From 1bde4c5d8843afbd668b1189b9f1481b5e9357dd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 6 Dec 2020 17:38:58 +0100 Subject: [PATCH] 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. --- miniml/compiler/compile.scm | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/miniml/compiler/compile.scm b/miniml/compiler/compile.scm index b56540d..28b7063 100644 --- a/miniml/compiler/compile.scm +++ b/miniml/compiler/compile.scm @@ -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 (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 (mkvar location funshape)