Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-27 21:58:53 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

(... <tpl>) escaped template implemented

Browse source
This commit is contained in:
ESL 2024-07-14 15:05:07 -04:00
parent bb97a65b2f
commit acbd648f7b
2 changed files with 34 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
src/t.scm
View file

@ -771,7 +771,7 @@
(match (cdr pat) (cdr sexp) bindings))] (match (cdr pat) (cdr sexp) bindings))]
[else (fail)]))))) [else (fail)])))))
(define (expand-template pat tmpl top-bindings use-env) (define (expand-template pat tmpl top-bindings)
; New-literals is an alist mapping each literal id in the ; New-literals is an alist mapping each literal id in the
; template to a fresh id for inserting into the output. It ; template to a fresh id for inserting into the output. It
; might have duplicate entries mapping an id to two different ; might have duplicate entries mapping an id to two different
@ -790,32 +790,34 @@
(define (list-ellipsis-vars subtmpl) (define (list-ellipsis-vars subtmpl)
(list-ids subtmpl #t (lambda (id) (memq id ellipsis-vars)))) (list-ids subtmpl #t (lambda (id) (memq id ellipsis-vars))))
(let expand ([tmpl tmpl] [bindings top-bindings]) (let expand ([tmpl tmpl] [bindings top-bindings] [esc? #f])
(let expand-part ([tmpl tmpl]) (let expand-part ([tmpl tmpl] [esc? esc?])
(cond (cond
[(id? tmpl) [(id? tmpl)
(cdr (or (assq tmpl bindings) (cdr (or (assq tmpl bindings)
(assq tmpl top-bindings) (assq tmpl top-bindings)
(assq tmpl new-literals)))] (assq tmpl new-literals)))]
[(vector? tmpl) [(vector? tmpl)
(list->vector (expand-part (vector->list tmpl)))] (list->vector (expand-part (vector->list tmpl) esc?))]
[(and (pair? tmpl) (ellipsis-pair? (cdr tmpl))) [(and (not esc?) (pair? tmpl) (ellipsis? (car tmpl))) ; r7rs
(if (pair? (cdr tmpl)) (expand-part (cadr tmpl) #t)
(x-error "invalid escaped template syntax" tmpl))]
[(and (not esc?) (pair? tmpl) (ellipsis-pair? (cdr tmpl)))
(let ([vars-to-iterate (list-ellipsis-vars (car tmpl))]) (let ([vars-to-iterate (list-ellipsis-vars (car tmpl))])
(define (lookup var) (define (lookup var)
(cdr (assq var bindings))) (cdr (assq var bindings)))
(define (expand-using-vals . vals) (define (expand-using-vals esc? . vals)
(expand (car tmpl) (expand (car tmpl) (map cons vars-to-iterate vals) esc?))
(map cons vars-to-iterate vals)))
(if (null? vars-to-iterate) (if (null? vars-to-iterate)
; ellipsis following non-repeatable part is an error, but we don't care ; ellipsis following non-repeatable part is an error, but we don't care
(cons (expand-part (car tmpl)) (expand-part (cddr tmpl))) ; repeat once (cons (expand-part (car tmpl) esc?)
(expand-part (cddr tmpl) esc?)) ; 'repeat' once
; correct use of ellipsis ; correct use of ellipsis
(let ([val-lists (map lookup vars-to-iterate)]) (let ([val-lists (map lookup vars-to-iterate)]
(append [euv (lambda v* (apply expand-using-vals esc? v*))])
(apply map (cons expand-using-vals val-lists)) (append (apply map (cons euv val-lists)) (expand-part (cddr tmpl) esc?)))))]
(expand-part (cddr tmpl))))))]
[(pair? tmpl) [(pair? tmpl)
(cons (expand-part (car tmpl)) (expand-part (cdr tmpl)))] (cons (expand-part (car tmpl) esc?) (expand-part (cdr tmpl) esc?))]
[else tmpl])))) [else tmpl]))))
(lambda (use use-env) (lambda (use use-env)
@ -823,7 +825,7 @@
(if (null? rules) (x-error "invalid syntax" use)) (if (null? rules) (x-error "invalid syntax" use))
(let* ([rule (car rules)] [pat (car rule)] [tmpl (cadr rule)]) (let* ([rule (car rules)] [pat (car rule)] [tmpl (cadr rule)])
(cond [(match-pattern pat use use-env) => (cond [(match-pattern pat use use-env) =>
(lambda (bindings) (expand-template pat tmpl bindings use-env))] (lambda (bindings) (expand-template pat tmpl bindings))]
[else (loop (cdr rules))]))))) [else (loop (cdr rules))])))))

31
t.c
View file

@ -466,20 +466,23 @@ char *t_code[] = {
"10)a,:5^[03},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[" "10)a,:5^[03},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)["
"12}.!0${.(i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(" "12}.!0${.(i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@("
"y4:list)c,@(y4:%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d," "y4:list)c,@(y4:%25map),@(y13:apply-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{%4,,,#" ".5d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!6.8,.2,.7,.5,.8,&5{%3,"
"0#1#2,#0${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},:3,.4,&2{%1${:0,&" ",,#0#1#2,#0${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:2^[03},:4,.4,&2{%1${:"
"1{%0:0^]0},:1,.4,@(y14:new-literal-id)[03},.1c]1},@(y5:%25map1)[02}.!0" "0,&1{%0:0^]0},:1,.4,@(y14:new-literal-id)[03},.1c]1},@(y5:%25map1)[02}"
".0^_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[1" ".!0.0^_1.!0${:3^,f,.7,:2^[03}.!1.1,:2,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0"
"3}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2" "^[13}.!2f,.6,.6,,#0.9,.5,:0,:1,.(i10),.5,&6{%3.2,.1,,#0.0,.5,:0,:1,:2,"
",@(y3:id?)[01}?{:5,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0" ":3,:4,:5,&8{%2${.2,@(y3:id?)[01}?{:6,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,"
"?{${.2X0,:6^[01}X1]1}.0p?{${.2d,:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1" ".3A3}_1}_1d]2}.0V0?{${.3,.3X0,:7^[02}X1]2}.1~?{.0p?{${.2a,:2^[01}}{f}}"
"{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:" "{f}?{.0dp?{t,.1da,:7^[22}.0,'(s31:invalid escaped template syntax),@(y"
"1a,:0^[12}.!1.2u?{${.5dd,:6^[01},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map" "7:x-error)[22}.1~?{.0p?{${.2d,:3^[01}}{f}}{f}?{${.2a,:4^[01},,,#0#1:6,"
"1)[02},${.6dd,:6^[01},${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[02}L" "&1{%1:0,.1A3d]1}.!0.2,.4,:5,&3{%!1.1,${.3,:2,@(y4:cons),@(y5:%25map2)["
"6]5}.0p?{${.2d,:6^[01},${.3a,:6^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[72}." "03},:1a,:0^[23}.!1.2u?{${.6,.6dd,:7^[02},${.7,.7a,:7^[02}c]5}.4,.2,&2{"
"!7.(i11),.8,.8,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid " "%!0.0,:1c,:0^,@(y13:apply-to-list)[12},${.5,.4^,@(y5:%25map1)[02},${.8"
"syntax),@(y7:x-error)[02}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,:2,.1" ",.8dd,:7^[02},${.3,.5c,@(y4:%25map),@(y13:apply-to-list)[02}L6]7}.0p?{"
",.4,.6,:1^[64}.4d,:0^[51}.!0.0^_1[21}](i12)", "${.3,.3d,:7^[02},${.4,.4a,:7^[02}c]2}.0]2}.!0.0^_1[32}.!0.0^_1[63}.!7."
"(i11),.8,.8,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syn"
"tax),@(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", "P", "make-include-transformer",
"%1,,,,#0#1#2#3&0{%2${.2,@(y6:list2?)[01}?{.0daS0}{f}~?{${.2,'(s14:inva" "%1,,,,#0#1#2#3&0{%2${.2,@(y6:list2?)[01}?{.0daS0}{f}~?{${.2,'(s14:inva"