mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
ready for env switch; repl commands
This commit is contained in:
ESL
parent
666ace8461
commit
6caa364255
2 changed files with 117 additions and 31 deletions
79
src/t.scm
79
src/t.scm
|
|
@ -880,6 +880,7 @@
|
|||
(return (car ic&ex) (cdr ic&ex)))]
|
||||
[(and (list1+? s) (andmap libpart? s))
|
||||
; NB: this is 1/3 of listname->library interface
|
||||
; FIXME: should lookup in env using listname!
|
||||
(let* ([listname (xform-sexp->datum s)] [sym (listname->symbol listname)]
|
||||
[id (id-rename-as sid sym)] [val (xform-ref id env)]) ; or should id be just sym?
|
||||
(unless (val-library? val) (x-error "invalid library" listname val))
|
||||
|
|
@ -960,6 +961,7 @@
|
|||
|
||||
; make functional read-only environment from import al,
|
||||
; allowing fall-through to env for lib://foo/bar ids
|
||||
; FIXME: should be replaced with make-controlled-environment
|
||||
(define (ial->controlled-environment ial make-nid env)
|
||||
(let ([v (make-vector 1 '())]) ; new ids go here
|
||||
(lambda (id at)
|
||||
|
|
@ -993,7 +995,7 @@
|
|||
[decls (if lid (cddr sexp) (cdr sexp))] ; NB: mac env is used below to resolve lib names!
|
||||
[icimesfs (preprocess-library-declarations (cons (car sexp) decls) env)])
|
||||
(let* ([code (car icimesfs)] [ial (cadr icimesfs)] [esps (caddr icimesfs)] [forms (cadddr icimesfs)]
|
||||
[cenv (ial->controlled-environment ial make-nid env)] [eal '()])
|
||||
[cenv (ial->controlled-environment ial make-nid env)] [eal '()]) ; FIXME
|
||||
(define (scan body code*) ;=> extended with side-effect on cenv
|
||||
(if (null? body)
|
||||
code*
|
||||
|
|
@ -1052,7 +1054,7 @@
|
|||
(let* ([name (xform-sexp->datum (car tail))] [sym (if (symbol? name) name (listname->symbol name))]
|
||||
[libform (cons head (cons sym (cdr tail)))] ; head is used as seed id for renamings
|
||||
[ic&ex (preprocess-library libform env)] [lid (id-rename-as head sym)])
|
||||
; NB: this is 1/3 of listname->library interface
|
||||
; NB: this is 1/3 of listname->library interface FIXME: lid should be listname!
|
||||
(list 'define-library lid (make-library (car ic&ex) (cdr ic&ex))))
|
||||
(x-error "improper define-library form" (cons head tail))))
|
||||
|
||||
|
|
@ -1062,7 +1064,7 @@
|
|||
(define (xform-import head tail env appos?) ; non-internal
|
||||
(if (list? tail)
|
||||
(let ([ic&ex (preprocess-import-sets (cons head tail) env)])
|
||||
; NB: this is 1/3 of listname->library interface
|
||||
; NB: this is 1/3 of listname->library interface FIXME
|
||||
(list 'import (make-library (car ic&ex) (cdr ic&ex))))
|
||||
(x-error "improper import form" (cons head tail))))
|
||||
|
||||
|
|
@ -1708,15 +1710,18 @@
|
|||
(let ([p (listname->path listname (car l) ".sld")])
|
||||
(if (and p (file-exists? p)) p (loop (cdr l)))))))
|
||||
|
||||
(define (read-port-sexps port)
|
||||
(let loop ([sexps '()])
|
||||
(let ([s (read-code-sexp port)])
|
||||
(if (eof-object? s)
|
||||
(reverse! sexps)
|
||||
(loop (cons s sexps))))))
|
||||
|
||||
(define (read-file-sexps filepath ci?)
|
||||
(call-with-input-file filepath
|
||||
(lambda (port)
|
||||
(when ci? (set-port-fold-case! port #t))
|
||||
(let loop ([sexps '()])
|
||||
(let ([s (read-code-sexp port)])
|
||||
(if (eof-object? s)
|
||||
(reverse! sexps)
|
||||
(loop (cons s sexps))))))))
|
||||
(read-port-sexps port))))
|
||||
|
||||
(define (library-available? lib) ;=> #f | filepath (external) | (code . eal) (loaded)
|
||||
(cond [(string? lib) (file-resolve-relative-to-current lib)]
|
||||
|
|
@ -1730,7 +1735,7 @@
|
|||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Environments
|
||||
; Environments FIXME
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; new lookup procedure for explicit macro environments
|
||||
|
|
@ -1827,19 +1832,21 @@
|
|||
(let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))]
|
||||
[al (vector-ref nr i)] [p (if (pair? name) (assoc name al) (assq name al))])
|
||||
(cond [p (cdr p)]
|
||||
[mkdefval
|
||||
(let ([loc (make-location (mkdefval name))])
|
||||
(vector-set! nr i (cons (cons name loc) al))
|
||||
loc)]
|
||||
[mkdefval ; got callback for missing bindings? use it:
|
||||
(let ([val (mkdefval name)]) ; check if it didn't fail:
|
||||
(cond [(not val) #f] ; mkdefval rejected the idea
|
||||
[(location? val) val] ; found good location elsewhere
|
||||
[else (let ([loc (make-location val)]) ; ok, put it in:
|
||||
(vector-set! nr i (cons (cons name loc) al))
|
||||
loc)]))]
|
||||
[else #f])))
|
||||
|
||||
; register integrable procedures
|
||||
(let loop ([i 0])
|
||||
(let ([li (lookup-integrable i)])
|
||||
(let ([li (lookup-integrable i)]) ;=> #f, #<void>, or integrable (li == i)
|
||||
(when li ; in range: void or integrable
|
||||
(when (integrable? i)
|
||||
(let ([name (integrable-global i)])
|
||||
;(display "integrable[") (write i) (display "] = ") (write name) (newline)
|
||||
(when (symbol? name) (name-lookup *root-name-registry* name (lambda (name) i)))))
|
||||
(loop (+ i 1)))))
|
||||
|
||||
|
|
@ -1862,6 +1869,11 @@
|
|||
(name-lookup *root-name-registry* k (lambda (name) sr-v))
|
||||
(loop l))]))))
|
||||
|
||||
; register handcoded transformers
|
||||
(name-lookup *root-name-registry* 'include (lambda (name) (make-include-transformer #f)))
|
||||
(name-lookup *root-name-registry* 'include-ci (lambda (name) (make-include-transformer #t)))
|
||||
(name-lookup *root-name-registry* 'cond-expand (lambda (name) (make-cond-expand-transformer)))
|
||||
|
||||
; register standard libraries as well as (repl) library for interactive environment
|
||||
; ... while doing that, bind missing standard names as refs to constant globals
|
||||
(for-each
|
||||
|
|
@ -1879,7 +1891,7 @@
|
|||
(name-lookup *root-name-registry* listname
|
||||
(lambda (ln)
|
||||
(let ([l (make-library '(begin) '())])
|
||||
; for now, mirror libraries in old registry too... FIXME!
|
||||
; for now, mirror libraries in old registry too... FIXME: just return l
|
||||
(define-in-root-environment! (listname->symbol listname) (make-location l) #t)
|
||||
l)))))
|
||||
(define (put-loc! library k loc)
|
||||
|
|
@ -2047,6 +2059,37 @@
|
|||
(when prompt (newline) (display prompt) (display " "))
|
||||
(read-code-sexp iport))
|
||||
|
||||
(define (repl-exec-command cmd argstr op)
|
||||
(define args
|
||||
(guard (err [else (void)])
|
||||
(read-port-sexps (open-input-string argstr))))
|
||||
(define cmd+args (cons cmd args))
|
||||
(sexp-case cmd+args
|
||||
[(say hello) (display "Well, hello!\n" op)]
|
||||
[(ref <symbol>) (write (repl-environment (car args) 'ref) op) (newline op)]
|
||||
[(ref (* * ...)) (write (repl-environment (car args) 'ref) op) (newline op)]
|
||||
[(peek *)
|
||||
(cond [(string? (car args))
|
||||
(display (if (file-exists? (car args))
|
||||
"file exists\n" "file does not exist\n") op)]
|
||||
[(symbol? (car args))
|
||||
(display (if (file-exists? (symbol->string (car args)))
|
||||
"file exists\n" "file does not exist\n") op)]
|
||||
[else (display "invalid file name; use double quotes\n" op)])]
|
||||
[(verbose on) (set! *verbose* #t)]
|
||||
[(verbose off) (set! *verbose* #f)]
|
||||
[(help)
|
||||
(display "Available commands:\n" op)
|
||||
(display " ,say hello -- displays nice greeting\n" op)
|
||||
(display " ,peek <fname> -- check if file exists\n" op)
|
||||
(display " ,verbose on -- turn verbosity on\n" op)
|
||||
(display " ,verbose off -- turn verbosity off\n" op)
|
||||
(display " ,ref <name> -- show current denotation for <name>\n" op)
|
||||
(display " ,help -- this help\n" op)]
|
||||
[else
|
||||
(display "syntax error in repl command\n" op)
|
||||
(display "type ,help to see available commands\n" op)]))
|
||||
|
||||
(define (repl-from-port iport env prompt)
|
||||
(define cfs (current-file-stack))
|
||||
(guard (err
|
||||
|
|
@ -2065,7 +2108,9 @@
|
|||
(when prompt (repl-from-port iport env prompt))])
|
||||
(let loop ([x (repl-read iport prompt)])
|
||||
(unless (eof-object? x)
|
||||
(repl-eval-top-form x env)
|
||||
(if (and prompt (sexp-match? '(unquote *) x))
|
||||
(repl-exec-command (cadr x) (read-line iport) (current-output-port))
|
||||
(repl-eval-top-form x env))
|
||||
(loop (repl-read iport prompt))))))
|
||||
|
||||
(define (repl-file fname env)
|
||||
|
|
|
|||
69
t.c
69
t.c
|
|
@ -955,10 +955,13 @@ char *t_code[] = {
|
|||
"%1@(y19:*library-path-list*),,#0.0,.3,&2{%1.0p?{${'(s4:.sld),.3a,:0,@("
|
||||
"y14:listname->path)[03},.0?{.0F0}{f}?{.0]2}.1d,:1^[21}f]1}.!0.0^_1[11",
|
||||
|
||||
"P", "read-port-sexps",
|
||||
"%1n,,#0.2,.1,&2{%1${:1,@(y14:read-code-sexp)[01},.0R8?{.1A9]2}.1,.1c,:"
|
||||
"0^[21}.!0.0^_1[11",
|
||||
|
||||
"P", "read-file-sexps",
|
||||
"%2.1,&1{%1:0?{t,.1P79}n,,#0.2,.1,&2{%1${:1,@(y14:read-code-sexp)[01},."
|
||||
"0R8?{.1A9]2}.1,.1c,:0^[21}.!0.0^_1[11},.1,@(y20:call-with-input-file)["
|
||||
"22",
|
||||
"%2.1,&1{%1:0?{t,.1P79}.0,@(y15:read-port-sexps)[11},.1,@(y20:call-with"
|
||||
"-input-file)[22",
|
||||
|
||||
"P", "library-available?",
|
||||
"%1.0S0?{.0,@(y32:file-resolve-relative-to-current)[11}${f,.3,@(y12:lib"
|
||||
|
|
@ -1013,7 +1016,7 @@ char *t_code[] = {
|
|||
|
||||
"P", "name-lookup",
|
||||
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}"
|
||||
".6?{${.7,.9[01}b,.2,.1,.8cc,.4,.7V5.0]8}f]7",
|
||||
".6?{${.7,.9[01},.0~?{f]8}.0Y2?{.0]8}.0b,.3,.1,.9cc,.5,.8V5.0]9}f]7",
|
||||
|
||||
"C", 0,
|
||||
"${'0,,#0.0,&1{%1.0U5,.0?{.1U0?{.1U7,.0Y0?{${.4,&1{%1:0]1},.3,@(y20:*ro"
|
||||
|
|
@ -1029,6 +1032,18 @@ char *t_code[] = {
|
|||
"[04}}.!1${.3,&1{%1:0^]1},.6,@(y20:*root-name-registry*),@(y11:name-loo"
|
||||
"kup)[03}.4,:0^[71}f]5}]1}.!0.0^_1[01}",
|
||||
|
||||
"C", 0,
|
||||
"${&0{%1f,@(y24:make-include-transformer)[11},'(y7:include),@(y20:*root"
|
||||
"-name-registry*),@(y11:name-lookup)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${&0{%1t,@(y24:make-include-transformer)[11},'(y10:include-ci),@(y20:*"
|
||||
"root-name-registry*),@(y11:name-lookup)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${&0{%1@(y28:make-cond-expand-transformer)[10},'(y11:cond-expand),@(y2"
|
||||
"0:*root-name-registry*),@(y11:name-lookup)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l343:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y"
|
||||
"3:...;y1:v;y1:u;y1:b;;l3:y1:/;y1:v;y1:b;;l3:y1:<;y1:v;y1:b;;l3:y2:<=;y"
|
||||
|
|
@ -1223,19 +1238,45 @@ char *t_code[] = {
|
|||
"P", "repl-read",
|
||||
"%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21",
|
||||
|
||||
"P", "repl-exec-command",
|
||||
"%3,,#0#1${${k0,.0,${.2,.(i12),&2{%0:1,&1{%!0.0,&1{%0:0,@(y6:values),@("
|
||||
"y13:apply-to-list)[02},:0[11},:0,&1{%0:0P50,@(y15:read-port-sexps)[01}"
|
||||
",@(y16:call-with-values)[02},.3,&1{%1${k0,.0,${.6,&1{%0:0,Y9]1},:0[01}"
|
||||
"_1_3}[10},@(y22:with-exception-handler)[02}_1_3}[00}.!0.0^,.3c.!1${.3^"
|
||||
",'(l2:y3:say;y5:hello;),@(y11:sexp-match?)[02}?{.4,'(s13:Well, hello!%"
|
||||
"0a)W4]5}${.3^,'(l2:y3:ref;y8:<symbol>;),@(y11:sexp-match?)[02}?{.4,${'"
|
||||
"(y3:ref),.4^a,@(y16:repl-environment)[02}W5.4W6]5}${.3^,'(l2:y3:ref;l3"
|
||||
":y1:*;y1:*;y3:...;;),@(y11:sexp-match?)[02}?{.4,${'(y3:ref),.4^a,@(y16"
|
||||
":repl-environment)[02}W5.4W6]5}${.3^,'(l2:y4:peek;y1:*;),@(y11:sexp-ma"
|
||||
"tch?)[02}?{.0^aS0?{.4,.1^aF0?{'(s12:file exists%0a)}{'(s20:file does n"
|
||||
"ot exist%0a)}W4]5}.0^aY0?{.4,.1^aX4F0?{'(s12:file exists%0a)}{'(s20:fi"
|
||||
"le does not exist%0a)}W4]5}.4,'(s37:invalid file name; use double quot"
|
||||
"es%0a)W4]5}${.3^,'(l2:y7:verbose;y2:on;),@(y11:sexp-match?)[02}?{t@!(y"
|
||||
"9:*verbose*)]5}${.3^,'(l2:y7:verbose;y3:off;),@(y11:sexp-match?)[02}?{"
|
||||
"f@!(y9:*verbose*)]5}${.3^,'(l1:y4:help;),@(y11:sexp-match?)[02}?{.4,'("
|
||||
"s20:Available commands:%0a)W4.4,'(s42: ,say hello -- displays nice"
|
||||
" greeting%0a)W4.4,'(s40: ,peek <fname> -- check if file exists%0a)W4."
|
||||
"4,'(s37: ,verbose on -- turn verbosity on%0a)W4.4,'(s38: ,verbose o"
|
||||
"ff -- turn verbosity off%0a)W4.4,'(s54: ,ref <name> -- show curre"
|
||||
"nt denotation for <name>%0a)W4.4,'(s29: ,help -- this help%0a"
|
||||
")W4]5}.4,'(s29:syntax error in repl command%0a)W4.4,'(s37:type ,help t"
|
||||
"o see available commands%0a)W4]5",
|
||||
|
||||
"P", "repl-from-port",
|
||||
"%3,#0${@(y18:current-file-stack)[00}.!0${k0,.0,${.2,.9,.(i11),.(i10),&"
|
||||
"4{%0:3,&1{%!0.0,&1{%0:0,@(y6:values),@(y13:apply-to-list)[02},:0[11},:"
|
||||
"0,:1,:2,&3{%0${:1,:2,@(y9:repl-read)[02},,#0:0,:2,:1,.3,&4{%1.0R8~?{${"
|
||||
":3,.3,@(y18:repl-eval-top-form)[02}${:1,:2,@(y9:repl-read)[02},:0^[11}"
|
||||
"]1}.!0.0^_1[01},@(y16:call-with-values)[02},.(i10),.(i10),.(i10),.(i10"
|
||||
"),.7,&5{%1${k0,.0,${.6,:1,:2,:3,:4,&5{%0:4,${.2,@(y13:error-object?)[0"
|
||||
"1}?{Pe,.0,${.4,@(y20:error-object-message)[01}W4.0W6${${.5,@(y22:error"
|
||||
"-object-irritants)[01},.3,&1{%1:0,.1W5:0W6]1},@(y10:%25for-each1)[02}_"
|
||||
"1${:3^,@(y23:set-current-file-stack!)[01}:0?{:0,:1,:2,@(y14:repl-from-"
|
||||
"port)[13}]1}Pe,.0,'(s14:Unknown error:)W4.0W6.0,.2W5.0W6_1${:3^,@(y23:"
|
||||
"set-current-file-stack!)[01}:0?{:0,:1,:2,@(y14:repl-from-port)[13}]1},"
|
||||
":0[01}_1_3}[10},@(y22:with-exception-handler)[02}_1_3}[40",
|
||||
"0,:1,:2,&3{%0${:1,:2,@(y9:repl-read)[02},,#0:0,:2,:1,.3,&4{%1.0R8~?{:1"
|
||||
"?{${.2,'(l2:y7:unquote;y1:*;),@(y11:sexp-match?)[02}}{f}?{${Po,${:2,@("
|
||||
"y9:read-line)[01},.4da,@(y17:repl-exec-command)[03}}{${:3,.3,@(y18:rep"
|
||||
"l-eval-top-form)[02}}${:1,:2,@(y9:repl-read)[02},:0^[11}]1}.!0.0^_1[01"
|
||||
"},@(y16:call-with-values)[02},.(i10),.(i10),.(i10),.(i10),.7,&5{%1${k0"
|
||||
",.0,${.6,:1,:2,:3,:4,&5{%0:4,${.2,@(y13:error-object?)[01}?{Pe,.0,${.4"
|
||||
",@(y20:error-object-message)[01}W4.0W6${${.5,@(y22:error-object-irrita"
|
||||
"nts)[01},.3,&1{%1:0,.1W5:0W6]1},@(y10:%25for-each1)[02}_1${:3^,@(y23:s"
|
||||
"et-current-file-stack!)[01}:0?{:0,:1,:2,@(y14:repl-from-port)[13}]1}Pe"
|
||||
",.0,'(s14:Unknown error:)W4.0W6.0,.2W5.0W6_1${:3^,@(y23:set-current-fi"
|
||||
"le-stack!)[01}:0?{:0,:1,:2,@(y14:repl-from-port)[13}]1},:0[01}_1_3}[10"
|
||||
"},@(y22:with-exception-handler)[02}_1_3}[40",
|
||||
|
||||
"P", "repl-file",
|
||||
"%2,#0${.3,@(y15:open-input-file)[01}.!0${f,.5,.4^,@(y14:repl-from-port"
|
||||
|
|
|
|||
Loading…
Reference in a new issue