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

once hack (mucho kluge!)

Browse source
This commit is contained in:
ESL 2024-07-10 11:02:56 -04:00
parent 1b113e59ec
commit 1c9e8d2b32
2 changed files with 40 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
src/t.scm
View file

@ -2055,7 +2055,7 @@
(define *verbose* #f) (define *verbose* #f)
(define *quiet* #f) (define *quiet* #f)
(define (repl-compile-and-run-core-expr core) #;(define (repl-compile-and-run-core-expr core)
(when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline)) (when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
(unless (val-core? core) (x-error "unexpected transformed output" core)) (unless (val-core? core) (x-error "unexpected transformed output" core))
(let ([code (compile-to-thunk-code core)] [start #f]) (let ([code (compile-to-thunk-code core)] [start #f])
@ -2069,6 +2069,35 @@
(display " ms.") (newline)) (display " ms.") (newline))
(unless (eq? res (void)) (write res) (newline))))) (unless (eq? res (void)) (write res) (newline)))))
(define (repl-compile-and-run-core-expr core)
(define start #f)
(define (compile-and-run core)
(define code (compile-to-thunk-code core))
(define cl (closure (deserialize-code code)))
(define vals (call-with-values cl list))
(for-each (lambda (v) (unless (void? v) (write v) (newline))) vals))
(when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
(unless (val-core? core) (x-error "unexpected transformed output" core))
(set! start (current-jiffy))
(let loop ([cores (list core)])
(unless (null? cores)
(let ([first (car cores)] [rest (cdr cores)])
(record-case first
[begin exps
(loop (append exps rest))]
[once (gid exp)
(compile-and-run first)
; this 'once' is done and there is no need to keep it around
(set-car! first 'begin) (set-cdr! first '()) ; mucho kluge!
(loop rest)]
[else
(compile-and-run first)
(loop rest)]))))
(when *verbose*
(display "Elapsed time: ") (write (* 1000 (/ (- (current-jiffy) start) (jiffies-per-second))))
(display " ms.") (newline)))
(define (repl-eval-top-form x env) (define (repl-eval-top-form x env)
(if (pair? x) (if (pair? x)
(let ([hval (xform #t (car x) env)]) ; returns <core> (let ([hval (xform #t (car x) env)]) ; returns <core>

16
t.c
View file

@ -1299,12 +1299,16 @@ char *t_code[] = {
"f@!(y7:*quiet*)", "f@!(y7:*quiet*)",
"P", "repl-compile-and-run-core-expr", "P", "repl-compile-and-run-core-expr",
"%1@(y9:*verbose*)?{Po,'(s12:TRANSFORM =>)W4PoW6Po,.1W5PoW6}.0p~?{${.2," "%1,,#0#1f.!0&0{%1,,,#0#1#2${.5,@(y21:compile-to-thunk-code)[01}.!0.0^U"
"'(s29:unexpected transformed output),@(y7:x-error)[02}}f,${.3,@(y21:co" "4,U91.!1${@(y4:list),.4^,@(y16:call-with-values)[02}.!2.2^,&0{%1.0Y8~?"
"mpile-to-thunk-code)[01},#1@(y9:*verbose*)?{Po,'(s20:COMPILE-TO-STRING" "{Po,.1W5PoW6]1}]1},@(y10:%25for-each1)[42}.!1@(y9:*verbose*)?{Po,'(s12"
" =>)W4PoW6Po,.1W4PoW6Po,'(s17:DECODE+EXECUTE =>)W4PoW6Z3.!1}.0U4,U91,$" ":TRANSFORM =>)W4PoW6Po,.3W5PoW6}.2p~?{${.4,'(s29:unexpected transforme"
"{.2[00},@(y9:*verbose*)?{Po,'(s14:Elapsed time: )W4Po,Z4,.5^,Z3-/,'(i1" "d output),@(y7:x-error)[02}}Z3.!0${.4,l1,,#0.0,.6,&2{%1.0u~?{.0d,.1a,'"
"000)*W5Po,'(s4: ms.)W4PoW6}Y9,.1q~?{Po,.1W5PoW6]5}]5", "(y5:begin),.1aq?{.0d,.2,:1,&2{%!0:1,.1L6,:0^[11},@(y13:apply-to-list)["
"32}'(y4:once),.1aq?{.0d,:1,.3,.3,:0,&4{%2${:1,:0^[01}'(y5:begin),:1san"
",:1sd:2,:3^[21},@(y13:apply-to-list)[32}${.2,:0^[01}.1,:1^[31}]1}.!0.0"
"^_1[01}@(y9:*verbose*)?{Po,'(s14:Elapsed time: )W4Po,Z4,.2^,Z3-/,'(i10"
"00)*W5Po,'(s4: ms.)W4PoW6]3}]3",
"P", "repl-eval-top-form", "P", "repl-eval-top-form",
"%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1." "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1."