Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-26 21:58:51 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

support for -f and FASL file load/run

Browse source
This commit is contained in:
ESL 2024-07-31 23:06:59 -04:00
parent c82ab3d0b1
commit 9fd3e04956
2 changed files with 118 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
pre/t.scm
View file

@ -2475,10 +2475,13 @@
(call-with-current-input-file filename ;=> (call-with-current-input-file filename ;=>
(lambda (port) (lambda (port)
(when ci? (set-port-fold-case! port #t)) (when ci? (set-port-fold-case! port #t))
(let loop ([x (read-code-sexp port)]) (let ([x0 (read-code-sexp port)]) ; support loading fasl files too
(unless (eof-object? x) (if (eq? x0 (symbol->shebang (string->symbol "/usr/bin/env skint -f")))
(eval x env) (run-fasl-from-port port #f) ; do not call main even if it is there
(loop (read-code-sexp port)))))) (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 ; we aren't asked by the spec to call last expr tail-recursively, so this
(void)) (void))
@ -2487,37 +2490,80 @@
(define env (if (pair? ?env) (car ?env) (interaction-environment))) (define env (if (pair? ?env) (car ?env) (interaction-environment)))
(xpand #t expr env)) ; allow it to return any expressed value (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) ; 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 (run-script filename args)
(define env (interaction-environment)) (define env (interaction-environment))
(define ci? #f) ; normal load-like behavior is the default (define ci? #f) ; normal load-like behavior is the default
(define callmain #f) ; got changed via first #! line (define callmain #f) ; got changed via first #! line
(define main-args (cons filename args)) (define main-args (cons filename args))
(define fasl? #f)
(call-with-current-input-file filename ;=> (call-with-current-input-file filename ;=>
(lambda (port) (lambda (port)
(let ([x0 (read-code-sexp 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) (when (shebang? x0)
(let ([shs (symbol->string (shebang->symbol x0))]) (let ([shs (symbol->string (shebang->symbol x0))])
(cond [(string-position "r7rs" shs)] ; skint env will do (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) [(string-position "r5rs" shs)
(set! env (scheme-report-environment 5)) (set! env (scheme-report-environment 5))
(set! ci? #t)] (set! ci? #t)]
[else (error "only scheme-r[57]rs scripts are supported" shs)]) [else (error "unsupported script type" shs)])
(when ci? (set-port-fold-case! port #t)) (unless fasl?
(set! callmain #t) (when ci? (set-port-fold-case! port #t))
(set! x0 (read-code-sexp port)))) (set! callmain #t)
(parameterize ([command-line main-args]) (set! x0 (read-code-sexp port)))))
(let loop ([x x0]) (if fasl? ; call (main) if it was a script
(unless (eof-object? x) (run-fasl-from-port port main-args)
(eval x env) (parameterize ([command-line main-args])
(loop (read-code-sexp port))))) (let loop ([x x0])
(if callmain (unless (eof-object? x)
; if it is a real script, call main and return its value (eval x env)
(eval `(main (quote ,main-args)) env) (loop (read-code-sexp port))))
; otherwise return #t -- it will be used as exit value (if callmain
#t))))) ; 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) ; r7rs scheme program processor (args is list of strings)
(define (run-program filename args) (define (run-program filename args)
@ -2682,8 +2728,8 @@
[define-feature "-D" "--define-feature" "NAME" "Add name to the list of features"] [define-feature "-D" "--define-feature" "NAME" "Add name to the list of features"]
[eval "-e" "--eval" "SEXP" "Evaluate and print an expression"] [eval "-e" "--eval" "SEXP" "Evaluate and print an expression"]
[script "-s" "--script" "FILE" "Run file as a Scheme script"] [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"] [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"] [version "-V" "--version" #f "Display version info"]
[help "-h" "--help" #f "Display this help"] [help "-h" "--help" #f "Display this help"]
)) ))
@ -2725,6 +2771,7 @@
[(define-feature *) (add-feature! optarg) (loop restargs #t)] [(define-feature *) (add-feature! optarg) (loop restargs #t)]
[(eval *) (eval! optarg #t) (loop restargs #f)] [(eval *) (eval! optarg #t) (loop restargs #f)]
[(script *) (set! *quiet* #t) (exit (run-script optarg restargs))] [(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))] [(program *) (set! *quiet* #t) (exit (run-program optarg restargs))]
[(benchmark *) (exit (run-script optarg restargs))] ; FIXME [(benchmark *) (exit (run-script optarg restargs))] ; FIXME
[(version) (print-version!) (loop '() #f)] [(version) (print-version!) (loop '() #f)]

78
t.c
View file

@ -1550,26 +1550,48 @@ char *t_code[] = {
"P", "load", "P", "load",
"%!1,,#0#1.2p?{.2a}{${@(y23:interaction-environment)[00}}.!0f.!1${.2,.4" "%!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" ",&2{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01},'(s21:/usr/bin/env s"
"8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]1}.!" "kint -f)X5Y6,.1q?{f,.2,@(y18:run-fasl-from-port)[22}.0,,#0:1,.4,.2,&3{"
"0.0^_1[11},.6,@(y28:call-with-current-input-file)[02}Y9]4", "%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", "P", "expand",
"%!1,#0.1p?{.1a}{${@(y23:interaction-environment)[00}}.!0.0^,.3,t,@(y5:" "%!1,#0.1p?{.1a}{${@(y23:interaction-environment)[00}}.!0.0^,.3,t,@(y5:"
"xpand)[33", "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", "P", "run-script",
"%2,,,,#0#1#2#3${@(y23:interaction-environment)[00}.!0f.!1f.!2.5,.5c.!3" "%2,,,,,#0#1#2#3#4${@(y23:interaction-environment)[00}.!0f.!1f.!2.6,.6c"
".1,.4,.2,.5,&4{%1${.2,@(y14:read-code-sexp)[01},#0.0^Y5?{.0^Y7X4,.0,'(" ".!3f.!4.5,.2,.2,.5,.7,.9,&6{%1${.2,@(y14:read-code-sexp)[01},#0.0^p?{'"
"s4:r7rs)S8,.0?{.0}{.1,'(s5:skint)S8,.0?{.0}{.2,'(s4:r5rs)S8?{${'5,@(y2" "(y6:import),.1^aq}{f}?{,,,#0#1#2${${:5,@(y20:path-strip-directory)[01}"
"5:scheme-report-environment)[01}:!1t:!3}{${.4,'(s41:only scheme-r[57]r" ",@(y20:path-strip-extension)[01}X5.!0.0,&1{%1.0,'(y1:?),:0^,'(y7:prog:"
"s scripts are supported),@(y5:error)[02}}}_1}_1:3^?{t,.3P79}t:!0${.4,@" "//),@(y13:symbol-append)[14}.!1'(y6:import)b,'(y6:import)c,l1.!2${@(y1"
"(y14:read-code-sexp)[01}.!1_1}@(y12:command-line),${f,:2^,.4[02},${.3[" "6:root-environment),.4^,.6^,@(y27:make-controlled-environment)[03}:!3_"
"00},${.2,.5,&2{%0t,:1,:0[02},.6,.8,:1,&3{%0:2^,,#0:0,:1,.2,&3{%1.0R8~?" "3}.0^Y5?{.0^Y7X4,.0,'(s4:r7rs)S8,.0?{.0}{.1,'(s8:skint -f)S8?{t:!0}{.1"
"{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]1}.!0.0" ",'(s5:skint)S8,.0?{.0}{.2,'(s4:r5rs)S8?{${'5,@(y25:scheme-report-envir"
"^_1[01},.5,.7,&2{%0t,:1,:0[02},@(y12:dynamic-wind)[03}_2_1:0^?{:1^,n,n" "onment)[01}:!3t:!4}{${.4,'(s23:unsupported script type),@(y5:error)[02"
",:2^c,'(y5:quote)cc,'(y4:main)c,@(y4:eval)[22}t]2},.5,@(y28:call-with-" "}}}_1}}_1:0^~?{:4^?{t,.3P79}t:!2${.4,@(y14:read-code-sexp)[01}.!1}_1}:"
"current-input-file)[62", "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", "P", "run-program",
"%2,,,,,,#0#1#2#3#4#5${${.(i10),@(y20:path-strip-directory)[01},@(y20:p" "%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", ",@(y16:repl-environment),.8^,@(y14:repl-from-port)[04}_3}t]3",
"C", 0, "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" ";;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" "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" "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" "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" "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 " "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" "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" "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" "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}" ".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" "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@" "^[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:" "!(y7:*quiet*)${.5,.5,@(y10:run-script)[02},@(y4:exit)[41}${.2,'(l2:y4:"
"program;y1:*;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)${.5,.5,@(y11:ru" "fasl;y1:*;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)${.5,.5,@(y8:run-fa"
"n-program)[02},@(y4:exit)[41}${.2,'(l2:y9:benchmark;y1:*;),@(y11:sexp-" "sl)[02},@(y4:exit)[41}${.2,'(l2:y7:program;y1:*;),@(y11:sexp-match?)[0"
"match?)[02}?{${.5,.5,@(y10:run-script)[02},@(y4:exit)[41}${.2,'(l1:y7:" "2}?{t@!(y7:*quiet*)${.5,.5,@(y11:run-program)[02},@(y4:exit)[41}${.2,'"
"version;),@(y11:sexp-match?)[02}?{${:3^[00}f,n,:2^[42}${.2,'(l1:y4:hel" "(l2:y9:benchmark;y1:*;),@(y11:sexp-match?)[02}?{${.5,.5,@(y10:run-scri"
"p;),@(y11:sexp-match?)[02}?{${:1^[00}f,n,:2^[42}${.2,'(l1:f;),@(y11:se" "pt)[02},@(y4:exit)[41}${.2,'(l1:y7:version;),@(y11:sexp-match?)[02}?{$"
"xp-match?)[02}?{.3p?{t@!(y7:*quiet*)${.5d,.6a,@(y10:run-script)[02},@(" "{:3^[00}f,n,:2^[42}${.2,'(l1:y4:help;),@(y11:sexp-match?)[02}?{${:1^[0"
"y4:exit)[41}:0~?{t,@(y4:exit)[41}f]4}]4},@(y15:*skint-options*),.2,@(y" "0}f,n,:2^[42}${.2,'(l1:f;),@(y11:sexp-match?)[02}?{.3p?{t@!(y7:*quiet*"
"28:get-next-command-line-option)[23}.!0.0^_1[02}PiP09?{PoP09}{f}?{${@(" ")${.5d,.6a,@(y10:run-script)[02},@(y4:exit)[41}:0~?{t,@(y4:exit)[41}f]"
"y15:*skint-version*),'(s30:SKINT Scheme Interpreter v~a~%25),t,@(y6:fo" "4}]4},@(y15:*skint-options*),.2,@(y28:get-next-command-line-option)[23"
"rmat)[03}${'(s35:Copyright (c) 2024 False Schemers~%25),t,@(y6:format)" "}.!0.0^_1[02}PiP09?{PoP09}{f}?{${@(y15:*skint-version*),'(s30:SKINT Sc"
"[02}}t]5", "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 0, 0, 0
}; };