mirror of
https://github.com/false-schemers/skint.git
synced 2024-09-28 03:20:44 +02:00
(current-directory) added; ksf2c started
This commit is contained in:
ESL
parent
09e5b3b4f7
commit
951f725b68
9 changed files with 168 additions and 37 deletions
16
i.c
16
i.c
|
|
@ -3902,6 +3902,22 @@ define_instruction(fren) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(getcwd) {
|
||||
extern char *get_cwd(void);
|
||||
char *s = get_cwd();
|
||||
if (s) ac = string_obj(newstring(s));
|
||||
else ac = bool_obj(0);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(setcwd) {
|
||||
extern int set_cwd(char *cwd);
|
||||
int res; cks(ac);
|
||||
res = set_cwd(stringchars(ac));
|
||||
ac = bool_obj(res == 0);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(argvref) {
|
||||
extern char *argv_ref(int idx);
|
||||
int i; char *s; ckk(ac);
|
||||
|
|
|
|||
2
i.h
2
i.h
|
|
@ -520,6 +520,8 @@ declare_instruction(wriw, "W8\0Po", 0, "write-simple",
|
|||
declare_instruction(fexis, "F0", 0, "file-exists?", '1', AUTOGL)
|
||||
declare_instruction(frem, "F1", 0, "delete-file", '1', AUTOGL)
|
||||
declare_instruction(fren, "F2", 0, "rename-file", '2', AUTOGL)
|
||||
declare_instruction(getcwd, "F8", 0, "%cwd", '0', AUTOGL)
|
||||
declare_instruction(setcwd, "F9", 0, "%set-cwd!", '1', AUTOGL)
|
||||
declare_instruction(argvref, "Z0", 0, "%argv-ref", '1', AUTOGL)
|
||||
declare_instruction(getenv, "Z1", 0, "get-environment-variable", '1', AUTOGL)
|
||||
declare_instruction(envvref, "Z2", 0, "%envv-ref", '1', AUTOGL)
|
||||
|
|
|
|||
12
n.c
12
n.c
|
|
@ -1042,4 +1042,16 @@ extern char *envv_ref(int idx)
|
|||
return *pv;
|
||||
}
|
||||
|
||||
extern char *get_cwd(void)
|
||||
{
|
||||
static char buf[FILENAME_MAX];
|
||||
if (getcwd(buf, FILENAME_MAX) == NULL) return NULL;
|
||||
return buf;
|
||||
}
|
||||
|
||||
extern int set_cwd(char *cwd)
|
||||
{
|
||||
return chdir(cwd);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
67
pre/ksf2c.ssc
Normal file
67
pre/ksf2c.ssc
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
;---------------------------------------------------------------------------------------------
|
||||
; Skint k.sf precursor compiler (k.sf => k.c)
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(import (only (skint hidden)
|
||||
list2? list3?))
|
||||
|
||||
(define (list4? x) (and (pair? x) (list3? (cdr x))))
|
||||
|
||||
(define (path-strip-directory filename)
|
||||
(let loop ([l (reverse (string->list filename))] [r '()])
|
||||
(cond [(null? l) (list->string r)]
|
||||
[(memv (car l) '(#\\ #\/ #\:)) (list->string r)]
|
||||
[else (loop (cdr l) (cons (car l) r))])))
|
||||
|
||||
(define (path-strip-extension filename)
|
||||
(let ([l (reverse (string->list filename))])
|
||||
(let ([r (memv #\. l)])
|
||||
(if r (list->string (reverse (cdr r))) filename))))
|
||||
|
||||
(define (module-name filename)
|
||||
(path-strip-extension (path-strip-directory filename)))
|
||||
|
||||
(define *local-definitions*
|
||||
'("#ifdef NAN_BOXING" "#ifndef FLONUMS_BOXED" "#else" "#endif"))
|
||||
|
||||
(define (process-top-form x oport)
|
||||
(when (and (list2? x) (symbol? (car x)) (string? (cadr x)))
|
||||
(case (car x)
|
||||
[(%definition)
|
||||
; make an exception for some conditional definitions!
|
||||
(when (member (cadr x) *local-definitions*)
|
||||
(display (cadr x) oport) (newline oport) (newline oport))]
|
||||
[(%localdef) (display (cadr x) oport) (newline oport) (newline oport)] ; does not go into n.h
|
||||
[(%include)]))) ; went into n.h
|
||||
|
||||
(define (process-file sfcpath ifname . ?ofname)
|
||||
(define iport (open-input-file ifname)) ; relative to wd, not this script!
|
||||
(define oport (if (pair? ?ofname) (open-output-file (car ?ofname)) (current-output-port)))
|
||||
(define mname (module-name ifname))
|
||||
(display "/* " oport) (display mname oport)
|
||||
(display ".c -- generated via skint nsf2c.ssc " oport)
|
||||
(display (path-strip-directory ifname) oport)
|
||||
(display " */" oport) (newline oport) (newline oport)
|
||||
(let loop ([x (read iport)] [end-of-includes? #f])
|
||||
(unless (eof-object? x)
|
||||
(cond [end-of-includes?
|
||||
(process-top-form x oport)
|
||||
(loop (read iport) #t)]
|
||||
[(and (list2? x) (eq? (car x) '%include) (string? (cadr x)))
|
||||
(display "#include " oport) (write (cadr x) oport) (newline oport)
|
||||
(loop (read iport) #f)]
|
||||
[else ; switching to body forms
|
||||
(display "#include \"" oport) (display mname oport)
|
||||
(display ".h\"" oport) (newline oport) (newline oport)
|
||||
(process-top-form x oport)
|
||||
(loop (read iport) #t)])))
|
||||
(close-input-port iport)
|
||||
(if (pair? ?ofname) (close-output-port oport)))
|
||||
|
||||
(define (main args)
|
||||
(cond [(list3? args) (process-file (cadr args) (caddr args))]
|
||||
[(list4? args) (process-file (cadr args) (caddr args) (cadddr args))]
|
||||
[else (error "usage: scint ksf2c.ssc SFCPATH INFILE [OUTFILE]" args)]))
|
||||
|
||||
; this is not a real #! script, so call main manually
|
||||
;(main (command-line))
|
||||
12
pre/n.sf
12
pre/n.sf
|
|
@ -1569,4 +1569,16 @@ extern char *envv_ref(int idx)
|
|||
while (idx-- > 0) if (*pv++ == NULL) return NULL;
|
||||
return *pv;
|
||||
}
|
||||
|
||||
extern char *get_cwd(void)
|
||||
{
|
||||
static char buf[FILENAME_MAX];
|
||||
if (getcwd(buf, FILENAME_MAX) == NULL) return NULL;
|
||||
return buf;
|
||||
}
|
||||
|
||||
extern int set_cwd(char *cwd)
|
||||
{
|
||||
return chdir(cwd);
|
||||
}
|
||||
")
|
||||
|
|
|
|||
13
pre/s.scm
13
pre/s.scm
|
|
@ -2003,6 +2003,11 @@
|
|||
;
|
||||
; (load s (env (interaction-environment)))
|
||||
|
||||
(define current-directory
|
||||
(case-lambda
|
||||
[() (%cwd)]
|
||||
[(d) (or (%set-cwd! d) (error "cannot change directory to" d))]
|
||||
[(d s) (if s (current-directory d) d)]))
|
||||
|
||||
(define (%command-line)
|
||||
(let loop ([r '()] [i 0])
|
||||
|
|
@ -2013,7 +2018,13 @@
|
|||
|
||||
(define command-line (make-parameter (%command-line))) ; can be changed later in (main)
|
||||
|
||||
(define (features) '(r7rs exact-closed skint skint-1.0.0))
|
||||
(define *features* (list r7rs exact-closed skint skint-1.0.0))
|
||||
|
||||
(define features
|
||||
(case-lambda
|
||||
[() *features*]
|
||||
[(f) (if (list? f) (set! *features* f) (error "cannot change features to" f))]
|
||||
[(f s) (if s (features f) f)]))
|
||||
|
||||
(define (feature-available? f) (and (symbol? f) (memq f (features))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1993,7 +1993,7 @@
|
|||
(list*) (char-cmp) (char-ci-cmp) (string-cat) (string-position) (string-cmp) (string-ci-cmp)
|
||||
(vector-cat) (bytevector=?) (bytevector->list) (list->bytevector) (subbytevector)
|
||||
(standard-input-port) (standard-output-port) (standard-error-port) (tty-port?)
|
||||
(port-fold-case?) (set-port-fold-case!) (rename-file) (void) (void?)
|
||||
(port-fold-case?) (set-port-fold-case!) (rename-file) (current-directory) (void) (void?)
|
||||
; (repl hidden) library entries below the auto-adder need to be added explicitly
|
||||
(*user-name-registry* . hidden) (make-readonly-environment . hidden)
|
||||
(make-controlled-environment . hidden) (make-sld-environment . hidden)
|
||||
|
|
|
|||
15
s.c
15
s.c
|
|
@ -1028,6 +1028,11 @@ 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)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1?{.0,@(y17:current-directory)[21}.0]2}%x,&0{%1.0F9,.0?{.0]2}.1,"
|
||||
"'(s26:cannot change directory to),@(y5:error)[22}%x,&0{%0F8]0}%x,&3{|0"
|
||||
"0|11|22%%}@!(y17:current-directory)",
|
||||
|
||||
"P", "%command-line",
|
||||
"%0'0,n,,#0.0,&1{%2.1Z0,.0?{'1,.3I+,.2,.2c,:0^[32}.1A9]3}.!0.0^_1[02",
|
||||
|
||||
|
|
@ -1035,8 +1040,14 @@ char *s_code[] = {
|
|||
"${${@(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",
|
||||
"C", 0,
|
||||
"@(y11:skint-1.0.0),@(y5:skint),@(y12:exact-closed),@(y4:r7rs),l4@!(y10"
|
||||
":*features*)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1?{.0,@(y8:features)[21}.0]2}%x,&0{%1.0L0?{.0@!(y10:*features*)]"
|
||||
"1}.0,'(s25:cannot change features to),@(y5:error)[12}%x,&0{%0@(y10:*fe"
|
||||
"atures*)]0}%x,&3{|00|11|22%%}@!(y8:features)",
|
||||
|
||||
"P", "feature-available?",
|
||||
"%1.0Y0?{${@(y8:features)[00},.1A0]1}f]1",
|
||||
|
|
|
|||
66
t.c
66
t.c
|
|
@ -1101,7 +1101,7 @@ char *t_code[] = {
|
|||
"0:*root-name-registry*),@(y11:name-lookup)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l505:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y"
|
||||
"${'(l506:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y"
|
||||
"3:...;y1:v;y1:u;y1:b;;l3:y1:/;y1:v;y1:b;;l3:y1:<;y1:v;y1:b;;l3:y2:<=;y"
|
||||
"1:v;y1:b;;l3:y1:=;y1:v;y1:b;;l4:y2:=>;y1:v;y1:u;y1:b;;l3:y1:>;y1:v;y1:"
|
||||
"b;;l3:y2:>=;y1:v;y1:b;;l2:y1:_;y1:b;;l3:y3:abs;y1:v;y1:b;;l4:y3:and;y1"
|
||||
|
|
@ -1263,38 +1263,38 @@ char *t_code[] = {
|
|||
"l1:y12:bytevector=?;;l1:y16:bytevector->list;;l1:y16:list->bytevector;"
|
||||
";l1:y13:subbytevector;;l1:y19:standard-input-port;;l1:y20:standard-out"
|
||||
"put-port;;l1:y19:standard-error-port;;l1:y9:tty-port?;;l1:y15:port-fol"
|
||||
"d-case?;;l1:y19:set-port-fold-case!;;l1:y11:rename-file;;l1:y4:void;;l"
|
||||
"1:y5:void?;;py20:*user-name-registry*;y6:hidden;;py25:make-readonly-en"
|
||||
"vironment;y6:hidden;;py27:make-controlled-environment;y6:hidden;;py20:"
|
||||
"make-sld-environment;y6:hidden;;py21:make-repl-environment;y6:hidden;;"
|
||||
"py19:find-library-in-env;y6:hidden;;py16:root-environment;y6:hidden;;p"
|
||||
"y16:repl-environment;y6:hidden;;py17:empty-environment;y6:hidden;;py32"
|
||||
":make-historic-report-environment;y6:hidden;;py16:r5rs-environment;y6:"
|
||||
"hidden;;py21:r5rs-null-environment;y6:hidden;;py9:*verbose*;y6:hidden;"
|
||||
";py7:*quiet*;y6:hidden;;py25:compile-and-run-core-expr;y6:hidden;;py17"
|
||||
":evaluate-top-form;y6:hidden;;py10:run-script;y6:hidden;;py11:run-prog"
|
||||
"ram;y6:hidden;;py22:repl-evaluate-top-form;y6:hidden;;py9:repl-read;y6"
|
||||
":hidden;;py17:repl-exec-command;y6:hidden;;py14:repl-from-port;y6:hidd"
|
||||
"en;;py13:run-benchmark;y6:hidden;;py4:repl;y6:hidden;;),&0{%1,,,,#0#1#"
|
||||
"2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y1:t),.1v?{'(l2:"
|
||||
"y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:repl;)]2}'(y1:r),"
|
||||
".1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:scheme;y4:r5rs;)]"
|
||||
"2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),.1v?{'(l2:y6:sc"
|
||||
"heme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]2}'(y1:s),.1v?{"
|
||||
"'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'(l2:y6:scheme;y7:"
|
||||
"inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y1:e),.1v?{'(l2:"
|
||||
"y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:complex;)]2}'(y1:"
|
||||
"h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:scheme;y11:cas"
|
||||
"e-lambda;)]2}'(y1:a),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y1:b),.1v?{'(l2:"
|
||||
"y6:scheme;y4:base;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:box;)]2}.1I0?{.1,"
|
||||
"'(y4:srfi),l2]2}.1,l1]2}.!0&0{%1${&0{%1n,'(l1:y5:begin;),V12]1},.3,@(y"
|
||||
"20:*root-name-registry*),@(y11:name-lookup)[03}z]1}.!1&0{%3'1,.1V4,.0,"
|
||||
".3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&0{%1&0{%1.0,'(y5:const),l2"
|
||||
"]1},.1,@(y20:*root-name-registry*),@(y11:name-lookup)[13}.!3.4d,.5a,,#"
|
||||
"0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:y5:skint;),:1^[01"
|
||||
"},:3^[23}.1p~?{${.2,:0^[01},.1,${n,.6c,'(y5:skint)c,:1^[01},:3^[23}${$"
|
||||
"{.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3^[03}.1d,.1,:4^[22}.!0.0^_1[5"
|
||||
"2},@(y10:%25for-each1)[02}",
|
||||
"d-case?;;l1:y19:set-port-fold-case!;;l1:y11:rename-file;;l1:y17:curren"
|
||||
"t-directory;;l1:y4:void;;l1:y5:void?;;py20:*user-name-registry*;y6:hid"
|
||||
"den;;py25:make-readonly-environment;y6:hidden;;py27:make-controlled-en"
|
||||
"vironment;y6:hidden;;py20:make-sld-environment;y6:hidden;;py21:make-re"
|
||||
"pl-environment;y6:hidden;;py19:find-library-in-env;y6:hidden;;py16:roo"
|
||||
"t-environment;y6:hidden;;py16:repl-environment;y6:hidden;;py17:empty-e"
|
||||
"nvironment;y6:hidden;;py32:make-historic-report-environment;y6:hidden;"
|
||||
";py16:r5rs-environment;y6:hidden;;py21:r5rs-null-environment;y6:hidden"
|
||||
";;py9:*verbose*;y6:hidden;;py7:*quiet*;y6:hidden;;py25:compile-and-run"
|
||||
"-core-expr;y6:hidden;;py17:evaluate-top-form;y6:hidden;;py10:run-scrip"
|
||||
"t;y6:hidden;;py11:run-program;y6:hidden;;py22:repl-evaluate-top-form;y"
|
||||
"6:hidden;;py9:repl-read;y6:hidden;;py17:repl-exec-command;y6:hidden;;p"
|
||||
"y14:repl-from-port;y6:hidden;;py13:run-benchmark;y6:hidden;;py4:repl;y"
|
||||
"6:hidden;;),&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:wr"
|
||||
"ite;)]2}'(y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:s"
|
||||
"cheme;y4:repl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?"
|
||||
"{'(l2:y6:scheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)"
|
||||
"]2}'(y1:d),.1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme"
|
||||
";y4:lazy;)]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:"
|
||||
"i),.1v?{'(l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:f"
|
||||
"ile;)]2}'(y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:s"
|
||||
"cheme;y7:complex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),."
|
||||
"1v?{'(l2:y6:scheme;y11:case-lambda;)]2}'(y1:a),.1v?{'(l2:y6:scheme;y3:"
|
||||
"cxr;)]2}'(y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}'(y1:x),.1v?{'(l2:y6:s"
|
||||
"cheme;y3:box;)]2}.1I0?{.1,'(y4:srfi),l2]2}.1,l1]2}.!0&0{%1${&0{%1n,'(l"
|
||||
"1:y5:begin;),V12]1},.3,@(y20:*root-name-registry*),@(y11:name-lookup)["
|
||||
"03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&"
|
||||
"0{%1&0{%1.0,'(y5:const),l2]1},.1,@(y20:*root-name-registry*),@(y11:nam"
|
||||
"e-lookup)[13}.!3.4d,.5a,,#0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},."
|
||||
"1,${'(l1:y5:skint;),:1^[01},:3^[23}.1p~?{${.2,:0^[01},.1,${n,.6c,'(y5:"
|
||||
"skint)c,:1^[01},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3^[0"
|
||||
"3}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}",
|
||||
|
||||
"C", 0,
|
||||
"@(y20:*root-name-registry*),${f,'(l1:y5:skint;),.4,@(y11:name-lookup)["
|
||||
|
|
|
|||
Loading…
Reference in a new issue