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

-D LIBDIR=... and (base-library-directory)

Browse source
This commit is contained in:
ESL 2024-07-31 17:18:29 -04:00
parent 6189cd0957
commit eadb6fb4fe
6 changed files with 82 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
i.c
View file

@ -4017,6 +4017,12 @@ define_instruction(dirsep) {
gonexti(); gonexti();
} }
define_instruction(libdir) {
extern char *lib_path;
ac = string_obj(newstring(lib_path));
gonexti();
}
#define VM_GEN_DEFGLOBAL #define VM_GEN_DEFGLOBAL
#include "i.h" #include "i.h"

2
i.h
View file

@ -191,7 +191,6 @@ declare_instruction(atest1, "%1", 0, NULL,
declare_instruction(atest2, "%2", 0, NULL, 0, NULL) declare_instruction(atest2, "%2", 0, NULL, 0, NULL)
declare_instruction(atest3, "%3", 0, NULL, 0, NULL) declare_instruction(atest3, "%3", 0, NULL, 0, NULL)
declare_instruction(atest4, "%4", 0, NULL, 0, NULL) declare_instruction(atest4, "%4", 0, NULL, 0, NULL)
/* declare_instruction(brnotlt, "<?", 'b', NULL, 0, NULL) */
declare_instruction(pushsub, "-,", 0, NULL, 0, NULL) declare_instruction(pushsub, "-,", 0, NULL, 0, NULL)
/* type checks: integrables but no globals */ /* type checks: integrables but no globals */
@ -532,6 +531,7 @@ declare_instruction(bumpcnt, "Zb", 0, "%bump-count",
declare_instruction(heapsz, "Zh", 0, "%heap-size", '0', AUTOGL) declare_instruction(heapsz, "Zh", 0, "%heap-size", '0', AUTOGL)
declare_instruction(flimmp, "Zf", 0, "%flonums-immediate?", '0', AUTOGL) declare_instruction(flimmp, "Zf", 0, "%flonums-immediate?", '0', AUTOGL)
declare_instruction(dirsep, "Zs", 0, "directory-separator", '0', AUTOGL) declare_instruction(dirsep, "Zs", 0, "directory-separator", '0', AUTOGL)
declare_instruction(libdir, "Zd", 0, "base-library-directory", '0', AUTOGL)
/* serialization, deserialization, compilation-related instructions */ /* serialization, deserialization, compilation-related instructions */
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL) declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)

8
n.c
View file

