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 Actions

top-level idless define fix (eval)

Browse source
This commit is contained in:
dermagen 2024-06-14 15:12:42 -04:00
parent 8964bbdab5
commit 21e470522d
2 changed files with 48 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
src/t.scm
View file

@ -1834,44 +1834,47 @@
(let ([hval (xform #t (car x) env)]) (let ([hval (xform #t (car x) env)])
(cond (cond
[(eq? hval 'begin) [(eq? hval 'begin)
; splice ; splice
(let loop ([x* (cdr x)]) (let loop ([x* (cdr x)])
(when (pair? x*) (when (pair? x*)
(repl-eval-top-form (car x*) env) (repl-eval-top-form (car x*) env)
(loop (cdr x*))))] (loop (cdr x*))))]
[(and (eq? hval 'define) (null? (cadr x)))
; special idless define
(repl-eval-top-form (caddr x) env)]
[(eq? hval 'define) [(eq? hval 'define)
; use new protocol for top-level envs ; use new protocol for top-level envs
(let* ([core (xform-define (cdr x) env)] (let* ([core (xform-define (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define)]) [loc (xenv-lookup env (cadr core) 'define)])
(if (and loc (sexp-match? '(ref *) (location-val loc))) (if (and loc (sexp-match? '(ref *) (location-val loc)))
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(list 'set! (cadr (location-val loc)) (caddr core))) (list 'set! (cadr (location-val loc)) (caddr core)))
(x-error "identifier cannot be (re)defined in env:" (x-error "identifier cannot be (re)defined in env:"
(cadr core) env)))] (cadr core) env)))]
[(eq? hval 'define-syntax) [(eq? hval 'define-syntax)
; use new protocol for top-level envs ; use new protocol for top-level envs
(let* ([core (xform-define-syntax (cdr x) env)] (let* ([core (xform-define-syntax (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define-syntax)]) [loc (xenv-lookup env (cadr core) 'define-syntax)])
(if loc ; location or #f (if loc ; location or #f
(location-set-val! loc (caddr core)) (location-set-val! loc (caddr core))
(x-error "identifier cannot be (re)defined as syntax in env:" (x-error "identifier cannot be (re)defined as syntax in env:"
(cadr core) env)) (cadr core) env))
(when *verbose* (display "SYNTAX INSTALLED: ") (write (cadr core)) (newline)))] (when *verbose* (display "SYNTAX INSTALLED: ") (write (cadr core)) (newline)))]
[(procedure? hval) [(procedure? hval)
; transformer: apply and loop ; transformer: apply and loop
(repl-eval-top-form (hval x env) env)] (repl-eval-top-form (hval x env) env)]
[(integrable? hval) [(integrable? hval)
; integrable application ; integrable application
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(xform-integrable hval (cdr x) env))] (xform-integrable hval (cdr x) env))]
[(symbol? hval) [(symbol? hval)
; other specials ; other specials
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(xform #f x env))] (xform #f x env))]
[else [else
; regular call ; regular call
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(xform-call hval (cdr x) env))])) (xform-call hval (cdr x) env))]))
; var refs and literals ; var refs and literals
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(xform #f x env)))) (xform #f x env))))

29
t.c
View file

@ -1033,20 +1033,21 @@ char *t_code[] = {
"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."
"0p?{${:1,.3a,@(y18:repl-eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(" "0p?{${:1,.3a,@(y18:repl-eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'("
"y6:define),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,." "y6:define),.1q?{.1dau}{f}?{.2,.2dda,@(y18:repl-eval-top-form)[32}'(y6:"
"7,@(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match" "define),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@"
"?)[02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-core-" "(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)["
"expr)[51}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:" "02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-core-exp"
"x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-synt" "r)[51}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:x-e"
"ax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dd" "rror)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)"
"a,.1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as syntax in " "[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,."
"env:),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INSTALLED: )W" "1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as syntax in env"
"4Po,.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form)[" ":),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INSTALLED: )W4Po"
"32}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-an" ",.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form)[32}"
"d-run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compile" ".0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-and-r"
"-and-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-co" "un-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compile-an"
"mpile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-compi" "d-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-compi"
"le-and-run-core-expr)[21", "le-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-compile-"
"and-run-core-expr)[21",
"P", "repl-read", "P", "repl-read",
"%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21", "%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21",