From 26b907c8af25ad741c7d487bbd19c559ff36b4cd Mon Sep 17 00:00:00 2001 From: dermagen Date: Fri, 14 Jun 2024 16:15:15 -0400 Subject: [PATCH] rename hack to circumvent hygiene! --- src/t.scm | 23 ++++++++++++------ t.c | 70 ++++++++++++++++++++++++++++++------------------------- 2 files changed, 54 insertions(+), 39 deletions(-) diff --git a/src/t.scm b/src/t.scm index 4d78ffe..48542e4 100644 --- a/src/t.scm +++ b/src/t.scm @@ -255,11 +255,13 @@ (define-syntax location-set-val! set-box!) (define (location-special? l) (not (pair? (unbox l)))) -(define (new-id sym den) (define p (cons sym den)) (lambda () p)) +(define (new-id sym den rename) (define p (list sym den rename)) (lambda () p)) (define (old-sym id) (car (id))) -(define (old-den id) (cdr (id))) +(define (old-den id) (cadr (id))) +(define (old-rename id) (or (caddr (id)) (lambda (nid) nid))) (define (id? x) (or (symbol? x) (procedure? x))) (define (id->sym id) (if (symbol? id) id (old-sym id))) +(define (id-rename-as id nid) (if (symbol? id) nid ((old-rename id) nid))) ; Expand-time environments map identifiers (symbolic or thunked) to denotations, i.e. locations ; containing either a or a value. In normal case, value is (ref ), @@ -469,7 +471,7 @@ [nid (gensym (id->sym id))] [env (add-local-var id nid env)]) (loop env (cons id ids) (cons init inits) (cons nid nids) rest))] [(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail))) - (let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda))] + (let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda) #f)] [init (cons lambda-id (cons (cdar tail) (cdr tail)))] [nid (gensym (id->sym id))] [env (add-local-var id nid env)]) (loop env (cons id ids) (cons init inits) (cons nid nids) rest))] @@ -640,9 +642,16 @@ ; fresh ids, but that's okay because when we go to retrieve a ; fresh id, assq will always retrieve the first one. (define new-literals - (map (lambda (id) (cons id (new-id (id->sym id) (xenv-ref mac-env id)))) - (list-ids tmpl #t - (lambda (id) (not (assq id top-bindings)))))) + (body + (define nl + (map (lambda (id) + (cons id + (new-id (id->sym id) + (xenv-ref mac-env id) + (lambda (nid) (cond [(assq nid nl) => cdr] [else nid]))))) + (list-ids tmpl #t + (lambda (id) (not (assq id top-bindings)))))) + nl)) (define ellipsis-vars (list-ids pat #f not-pat-literal?)) @@ -690,7 +699,7 @@ ; hand-made transformers (use functionality defined below) (define (make-include-transformer ci?) - (define begin-id (new-id 'begin (make-location 'begin))) + (define begin-id (new-id 'begin (make-location 'begin) #f)) (lambda (sexp env) (if (list1+? sexp) (let loop ([files (cdr sexp)] [exp-lists '()]) diff --git a/t.c b/t.c index 63e4304..a7775d7 100644 --- a/t.c +++ b/t.c @@ -124,13 +124,16 @@ char *t_code[] = { "%1.0zp~]1", "P", "new-id", - "%2,#0.2,.2c.!0.0,&1{%0:0^]0}]3", + "%3,#0.3,.3,.3,l3.!0.0,&1{%0:0^]0}]4", "P", "old-sym", "%1${.2[00}a]1", "P", "old-den", - "%1${.2[00}d]1", + "%1${.2[00}da]1", + + "P", "old-rename", + "%1${.2[00}dda,.0?{.0]2}&0{%1.0]1}]2", "P", "id?", "%1.0Y0,.0?{.0]2}.1K0]2", @@ -138,6 +141,9 @@ char *t_code[] = { "P", "id->sym", "%1.0Y0?{.0]1}.0,@(y7:old-sym)[11", + "P", "id-rename-as", + "%2.0Y0?{.1]2}.1,${.3,@(y10:old-rename)[01}[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", @@ -264,17 +270,17 @@ char *t_code[] = { "}{f}?{.2a,.3da,${${.5,@(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,@(y7:list2+?)[01}?{.2ap?{${.4aa,@(y3:id?)[01}?{${.4ad,@(y8" - ":idslist?)[01}}{f}}{f}}{f}?{.2aa,${'(y6:lambda)b,'(y6:lambda),@(y6:new" - "-id)[02},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i" - "12),.3,.7,@(y13:add-local-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15)" - ",.8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2" - "}'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}" - "{f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y17:extend-xenv-local)" - "[03},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:imprope" - "r define-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(" - "i10),.(i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11" - ")A8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels" - ")[55}.!0.0^_1[25", + ":idslist?)[01}}{f}}{f}}{f}?{.2aa,${f,'(y6:lambda)b,'(y6:lambda),@(y6:n" + "ew-id)[03},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${." + "(i12),.3,.7,@(y13:add-local-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i1" + "5),.8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11" + ")2}'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01" + "}}{f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y17:extend-xenv-loca" + "l)[03},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:impro" + "per define-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c," + ".(i10),.(i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i" + "11)A8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labe" + "ls)[55}.!0.0^_1[25", "P", "xform-labels", "%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5" @@ -346,27 +352,27 @@ char *t_code[] = { ",:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${.(i12),.6,.(i12)dd,:6^[03" "},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4:%25map),@(y13:appl" "y-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^[43}:7^[40" - "}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2${${.9,&1{%1:0,.1A3~]1},t,.(" - "i10),:1^[03},:3,&1{%1${${.4,:0,@(y8:xenv-ref)[02},${.5,@(y7:id->sym)[0" - "1},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1^[03}.!1.1" - ",:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5" - "{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}" - "{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d" - ",:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!" - "0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01" - "},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c" - ",@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6" - "^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:2,,#0:0,.3" - ",.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,." - "0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[" - "21}](i12)", + "}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2,#0${${.(i10),&1{%1:0,.1A3~]" + "1},t,.(i11),:1^[03},:3,.4,&2{%1${:0,&1{%1:0^,.1A3,.0?{.0d]2}.1]2},${.5" + ",:1,@(y8:xenv-ref)[02},${.6,@(y7:id->sym)[01},@(y6:new-id)[03},.1c]1}," + "@(y5:%25map1)[02}.!0.0^_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0" + "^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5{%2.0,,#0.0,.4,:0,:" + "1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1" + "^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d,:2^[01}}{f}?{${.2a" + ",:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:cons)" + ",@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01},${.6a,:6^[01}c]4}" + "${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c,@(y4:%25map),@(y13" + ":apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6^[01}c]1}.0]1}.!0.0" + "^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?" + "{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,.0a,.1da,${:2,:3,.5," + ":4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i12)", "P", "make-include-transformer", - "%1,#0${'(y5:begin)b,'(y5:begin),@(y6:new-id)[02}.!0.1,.1,&2{%2${.2,@(y" - "7:list1+?)[01}?{n,.1d,,#0.0,:1,:0,&3{%2.0u?{${.3A9,@(y7:%25append),@(y" - "13:apply-to-list)[02},:0^c]2}.1,.1,:2,&3{%1:2,.1c,:1d,:0^[12},:1,.2a,@" - "(y24:call-with-file/lib-sexps)[23}.!0.0^_1[22}.0,'(s14:invalid syntax)" - ",@(y7:x-error)[22}]2", + "%1,#0${f,'(y5:begin)b,'(y5:begin),@(y6:new-id)[03}.!0.1,.1,&2{%2${.2,@" + "(y7:list1+?)[01}?{n,.1d,,#0.0,:1,:0,&3{%2.0u?{${.3A9,@(y7:%25append),@" + "(y13:apply-to-list)[02},:0^c]2}.1,.1,:2,&3{%1:2,.1c,:1d,:0^[12},:1,.2a" + ",@(y24:call-with-file/lib-sexps)[23}.!0.0^_1[22}.0,'(s14:invalid synta" + "x),@(y7:x-error)[22}]2", "P", "if-feature-available-transformer", "%2.0L0?{'4,.1g=}{f}?{.0ddda,.1dda,.2da,${${.4,@(y17:xform-sexp->datum)"