Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2025-01-13 20:03:30 +01:00
Code Issues Projects Releases Packages Wiki Activity

rename hack to circumvent hygiene!

Browse source
This commit is contained in:
dermagen 2024-06-14 16:15:15 -04:00
parent 21e470522d
commit 26b907c8af
2 changed files with 54 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/t.scm
View file

@ -255,11 +255,13 @@
(define-syntax location-set-val! set-box!) (define-syntax location-set-val! set-box!)
(define (location-special? l) (not (pair? (unbox l)))) (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-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? x) (or (symbol? x) (procedure? x)))
(define (id->sym id) (if (symbol? id) id (old-sym id))) (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 ; Expand-time environments map identifiers (symbolic or thunked) to denotations, i.e. locations
; containing either a <special> or a <core> value. In normal case, <core> value is (ref <gid>), ; containing either a <special> or a <core> value. In normal case, <core> value is (ref <gid>),
@ -469,7 +471,7 @@
[nid (gensym (id->sym id))] [env (add-local-var id nid env)]) [nid (gensym (id->sym id))] [env (add-local-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))] (loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
[(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail))) [(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)))] [init (cons lambda-id (cons (cdar tail) (cdr tail)))]
[nid (gensym (id->sym id))] [env (add-local-var id nid env)]) [nid (gensym (id->sym id))] [env (add-local-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))] (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 ids, but that's okay because when we go to retrieve a
; fresh id, assq will always retrieve the first one. ; fresh id, assq will always retrieve the first one.
(define new-literals (define new-literals
(map (lambda (id) (cons id (new-id (id->sym id) (xenv-ref mac-env id)))) (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 (list-ids tmpl #t
(lambda (id) (not (assq id top-bindings)))))) (lambda (id) (not (assq id top-bindings))))))
nl))
(define ellipsis-vars (define ellipsis-vars
(list-ids pat #f not-pat-literal?)) (list-ids pat #f not-pat-literal?))
@ -690,7 +699,7 @@
; hand-made transformers (use functionality defined below) ; hand-made transformers (use functionality defined below)
(define (make-include-transformer ci?) (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) (lambda (sexp env)
(if (list1+? sexp) (if (list1+? sexp)
(let loop ([files (cdr sexp)] [exp-lists '()]) (let loop ([files (cdr sexp)] [exp-lists '()])

70
t.c
View file

@ -124,13 +124,16 @@ char *t_code[] = {
"%1.0zp~]1", "%1.0zp~]1",
"P", "new-id", "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", "P", "old-sym",
"%1${.2[00}a]1", "%1${.2[00}a]1",
"P", "old-den", "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?", "P", "id?",
"%1.0Y0,.0?{.0]2}.1K0]2", "%1.0Y0,.0?{.0]2}.1K0]2",
@ -138,6 +141,9 @@ char *t_code[] = {
"P", "id->sym", "P", "id->sym",
"%1.0Y0?{.0]1}.0,@(y7:old-sym)[11", "%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", "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" "%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", ",.1,:2[22}]4",
@ -264,17 +270,17 @@ char *t_code[] = {
"}{f}?{.2a,.3da,${${.5,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i11),.3,." "}{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^[" "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" "(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" ":idslist?)[01}}{f}}{f}}{f}?{.2aa,${f,'(y6:lambda)b,'(y6:lambda),@(y6:n"
"-id)[02},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i" "ew-id)[03},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${."
"12),.3,.7,@(y13:add-local-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15)" "(i12),.3,.7,@(y13:add-local-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i1"
",.8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2" "5),.8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11"
"}'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}" ")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)" "}}{f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y17:extend-xenv-loca"
"[03},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:imprope" "l)[03},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:impro"
"r define-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(" "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,.(i11" ".(i10),.(i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i"
")A8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels" "11)A8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labe"
")[55}.!0.0^_1[25", "ls)[55}.!0.0^_1[25",
"P", "xform-labels", "P", "xform-labels",
"%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5" "%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" ",: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" "},${${.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" "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,.(" "}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2,#0${${.(i10),&1{%1:0,.1A3~]"
"i10),:1^[03},:3,&1{%1${${.4,:0,@(y8:xenv-ref)[02},${.5,@(y7:id->sym)[0" "1},t,.(i11),:1^[03},:3,.4,&2{%1${:0,&1{%1:0^,.1A3,.0?{.0d]2}.1]2},${.5"
"1},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1^[03}.!1.1" ",:1,@(y8:xenv-ref)[02},${.6,@(y7:id->sym)[01},@(y6:new-id)[03},.1c]1},"
",:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5" "@(y5:%25map1)[02}.!0.0^_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0"
"{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}" "^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5{%2.0,,#0.0,.4,:0,:"
"{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d" "1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1"
",:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!" "^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d,:2^[01}}{f}?{${.2a"
"0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01" ",:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:cons)"
"},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c" ",@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01},${.6a,:6^[01}c]4}"
",@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6" "${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c,@(y4:%25map),@(y13"
"^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:2,,#0:0,.3" ":apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6^[01}c]1}.0]1}.!0.0"
",.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,." "^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?"
"0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[" "{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,.0a,.1da,${:2,:3,.5,"
"21}](i12)", ":4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i12)",
"P", "make-include-transformer", "P", "make-include-transformer",
"%1,#0${'(y5:begin)b,'(y5:begin),@(y6:new-id)[02}.!0.1,.1,&2{%2${.2,@(y" "%1,#0${f,'(y5:begin)b,'(y5:begin),@(y6:new-id)[03}.!0.1,.1,&2{%2${.2,@"
"7:list1+?)[01}?{n,.1d,,#0.0,:1,:0,&3{%2.0u?{${.3A9,@(y7:%25append),@(y" "(y7:list1+?)[01}?{n,.1d,,#0.0,:1,:0,&3{%2.0u?{${.3A9,@(y7:%25append),@"
"13:apply-to-list)[02},:0^c]2}.1,.1,:2,&3{%1:2,.1c,:1d,:0^[12},:1,.2a,@" "(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 syntax)" ",@(y24:call-with-file/lib-sexps)[23}.!0.0^_1[22}.0,'(s14:invalid synta"
",@(y7:x-error)[22}]2", "x),@(y7:x-error)[22}]2",
"P", "if-feature-available-transformer", "P", "if-feature-available-transformer",
"%2.0L0?{'4,.1g=}{f}?{.0ddda,.1dda,.2da,${${.4,@(y17:xform-sexp->datum)" "%2.0L0?{'4,.1g=}{f}?{.0ddda,.1dda,.2da,${${.4,@(y17:xform-sexp->datum)"