import and define-library forms in bodies!

src/t.scm

@@ -307,26 +307,31 @@
             (cond [(assq renamed-nid lits) => cdr]
                   [else renamed-nid]))))))
 
-; Expand-time environments map identifiers (symbolic or thunked) to denotations, i.e. locations
+; Expand-time environments map names (identifiers or listnames) to denotations, i.e. locations
 ; containing either a <special> or a <core> value. In normal case, <core> value is (ref <gid>),
 ; where <gid> is a key in run-time store, aka *globals*. Environments should allocate new locations
-; as needed, so every identifier gets mapped to one. Expand-time environments are represented as
+; as needed, so every name gets mapped to one. Expand-time environments are represented as
 ; two-argument procedures, where the second argument (at) is an access type symbol, one of the
 ; four possible values: ref, set!, define, define-syntax (defines are requests to allocate)
 
 (define (extend-xenv-local id val env)
   (let ([loc (make-location val)])
-    (lambda (i at) 
-      (if (eq? id i)
-          (case at [(ref set!) loc] [else #f]) 
-          (env i at)))))
+    (if (pair? id) 
+        (lambda (i at) ; listname binding 
+          (if (equal? id i) 
+              (case at [(ref set!) loc] [else #f]) 
+              (env i at)))
+        (lambda (i at) ; symname binding
+          (if (eq? id i)
+              (case at [(ref set!) loc] [else #f]) 
+              (env i at))))))
 
 (define (add-local-var id gid env)
   (extend-xenv-local id (list 'ref gid) env))
 
 (define (xenv-lookup env id at)
   (or (env id at)
-      (error* "transformer: invalid identifier access" (list id (id->sym id) at))))
+      (error* "transformer: invalid identifier access" (list id (xform-sexp->datum id) at))))
 
 (define (xenv-ref env id) (xenv-lookup env id 'ref))
 
@@ -536,9 +541,32 @@
                  [(define-syntax) ; internal
                   (if (and (list2? tail) (id? (car tail))) 
                       (let* ([id (car tail)] [init (cadr tail)]
-                             [env (extend-xenv-local id '(begin) env)]) ; placeholder val
+                             [env (extend-xenv-local id '(undefined) env)]) ; placeholder val
                         (loop env (cons id ids) (cons init inits) (cons #t nids) rest))
                       (x-error "improper define-syntax form" first))]
+                 [(define-library) ; internal
+                  (if (and (list2+? tail) (listname? (car tail)))
+                      ; note: library is fully expanded in incomplete env, to make it
+                      ; immediately available for import; it ignores lexical scope anyway 
+                      (let* ([core (xform-define-library head tail env #f)] 
+                             ; core is (define-library <listname> <library>)
+                             [listname (cadr core)] [library (caddr core)]
+                             [env (extend-xenv-local listname library env)])
+                        (loop env ids inits nids rest)) ; no trace for xform-labels
+                      (x-error "improper define-library form" first))]
+                 [(import) ; internal
+                  (if (list? tail)
+                      ; note: import is fully expanded in incomplete env, right now! 
+                      (let* ([core (xform-import head tail env #f)] ; core is (import <library>)
+                             [l (cadr core)] [code (library-code l)] [eal (library-exports l)])
+                        (let scan ([eal eal] [env env])
+                          (if (null? eal) ; add init code as if it were idless define
+                              (let ([init (list syntax-quote-id code)])
+                                (loop env (cons #f ids) (cons init inits) (cons #f nids) rest))
+                              (let ([id (id-rename-as head (caar eal))] [loc (cdar eal)])
+                                (scan (cdr eal) ; use handmade env sharing loc, but for ref only!
+                                  (lambda (i at) (if (and (eq? i id) (eq? at 'ref)) loc (env i at))))))))
+                      (x-error "improper import form" first))] 
                  [else
                   (if (val-transformer? hval)
                       (loop env ids inits nids (cons (hval first env) rest))
@@ -1034,7 +1062,7 @@
   (if (and (list2+? tail) (listname? (car tail)))
       (let* ([listname (xform-sexp->datum (car tail))]
              [prefix (and top? (listname->symbol listname))]
-             ; NB: head is used as seed id for renamingsl fixed prefix used on top only
+             ; NB: head is used as seed id for renamings; fixed prefix used on top only
              [libform (cons head (if prefix (cons prefix (cdr tail)) (cdr tail)))]
              [ic&ex (preprocess-library libform env)])
         ; NB: this is part 2/4 of listname <-> library interaction

t.c

@@ -190,15 +190,16 @@ char *t_code[] = {
   "[21",
 
   "P", "extend-xenv-local",
-  "%3.1b,.3,.1,.3,&3{%2.0,:0q?{.1,'(l2:y3:ref;y4:set!;),.1A1?{:1]3}f]3}.1"
-  ",.1,:2[22}]4",
+  "%3.1b,.1p?{.3,.1,.3,&3{%2.0,:0e?{.1,'(l2:y3:ref;y4:set!;),.1A1?{:1]3}f"
+  "]3}.1,.1,:2[22}]4}.3,.1,.3,&3{%2.0,:0q?{.1,'(l2:y3:ref;y4:set!;),.1A1?"
+  "{:1]3}f]3}.1,.1,:2[22}]4",
 
   "P", "add-local-var",
   "%3.2,.2,'(y3:ref),l2,.2,@(y17:extend-xenv-local)[33",
 
   "P", "xenv-lookup",
-  "%3${.4,.4,.4[02},.0?{.0]4}.3,${.5,@(y7:id->sym)[01},.4,l3,'(s38:transf"
-  "ormer: invalid identifier access),@(y6:error*)[42",
+  "%3${.4,.4,.4[02},.0?{.0]4}.3,${.5,@(y17:xform-sexp->datum)[01},.4,l3,'"
+  "(s38:transformer: invalid identifier access),@(y6:error*)[42",
 
   "P", "xenv-ref",
   "%2'(y3:ref),.2,.2,@(y11:xenv-lookup)[23",
@@ -346,12 +347,22 @@ char *t_code[] = {
   ",@(y7:id->sym)[01},@(y6:gensym)[01},${.(i11),.3,.6,@(y13:add-local-var"
   ")[03},.9,.(i14),.3c,.(i14),.5c,.(i14),.7c,.4,:0^[(i15)5}.4,'(s20:impro"
   "per define form),@(y7:x-error)[(i11)2}'(y13:define-syntax),.1v?{${.4,@"
-  "(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da,${.(i10),'(l1:y5:be"
-  "gin;),.5,@(y17:extend-xenv-local)[03},.8,.(i13),tc,.(i13),.4c,.(i13),."
-  "6c,.4,:0^[(i14)5}.4,'(s27:improper define-syntax form),@(y7:x-error)[("
-  "i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i10),.(i10),.(i10),.(i10),:0^[(i11)5}"
-  ":1,.7,.(i12),.(i12)A8,.(i12)A8,.(i12)A8,@(y12:xform-labels)[(i11)6}:1,"
-  ".1,.6,.6A8,.6A8,.6A8,@(y12:xform-labels)[56}.!0.0^_1[35",
+  "(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da,${.(i10),'(l1:y9:un"
+  "defined;),.5,@(y17:extend-xenv-local)[03},.8,.(i13),tc,.(i13),.4c,.(i1"
+  "3),.6c,.4,:0^[(i14)5}.4,'(s27:improper define-syntax form),@(y7:x-erro"
+  "r)[(i11)2}'(y14:define-library),.1v?{${.4,@(y7:list2+?)[01}?{${.4a,@(y"
+  "9:listname?)[01}}{f}?{${f,.9,.6,.8,@(y20:xform-define-library)[04},.0d"
+  "a,.1dda,${.(i11),.3,.5,@(y17:extend-xenv-local)[03},.9,.(i14),.(i14),."
+  "(i14),.4,:0^[(i15)5}.4,'(s28:improper define-library form),@(y7:x-erro"
+  "r)[(i11)2}'(y6:import),.1v?{.2L0?{${f,.9,.6,.8,@(y12:xform-import)[04}"
+  ",.0da,'0,.1V4,'1,.2V4,.(i10),.1,,#0.(i10),.1,.(i14),.(i19),.(i19),.(i1"
+  "9),:0,.(i11),&8{%2.0u?{:0,@(y15:syntax-quote-id),l2,:5,:4,fc,:3,.3c,:2"
+  ",fc,.6,:1^[35}.0ad,${.3aa,:7,@(y12:id-rename-as)[02},.3,.2,.2,&3{%2:0,"
+  ".1q?{'(y3:ref),.2q}{f}?{:1]2}.1,.1,:2[22},.3d,:6^[42}.!0.0^_1[(i15)2}."
+  "4,'(s20:improper import form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6"
+  "[02}c,.(i10),.(i10),.(i10),.(i10),:0^[(i11)5}:1,.7,.(i12),.(i12)A8,.(i"
+  "12)A8,.(i12)A8,@(y12:xform-labels)[(i11)6}:1,.1,.6,.6A8,.6A8,.6A8,@(y1"
+  "2:xform-labels)[56}.!0.0^_1[35",
 
   "P", "xform-labels",
   "%6,#0${.5,&0{%1t,.1q]1},@(y6:andmap)[02}.!0n,n,.5,.5,.5,,#0.0,.(i12),."