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

bodies in COND, CASE, WHEN, UNLESS, DO, GUARD

Browse source
This commit is contained in:
ESL 2024-07-24 18:39:51 -04:00
parent 3c34a4cbae
commit eb61384689
2 changed files with 51 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
pre/s.scm
View file

@ -121,13 +121,13 @@
[(_ test) test] [(_ test) test]
[(_ test . tests) (let ([x test]) (if x x (or . tests)))])) [(_ test . tests) (let ([x test]) (if x x (or . tests)))]))
(define-syntax cond (define-syntax cond ; + body support
(syntax-rules (else =>) (syntax-rules (else =>)
[(_) #f] [(_) #f]
[(_ (else . exps)) (begin . exps)] [(_ (else . exps)) (body . exps)]
[(_ (x) . rest) (or x (cond . rest))] [(_ (x) . rest) (or x (cond . rest))]
[(_ (x => proc) . rest) (let ([tmp x]) (cond [tmp (proc tmp)] . rest))] [(_ (x => proc) . rest) (let ([tmp x]) (cond [tmp (proc tmp)] . rest))]
[(_ (x . exps) . rest) (if x (begin . exps) (cond . rest))])) [(_ (x . exps) . rest) (if x (body . exps) (cond . rest))]))
(define-syntax %case-test (define-syntax %case-test
(syntax-rules () (syntax-rules ()
@ -135,23 +135,23 @@
[(_ k (datum)) (eqv? k 'datum)] [(_ k (datum)) (eqv? k 'datum)]
[(_ k data) (memv k 'data)])) [(_ k data) (memv k 'data)]))
(define-syntax %case (define-syntax %case ; + body support
(syntax-rules (else =>) (syntax-rules (else =>)
[(_ key) (begin)] [(_ key) (begin)]
[(_ key (else => resproc)) [(_ key (else => resproc))
(resproc key)] (resproc key)]
[(_ key (else expr ...)) [(_ key (else expr ...))
(begin expr ...)] (body expr ...)]
[(_ key ((datum ...) => resproc) . clauses) [(_ key ((datum ...) => resproc) . clauses)
(if (%case-test key (datum ...)) (if (%case-test key (datum ...))
(resproc key) (resproc key)
(%case key . clauses))] (%case key . clauses))]
[(_ key ((datum ...) expr ...) . clauses) [(_ key ((datum ...) expr ...) . clauses)
(if (%case-test key (datum ...)) (if (%case-test key (datum ...))
(begin expr ...) (body expr ...)
(%case key . clauses))])) (%case key . clauses))]))
(define-syntax case (define-syntax case ; + body support
(syntax-rules () (syntax-rules ()
[(_ x . clauses) (let ([key x]) (%case key . clauses))])) [(_ x . clauses) (let ([key x]) (%case key . clauses))]))
@ -159,14 +159,14 @@
(syntax-rules () (syntax-rules ()
[(_ x) x] [(_ x y) y])) [(_ x) x] [(_ x y) y]))
(define-syntax do (define-syntax do ; + body support
(syntax-rules () (syntax-rules ()
[(_ ([var init step ...] ...) [(_ ([var init step ...] ...)
[test expr ...] [test expr ...]
command ...) command ...)
(let loop ([var init] ...) (let loop ([var init] ...)
(if test (if test
(begin expr ...) (body expr ...)
(let () command ... (let () command ...
(loop (%do-step var step ...) ...))))])) (loop (%do-step var step ...) ...))))]))
@ -182,13 +182,13 @@
[(_ #(x ...) . d) (list->vector (quasiquote (x ...) . d))] [(_ #(x ...) . d) (list->vector (quasiquote (x ...) . d))]
[(_ x . d) 'x])) [(_ x . d) 'x]))
(define-syntax when (define-syntax when ; + body support
(syntax-rules () (syntax-rules ()
[(_ test . rest) (if test (begin . rest))])) [(_ test . rest) (if test (body . rest))]))
(define-syntax unless (define-syntax unless ; + body support
(syntax-rules () (syntax-rules ()
[(_ test . rest) (if (not test) (begin . rest))])) [(_ test . rest) (if (not test) (body . rest))]))
(define-syntax case-lambda (define-syntax case-lambda
(syntax-rules () (syntax-rules ()
@ -1317,10 +1317,10 @@
(parameterize ([current-exception-handler (eh)]) (parameterize ([current-exception-handler (eh)])
(eh obj)))) (eh obj))))
(define-syntax %guard-aux (define-syntax %guard-aux ; + body support
(syntax-rules (else =>) (syntax-rules (else =>)
[(_ reraise (else result1 result2 ...)) [(_ reraise (else result1 result2 ...))
(begin result1 result2 ...)] (body result1 result2 ...)]
[(_ reraise (test => result)) [(_ reraise (test => result))
(let ([temp test]) (if temp (result temp) reraise))] (let ([temp test]) (if temp (result temp) reraise))]
[(_ reraise (test => result) clause1 clause2 ...) [(_ reraise (test => result) clause1 clause2 ...)
@ -1333,10 +1333,10 @@
(let ([temp test]) (let ([temp test])
(if temp temp (%guard-aux reraise clause1 clause2 ...)))] (if temp temp (%guard-aux reraise clause1 clause2 ...)))]
[(_ reraise (test result1 result2 ...)) [(_ reraise (test result1 result2 ...))
(if test (begin result1 result2 ...) reraise)] (if test (body result1 result2 ...) reraise)]
[(_ reraise (test result1 result2 ...) clause1 clause2 ...) [(_ reraise (test result1 result2 ...) clause1 clause2 ...)
(if test (if test
(begin result1 result2 ...) (body result1 result2 ...)
(%guard-aux reraise clause1 clause2 ...))])) (%guard-aux reraise clause1 clause2 ...))]))
(define-syntax guard (define-syntax guard

66
s.c
View file

@ -87,11 +87,11 @@ char *s_code[] = {
"S", "cond", "S", "cond",
"l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l1:y1:_;;f;;l2:l2:y1:_;py4:el" "l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l1:y1:_;;f;;l2:l2:y1:_;py4:el"
"se;y4:exps;;;py5:begin;y4:exps;;;l2:py1:_;pl1:y1:x;;y4:rest;;;l3:y2:or" "se;y4:exps;;;py4:body;y4:exps;;;l2:py1:_;pl1:y1:x;;y4:rest;;;l3:y2:or;"
";y1:x;py4:cond;y4:rest;;;;l2:py1:_;pl3:y1:x;y2:=>;y4:proc;;y4:rest;;;l" "y1:x;py4:cond;y4:rest;;;;l2:py1:_;pl3:y1:x;y2:=>;y4:proc;;y4:rest;;;l3"
"3:y3:let;l1:l2:y3:tmp;y1:x;;;py4:cond;pl2:y3:tmp;l2:y4:proc;y3:tmp;;;y" ":y3:let;l1:l2:y3:tmp;y1:x;;;py4:cond;pl2:y3:tmp;l2:y4:proc;y3:tmp;;;y4"
"4:rest;;;;;l2:py1:_;ppy1:x;y4:exps;;y4:rest;;;l4:y2:if;y1:x;py5:begin;" ":rest;;;;;l2:py1:_;ppy1:x;y4:exps;;y4:rest;;;l4:y2:if;y1:x;py4:body;y4"
"y4:exps;;py4:cond;y4:rest;;;;", ":exps;;py4:cond;y4:rest;;;;",
"S", "%case-test", "S", "%case-test",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:k;n;;f;;l2:l3:y1:_;y1:k;l1:y5:datu" "l5:y12:syntax-rules;n;l2:l3:y1:_;y1:k;n;;f;;l2:l3:y1:_;y1:k;l1:y5:datu"
@ -101,13 +101,13 @@ char *s_code[] = {
"S", "%case", "S", "%case",
"l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l2:y1:_;y3:key;;l1:y5:begin;;" "l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l2:y1:_;y3:key;;l1:y5:begin;;"
";l2:l3:y1:_;y3:key;l3:y4:else;y2:=>;y7:resproc;;;l2:y7:resproc;y3:key;" ";l2:l3:y1:_;y3:key;l3:y4:else;y2:=>;y7:resproc;;;l2:y7:resproc;y3:key;"
";;l2:l3:y1:_;y3:key;l3:y4:else;y4:expr;y3:...;;;l3:y5:begin;y4:expr;y3" ";;l2:l3:y1:_;y3:key;l3:y4:else;y4:expr;y3:...;;;l3:y4:body;y4:expr;y3:"
":...;;;l2:py1:_;py3:key;pl3:l2:y5:datum;y3:...;;y2:=>;y7:resproc;;y7:c" "...;;;l2:py1:_;py3:key;pl3:l2:y5:datum;y3:...;;y2:=>;y7:resproc;;y7:cl"
"lauses;;;;l4:y2:if;l3:y10:%25case-test;y3:key;l2:y5:datum;y3:...;;;l2:" "auses;;;;l4:y2:if;l3:y10:%25case-test;y3:key;l2:y5:datum;y3:...;;;l2:y"
"y7:resproc;y3:key;;py5:%25case;py3:key;y7:clauses;;;;;l2:py1:_;py3:key" "7:resproc;y3:key;;py5:%25case;py3:key;y7:clauses;;;;;l2:py1:_;py3:key;"
";pl3:l2:y5:datum;y3:...;;y4:expr;y3:...;;y7:clauses;;;;l4:y2:if;l3:y10" "pl3:l2:y5:datum;y3:...;;y4:expr;y3:...;;y7:clauses;;;;l4:y2:if;l3:y10:"
":%25case-test;y3:key;l2:y5:datum;y3:...;;;l3:y5:begin;y4:expr;y3:...;;" "%25case-test;y3:key;l2:y5:datum;y3:...;;;l3:y4:body;y4:expr;y3:...;;py"
"py5:%25case;py3:key;y7:clauses;;;;;", "5:%25case;py3:key;y7:clauses;;;;;",
"S", "case", "S", "case",
"l3:y12:syntax-rules;n;l2:py1:_;py1:x;y7:clauses;;;l3:y3:let;l1:l2:y3:k" "l3:y12:syntax-rules;n;l2:py1:_;py1:x;y7:clauses;;;l3:y3:let;l1:l2:y3:k"
@ -120,9 +120,9 @@ char *s_code[] = {
"S", "do", "S", "do",
"l3:y12:syntax-rules;n;l2:l5:y1:_;l2:l4:y3:var;y4:init;y4:step;y3:...;;" "l3:y12:syntax-rules;n;l2:l5:y1:_;l2:l4:y3:var;y4:init;y4:step;y3:...;;"
"y3:...;;l3:y4:test;y4:expr;y3:...;;y7:command;y3:...;;l4:y3:let;y4:loo" "y3:...;;l3:y4:test;y4:expr;y3:...;;y7:command;y3:...;;l4:y3:let;y4:loo"
"p;l2:l2:y3:var;y4:init;;y3:...;;l4:y2:if;y4:test;l3:y5:begin;y4:expr;y" "p;l2:l2:y3:var;y4:init;;y3:...;;l4:y2:if;y4:test;l3:y4:body;y4:expr;y3"
"3:...;;l5:y3:let;n;y7:command;y3:...;l3:y4:loop;l4:y8:%25do-step;y3:va" ":...;;l5:y3:let;n;y7:command;y3:...;l3:y4:loop;l4:y8:%25do-step;y3:var"
"r;y4:step;y3:...;;y3:...;;;;;;", ";y4:step;y3:...;;y3:...;;;;;;",
"S", "quasiquote", "S", "quasiquote",
"l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote" "l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote"
@ -139,12 +139,12 @@ char *s_code[] = {
"2:y5:quote;y1:x;;;", "2:y5:quote;y1:x;;;",
"S", "when", "S", "when",
"l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;y4:test;py5" "l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;y4:test;py4"
":begin;y4:rest;;;;", ":body;y4:rest;;;;",
"S", "unless", "S", "unless",
"l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;l2:y3:not;y" "l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;l2:y3:not;y"
"4:test;;py5:begin;y4:rest;;;;", "4:test;;py4:body;y4:rest;;;;",
"S", "case-lambda", "S", "case-lambda",
"l3:y12:syntax-rules;n;l2:l3:y1:_;py4:args;y5:forms;;y3:...;;l3:y7:lamb" "l3:y12:syntax-rules;n;l2:l3:y1:_;py4:args;y5:forms;;y3:...;;l3:y7:lamb"
@ -710,21 +710,21 @@ char *s_code[] = {
"S", "%guard-aux", "S", "%guard-aux",
"l9:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l3:y1:_;y7:reraise;l4:y4:else" "l9:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l3:y1:_;y7:reraise;l4:y4:else"
";y7:result1;y7:result2;y3:...;;;l4:y5:begin;y7:result1;y7:result2;y3:." ";y7:result1;y7:result2;y3:...;;;l4:y4:body;y7:result1;y7:result2;y3:.."
"..;;;l2:l3:y1:_;y7:reraise;l3:y4:test;y2:=>;y6:result;;;l3:y3:let;l1:l" ".;;;l2:l3:y1:_;y7:reraise;l3:y4:test;y2:=>;y6:result;;;l3:y3:let;l1:l2"
"2:y4:temp;y4:test;;;l4:y2:if;y4:temp;l2:y6:result;y4:temp;;y7:reraise;" ":y4:temp;y4:test;;;l4:y2:if;y4:temp;l2:y6:result;y4:temp;;y7:reraise;;"
";;;l2:l6:y1:_;y7:reraise;l3:y4:test;y2:=>;y6:result;;y7:clause1;y7:cla" ";;l2:l6:y1:_;y7:reraise;l3:y4:test;y2:=>;y6:result;;y7:clause1;y7:clau"
"use2;y3:...;;l3:y3:let;l1:l2:y4:temp;y4:test;;;l4:y2:if;y4:temp;l2:y6:" "se2;y3:...;;l3:y3:let;l1:l2:y4:temp;y4:test;;;l4:y2:if;y4:temp;l2:y6:r"
"result;y4:temp;;l5:y10:%25guard-aux;y7:reraise;y7:clause1;y7:clause2;y" "esult;y4:temp;;l5:y10:%25guard-aux;y7:reraise;y7:clause1;y7:clause2;y3"
"3:...;;;;;l2:l3:y1:_;y7:reraise;l1:y4:test;;;l3:y2:or;y4:test;y7:rerai" ":...;;;;;l2:l3:y1:_;y7:reraise;l1:y4:test;;;l3:y2:or;y4:test;y7:rerais"
"se;;;l2:l6:y1:_;y7:reraise;l1:y4:test;;y7:clause1;y7:clause2;y3:...;;l" "e;;;l2:l6:y1:_;y7:reraise;l1:y4:test;;y7:clause1;y7:clause2;y3:...;;l3"
"3:y3:let;l1:l2:y4:temp;y4:test;;;l4:y2:if;y4:temp;y4:temp;l5:y10:%25gu" ":y3:let;l1:l2:y4:temp;y4:test;;;l4:y2:if;y4:temp;y4:temp;l5:y10:%25gua"
"ard-aux;y7:reraise;y7:clause1;y7:clause2;y3:...;;;;;l2:l3:y1:_;y7:rera" "rd-aux;y7:reraise;y7:clause1;y7:clause2;y3:...;;;;;l2:l3:y1:_;y7:rerai"
"ise;l4:y4:test;y7:result1;y7:result2;y3:...;;;l4:y2:if;y4:test;l4:y5:b" "se;l4:y4:test;y7:result1;y7:result2;y3:...;;;l4:y2:if;y4:test;l4:y4:bo"
"egin;y7:result1;y7:result2;y3:...;;y7:reraise;;;l2:l6:y1:_;y7:reraise;" "dy;y7:result1;y7:result2;y3:...;;y7:reraise;;;l2:l6:y1:_;y7:reraise;l4"
"l4:y4:test;y7:result1;y7:result2;y3:...;;y7:clause1;y7:clause2;y3:...;" ":y4:test;y7:result1;y7:result2;y3:...;;y7:clause1;y7:clause2;y3:...;;l"
";l4:y2:if;y4:test;l4:y5:begin;y7:result1;y7:result2;y3:...;;l5:y10:%25" "4:y2:if;y4:test;l4:y4:body;y7:result1;y7:result2;y3:...;;l5:y10:%25gua"
"guard-aux;y7:reraise;y7:clause1;y7:clause2;y3:...;;;;", "rd-aux;y7:reraise;y7:clause1;y7:clause2;y3:...;;;;",
"S", "guard", "S", "guard",
"l3:y12:syntax-rules;n;l2:l5:y5:guard;l3:y3:var;y6:clause;y3:...;;y2:e1" "l3:y12:syntax-rules;n;l2:l5:y5:guard;l3:y3:var;y6:clause;y3:...;;y2:e1"