From 0763791fe3de694e94cdcde8bddb8a3f4668f1a0 Mon Sep 17 00:00:00 2001 From: ESL Date: Wed, 17 Jul 2024 17:47:08 -0400 Subject: [PATCH] support for #! shebangs of various use --- i.c | 24 +++++++ i.h | 3 + n.c | 12 +++- n.h | 5 ++ s.c | 212 ++++++++++++++++++++++++++++-------------------------- src/n.sf | 19 +++-- src/s.scm | 26 +++++++ src/t.scm | 8 ++- t.c | 18 +++-- 9 files changed, 213 insertions(+), 114 deletions(-) diff --git a/i.c b/i.c index 428a116..6581037 100644 --- a/i.c +++ b/i.c @@ -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(); diff --git a/i.h b/i.h index c1a1184..001940c 100644 --- a/i.h +++ b/i.h @@ -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) diff --git a/n.c b/n.c index 7d73991..143a34c 100644 --- a/n.c +++ b/n.c @@ -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("#", e); - } else if (o == obj_from_void(0)) { + } else if (isvoid(o)) { wrs("#", e); + } else if (isshebang(o)) { + char *s = symbolname(getshebang(o)); + wrs("#', e); } else if (o == obj_from_unit()) { wrs("#", 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("#", e); } else { wrs("#", e); } diff --git a/n.h b/n.h index df6c9db..aece6d5 100644 --- a/n.h +++ b/n.h @@ -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; diff --git a/s.c b/s.c index f9f5f9d..b4b15c5 100644 --- a/s.c +++ b/s.c @@ -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 }; diff --git a/src/n.sf b/src/n.sf index 7df9239..6882f41 100644 --- a/src/n.sf +++ b/src/n.sf @@ -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(\"#\", e); - } else if (o == obj_from_void(0)) { + } else if (isvoid(o)) { wrs(\"#\", e); + } else if (isshebang(o)) { + char *s = symbolname(getshebang(o)); + wrs(\"#', e); } else if (o == obj_from_unit()) { wrs(\"#\", 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(\"#\", e); } else { wrs(\"#\", e); } diff --git a/src/s.scm b/src/s.scm index b002138..adf553b 100644 --- a/src/s.scm +++ b/src/s.scm @@ -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)) + + diff --git a/src/t.scm b/src/t.scm index 560be09..f1f915f 100644 --- a/src/t.scm +++ b/src/t.scm @@ -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 diff --git a/t.c b/t.c index cd8bb4e..b877982 100644 --- a/t.c +++ b/t.c @@ -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"