mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
support for -f and FASL file load/run
This commit is contained in:
ESL
parent
c82ab3d0b1
commit
9fd3e04956
2 changed files with 118 additions and 47 deletions
87
pre/t.scm
87
pre/t.scm
|
|
@ -2475,10 +2475,13 @@
|
|||
(call-with-current-input-file filename ;=>
|
||||
(lambda (port)
|
||||
(when ci? (set-port-fold-case! port #t))
|
||||
(let loop ([x (read-code-sexp port)])
|
||||
(unless (eof-object? x)
|
||||
(eval x env)
|
||||
(loop (read-code-sexp port))))))
|
||||
(let ([x0 (read-code-sexp port)]) ; support loading fasl files too
|
||||
(if (eq? x0 (symbol->shebang (string->symbol "/usr/bin/env skint -f")))
|
||||
(run-fasl-from-port port #f) ; do not call main even if it is there
|
||||
(let loop ([x x0])
|
||||
(unless (eof-object? x)
|
||||
(eval x env)
|
||||
(loop (read-code-sexp port))))))))
|
||||
; we aren't asked by the spec to call last expr tail-recursively, so this
|
||||
(void))
|
||||
|
||||
|
|
@ -2487,37 +2490,80 @@
|
|||
(define env (if (pair? ?env) (car ?env) (interaction-environment)))
|
||||
(xpand #t expr env)) ; allow it to return any expressed value
|
||||
|
||||
; run fasl-compiled script, optionally starting with #! /usr/bin/env skint -f
|
||||
(define (run-fasl-from-port port main-args)
|
||||
(define env (interaction-environment))
|
||||
(define (exec code)
|
||||
(define cl (closure (deserialize-code code)))
|
||||
(cl))
|
||||
(when (eqv? (peek-char port) #\#) ; header is optional if call is explicit
|
||||
(define x (read-code-sexp port))
|
||||
(unless (eq? x (symbol->shebang (string->symbol "/usr/bin/env skint -f")))
|
||||
(error "unexpected header in FASL file" x)))
|
||||
(let loop ([c (peek-char port)])
|
||||
(when (memv c '(#\newline #\return))
|
||||
(read-char port) (loop (peek-char port))))
|
||||
(let loop ([line 1])
|
||||
(unless (eof-object? (peek-char port))
|
||||
(define c1 (read-char port))
|
||||
(define c2 (read-char port))
|
||||
(define c3 (read-char port))
|
||||
(define hd (list c1 c2 c3))
|
||||
(cond [(equal? hd '(#\C #\tab #\tab))
|
||||
(exec (read-line port))
|
||||
(loop (+ line 1))]
|
||||
[(equal? hd '(#\M #\tab #\tab))
|
||||
(and (pair? main-args) (eval `(main (quote ,main-args)) env))]
|
||||
[else (error "unexpected line header on FASL body line" line hd)]))))
|
||||
|
||||
(define (run-fasl filename args)
|
||||
(define main-args (cons filename args))
|
||||
(call-with-current-input-file filename ;=>
|
||||
(lambda (port) (run-fasl-from-port port main-args))))
|
||||
|
||||
; srfi-22 - like script processor (args is list of strings)
|
||||
; since this one is a default file processor, support other kinds too
|
||||
(define (run-script filename args)
|
||||
(define env (interaction-environment))
|
||||
(define ci? #f) ; normal load-like behavior is the default
|
||||
(define callmain #f) ; got changed via first #! line
|
||||
(define main-args (cons filename args))
|
||||
(define fasl? #f)
|
||||
(call-with-current-input-file filename ;=>
|
||||
(lambda (port)
|
||||
(let ([x0 (read-code-sexp port)])
|
||||
(when (and (pair? x0) (eq? (car x0) 'import))
|
||||
; consider it a 'program script', prepare program env
|
||||
(define modname (string->symbol
|
||||
(path-strip-extension (path-strip-directory filename))))
|
||||
(define global (lambda (n) (symbol-append 'prog:// modname '? n)))
|
||||
(define ial (list (cons 'import (make-location 'import))))
|
||||
(set! env (make-controlled-environment ial global root-environment)))
|
||||
(when (shebang? x0)
|
||||
(let ([shs (symbol->string (shebang->symbol x0))])
|
||||
(cond [(string-position "r7rs" shs)] ; skint env will do
|
||||
[(string-position "skint" shs)] ; ditto
|
||||
[(string-position "skint -f" shs) (set! fasl? #t)]
|
||||
[(string-position "skint" shs)] ; skint env will do
|
||||
[(string-position "r5rs" shs)
|
||||
(set! env (scheme-report-environment 5))
|
||||
(set! ci? #t)]
|
||||
[else (error "only scheme-r[57]rs scripts are supported" shs)])
|
||||
(when ci? (set-port-fold-case! port #t))
|
||||
(set! callmain #t)
|
||||
(set! x0 (read-code-sexp port))))
|
||||
(parameterize ([command-line main-args])
|
||||
(let loop ([x x0])
|
||||
(unless (eof-object? x)
|
||||
(eval x env)
|
||||
(loop (read-code-sexp port)))))
|
||||
(if callmain
|
||||
; if it is a real script, call main and return its value
|
||||
(eval `(main (quote ,main-args)) env)
|
||||
; otherwise return #t -- it will be used as exit value
|
||||
#t)))))
|
||||
[else (error "unsupported script type" shs)])
|
||||
(unless fasl?
|
||||
(when ci? (set-port-fold-case! port #t))
|
||||
(set! callmain #t)
|
||||
(set! x0 (read-code-sexp port)))))
|
||||
(if fasl? ; call (main) if it was a script
|
||||
(run-fasl-from-port port main-args)
|
||||
(parameterize ([command-line main-args])
|
||||
(let loop ([x x0])
|
||||
(unless (eof-object? x)
|
||||
(eval x env)
|
||||
(loop (read-code-sexp port))))
|
||||
(if callmain
|
||||
; if it is a real script, call main and return its value
|
||||
(eval `(main (quote ,main-args)) env)
|
||||
; otherwise return #t -- it will be used as exit value
|
||||
#t)))))))
|
||||
|
||||
; r7rs scheme program processor (args is list of strings)
|
||||
(define (run-program filename args)
|
||||
|
|
@ -2682,8 +2728,8 @@
|
|||
[define-feature "-D" "--define-feature" "NAME" "Add name to the list of features"]
|
||||
[eval "-e" "--eval" "SEXP" "Evaluate and print an expression"]
|
||||
[script "-s" "--script" "FILE" "Run file as a Scheme script"]
|
||||
[fasl "-f" "--fasl" "FILE" "Run file as a compiled script"]
|
||||
[program "-p" "--program" "FILE" "Run file as a Scheme program"]
|
||||
;[benchmark #f "--benchmark" "FILE" "Run .sf benchmark file (internal)"]
|
||||
[version "-V" "--version" #f "Display version info"]
|
||||
[help "-h" "--help" #f "Display this help"]
|
||||
))
|
||||
|
|
@ -2725,6 +2771,7 @@
|
|||
[(define-feature *) (add-feature! optarg) (loop restargs #t)]
|
||||
[(eval *) (eval! optarg #t) (loop restargs #f)]
|
||||
[(script *) (set! *quiet* #t) (exit (run-script optarg restargs))]
|
||||
[(fasl *) (set! *quiet* #t) (exit (run-fasl optarg restargs))]
|
||||
[(program *) (set! *quiet* #t) (exit (run-program optarg restargs))]
|
||||
[(benchmark *) (exit (run-script optarg restargs))] ; FIXME
|
||||
[(version) (print-version!) (loop '() #f)]
|
||||
|
|
|
|||
78
t.c
78
t.c
|
|
@ -1550,26 +1550,48 @@ char *t_code[] = {
|
|||
|
||||
"P", "load",
|
||||
"%!1,,#0#1.2p?{.2a}{${@(y23:interaction-environment)[00}}.!0f.!1${.2,.4"
|
||||
",&2{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01},,#0:1,.3,.2,&3{%1.0R"
|
||||
"8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]1}.!"
|
||||
"0.0^_1[11},.6,@(y28:call-with-current-input-file)[02}Y9]4",
|
||||
",&2{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01},'(s21:/usr/bin/env s"
|
||||
"kint -f)X5Y6,.1q?{f,.2,@(y18:run-fasl-from-port)[22}.0,,#0:1,.4,.2,&3{"
|
||||
"%1.0R8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}"
|
||||
"]1}.!0.0^_1[21},.6,@(y28:call-with-current-input-file)[02}Y9]4",
|
||||
|
||||
"P", "expand",
|
||||
"%!1,#0.1p?{.1a}{${@(y23:interaction-environment)[00}}.!0.0^,.3,t,@(y5:"
|
||||
"xpand)[33",
|
||||
|
||||
"P", "run-fasl-from-port",
|
||||
"%2,,#0#1${@(y23:interaction-environment)[00}.!0&0{%1,#0.1U4,U91.!0.0^["
|
||||
"20}.!1'(c#),.3R1v?{,#0${.5,@(y14:read-code-sexp)[01}.!0'(s21:/usr/bin/"
|
||||
"env skint -f)X5Y6,.1^q~?{${.2^,'(s30:unexpected header in FASL file),@"
|
||||
"(y5:error)[02}}_1}${.4R1,,#0.6,.1,&2{%1'(l2:c%0a;c%0d;),.1A1?{:1R0:1R1"
|
||||
",:0^[11}]1}.!0.0^_1[01}'1,,#0.0,.4,.6,.8,.6,&5{%1:2R1R8~?{,,,,#0#1#2#3"
|
||||
":2R0.!0:2R0.!1:2R0.!2.2^,.2^,.2^,l3.!3'(l3:cC;c%09;c%09;),.4^e?{${${:2"
|
||||
",@(y9:read-line)[01},:3^[01}'1,.5+,:4^[51}'(l3:cM;c%09;c%09;),.4^e?{:1"
|
||||
"p?{:0^,n,n,:1c,'(y5:quote)cc,'(y4:main)c,@(y4:eval)[52}f]5}.3^,.5,'(s4"
|
||||
"0:unexpected line header on FASL body line),@(y5:error)[53}]1}.!0.0^_1"
|
||||
"[41",
|
||||
|
||||
"P", "run-fasl",
|
||||
"%2,#0.2,.2c.!0.0,&1{%1:0^,.1,@(y18:run-fasl-from-port)[12},.2,@(y28:ca"
|
||||
"ll-with-current-input-file)[32",
|
||||
|
||||
"P", "run-script",
|
||||
"%2,,,,#0#1#2#3${@(y23:interaction-environment)[00}.!0f.!1f.!2.5,.5c.!3"
|
||||
".1,.4,.2,.5,&4{%1${.2,@(y14:read-code-sexp)[01},#0.0^Y5?{.0^Y7X4,.0,'("
|
||||
"s4:r7rs)S8,.0?{.0}{.1,'(s5:skint)S8,.0?{.0}{.2,'(s4:r5rs)S8?{${'5,@(y2"
|
||||
"5:scheme-report-environment)[01}:!1t:!3}{${.4,'(s41:only scheme-r[57]r"
|
||||
"s scripts are supported),@(y5:error)[02}}}_1}_1:3^?{t,.3P79}t:!0${.4,@"
|
||||
"(y14:read-code-sexp)[01}.!1_1}@(y12:command-line),${f,:2^,.4[02},${.3["
|
||||
"00},${.2,.5,&2{%0t,:1,:0[02},.6,.8,:1,&3{%0:2^,,#0:0,:1,.2,&3{%1.0R8~?"
|
||||
"{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]1}.!0.0"
|
||||
"^_1[01},.5,.7,&2{%0t,:1,:0[02},@(y12:dynamic-wind)[03}_2_1:0^?{:1^,n,n"
|
||||
",:2^c,'(y5:quote)cc,'(y4:main)c,@(y4:eval)[22}t]2},.5,@(y28:call-with-"
|
||||
"current-input-file)[62",
|
||||
"%2,,,,,#0#1#2#3#4${@(y23:interaction-environment)[00}.!0f.!1f.!2.6,.6c"
|
||||
".!3f.!4.5,.2,.2,.5,.7,.9,&6{%1${.2,@(y14:read-code-sexp)[01},#0.0^p?{'"
|
||||
"(y6:import),.1^aq}{f}?{,,,#0#1#2${${:5,@(y20:path-strip-directory)[01}"
|
||||
",@(y20:path-strip-extension)[01}X5.!0.0,&1{%1.0,'(y1:?),:0^,'(y7:prog:"
|
||||
"//),@(y13:symbol-append)[14}.!1'(y6:import)b,'(y6:import)c,l1.!2${@(y1"
|
||||
"6:root-environment),.4^,.6^,@(y27:make-controlled-environment)[03}:!3_"
|
||||
"3}.0^Y5?{.0^Y7X4,.0,'(s4:r7rs)S8,.0?{.0}{.1,'(s8:skint -f)S8?{t:!0}{.1"
|
||||
",'(s5:skint)S8,.0?{.0}{.2,'(s4:r5rs)S8?{${'5,@(y25:scheme-report-envir"
|
||||
"onment)[01}:!3t:!4}{${.4,'(s23:unsupported script type),@(y5:error)[02"
|
||||
"}}}_1}}_1:0^~?{:4^?{t,.3P79}t:!2${.4,@(y14:read-code-sexp)[01}.!1}_1}:"
|
||||
"0^?{:1^,.2,@(y18:run-fasl-from-port)[22}@(y12:command-line),${f,:1^,.4"
|
||||
"[02},${.3[00},.0,.3,&2{%0t,:1,:0[02},:2,:3,:1,.8,.8,&5{%0${:0^,,#0:3,:"
|
||||
"1,.2,&3{%1.0R8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01}"
|
||||
",:0^[11}]1}.!0.0^_1[01}:4^?{:3^,n,n,:2^c,'(y5:quote)cc,'(y4:main)c,@(y"
|
||||
"4:eval)[02}t]0},.3,.5,&2{%0t,:1,:0[02},@(y12:dynamic-wind)[53},.6,@(y2"
|
||||
"8:call-with-current-input-file)[72",
|
||||
|
||||
"P", "run-program",
|
||||
"%2,,,,,,#0#1#2#3#4#5${${.(i10),@(y20:path-strip-directory)[01},@(y20:p"
|
||||
|
|
@ -1690,7 +1712,7 @@ char *t_code[] = {
|
|||
",@(y16:repl-environment),.8^,@(y14:repl-from-port)[04}_3}t]3",
|
||||
|
||||
"C", 0,
|
||||
"'(l10:l5:y7:verbose;s2:-v;s9:--verbose;f;s25:Increase output verbosity"
|
||||
"'(l11:l5:y7:verbose;s2:-v;s9:--verbose;f;s25:Increase output verbosity"
|
||||
";;l5:y5:quiet;s2:-q;s7:--quiet;f;s30:Suppress nonessential messages;;l"
|
||||
"5:y13:append-libdir;s2:-A;s15:--append-libdir;s3:DIR;s33:Append a libr"
|
||||
"ary search directory;;l5:y14:prepend-libdir;s2:-I;s16:--prepend-libdir"
|
||||
|
|
@ -1698,6 +1720,7 @@ char *t_code[] = {
|
|||
"s2:-D;s16:--define-feature;s4:NAME;s32:Add name to the list of feature"
|
||||
"s;;l5:y4:eval;s2:-e;s6:--eval;s4:SEXP;s32:Evaluate and print an expres"
|
||||
"sion;;l5:y6:script;s2:-s;s8:--script;s4:FILE;s27:Run file as a Scheme "
|
||||
"script;;l5:y4:fasl;s2:-f;s6:--fasl;s4:FILE;s29:Run file as a compiled "
|
||||
"script;;l5:y7:program;s2:-p;s9:--program;s4:FILE;s28:Run file as a Sch"
|
||||
"eme program;;l5:y7:version;s2:-V;s9:--version;f;s20:Display version in"
|
||||
"fo;;l5:y4:help;s2:-h;s6:--help;f;s17:Display this help;;)@!(y15:*skint"
|
||||
|
|
@ -1736,18 +1759,19 @@ char *t_code[] = {
|
|||
".2,'(l2:y14:define-feature;y1:*;),@(y11:sexp-match?)[02}?{${.4,:5^[01}"
|
||||
"t,.4,:2^[42}${.2,'(l2:y4:eval;y1:*;),@(y11:sexp-match?)[02}?{${t,.5,:4"
|
||||
"^[02}f,.4,:2^[42}${.2,'(l2:y6:script;y1:*;),@(y11:sexp-match?)[02}?{t@"
|
||||
"!(y7:*quiet*)${.5,.5,@(y10:run-script)[02},@(y4:exit)[41}${.2,'(l2:y7:"
|
||||
"program;y1:*;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)${.5,.5,@(y11:ru"
|
||||
"n-program)[02},@(y4:exit)[41}${.2,'(l2:y9:benchmark;y1:*;),@(y11:sexp-"
|
||||
"match?)[02}?{${.5,.5,@(y10:run-script)[02},@(y4:exit)[41}${.2,'(l1:y7:"
|
||||
"version;),@(y11:sexp-match?)[02}?{${:3^[00}f,n,:2^[42}${.2,'(l1:y4:hel"
|
||||
"p;),@(y11:sexp-match?)[02}?{${:1^[00}f,n,:2^[42}${.2,'(l1:f;),@(y11:se"
|
||||
"xp-match?)[02}?{.3p?{t@!(y7:*quiet*)${.5d,.6a,@(y10:run-script)[02},@("
|
||||
"y4:exit)[41}:0~?{t,@(y4:exit)[41}f]4}]4},@(y15:*skint-options*),.2,@(y"
|
||||
"28:get-next-command-line-option)[23}.!0.0^_1[02}PiP09?{PoP09}{f}?{${@("
|
||||
"y15:*skint-version*),'(s30:SKINT Scheme Interpreter v~a~%25),t,@(y6:fo"
|
||||
"rmat)[03}${'(s35:Copyright (c) 2024 False Schemers~%25),t,@(y6:format)"
|
||||
"[02}}t]5",
|
||||
"!(y7:*quiet*)${.5,.5,@(y10:run-script)[02},@(y4:exit)[41}${.2,'(l2:y4:"
|
||||
"fasl;y1:*;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)${.5,.5,@(y8:run-fa"
|
||||
"sl)[02},@(y4:exit)[41}${.2,'(l2:y7:program;y1:*;),@(y11:sexp-match?)[0"
|
||||
"2}?{t@!(y7:*quiet*)${.5,.5,@(y11:run-program)[02},@(y4:exit)[41}${.2,'"
|
||||
"(l2:y9:benchmark;y1:*;),@(y11:sexp-match?)[02}?{${.5,.5,@(y10:run-scri"
|
||||
"pt)[02},@(y4:exit)[41}${.2,'(l1:y7:version;),@(y11:sexp-match?)[02}?{$"
|
||||
"{:3^[00}f,n,:2^[42}${.2,'(l1:y4:help;),@(y11:sexp-match?)[02}?{${:1^[0"
|
||||
"0}f,n,:2^[42}${.2,'(l1:f;),@(y11:sexp-match?)[02}?{.3p?{t@!(y7:*quiet*"
|
||||
")${.5d,.6a,@(y10:run-script)[02},@(y4:exit)[41}:0~?{t,@(y4:exit)[41}f]"
|
||||
"4}]4},@(y15:*skint-options*),.2,@(y28:get-next-command-line-option)[23"
|
||||
"}.!0.0^_1[02}PiP09?{PoP09}{f}?{${@(y15:*skint-version*),'(s30:SKINT Sc"
|
||||
"heme Interpreter v~a~%25),t,@(y6:format)[03}${'(s35:Copyright (c) 2024"
|
||||
" False Schemers~%25),t,@(y6:format)[02}}t]5",
|
||||
|
||||
0, 0, 0
|
||||
};
|
||||
|
|
|
|||
Loading…
Reference in a new issue