support for #! shebangs of various use

This commit is contained in:
ESL 2024-07-17 17:47:08 -04:00
parent a7fb308858
commit 0763791fe3
9 changed files with 213 additions and 114 deletions

24
i.c
View file

@ -217,6 +217,9 @@ static void _sck(obj *s) {
#define get_char(o) char_from_obj(o)
#define void_obj() obj_from_void(0)
#define is_void(o) (o == obj_from_void(0))
#define is_shebang(o) isshebang(o)
#define get_shebang(o) getshebang(o)
#define shebang_obj(i) mkshebang(i)
#define unit_obj() obj_from_unit()
#define is_unit(o) (o == obj_from_unit())
#define null_obj() mknull()
@ -241,6 +244,7 @@ static void _sck(obj *s) {
#endif
#define is_symbol(o) issymbol(o)
#define get_symbol(o) getsymbol(o)
#define symbol_obj(i) mksymbol(i)
#define is_pair(o) ispair(o)
#define pair_car(o) car(o)
#define pair_cdr(o) cdr(o)
@ -568,6 +572,8 @@ define_instrhelper(cxi_failactype) {
{ ac = _x; spush((obj)"box, cell, or promise"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckg(x) do { obj _x = (x); if (unlikely(!isintegrable(_x))) \
{ ac = _x; spush((obj)"integrable entry"); musttail return cxi_failactype(IARGS); } } while (0)
#define cksb(x) do { obj _x = (x); if (unlikely(!is_shebang(_x))) \
{ ac = _x; spush((obj)"directive"); musttail return cxi_failactype(IARGS); } } while (0)
define_instruction(halt) {
@ -3084,6 +3090,24 @@ define_instruction(boxp) {
gonexti();
}
define_instruction(shebangp) {
ac = bool_obj(is_shebang(ac));
gonexti();
}
define_instruction(ytosb) {
cky(ac);
ac = shebang_obj(get_symbol(ac));
gonexti();
}
define_instruction(sbtoy) {
cksb(ac);
ac = symbol_obj(get_shebang(ac));
gonexti();
}
define_instruction(funp) {
ac = bool_obj(is_proc(ac));
gonexti();

3
i.h
View file

@ -465,6 +465,9 @@ declare_instruction(ston, "E9\0'(i10)", 0, "string->number",
declare_instruction(symp, "Y0", 0, "symbol?", '1', AUTOGL)
declare_instruction(boolp, "Y1", 0, "boolean?", '1', AUTOGL)
declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL)
declare_instruction(shebangp, "Y5", 0, "shebang?", '1', AUTOGL)
declare_instruction(ytosb, "Y6", 0, "symbol->shebang", '1', AUTOGL)
declare_instruction(sbtoy, "Y7", 0, "shebang->symbol", '1', AUTOGL)
declare_instruction(voidp, "Y8", 0, "void?", '1', AUTOGL)
declare_instruction(void, "Y9", 0, "void", '0', AUTOGL)
declare_instruction(cin, "Pi", 0, "%current-input-port", '0', AUTOGL)

12
n.c
View file

@ -872,6 +872,11 @@ default: /* inter-host call */
#define EOF_ITAG 7
#define mkeof() mkimm(0, EOF_ITAG)
#define iseof(o) ((o) == mkimm(0, EOF_ITAG))
/* shebangs (#! directives or script start lines) */
#define SHEBANG_ITAG 8
#define isshebang(o) (isimm(o, SHEBANG_ITAG))
#define mkshebang(i) mkimm(i, SHEBANG_ITAG)
#define getshebang(o) getimmu(o, SHEBANG_ITAG)
/* input ports */
typedef struct { /* extends cxtype_t */
const char *tname;
@ -1303,8 +1308,11 @@ static void wrdatum(obj o, wenv_t *e) {
wrs(buf, e);
} else if (iseof(o)) {
wrs("#<eof>", e);
} else if (o == obj_from_void(0)) {
} else if (isvoid(o)) {
wrs("#<void>", e);
} else if (isshebang(o)) {
char *s = symbolname(getshebang(o));
wrs("#<!", e); wrs(s, e); wrc('>', e);
} else if (o == obj_from_unit()) {
wrs("#<values>", e);
} else if (isiport(o)) {
@ -1401,8 +1409,6 @@ static void wrdatum(obj o, wenv_t *e) {
wrc(' ', e); wrdatum(recordref(o, i), e);
}
wrc('>', e);
} else if (isvoid(o)) {
wrs("#<void>", e);
} else {
wrs("#<unknown>", e);
}

5
n.h
View file

@ -386,6 +386,11 @@ extern obj appcases[];
#define EOF_ITAG 7
#define mkeof() mkimm(0, EOF_ITAG)
#define iseof(o) ((o) == mkimm(0, EOF_ITAG))
/* shebangs (#! directives or script start lines) */
#define SHEBANG_ITAG 8
#define isshebang(o) (isimm(o, SHEBANG_ITAG))
#define mkshebang(i) mkimm(i, SHEBANG_ITAG)
#define getshebang(o) getimmu(o, SHEBANG_ITAG)
/* input ports */
typedef struct { /* extends cxtype_t */
const char *tname;

212
s.c
View file

@ -909,106 +909,109 @@ char *s_code[] = {
"C=]7}.!(i14).(i16),.(i12),&2{%1${.2,:1^[01},.0R8?{.1,'(y5:port:),'(s22"
":unexpected end of file),@(y10:read-error)[23}${.2,:0^[01}?{.1,'(y5:po"
"rt:),.2d,'(s17:unexpected token:),@(y10:read-error)[24}.0]2}.!(i15).9,"
".(i13),.(i21),.(i25),.(i20),.(i13),.(i23),.(i25),.(i28),.(i23),.(i13),"
".(i26),.(i14),.(i14),.(i38),&(i15){%1.0R0,.0R8?{.0]2}.0C1?{.1,:(i10)^["
"21}'(c(),.1C=?{t,:9^,.3,.3,:8^[24}'(c)),.1C=?{:9^]2}'(c[),.1C=?{t,:(i1"
"4)^,.3,.3,:8^[24}'(c]),.1C=?{:(i14)^]2}'(c'),.1C=?{${.3,:3^[01},'(y5:q"
"uote),l2]2}'(c`),.1C=?{${.3,:3^[01},'(y10:quasiquote),l2]2}${.2,:(i13)"
"^[01}?{.1,.1,:(i11)^[22}'(c;),.1C=?{${.3R0,,#0.5,.1,&2{%1.0R8,.0?{.0]2"
"}'(c%0a),.2C=,.0?{.0]3}:1R0,:0^[31}.!0.0^_1[01}.1,:(i10)^[21}'(c,),.1C"
"=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after ,),@(y10:read-err"
"or)[33}'(c@),.1C=?{.2R0${.4,:3^[01},'(y16:unquote-splicing),l2]3}${.4,"
":3^[01},'(y7:unquote),l2]3}'(c%22),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,."
"0R8?{:2,'(y5:port:),'(s27:end of file within a string),@(y10:read-erro"
"r)[23}'(c%5c),.1C=?{${'(y6:string),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'"
"(c%22),.1C=?{.1A9X3]2}.1,.1c,:0^[21}.!0.0^_1[21}'(c|),.1C=?{n,,#0.3,:("
"i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s29:end of file within a |sym"
"bol|),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:symbol),:2,:1^[02},.0?"
"{.2,.1c}{.2},:0^[31}'(c|),.1C=?{.1A9X3X5]2}.1,.1c,:0^[21}.!0.0^_1[21}'"
"(c#),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after #),@(y10:"
"read-error)[33}'(ct),.1Ci=,.0?{.0}{'(cf),.2Ci=}_1?{${.4,:3^[01},.0,'(l"
"2:y1:t;y4:true;),.1A1?{t]5}'(l2:y1:f;y5:false;),.1A1?{f]5}.4,'(y5:port"
":),.3,'(s23:unexpected name after #),@(y10:read-error)[54}'(cb),.1Ci=,"
".0?{.0}{'(co),.2Ci=,.0?{.0}{'(cd),.3Ci=,.0?{.0}{'(cx),.4Ci=,.0?{.0}{'("
"ci),.5Ci=,.0?{.0}{'(ce),.6Ci=}_1}_1}_1}_1}_1?{.2,'(c#),:(i11)^[32}'(c&"
"),.1C=?{.2R0${.4,:3^[01}b]3}'(c;),.1C=?{.2R0${.4,:3^[01}.2,:(i10)^[31}"
"'(c|),.1C=?{.2R0${,#0.5,.1,&2{%0:1R0,.0R8?{:1,'(y5:port:),'(s25:end of"
" file in #| comment),@(y10:read-error)[13}'(c|),.1C=?{:1R1,.0R8?{:1,'("
"y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[23}'(c#),"
".1C=?{:1R0]2}:0^[20}'(c#),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of"
" file in #| comment),@(y10:read-error)[23}'(c|),.1C=?{:1R0${:0^[00}:0^"
"[20}:0^[20}:0^[10}.!0.0^_1[00}.2,:(i10)^[31}'(c(),.1C=?{.2R0${f,:9^,.6"
",.5,:8^[04}X1]3}'(cu),.1C=?{.2R0'(c8),.3R0q?{'(c(),.3R0q}{f}?{${.4,:7^"
"[01}E1]3}.2,'(y5:port:),'(s25:invalid bytevector syntax),@(y10:read-er"
"ror)[33}'(c%5c),.1C=?{.2R0.2R1,.0R8?{.3,'(y5:port:),'(s20:end of file "
"after #%5c),@(y10:read-error)[43}.0,'(cx)C=?{.3R0${.5R1,:5^[01}?{.0]4}"
"f,.4,:6^[42}.0C4?{${.5,:3^[01},'1,.1X4S3=?{.1]5}.0,'(y4:null),.1v?{'0X"
"9]6}'(y5:space),.1v?{'(c )]6}'(y5:alarm),.1v?{'(c%07)]6}'(y9:backspace"
"),.1v?{'(c%08)]6}'(y6:delete),.1v?{'(i127)X9]6}'(y6:escape),.1v?{'(i27"
")X9]6}'(y3:tab),.1v?{'(c%09)]6}'(l2:y7:newline;y8:linefeed;),.1A1?{'(c"
"%0a)]6}'(y4:vtab),.1v?{'(c%0b)]6}'(y4:page),.1v?{'(c%0c)]6}'(y6:return"
"),.1v?{'(c%0d)]6}.5,'(y5:port:),.3,'(s15:unknown #%5c name),@(y10:read"
"-error)[64}.3R0.0]4}.0C5?{:0?{${.4,'(y5:port:),'(s44:#N=/#N# notation "
"is not allowed in this mode),@(y10:read-error)[03}}n,,#0.4,.1,:4,:3,:2"
",:1,&6{%1:5R0,.0R8?{:5,'(y5:port:),'(s32:end of file within a #N notat"
"ion),@(y10:read-error)[23}.0C5?{.1,.1c,:4^[21}'(c#),.1C=?{.1A9X3,'(i10"
"),.1E9,.0I0?{:0^,.1A3}{f},.0?{.0d]5}'(s22:unknown #n# reference:),'(y5"
":port:),.4,@(y10:read-error)[53}'(c=),.1C=?{.1A9X3,'(i10),.1E9,.0I0~?{"
"${'(s22:invalid #n= reference:),'(y5:port:),.5,@(y10:read-error)[03}}{"
":0^,.1A3?{${'(s18:duplicate #n= tag:),'(y5:port:),.4,@(y10:read-error)"
"[03}}{f}}fb,:0^,${.3,:1^[01},.3cc:!0${:5,:2^[01},${.2,:3^[01}?{'(s31:#"
"n= has another label as target),'(y5:port:),.5,@(y10:read-error)[63}.0"
",.2sz.0]6}:5,'(y5:port:),'(s34:invalid terminator for #N notation),@(y"
"10:read-error)[23}.!0.0^_1[31}.2,'(y5:port:),.2,'(s16:unknown # syntax"
"),@(y10:read-error)[34}.1,'(y5:port:),.2,'(s22:illegal character read)"
",@(y10:read-error)[24}.!(i16).(i16),.(i12),.(i17),.(i13),&4{%4${.3,:3^"
"[01},:0^,.1q?{.2,'(y5:port:),'(s42:missing car -- ( immediately follow"
"ed by .),@(y10:read-error)[53}.0,,#0.0,.5,:3,:2,.(i10),:1,.(i11),:0,&8"
"{%1.0R8?{:6,'(y5:port:),'(s41:eof inside list -- unbalanced parenthese"
"s),@(y10:read-error)[13}:1,.1q?{n]1}:0^,.1q?{:3?{${:6,:2^[01},${:6,:5^"
"[01},:1,.1q?{.1]3}:6,'(y5:port:),.2,'(s31:randomness after form after "
"dot),@(y10:read-error)[34}:6,'(y5:port:),'(s13:dot in #(...)),@(y10:re"
"ad-error)[13}${.2,:4^[01}?{:6,'(y5:port:),.2d,'(s20:error inside list "
"--),@(y10:read-error)[14}${${:6,:5^[01},:7^[01},.1c]1}.!0.0^_1[51}.!(i"
"17).(i16),.9,.(i13),&3{%1${.2,:2^[01},,#0.0,.3,:2,:0,:1,&5{%1.0R8?{:3,"
"'(y5:port:),'(s21:eof inside bytevector),@(y10:read-error)[13}:0^,.1q?"
"{n]1}${.2,:1^[01}?{:3,'(y5:port:),.2d,'(s26:error inside bytevector --"
"),@(y10:read-error)[14}.0I0~,.0?{.0}{'0,.2I<,.0?{.0}{'(i255),.3I>}_1}_"
"1?{:3,'(y5:port:),.2,'(s33:invalid byte inside bytevector --),@(y10:re"
"ad-error)[14}${${:3,:2^[01},:4^[01},.1c]1}.!0.0^_1[11}.!(i18).(i20),&1"
"{%2.0R0,.0R8?{${.3,'(y5:port:),.6,'(s20:end of file within a),@(y10:re"
"ad-error)[04}}'(c%5c),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c|),.3C=}_1}"
"_1?{.0]3}'(ca),.1C=?{'(c%07)]3}'(cb),.1C=?{'(c%08)]3}'(ct),.1C=?{'(c%0"
"9)]3}'(cn),.1C=?{'(c%0a)]3}'(cv),.1C=?{'(c%0b)]3}'(cf),.1C=?{'(c%0c)]3"
"}'(cr),.1C=?{'(c%0d)]3}'(cx),.1C=?{t,.2,:0^[32}'(y6:string),.3q?{.0C1}"
"{f}?{.1R1,'(c%0a),.2C=,,#0.0,.5,&2{%2.1R8,.0?{.0}{.2C1~}_1?{.0?{f]2}:0"
",'(y5:port:),'(s32:no newline in line ending escape),@(y10:read-error)"
"[23}.0?{'(c%0a),.2C=}{f}?{f]2}:0R0:0R1,.1,.0?{.0}{'(c%0a),.4C=}_1,:1^["
"22}.!0.0^_1[32}.1,'(y5:port:),.2,'(y1::),.6,'(s22:invalid char escape "
"in),@(y10:read-error)[36}.!(i19).(i14),.(i14),&2{%2,#0.1,&1{%1.0u?{:0,"
"'(y5:port:),'(s31:%5cx escape sequence is too short),@(y10:read-error)"
"[13}'(i16),.1A9X3X7X9]1}.!0'0,n,.3R1,,#0.0,.6,:0,.7,.(i10),:1,&6{%3.0R"
"8?{:1?{:4,'(y5:port:),'(s27:end of file within a string),@(y10:read-er"
"ror)[33}.1,:2^[31}:1?{'(c;),.1C=}{f}?{:4R0.1,:2^[31}:1~?{${.2,:0^[01}}"
"{f}?{.1,:2^[31}${.2,:3^[01}~?{:4,'(y5:port:),.2,'(s37:unexpected char "
"in %5cx escape sequence),@(y10:read-error)[34}'2,.3>?{:4,'(y5:port:),'"
"(s30:%5cx escape sequence is too long),@(y10:read-error)[33}:4R0'1,.3+"
",.2,.2c,:4R1,:5^[33}.!0.0^_1[33}.!(i20)&0{%4.0,.0?{.0}{.2C5}_1?{f]4}'("
"s2:+i),.4Si=,.0?{.0}{'(s2:-i),.5Si=}_1?{f]4}'(s6:+nan.0),.4Si=,.0?{.0}"
"{'(s6:-nan.0),.5Si=}_1?{f]4}'(s6:+inf.0),.4Si=,.0?{.0}{'(s6:-inf.0),.5"
"Si=}_1?{f]4}'(c+),.2C=,.0?{.0}{'(c-),.3C=}_1?{.2du?{t]4}'(c.),.3daC=?{"
".2ddp?{.2ddaC5~]4}f]4}.2daC5~]4}'(c.),.2C=?{.2dp?{.2daC5~]4}f]4}f]4}.!"
"(i21).(i14),.(i22),.(i12),.3,.(i16),&5{%2'(c#),.1C=,.1,l1,.3R1,,#0.5,."
"1,:0,:1,:2,:3,:4,&7{%3.0R8,.0?{.0}{${.3,:0^[01}}_1?{.1A9,.0a,.1X3,.5,."
"0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0?{.0}{'(c-),.5C=,.0?{.0}{'(c.),.6C=}_"
"1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}${.2,.5,.5,.(i10),:1^[04}?{:3^?{.0SfX5"
"]6}.0X5]6}'(i10),.1E9,.0?{.0]7}:6,'(y5:port:),.3,'(s54:unsupported num"
"ber syntax (implementation restriction)),@(y10:read-error)[74}:3^?{.0S"
"fX5]6}.0X5]6}'(c#),.1C=?{:6R0t,.2,.2c,:6R1,:5^[33}${.2,:4^[01}?{:6R0.2"
",.2,.2c,:6R1,:5^[33}:6,'(y5:port:),.2,'(s29:unexpected number/symbol c"
"har),@(y10:read-error)[34}.!0.0^_1[23}.!(i22)${.(i25),.(i19)^[01},${.2"
",.(i15)^[01}~?{.2^u?{.0](i26)}.0,.8^[(i26)1}.(i24),'(y5:port:),.2d,'(s"
"17:unexpected token:),@(y10:read-error)[(i26)4",
".(i13),.(i21),.3,.(i26),.(i21),.(i14),.(i24),.(i26),.(i29),.(i24),.(i1"
"4),.(i27),.(i15),.(i15),.(i39),&(i16){%1.0R0,.0R8?{.0]2}.0C1?{.1,:(i10"
")^[21}'(c(),.1C=?{t,:9^,.3,.3,:8^[24}'(c)),.1C=?{:9^]2}'(c[),.1C=?{t,:"
"(i15)^,.3,.3,:8^[24}'(c]),.1C=?{:(i15)^]2}'(c'),.1C=?{${.3,:3^[01},'(y"
"5:quote),l2]2}'(c`),.1C=?{${.3,:3^[01},'(y10:quasiquote),l2]2}${.2,:(i"
"14)^[01}?{.1,.1,:(i11)^[22}'(c;),.1C=?{${.3R0,,#0.5,.1,&2{%1.0R8,.0?{."
"0]2}'(c%0a),.2C=,.0?{.0]3}:1R0,:0^[31}.!0.0^_1[01}.1,:(i10)^[21}'(c,),"
".1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after ,),@(y10:read-"
"error)[33}'(c@),.1C=?{.2R0${.4,:3^[01},'(y16:unquote-splicing),l2]3}${"
".4,:3^[01},'(y7:unquote),l2]3}'(c%22),.1C=?{n,,#0.3,:(i13),.2,&3{%1:2R"
"0,.0R8?{:2,'(y5:port:),'(s27:end of file within a string),@(y10:read-e"
"rror)[23}'(c%5c),.1C=?{${'(y6:string),:2,:1^[02},.0?{.2,.1c}{.2},:0^[3"
"1}'(c%22),.1C=?{.1A9X3]2}.1,.1c,:0^[21}.!0.0^_1[21}'(c|),.1C=?{n,,#0.3"
",:(i13),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s29:end of file within a |"
"symbol|),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:symbol),:2,:1^[02},"
".0?{.2,.1c}{.2},:0^[31}'(c|),.1C=?{.1A9X3X5]2}.1,.1c,:0^[21}.!0.0^_1[2"
"1}'(c#),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after #),@(y"
"10:read-error)[33}'(c!),.1C=?{.2R0${.4,:3^[01},.0,'(l2:y9:fold-case;y1"
"2:no-fold-case;),.1A1?{'(y9:fold-case),.2q:!(i12):(i12)^,.5P79.4,:(i10"
")^[51}.1Y0?{.1Y6]5}.4,'(y5:port:),.3,'(s24:unexpected name after #!),@"
"(y10:read-error)[54}'(ct),.1Ci=,.0?{.0}{'(cf),.2Ci=}_1?{${.4,:3^[01},."
"0,'(l2:y1:t;y4:true;),.1A1?{t]5}'(l2:y1:f;y5:false;),.1A1?{f]5}.4,'(y5"
":port:),.3,'(s23:unexpected name after #),@(y10:read-error)[54}'(cb),."
"1Ci=,.0?{.0}{'(co),.2Ci=,.0?{.0}{'(cd),.3Ci=,.0?{.0}{'(cx),.4Ci=,.0?{."
"0}{'(ci),.5Ci=,.0?{.0}{'(ce),.6Ci=}_1}_1}_1}_1}_1?{.2,'(c#),:(i11)^[32"
"}'(c&),.1C=?{.2R0${.4,:3^[01}b]3}'(c;),.1C=?{.2R0${.4,:3^[01}.2,:(i10)"
"^[31}'(c|),.1C=?{.2R0${,#0.5,.1,&2{%0:1R0,.0R8?{:1,'(y5:port:),'(s25:e"
"nd of file in #| comment),@(y10:read-error)[13}'(c|),.1C=?{:1R1,.0R8?{"
":1,'(y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[23}'"
"(c#),.1C=?{:1R0]2}:0^[20}'(c#),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:e"
"nd of file in #| comment),@(y10:read-error)[23}'(c|),.1C=?{:1R0${:0^[0"
"0}:0^[20}:0^[20}:0^[10}.!0.0^_1[00}.2,:(i10)^[31}'(c(),.1C=?{.2R0${f,:"
"9^,.6,.5,:8^[04}X1]3}'(cu),.1C=?{.2R0'(c8),.3R0q?{'(c(),.3R0q}{f}?{${."
"4,:7^[01}E1]3}.2,'(y5:port:),'(s25:invalid bytevector syntax),@(y10:re"
"ad-error)[33}'(c%5c),.1C=?{.2R0.2R1,.0R8?{.3,'(y5:port:),'(s20:end of "
"file after #%5c),@(y10:read-error)[43}.0,'(cx)C=?{.3R0${.5R1,:5^[01}?{"
".0]4}f,.4,:6^[42}.0C4?{${.5,:3^[01},'1,.1X4S3=?{.1]5}.0,'(y4:null),.1v"
"?{'0X9]6}'(y5:space),.1v?{'(c )]6}'(y5:alarm),.1v?{'(c%07)]6}'(y9:back"
"space),.1v?{'(c%08)]6}'(y6:delete),.1v?{'(i127)X9]6}'(y6:escape),.1v?{"
"'(i27)X9]6}'(y3:tab),.1v?{'(c%09)]6}'(l2:y7:newline;y8:linefeed;),.1A1"
"?{'(c%0a)]6}'(y4:vtab),.1v?{'(c%0b)]6}'(y4:page),.1v?{'(c%0c)]6}'(y6:r"
"eturn),.1v?{'(c%0d)]6}.5,'(y5:port:),.3,'(s15:unknown #%5c name),@(y10"
":read-error)[64}.3R0.0]4}.0C5?{:0?{${.4,'(y5:port:),'(s44:#N=/#N# nota"
"tion is not allowed in this mode),@(y10:read-error)[03}}n,,#0.4,.1,:4,"
":3,:2,:1,&6{%1:5R0,.0R8?{:5,'(y5:port:),'(s32:end of file within a #N "
"notation),@(y10:read-error)[23}.0C5?{.1,.1c,:4^[21}'(c#),.1C=?{.1A9X3,"
"'(i10),.1E9,.0I0?{:0^,.1A3}{f},.0?{.0d]5}'(s22:unknown #n# reference:)"
",'(y5:port:),.4,@(y10:read-error)[53}'(c=),.1C=?{.1A9X3,'(i10),.1E9,.0"
"I0~?{${'(s22:invalid #n= reference:),'(y5:port:),.5,@(y10:read-error)["
"03}}{:0^,.1A3?{${'(s18:duplicate #n= tag:),'(y5:port:),.4,@(y10:read-e"
"rror)[03}}{f}}fb,:0^,${.3,:1^[01},.3cc:!0${:5,:2^[01},${.2,:3^[01}?{'("
"s31:#n= has another label as target),'(y5:port:),.5,@(y10:read-error)["
"63}.0,.2sz.0]6}:5,'(y5:port:),'(s34:invalid terminator for #N notation"
"),@(y10:read-error)[23}.!0.0^_1[31}.2,'(y5:port:),.2,'(s16:unknown # s"
"yntax),@(y10:read-error)[34}.1,'(y5:port:),.2,'(s22:illegal character "
"read),@(y10:read-error)[24}.!(i16).(i16),.(i12),.(i17),.(i13),&4{%4${."
"3,:3^[01},:0^,.1q?{.2,'(y5:port:),'(s42:missing car -- ( immediately f"
"ollowed by .),@(y10:read-error)[53}.0,,#0.0,.5,:3,:2,.(i10),:1,.(i11),"
":0,&8{%1.0R8?{:6,'(y5:port:),'(s41:eof inside list -- unbalanced paren"
"theses),@(y10:read-error)[13}:1,.1q?{n]1}:0^,.1q?{:3?{${:6,:2^[01},${:"
"6,:5^[01},:1,.1q?{.1]3}:6,'(y5:port:),.2,'(s31:randomness after form a"
"fter dot),@(y10:read-error)[34}:6,'(y5:port:),'(s13:dot in #(...)),@(y"
"10:read-error)[13}${.2,:4^[01}?{:6,'(y5:port:),.2d,'(s20:error inside "
"list --),@(y10:read-error)[14}${${:6,:5^[01},:7^[01},.1c]1}.!0.0^_1[51"
"}.!(i17).(i16),.9,.(i13),&3{%1${.2,:2^[01},,#0.0,.3,:2,:0,:1,&5{%1.0R8"
"?{:3,'(y5:port:),'(s21:eof inside bytevector),@(y10:read-error)[13}:0^"
",.1q?{n]1}${.2,:1^[01}?{:3,'(y5:port:),.2d,'(s26:error inside bytevect"
"or --),@(y10:read-error)[14}.0I0~,.0?{.0}{'0,.2I<,.0?{.0}{'(i255),.3I>"
"}_1}_1?{:3,'(y5:port:),.2,'(s33:invalid byte inside bytevector --),@(y"
"10:read-error)[14}${${:3,:2^[01},:4^[01},.1c]1}.!0.0^_1[11}.!(i18).(i2"
"0),&1{%2.0R0,.0R8?{${.3,'(y5:port:),.6,'(s20:end of file within a),@(y"
"10:read-error)[04}}'(c%5c),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c|),.3C"
"=}_1}_1?{.0]3}'(ca),.1C=?{'(c%07)]3}'(cb),.1C=?{'(c%08)]3}'(ct),.1C=?{"
"'(c%09)]3}'(cn),.1C=?{'(c%0a)]3}'(cv),.1C=?{'(c%0b)]3}'(cf),.1C=?{'(c%"
"0c)]3}'(cr),.1C=?{'(c%0d)]3}'(cx),.1C=?{t,.2,:0^[32}'(y6:string),.3q?{"
".0C1}{f}?{.1R1,'(c%0a),.2C=,,#0.0,.5,&2{%2.1R8,.0?{.0}{.2C1~}_1?{.0?{f"
"]2}:0,'(y5:port:),'(s32:no newline in line ending escape),@(y10:read-e"
"rror)[23}.0?{'(c%0a),.2C=}{f}?{f]2}:0R0:0R1,.1,.0?{.0}{'(c%0a),.4C=}_1"
",:1^[22}.!0.0^_1[32}.1,'(y5:port:),.2,'(y1::),.6,'(s22:invalid char es"
"cape in),@(y10:read-error)[36}.!(i19).(i14),.(i14),&2{%2,#0.1,&1{%1.0u"
"?{:0,'(y5:port:),'(s31:%5cx escape sequence is too short),@(y10:read-e"
"rror)[13}'(i16),.1A9X3X7X9]1}.!0'0,n,.3R1,,#0.0,.6,:0,.7,.(i10),:1,&6{"
"%3.0R8?{:1?{:4,'(y5:port:),'(s27:end of file within a string),@(y10:re"
"ad-error)[33}.1,:2^[31}:1?{'(c;),.1C=}{f}?{:4R0.1,:2^[31}:1~?{${.2,:0^"
"[01}}{f}?{.1,:2^[31}${.2,:3^[01}~?{:4,'(y5:port:),.2,'(s37:unexpected "
"char in %5cx escape sequence),@(y10:read-error)[34}'2,.3>?{:4,'(y5:por"
"t:),'(s30:%5cx escape sequence is too long),@(y10:read-error)[33}:4R0'"
"1,.3+,.2,.2c,:4R1,:5^[33}.!0.0^_1[33}.!(i20)&0{%4.0,.0?{.0}{.2C5}_1?{f"
"]4}'(s2:+i),.4Si=,.0?{.0}{'(s2:-i),.5Si=}_1?{f]4}'(s6:+nan.0),.4Si=,.0"
"?{.0}{'(s6:-nan.0),.5Si=}_1?{f]4}'(s6:+inf.0),.4Si=,.0?{.0}{'(s6:-inf."
"0),.5Si=}_1?{f]4}'(c+),.2C=,.0?{.0}{'(c-),.3C=}_1?{.2du?{t]4}'(c.),.3d"
"aC=?{.2ddp?{.2ddaC5~]4}f]4}.2daC5~]4}'(c.),.2C=?{.2dp?{.2daC5~]4}f]4}f"
"]4}.!(i21).(i14),.(i22),.(i12),.3,.(i16),&5{%2'(c#),.1C=,.1,l1,.3R1,,#"
"0.5,.1,:0,:1,:2,:3,:4,&7{%3.0R8,.0?{.0}{${.3,:0^[01}}_1?{.1A9,.0a,.1X3"
",.5,.0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0?{.0}{'(c-),.5C=,.0?{.0}{'(c.),."
"6C=}_1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}${.2,.5,.5,.(i10),:1^[04}?{:3^?{."
"0SfX5]6}.0X5]6}'(i10),.1E9,.0?{.0]7}:6,'(y5:port:),.3,'(s54:unsupporte"
"d number syntax (implementation restriction)),@(y10:read-error)[74}:3^"
"?{.0SfX5]6}.0X5]6}'(c#),.1C=?{:6R0t,.2,.2c,:6R1,:5^[33}${.2,:4^[01}?{:"
"6R0.2,.2,.2c,:6R1,:5^[33}:6,'(y5:port:),.2,'(s29:unexpected number/sym"
"bol char),@(y10:read-error)[34}.!0.0^_1[23}.!(i22)${.(i25),.(i19)^[01}"
",${.2,.(i15)^[01}~?{.2^u?{.0](i26)}.0,.8^[(i26)1}.(i24),'(y5:port:),.2"
"d,'(s17:unexpected token:),@(y10:read-error)[(i26)4",
"C", 0,
"&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,Pi,@(y5:%25read)[02}%x,&2{|00|11%"
@ -1112,5 +1115,14 @@ char *s_code[] = {
"(y13:apply-to-list)[02}.1P90]4}t,.2q?{.0,Poc,@(y7:fprintf),@(y13:apply"
"-to-list)[22}.0,.2c,@(y7:fprintf),@(y13:apply-to-list)[22",
"P", "write-to-string",
"%1P51,.0,.2W5.0P90,.1P61.0]3",
"P", "read-from-string",
"%1.0P50,${${k0,.0,${.2,.9,&2{%0:1,&1{%!0.0,&1{%0:0,@(y6:values),@(y13:"
"apply-to-list)[02},:0[11},:0,&1{%0:0,@(y4:read)[01},@(y16:call-with-va"
"lues)[02},.3,&1{%1${k0,.0,${.6,&1{%0:0,R9]1},:0[01}_1_3}[10},@(y22:wit"
"h-exception-handler)[02}_1_3}[00},.1P60.0]3",
0, 0, 0
};

View file

@ -2813,7 +2813,6 @@ default: /* inter-host call */
(syntax-rules () [(_ x) (delay-force (make-promise x))]))
; eof
; eof is tagged immediate with payload 0 and immediate tag 7
@ -2836,6 +2835,17 @@ default: /* inter-host call */
(%prim "bool(iseof(obj_from_$arg))" x))
; shebangs
; shebangs are symbol-like immediates with immediate tag 8
(%definition "/* shebangs (#! directives or script start lines) */")
(%definition "#define SHEBANG_ITAG 8")
(%definition "#define isshebang(o) (isimm(o, SHEBANG_ITAG))")
(%definition "#define mkshebang(i) mkimm(i, SHEBANG_ITAG)")
(%definition "#define getshebang(o) getimmu(o, SHEBANG_ITAG)")
; i/o ports
; internal helper fo opening regular files
@ -3756,8 +3766,11 @@ static void wrdatum(obj o, wenv_t *e) {
wrs(buf, e);
} else if (iseof(o)) {
wrs(\"#<eof>\", e);
} else if (o == obj_from_void(0)) {
} else if (isvoid(o)) {
wrs(\"#<void>\", e);
} else if (isshebang(o)) {
char *s = symbolname(getshebang(o));
wrs(\"#<!\", e); wrs(s, e); wrc('>', e);
} else if (o == obj_from_unit()) {
wrs(\"#<values>\", e);
} else if (isiport(o)) {
@ -3854,8 +3867,6 @@ static void wrdatum(obj o, wenv_t *e) {
wrc(' ', e); wrdatum(recordref(o, i), e);
}
wrc('>', e);
} else if (isvoid(o)) {
wrs(\"#<void>\", e);
} else {
wrs(\"#<unknown>\", e);
}

View file

@ -1656,6 +1656,17 @@
[(char=? c #\#)
(let ([c (peek-char p)])
(cond [(eof-object? c) (r-error p "end of file after #")]
[(char=? c #\!)
(read-char p)
(let ([name (sub-read-carefully p)])
(case name
[(fold-case no-fold-case)
(set! fold-case? (eq? name 'fold-case))
(set-port-fold-case! p fold-case?)
(sub-read p)]
[else (if (symbol? name)
(symbol->shebang name)
(r-error p "unexpected name after #!" name))]))]
[(or (char-ci=? c #\t) (char-ci=? c #\f))
(let ([name (sub-read-carefully p)])
(case name [(t true) #t] [(f false) #f]
@ -2045,3 +2056,18 @@
(apply fprintf p args) (get-output-string p))]
[(eq? arg #t) (apply fprintf (current-output-port) args)]
[else (apply fprintf arg args)]))
(define (write-to-string obj)
(let ([p (open-output-string)])
(write obj p)
(let ([s (get-output-string p)])
(close-output-port p)
s)))
(define (read-from-string str)
(let* ([p (open-input-string str)]
[obj (guard (err [else (eof-object)]) (read p))])
(close-input-port p)
obj))

View file

@ -1729,11 +1729,16 @@
(define *library-path-list* '("./")) ; will do for now; FIXME: get access to real separator!
(define (add-library-path! path)
(define (append-library-path! path)
(if (base-path-separator path)
(set! *library-path-list* (append *library-path-list* (list path)))
(c-error "library path should end in directory separator" path)))
(define (prepend-library-path! path)
(if (base-path-separator path)
(set! *library-path-list* (append (list path) *library-path-list*))
(c-error "library path should end in directory separator" path)))
(define (find-library-path listname) ;=> name of existing .sld file or #f
(let loop ([l *library-path-list*])
(and (pair? l)
@ -2313,6 +2318,7 @@
(define ci? #f) ; do not bother setting this unless told by the specification
(let* ([filepath (and (string? filename) (file-resolve-relative-to-current filename))]
[fileok? (and (string? filepath) (file-exists? filepath))])
(unless fileok? (error "cannot load file" filename filepath))
(with-current-file filepath
(lambda ()
(call-with-input-file filepath

18
t.c
View file

@ -994,11 +994,16 @@ char *t_code[] = {
"C", 0,
"'(l1:s2:./;)@!(y19:*library-path-list*)",
"P", "add-library-path!",
"P", "append-library-path!",
"%1${.2,@(y19:base-path-separator)[01}?{.0,l1,@(y19:*library-path-list*"
")L6@!(y19:*library-path-list*)]1}.0,'(s46:library path should end in d"
"irectory separator),@(y7:c-error)[12",
"P", "prepend-library-path!",
"%1${.2,@(y19:base-path-separator)[01}?{@(y19:*library-path-list*),.1,l"
"1L6@!(y19:*library-path-list*)]1}.0,'(s46:library path should end in d"
"irectory separator),@(y7:c-error)[12",
"P", "find-library-path",
"%1@(y19:*library-path-list*),,#0.0,.3,&2{%1.0p?{${'(s4:.sld),.3a,:0,@("
"y14:listname->path)[03},.0?{.0F0}{f}?{.0]2}.1d,:1^[21}f]1}.!0.0^_1[11",
@ -1449,11 +1454,12 @@ char *t_code[] = {
"P", "load",
"%!1,,#0#1.2p?{.2a}{${@(y23:interaction-environment)[00}}.!0f.!1.3S0?{$"
"{.5,@(y32:file-resolve-relative-to-current)[01}}{f},.0S0?{.0F0}{f},${."
"5,.5,.5,&3{%0:1,:2,&2{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01},,#"
"0:1,.3,.2,&3{%1.0R8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp"
")[01},:0^[11}]1}.!0.0^_1[11},:0,@(y20:call-with-input-file)[02},.4,@(y"
"17:with-current-file)[02}_1_1Y9]4",
"{.5,@(y32:file-resolve-relative-to-current)[01}}{f},.0S0?{.0F0}{f},.0~"
"?{${.3,.8,'(s16:cannot load file),@(y5:error)[03}}${.5,.5,.5,&3{%0:1,:"
"2,&2{%1:0^?{t,.1P79}${.2,@(y14:read-code-sexp)[01},,#0:1,.3,.2,&3{%1.0"
"R8~?{${:2^,.3,@(y4:eval)[02}${:1,@(y14:read-code-sexp)[01},:0^[11}]1}."
"!0.0^_1[11},:0,@(y20:call-with-input-file)[02},.4,@(y17:with-current-f"
"ile)[02}_1_1Y9]4",
"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"