mirror of
https://github.com/false-schemers/skint.git
synced 2025-01-13 20:03:30 +01:00
first working REPL in t.scm
This commit is contained in:
ESL
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
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define *reset* #f)
|
||||
|
||||
(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
|
||||
; explicitly, so that they can produce and observe side effects on env
|
||||
|
|
@ -1302,40 +1310,6 @@
|
|||
(let* ([cl (closure (deserialize-code code))] [r (cl)])
|
||||
(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 p (open-input-file f))
|
||||
(let loop ([x (read p)])
|
||||
|
|
@ -1356,3 +1330,102 @@
|
|||
(loop (read 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",
|
||||
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
|
||||
|
||||
"C", 0,
|
||||
"f@!(y7:*reset*)",
|
||||
|
||||
"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",
|
||||
"%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"
|
||||
"^[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
|
||||
};
|
||||
|
|
|
|||
Loading…
Reference in a new issue