mirror of
https://github.com/false-schemers/skint.git
synced 2025-01-18 10:26:29 +01:00
first working REPL in t.scm
This commit is contained in:
parent
547c29df64
commit
abb022005b
2 changed files with 165 additions and 36 deletions
143
src/t.scm
143
src/t.scm
|
@ -1198,8 +1198,16 @@
|
||||||
; Evaluation
|
; Evaluation
|
||||||
;---------------------------------------------------------------------------------------------
|
;---------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(define *reset* #f)
|
||||||
|
|
||||||
(define (error* msg args)
|
(define (error* msg args)
|
||||||
(apply error (cons msg args)))
|
(if (procedure? *reset*)
|
||||||
|
(let ([p (current-error-port)])
|
||||||
|
(display msg p) (newline p)
|
||||||
|
(for-each (lambda (arg) (write arg p) (newline p)) args)
|
||||||
|
(*reset* #f))
|
||||||
|
(apply error (cons msg args))))
|
||||||
|
|
||||||
|
|
||||||
; transformation of top-level form should process begin, define, and define-syntax
|
; transformation of top-level form should process begin, define, and define-syntax
|
||||||
; explicitly, so that they can produce and observe side effects on env
|
; explicitly, so that they can produce and observe side effects on env
|
||||||
|
@ -1302,40 +1310,6 @@
|
||||||
(let* ([cl (closure (deserialize-code code))] [r (cl)])
|
(let* ([cl (closure (deserialize-code code))] [r (cl)])
|
||||||
(when *verbose* (write r) (newline)))))
|
(when *verbose* (write r) (newline)))))
|
||||||
|
|
||||||
#|
|
|
||||||
(define (transform! x)
|
|
||||||
(let ([t (xform #t x root-environment)])
|
|
||||||
(when (and (syntax-match? '(define-syntax * *) t) (id? (cadr t))) ; (procedure? (caddr t))
|
|
||||||
(let ([loc (root-environment (cadr t))])
|
|
||||||
(when loc (location-set-val! loc (caddr t)))))
|
|
||||||
t))
|
|
||||||
|
|
||||||
(define (visit f)
|
|
||||||
(define p (open-input-file f))
|
|
||||||
(let loop ([x (read p)])
|
|
||||||
(unless (eof-object? x)
|
|
||||||
(let ([t (transform! x)])
|
|
||||||
(write t)
|
|
||||||
(newline))
|
|
||||||
(loop (read p))))
|
|
||||||
(close-input-port p))
|
|
||||||
|
|
||||||
(define (visit/c f)
|
|
||||||
(define p (open-input-file f))
|
|
||||||
(let loop ([x (read p)])
|
|
||||||
(unless (eof-object? x)
|
|
||||||
(let ([t (transform! x)])
|
|
||||||
(write t) (newline)
|
|
||||||
(let exec ([x t])
|
|
||||||
(record-case x
|
|
||||||
[begin x* (for-each exec x*)]
|
|
||||||
[define (i v) (exec (list 'set! i v))]
|
|
||||||
[define-syntax (i m)]
|
|
||||||
[else (write (compile-to-thunk-code x)) (newline)])))
|
|
||||||
(loop (read p))))
|
|
||||||
(close-input-port p))
|
|
||||||
|#
|
|
||||||
|
|
||||||
(define (visit/v f)
|
(define (visit/v f)
|
||||||
(define p (open-input-file f))
|
(define p (open-input-file f))
|
||||||
(let loop ([x (read p)])
|
(let loop ([x (read p)])
|
||||||
|
@ -1356,3 +1330,102 @@
|
||||||
(loop (read p))))
|
(loop (read p))))
|
||||||
(close-input-port p))
|
(close-input-port p))
|
||||||
|
|
||||||
|
|
||||||
|
;---------------------------------------------------------------------------------------------
|
||||||
|
; REPL
|
||||||
|
;---------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(define (repl-environment id at) ; FIXME: need to happen in a "repl." namespace
|
||||||
|
(env-lookup id *root-environment* at))
|
||||||
|
|
||||||
|
(define (repl-compile-and-run-core-expr core)
|
||||||
|
(when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
|
||||||
|
(unless (pair? core) (x-error "unexpected transformed output" core))
|
||||||
|
(let ([code (compile-to-thunk-code core)] [start #f])
|
||||||
|
(when *verbose*
|
||||||
|
(display "COMPILE-TO-STRING =>") (newline) (display code) (newline)
|
||||||
|
(display "DECODE+EXECUTE =>") (newline)
|
||||||
|
(set! start (current-jiffy)))
|
||||||
|
(let* ([cl (closure (deserialize-code code))] [res (cl)])
|
||||||
|
(when *verbose*
|
||||||
|
(display "Elapsed time: ") (write (* 1000 (/ (- (current-jiffy) start) (jiffies-per-second))))
|
||||||
|
(display " ms.") (newline))
|
||||||
|
(unless (eq? res (void)) (write res) (newline)))))
|
||||||
|
|
||||||
|
(define (repl-eval-top-form x env)
|
||||||
|
(letcc catch
|
||||||
|
(set! *reset* catch)
|
||||||
|
(if (pair? x)
|
||||||
|
(let ([hval (xform #t (car x) env)])
|
||||||
|
(cond
|
||||||
|
[(eq? hval 'begin)
|
||||||
|
; splice
|
||||||
|
(let loop ([x* (cdr x)])
|
||||||
|
(when (pair? x*)
|
||||||
|
(repl-eval-top-form (car x*) env)
|
||||||
|
(loop (cdr x*))))]
|
||||||
|
[(eq? hval 'define)
|
||||||
|
; use new protocol for top-level envs
|
||||||
|
(let* ([core (xform-define (cdr x) env)]
|
||||||
|
[loc (xenv-lookup env (cadr core) 'define)])
|
||||||
|
(if (and loc (syntax-match? '(ref *) (location-val loc)))
|
||||||
|
(repl-compile-and-run-core-expr
|
||||||
|
(list 'set! (cadr (location-val loc)) (caddr core)))
|
||||||
|
(x-error "identifier cannot be (re)defined in env:"
|
||||||
|
(cadr core) env)))]
|
||||||
|
[(eq? hval 'define-syntax)
|
||||||
|
; use new protocol for top-level envs
|
||||||
|
(let* ([core (xform-define-syntax (cdr x) env)]
|
||||||
|
[loc (xenv-lookup env (cadr core) 'define-syntax)])
|
||||||
|
(if loc ; location or #f
|
||||||
|
(location-set-val! loc (caddr core))
|
||||||
|
(x-error "identifier cannot be (re)defined as syntax in env:"
|
||||||
|
(cadr core) env))
|
||||||
|
(when *verbose* (display "SYNTAX INSTALLED: ") (write (cadr core)) (newline)))]
|
||||||
|
[(procedure? hval)
|
||||||
|
; transformer: apply and loop
|
||||||
|
(repl-eval-top-form (hval x env) env)]
|
||||||
|
[(integrable? hval)
|
||||||
|
; integrable application
|
||||||
|
(repl-compile-and-run-core-expr
|
||||||
|
(xform-integrable hval (cdr x) env))]
|
||||||
|
[(symbol? hval)
|
||||||
|
; other specials
|
||||||
|
(repl-compile-and-run-core-expr
|
||||||
|
(xform #f x env))]
|
||||||
|
[else
|
||||||
|
; regular call
|
||||||
|
(repl-compile-and-run-core-expr
|
||||||
|
(xform-call hval (cdr x) env))]))
|
||||||
|
; var refs and literals
|
||||||
|
(repl-compile-and-run-core-expr
|
||||||
|
(xform #f x env)))))
|
||||||
|
|
||||||
|
(define (repl-read iport)
|
||||||
|
(when (eq? iport (current-input-port))
|
||||||
|
(display "\nskint] "))
|
||||||
|
(read iport))
|
||||||
|
|
||||||
|
(define (repl-from-port iport)
|
||||||
|
(let loop ([x (repl-read iport)])
|
||||||
|
(unless (eof-object? x)
|
||||||
|
(repl-eval-top-form x repl-environment)
|
||||||
|
(loop (repl-read iport)))))
|
||||||
|
|
||||||
|
(define (repl-file fname)
|
||||||
|
(define iport (open-input-file fname))
|
||||||
|
(repl-from-port iport)
|
||||||
|
(close-input-port iport))
|
||||||
|
|
||||||
|
(define (benchmark-file fname)
|
||||||
|
(define iport (open-input-file fname))
|
||||||
|
(unless (syntax-match? '(load "libl.sf") (read iport))
|
||||||
|
(error "unexpected benchmark file format" fname))
|
||||||
|
(repl-from-port iport)
|
||||||
|
(repl-eval-top-form '(main #f) repl-environment)
|
||||||
|
(close-input-port iport))
|
||||||
|
|
||||||
|
(define (run-repl)
|
||||||
|
(repl-from-port (current-input-port)))
|
||||||
|
|
||||||
|
|
||||||
|
|
58
t.c
58
t.c
|
@ -570,8 +570,13 @@ char *t_code[] = {
|
||||||
"P", "root-environment",
|
"P", "root-environment",
|
||||||
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
|
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
|
||||||
|
|
||||||
|
"C", 0,
|
||||||
|
"f@!(y7:*reset*)",
|
||||||
|
|
||||||
"P", "error*",
|
"P", "error*",
|
||||||
"%2.1,.1c,@(y5:error),@(y13:apply-to-list)[22",
|
"%2@(y7:*reset*)K0?{Pe,.0,.2W4.0W6${.4,.3,&1{%1:0,.1W5:0W6]1},@(y10:%25"
|
||||||
|
"for-each1)[02}f,@(y7:*reset*)[31}.1,.1c,@(y5:error),@(y13:apply-to-lis"
|
||||||
|
"t)[22",
|
||||||
|
|
||||||
"P", "visit-top-form",
|
"P", "visit-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."
|
||||||
|
@ -622,5 +627,56 @@ char *t_code[] = {
|
||||||
",@(y13:eval-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y4:read)[01},:0"
|
",@(y13:eval-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y4:read)[01},:0"
|
||||||
"^[11}]1}.!0.0^_1[01}.0^P60]2",
|
"^[11}]1}.!0.0^_1[01}.0^P60]2",
|
||||||
|
|
||||||
|
"P", "repl-environment",
|
||||||
|
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
|
||||||
|
|
||||||
|
"P", "repl-compile-and-run-core-expr",
|
||||||
|
"%1@(y9:*verbose*)?{Po,'(s12:TRANSFORM =>)W4PoW6Po,.1W5PoW6}.0p~?{${.2,"
|
||||||
|
"'(s29:unexpected transformed output),@(y7:x-error)[02}}f,${.3,@(y21:co"
|
||||||
|
"mpile-to-thunk-code)[01},#1@(y9:*verbose*)?{Po,'(s20:COMPILE-TO-STRING"
|
||||||
|
" =>)W4PoW6Po,.1W4PoW6Po,'(s17:DECODE+EXECUTE =>)W4PoW6Z3.!1}.0U4,U91,$"
|
||||||
|
"{.2[00},@(y9:*verbose*)?{Po,'(s14:Elapsed time: )W4Po,Z4,.5^,Z3-/,'(i1"
|
||||||
|
"000)*W5Po,'(s4: ms.)W4PoW6}Y9,.1q~?{Po,.1W5PoW6]5}]5",
|
||||||
|
|
||||||
|
"P", "repl-eval-top-form",
|
||||||
|
"%2k2,.0@!(y7:*reset*).1p?{${.4,.4a,t,@(y5:xform)[03},'(y5:begin),.1q?{"
|
||||||
|
".2d,,#0.5,.1,&2{%1.0p?{${:1,.3a,@(y18:repl-eval-top-form)[02}.0d,:0^[1"
|
||||||
|
"1}]1}.!0.0^_1[41}'(y6:define),.1q?{${.5,.5d,@(y12:xform-define)[02},${"
|
||||||
|
"'(y6:define),.3da,.8,@(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*"
|
||||||
|
";),@(y13:syntax-match?)[02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-"
|
||||||
|
"compile-and-run-core-expr)[61}.5,.2da,'(s40:identifier cannot be (re)d"
|
||||||
|
"efined in env:),@(y7:x-error)[63}'(y13:define-syntax),.1q?{${.5,.5d,@("
|
||||||
|
"y19:xform-define-syntax)[02},${'(y13:define-syntax),.3da,.8,@(y11:xenv"
|
||||||
|
"-lookup)[03},.0?{.1dda,.1sz}{${.7,.4da,'(s50:identifier cannot be (re)"
|
||||||
|
"defined as syntax in env:),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18"
|
||||||
|
":SYNTAX INSTALLED: )W4Po,.2daW5PoW6]6}]6}.0K0?{.3,${.6,.6,.5[02},@(y18"
|
||||||
|
":repl-eval-top-form)[42}.0U0?{${.5,.5d,.4,@(y16:xform-integrable)[03},"
|
||||||
|
"@(y30:repl-compile-and-run-core-expr)[41}.0Y0?{${.5,.5,f,@(y5:xform)[0"
|
||||||
|
"3},@(y30:repl-compile-and-run-core-expr)[41}${.5,.5d,.4,@(y10:xform-ca"
|
||||||
|
"ll)[03},@(y30:repl-compile-and-run-core-expr)[41}${.4,.4,f,@(y5:xform)"
|
||||||
|
"[03},@(y30:repl-compile-and-run-core-expr)[31",
|
||||||
|
|
||||||
|
"P", "repl-read",
|
||||||
|
"%1Pi,.1q?{Po,'(s8:%0askint] )W4}.0,@(y4:read)[11",
|
||||||
|
|
||||||
|
"P", "repl-from-port",
|
||||||
|
"%1${.2,@(y9:repl-read)[01},,#0.2,.1,&2{%1.0R8~?{${@(y16:repl-environme"
|
||||||
|
"nt),.3,@(y18:repl-eval-top-form)[02}${:1,@(y9:repl-read)[01},:0^[11}]1"
|
||||||
|
"}.!0.0^_1[11",
|
||||||
|
|
||||||
|
"P", "repl-file",
|
||||||
|
"%1,#0${.3,@(y15:open-input-file)[01}.!0${.2^,@(y14:repl-from-port)[01}"
|
||||||
|
".0^P60]2",
|
||||||
|
|
||||||
|
"P", "benchmark-file",
|
||||||
|
"%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},'(l2:y4:"
|
||||||
|
"load;s7:libl.sf;),@(y13:syntax-match?)[02}~?{${.3,'(s32:unexpected ben"
|
||||||
|
"chmark file format),@(y5:error)[02}}${.2^,@(y14:repl-from-port)[01}${@"
|
||||||
|
"(y16:repl-environment),'(l2:y4:main;f;),@(y18:repl-eval-top-form)[02}."
|
||||||
|
"0^P60]2",
|
||||||
|
|
||||||
|
"P", "run-repl",
|
||||||
|
"%0Pi,@(y14:repl-from-port)[01",
|
||||||
|
|
||||||
0, 0, 0
|
0, 0, 0
|
||||||
};
|
};
|
||||||
|
|
Loading…
Reference in a new issue