Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-11-16 07:47:54 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

(string-position str str), run-script checks #!

Browse source
This commit is contained in:
ESL 2024-07-17 22:43:19 -04:00
parent b3567d8b61
commit 0edd2255e3
3 changed files with 28 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
i.c
View file

@ -1346,8 +1346,13 @@ define_instruction(ssub) {
define_instruction(spos) {
obj x = ac, y = spop(); char *s, *p;
ckc(x); cks(y);
s = stringchars(y), p = strchr(s, get_char(x));
cks(y); s = stringchars(y);
if (is_string(x)) {
p = strstr(s, stringchars(x));
} else {
ckc(x);
p = strchr(s, get_char(x));
}
ac = p ? fixnum_obj(p-s) : bool_obj(0);
gonexti();
}

18
src/t.scm
View file

@ -2296,7 +2296,7 @@
; srfi-22 - like script processor (args is list of strings)
(define (run-script filename args)
(define env (interaction-environment))
(define ci? #f) ; do not bother setting this
(define ci? #f) ; normal load-like behavior is the default
(define callmain #f)
(define main-args (cons filename args))
(let* ([filepath (and (string? filename) (file-resolve-relative-to-current filename))]
@ -2306,18 +2306,24 @@
(lambda ()
(call-with-input-file filepath
(lambda (port)
(when ci? (set-port-fold-case! port #t))
(let ([x0 (read-code-sexp port)])
(when (shebang? x0) ; TODO: set! env depending on x?
(set! callmain #t)
(set! x0 (read-code-sexp port)))
(when (shebang? x0)
(let ([shs (symbol->string (shebang->symbol x0))])
(cond [(string-position "r7rs" shs)] ; ok, repl 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))))
(let loop ([x x0])
(unless (eof-object? x)
(eval x env)
(loop (read-code-sexp port))))
(when callmain
; if it is a real script, exit with main's return value
(eval `(exit (main (quote ,main-args))) env)))))))
(exit (eval `(main (quote ,main-args)) env))))))))
(void)))

16
t.c
View file

@ -1440,13 +1440,15 @@ char *t_code[] = {
"P", "run-script",
"%2,,,,#0#1#2#3${@(y23:interaction-environment)[00}.!0f.!1f.!2.5,.5c.!3"
".4S0?{${.6,@(y32:file-resolve-relative-to-current)[01}}{f},.0S0?{.0F0}"
"{f},.0~?{${.3,.9,'(s17:cannot run script),@(y5:error)[03}}${.5,.8,.6,."
"9,.7,&5{%0:1,:2,:3,:4,&4{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01}"
",#0.0^Y5?{t:!3${.3,@(y14:read-code-sexp)[01}.!0}${.2^,,#0:2,.6,.2,&3{%"
"1.0R8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]"
"1}.!0.0^_1[01}:3^?{:2^,n,n,n,:1^c,'(y5:quote)cc,'(y4:main)cc,'(y4:exit"
")c,@(y4:eval)[22}]2},:0,@(y20:call-with-input-file)[02},.4,@(y17:with-"
"current-file)[02}Y9]8",
"{f},.0~?{${.3,.9,'(s17:cannot run script),@(y5:error)[03}}${.6,.8,.6,."
"8,.7,&5{%0:1,:2,:3,:4,&4{%1${.2,@(y14:read-code-sexp)[01},#0.0^Y5?{.0^"
"Y7X4,.0,'(s4:r7rs)S8,.0?{.0}{.1,'(s4:r5rs)S8?{${'5,@(y25:scheme-report"
"-environment)[01}:!2t:!3}{${.3,'(s41:only scheme-r[57]rs scripts are s"
"upported),@(y5:error)[02}}}_1:3^?{t,.3P79}t:!0${.4,@(y14:read-code-sex"
"p)[01}.!1_1}${.2^,,#0:2,.6,.2,&3{%1.0R8~?{${:2^,.3,@(y4:eval)[02}${:1,"
"@(y14:read-code-sexp)[01},:0^[11}]1}.!0.0^_1[01}:0^?{${:2^,n,n,:1^c,'("
"y5:quote)cc,'(y4:main)c,@(y4:eval)[02},@(y4:exit)[21}]2},:0,@(y20:call"
"-with-input-file)[02},.4,@(y17:with-current-file)[02}Y9]8",
"P", "repl-evaluate-top-form",
"%3,,#0#1.!0${.2,&1{%!0.0:!0]1},.6,.6,&2{%0:1,:0,@(y17:evaluate-top-for"