Ekdohibs/camlboot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

environments contain "bindings", export bindings-get

Browse Source 
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
1 changed files with 17 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
miniml/compiler/compile.scm
View File

@ -907,6 +907,15 @@
(define RERAISE 146) (define RERAISE 146)
(define obj_tag (cdr (prim "caml_obj_tag"))) (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> (define-immutable-record-type <env>
(mkenv vars constrs fields modules) (mkenv vars constrs fields modules)
env? env?
@ -915,7 +924,6 @@
(fields env-get-fields env-with-fields) (fields env-get-fields env-with-fields)
(modules env-get-modules env-with-modules)) (modules env-get-modules env-with-modules))
(define (env-replace-var env k v) (define (env-replace-var env k v)
(env-with-vars env (vhash-replace k v (env-get-vars env)))) (env-with-vars env (vhash-replace k v (env-get-vars env))))
(define (env-replace-constr env k v) (define (env-replace-constr env k v)
@ -927,17 +935,12 @@
(define empty-env (mkenv vlist-null vlist-null vlist-null vlist-null)) (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) (define (env-get-module env ld)
(match ld (match ld
(('Lident v) (('Lident v)
(cdr (cdr (vhash-assoc-err v (env-get-modules env))))) (bindings-get-err (env-get-modules env) v))
(('Ldot ld uid) (('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) (define (env-get-env-li env ld)
(match ld (match ld
@ -947,14 +950,14 @@
(cons (env-get-module env ld) uid)))) (cons (env-get-module env ld) uid))))
(define (env-get-var env ld) (define (env-get-var env ld)
(let ((envs (env-get-env-li env ld))) (match-let (((env . v) (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-vars (car envs))))))) (bindings-get-err (env-get-vars env) v)))
(define (env-get-constr env ld) (define (env-get-constr env ld)
(let ((envs (env-get-env-li env ld))) (match-let (((env . v) (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-constrs (car envs))))))) (bindings-get-err (env-get-constrs env) v)))
(define (env-get-field env ld) (define (env-get-field env ld)
(let ((envs (env-get-env-li env ld))) (match-let (((env . v) (env-get-env-li env ld)))
(cdr (cdr (vhash-assoc-err (cdr envs) (env-get-fields (car envs))))))) (bindings-get-err (env-get-fields env) v)))
(define-immutable-record-type <var> (define-immutable-record-type <var>
(mkvar location funshape) (mkvar location funshape)