diff --git a/src/t.scm b/src/t.scm index 53234ae..1ac2140 100644 --- a/src/t.scm +++ b/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, #, 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 ) (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 -- check if file exists\n" op) + (display " ,verbose on -- turn verbosity on\n" op) + (display " ,verbose off -- turn verbosity off\n" op) + (display " ,ref -- show current denotation for \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) diff --git a/t.c b/t.c index d2259fc..46fea9b 100644 --- a/t.c +++ b/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:;),@(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 -- 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 -- show curre" + "nt denotation for %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"