diff --git a/pre/t.scm b/pre/t.scm index 9256b41..d8a2323 100644 --- a/pre/t.scm +++ b/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)] diff --git a/t.c b/t.c index bd7690f..f7cc95c 100644 --- a/t.c +++ b/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 };