environments contain "bindings", export bindings-get

This is a new abstraction/concept in the codebase: the vhashes that
contain visibility information and a definition are called
"environment bindings".

For now there is only an accessor, bindings-get.
This commit is contained in:
Gabriel Scherer 2020-12-06 17:38:58 +01:00 committed by Nathanaël Courant
parent ed364b7ee4
commit 1bde4c5d88

View File

@ -907,6 +907,15 @@
(define RERAISE 146)
(define obj_tag (cdr (prim "caml_obj_tag")))
; bindings store for each name a definition, but also some visibility
; information, which indicate if this name was defined as "exported"
; by the current compilation unit ('Export), or is just available locally ('Local).
; In OCaml, this is the difference between `include M` and `open M`.
(define (bindings-get-err bindings name)
(match (vhash-assoc name bindings)
((k . (viz . v)) v)
(#f (errorp "Not found in env: " name))))
(define-immutable-record-type <env>
(mkenv vars constrs fields modules)
env?
@ -915,7 +924,6 @@
(fields env-get-fields env-with-fields)
(modules env-get-modules env-with-modules))
(define (env-replace-var env k v)
(env-with-vars env (vhash-replace k v (env-get-vars env))))
(define (env-replace-constr env k v)
@ -927,17 +935,12 @@
(define empty-env (mkenv vlist-null vlist-null vlist-null vlist-null))
(define (vhash-assoc-err name env)
(let ((r (vhash-assoc name env)))
(if (pair? r) r (errorp "Not found in env: " name))
))
(define (env-get-module env ld)
(match ld
(('Lident v)
(cdr (cdr (vhash-assoc-err v (env-get-modules env)))))
(bindings-get-err (env-get-modules env) v))
(('Ldot ld uid)
(cdr (cdr (vhash-assoc-err uid (env-get-modules (env-get-module env ld))))))))
(bindings-get-err (env-get-modules (env-get-module env ld)) uid))))
(define (env-get-env-li env ld)
(match ld
@ -947,14 +950,14 @@
(cons (env-get-module env ld) uid))))
(define (env-get-var env ld)
(let ((envs (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-vars (car envs)))))))
(match-let (((env . v) (env-get-env-li env ld)))
(bindings-get-err (env-get-vars env) v)))
(define (env-get-constr env ld)
(let ((envs (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-constrs (car envs)))))))
(match-let (((env . v) (env-get-env-li env ld)))
(bindings-get-err (env-get-constrs env) v)))
(define (env-get-field env ld)
(let ((envs (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-fields (car envs)))))))
(match-let (((env . v) (env-get-env-li env ld)))
(bindings-get-err (env-get-fields env) v)))
(define-immutable-record-type <var>
(mkvar location funshape)