diff --git a/src/t.scm b/src/t.scm index eb83a7e..56cdd99 100644 --- a/src/t.scm +++ b/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 or a value. In normal case, value is (ref ), ; where 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 (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 ) + [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 diff --git a/t.c b/t.c index a6a09d9..48f5aa4 100644 --- a/t.c +++ b/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),."