diff --git a/s.c b/s.c index e1f57dd..b931381 100644 --- a/s.c +++ b/s.c @@ -1,4 +1,4 @@ -/* s.c -- code is generated via skint -c s.scm */ +/* s.c -- generated via skint -c s.scm */ #include "s.h" #include "n.h" @@ -1010,15 +1010,32 @@ char *s_code[] = { "(y19:write-subbytevector)[34}%x,&0{%2.1,.1W3]2}%x,&0{%1Po,.1W3]1}%x,&4" "{|10|21|32|43%%}@!(y16:write-bytevector)", - "P", "command-line", + "P", "%command-line", "%0'0,n,,#0.0,&1{%2.1Z0,.0?{'1,.3I+,.2,.2c,:0^[32}.1A9]3}.!0.0^_1[02", + "C", 0, + "${${@(y13:%25command-line)[00},@(y14:make-parameter)[01}@!(y12:command" + "-line)", + "P", "features", "%0'(l4:y4:r7rs;y12:exact-closed;y5:skint;y11:skint-1.0.0;)]0", "P", "feature-available?", "%1.0Y0?{${@(y8:features)[00},.1A0]1}f]1", + "P", "emergency-exit", + "%!0.0u?{tZ9]1}.0aZ9]1", + + "C", 0, + "@(y14:emergency-exit)@!(y4:exit)", + + "P", "%make-exit", + "%1.0,&1{%!0.0u?{t,:0[11}.0a,:0[11}]1", + + "C", 0, + "${k0,.0,${.2,@(y10:%25make-exit)[01}@!(y4:exit)'(y8:continue)_1_3},'(y" + "8:continue),.1q~?{${.2,@(y14:emergency-exit)[01}}_1", + "C", 0, "${@(y5:write),@(y14:make-parameter)[01}@!(y19:format-pretty-print)", diff --git a/src/s.scm b/src/s.scm index 8e97286..d99f50d 100644 --- a/src/s.scm +++ b/src/s.scm @@ -1334,13 +1334,13 @@ ; Environments and evaluation ;--------------------------------------------------------------------------------------------- -;TBD: +; defined in t.scm: ; -;environment -;scheme-report-environment -;null-environment -;interaction-environment -;eval +; (scheme-report-environment 5) +; (null-environment 5) +; (interaction-environment) +; (environment iset ...) +; (eval exp (env (interaction-environment))) ;--------------------------------------------------------------------------------------------- @@ -1937,28 +1937,42 @@ ; (jiffies-per-second) ; (%system s) + -(define (command-line) +; defined in t.scm: +; +; (load s (env (interaction-environment))) + + +(define (%command-line) (let loop ([r '()] [i 0]) (let ([arg (%argv-ref i)]) (if arg (loop (cons arg r) (fx+ i 1)) (reverse! r))))) +(define command-line (make-parameter (%command-line))) ; can be changed later in (main) + (define (features) '(r7rs exact-closed skint skint-1.0.0)) -(define (feature-available? f) - (and (symbol? f) (memq f (features)))) +(define (feature-available? f) (and (symbol? f) (memq f (features)))) ;TBD: ; -;load -;exit -;emergency-exit ;get-environment-variables +(define (emergency-exit . ?obj) + (if (null? ?obj) (%exit) (%exit (car ?obj)))) + +(define exit emergency-exit) + +(define (%make-exit k) + (lambda ?obj (if (null? ?obj) (k #t) (k (car ?obj))))) + +(let ([status (call/cc (lambda (k) (set! exit (%make-exit k)) 'continue))]) + (unless (eq? status 'continue) (emergency-exit status))) + ;--------------------------------------------------------------------------------------------- -; Extras +; Selected extras ;--------------------------------------------------------------------------------------------- ; SRFI-48 compatible intermediate formatting (advanced functionality accessible via params)