@ -1015,6 +1015,14 @@ int dirsep = '\\';
int dirsep = '/'; int dirsep = '/';
#endif #endif
#ifdef LIBPATH
char *lib_path = ##LIBPATH;
#elif defined(WIN32)
char *lib_path = ".\\";
#else
char *lib_path = "./";
#endif
extern char *argv_ref(int idx) extern char *argv_ref(int idx)
{ {
char **pv = cxg_argv; char **pv = cxg_argv;

8
pre/n.sf
View file

@ -1543,6 +1543,14 @@ int dirsep = '\\\\';
int dirsep = '/'; int dirsep = '/';
#endif #endif
#ifdef LIBPATH
char *lib_path = ##LIBPATH;
#elif defined(WIN32)
char *lib_path = \".\\\\\";
#else
char *lib_path = \"./\";
#endif
extern char *argv_ref(int idx) extern char *argv_ref(int idx)
{ {
char **pv = cxg_argv; char **pv = cxg_argv;

26
pre/t.scm
View file

@ -1747,8 +1747,10 @@
[else #t]))) [else #t])))
(define (file-resolve-relative-to-base-path filename basepath) (define (file-resolve-relative-to-base-path filename basepath)
(if (and (path-relative? filename) (base-path-separator basepath)) (if (path-relative? filename) ; leading . and .. to be resolved by OS
(string-append basepath filename) ; leading . and .. to be resolved by OS (if (base-path-separator basepath)
(string-append basepath filename)
(string-append basepath (string (directory-separator)) filename))
filename)) filename))
; hacks for relative file name resolution ; hacks for relative file name resolution
@ -1833,9 +1835,7 @@
[else (c-error "invalid library name name element" s)])) [else (c-error "invalid library name name element" s)]))
(define (listname->path listname basepath ext) (define (listname->path listname basepath ext)
(define sep (define sep (string (or (base-path-separator basepath) (directory-separator))))
(let ([sc (base-path-separator basepath)])
(if sc (string sc) (c-error "library path does not end in separator" basepath))))
(let loop ([l listname] [r '()]) (let loop ([l listname] [r '()])
(if (pair? l) (if (pair? l)
(loop (cdr l) (loop (cdr l)
@ -1846,17 +1846,17 @@
; hacks for locating library files ; hacks for locating library files
(define *library-path-list* '("./")) ; will do for now; FIXME: get access to real separator! (define *library-path-list* (list (base-library-directory)))
(define (append-library-path! path) (define (append-library-path! path)
(if (base-path-separator path) (unless (base-path-separator path)
(set! *library-path-list* (append *library-path-list* (list path))) (set! path (string-append path (string (directory-separator)))))
(c-error "library path should end in directory separator" path))) (set! *library-path-list* (append *library-path-list* (list path))))
(define (prepend-library-path! path) (define (prepend-library-path! path)
(if (base-path-separator path) (unless (base-path-separator path)
(set! *library-path-list* (append (list path) *library-path-list*)) (set! path (string-append path (string (directory-separator)))))
(c-error "library path should end in directory separator" path))) (set! *library-path-list* (append (list path) *library-path-list*)))
(define (find-library-path listname) ;=> name of existing .sld file or #f (define (find-library-path listname) ;=> name of existing .sld file or #f
(let loop ([l *library-path-list*]) (let loop ([l *library-path-list*])
@ -2132,7 +2132,7 @@
(string-cmp) (string-ci-cmp) (vector-cat) (bytevector=?) (bytevector->list) (list->bytevector) (string-cmp) (string-ci-cmp) (vector-cat) (bytevector=?) (bytevector->list) (list->bytevector)
(subbytevector) (standard-input-port) (standard-output-port) (standard-error-port) (tty-port?) (subbytevector) (standard-input-port) (standard-output-port) (standard-error-port) (tty-port?)
(port-fold-case?) (set-port-fold-case!) (rename-file) (current-directory) (directory-separator) (port-fold-case?) (set-port-fold-case!) (rename-file) (current-directory) (directory-separator)
(void) (void?) (implementation-name) (implementation-version) (base-library-directory) (void) (void?) (implementation-name) (implementation-version)
; (repl hidden) library entries below the auto-adder need to be added explicitly ; (repl hidden) library entries below the auto-adder need to be added explicitly
(*user-name-registry* . hidden) (make-readonly-environment . hidden) (*user-name-registry* . hidden) (make-readonly-environment . hidden)
(make-controlled-environment . hidden) (make-sld-environment . hidden) (make-controlled-environment . hidden) (make-sld-environment . hidden)

94
t.c
View file

@ -983,8 +983,8 @@ char *t_code[] = {
"{'(c%5c),.1ddav}{f}}{f}}{f}?{f]2}t]2", "{'(c%5c),.1ddav}{f}}{f}}{f}?{f]2}t]2",
"P", "file-resolve-relative-to-base-path", "P", "file-resolve-relative-to-base-path",
"%2${.2,@(y14:path-relative?)[01}?{${.3,@(y19:base-path-separator)[01}}" "%2${.2,@(y14:path-relative?)[01}?{${.3,@(y19:base-path-separator)[01}?"
"{f}?{.0,.2S6]2}.0]2", "{.0,.2S6]2}.0,Zs,S11,.3,@(y14:%25string-append)[23}.0]2",
"C", 0, "C", 0,
"n@!(y20:*current-file-stack*)", "n@!(y20:*current-file-stack*)",
@ -1046,25 +1046,22 @@ char *t_code[] = {
"3:invalid library name name element),@(y7:c-error)[12", "3:invalid library name name element),@(y7:c-error)[12",
"P", "listname->path", "P", "listname->path",
"%3,#0${.4,@(y19:base-path-separator)[01},.0?{.0,S11}{${.5,'(s38:librar" "%3,#0${.4,@(y19:base-path-separator)[01},.0?{.0}{Zs}_1,S11.!0n,.2,,#0."
"y path does not end in separator),@(y7:c-error)[02}}_1.!0n,.2,,#0.5,.7" "5,.7,.2,.6,&4{%2.0p?{.1u?{.1,${.3a,@(y24:listname-segment->string)[01}"
",.2,.6,&4{%2.0p?{.1u?{.1,${.3a,@(y24:listname-segment->string)[01}c}{." "c}{.1,:0^c,${.3a,@(y24:listname-segment->string)[01}c},.1d,:1^[22}:3,$"
"1,:0^c,${.3a,@(y24:listname-segment->string)[01}c},.1d,:1^[22}:3,${.4," "{.4,:2cA8,@(y14:string-append*)[01},@(y34:file-resolve-relative-to-bas"
":2cA8,@(y14:string-append*)[01},@(y34:file-resolve-relative-to-base-pa" "e-path)[22}.!0.0^_1[42",
"th)[22}.!0.0^_1[42",
"C", 0, "C", 0,
"'(l1:s2:./;)@!(y19:*library-path-list*)", "${@(y22:base-library-directory)[00},l1@!(y19:*library-path-list*)",
"P", "append-library-path!", "P", "append-library-path!",
"%1${.2,@(y19:base-path-separator)[01}?{.0,l1,@(y19:*library-path-list*" "%1#0${.2^,@(y19:base-path-separator)[01}~?{Zs,S11,.1^S6.!0}.0^,l1,@(y1"
")L6@!(y19:*library-path-list*)]1}.0,'(s46:library path should end in d" "9:*library-path-list*)L6@!(y19:*library-path-list*)]1",
"irectory separator),@(y7:c-error)[12",
"P", "prepend-library-path!", "P", "prepend-library-path!",
"%1${.2,@(y19:base-path-separator)[01}?{@(y19:*library-path-list*),.1,l" "%1#0${.2^,@(y19:base-path-separator)[01}~?{Zs,S11,.1^S6.!0}@(y19:*libr"
"1L6@!(y19:*library-path-list*)]1}.0,'(s46:library path should end in d" "ary-path-list*),.1^,l1L6@!(y19:*library-path-list*)]1",
"irectory separator),@(y7:c-error)[12",
"P", "find-library-path", "P", "find-library-path",
"%1@(y19:*library-path-list*),,#0.0,.3,&2{%1.0p?{${'(s4:.sld),.3a,:0,@(" "%1@(y19:*library-path-list*),,#0.0,.3,&2{%1.0p?{${'(s4:.sld),.3a,:0,@("
@ -1174,7 +1171,7 @@ char *t_code[] = {
"0:*root-name-registry*),@(y11:name-lookup)[03}", "0:*root-name-registry*),@(y11:name-lookup)[03}",
"C", 0, "C", 0,
"${'(l509:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y" "${'(l510: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" "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:" "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" "b;;l3:y2:>=;y1:v;y1:b;;l2:y1:_;y1:b;;l3:y3:abs;y1:v;y1:b;;l4:y3:and;y1"
@ -1337,38 +1334,39 @@ char *t_code[] = {
"tevector;;l1:y19:standard-input-port;;l1:y20:standard-output-port;;l1:" "tevector;;l1:y19:standard-input-port;;l1:y20:standard-output-port;;l1:"
"y19:standard-error-port;;l1:y9:tty-port?;;l1:y15:port-fold-case?;;l1:y" "y19:standard-error-port;;l1:y9:tty-port?;;l1:y15:port-fold-case?;;l1:y"
"19:set-port-fold-case!;;l1:y11:rename-file;;l1:y17:current-directory;;" "19:set-port-fold-case!;;l1:y11:rename-file;;l1:y17:current-directory;;"
"l1:y19:directory-separator;;l1:y4:void;;l1:y5:void?;;l1:y19:implementa" "l1:y19:directory-separator;;l1:y22:base-library-directory;;l1:y4:void;"
"tion-name;;l1:y22:implementation-version;;py20:*user-name-registry*;y6" ";l1:y5:void?;;l1:y19:implementation-name;;l1:y22:implementation-versio"
":hidden;;py25:make-readonly-environment;y6:hidden;;py27:make-controlle" "n;;py20:*user-name-registry*;y6:hidden;;py25:make-readonly-environment"
"d-environment;y6:hidden;;py20:make-sld-environment;y6:hidden;;py21:mak" ";y6:hidden;;py27:make-controlled-environment;y6:hidden;;py20:make-sld-"
"e-repl-environment;y6:hidden;;py19:find-library-in-env;y6:hidden;;py16" "environment;y6:hidden;;py21:make-repl-environment;y6:hidden;;py19:find"
":root-environment;y6:hidden;;py16:repl-environment;y6:hidden;;py17:emp" "-library-in-env;y6:hidden;;py16:root-environment;y6:hidden;;py16:repl-"
"ty-environment;y6:hidden;;py32:make-historic-report-environment;y6:hid" "environment;y6:hidden;;py17:empty-environment;y6:hidden;;py32:make-his"
"den;;py16:r5rs-environment;y6:hidden;;py21:r5rs-null-environment;y6:hi" "toric-report-environment;y6:hidden;;py16:r5rs-environment;y6:hidden;;p"
"dden;;py9:*verbose*;y6:hidden;;py7:*quiet*;y6:hidden;;py25:compile-and" "y21:r5rs-null-environment;y6:hidden;;py9:*verbose*;y6:hidden;;py7:*qui"
"-run-core-expr;y6:hidden;;py17:evaluate-top-form;y6:hidden;;py10:run-s" "et*;y6:hidden;;py25:compile-and-run-core-expr;y6:hidden;;py17:evaluate"
"cript;y6:hidden;;py11:run-program;y6:hidden;;py22:repl-evaluate-top-fo" "-top-form;y6:hidden;;py10:run-script;y6:hidden;;py11:run-program;y6:hi"
"rm;y6:hidden;;py9:repl-read;y6:hidden;;py17:repl-exec-command;y6:hidde" "dden;;py22:repl-evaluate-top-form;y6:hidden;;py9:repl-read;y6:hidden;;"
"n;;py14:repl-from-port;y6:hidden;;py13:run-benchmark;y6:hidden;;py4:re" "py17:repl-exec-command;y6:hidden;;py14:repl-from-port;y6:hidden;;py13:"
"pl;y6:hidden;;),&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y" "run-benchmark;y6:hidden;;py4:repl;y6:hidden;;),&0{%1,,,,#0#1#2#3&0{%1."
"5:write;)]2}'(y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:" "0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y1:t),.1v?{'(l2:y6:scheme"
"y6:scheme;y4:repl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v)," ";y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:repl;)]2}'(y1:r),.1v?{'(l2"
".1v?{'(l2:y6:scheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-nu" ":y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:scheme;y4:r5rs;)]2}'(y1:u)"
"ll;)]2}'(y1:d),.1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:sc" ",.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),.1v?{'(l2:y6:scheme;y4:l"
"heme;y4:lazy;)]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'" "oad;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]2}'(y1:s),.1v?{'(l2:y6:s"
"(y1:i),.1v?{'(l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;" "cheme;y15:process-context;)]2}'(y1:i),.1v?{'(l2:y6:scheme;y7:inexact;)"
"y4:file;)]2}'(y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:" "]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y1:e),.1v?{'(l2:y6:scheme"
"y6:scheme;y7:complex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:" ";y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:complex;)]2}'(y1:h),.1v?{'"
"l),.1v?{'(l2:y6:scheme;y11:case-lambda;)]2}'(y1:a),.1v?{'(l2:y6:scheme" "(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:scheme;y11:case-lambda;"
";y3:cxr;)]2}'(y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}'(y1:x),.1v?{'(l2:" ")]2}'(y1:a),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y1:b),.1v?{'(l2:y6:scheme"
"y6:scheme;y3:box;)]2}.1I0?{.1,'(y4:srfi),l2]2}.1,l1]2}.!0&0{%1${&0{%1n" ";y4:base;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:box;)]2}.1I0?{.1,'(y4:srfi"
",'(l1:y5:begin;),V12]1},.3,@(y20:*root-name-registry*),@(y11:name-look" "),l2]2}.1,l1]2}.!0&0{%1${&0{%1n,'(l1:y5:begin;),V12]1},.3,@(y20:*root-"
"up)[03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}" "name-registry*),@(y11:name-lookup)[03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{"
".!2&0{%1&0{%1.0,'(y5:const),l2]1},.1,@(y20:*root-name-registry*),@(y11" ".4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&0{%1&0{%1.0,'(y5:const),l2]1},.1,@("
":name-lookup)[13}.!3.4d,.5a,,#0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[0" "y20:*root-name-registry*),@(y11:name-lookup)[13}.!3.4d,.5a,,#0.0,.6,.5"
"1},.1,${'(l1:y5:skint;),:1^[01},:3^[23}.1p~?{${.2,:0^[01},.1,${n,.6c,'" ",.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:y5:skint;),:1^[01},:3^[23}"
"(y5:skint)c,:1^[01},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:" ".1p~?{${.2,:0^[01},.1,${n,.6c,'(y5:skint)c,:1^[01},:3^[23}${${.4,:0^[0"
"3^[03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}", "1},.3,${${.9a,:2^[01},:1^[01},:3^[03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:"
"%25for-each1)[02}",
"C", 0, "C", 0,
"@(y20:*root-name-registry*),${f,'(l1:y5:skint;),.4,@(y11:name-lookup)[" "@(y20:*root-name-registry*),${f,'(l1:y5:skint;),.4,@(y11:name-lookup)["