ref: df55d10a88b7ac80aeabe1f01484b37a2e404961
parent: b919a8a8873b9b191c056e8124363b7d9e1d506f
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Mar 13 23:21:53 EDT 2025
rename to shorten string → str number → num integer → int iostream → io and so on.
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -18,11 +18,11 @@
doc options... (slot-1 DEFAULT) slot-2 (slot-3 :read-only))
(name (:type vector) (:named T) (:constructor T) (:conc-name NIL) (:predicate NIL) . slots)) help ((term)) length= ((lst
n)) __finish ((status)) doc-for ((term (doc NIL))) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) car ((lst)) <= ((a . rest)) add-exit-hook ((fun)) /= ((a . rest)) lz-pack ((data
- (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) rand-double (NIL) * ((number…)) cdr ((lst)) + ((number…)) > ((a . rest))) *doc* #table(>= "Return T if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return T if x is #<void>, NIL otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." doc-for "Define documentation for a top level term.\nIf the optional doc argument is missing and the term is a function\nsignture, adds it to the documentation." car "Return the first element of a list or NIL if not available." *builtins* "VM instructions as closures." <= "Return T if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though T or NIL could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." rand "Return a random non-negative fixnum on its maximum range." nan? "Return T if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return T if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Return the tail of a list or NIL if not available." + "Return sum of the numbers or 0 with no arguments." __finish "A function called right before exit by the VM." lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." help "Display documentation for the specified term, if available." defstruct "Defines a structure type with a specific name and slots.\nThe default underlying type is a named vector, ie the first element is\nthe name of the structure type, the rest are the slot values. If the\nname as the first element isn't required, \":named NIL\" should be\nused. A list can be used instead of a vector by adding \":type list\"\noption.\n\nThe option :conc-name specifies the slot accessor prefix, which\ndefaults to \"name-\".\n\nDefault predicate name (\"name?\") can be changed:\n (defstruct blah :predicate blargh? a b c)" rand-u32 "Return a random integer on [0, 2³²-1] interval." = "Return T if the arguments are equal." rand-u64 "Return a random integer on [0, 2⁶⁴-1] interval." add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) 0 on success and any other number on\nerror." /= "Return T if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." arg-counts "VM instructions mapped to their expected arguments count." rand-float "Return a random float on [0.0, 1.0] interval." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Return T if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
+ (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) rand-double (NIL) * ((num…)) cdr ((lst)) + ((num…)) > ((a . rest))) *doc* #table(>= "Return T if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return T if x is #<void>, NIL otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." doc-for "Define documentation for a top level term.\nIf the optional doc argument is missing and the term is a function\nsignture, adds it to the documentation." car "Return the first element of a list or NIL if not available." *builtins* "VM instructions as closures." <= "Return T if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though T or NIL could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." rand "Return a random non-negative fixnum on its maximum range." nan? "Return T if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return T if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Return the tail of a list or NIL if not available." + "Return sum of the numbers or 0 with no arguments." __finish "A function called right before exit by the VM." lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." help "Display documentation for the specified term, if available." defstruct "Defines a structure type with a specific name and slots.\nThe default underlying type is a named vector, ie the first element is\nthe name of the structure type, the rest are the slot values. If the\nname as the first element isn't required, \":named NIL\" should be\nused. A list can be used instead of a vector by adding \":type list\"\noption.\n\nThe option :conc-name specifies the slot accessor prefix, which\ndefaults to \"name-\".\n\nDefault predicate name (\"name?\") can be changed:\n (defstruct blah :predicate blargh? a b c)" rand-u32 "Return a random integer on [0, 2³²-1] interval." = "Return T if the arguments are equal." rand-u64 "Return a random integer on [0, 2⁶⁴-1] interval." add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) 0 on success and any other number on\nerror." /= "Return T if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." arg-counts "VM instructions mapped to their expected arguments count." rand-float "Return a random float on [0.0, 1.0] interval." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Return T if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
*syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void symbol-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings
- *input-stream* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if+ with-bindings *io-in*
+ #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc symbol-set-doc void set-syntax! quote #fn(nconc) λ #fn(copy-list))) time #fn("n1202122e1e2e123024252622e121e32728e5e3e3:" #(let #:g352 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn("z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)@@ -34,21 +34,21 @@
#fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!)))) let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc) λ #fn(map) #fn("n10B3500<:0:" #()) #fn(copy-list) #fn("n10B3500T:7060:" #(void)) letrec)) bcode:code #fn("n1200Ee3:" #(aref)) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) > #fn("z12021e12273151510e163:" #(#fn(nconc)- < #fn(copy-list) reverse!)) when #fn("z1200211Pqe4:" #(if begin)) quasiquote #fn("n1700E62:" #(bq-process)) help #fn("n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getprop+ < #fn(copy-list) reverse!)) when #fn("z1200211Pqe4:" #(if begin)) quasiquote #fn("n1700E62:" #(bq-process)) help #fn("n17002152853W072855147350424250>170026q535247350@>072270524735047860:" #(getprop *doc* princ newline #fn(for-each) #fn("n17050471A0P61:" #(newline print)) *funvars* "no help for "- #fn(string) void)) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5142586<51;360486<8=;360486=;J50486268>5127288>528<8>51292:12;525185;J>04292:02;525183;3`0483H;3Q0483DQ;3>04292:2<05251;J504838AP;J5048382;36040e184;J:042:02=522>2?e12@8C2Ae22B8B2Ae22C2D2E8Ee2e22F2G2AEe32E0e2e3e32H2I2Ae2268E518?Me3e4e3e12J8=2K2E0e28=e3e3e18D3X02@8D2>1e12>2Ee12L8E5152e12L8@5153e3@30qe12L7M2N8;8A8@8F8C8E0>78?525165:" #(#(NIL+ void)) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5142586<51;360486<8=;360486=;J50486268>5127288>528<8>51292:12;525185;J>04292:02;525183;3`0483H;3Q0483DQ;3>04292:2<05251;J504838AP;J5048382;36040e184;J:042:02=522>2?e12@8C2Ae22B8B2Ae22C2D2E8Ee2e22F2G2AEe32E0e2e3e32H2I2Ae2268E518?Me3e4e3e12J8=2K2E0e28=e3e3e18D3X02@8D2>1e12>2Ee12L8E5152e12L8@5153e3@30qe12L7M2N8;8A8@8F8C8E0>78?525165:" #(#(NILNIL :named 1 :conc-name 3 :type 0 NIL NIL NIL NIL NIL NIL :predicate 4 NIL NIL NIL NIL NIL NIL
:constructor 2) vector #0# #fn("n17005121220A>28552485:" #(cddr #fn(for-each) #fn("n17002152340q:722324A<25F2605661:" #(member- (:read-only) error #fn(string) "invalid option in slot " " of struct " ": "))) slot-opts)
+ (:read-only) error #fn(str) "invalid option in slot " " of struct " ": "))) slot-opts)
#fn("n17021062:" #(map! #fn("n10B;35040<85;J404085;35040=;J604qe186RS;J9042086513=071228652@30q4232425268652512087<51390q87P@408762:" #(#fn(keyword?)error "invalid slot name: " #fn(list*) #fn(symbol)
- #fn(string) ":"))) tokw) #fn(string?) #fn(length)
- #fn(map) #fn("n10B3500<:0:" #()) #fn(symbol) #fn(string) "?" "make-" "-" #fn(nconc) begin def s- and or not quote eq? aref = length when symbol-set-doc #fn(copy-list) map-int #fn("n1A<70F05251709205221229386525123872425Ie2e3269424e2e2272825e229242:95510Me37;2<85523O02=2>2?2@86e22A2@96e22Be6e2@B02C242:95510M25e4e4e4:" #(list-ref- #fn(symbol) #fn(string) def s v assert if void? aref #fn(length) member :read-only error string
- "slot " quote " in struct " " is :read-only" aset!)))) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *output-stream* #fn(copy-list))) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch+ #fn(str) ":"))) tokw) #fn(str?) #fn(length) #fn(map)
+ #fn("n10B3500<:0:" #()) #fn(symbol) #fn(str) "?" "make-" "-" #fn(nconc) begin def s and or not+ quote eq? aref = length when symbol-set-doc #fn(copy-list) map-int #fn("n1A<70F05251709205221229386525123872425Ie2e3269424e2e2272825e229242:95510Me37;2<85523O02=2>2?2@86e22A2@96e22Be6e2@B02C242:95510M25e4e4e4:" #(list-ref+ #fn(symbol) #fn(str) def s v assert if void? aref #fn(length) member :read-only error str "slot "
+ quote " in struct " " is :read-only" aset!)))) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings *io-out* #fn(copy-list))) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch λ #:g347 if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc) λ #fn(copy-list) caar let* cadar)) letrec #fn("z1202021e12273052e122240522515154e1227605262:" #(#fn(nconc) λ #fn(map) car #fn("n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))@@ -66,16 +66,16 @@
<= #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JL041<0L2;J5040V340q:A<1<1=62:" #())) <=) > #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JE041<0L2;3;04A<1<1=62:" #())) >) >= #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JL0401<L2;J5040V340q:A<1<1=62:" #())) >=)- Instructions #table(call.l #byte(0x51) trycatch #byte(0x4b) loadg.l #byte(0x44) aref2 #byte(0x17) box #byte(0x32) cadr #byte(0x24) argc #byte(0x3e) setg #byte(0x47) load0 #byte(0x15) nan? #byte(0x26) vector? #byte(0x2d) fixnum? #byte(0x29) loadc0 #byte(0x11) loada0 #byte(0x0) div0 #byte(0x3b) keyargs #byte(0x1f) call #byte(0x5) loada.l #byte(0x45) sub2 #byte(0x4e) add2 #byte(0x1d) loadc.l #byte(0x46) loadc #byte(0x9) builtin? #byte(0x2b) set-car! #byte(0x2f) vargc.l #byte(0x50) ret #byte(0xa) loadi8 #byte(0x42) tapply #byte(0x4d) loadvoid #byte(0x19) loada1 #byte(0x1) shift #byte(0x2e) atom? #byte(0x18) cdr #byte(0xd) brne.l #byte(0x53) / #byte(0x3a) equal? #byte(0x34) apply #byte(0x36) dup #byte(0xb) loadt #byte(0x14) jmp.l #byte(0x30) = #byte(0x3c) not #byte(0x23) set-cdr! #byte(0x1e) eq? #byte(0x21) * #byte(0x39) load1 #byte(0x1b) bound? #byte(0x2a) function? #byte(0x2c) box.l #byte(0x56) < #byte(0x1c) brnn.l #byte(0x54) jmp #byte(0x10) loadv #byte(0x2) for #byte(0x4c) dummy_eof #byte(0x58) + #byte(0x37) brne #byte(0x13) argc.l #byte(0x4f) compare #byte(0x3d) brn #byte(0x3) neg #byte(0x25) number? #byte(0x28) loadv.l #byte(0x43) vargc #byte(0x4a) brbound #byte(0x27) vector #byte(0x3f) loadc1 #byte(0x16) setg.l #byte(0x48) cons? #byte(0x12) aref #byte(0x55) symbol? #byte(0x22) aset! #byte(0x40) car #byte(0xc) cons #byte(0x20) tcall.l #byte(0x52) - #byte(0x38) brn.l #byte(0x31) optargs #byte(0x57) closure #byte(0xe) pop #byte(0x4) eqv? #byte(0x33) list #byte(0x35) seta #byte(0xf) seta.l #byte(0x49) brnn #byte(0x1a) loadnil #byte(0x41) loadg #byte(0x7) loada #byte(0x8) tcall #byte(0x6))
+ Instructions #table(call.l #byte(0x51) trycatch #byte(0x4b) loadg.l #byte(0x44) aref2 #byte(0x17) box #byte(0x32) cadr #byte(0x24) argc #byte(0x3e) setg #byte(0x47) load0 #byte(0x15) nan? #byte(0x26) vector? #byte(0x2d) fixnum? #byte(0x29) loadc0 #byte(0x11) loada0 #byte(0x0) div0 #byte(0x3b) keyargs #byte(0x1f) call #byte(0x5) loada.l #byte(0x45) num? #byte(0x28) sub2 #byte(0x4e) add2 #byte(0x1d) loadc.l #byte(0x46) loadc #byte(0x9) builtin? #byte(0x2b) set-car! #byte(0x2f) vargc.l #byte(0x50) ret #byte(0xa) loadi8 #byte(0x42) tapply #byte(0x4d) loadvoid #byte(0x19) loada1 #byte(0x1) shift #byte(0x2e) atom? #byte(0x18) cdr #byte(0xd) brne.l #byte(0x53) / #byte(0x3a) equal? #byte(0x34) apply #byte(0x36) dup #byte(0xb) loadt #byte(0x14) jmp.l #byte(0x30) = #byte(0x3c) not #byte(0x23) set-cdr! #byte(0x1e) eq? #byte(0x21) * #byte(0x39) load1 #byte(0x1b) bound? #byte(0x2a) function? #byte(0x2c) box.l #byte(0x56) < #byte(0x1c) brnn.l #byte(0x54) jmp #byte(0x10) loadv #byte(0x2) for #byte(0x4c) dummy_eof #byte(0x58) + #byte(0x37) brne #byte(0x13) argc.l #byte(0x4f) compare #byte(0x3d) brn #byte(0x3) neg #byte(0x25) loadv.l #byte(0x43) vargc #byte(0x4a) brbound #byte(0x27) vector #byte(0x3f) loadc1 #byte(0x16) setg.l #byte(0x48) cons? #byte(0x12) aref #byte(0x55) symbol? #byte(0x22) aset! #byte(0x40) car #byte(0xc) cons #byte(0x20) tcall.l #byte(0x52) - #byte(0x38) brn.l #byte(0x31) optargs #byte(0x57) closure #byte(0xe) pop #byte(0x4) eqv? #byte(0x33) list #byte(0x35) seta #byte(0xf) seta.l #byte(0x49) brnn #byte(0x1a) loadnil #byte(0x41) loadg #byte(0x7) loada #byte(0x8) tcall #byte(0x6))
__finish #fn("n120210>17262:" #(#fn(for-each) #fn("n10A61:" #()) *exit-hooks*) __finish) __init_globals #fn("n07021d37022@402384w4^147025d;350426;J50427w8429w:4qw;47<w=47>w?47@wA:" #(*os-name* "macos" #fn("n0702161:" #(princ "\e[0m\e[1m#;> \e[0m")) #fn("n0702161:" #(princ "#;> ")) *prompt* "dos" "\\" "/" *directory-separator* "\n" *linefeed*- *exit-hooks* *stdout* *output-stream* *stdin* *input-stream* *stderr* *error-stream*) __init_globals)
+ *exit-hooks* *stdout* *io-out* *stdin* *io-in* *stderr* *io-err*) __init_globals)
__rcscript #fn("n0708421c360q@T08422c37023@G08424c3=07526514q@4027^184;3904288451708622c37029@402:^185;3=042;857<8653873B02=87513907>8761:q:" #(*os-name*"unknown" "plan9" "home" "macos" princ "\e]0;StreetLISP v0.999\a" "HOME" #fn(os-getenv) "lib/slrc"
- ".slrc" #fn(string) *directory-separator* #fn(path-exists?) load) __rcscript)
+ ".slrc" #fn(str) *directory-separator* #fn(path-exists?) load) __rcscript)
__script #fn("n1200>121{:" #(#fn("n070A61:" #(load)) #fn("n170051421K61:" #(top-level-exception-handler#fn(exit)))) __script)
@@ -87,7 +87,7 @@
#fn(exit)) __start)
abs #fn("n10EL23500U:0:" #() abs) add-exit-hook #fn("n1070Pw047160:" #(*exit-hooks* void) add-exit-hook) any #fn("n21B;3D0401<51;J:047001=62:" #(any) any)- arg-counts #table(bound? 1 function? 1 symbol? 1 car 1 cons 2 cadr 1 nan? 1 for 3 fixnum? 1 vector? 1 cdr 1 atom? 1 div0 2 equal? 2 eqv? 2 compare 2 not 1 number? 1 set-cdr! 2 eq? 2 builtin? 1 cons? 1 set-car! 2)
+ arg-counts #table(bound? 1 function? 1 symbol? 1 car 1 cons 2 cadr 1 nan? 1 for 3 fixnum? 1 vector? 1 cdr 1 atom? 1 div0 2 equal? 2 eqv? 2 compare 2 not 1 set-cdr! 2 num? 1 eq? 2 builtin? 1 cons? 1 set-car! 2)
argc-error #fn("n2702102211Kl237023@402465:" #(error "compile error: " " expects " " argument."" arguments.") argc-error)
array? #fn("n10];JF042005185B;390485<21Q:" #(#fn(typeof) array) array?) assoc@@ -108,7 +108,7 @@
any splice-form? lastcdr #fn(map) #fn("n1700A62:" #(bq-bracket1)) #fn(nconc) list* #fn("n20J;02071151P:0B3o00<22CX020731AEl23700=@C07425e2760=AK~52e252P:F<0=770<A521P62:2071760A521P51P:" #(nconcreverse! unquote nreconc list 'unquote bq-process bq-bracket))) bq-process)
- builtin->instruction #fn("n120A0q63:" #(#fn(get)) #(#table(#.cadr cadr #.aset! aset! #.+ + #.- - #.equal? equal? #.eq? eq? #.builtin? builtin? #.not not #.cons? cons? #.cdr cdr #./ / #.div0 div0 #.set-car! set-car! #.vector vector #.set-cdr! set-cdr! #.< < #.aref aref #.for for #.cons cons #.apply apply #.eqv? eqv? #.vector? vector? #.list list #.car car #.bound? bound? #.nan? nan? #.function? function? #.symbol? symbol? #.compare compare #.fixnum? fixnum? #.atom? atom? #.= = #.number? number? #.* *)))+ builtin->instruction #fn("n120A0q63:" #(#fn(get)) #(#table(#.cadr cadr #.aset! aset! #.+ + #.- - #.equal? equal? #.eq? eq? #.builtin? builtin? #.not not #.cons? cons? #.cdr cdr #./ / #.div0 div0 #.set-car! set-car! #.vector vector #.set-cdr! set-cdr! #.< < #.aref aref #.for for #.cons cons #.apply apply #.eqv? eqv? #.vector? vector? #.list list #.car car #.bound? bound? #.nan? nan? #.function? function? #.symbol? symbol? #.compare compare #.fixnum? fixnum? #.atom? atom? #.= = #.num? num? #.* *))) caaaar #fn("n10<<<<:" #() caaaar) caaadr #fn("n10T<<:" #() caaadr) caaar #fn("n10<<<:" #() caaar) caadar #fn("n10<T<:" #() caadar) caaddr #fn("n10=T<:" #() caaddr) caadr@@ -166,7 +166,7 @@
compile-prog1 #fn("n37001q82T544718251B3_00r40r4GKMp47201q718251544730245240r40r4Gr/Mp:q:" #(compile-incddr compile-begin emit pop) compile-prog1)
compile-set! #fn("n470821E538821CF07201q83544730248263:88<El288=T893<07588=51@9076082528:3o07308937027@40288;5340r40r4GKMp47201q835440r40r4Gr/Mp47302962:7201q8354489360q@>07:2;2<82525147302=8;63:" #(lookup-sym- global compile-in emit setg vinfo:index capture-var! loada loadc set-car! error #fn(string)
+ global compile-in emit setg vinfo:index capture-var! loada loadc set-car! error #fn(str)
"internal error: misallocated var " seta) compile-set!)
compile-short-circuit #fn("n783H3?0700182848665:83=H3@070018283<8665:86;J70421507001q83<865540r40r4GKMp486360q@9072023524720858;5340r40r4Gr/Mp486360q@907202452475018283=84858657486340q:720268;63:" #(compile-in#fn(gensym) emit dup pop compile-short-circuit label) compile-short-circuit)
@@ -202,9 +202,9 @@
#fn(length) #fn(table-foldl) #fn("n382;J@041AF<Gl2;34040:" #()) Instructions #fn("n1702161:" #(princ"\t")) #fn(memq) (loadv.l loadg.l setg.l) ref-s32-LE (loadv loadg setg)
(loada seta loadc call tcall list + - * / < = vector argc vargc loadi8 apply tapply closure box
- shift aref) princ #fn(number->string) aref (loada.l seta.l loadc.l argc.l vargc.l call.l tcall.l
- box.l) (optargs keyargs) keyargs " " brbound
- (jmp brne brnn brn) "@" hex5 ref-s16-LE (jmp.l brne.l brnn.l brn.l)) disassemble)
+ shift aref) princ #fn(num->str) aref (loada.l seta.l loadc.l argc.l vargc.l call.l tcall.l box.l)
+ (optargs keyargs) keyargs " " brbound (jmp brne brnn brn) "@" hex5 ref-s16-LE (jmp.l brne.l
+ brnn.l brn.l)) disassemble)
div #fn("n201k0EL2;3D041EL2;3404K;J504r/;J404EM:" #() div) emit #fn("z2I2021?75140EG82Jk0122CB088<23C:08824_@R0125CE08788<513;00E88=p@900E188Pp@D126127523A078082<52e1?2@30q42912:52893D02;82<L23:089T?1@30q^142912<52893D02;82<L23:089T?1@30q^1412=C\\0822>d3=02??14q?2@F0822@d3=02A?14q?2@30q@30q412BC\\0822>d3=02C?14q?2@F0822@d3=02D?14q?2@30q@30q488<12EQ;3b04892FCB00E82<2G88=PPp@J0892HCB00E82<2I88=PPp@30q;J@040E7J182P8852p^140:" #(#0# #fn("n17002162:" #(member (load0 load1 loadt loadf loadnil loadvoid)) load?) car cdr cadr pop #fn(memq)@@ -223,12 +223,12 @@
keyargs #fn(u8) #fn(for-each) #fn("n220A052421AF37072@407324921520~5162:" #(#fn(io-seek)#fn(io-write) s32 s16
#fn(get)))
- #fn(iostream->string)) encode-byte-code)
+ #fn(io->str)) encode-byte-code)
error #fn("z020210P61:" #(#fn(raise) error) error) eval #fn("n170710515160:" #(compile-thunk macroexpand) eval) even? #fn("n1200K52El2:" #(#fn(logand)) even?) every #fn("n21H;JD0401<51;3:047001=62:" #(every) every) expand-define #fn("n10T70051B3:070051@H085R37021@=07223740515285R3@021258586<e3e2:212585<2627e185=e128865185<54e3e2:" #(cddr- #1# error "compile error: invalid syntax " print-to-string set! #fn(nconc) λ #fn(copy-list)) expand-define)
+ #1# error "compile error: invalid syntax " print-to-str set! #fn(nconc) λ #fn(copy-list)) expand-define)
extend-env #fn("n370182E530P:" #(vars-to-env) extend-env) filter #fn("n2I20210>1?65148601qe163:" #(#0# #fn("n382I1B3Q04A1<513?0821<qPN=?2@30q41=?1@\x0e/4=:" #() filter-)) filter) fits-i8 #fn("n10Y;3<0470r\xaf0r\xb063:" #(>=) fits-i8) foldl@@ -237,7 +237,7 @@
caadr begin nconc #fn(map)) #(#2#)))))
getprop #fn("\x8720003000W2000J60q?2420711q5387;3<04208708253;J50482:" #(#fn(get)*properties*) getprop)
- hex5 #fn("n170210r@52r52263:" #(string-lpad #fn(number->string) #\0) hex5) identity+ hex5 #fn("n170210r@52r52263:" #(str-lpad #fn(num->str) #\0) hex5) identity #fn("n10:" #() identity) in-env? #fn("n21B;3F042001<52;J:047101=62:" #(#fn(assq)in-env?) in-env?)
index-of #fn("n31J40q:01<C5082:7001=82KM63:" #(index-of) index-of) inlineable?@@ -245,7 +245,7 @@
list? every symbol? length> 255 length= #fn(length)) inlineable?)
io-readall #fn("n1205021850524228561:" #(#fn(buffer)#fn(io-copy)
- #fn(iostream->string)) io-readall)
+ #fn(io->str)) io-readall)
io-readline #fn("n12002162:" #(#fn(io-readuntil) #\newline) io-readline) io-readlines #fn("n17071062:" #(read-all-of io-readline) io-readlines) iota #fn("n17071062:" #(map-intidentity) iota)
@@ -252,9 +252,9 @@
is-lambda? #fn("n1020Q;J704020Q:" #(λ) is-lambda?) keyword->symbol #fn("n1200513K021220512386K24865153^161:0:" #(#fn(keyword?)#fn(symbol)
- #fn(string)
- #fn(string-sub)
- #fn(string-length)) keyword->symbol)
+ #fn(str)
+ #fn(str-sub)
+ #fn(str-length)) keyword->symbol)
keyword-arg? #fn("n10B;3904200<61:" #(#fn(keyword?)) keyword-arg?) lambda-vars #fn("n1Ib520852185>1_51485<00qq54422237405162:" #(#0# #fn("n40S;J5040R340D:0B3Z00<R3T082;J504833<0702112263:A<0=1828364:0B3\x8d00<B3\x870730<r2523?074051R360q@=070250<2615442774051513=0A<0=182D64:833<0702112863:A<0=1D8364:0B3>070290<26164:01C:07021162:7029026164:" #(error@@ -314,7 +314,7 @@
procedure? top-level-bound?) *print-pretty* *print-readably*
#fn("n0Aw04Fw1:" #(*print-pretty* *print-readably*)) #fn("n07021A>17223505152742576842577845253f22885F52429F7:52^1^142;F61:" #(filter #fn("n10Z;3u0420051S;3j0421051[S;JC0422051222105151dS;3I04230A52S;3=04242105151S:" #(#fn(constant?)- #fn(top-level-value) #fn(string) #fn(memq) #fn(iostream?))) simple-sort #fn(environment) nconc #fn(map)
+ #fn(top-level-value) #fn(str) #fn(memq) #fn(io?))) simple-sort #fn(environment) nconc #fn(map)
list top-level-value #fn(write)
#fn(io-write)
*linefeed* #fn(io-close)))
@@ -327,7 +327,7 @@
#fn("n207001521i2~:" #(div) mod) mod0 #fn("n2001k1i2~:" #() mod0) negative? #fn("n10EL2:" #() negative?) nestlist #fn("n37082E52340q:1710015182K~53P:" #(<=nestlist) nestlist)
- newline #fn("\x8700001000W0000J7070?04210725247360:" #(*output-stream* #fn(io-write)+ newline #fn("\x8700001000W0000J7070?04210725247360:" #(*io-out* #fn(io-write)*linefeed* void) newline)
nreconc #fn("n2701062:" #(reverse!-) nreconc) odd? #fn("n170051S:" #(even?) odd?) partition #fn("n2I2021?65148601qe1qe164:" #(#0#@@ -340,7 +340,7 @@
#fn("n10B3e00<20C^0710r3523T072230T2425760515127554787605151@\x0e00B3Z00<29CS0710r3523I0722:760512;534780T51@\xe100B3P00<2<CI0710r2523?0722=0T2>53@\xbe00B3I00<2?CB0722@514720=f2@\xa200B3N00<2ACG07B76051514722C0T52@\x8107D0513m0710r2523c0780<51472275140T2E8551;J60485R37072@40788551^1@>0722F514780514727G61:" #(type-errorlength= princ "type error: expected " ", got " #fn(typeof) caddr ": " print bounds-error "index "
" out of bounds for " unbound-error "eval: variable " " has no value" error "error: " load-error
- print-exception "in file " list? #fn(string?) "*** Unhandled exception: " *linefeed*) print-exception)
+ print-exception "in file " list? #fn(str?) "*** Unhandled exception: " *linefeed*) print-exception)
print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_51473740r3523F075076370r5@40r452@300517778292:2;505252Eb92<2=868889>38762:" #(#0# #fn("n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(function:name)#fn(function:code)
@@ -351,20 +351,20 @@
#fn("n220A01>321{863E0722374758651522662:27:" #(#fn("n02021AF>292524q:" #(#fn(for-each) #fn("n1A<0Fq63:" #()))) #fn("n10B3F00<20C?00T21C8072061:23061:" #(thrown-value- ffound caddr #fn(raise))) string-join #fn(map) string reverse! "/" "λ") fn-name) reverse! length>
+ ffound caddr #fn(raise))) str-join #fn(map) str reverse! "/" "λ") fn-name) reverse! length>
list-tail *interactive* filter closure? #fn(map) #fn("n10Z;380420061:" #(#fn(top-level-value))) #fn(environment) #fn(for-each) #fn("n17021A<0KGF52524222374051==52470257652492<El23?0770KG0EG52@30q49292<KM_:" #(princ "(" #fn(for-each) #fn("n1702151472061:" #(princ " " print)) vector->list ")" *linefeed*disassemble))) print-stack-trace)
- print-to-string #fn("n1205021085524228561:" #(#fn(buffer)- #fn(write)
- #fn(iostream->string)) print-to-string)
- printable? #fn("n120051;JB0471051;J80422051S:" #(#fn(iostream?) void? #fn(eof-object?)) printable?)+ print-to-str #fn("n1205021085524228561:" #(#fn(buffer)+ #fn(write)
+ #fn(io->str)) print-to-str)
+ printable? #fn("n120051;JB0471051;J80422051S:" #(#fn(io?) void? #fn(eof-object?)) printable?) putprop #fn("n320711q5387360q@F02250237118853488?7^14238708253482:" #(#fn(get)*properties* #fn(table)
#fn(put!)) putprop)
quote-value #fn("n1700513400:210e2:" #(self-evaluating? quote) quote-value) quoted?- #fn("n10<20Q:" #(quote) quoted?) random #fn("n1200513<0712250062:23500i2:" #(#fn(integer?)+ #fn("n10<20Q:" #(quote) quoted?) random #fn("n1200513<0712250062:23500i2:" #(#fn(int?)mod #fn(rand) #fn(rand-double)) random)
read-all #fn("n17071062:" #(read-all-of read) read-all) read-all-of #fn("n2Ib686201860>3_486<^1q015162:" #(#fn("n220A5138071061:F<10P92A5162:" #(#fn(io-eof?)@@ -377,9 +377,9 @@
#fn(del!)) remprop)
repl #fn("n0IIb4b5208421_5142085228485>2_51485<5047360:" #(#0# #fn("n07050421725142324{257651S;3Z04778451788551360q@=079855147:5047;85w<61:" #(*prompt*- #fn(io-flush) *output-stream* #fn("n02060:" #(#fn(read)))- #fn("n1207151422061:" #(#fn(io-discardbuffer) *input-stream* #fn(raise)))- #fn(io-eof?) *input-stream* load-process void? print newline void that) prompt)
+ #fn(io-flush) *io-out* #fn("n02060:" #(#fn(read)))+ #fn("n1207151422061:" #(#fn(io-discardbuffer) *io-in* #fn(raise)))+ #fn(io-eof?) *io-in* load-process void? print newline void that) prompt)
#fn("n020A>121{370F<60:q:" #(#fn("n0A<60:" #()) #fn("n1700514D:" #(top-level-exception-handler))) reploop) newline) repl) revappend #fn("n2701062:" #(reverse-) revappend) reverse@@ -393,23 +393,25 @@
#fn("n10AL2:" #()))) #fn("n22071051Ae17115163:" #(#fn(nconc) simple-sort))) simple-sort) splice-form? #fn("n10B;3X040<20Q;JN040<21Q;JD040<22Q;3:04730r252;J704022Q:" #(unquote-splicingunquote-nsplicing unquote length>) splice-form?)
- string-join #fn("n20J5020:215022860<5242324861>20=524258661:" #("" #fn(buffer)- #fn(io-write)
- #fn(for-each)
- #fn("n120AF52420A062:" #(#fn(io-write)))- #fn(iostream->string)) string-join)
- string-lpad #fn("n3207182122051~52062:" #(#fn(string) string-rep #fn(string-length)) string-lpad)- string-map #fn("n2205021151EI8887L23O0422860231885251524748851?8@\f/^14258661:" #(#fn(buffer)- #fn(string-length) #fn(io-putc) #fn(string-char) 1+ #fn(iostream->string)) string-map)
- string-rep #fn("n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=- "" #fn(string) odd? string-rep) string-rep)
- string-rpad #fn("n32007182122051~5262:" #(#fn(string) string-rep #fn(string-length)) string-rpad)- string-tail #fn("n2200162:" #(#fn(string-sub)) string-tail) string-trim+ str-join #fn("n20J5020:215022860<5242324861>20=524258661:" #("" #fn(buffer)+ #fn(io-write)
+ #fn(for-each)
+ #fn("n120AF52420A062:" #(#fn(io-write)))+ #fn(io->str)) str-join)
+ str-lpad #fn("n3207182122051~52062:" #(#fn(str) str-rep #fn(str-length)) str-lpad)+ str-map #fn("n2205021151EI8887L23O0422860231885251524748851?8@\f/^14758661:" #(#fn(buffer)+ #fn(str-length) #fn(io-putc) #fn(str-char) 1+ ios->str) str-map)
+ str-rep #fn("n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=+ "" #fn(str) odd? str-rep) str-rep)
+ str-rpad #fn("n32007182122051~5262:" #(#fn(str) str-rep #fn(str-length)) str-rpad)+ str-tail #fn("n2200162:" #(#fn(str-sub)) str-tail) str-trim #fn("n3IIb7b820872187>1_51420882288>1_5142305124087<01E895488<082895363:" #(#0#- #fn("n48283L23P02012108252523A0A<017282518364:82:" #(#fn(string-find)- #fn(string-char) 1+) trim-start) #fn("n3E82L23R020121072825152523?0A<0172825163:82:" #(#fn(string-find)- #fn(string-char) 1-) trim-end) #fn(string-length)
- #fn(string-sub)) string-trim)
+ #fn("n48283L23P02012108252523A0A<017282518364:82:" #(#fn(str-find)+ #fn(str-char) 1+) trim-start) #fn("n3E82L23R020121072825152523?0A<0172825163:82:" #(#fn(str-find)+ #fn(str-char)
+ 1-) trim-end)
+ #fn(str-length)
+ #fn(str-sub)) str-trim)
symbol-set-doc #fn("z213=070021153@30q482B3\\072023q53742587>18252700232687885253^1^1@30q47760:" #(putprop *doc* getprop *funvars* filter #fn("n1700A52S:" #(member))#fn(append) void) symbol-set-doc)
@@ -428,8 +430,8 @@
table-values #fn("n12021q063:" #(#fn(table-foldl) #fn("n3182P:" #())) table-values) to-proper #fn("n10J400:0H3600e1:0<700=51P:" #(to-proper) to-proper)- top-level-exception-handler #fn("n17071w042285>1230>12486>1{86504:" #(*output-stream*- *stderr* #fn("n0Aw0:" #(*output-stream*))+ top-level-exception-handler #fn("n17071w042285>1230>12486>1{86504:" #(*io-out* *stderr*+ #fn("n0Aw0:" #(*io-out*)) #fn("n070A51471225061:" #(print-exception print-stack-trace #fn(stacktrace))) #fn("n1A50420061:" #(#fn(raise)))) top-level-exception-handler) trace #fn("n120051718551Jc02207324252627280e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)@@ -439,7 +441,7 @@
untrace #fn("n1200517185513C0220238551r3G52@30q^147460:" #(#fn(top-level-value) traced?#fn(set-top-level-value!)
#fn(function:vals) void) untrace)
- value-get-doc #fn("n10<0=208551;3=0486B;350485:" #(#fn(string?)) value-get-doc) values+ value-get-doc #fn("n10<0=208551;3=0486B;350485:" #(#fn(str?)) value-get-doc) values #fn("z00B3:00=J500<:A0P:" #() #(#3#)) vars-to-env #fn("n32021182>2072230515163:" #(#fn(map) #fn("n2700210A52SS1FM63:" #(vinfo #fn(memq))) iota #fn(length)) vars-to-env) vector->list #fn("n120051qb6K852186085>3|486<:" #(#fn(length)--- a/meson.build
+++ b/meson.build
@@ -56,8 +56,8 @@
'src/slmain.c',
'src/hashing.c',
'src/htable.c',
+ 'src/io.c',
'src/ios.c',
- 'src/iostream.c',
'src/math.c',
'src/opcodes.c',
'src/operators.c',
@@ -65,7 +65,7 @@
'src/ptrhash.c',
'src/random.c',
'src/read.c',
- 'src/string.c',
+ 'src/str.c',
'src/table.c',
'src/types.c',
'src/utf8.c',
--- a/mkfile
+++ b/mkfile
@@ -36,8 +36,8 @@
src/slmain.$O\
src/hashing.$O\
src/htable.$O\
+ src/io.$O\
src/ios.$O\
- src/iostream.$O\
src/math.$O\
src/nan.$O\
src/opcodes.$O\
@@ -51,7 +51,7 @@
src/ptrhash.$O\
src/random.$O\
src/read.$O\
- src/string.$O\
+ src/str.$O\
src/table.$O\
src/types.$O\
src/utf8.$O\
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -145,8 +145,8 @@
BUILTIN("symbol", symbol) {argcount(nargs, 1);
- if(sl_unlikely(!sl_isstring(args[0])))
- type_error("string", args[0]);+ if(sl_unlikely(!sl_isstr(args[0])))
+ type_error("str", args[0]);return symbol(cvalue_data(args[0]), true);
}
@@ -216,7 +216,7 @@
}
sl_purefn
-BUILTIN("integer-valued?", integer_valuedp)+BUILTIN("int-valued?", int_valuedp) {argcount(nargs, 1);
sl_v v = args[0];
@@ -246,7 +246,7 @@
}
sl_purefn
-BUILTIN("integer?", integerp)+BUILTIN("int?", intp) {argcount(nargs, 1);
sl_v v = args[0];
@@ -278,7 +278,7 @@
#else
return fixnum(mptoi(tomp(v)));
#endif
- type_error("number", v);+ type_error("num", v);}
BUILTIN("truncate", truncate)@@ -308,7 +308,7 @@
return args[0];
return return_from_s64((s64int)d);
}
- type_error("number", v);+ type_error("num", v);}
BUILTIN("vector-alloc", vector_alloc)@@ -353,22 +353,22 @@
}
if(ismp(a))
return conv_to_double(cv_data(ptr(a)), T_MP);
- type_error("number", a);+ type_error("num", a);}
-BUILTIN("time->string", time_string)+BUILTIN("time->str", time_str) {argcount(nargs, 1);
double t = todouble(args[0]);
char buf[64];
- timestring(t, buf, sizeof(buf));
- return string_from_cstr(buf);
+ timestr(t, buf, sizeof(buf));
+ return str_from_cstr(buf);
}
-BUILTIN("string->time", string_time)+BUILTIN("str->time", str_time) {argcount(nargs, 1);
- char *ptr = tostring(args[0]);
+ char *ptr = tostr(args[0]);
double t = parsetime(ptr);
s64int it = (s64int)t;
if((double)it == t && fits_fixnum(it))
@@ -384,9 +384,9 @@
char buf[4096];
if(getcwd(buf, sizeof(buf)) == nil)
lerrorf(sl_errio, "could not get current dir");
- return string_from_cstr(buf);
+ return str_from_cstr(buf);
}
- char *ptr = tostring(args[0]);
+ char *ptr = tostr(args[0]);
if(chdir(ptr) != 0)
lerrorf(sl_errio, "could not cd to %s", ptr);
return sl_void;
@@ -395,7 +395,7 @@
BUILTIN("path-exists?", path_existsp) {argcount(nargs, 1);
- const char *path = tostring(args[0]);
+ const char *path = tostr(args[0]);
return access(path, F_OK) == 0 ? sl_t : sl_nil;
}
@@ -402,7 +402,7 @@
BUILTIN("delete-file", delete_file) {argcount(nargs, 1);
- const char *path = tostring(args[0]);
+ const char *path = tostr(args[0]);
if(remove(path) != 0)
lerrorf(sl_errio, "could not remove %s", path);
return sl_void;
@@ -411,22 +411,22 @@
BUILTIN("os-getenv", os_getenv) {argcount(nargs, 1);
- char *name = tostring(args[0]);
+ char *name = tostr(args[0]);
char *val = getenv(name);
if(val == nil)
return sl_nil;
- return cvalue_static_cstring(val);
+ return cvalue_static_cstr(val);
}
BUILTIN("os-setenv", os_setenv) {argcount(nargs, 2);
- char *name = tostring(args[0]);
+ char *name = tostr(args[0]);
int result;
if(args[1] == sl_nil)
result = unsetenv(name);
else{- char *val = tostring(args[1]);
+ char *val = tostr(args[1]);
result = setenv(name, val, 1);
}
if(result != 0)
--- a/src/compiler.lsp
+++ b/src/compiler.lsp
@@ -113,7 +113,7 @@
((eq? vi 'brbound)
(io-write bcode (s32 nxt))
(set! i (+ i 1)))
- ((number? nxt)
+ ((num? nxt)
(case vi
((loadv.l loadg.l setg.l loada.l seta.l
argc.l vargc.l call.l tcall.l loadc.l box.l)
@@ -141,7 +141,7 @@
(io-write bcode ((if long? s32 s16)
(- (get label-to-loc labl) addr))))
fixup-to-label)
- (iostream->string bcode))))
+ (io->str bcode))))
(def (const-to-idx-vec e)
(let ((cvec (vector-alloc (bcode:nconst e))))
@@ -186,9 +186,9 @@
(cdr env)
(+ lev 1))))))
-(def (printable? x) (not (or (iostream? x)
- (void? x)
- (eof-object? x))))
+(def (printable? x) (not (or (io? x)
+ (void? x)
+ (eof-object? x))))
(def (compile-sym g env s deref)
(let ((loc (lookup-sym s env 0)))
@@ -237,7 +237,7 @@
(emit g 'set-car!))
(begin (compile-in g env nil rhs)
- (unless arg? (error (string "internal error: misallocated var " s)))
+ (unless arg? (error (str "internal error: misallocated var " s)))
(emit g 'seta idx))))))))
(def (box-vars g env)
@@ -349,7 +349,7 @@
" arguments.")))
(def builtin->instruction
- (let ((b2i (table number? 'number? cons 'cons
+ (let ((b2i (table num? 'num? cons 'cons
fixnum? 'fixnum? equal? 'equal?
eq? 'eq? symbol? 'symbol?
div0 'div0 builtin? 'builtin?
@@ -530,8 +530,8 @@
(def (keyword-arg? x) (and (cons? x) (keyword? (car x))))
(def (keyword->symbol k)
(if (keyword? k)
- (symbol (let ((s (string k)))
- (string-sub s 1 (string-length s))))
+ (symbol (let ((s (str k)))
+ (str-sub s 1 (str-length s))))
k))
(def (lambda-vars l)
@@ -586,7 +586,7 @@
(cddr x)
(if (symbol? form)
#.void
- (error "compile error: invalid syntax " (print-to-string x))))))
+ (error "compile error: invalid syntax " (print-to-str x))))))
(if (symbol? form)
`(#.void (set! ,form ,(car body)))
`(#.void (set! ,(car form)
@@ -749,7 +749,7 @@
(ash (aref a (+ i 1)) 8))))
(def (hex5 n)
- (string-lpad (number->string n 16) 5 #\0))
+ (str-lpad (num->str n 16) 5 #\0))
(def (disassemble f (ip nil) . lev?)
(when (not lev?)
@@ -794,28 +794,28 @@
((loada seta loadc call tcall list + - * / < = vector
argc vargc loadi8 apply tapply closure box shift aref)
(print-inst inst i 1)
- (princ (number->string (+ (aref code i) (if (eq? inst 'aref) 3 0))))
+ (princ (num->str (+ (aref code i) (if (eq? inst 'aref) 3 0))))
(set! i (+ i 1)))
((loada.l seta.l loadc.l argc.l vargc.l call.l tcall.l box.l)
(print-inst inst i 4)
- (princ (number->string (ref-s32-LE code i)))
+ (princ (num->str (ref-s32-LE code i)))
(set! i (+ i 4)))
((optargs keyargs)
(print-inst inst i (+ 8 (if (eq? inst 'keyargs) 4 0)))
- (princ (number->string (ref-s32-LE code i)) " ")
+ (princ (num->str (ref-s32-LE code i)) " ")
(set! i (+ i 4))
- (princ (number->string (ref-s32-LE code i)))
+ (princ (num->str (ref-s32-LE code i)))
(set! i (+ i 4))
(when (eq? inst 'keyargs)
(princ " ")
- (princ (number->string (ref-s32-LE code i)) " ")
+ (princ (num->str (ref-s32-LE code i)) " ")
(set! i (+ i 4))))
((brbound)
(print-inst inst i 4)
- (princ (number->string (ref-s32-LE code i)) " ")
+ (princ (num->str (ref-s32-LE code i)) " ")
(set! i (+ i 4)))
((jmp brne brnn brn)
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -2,7 +2,7 @@
#include "operators.h"
#include "cvalues.h"
#include "types.h"
-#include "iostream.h"
+#include "io.h"
#include "equal.h"
enum {@@ -148,37 +148,37 @@
}
sl_v
-cvalue_string(usize sz)
+cvalue_str(usize sz)
{if(sz == 0)
return sl_emptystr;
- return cvalue(sl_stringtype, sz);
+ return cvalue(sl_strtype, sz);
}
sl_v
-cvalue_static_cstring(const char *str)
+cvalue_static_cstr(const char *str)
{if(*str == 0)
return sl_emptystr;
- return cvalue_from_ref(sl_stringtype, (char*)str, strlen(str));
+ return cvalue_from_ref(sl_strtype, (char*)str, strlen(str));
}
sl_v
-string_from_cstrn(char *str, usize n)
+str_from_cstrn(char *str, usize n)
{- sl_v v = cvalue_string(n);
+ sl_v v = cvalue_str(n);
memcpy(cvalue_data(v), str, n);
return v;
}
sl_v
-string_from_cstr(char *str)
+str_from_cstr(char *str)
{- return string_from_cstrn(str, strlen(str));
+ return str_from_cstrn(str, strlen(str));
}
bool
-sl_isstring(sl_v v)
+sl_isstr(sl_v v)
{return iscvalue(v) && cv_isstr(ptr(v));
}
@@ -214,7 +214,7 @@
void *p = cv_data(ptr(arg)); \
n = (ctype)conv_to_##cnvt(p, T_MP); \
}else \
- type_error("number", arg); \+ type_error("num", arg); \*((ctype*)dest) = n; \
}
@@ -283,7 +283,7 @@
void *p = cp_data(cp);
n = conv_to_mp(p, cp_numtype(cp));
}else
- type_error("number", arg);+ type_error("num", arg);*((mpint**)dest) = n;
}
@@ -337,7 +337,7 @@
return conv_to_u64(cp_data(cp), cp_numtype(cp));
return conv_to_u32(cp_data(cp), cp_numtype(cp));
}
- type_error("number", n);+ type_error("num", n);}
soffset
@@ -349,7 +349,7 @@
sl_cprim *cp = ptr(n);
return conv_to_s64(cp_data(cp), cp_numtype(cp));
}
- type_error("number", n);+ type_error("num", n);}
bool
@@ -452,8 +452,8 @@
char *dest = cvalue_data(cv);
int i;
FOR_ARGS(i, 1, arg, args){- if(!sl_isnumber(arg))
- type_error("number", arg);+ if(!sl_isnum(arg))
+ type_error("num", arg);cvalue_init(type->eltype, arg, dest);
dest += elsize;
}
@@ -480,8 +480,8 @@
a = 2;
for(i = 0; i < cnt; i++){sl_v arg = args[a];
- if(!sl_isnumber(arg))
- type_error("number", arg);+ if(!sl_isnum(arg))
+ type_error("num", arg);cvalue_init(type->eltype, arg, dest);
dest += elsize;
if((a = (a + 1) % nargs) < 2)
@@ -528,7 +528,7 @@
if(iscvalue(v)){csl_v *pcv = ptr(v);
sl_ios *x;
- if(isiostream(v) && (x = value2c(sl_ios*, v))->bm == bm_mem){+ if(isio(v) && (x = value2c(sl_ios*, v))->bm == bm_mem){*pdata = x->buf;
*psz = x->size;
return;
@@ -915,7 +915,7 @@
}
}
- type_error("number", n);+ type_error("num", n);}
bool
@@ -966,12 +966,12 @@
}
if(!num_to_ptr(a, &ai, &ta, &aptr)){if(typeerr)
- type_error("number", a);+ type_error("num", a);return 2;
}
if(!num_to_ptr(b, &bi, &tb, &bptr)){if(typeerr)
- type_error("number", b);+ type_error("num", b);return 2;
}
if(eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
@@ -1000,9 +1000,9 @@
void *aptr, *bptr;
if(!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("number", a);+ type_error("num", a);if(!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("number", b);+ type_error("num", b);da = conv_to_double(aptr, ta);
db = conv_to_double(bptr, tb);
@@ -1027,9 +1027,9 @@
mpint *x;
if(!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("number", a);+ type_error("num", a);if(!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("number", b);+ type_error("num", b); if(ta == T_MP){ if(tb == T_MP){@@ -1088,9 +1088,9 @@
s64int b64;
if(!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
- type_error("integer", a);+ type_error("int", a);if(!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
- type_error("integer", b);+ type_error("int", b); if(ta < tb){itmp = ta; ta = tb; tb = itmp;
@@ -1241,7 +1241,7 @@
return mk_mp(m);
}
}
- type_error("integer", a);+ type_error("int", a);}
BUILTIN("ash", ash)@@ -1297,7 +1297,7 @@
if(ta < T_FLOAT)
return return_from_s64(conv_to_s64(aptr, ta)<<n);
}
- type_error("integer", a);+ type_error("int", a);}
void
@@ -1323,11 +1323,11 @@
ctor_cv_intern(array, NONNUMERIC, int);
- sl_stringtypesym = csymbol("*string-type*");- setc(sl_stringtypesym, mk_list2(sl_arraysym, sl_bytesym));
+ sl_strtypesym = csymbol("*str-type*");+ setc(sl_strtypesym, mk_list2(sl_arraysym, sl_bytesym));
- sl_runestringtypesym = csymbol("*runestring-type*");- setc(sl_runestringtypesym, mk_list2(sl_arraysym, sl_runesym));
+ sl_runestrtypesym = csymbol("*runestr-type*");+ setc(sl_runestrtypesym, mk_list2(sl_arraysym, sl_runesym));
mk_primtype(s8, s8int);
mk_primtype(u8, u8int);
@@ -1347,7 +1347,7 @@
sl_mptype->init = cvalue_mp_init;
sl_mptype->vtable = &mp_vtable;
- sl_stringtype = get_type(symbol_value(sl_stringtypesym));
- sl_emptystr = cvalue_from_ref(sl_stringtype, (char*)"", 0);
- sl_runestringtype = get_type(symbol_value(sl_runestringtypesym));
+ sl_strtype = get_type(symbol_value(sl_strtypesym));
+ sl_emptystr = cvalue_from_ref(sl_strtype, (char*)"", 0);
+ sl_runestrtype = get_type(symbol_value(sl_runestrtypesym));
}
--- a/src/cvalues.h
+++ b/src/cvalues.h
@@ -13,11 +13,11 @@
#define cvalue(type, sz) cvalue_(type, sz, false)
#define cvalue_nofinalizer(type, sz) cvalue_(type, sz, true)
sl_v cvalue_from_ref(sl_type *type, void *ptr, usize sz);
-sl_v cvalue_string(usize sz);
-sl_v cvalue_static_cstring(const char *str);
-sl_v string_from_cstrn(char *str, usize n);
-sl_v string_from_cstr(char *str);
-bool sl_isstring(sl_v v) sl_purefn;
+sl_v cvalue_str(usize sz);
+sl_v cvalue_static_cstr(const char *str);
+sl_v str_from_cstrn(char *str, usize n);
+sl_v str_from_cstr(char *str);
+bool sl_isstr(sl_v v) sl_purefn;
void cv_pin(csl_v *cv);
sl_v size_wrap(usize sz);
usize tosize(sl_v n);
--- a/src/dos/sys.c
+++ b/src/dos/sys.c
@@ -14,7 +14,7 @@
}
void
-timestring(double s, char *buf, int sz)
+timestr(double s, char *buf, int sz)
{time_t tme = (time_t)s;
struct tm tm;
--- /dev/null
+++ b/src/io.c
@@ -1,0 +1,489 @@
+#include "sl.h"
+#include "cvalues.h"
+#include "types.h"
+#include "print.h"
+#include "read.h"
+#include "io.h"
+
+static sl_v sl_linesym, sl_blocksym, sl_memorysym, sl_nonesym;
+static sl_v sl_ioinsym, sl_iooutsym;
+sl_type *sl_iotype;
+
+static void
+print_io(sl_v v, sl_ios *f)
+{+ sl_ios *s = value2c(sl_ios*, v);
+ sl_print_str(f, "#<io");
+ if(*s->loc.filename){+ sl_print_chr(f, ' ');
+ sl_print_str(f, s->loc.filename);
+ }
+ sl_print_chr(f, '>');
+}
+
+static void
+free_io(sl_v self)
+{+ sl_ios *s = value2c(sl_ios*, self);
+ ios_close(s);
+ ios_free(s);
+}
+
+static void
+relocate_io(sl_v oldv, sl_v newv)
+{+ sl_ios *olds = value2c(sl_ios*, oldv);
+ sl_ios *news = value2c(sl_ios*, newv);
+ if(news->buf == &olds->local[0])
+ news->buf = &news->local[0];
+}
+
+static sl_cvtable io_vtable = {+ print_io,
+ relocate_io,
+ free_io,
+ nil
+};
+
+bool
+isio(sl_v v)
+{+ return iscvalue(v) && cv_class(ptr(v)) == sl_iotype;
+}
+
+sl_purefn
+BUILTIN("io?", iop)+{+ argcount(nargs, 1);
+ return isio(args[0]) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("eof-object?", eof_objectp)+{+ argcount(nargs, 1);
+ return args[0] == sl_eof ? sl_t : sl_nil;
+}
+
+sl_purefn
+sl_ios *
+toio(sl_v v)
+{+ if(sl_unlikely(!isio(v)))
+ type_error("io", v);+ return value2c(sl_ios*, v);
+}
+
+BUILTIN("file", file)+{+ if(nargs < 1)
+ argcount(nargs, 1);
+ bool r = false, w = false, c = false, t = false, a = false;
+ for(int i = 1; i < nargs; i++){+ if(args[i] == sl_rdsym)
+ r = 1;
+ else if(args[i] == sl_wrsym)
+ w = 1;
+ else if(args[i] == sl_apsym)
+ a = w = 1;
+ else if(args[i] == sl_crsym)
+ c = w = 1;
+ else if(args[i] == sl_truncsym)
+ t = w = 1;
+ }
+ if(!r && !w && !c && !t && !a)
+ r = true; // default to reading
+ sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
+ char *fname = tostr(args[0]);
+ sl_ios *s = value2c(sl_ios*, f);
+ if(ios_file(s, fname, r, w, c, t) == nil)
+ lerrorf(sl_errio, "could not open \"%s\"", fname);
+ if(a)
+ ios_seek_end(s);
+ return f;
+}
+
+BUILTIN("io-buffer-mode", io_buffer_mode)+{+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 1);
+ sl_ios *s = toio(args[0]);
+ if(nargs == 1){+ switch(s->bm){+ case bm_none: return sl_nonesym;
+ case bm_line: return sl_linesym;
+ case bm_block: return sl_blocksym;
+ case bm_mem: return sl_memorysym;
+ }
+ assert("impossible" == nil);+ }
+ sl_v a = args[1];
+ int bm = -1;
+ if(a == sl_nonesym)
+ bm = bm_none;
+ else if(a == sl_linesym)
+ bm = bm_line;
+ else if(a == sl_blocksym)
+ bm = bm_block;
+ else if(a == sl_memorysym)
+ bm = bm_mem;
+ if(bm < 0 || ios_bufmode(s, bm) != 0)
+ lerrorf(sl_errarg, "invalid buffer mode");
+ return sl_void;
+}
+
+BUILTIN("buffer", buffer)+{+ argcount(nargs, 0);
+ USED(args);
+ sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
+ sl_ios *s = value2c(sl_ios*, f);
+ if(ios_mem(s, 0) == nil)
+ lerrorf(sl_errmem, "could not allocate in-memory io");
+ return f;
+}
+
+BUILTIN("read", read)+{+ if(nargs > 1)
+ argcount(nargs, 1);
+ sl_v a = nargs == 0 ? symbol_value(sl_ioinsym) : args[0];
+ sl_gc_handle(&a);
+ sl_v v = sl_read_sexpr(a);
+ sl_free_gc_handles(1);
+ return ios_eof(toio(a)) ? sl_eof : v;
+}
+
+BUILTIN("io-getc", io_getc)+{+ argcount(nargs, 1);
+ sl_ios *s = toio(args[0]);
+ Rune r;
+ int res;
+ if((res = ios_getutf8(s, &r)) == IOS_EOF)
+ //lerrorf(sl_errio, "end of file reached");
+ return sl_eof;
+ if(res == 0)
+ lerrorf(sl_errio, "invalid UTF-8 sequence");
+ return mk_rune(r);
+}
+
+BUILTIN("io-wait", io_wait)+{+ if(nargs > 2)
+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ int r = ios_wait(s, nargs > 1 ? todouble(args[1]) : -1);
+ if(r >= 0)
+ return r ? sl_t : sl_nil;
+ if(r == IOS_EOF)
+ return sl_eof;
+ lerrorf(sl_errio, "i/o error");
+}
+
+BUILTIN("io-putc", io_putc)+{+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ sl_cprim *cp = ptr(args[1]);
+ if(!iscprim(args[1]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[1]);+ Rune r = *(Rune*)cp_data(cp);
+ return fixnum(ios_pututf8(s, r));
+}
+
+BUILTIN("io-skip", io_skip)+{+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ soffset off = tooffset(args[1]);
+ soffset res = ios_skip(s, off);
+ if(res < 0)
+ return sl_nil;
+ return sizeof(res) == sizeof(s64int) ? mk_s64(res) : mk_s32(res);
+}
+
+BUILTIN("io-flush", io_flush)+{+ argcount(nargs, 1);
+ return ios_flush(toio(args[0])) == 0 ? sl_t : sl_nil;
+}
+
+BUILTIN("io-close", io_close)+{+ argcount(nargs, 1);
+ ios_close(toio(args[0]));
+ return sl_void;
+}
+
+BUILTIN("io-truncate", io_truncate)+{+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ if(ios_trunc(s, tooffset(args[1])) < 0)
+ lerrorf(sl_errio, "truncation failed");
+ return sl_void;
+}
+
+BUILTIN("io-discardbuffer", io_discardbuffer)+{+ argcount(nargs, 1);
+ ios_purge(toio(args[0]));
+ return sl_void;
+}
+
+sl_purefn
+BUILTIN("io-eof?", io_eofp)+{+ argcount(nargs, 1);
+ return ios_eof(toio(args[0])) ? sl_t : sl_nil;
+}
+
+BUILTIN("io-seek", io_seek)+{+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ usize pos = tosize(args[1]);
+ soffset res = ios_seek(s, (soffset)pos);
+ if(res < 0)
+ return sl_nil;
+ return sl_t;
+}
+
+BUILTIN("io-pos", io_pos)+{+ argcount(nargs, 1);
+ sl_ios *s = toio(args[0]);
+ soffset res = ios_pos(s);
+ if(res < 0)
+ return sl_nil;
+ return size_wrap((usize)res);
+}
+
+BUILTIN("write", write)+{+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 1);
+ sl_ios *s;
+ s = nargs == 2 ? toio(args[1]) : toio(symbol_value(sl_iooutsym));
+ sl_print(s, args[0]);
+ return args[0];
+}
+
+BUILTIN("io-read", io_read)+{+ if(nargs != 3)
+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ usize n;
+ sl_type *ft;
+ if(nargs == 3){+ // form (io.read s type count)
+ ft = get_array_type(args[1]);
+ n = tosize(args[2]) * ft->elsz;
+ }else{+ ft = get_type(args[1]);
+ if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
+ lerrorf(sl_errarg, "incomplete type");
+ n = ft->size;
+ }
+ sl_v cv = cvalue(ft, n);
+ u8int *data = cptr(cv);
+ usize got = ios_read(s, data, n);
+ if(got < n)
+ //lerrorf(sl_errio, "end of input reached");
+ return sl_eof;
+ return cv;
+}
+
+// args must contain data[, offset[, count]]
+static void
+get_start_count_args(sl_v *args, u32int nargs, usize sz, usize *offs, usize *nb)
+{+ if(nargs > 1){+ *offs = tosize(args[1]);
+ *nb = nargs > 2 ? tosize(args[2]) : sz - *offs;
+ if(*offs >= sz || *offs + *nb > sz)
+ bounds_error(args[0], args[1]);
+ }
+}
+
+BUILTIN("io-write", io_write)+{+ if(nargs < 2 || nargs > 4)
+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ sl_v v = args[1];
+ sl_cprim *cp = ptr(v);
+ if(iscprim(args[1]) && cp_class(cp) == sl_runetype){+ if(nargs > 2)
+ lerrorf(sl_errarg, "offset argument not supported for characters");
+ Rune r = *(Rune*)cp_data(ptr(args[1]));
+ return fixnum(ios_pututf8(s, r));
+ }
+ u8int *data;
+ usize sz, offs = 0;
+ to_sized_ptr(v, &data, &sz);
+ usize nb = sz;
+ if(nargs > 2){+ get_start_count_args(args+1, nargs-1, sz, &offs, &nb);
+ data += offs;
+ }
+ return size_wrap(ios_write(s, data, nb));
+}
+
+static u8int
+get_delim_arg(sl_v arg)
+{+ usize uldelim = tosize(arg);
+ if(uldelim > 0x7f){+ // runes > 0x7f, or anything else > 0xff, are out of range
+ if((iscprim(arg) && cp_class(ptr(arg)) == sl_runetype) || uldelim > 0xff)
+ lerrorf(sl_errarg, "delimiter out of range");
+ }
+ return (u8int)uldelim;
+}
+
+BUILTIN("io-readuntil", io_readuntil)+{+ argcount(nargs, 2);
+ sl_v str = cvalue_str(80);
+ csl_v *cv = ptr(str);
+ u8int *data = cv_data(cv);
+ sl_ios dest;
+ ios_mem(&dest, 0);
+ ios_setbuf(&dest, data, 80, 0);
+ u8int delim = get_delim_arg(args[1]);
+ sl_ios *src = toio(args[0]);
+ usize n = ios_copyuntil(&dest, src, delim);
+ cv->len = n;
+ if(dest.buf != data){+ // outgrew initial space
+ usize sz;
+ cv->data = ios_takebuf(&dest, &sz);
+ cv_autorelease(cv);
+ }else{+ ((u8int*)cv->data)[n] = 0;
+ }
+ if(n == 0 && ios_eof(src))
+ return sl_eof;
+ return str;
+}
+
+BUILTIN("io-copyuntil", io_copyuntil)+{+ argcount(nargs, 3);
+ sl_ios *dest = toio(args[0]);
+ sl_ios *src = toio(args[1]);
+ u8int delim = get_delim_arg(args[2]);
+ return size_wrap(ios_copyuntil(dest, src, delim));
+}
+
+BUILTIN("io-copy", io_copy)+{+ if(nargs < 2 || nargs > 3)
+ argcount(nargs, 2);
+ sl_ios *dest = toio(args[0]);
+ sl_ios *src = toio(args[1]);
+ if(nargs == 3)
+ return size_wrap(ios_copy(dest, src, tosize(args[2])));
+ return size_wrap(ios_copyall(dest, src));
+}
+
+BUILTIN("io-filename", io_filename)+{+ argcount(nargs, 1);
+ return str_from_cstr(toio(args[0])->loc.filename);
+}
+
+BUILTIN("io-set-filename!", io_set_filename)+{+ argcount(nargs, 2);
+ sl_ios *s = toio(args[0]);
+ char *f = tostr(args[1]);
+ MEM_FREE(s->loc.filename);
+ s->loc.filename = MEM_STRDUP(f);
+ return args[1];
+}
+
+BUILTIN("io-line", io_line)+{+ argcount(nargs, 1);
+ return size_wrap(toio(args[0])->loc.lineno);
+}
+
+BUILTIN("io-set-line!", io_set_line)+{+ argcount(nargs, 2);
+ toio(args[0])->loc.lineno = tosize(args[1]);
+ return args[1];
+}
+
+BUILTIN("io-column", io_column)+{+ argcount(nargs, 1);
+ return size_wrap(toio(args[0])->loc.colno);
+}
+
+BUILTIN("io-set-column!", io_set_column)+{+ argcount(nargs, 2);
+ toio(args[0])->loc.colno = tosize(args[1]);
+ return args[1];
+}
+
+sl_v
+io_to_str(sl_v *ps)
+{+ sl_v str;
+ usize n;
+ sl_ios *st = value2c(sl_ios*, *ps);
+ if(st->buf == &st->local[0]){+ n = st->size;
+ str = cvalue_str(n);
+ memcpy(cvalue_data(str), st->buf, n);
+ ios_trunc(st, 0);
+ }else{+ u8int *b = ios_takebuf(st, &n); n--;
+ if(n == 0)
+ return sl_emptystr;
+ b[n] = '\0';
+ str = cvalue_from_ref(sl_strtype, b, n);
+ cv_autorelease(ptr(str));
+ }
+ return str;
+}
+
+BUILTIN("io->str", io_tostr)+{+ argcount(nargs, 1);
+ sl_ios *src = toio(args[0]);
+ if(src->bm != bm_mem)
+ lerrorf(sl_errarg, "requires in-memory io");
+ bool eof = ios_eof(src);
+ sl_v v = io_to_str(&args[0]);
+ if(eof && v == sl_emptystr)
+ v = sl_eof;
+ return v;
+}
+
+void
+io_init(void)
+{+ sl_iosym = csymbol("io");+ sl_rdsym = csymbol(":read");+ sl_wrsym = csymbol(":write");+ sl_apsym = csymbol(":append");+ sl_crsym = csymbol(":create");+ sl_truncsym = csymbol(":truncate");+ sl_nonesym = csymbol(":none");+ sl_linesym = csymbol(":line");+ sl_blocksym = csymbol(":block");+ sl_memorysym = csymbol(":memory");+ sl_ioinsym = csymbol("*io-in*");+ sl_iooutsym = csymbol("*io-out*");+ sl_iotype = define_opaque_type(sl_iosym, sizeof(sl_ios), &io_vtable, nil);
+ set(csymbol("*stdout*"), cvalue_from_ref(sl_iotype, ios_stdout, sizeof(sl_ios)));+ set(csymbol("*stderr*"), cvalue_from_ref(sl_iotype, ios_stderr, sizeof(sl_ios)));+ set(csymbol("*stdin*"), cvalue_from_ref(sl_iotype, ios_stdin, sizeof(sl_ios)));+}
--- /dev/null
+++ b/src/io.h
@@ -1,0 +1,5 @@
+sl_ios *toio(sl_v v);
+bool isio(sl_v v) sl_purefn;
+sl_v io_to_str(sl_v *ps);
+void io_init(void);
+extern sl_type *sl_iotype;
--- a/src/ios.c
+++ b/src/ios.c
@@ -178,7 +178,7 @@
if(s->bpos + n > s->size){ if(s->bpos + n > s->maxsize){/* TODO: here you might want to add a mechanism for limiting
- the growth of the stream. */
+ the growth of the io. */
newsize = s->maxsize ? s->maxsize * 2 : 8;
while(s->bpos + n > newsize)
newsize *= 2;
@@ -608,7 +608,7 @@
buf[s->size] = '\0';
*psize = s->size + 1;
- /* empty stream and reinitialize */
+ /* empty io and reinitialize */
_buf_init(s, s->bm);
return buf;
@@ -744,7 +744,7 @@
s->loc.lineno = 1;
}
-/* stream object initializers. we do no allocation. */
+/* io object initializers. we do no allocation. */
sl_ios *
ios_file(sl_ios *s, char *fname, bool rd, bool wr, bool creat, bool trunc)
@@ -809,7 +809,7 @@
}
void
-ios_init_stdstreams(void)
+ios_init_std(void)
{ios_stdin = MEM_ALLOC(sizeof(sl_ios));
ios_fd(ios_stdin, STDIN_FILENO, 0, 0);
--- a/src/ios.h
+++ b/src/ios.h
@@ -1,5 +1,5 @@
// this flag controls when data actually moves out to the underlying I/O
-// channel. memory streams are a special case of this where the data
+// channel. in-memory io is a special case of this where the data
// never moves out.
typedef enum {bm_none,
@@ -79,7 +79,7 @@
int ios_wait(sl_ios *s, double ws);
-/* stream creation */
+/* io creation */
sl_ios *ios_file(sl_ios *s, char *fname, bool rd, bool wr, bool create, bool trunc);
sl_ios *ios_mem(sl_ios *s, usize initsize);
sl_ios *ios_static_buffer(sl_ios *s, const u8int *buf, usize sz);
@@ -88,7 +88,7 @@
extern sl_ios *ios_stdin;
extern sl_ios *ios_stdout;
extern sl_ios *ios_stderr;
-void ios_init_stdstreams(void);
+void ios_init_std(void);
/* high-level functions - output */
int ios_pututf8(sl_ios *s, Rune r);
@@ -95,7 +95,7 @@
int ios_printf(sl_ios *s, const char *format, ...) sl_printfmt(2, 3);
int ios_vprintf(sl_ios *s, const char *format, va_list args) sl_printfmt(2, 0);
-/* high-level stream functions - input */
+/* high-level io functions - input */
int ios_getutf8(sl_ios *s, Rune *r);
// discard data buffered for reading
@@ -109,9 +109,9 @@
#define ios_puts(s, str) ios_write(s, str, strlen(str))
/*
- With memory streams, mixed reads and writes are equivalent to performing
- sequences of *p++, as either an lvalue or rvalue. File streams behave
- similarly, but other streams might not support this. Using unbuffered
+ With in-memory io, mixed reads and writes are equivalent to performing
+ sequences of *p++, as either an lvalue or rvalue. File ios behave
+ similarly, but other ios might not support this. Using unbuffered
mode makes this more predictable.
Note on "unget" functions:
@@ -125,20 +125,20 @@
buffered but not read yet). IOS reserves the right to perform large block
operations directly, bypassing the buffer. In such a case data was
never buffered, so "rebuffering" has no meaning (i.e. there is no
- correspondence between the buffer and the physical stream).
+ correspondence between the buffer and the physical io).
- Single-bit I/O is able to write partial bytes ONLY IF the stream supports
+ Single-bit I/O is able to write partial bytes ONLY IF the io supports
seeking. Also, line buffering is not well-defined in the context of
single-bit I/O, so it might not do what you expect.
implementation notes:
in order to know where we are in a file, we must ensure the buffer
- is only populated from the underlying stream starting with p==buf.
+ is only populated from the underlying io starting with p==buf.
to switch from writing to reading: flush, set p=buf, cnt=0
to switch from reading to writing: seek backwards cnt bytes, p=buf, cnt=0
- when writing: buf starts at curr. physical stream pos, p - buf is how
+ when writing: buf starts at curr. physical io pos, p - buf is how
many bytes we've written logically. cnt==0
dirty == (bitpos>0 && state==iost_wr), EXCEPT right after switching from
@@ -151,7 +151,7 @@
then formally switch to the read state using flush.
design points:
- - data-source independence, including memory streams
+ - data-source independence, including in-memory io
- expose buffer to user, allow user-owned buffers
- allow direct I/O, don't always go through buffer
- buffer-internal seeking. makes seeking back 1-2 bytes very fast,
@@ -169,7 +169,7 @@
write around in it as much as you like, as if it were just a string.
we keep track of the part of the buffer that's invalid (written to).
- we remember whether the position of the underlying stream is aligned
+ we remember whether the position of the underlying io is aligned
with the end of the buffer (reading mode) or the beginning (writing mode).
based on this info, we might have to seek back before doing a flush.
--- a/src/iostream.c
+++ /dev/null
@@ -1,488 +1,0 @@
-#include "sl.h"
-#include "cvalues.h"
-#include "types.h"
-#include "print.h"
-#include "read.h"
-#include "iostream.h"
-
-static sl_v sl_linesym, sl_blocksym, sl_memorysym, sl_nonesym;
-sl_type *sl_iostreamtype;
-
-static void
-print_iostream(sl_v v, sl_ios *f)
-{- sl_ios *s = value2c(sl_ios*, v);
- sl_print_str(f, "#<io stream");
- if(*s->loc.filename){- sl_print_chr(f, ' ');
- sl_print_str(f, s->loc.filename);
- }
- sl_print_chr(f, '>');
-}
-
-static void
-free_iostream(sl_v self)
-{- sl_ios *s = value2c(sl_ios*, self);
- ios_close(s);
- ios_free(s);
-}
-
-static void
-relocate_iostream(sl_v oldv, sl_v newv)
-{- sl_ios *olds = value2c(sl_ios*, oldv);
- sl_ios *news = value2c(sl_ios*, newv);
- if(news->buf == &olds->local[0])
- news->buf = &news->local[0];
-}
-
-static sl_cvtable iostream_vtable = {- print_iostream,
- relocate_iostream,
- free_iostream,
- nil
-};
-
-int
-isiostream(sl_v v)
-{- return iscvalue(v) && cv_class(ptr(v)) == sl_iostreamtype;
-}
-
-sl_purefn
-BUILTIN("iostream?", iostreamp)-{- argcount(nargs, 1);
- return isiostream(args[0]) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("eof-object?", eof_objectp)-{- argcount(nargs, 1);
- return args[0] == sl_eof ? sl_t : sl_nil;
-}
-
-sl_purefn
-sl_ios *
-toiostream(sl_v v)
-{- if(sl_unlikely(!isiostream(v)))
- type_error("iostream", v);- return value2c(sl_ios*, v);
-}
-
-BUILTIN("file", file)-{- if(nargs < 1)
- argcount(nargs, 1);
- bool r = false, w = false, c = false, t = false, a = false;
- for(int i = 1; i < nargs; i++){- if(args[i] == sl_rdsym)
- r = 1;
- else if(args[i] == sl_wrsym)
- w = 1;
- else if(args[i] == sl_apsym)
- a = w = 1;
- else if(args[i] == sl_crsym)
- c = w = 1;
- else if(args[i] == sl_truncsym)
- t = w = 1;
- }
- if(!r && !w && !c && !t && !a)
- r = true; // default to reading
- sl_v f = cvalue(sl_iostreamtype, sizeof(sl_ios));
- char *fname = tostring(args[0]);
- sl_ios *s = value2c(sl_ios*, f);
- if(ios_file(s, fname, r, w, c, t) == nil)
- lerrorf(sl_errio, "could not open \"%s\"", fname);
- if(a)
- ios_seek_end(s);
- return f;
-}
-
-BUILTIN("io-buffer-mode", io_buffer_mode)-{- if(nargs < 1 || nargs > 2)
- argcount(nargs, 1);
- sl_ios *s = toiostream(args[0]);
- if(nargs == 1){- switch(s->bm){- case bm_none: return sl_nonesym;
- case bm_line: return sl_linesym;
- case bm_block: return sl_blocksym;
- case bm_mem: return sl_memorysym;
- }
- assert("impossible" == nil);- }
- sl_v a = args[1];
- int bm = -1;
- if(a == sl_nonesym)
- bm = bm_none;
- else if(a == sl_linesym)
- bm = bm_line;
- else if(a == sl_blocksym)
- bm = bm_block;
- else if(a == sl_memorysym)
- bm = bm_mem;
- if(bm < 0 || ios_bufmode(s, bm) != 0)
- lerrorf(sl_errarg, "invalid buffer mode");
- return sl_void;
-}
-
-BUILTIN("buffer", buffer)-{- argcount(nargs, 0);
- USED(args);
- sl_v f = cvalue(sl_iostreamtype, sizeof(sl_ios));
- sl_ios *s = value2c(sl_ios*, f);
- if(ios_mem(s, 0) == nil)
- lerrorf(sl_errmem, "could not allocate stream");
- return f;
-}
-
-BUILTIN("read", read)-{- if(nargs > 1)
- argcount(nargs, 1);
- sl_v a = nargs == 0 ? symbol_value(sl_instrsym) : args[0];
- sl_gc_handle(&a);
- sl_v v = sl_read_sexpr(a);
- sl_free_gc_handles(1);
- return ios_eof(toiostream(a)) ? sl_eof : v;
-}
-
-BUILTIN("io-getc", io_getc)-{- argcount(nargs, 1);
- sl_ios *s = toiostream(args[0]);
- Rune r;
- int res;
- if((res = ios_getutf8(s, &r)) == IOS_EOF)
- //lerrorf(sl_errio, "end of file reached");
- return sl_eof;
- if(res == 0)
- lerrorf(sl_errio, "invalid UTF-8 sequence");
- return mk_rune(r);
-}
-
-BUILTIN("io-wait", io_wait)-{- if(nargs > 2)
- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- int r = ios_wait(s, nargs > 1 ? todouble(args[1]) : -1);
- if(r >= 0)
- return r ? sl_t : sl_nil;
- if(r == IOS_EOF)
- return sl_eof;
- lerrorf(sl_errio, "i/o error");
-}
-
-BUILTIN("io-putc", io_putc)-{- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- sl_cprim *cp = ptr(args[1]);
- if(!iscprim(args[1]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[1]);- Rune r = *(Rune*)cp_data(cp);
- return fixnum(ios_pututf8(s, r));
-}
-
-BUILTIN("io-skip", io_skip)-{- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- soffset off = tooffset(args[1]);
- soffset res = ios_skip(s, off);
- if(res < 0)
- return sl_nil;
- return sizeof(res) == sizeof(s64int) ? mk_s64(res) : mk_s32(res);
-}
-
-BUILTIN("io-flush", io_flush)-{- argcount(nargs, 1);
- return ios_flush(toiostream(args[0])) == 0 ? sl_t : sl_nil;
-}
-
-BUILTIN("io-close", io_close)-{- argcount(nargs, 1);
- ios_close(toiostream(args[0]));
- return sl_void;
-}
-
-BUILTIN("io-truncate", io_truncate)-{- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- if(ios_trunc(s, tooffset(args[1])) < 0)
- lerrorf(sl_errio, "truncation failed");
- return sl_void;
-}
-
-BUILTIN("io-discardbuffer", io_discardbuffer)-{- argcount(nargs, 1);
- ios_purge(toiostream(args[0]));
- return sl_void;
-}
-
-sl_purefn
-BUILTIN("io-eof?", io_eofp)-{- argcount(nargs, 1);
- return ios_eof(toiostream(args[0])) ? sl_t : sl_nil;
-}
-
-BUILTIN("io-seek", io_seek)-{- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- usize pos = tosize(args[1]);
- soffset res = ios_seek(s, (soffset)pos);
- if(res < 0)
- return sl_nil;
- return sl_t;
-}
-
-BUILTIN("io-pos", io_pos)-{- argcount(nargs, 1);
- sl_ios *s = toiostream(args[0]);
- soffset res = ios_pos(s);
- if(res < 0)
- return sl_nil;
- return size_wrap((usize)res);
-}
-
-BUILTIN("write", write)-{- if(nargs < 1 || nargs > 2)
- argcount(nargs, 1);
- sl_ios *s;
- s = nargs == 2 ? toiostream(args[1]) : toiostream(symbol_value(sl_outstrsym));
- sl_print(s, args[0]);
- return args[0];
-}
-
-BUILTIN("io-read", io_read)-{- if(nargs != 3)
- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- usize n;
- sl_type *ft;
- if(nargs == 3){- // form (io.read s type count)
- ft = get_array_type(args[1]);
- n = tosize(args[2]) * ft->elsz;
- }else{- ft = get_type(args[1]);
- if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
- lerrorf(sl_errarg, "incomplete type");
- n = ft->size;
- }
- sl_v cv = cvalue(ft, n);
- u8int *data = cptr(cv);
- usize got = ios_read(s, data, n);
- if(got < n)
- //lerrorf(sl_errio, "end of input reached");
- return sl_eof;
- return cv;
-}
-
-// args must contain data[, offset[, count]]
-static void
-get_start_count_args(sl_v *args, u32int nargs, usize sz, usize *offs, usize *nb)
-{- if(nargs > 1){- *offs = tosize(args[1]);
- *nb = nargs > 2 ? tosize(args[2]) : sz - *offs;
- if(*offs >= sz || *offs + *nb > sz)
- bounds_error(args[0], args[1]);
- }
-}
-
-BUILTIN("io-write", io_write)-{- if(nargs < 2 || nargs > 4)
- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- sl_v v = args[1];
- sl_cprim *cp = ptr(v);
- if(iscprim(args[1]) && cp_class(cp) == sl_runetype){- if(nargs > 2)
- lerrorf(sl_errarg, "offset argument not supported for characters");
- Rune r = *(Rune*)cp_data(ptr(args[1]));
- return fixnum(ios_pututf8(s, r));
- }
- u8int *data;
- usize sz, offs = 0;
- to_sized_ptr(v, &data, &sz);
- usize nb = sz;
- if(nargs > 2){- get_start_count_args(args+1, nargs-1, sz, &offs, &nb);
- data += offs;
- }
- return size_wrap(ios_write(s, data, nb));
-}
-
-static u8int
-get_delim_arg(sl_v arg)
-{- usize uldelim = tosize(arg);
- if(uldelim > 0x7f){- // runes > 0x7f, or anything else > 0xff, are out of range
- if((iscprim(arg) && cp_class(ptr(arg)) == sl_runetype) || uldelim > 0xff)
- lerrorf(sl_errarg, "delimiter out of range");
- }
- return (u8int)uldelim;
-}
-
-BUILTIN("io-readuntil", io_readuntil)-{- argcount(nargs, 2);
- sl_v str = cvalue_string(80);
- csl_v *cv = ptr(str);
- u8int *data = cv_data(cv);
- sl_ios dest;
- ios_mem(&dest, 0);
- ios_setbuf(&dest, data, 80, 0);
- u8int delim = get_delim_arg(args[1]);
- sl_ios *src = toiostream(args[0]);
- usize n = ios_copyuntil(&dest, src, delim);
- cv->len = n;
- if(dest.buf != data){- // outgrew initial space
- usize sz;
- cv->data = ios_takebuf(&dest, &sz);
- cv_autorelease(cv);
- }else{- ((u8int*)cv->data)[n] = 0;
- }
- if(n == 0 && ios_eof(src))
- return sl_eof;
- return str;
-}
-
-BUILTIN("io-copyuntil", io_copyuntil)-{- argcount(nargs, 3);
- sl_ios *dest = toiostream(args[0]);
- sl_ios *src = toiostream(args[1]);
- u8int delim = get_delim_arg(args[2]);
- return size_wrap(ios_copyuntil(dest, src, delim));
-}
-
-BUILTIN("io-copy", io_copy)-{- if(nargs < 2 || nargs > 3)
- argcount(nargs, 2);
- sl_ios *dest = toiostream(args[0]);
- sl_ios *src = toiostream(args[1]);
- if(nargs == 3)
- return size_wrap(ios_copy(dest, src, tosize(args[2])));
- return size_wrap(ios_copyall(dest, src));
-}
-
-BUILTIN("io-filename", io_filename)-{- argcount(nargs, 1);
- return string_from_cstr(toiostream(args[0])->loc.filename);
-}
-
-BUILTIN("io-set-filename!", io_set_filename)-{- argcount(nargs, 2);
- sl_ios *s = toiostream(args[0]);
- char *f = tostring(args[1]);
- MEM_FREE(s->loc.filename);
- s->loc.filename = MEM_STRDUP(f);
- return args[1];
-}
-
-BUILTIN("io-line", io_line)-{- argcount(nargs, 1);
- return size_wrap(toiostream(args[0])->loc.lineno);
-}
-
-BUILTIN("io-set-line!", io_set_line)-{- argcount(nargs, 2);
- toiostream(args[0])->loc.lineno = tosize(args[1]);
- return args[1];
-}
-
-BUILTIN("io-column", io_column)-{- argcount(nargs, 1);
- return size_wrap(toiostream(args[0])->loc.colno);
-}
-
-BUILTIN("io-set-column!", io_set_column)-{- argcount(nargs, 2);
- toiostream(args[0])->loc.colno = tosize(args[1]);
- return args[1];
-}
-
-sl_v
-stream_to_string(sl_v *ps)
-{- sl_v str;
- usize n;
- sl_ios *st = value2c(sl_ios*, *ps);
- if(st->buf == &st->local[0]){- n = st->size;
- str = cvalue_string(n);
- memcpy(cvalue_data(str), st->buf, n);
- ios_trunc(st, 0);
- }else{- u8int *b = ios_takebuf(st, &n); n--;
- if(n == 0)
- return sl_emptystr;
- b[n] = '\0';
- str = cvalue_from_ref(sl_stringtype, b, n);
- cv_autorelease(ptr(str));
- }
- return str;
-}
-
-BUILTIN("iostream->string", io_tostring)-{- argcount(nargs, 1);
- sl_ios *src = toiostream(args[0]);
- if(src->bm != bm_mem)
- lerrorf(sl_errarg, "requires memory stream");
- bool eof = ios_eof(src);
- sl_v v = stream_to_string(&args[0]);
- if(eof && v == sl_emptystr)
- v = sl_eof;
- return v;
-}
-
-void
-iostream_init(void)
-{- sl_iostreamsym = csymbol("iostream");- sl_rdsym = csymbol(":read");- sl_wrsym = csymbol(":write");- sl_apsym = csymbol(":append");- sl_crsym = csymbol(":create");- sl_truncsym = csymbol(":truncate");- sl_nonesym = csymbol(":none");- sl_linesym = csymbol(":line");- sl_blocksym = csymbol(":block");- sl_memorysym = csymbol(":memory");- sl_instrsym = csymbol("*input-stream*");- sl_outstrsym = csymbol("*output-stream*");- sl_iostreamtype = define_opaque_type(sl_iostreamsym, sizeof(sl_ios), &iostream_vtable, nil);
- set(csymbol("*stdout*"), cvalue_from_ref(sl_iostreamtype, ios_stdout, sizeof(sl_ios)));- set(csymbol("*stderr*"), cvalue_from_ref(sl_iostreamtype, ios_stderr, sizeof(sl_ios)));- set(csymbol("*stdin*"), cvalue_from_ref(sl_iostreamtype, ios_stdin, sizeof(sl_ios)));-}
--- a/src/iostream.h
+++ /dev/null
@@ -1,5 +1,0 @@
-sl_ios *toiostream(sl_v v);
-int isiostream(sl_v v) sl_purefn;
-sl_v stream_to_string(sl_v *ps);
-void iostream_init(void);
-extern sl_type *sl_iostreamtype;
--- a/src/macos/sys.c
+++ b/src/macos/sys.c
@@ -24,7 +24,7 @@
}
void
-timestring(double s, char *buf, int sz)
+timestr(double s, char *buf, int sz)
{USED(s); USED(sz);
buf[0] = 0;
--- a/src/opcodes.c
+++ b/src/opcodes.c
@@ -15,10 +15,10 @@
[OP_NOT] = {"not", 1}, [OP_LIST] = {"list", ANYARGS}, [OP_CONS] = {"cons", 2},- [OP_NUMBERP] = {"number?", 1},+ [OP_VECTORP] = {"vector?", 1}, [OP_BOUNDP] = {"bound?", 1}, [OP_LT] = {"<", -1},- [OP_VECTORP] = {"vector?", 1},+ [OP_NUMP] = {"num?", 1}, [OP_CAR] = {"car", 1}, [OP_EQV] = {"eqv?", 2}, [OP_IDIV] = {"div0", 2},--- a/src/opcodes.h
+++ b/src/opcodes.h
@@ -39,7 +39,7 @@
OP_NEG,
OP_NANP,
OP_BRBOUND,
- OP_NUMBERP,
+ OP_NUMP,
OP_FIXNUMP,
OP_BOUNDP,
OP_BUILTINP,
--- a/src/plan9/lsd.c
+++ b/src/plan9/lsd.c
@@ -3,7 +3,7 @@
#include <ctype.h>
#include <mach.h>
#include "cvalues.h"
-#include "iostream.h"
+#include "io.h"
static char aout[1024];
static sl_v lsd_gpregsym, lsd_fpregsym, lsd_regsym, lsd_symsym, lsd_framesym;
@@ -70,7 +70,7 @@
v = alloc_vector(4, 0);
sl_gc_handle(&v);
vector_elt(v, 0) = lsd_symsym;
- vector_elt(v, 1) = string_from_cstr(s->name);
+ vector_elt(v, 1) = str_from_cstr(s->name);
vector_elt(v, 2) = mk_rune(r);
vector_elt(v, 3) = size_wrap(s->value);
sl_free_gc_handles(1);
@@ -253,8 +253,8 @@
pid = -1;
argcount(nargs, 1);
- if(sl_unlikely(!sl_isstring(args[0]) && !sl_isnumber(args[0])))
- type_error("string|number", args[0]);+ if(sl_unlikely(!sl_isstr(args[0]) && !sl_isnum(args[0])))
+ type_error("str|num", args[0]); if(isfixnum(args[0])){pid = numval(args[0]);
@@ -276,7 +276,7 @@
for(r = mach->reglist; r->rname != nil; r++){v = alloc_vector(5, 0);
vector_elt(v, 0) = lsd_regsym;
- vector_elt(v, 1) = string_from_cstr(r->rname);
+ vector_elt(v, 1) = str_from_cstr(r->rname);
vector_elt(v, 2) = r->rflags == RINT ? lsd_gpregsym : lsd_fpregsym;
vector_elt(v, 3) = size_wrap(r->roffs);
switch(r->rformat){@@ -296,7 +296,7 @@
sl_gc_handle(&v);
vector_elt(v, 0) = fixnum(pid);
vector_elt(v, 1) = registers;
- vector_elt(v, 2) = cvalue_from_ref(sl_stringtype, machdata->bpinst, machdata->bpsize);
+ vector_elt(v, 2) = cvalue_from_ref(sl_strtype, machdata->bpinst, machdata->bpsize);
vector_elt(v, 3) = symslist(textsym);
vector_elt(v, 4) = symslist(globalsym);
sl_free_gc_handles(1);
@@ -325,7 +325,7 @@
v = alloc_vector(2, 0);
sl_gc_handle(&v);
vector_elt(v, 0) = fixnum(pid);
- vector_elt(v, 1) = cvalue_from_ref(sl_iostreamtype, proc_stdin, sizeof(*proc_stdin));
+ vector_elt(v, 1) = cvalue_from_ref(sl_iotype, proc_stdin, sizeof(*proc_stdin));
sl_free_gc_handles(1);
return v;
}
@@ -337,8 +337,8 @@
sl_v foll;
argcount(nargs, 1);
- if(sl_unlikely(!sl_isnumber(args[0])))
- type_error("number", args[0]);+ if(sl_unlikely(!sl_isnum(args[0])))
+ type_error("num", args[0]);addr = tosize(args[0]);
n = (*machdata->foll)(coremap, addr, rget, f);
@@ -360,8 +360,8 @@
argcount(nargs, 3);
for(a = args; a < args+3; a++)
- if(sl_unlikely(!sl_isnumber(*a)))
- type_error("number", *a);+ if(sl_unlikely(!sl_isnum(*a)))
+ type_error("num", *a);pc = tosize(args[0]);
sp = tosize(args[1]);
--- a/src/plan9/lsd.lsp
+++ b/src/plan9/lsd.lsp
@@ -14,7 +14,7 @@
(def bptbl (table))
(def (procfile s . flags)
- (let ((path (string "/proc/" pid "/" s)))
+ (let ((path (str "/proc/" pid "/" s)))
(apply file (cons path flags))))
(def (writectl msg)
@@ -69,7 +69,7 @@
(if (< pid 0) (error "no running process"))
(let ((addr (cond ((eq? (typeof loc) 'symbol)
(sym-addr (get (global-text globals) loc)))
- ((number? loc) (u64 loc))
+ ((num? loc) (u64 loc))
(else (error "symbol or number")))))
(unless (eq? (status) 'Stopped)
(begin
@@ -158,7 +158,7 @@
(add-exit-hook at-exit)
(let* ((proc (cadr *argv*))
- (pid (string->number proc)))
+ (pid (str->num proc)))
(if pid (load pid) (load proc)))
(repl)
--- a/src/plan9/sys.c
+++ b/src/plan9/sys.c
@@ -70,7 +70,7 @@
}
void
-timestring(double s, char *buf, int sz)
+timestr(double s, char *buf, int sz)
{Tm tm;
snprint(buf, sz, "%τ", tmfmt(tmtime(&tm, s, tzload("local")), nil));--- a/src/posix/sys.c
+++ b/src/posix/sys.c
@@ -59,7 +59,7 @@
}
void
-timestring(double s, char *buf, int sz)
+timestr(double s, char *buf, int sz)
{time_t tme = (time_t)s;
struct tm tm;
--- a/src/print.c
+++ b/src/print.c
@@ -180,7 +180,7 @@
const char *s = symbol_name(v);
return u8_strwidth(s, strlen(s)) < SMALL_STR_LEN;
}
- if(sl_isstring(v))
+ if(sl_isstr(v))
return cv_len(ptr(v)) < SMALL_STR_LEN;
return (
isfixnum(v) || isbuiltin(v) || iscprim(v) ||
@@ -193,7 +193,7 @@
{if(tinyp(v))
return true;
- if(sl_isnumber(v))
+ if(sl_isnum(v))
return true;
if(iscons(v)){if(tinyp(car_(v)) &&
@@ -524,7 +524,7 @@
}
static void
-print_string(sl_ios *f, const char *str, usize sz)
+print_str(sl_ios *f, const char *str, usize sz)
{char buf[64];
u8int c;
@@ -800,7 +800,7 @@
*/
}else{outc(f, '"');
- print_string(f, (char*)data, len);
+ print_str(f, (char*)data, len);
outc(f, '"');
}
return;
@@ -812,7 +812,7 @@
n = runetochar(buf, (Rune*)data);
buf[n] = 0;
if(!sl.print_princ)
- print_string(f, buf, n);
+ print_str(f, buf, n);
else if(ios_write(f, buf, n) != (usize)n)
goto err;
}
@@ -905,6 +905,6 @@
memset(sl.consflags, 0, 4*bitvector_nwords(slg.heapsize/sizeof(sl_cons)));
if((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) &&
- !sl_isstring(v) && v != sl_t && v != sl_nil && v != sl_void)
+ !sl_isstr(v) && v != sl_t && v != sl_nil && v != sl_void)
htable_reset(&sl.printconses, 32);
}
--- a/src/read.c
+++ b/src/read.c
@@ -134,7 +134,7 @@
n = 0;
va_start(args, format);
vsnprintf(msgbuf+n, sizeof(msgbuf)-n, format, args);
- sl_v msg = string_from_cstr(msgbuf);
+ sl_v msg = str_from_cstr(msgbuf);
va_end(args);
sl_raise(mk_list2(sl_errparse, msg));
@@ -440,7 +440,7 @@
}
static sl_v
-read_string(Rctx *ctx)
+read_str(Rctx *ctx)
{char *buf, *temp;
char eseq[10];
@@ -536,7 +536,7 @@
buf[i++] = c;
}
}
- s = cvalue_string(i);
+ s = cvalue_str(i);
memcpy(cvalue_data(s), buf, i);
if(buf != ctx->buf)
MEM_FREE(buf);
@@ -709,7 +709,7 @@
*pv = gensym();
return *pv;
case TOK_DOUBLEQUOTE:
- return read_string(ctx);
+ return read_str(ctx);
case TOK_CLOSE:
parse_error(&ctx->loc, "unexpected ')'");
case TOK_CLOSEB:
--- a/src/sl.c
+++ b/src/sl.c
@@ -8,7 +8,7 @@
#include "equal.h"
#include "hashing.h"
#include "table.h"
-#include "iostream.h"
+#include "io.h"
#include "compress.h"
sl_v sl_builtinssym, sl_quote, sl_lambda, sl_function, sl_comma, sl_commaat;
@@ -25,12 +25,11 @@
sl_v sl_printwidthsym, sl_printreadablysym, sl_printprettysym, sl_printlengthsym;
sl_v sl_printlevelsym;
sl_v sl_tablesym, sl_arraysym;
-sl_v sl_iostreamsym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
-sl_v sl_instrsym, sl_outstrsym;
+sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
sl_v sl_s64sym, sl_u64sym, sl_bignumsym;
sl_v sl_bytesym, sl_runesym, sl_floatsym, sl_doublesym;
-sl_v sl_stringtypesym, sl_runestringtypesym;
+sl_v sl_strtypesym, sl_runestrtypesym;
sl_type *sl_mptype, *sl_builtintype;
sl_type *sl_s8type, *sl_u8type;
@@ -39,7 +38,7 @@
sl_type *sl_s64type, *sl_u64type;
sl_type *sl_floattype, *sl_doubletype;
sl_type *sl_bytetype, *sl_runetype;
-sl_type *sl_stringtype, *sl_runestringtype;
+sl_type *sl_strtype, *sl_runestrtype;
sl_thread(Sl *slp);
Slg slg = {0};@@ -145,7 +144,7 @@
PUSH(e);
va_start(args, format);
vsnprintf(msgbuf, sizeof(msgbuf), format, args);
- sl_v msg = string_from_cstr(msgbuf);
+ sl_v msg = str_from_cstr(msgbuf);
va_end(args);
e = POP();
@@ -178,7 +177,7 @@
// safe cast operators --------------------------------------------------------
-#define isstring sl_isstring
+#define isstr sl_isstr
#define SAFECAST_OP(type, ctype, cnvt) \
ctype to##type(sl_v v) \
{ \@@ -190,8 +189,8 @@
SAFECAST_OP(symbol, sl_sym*, ptr)
SAFECAST_OP(fixnum, sl_fx, numval)
//SAFECAST_OP(cvalue, csl_v*, ptr)
-SAFECAST_OP(string, char*, cvalue_data)
-#undef isstring
+SAFECAST_OP(str, char*, cvalue_data)
+#undef isstr
// symbol table ---------------------------------------------------------------
@@ -676,7 +675,7 @@
}
bool
-sl_isnumber(sl_v v)
+sl_isnum(sl_v v)
{if(isfixnum(v) || ismp(v))
return true;
@@ -944,8 +943,8 @@
return fn_builtin_builtin(args, nargs);
if(nargs < 2 || nargs > 4)
argcount(nargs, 2);
- if(sl_unlikely(!sl_isstring(args[0])))
- type_error("string", args[0]);+ if(sl_unlikely(!sl_isstr(args[0])))
+ type_error("str", args[0]);if(sl_unlikely(!isvector(args[1])))
type_error("vector", args[1]);csl_v *arr = ptr(args[0]);
@@ -1306,17 +1305,17 @@
cvalues_init();
- set(csymbol("*os-name*"), cvalue_static_cstring(__os_name__));+ set(csymbol("*os-name*"), cvalue_static_cstr(__os_name__));#if defined(__os_version__)
- set(csymbol("*os-version*"), cvalue_static_cstring(__os_version__));+ set(csymbol("*os-version*"), cvalue_static_cstr(__os_version__));#endif
- sl_erroom = mk_list2(sl_errmem, cvalue_static_cstring("out of memory"));+ sl_erroom = mk_list2(sl_errmem, cvalue_static_cstr("out of memory"));const sl_builtinspec *b;
for(i = 0, b = builtin_fns; i < nelem(builtin_fns); i++, b++)
cbuiltin(b->name, b->fptr);
table_init();
- iostream_init();
+ io_init();
compress_init();
sys_init();
return 0;
@@ -1331,10 +1330,10 @@
}
int
-sl_load_system_image(sl_v sys_image_iostream)
+sl_load_system_image(sl_v sys_image_io)
{slg.loading = true;
- PUSH(sys_image_iostream);
+ PUSH(sys_image_io);
sl_v *saveSP = sl.sp;
sl_TRY{ while(1){--- a/src/sl.h
+++ b/src/sl.h
@@ -202,7 +202,7 @@
sl_v mk_cons(sl_v a, sl_v b);
sl_v mk_list2(sl_v a, sl_v b);
sl_v mk_listn(int n, ...);
-bool sl_isnumber(sl_v v) sl_purefn;
+bool sl_isnum(sl_v v) sl_purefn;
sl_v alloc_vector(usize n, bool init);
/* consistent iswprint and wcwidth */
@@ -213,7 +213,7 @@
sl_cons *tocons(sl_v v) sl_purefn;
sl_sym *tosymbol(sl_v v) sl_purefn;
sl_fx tofixnum(sl_v v) sl_purefn;
-char *tostring(sl_v v) sl_purefn;
+char *tostr(sl_v v) sl_purefn;
double todouble(sl_v a) sl_purefn;
/* conses */
@@ -425,12 +425,11 @@
extern sl_v sl_printwidthsym, sl_printreadablysym, sl_printprettysym, sl_printlengthsym;
extern sl_v sl_printlevelsym;
extern sl_v sl_arraysym;
-extern sl_v sl_iostreamsym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
-extern sl_v sl_instrsym, sl_outstrsym;
+extern sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
extern sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
extern sl_v sl_s64sym, sl_u64sym, sl_bignumsym;
extern sl_v sl_bytesym, sl_runesym, sl_floatsym, sl_doublesym;
-extern sl_v sl_stringtypesym, sl_runestringtypesym;
+extern sl_v sl_strtypesym, sl_runestrtypesym;
extern sl_type *sl_mptype, *sl_builtintype;
extern sl_type *sl_s8type, *sl_u8type;
@@ -439,7 +438,7 @@
extern sl_type *sl_s64type, *sl_u64type;
extern sl_type *sl_floattype, *sl_doubletype;
extern sl_type *sl_bytetype, *sl_runetype;
-extern sl_type *sl_stringtype, *sl_runestringtype;
+extern sl_type *sl_strtype, *sl_runestrtype;
void sys_init(void);
--- a/src/sl_arith_any.h
+++ b/src/sl_arith_any.h
@@ -32,7 +32,7 @@
typeerr:
mpfree(Maccum);
mpfree(m);
- type_error("number", arg);+ type_error("num", arg);}
switch(pt){case T_DOUBLE: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue;
--- a/src/slmain.c
+++ b/src/slmain.c
@@ -1,7 +1,7 @@
#include "sl.h"
#include "cvalues.h"
#include "print.h"
-#include "iostream.h"
+#include "io.h"
#include "random.h"
#include "brieflz.h"
#include "nan.h"
@@ -36,10 +36,10 @@
sl_gc_handle(&lst);
sl_gc_handle(&temp);
for(i = argc-1; i >= 0; i--){- temp = cvalue_static_cstring(argv[i]);
+ temp = cvalue_static_cstr(argv[i]);
lst = mk_cons(temp, lst);
}
- lst = mk_cons(cvalue_static_cstring(argv0), lst);
+ lst = mk_cons(cvalue_static_cstr(argv0), lst);
sl_free_gc_handles(2);
return lst;
}
@@ -78,7 +78,7 @@
nan_init();
randomize();
- ios_init_stdstreams();
+ ios_init_std();
mpsetminbits(sizeof(sl_fx)*8);
ARGBEGIN{--- /dev/null
+++ b/src/str.c
@@ -1,0 +1,457 @@
+/*
+ string functions
+*/
+#include "sl.h"
+#include "operators.h"
+#include "cvalues.h"
+#include "print.h"
+#include "read.h"
+#include "equal.h"
+#include "io.h"
+
+sl_purefn
+BUILTIN("str?", strp)+{+ argcount(nargs, 1);
+ return sl_isstr(args[0]) ? sl_t : sl_nil;
+}
+
+BUILTIN("str-length", str_length)+{+ usize start = 0;
+ if(nargs < 1 || nargs > 3)
+ argcount(nargs, 1);
+ if(!sl_isstr(args[0]))
+ type_error("str", args[0]);+ usize len = cv_len(ptr(args[0]));
+ usize stop = len;
+ if(nargs > 1){+ start = tosize(args[1]);
+ if(start > len)
+ bounds_error(args[0], args[1]);
+ if(nargs > 2){+ stop = tosize(args[2]);
+ if(stop > len)
+ bounds_error(args[0], args[2]);
+ if(stop <= start)
+ return fixnum(0);
+ }
+ }
+ char *str = cvalue_data(args[0]);
+ return size_wrap(u8_charnum(str+start, stop-start));
+}
+
+BUILTIN("str-width", str_width)+{+ argcount(nargs, 1);
+ if(iscprim(args[0])){+ sl_cprim *cp = ptr(args[0]);
+ if(cp_class(cp) == sl_runetype){+ int w = sl_wcwidth(*(Rune*)cp_data(cp));
+ return w < 0 ? sl_nil : fixnum(w);
+ }
+ }
+ if(!sl_isstr(args[0]))
+ type_error("str", args[0]);+ char *str = tostr(args[0]);
+ usize len = cv_len(ptr(args[0]));
+ ssize w = u8_strwidth(str, len);
+ return w < 0 ? sl_nil : size_wrap(w);
+}
+
+BUILTIN("str-reverse", str_reverse)+{+ argcount(nargs, 1);
+ if(!sl_isstr(args[0]))
+ type_error("str", args[0]);+ usize len = cv_len(ptr(args[0]));
+ sl_v ns = cvalue_str(len);
+ u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
+ return ns;
+}
+
+BUILTIN("str-encode", str_encode)+{+ argcount(nargs, 1);
+ if(iscvalue(args[0])){+ csl_v *cv = ptr(args[0]);
+ sl_type *t = cv_class(cv);
+ if(t->eltype == sl_runetype){+ usize nr = cv_len(cv) / sizeof(Rune);
+ Rune *r = (Rune*)cv_data(cv);
+ usize nb = runenlen(r, nr);
+ sl_v str = cvalue_str(nb);
+ char *s = cvalue_data(str);
+ for(usize i = 0; i < nr; i++)
+ s += runetochar(s, r+i);
+ return str;
+ }
+ }
+ type_error("rune array", args[0]);+}
+
+BUILTIN("str-decode", str_decode)+{+ bool term = false;
+ if(nargs == 2)
+ term = args[1] != sl_nil;
+ else
+ argcount(nargs, 1);
+ if(!sl_isstr(args[0]))
+ type_error("str", args[0]);+ csl_v *cv = ptr(args[0]);
+ char *ptr = (char*)cv_data(cv);
+ usize nb = cv_len(cv);
+ usize nc = u8_runelen(ptr, nb);
+ usize newsz = nc*sizeof(Rune);
+ if(term)
+ newsz += sizeof(Rune);
+ sl_v runestr = cvalue(sl_runestrtype, newsz);
+ ptr = cvalue_data(args[0]); // relocatable pointer
+ Rune *r = cvalue_data(runestr);
+ for(usize i = 0; i < nb; i++)
+ ptr += chartorune(r+i, ptr);
+ if(term)
+ r[nb] = 0;
+ return runestr;
+}
+
+BUILTIN("str", str)+{+ if(nargs == 1 && sl_isstr(args[0]))
+ return args[0];
+ sl_v arg, buf = fn_builtin_buffer(nil, 0);
+ sl_gc_handle(&buf);
+ sl_ios *s = value2c(sl_ios*, buf);
+ sl_v oldpr = symbol_value(sl_printreadablysym);
+ sl_v oldpp = symbol_value(sl_printprettysym);
+ set(sl_printreadablysym, sl_nil);
+ set(sl_printprettysym, sl_nil);
+ int i;
+ FOR_ARGS(i, 0, arg, args){+ USED(arg);
+ sl_print(s, args[i]);
+ }
+ set(sl_printreadablysym, oldpr);
+ set(sl_printprettysym, oldpp);
+ sl_v outp = io_to_str(&buf);
+ sl_free_gc_handles(1);
+ return outp;
+}
+
+BUILTIN("str-split", str_split)+{+ if(nargs < 1)
+ argcount(nargs, 1);
+ char *s = tostr(args[0]);
+ usize len = cv_len(ptr(args[0]));
+ // split on whitespace by default
+ const char *delim0 = " \t\n\r\v", *delim = delim0;
+ usize dlen = 5;
+ int n = 1;
+ // second is either a :trim or a separator
+ if(nargs > n && args[n] != sl_trimsym){+ delim = tostr(args[n]);
+ dlen = cv_len(ptr(args[n]));
+ n++;
+ }
+ bool trim = false;
+ // it can only be a :trim X now
+ if(nargs > n){+ if(args[n] != sl_trimsym)
+ lerrorf(sl_errarg, "invalid argument at position %d", n);
+ n++;
+ if(nargs <= n)
+ argcount(nargs, n+1);
+ trim = args[n] != sl_nil;
+ }
+ usize ssz, tokend, tokstart, i = 0;
+ sl_v first = sl_nil, c = sl_nil, last;
+ usize junk;
+ sl_gc_handle(&first);
+ sl_gc_handle(&last);
+
+ do{+ // find and allocate next token
+ tokstart = tokend = i;
+ while(i < len && !u8_memchr((char*)delim, u8_nextmemchar(s, &i), dlen, &junk))
+ tokend = i;
+ ssz = tokend - tokstart;
+ if(ssz == 0 && trim)
+ continue;
+
+ last = c; // save previous cons cell
+ c = mk_cons(cvalue_str(ssz), sl_nil);
+
+ if(delim != delim0){+ // we've done allocation; reload movable pointers
+ s = cvalue_data(args[0]);
+ delim = cvalue_data(args[1]);
+ }
+
+ if(ssz)
+ memmove(cvalue_data(car_(c)), &s[tokstart], ssz);
+
+ // link new cell
+ if(last == sl_nil)
+ first = c; // first time, save first cons
+ else
+ ((sl_cons*)ptr(last))->cdr = c;
+
+ // note this tricky condition: if the string ends with a
+ // delimiter, we need to go around one more time to add an
+ // empty string. this happens when (i == len && tokend < i)
+ }while(i < len || (i == len && tokend != i));
+ sl_free_gc_handles(2);
+ return first;
+}
+
+BUILTIN("str-sub", str_sub)+{+ if(nargs != 2)
+ argcount(nargs, 3);
+ char *s = tostr(args[0]);
+ usize lenbytes = cv_len(ptr(args[0]));
+ usize startbytes, n, startchar = tosize(args[1]);
+ for(startbytes = n = 0; n < startchar && startbytes < lenbytes; n++)
+ startbytes += u8_seqlen(s+startbytes);
+ if(n != startchar)
+ bounds_error(args[0], args[1]);
+ usize endbytes = lenbytes;
+ if(nargs == 3){+ usize endchar = tosize(args[2]);
+ for(endbytes = startbytes; n < endchar && endbytes < lenbytes; n++)
+ endbytes += u8_seqlen(s+endbytes);
+ if(n != endchar)
+ bounds_error(args[0], args[2]);
+ }
+ sl_v ns = cvalue_str(endbytes-startbytes);
+ s = cvalue_data(args[0]); // reload after alloc
+ memmove(cvalue_data(ns), s+startbytes, endbytes-startbytes);
+ return ns;
+}
+
+BUILTIN("str-char", str_char)+{+ argcount(nargs, 2);
+ char *s = tostr(args[0]);
+ usize lenbytes = cv_len(ptr(args[0]));
+ usize startbytes, n, startchar = tosize(args[1]);
+ for(startbytes = n = 0; n < startchar && startbytes < lenbytes; n++)
+ startbytes += u8_seqlen(s+startbytes);
+ if(n != startchar || startbytes >= lenbytes)
+ bounds_error(args[0], args[1]);
+ Rune r;
+ chartorune(&r, s+startbytes);
+ return mk_rune(r);
+}
+
+BUILTIN("char-upcase", char_upcase)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return mk_rune(toupperrune(*(Rune*)cp_data(cp)));
+}
+
+BUILTIN("char-downcase", char_downcase)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return mk_rune(tolowerrune(*(Rune*)cp_data(cp)));
+}
+
+BUILTIN("char-titlecase", char_titlecase)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return mk_rune(totitlerune(*(Rune*)cp_data(cp)));
+}
+
+sl_purefn
+BUILTIN("char-alphabetic?", char_alphabeticp)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return isalpharune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("char-lower-case?", char_lower_casep)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return islowerrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("char-upper-case?", char_upper_casep)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return isupperrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("char-title-case?", char_title_casep)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return istitlerune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("char-numeric?", char_numericp)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return isdigitrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+sl_purefn
+BUILTIN("char-whitespace?", char_whitespacep)+{+ argcount(nargs, 1);
+ sl_cprim *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
+ type_error("rune", args[0]);+ return isspacerune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
+}
+
+BUILTIN("str-find", str_find)+{+ char cbuf[UTFmax+1];
+ usize start = 0;
+ if(nargs == 3)
+ start = tosize(args[2]);
+ else
+ argcount(nargs, 2);
+ char *s = tostr(args[0]);
+ usize len = cv_len(ptr(args[0]));
+ if(start > len)
+ bounds_error(args[0], args[2]);
+ char *needle; usize needlesz;
+
+ sl_v v = args[1];
+ sl_cprim *cp = ptr(v);
+ if(iscprim(v) && cp_class(cp) == sl_runetype){+ Rune r = *(Rune*)cp_data(cp);
+ needlesz = runetochar(cbuf, &r);
+ needle = cbuf;
+ needle[needlesz] = 0;
+ }else if(iscprim(v) && cp_class(cp) == sl_bytetype){+ needlesz = 1;
+ needle = cbuf;
+ needle[0] = *(char*)cp_data(cp);
+ needle[needlesz] = 0;
+ }else if(sl_isstr(v)){+ csl_v *cv = ptr(v);
+ needlesz = cv_len(cv);
+ needle = (char*)cv_data(cv);
+ }else{+ type_error("str", args[1]);+ }
+ if(needlesz > len-start)
+ return sl_nil;
+ if(needlesz == 0)
+ return size_wrap(start);
+ usize i;
+ for(i = start; i < len-needlesz+1; i++){+ if(s[i] == needle[0] && memcmp(&s[i+1], needle+1, needlesz-1) == 0)
+ return size_wrap(i);
+ }
+ return sl_nil;
+}
+
+static unsigned long
+get_radix_arg(sl_v arg)
+{+ unsigned long radix = tosize(arg);
+ if(radix < 2 || radix > 36)
+ lerrorf(sl_errarg, "invalid radix");
+ return radix;
+}
+
+BUILTIN("num->str", numb_2_str)+{+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 2);
+ sl_v n = args[0];
+ bool neg = false;
+ u64int num;
+ int radix = 10;
+ if(nargs == 2)
+ radix = get_radix_arg(args[1]);
+ if(isfixnum(n))
+ num = numval(n);
+ else if(iscprim(n)){+ void *data = ptr(n);
+ if(cp_numtype(data) < T_FLOAT)
+ num = conv_to_u64(cp_data(data), cp_numtype(data));
+ else if(radix != 10)
+ lerrorf(sl_errarg, "invalid radix with floating point");
+ else
+ return fn_builtin_str(args, nargs);
+ }else if(ismp(n)){+ if(radix != 16 && radix != 10 && radix != 8 && radix != 4 && radix != 2)
+ lerrorf(sl_errarg, "invalid radix with bignum");
+ mpint *i = tomp(n);
+ char *s = mptoa(i, radix, nil, 0);
+ assert(s != nil);
+ if(radix == 16){ /* FFFF → ffff */+ for(int k = 0; s[k]; k++)
+ s[k] = tolower(s[k]);
+ }
+ n = str_from_cstr(s);
+ MEM_FREE(s);
+ return n;
+ }else{+ type_error("int", n);+ }
+ if(numval(sl_compare(args[0], fixnum(0), false)) < 0){+ num = -num;
+ neg = true;
+ }
+ char buf[128], *str = uint2str(buf, sizeof(buf), num, radix);
+ if(neg && str > buf)
+ *(--str) = '-';
+ return str_from_cstr(str);
+}
+
+BUILTIN("str->num", str_2_num)+{+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 2);
+ char *str = tostr(args[0]);
+ sl_v n;
+ unsigned long radix = 0;
+ if(nargs == 2)
+ radix = get_radix_arg(args[1]);
+ if(!sl_read_numtok(str, &n, (int)radix))
+ return sl_nil;
+ return n;
+}
+
+sl_purefn
+BUILTIN("str-utf8?", str_utf8p)+{+ argcount(nargs, 1);
+ char *s = tostr(args[0]);
+ usize len = cv_len(ptr(args[0]));
+ return u8_isvalid(s, len) ? sl_t : sl_nil;
+}
--- a/src/string.c
+++ /dev/null
@@ -1,457 +1,0 @@
-/*
- string functions
-*/
-#include "sl.h"
-#include "operators.h"
-#include "cvalues.h"
-#include "print.h"
-#include "read.h"
-#include "equal.h"
-#include "iostream.h"
-
-sl_purefn
-BUILTIN("string?", stringp)-{- argcount(nargs, 1);
- return sl_isstring(args[0]) ? sl_t : sl_nil;
-}
-
-BUILTIN("string-length", string_length)-{- usize start = 0;
- if(nargs < 1 || nargs > 3)
- argcount(nargs, 1);
- if(!sl_isstring(args[0]))
- type_error("string", args[0]);- usize len = cv_len(ptr(args[0]));
- usize stop = len;
- if(nargs > 1){- start = tosize(args[1]);
- if(start > len)
- bounds_error(args[0], args[1]);
- if(nargs > 2){- stop = tosize(args[2]);
- if(stop > len)
- bounds_error(args[0], args[2]);
- if(stop <= start)
- return fixnum(0);
- }
- }
- char *str = cvalue_data(args[0]);
- return size_wrap(u8_charnum(str+start, stop-start));
-}
-
-BUILTIN("string-width", string_width)-{- argcount(nargs, 1);
- if(iscprim(args[0])){- sl_cprim *cp = ptr(args[0]);
- if(cp_class(cp) == sl_runetype){- int w = sl_wcwidth(*(Rune*)cp_data(cp));
- return w < 0 ? sl_nil : fixnum(w);
- }
- }
- if(!sl_isstring(args[0]))
- type_error("string", args[0]);- char *str = tostring(args[0]);
- usize len = cv_len(ptr(args[0]));
- ssize w = u8_strwidth(str, len);
- return w < 0 ? sl_nil : size_wrap(w);
-}
-
-BUILTIN("string-reverse", string_reverse)-{- argcount(nargs, 1);
- if(!sl_isstring(args[0]))
- type_error("string", args[0]);- usize len = cv_len(ptr(args[0]));
- sl_v ns = cvalue_string(len);
- u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
- return ns;
-}
-
-BUILTIN("string-encode", string_encode)-{- argcount(nargs, 1);
- if(iscvalue(args[0])){- csl_v *cv = ptr(args[0]);
- sl_type *t = cv_class(cv);
- if(t->eltype == sl_runetype){- usize nr = cv_len(cv) / sizeof(Rune);
- Rune *r = (Rune*)cv_data(cv);
- usize nb = runenlen(r, nr);
- sl_v str = cvalue_string(nb);
- char *s = cvalue_data(str);
- for(usize i = 0; i < nr; i++)
- s += runetochar(s, r+i);
- return str;
- }
- }
- type_error("rune array", args[0]);-}
-
-BUILTIN("string-decode", string_decode)-{- bool term = false;
- if(nargs == 2)
- term = args[1] != sl_nil;
- else
- argcount(nargs, 1);
- if(!sl_isstring(args[0]))
- type_error("string", args[0]);- csl_v *cv = ptr(args[0]);
- char *ptr = (char*)cv_data(cv);
- usize nb = cv_len(cv);
- usize nc = u8_runelen(ptr, nb);
- usize newsz = nc*sizeof(Rune);
- if(term)
- newsz += sizeof(Rune);
- sl_v runestr = cvalue(sl_runestringtype, newsz);
- ptr = cvalue_data(args[0]); // relocatable pointer
- Rune *r = cvalue_data(runestr);
- for(usize i = 0; i < nb; i++)
- ptr += chartorune(r+i, ptr);
- if(term)
- r[nb] = 0;
- return runestr;
-}
-
-BUILTIN("string", string)-{- if(nargs == 1 && sl_isstring(args[0]))
- return args[0];
- sl_v arg, buf = fn_builtin_buffer(nil, 0);
- sl_gc_handle(&buf);
- sl_ios *s = value2c(sl_ios*, buf);
- sl_v oldpr = symbol_value(sl_printreadablysym);
- sl_v oldpp = symbol_value(sl_printprettysym);
- set(sl_printreadablysym, sl_nil);
- set(sl_printprettysym, sl_nil);
- int i;
- FOR_ARGS(i, 0, arg, args){- USED(arg);
- sl_print(s, args[i]);
- }
- set(sl_printreadablysym, oldpr);
- set(sl_printprettysym, oldpp);
- sl_v outp = stream_to_string(&buf);
- sl_free_gc_handles(1);
- return outp;
-}
-
-BUILTIN("string-split", string_split)-{- if(nargs < 1)
- argcount(nargs, 1);
- char *s = tostring(args[0]);
- usize len = cv_len(ptr(args[0]));
- // split on whitespace by default
- const char *delim0 = " \t\n\r\v", *delim = delim0;
- usize dlen = 5;
- int n = 1;
- // second is either a :trim or a separator
- if(nargs > n && args[n] != sl_trimsym){- delim = tostring(args[n]);
- dlen = cv_len(ptr(args[n]));
- n++;
- }
- bool trim = false;
- // it can only be a :trim X now
- if(nargs > n){- if(args[n] != sl_trimsym)
- lerrorf(sl_errarg, "invalid argument at position %d", n);
- n++;
- if(nargs <= n)
- argcount(nargs, n+1);
- trim = args[n] != sl_nil;
- }
- usize ssz, tokend, tokstart, i = 0;
- sl_v first = sl_nil, c = sl_nil, last;
- usize junk;
- sl_gc_handle(&first);
- sl_gc_handle(&last);
-
- do{- // find and allocate next token
- tokstart = tokend = i;
- while(i < len && !u8_memchr((char*)delim, u8_nextmemchar(s, &i), dlen, &junk))
- tokend = i;
- ssz = tokend - tokstart;
- if(ssz == 0 && trim)
- continue;
-
- last = c; // save previous cons cell
- c = mk_cons(cvalue_string(ssz), sl_nil);
-
- if(delim != delim0){- // we've done allocation; reload movable pointers
- s = cvalue_data(args[0]);
- delim = cvalue_data(args[1]);
- }
-
- if(ssz)
- memmove(cvalue_data(car_(c)), &s[tokstart], ssz);
-
- // link new cell
- if(last == sl_nil)
- first = c; // first time, save first cons
- else
- ((sl_cons*)ptr(last))->cdr = c;
-
- // note this tricky condition: if the string ends with a
- // delimiter, we need to go around one more time to add an
- // empty string. this happens when (i == len && tokend < i)
- }while(i < len || (i == len && tokend != i));
- sl_free_gc_handles(2);
- return first;
-}
-
-BUILTIN("string-sub", string_sub)-{- if(nargs != 2)
- argcount(nargs, 3);
- char *s = tostring(args[0]);
- usize lenbytes = cv_len(ptr(args[0]));
- usize startbytes, n, startchar = tosize(args[1]);
- for(startbytes = n = 0; n < startchar && startbytes < lenbytes; n++)
- startbytes += u8_seqlen(s+startbytes);
- if(n != startchar)
- bounds_error(args[0], args[1]);
- usize endbytes = lenbytes;
- if(nargs == 3){- usize endchar = tosize(args[2]);
- for(endbytes = startbytes; n < endchar && endbytes < lenbytes; n++)
- endbytes += u8_seqlen(s+endbytes);
- if(n != endchar)
- bounds_error(args[0], args[2]);
- }
- sl_v ns = cvalue_string(endbytes-startbytes);
- s = cvalue_data(args[0]); // reload after alloc
- memmove(cvalue_data(ns), s+startbytes, endbytes-startbytes);
- return ns;
-}
-
-BUILTIN("string-char", string_char)-{- argcount(nargs, 2);
- char *s = tostring(args[0]);
- usize lenbytes = cv_len(ptr(args[0]));
- usize startbytes, n, startchar = tosize(args[1]);
- for(startbytes = n = 0; n < startchar && startbytes < lenbytes; n++)
- startbytes += u8_seqlen(s+startbytes);
- if(n != startchar || startbytes >= lenbytes)
- bounds_error(args[0], args[1]);
- Rune r;
- chartorune(&r, s+startbytes);
- return mk_rune(r);
-}
-
-BUILTIN("char-upcase", char_upcase)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return mk_rune(toupperrune(*(Rune*)cp_data(cp)));
-}
-
-BUILTIN("char-downcase", char_downcase)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return mk_rune(tolowerrune(*(Rune*)cp_data(cp)));
-}
-
-BUILTIN("char-titlecase", char_titlecase)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return mk_rune(totitlerune(*(Rune*)cp_data(cp)));
-}
-
-sl_purefn
-BUILTIN("char-alphabetic?", char_alphabeticp)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return isalpharune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("char-lower-case?", char_lower_casep)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return islowerrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("char-upper-case?", char_upper_casep)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return isupperrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("char-title-case?", char_title_casep)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return istitlerune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("char-numeric?", char_numericp)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return isdigitrune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-sl_purefn
-BUILTIN("char-whitespace?", char_whitespacep)-{- argcount(nargs, 1);
- sl_cprim *cp = ptr(args[0]);
- if(!iscprim(args[0]) || cp_class(cp) != sl_runetype)
- type_error("rune", args[0]);- return isspacerune(*(Rune*)cp_data(cp)) ? sl_t : sl_nil;
-}
-
-BUILTIN("string-find", string_find)-{- char cbuf[UTFmax+1];
- usize start = 0;
- if(nargs == 3)
- start = tosize(args[2]);
- else
- argcount(nargs, 2);
- char *s = tostring(args[0]);
- usize len = cv_len(ptr(args[0]));
- if(start > len)
- bounds_error(args[0], args[2]);
- char *needle; usize needlesz;
-
- sl_v v = args[1];
- sl_cprim *cp = ptr(v);
- if(iscprim(v) && cp_class(cp) == sl_runetype){- Rune r = *(Rune*)cp_data(cp);
- needlesz = runetochar(cbuf, &r);
- needle = cbuf;
- needle[needlesz] = 0;
- }else if(iscprim(v) && cp_class(cp) == sl_bytetype){- needlesz = 1;
- needle = cbuf;
- needle[0] = *(char*)cp_data(cp);
- needle[needlesz] = 0;
- }else if(sl_isstring(v)){- csl_v *cv = ptr(v);
- needlesz = cv_len(cv);
- needle = (char*)cv_data(cv);
- }else{- type_error("string", args[1]);- }
- if(needlesz > len-start)
- return sl_nil;
- if(needlesz == 0)
- return size_wrap(start);
- usize i;
- for(i = start; i < len-needlesz+1; i++){- if(s[i] == needle[0] && memcmp(&s[i+1], needle+1, needlesz-1) == 0)
- return size_wrap(i);
- }
- return sl_nil;
-}
-
-static unsigned long
-get_radix_arg(sl_v arg)
-{- unsigned long radix = tosize(arg);
- if(radix < 2 || radix > 36)
- lerrorf(sl_errarg, "invalid radix");
- return radix;
-}
-
-BUILTIN("number->string", number_2_string)-{- if(nargs < 1 || nargs > 2)
- argcount(nargs, 2);
- sl_v n = args[0];
- bool neg = false;
- u64int num;
- int radix = 10;
- if(nargs == 2)
- radix = get_radix_arg(args[1]);
- if(isfixnum(n))
- num = numval(n);
- else if(iscprim(n)){- void *data = ptr(n);
- if(cp_numtype(data) < T_FLOAT)
- num = conv_to_u64(cp_data(data), cp_numtype(data));
- else if(radix != 10)
- lerrorf(sl_errarg, "invalid radix with floating point");
- else
- return fn_builtin_string(args, nargs);
- }else if(ismp(n)){- if(radix != 16 && radix != 10 && radix != 8 && radix != 4 && radix != 2)
- lerrorf(sl_errarg, "invalid radix with bignum");
- mpint *i = tomp(n);
- char *s = mptoa(i, radix, nil, 0);
- assert(s != nil);
- if(radix == 16){ /* FFFF → ffff */- for(int k = 0; s[k]; k++)
- s[k] = tolower(s[k]);
- }
- n = string_from_cstr(s);
- MEM_FREE(s);
- return n;
- }else{- type_error("integer", n);- }
- if(numval(sl_compare(args[0], fixnum(0), false)) < 0){- num = -num;
- neg = true;
- }
- char buf[128], *str = uint2str(buf, sizeof(buf), num, radix);
- if(neg && str > buf)
- *(--str) = '-';
- return string_from_cstr(str);
-}
-
-BUILTIN("string->number", string_2_number)-{- if(nargs < 1 || nargs > 2)
- argcount(nargs, 2);
- char *str = tostring(args[0]);
- sl_v n;
- unsigned long radix = 0;
- if(nargs == 2)
- radix = get_radix_arg(args[1]);
- if(!sl_read_numtok(str, &n, (int)radix))
- return sl_nil;
- return n;
-}
-
-sl_purefn
-BUILTIN("string-utf8?", string_utf8p)-{- argcount(nargs, 1);
- char *s = tostring(args[0]);
- usize len = cv_len(ptr(args[0]));
- return u8_isvalid(s, len) ? sl_t : sl_nil;
-}
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -148,7 +148,7 @@
(getprop term '*funvars* nil))
(newline))
(begin
- (princ "no help for " (string term))
+ (princ "no help for " term)
(newline)))
(void)))
@@ -155,7 +155,7 @@
(def (value-get-doc body)
(let ((first (car body))
(rest (cdr body)))
- (and (string? first) (cons? rest) first)))
+ (and (str? first) (cons? rest) first)))
;;; standard procedures
@@ -243,7 +243,7 @@
(- x (* (div x y) y)))
(def (random n)
- (if (integer? n)
+ (if (int? n)
(mod (rand) n)
(* (rand-double) n)))
@@ -732,13 +732,13 @@
(with-bindings ((*print-readably* nil))
(for-each write args)))
-(def (newline (port *output-stream*))
- (io-write port *linefeed*)
+(def (newline (io *io-out*))
+ (io-write io *linefeed*)
(void))
(def (io-readline s) (io-readuntil s #\linefeed))
-; call f on a stream until the stream runs out of data
+; call f on an io until the io runs out of data
(def (read-all-of f s)
(let loop ((lines ())
(curr (f s)))
@@ -752,13 +752,13 @@
(def (io-readall s)
(let ((b (buffer)))
(io-copy b s)
- (iostream->string b)))
+ (io->str b)))
-(defmacro (with-output-to stream . body)
- `(with-bindings ((*output-stream* ,stream))
+(defmacro (with-output-to io . body)
+ `(with-bindings ((*io-out* ,io))
,@body))
-(defmacro (with-input-from stream . body)
- `(with-bindings ((*input-stream* ,stream))
+(defmacro (with-input-from io . body)
+ `(with-bindings ((*io-in* ,io))
,@body))
;;; vector functions
@@ -804,49 +804,49 @@
;;; string functions
-(def (string-tail s n) (string-sub s n))
+(def (str-tail s n) (str-sub s n))
-(def (string-trim s at-start at-end)
+(def (str-trim s at-start at-end)
(def (trim-start s chars i L)
- (if (and (< i L) (string-find chars (string-char s i)))
+ (if (and (< i L) (str-find chars (str-char s i)))
(trim-start s chars (1+ i) L)
i))
(def (trim-end s chars i)
- (if (and (> i 0) (string-find chars (string-char s (1- i))))
+ (if (and (> i 0) (str-find chars (str-char s (1- i))))
(trim-end s chars (1- i))
i))
- (let ((L (string-length s)))
- (string-sub s
+ (let ((L (str-length s)))
+ (str-sub s
(trim-start s at-start 0 L)
(trim-end s at-end L))))
-(def (string-map f s)
+(def (str-map f s)
(let ((b (buffer))
- (n (string-length s)))
+ (n (str-length s)))
(let ((i 0))
(while (< i n)
- (io-putc b (f (string-char s i)))
+ (io-putc b (f (str-char s i)))
(set! i (1+ i))))
- (iostream->string b)))
+ (ios->str b)))
-(def (string-rep s k)
+(def (str-rep s k)
(cond ((< k 4)
(cond ((<= k 0) "")
- ((= k 1) (string s))
- ((= k 2) (string s s))
- (else (string s s s))))
- ((odd? k) (string s (string-rep s (- k 1))))
- (else (string-rep (string s s) (/ k 2)))))
+ ((= k 1) (str s))
+ ((= k 2) (str s s))
+ (else (str s s s))))
+ ((odd? k) (str s (str-rep s (- k 1))))
+ (else (str-rep (str s s) (/ k 2)))))
-(def (string-lpad s n c) (string (string-rep c (- n (string-length s))) s))
-(def (string-rpad s n c) (string s (string-rep c (- n (string-length s)))))
+(def (str-lpad s n c) (str (str-rep c (- n (str-length s))) s))
+(def (str-rpad s n c) (str s (str-rep c (- n (str-length s)))))
-(def (print-to-string v)
+(def (print-to-str v)
(let ((b (buffer)))
(write v b)
- (iostream->string b)))
+ (io->str b)))
-(def (string-join strlist sep)
+(def (str-join strlist sep)
(if (not strlist)
""
(let ((b (buffer)))
@@ -854,7 +854,7 @@
(for-each (λ (s) (io-write b sep)
(io-write b s))
(cdr strlist))
- (iostream->string b))))
+ (io->str b))))
;;; structs
@@ -880,9 +880,9 @@
; check whether slot options, if any, are valid
(let ((opts (cddr slot)))
(for-each (λ (opt) (unless (member opt '(:read-only))
- (error (string "invalid option in slot " (car slot)
- " of struct " name
- ": " opt))))
+ (error (str "invalid option in slot " (car slot)
+ " of struct " name
+ ": " opt))))
opts)
opts))
(def (tokw slots)
@@ -897,13 +897,13 @@
(when (or (not (symbol? name))
(keyword? name))
(error "invalid slot name: " name))
- (list* (symbol (string ":" name))
+ (list* (symbol (str ":" name))
(if (keyword? (car tail))
(cons nil tail)
tail))))
slots))
(let* {; first element in slots may be the doc string- [doc (and (string? (car slots))
+ [doc (and (str? (car slots))
(car slots))]
; if it is, rid of it
[slots (or (and doc (cdr slots))
@@ -916,16 +916,16 @@
; and keywords for names
[slots-kw (tokw slots)]
; struct's underlying type's predicate (either vector? or list?)
- [type? (symbol (string type "?"))]
+ [type? (symbol (str type "?"))]
; struct's predicate name
[is? (or predicate
- (symbol (string name "?")))]
+ (symbol (str name "?")))]
; constructor name and arguments
[constructor
(and constructor ; NIL means none to make at all
(or (and (atom? constructor) ; a single argument
(cons (or (and (eq? constructor T) ; T means the defaults
- (symbol (string "make-" name)))
+ (symbol (str "make-" name)))
constructor) ; else a custom name
slots-kw))
constructor))] ; anything else means custom name and args
@@ -933,7 +933,7 @@
[named (and named (list name))]
; accessor prefix
[access (or conc-name
- (string name "-"))]}
+ (str name "-"))]}
`(begin
; predicate
(def (,is? s)
@@ -949,17 +949,17 @@
; accessor per slot
,@(map-int (λ (i) [let* {[opts (slot-opts (list-ref slots-kw i))][fld (list-ref slots-car i)]
- [fun (symbol (string access fld))]}
+ [fun (symbol (str access fld))]}
`(def (,fun s (v #.(void)))
(assert (,is? s))
(if (void? v)
(aref s ,[+ (length named) i])
,(if (member :read-only opts)
- `(error (string "slot "
- ',fld
- " in struct "
- ',name
- " is :read-only"))
+ `(error (str "slot "
+ ',fld
+ " in struct "
+ ',name
+ " is :read-only"))
`(aset! s ,[+ (length named) i] v))))])
num-slots))))
@@ -1142,11 +1142,11 @@
(def (repl)
(def (prompt)
(*prompt*)
- (io-flush *output-stream*)
+ (io-flush *io-out*)
(let ((v (trycatch (read)
- (λ (e) (io-discardbuffer *input-stream*)
+ (λ (e) (io-discardbuffer *io-in*)
(raise e)))))
- (and (not (io-eof? *input-stream*))
+ (and (not (io-eof? *io-in*))
(let ((V (load-process v)))
(unless (void? V) (print V) (newline))
(void (set! that V))))))
@@ -1181,7 +1181,7 @@
e)
nil))))
(if p
- (string-join (map string (reverse! p)) "/")
+ (str-join (map str (reverse! p)) "/")
"λ")))
(let ((st (reverse! (if (length> st 3)
(list-tail st (if *interactive* 5 4))
@@ -1234,7 +1234,7 @@
(print (car e))
(princ ": ")
(let ((msg (cadr e)))
- ((if (or (string? msg) (symbol? msg))
+ ((if (or (str? msg) (symbol? msg))
princ
print)
msg)))
@@ -1267,10 +1267,10 @@
(and (bound? s)
(not (constant? s))
(or (not (builtin? (top-level-value s)))
- (not (equal? (string s) ; alias of builtin
- (string (top-level-value s)))))
+ (not (equal? (str s) ; alias of builtin
+ (str (top-level-value s)))))
(not (memq s excludes))
- (not (iostream? (top-level-value s)))))
+ (not (io? (top-level-value s)))))
(simple-sort (environment))))
(data (apply nconc (map list syms (map top-level-value syms)))))
(write data f)
@@ -1288,9 +1288,9 @@
(set! *directory-separator* (or (and (equal? *os-name* "dos") "\\") "/"))
(set! *linefeed* "\n")
(set! *exit-hooks* nil)
- (set! *output-stream* *stdout*)
- (set! *input-stream* *stdin*)
- (set! *error-stream* *stderr*))
+ (set! *io-out* *stdout*)
+ (set! *io-in* *stdin*)
+ (set! *io-err* *stderr*))
(def (__script fname)
(trycatch (load fname)
@@ -1307,7 +1307,7 @@
(rcpath (case *os-name*
(("plan9") "lib/slrc")(else ".slrc")))
- (fname (and home (string home *directory-separator* rcpath))))
+ (fname (and home (str home *directory-separator* rcpath))))
(when (and fname (path-exists? fname))
(load fname))))
--- a/src/timefuncs.h
+++ b/src/timefuncs.h
@@ -2,6 +2,6 @@
double sec_realtime(void);
u64int nanosec_monotonic(void);
-void timestring(double s, char *buf, int sz);
+void timestr(double s, char *buf, int sz);
double parsetime(const char *s);
void sleep_ms(int ms);
--- a/src/vm.h
+++ b/src/vm.h
@@ -597,8 +597,8 @@
sp[-1] = issymbol(sp[-1]) ? sl_t : sl_nil;
NEXT_OP;
-OP(OP_NUMBERP)
- sp[-1] = sl_isnumber(sp[-1]) ? sl_t : sl_nil;
+OP(OP_NUMP)
+ sp[-1] = sl_isnum(sp[-1]) ? sl_t : sl_nil;
NEXT_OP;
OP(OP_BRBOUND)
--- a/test/ast/asttools.lsp
+++ b/test/ast/asttools.lsp
@@ -1,7 +1,7 @@
; utilities for AST processing
(def (symconcat s1 s2)
- (symbol (string s1 s2)))
+ (symbol (str s1 s2)))
(def (list-adjoin item lst)
(if (member item lst)
--- a/test/ast/rpasses.lsp
+++ b/test/ast/rpasses.lsp
@@ -20,7 +20,7 @@
(let ((ctr 0))
(set! r-gensym (lambda ()
- (prog1 (symbol (string "%r:" ctr))
+ (prog1 (symbol (str "%r:" ctr))
(set! ctr (+ ctr 1))))))
(def (dollarsign-transform e)
@@ -28,7 +28,7 @@
(pattern-lambda ($ lhs name)
(let* ((g (if (not (cons? lhs)) lhs (r-gensym)))
(n (if (symbol? name)
- name ;(symbol->string name)
+ name ;(symbol->str name)
name))
(expr `(r-call
r-aref ,g (index-in-strlist ,n (r-call attr ,g "names")))))
--- a/test/number-boundaries.lsp
+++ b/test/number-boundaries.lsp
@@ -62,14 +62,14 @@
`(let* ((h (high-border ,smaller))
(L (low-border ,bigger))
(l (if (= L 0) 0 (low-border ,smaller))))
- (assert (and (integer? h) (integer? l) (number? h) (number? l)))
- (assert (and (number? (,smaller h)) (number? (,smaller l))))
- (assert (and (integer? (,smaller h)) (integer? (,smaller l))))
- (assert (and (integer? (,bigger h)) (integer? (,bigger l))))
- (assert (and (number? (,bigger h)) (number? (,bigger l))))
- (assert (and (integer-valued? h) (integer-valued? l)))
- (assert (and (integer-valued? (,smaller h)) (integer-valued? (,smaller l))))
- (assert (and (integer-valued? (,bigger h)) (integer-valued? (,bigger l))))
+ (assert (and (int? h) (int? l) (num? h) (num? l)))
+ (assert (and (num? (,smaller h)) (num? (,smaller l))))
+ (assert (and (int? (,smaller h)) (int? (,smaller l))))
+ (assert (and (int? (,bigger h)) (int? (,bigger l))))
+ (assert (and (num? (,bigger h)) (num? (,bigger l))))
+ (assert (and (int-valued? h) (int-valued? l)))
+ (assert (and (int-valued? (,smaller h)) (int-valued? (,smaller l))))
+ (assert (and (int-valued? (,bigger h)) (int-valued? (,bigger l))))
(assert (= h
(,smaller h) (,bigger h)
(,smaller (,bigger h)) (,bigger (,smaller h))))
--- a/test/test.lsp
+++ b/test/test.lsp
@@ -20,19 +20,19 @@
(def width (+ 4
(apply max
(map (λ (x)
- (length (string x)))
+ (length (str x)))
(cons 'Function
(map car pr))))))
- (princ (string-rpad "Function" width #\ )
+ (princ (str-rpad "Function" width #\ )
"#Calls Time (seconds)")
(newline)
- (princ (string-rpad "--------" width #\ )
+ (princ (str-rpad "--------" width #\ )
"------ --------------")
(newline)
(for-each
(λ (p)
- (princ (string-rpad (string (caddr p)) width #\ )
- (string-rpad (string (cadr p)) 11 #\ )
+ (princ (str-rpad (str (caddr p)) width #\ )
+ (str-rpad (str (cadr p)) 11 #\ )
(car p))
(newline))
(simple-sort (map (λ (l) (reverse (to-proper l)))
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -78,8 +78,8 @@
(assert (equal? (u64 (double -123)) #u64(0xffffffffffffff85)))
-(assert (equal? (string 'sym #byte(65) #rune(945) "blah") "symA\u03B1blah"))
-(assert (= (length (string #\x0)) 1))
+(assert (equal? (str 'sym #byte(65) #rune(945) "blah") "symA\u03B1blah"))
+(assert (= (length (str #\x0)) 1))
(assert (> 9223372036854775808 9223372036854775807))
@@ -287,7 +287,7 @@
(assert (gensym? (gensym)))
(assert (not (gensym? 'a)))
(assert (not (eq? (gensym) (gensym))))
-(assert (not (equal? (string (gensym)) (string (gensym)))))
+(assert (not (equal? (str (gensym)) (str (gensym)))))
(let ((gs (gensym))) (assert (eq? gs gs)))
(load "color.lsp")
@@ -362,20 +362,20 @@
(assert (not (equal? (hash (iota 41))
(hash (iota 42)))))
-(assert (let ((ts (time->string (time-now))))
- (eqv? ts (time->string (string->time ts)))))
+(assert (let ((ts (time->str (time-now))))
+ (eqv? ts (time->str (str->time ts)))))
(assert (equal? 0.0 (+ 0.0 0))) ; tests that + no longer does inexact->exact
(assert (equal? 1.0 (* 1.0 1))) ; tests that * no longer does inexact->exact
-(def (with-output-to-string nada thunk)
+(def (with-output-to-str nada thunk)
(let ((b (buffer)))
(with-output-to b (thunk))
- (iostream->string b)))
+ (io->str b)))
(let ((c #\a))
- (assert (equal? (with-output-to-string nil (λ () (print (list c c))))
+ (assert (equal? (with-output-to-str nil (λ () (print (list c c))))
"(#\\a #\\a)")))
(assert-fail (eval '(set! (car (cons 1 2)) 3)))
@@ -463,7 +463,7 @@
equal? 2 atom? 1
not 1 nan? 1
cons? 1 symbol? 1
- number? 1 bound? 1
+ num? 1 bound? 1
cons? 1 builtin? 1
vector? 1 fixnum? 1
cons 2 car 1
@@ -501,66 +501,66 @@
;; rune strings
(let* ((b (buffer))
(s "1э1ю1я") ; mixed ascii and non-ascii
- (es (string #\" s #\")))
- (write (string-decode s) b)
- (assert (equal? es (iostream->string b)))
+ (es (str #\" s #\")))
+ (write (str-decode s) b)
+ (assert (equal? es (io->str b)))
(io-close b))
(def s "привет\0пока")
(def s2 "hello \t \n world\n ")
-(assert (equal? s (string-encode (string-decode s))))
-(assert (equal? (string s "\0") (string-encode (string-decode s t))))
+(assert (equal? s (str-encode (str-decode s))))
+(assert (equal? (str s "\0") (str-encode (str-decode s t))))
(assert (eq? 21 (sizeof s)))
(assert (eq? 21 (length s)))
-(assert (eq? 11 (string-length s)))
-(assert (eq? 11 (string-length s 0)))
-(assert (eq? 10 (string-length s 2)))
-(assert (eq? 9 (string-length s 3)))
-(assert (eq? 0 (string-length s 21)))
-(assert-fail (string-length s -1))
-(assert-fail (string-length s 22))
-(assert (eq? 1 (string-length s 0 2)))
-(assert (eq? 2 (string-length s 0 4)))
-(assert (eq? 0 (string-length s 21 20)))
-(assert (eq? 0 (string-length s 21 21)))
-(assert-fail (string-length s 21 22))
+(assert (eq? 11 (str-length s)))
+(assert (eq? 11 (str-length s 0)))
+(assert (eq? 10 (str-length s 2)))
+(assert (eq? 9 (str-length s 3)))
+(assert (eq? 0 (str-length s 21)))
+(assert-fail (str-length s -1))
+(assert-fail (str-length s 22))
+(assert (eq? 1 (str-length s 0 2)))
+(assert (eq? 2 (str-length s 0 4)))
+(assert (eq? 0 (str-length s 21 20)))
+(assert (eq? 0 (str-length s 21 21)))
+(assert-fail (str-length s 21 22))
-(assert (equal? "акоп\0тевирп" (string-reverse s)))
-(assert (equal? "" (string-reverse "")))
-(assert (equal? "й" (string-reverse "й")))
-(assert (equal? "wб☺🡷⁹гq" (string-reverse "qг⁹🡷☺бw")))
+(assert (equal? "акоп\0тевирп" (str-reverse s)))
+(assert (equal? "" (str-reverse "")))
+(assert (equal? "й" (str-reverse "й")))
+(assert (equal? "wб☺🡷⁹гq" (str-reverse "qг⁹🡷☺бw")))
-(assert (string-utf8? ""))
-(assert (string-utf8? "wб☺🡷⁹гq"))
-(assert (not (string-utf8? "\xfffe")))
+(assert (str-utf8? ""))
+(assert (str-utf8? "wб☺🡷⁹гq"))
+(assert (not (str-utf8? "\xfffe")))
(let ((b (buffer)))
(write "a\x0a\x09\\\x07\x08\x1b\x0c\x0d\x0b" b)
- (assert (equal? (iostream->string b) "\"a\\n\\t\\\\\\a\\b\\e\\f\\r\\v\"")))
+ (assert (equal? (io->str b) "\"a\\n\\t\\\\\\a\\b\\e\\f\\r\\v\"")))
-(assert (= 10 (string-width s)))
-(assert (= 0 (string-width "")))
-(assert (= 1 (string-width #\q)))
-(assert (= 1 (string-width #\й)))
-(assert (= 0 (string-width #\nul)))
-(assert-fail (string-width 123))
-(assert-fail (string-width 'blah))
-(assert-fail (string-width string-width))
+(assert (= 10 (str-width s)))
+(assert (= 0 (str-width "")))
+(assert (= 1 (str-width #\q)))
+(assert (= 1 (str-width #\й)))
+(assert (= 0 (str-width #\nul)))
+(assert-fail (str-width 123))
+(assert-fail (str-width 'blah))
+(assert-fail (str-width str-width))
-(assert (equal? '("привет" "пока") (string-split s "\0")))-(assert (equal? '("пр" "вет" "пок" "") (string-split s "аи\0")))-(assert (equal? '("" "") (string-split "1" "1")))+(assert (equal? '("привет" "пока") (str-split s "\0")))+(assert (equal? '("пр" "вет" "пок" "") (str-split s "аи\0")))+(assert (equal? '("" "") (str-split "1" "1")))-(assert (equal? '("hello" "world") (string-split s2 :trim T)))-(assert (equal? '("hello" "\t" "\n" "world\n") (string-split s2 " " :trim T)))-(assert (equal? (list s2) (string-split s2 "X" :trim T)))
-(assert (equal? (list s2) (string-split s2 "X")))
+(assert (equal? '("hello" "world") (str-split s2 :trim T)))+(assert (equal? '("hello" "\t" "\n" "world\n") (str-split s2 " " :trim T)))+(assert (equal? (list s2) (str-split s2 "X" :trim T)))
+(assert (equal? (list s2) (str-split s2 "X")))
-(assert (equal? #\а (string-char s 10)))
-(assert (equal? #\nul (string-char s 6)))
-(assert-fail (string-char s 11))
+(assert (equal? #\а (str-char s 10)))
+(assert (equal? #\nul (str-char s 6)))
+(assert-fail (str-char s 11))
(assert (equal? #\W (char-upcase #\w)))
(assert (equal? #\П (char-upcase #\п)))
@@ -607,35 +607,35 @@
(assert (char-title-case? #\Dž))
(def s "hello й goodbye")
-(assert (= 6 (string-find s #\й)))
-(assert (= 6 (string-find s #\й 6)))
-(assert-fail (string-find s #\o -1))
-(assert (not (string-find s #\o 16)))
-(assert-fail (string-find s #\o 17))
-(assert (= 4 (string-find s #\o)))
-(assert (= 10 (string-find s #\o 5)))
-(assert (= 11 (string-find s #\o 11)))
-(assert (not (string-find s #\o 12)))
-(assert (= 4 (string-find s (byte #\o))))
-(assert (= 4 (string-find s "o")))
-(assert (= 2 (string-find s "ll")))
-(assert (not (string-find s "ll" 3)))
-(assert (= 0 (string-find s "")))
-(assert (= 7 (string-find s "" 7)))
-(assert-fail (string-find s 0))
+(assert (= 6 (str-find s #\й)))
+(assert (= 6 (str-find s #\й 6)))
+(assert-fail (str-find s #\o -1))
+(assert (not (str-find s #\o 16)))
+(assert-fail (str-find s #\o 17))
+(assert (= 4 (str-find s #\o)))
+(assert (= 10 (str-find s #\o 5)))
+(assert (= 11 (str-find s #\o 11)))
+(assert (not (str-find s #\o 12)))
+(assert (= 4 (str-find s (byte #\o))))
+(assert (= 4 (str-find s "o")))
+(assert (= 2 (str-find s "ll")))
+(assert (not (str-find s "ll" 3)))
+(assert (= 0 (str-find s "")))
+(assert (= 7 (str-find s "" 7)))
+(assert-fail (str-find s 0))
-(assert (equal? "1.5" (number->string 1.5)))
-(assert (equal? "-3039" (number->string (s16 -12345) 16)))
-(assert (equal? "111111111111111111111111111111111" (number->string 111111111111111111111111111111111)))
-(assert (equal? "fffffffffffffffffffffffffffffffff" (number->string 0xfffffffffffffffffffffffffffffffff 16)))
+(assert (equal? "1.5" (num->str 1.5)))
+(assert (equal? "-3039" (num->str (s16 -12345) 16)))
+(assert (equal? "111111111111111111111111111111111" (num->str 111111111111111111111111111111111)))
+(assert (equal? "fffffffffffffffffffffffffffffffff" (num->str 0xfffffffffffffffffffffffffffffffff 16)))
-(assert-fail (number->string 1.5 16))
-(assert-fail (number->string (bignum 0) 36))
+(assert-fail (num->str 1.5 16))
+(assert-fail (num->str (bignum 0) 36))
-(assert (= 1.5 (string->number "1.5")))
-(assert (= -12345 (string->number "-3039" 16)))
-(assert (= 111111111111111111111111111111111 (string->number "111111111111111111111111111111111")))
-(assert (= 0xfffffffffffffffffffffffffffffffff (string->number "fffffffffffffffffffffffffffffffff" 16)))
+(assert (= 1.5 (str->num "1.5")))
+(assert (= -12345 (str->num "-3039" 16)))
+(assert (= 111111111111111111111111111111111 (str->num "111111111111111111111111111111111")))
+(assert (= 0xfffffffffffffffffffffffffffffffff (str->num "fffffffffffffffffffffffffffffffff" 16)))
(assert (= (length (byte #\f)) 1))
(assert (= (length #\я) 2))
@@ -650,20 +650,20 @@
(assert-fail (symbol 'blah))
(assert-fail (exit 1 2))
-(assert (integer-valued? 1.0))
-(assert (integer-valued? -1.0))
-(assert (integer-valued? 1.0f))
-(assert (integer-valued? -1.0f))
-(assert (integer-valued? (bignum 0)))
+(assert (int-valued? 1.0))
+(assert (int-valued? -1.0))
+(assert (int-valued? 1.0f))
+(assert (int-valued? -1.0f))
+(assert (int-valued? (bignum 0)))
-(assert (number? 1.3))
-(assert (number? -1.3))
-(assert (number? 1.3f))
-(assert (number? -1.3f))
-(assert (not (number? #\я)))
+(assert (num? 1.3))
+(assert (num? -1.3))
+(assert (num? 1.3f))
+(assert (num? -1.3f))
+(assert (not (num? #\я)))
-(assert (integer? 0))
-(assert (integer? (bignum 0)))
+(assert (int? 0))
+(assert (int? (bignum 0)))
(assert (= 12345 (fixnum (bignum 12345))))
(assert (= -12345 (fixnum (bignum -12345))))
@@ -720,7 +720,7 @@
(def ta (table 1 2 "3" 4 'foo 'bar))
(let ((b (buffer)))
(write ta b)
- (assert (equal? (iostream->string b) "#table(1 2 \"3\" 4 foo bar)")))
+ (assert (equal? (io->str b) "#table(1 2 \"3\" 4 foo bar)")))
(assert (table? ta))
(assert (not (table? "nope")))
(assert-fail (get ta 3))
--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -43,7 +43,7 @@
OP_NEG neg nil nil nil
OP_NANP nan? 1 (λ (x) (nan? x)) nil
OP_BRBOUND brbound nil nil nil
- OP_NUMBERP number? 1 (λ (x) (number? x)) nil
+ OP_NUMP num? 1 (λ (x) (num? x)) nil
OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) nil
OP_BOUNDP bound? 1 (λ (x) (bound? x)) nil
OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) nil
@@ -59,10 +59,10 @@
OP_LIST list ANYARGS (λ rest rest) nil
OP_APPLY apply -2 (λ rest (apply apply rest)) nil
OP_ADD + ANYARGS (λ rest (apply + rest)) (
- ((number…) "Return sum of the numbers or 0 with no arguments."))
+ ((num…) "Return sum of the numbers or 0 with no arguments."))
OP_SUB - -1 (λ rest (apply - rest)) nil
OP_MUL * ANYARGS (λ rest (apply * rest)) (
- ((number…) "Return product of the numbers or 1 with no arguments."))
+ ((num…) "Return product of the numbers or 1 with no arguments."))
OP_DIV / -1 (λ rest (apply / rest)) nil
OP_IDIV div0 2 (λ rest (apply div0 rest)) nil
OP_NUMEQ = -1 (λ rest (apply = rest)) nil
@@ -129,7 +129,7 @@
(put! e lop (byte i))
(when argc
(put! cl cop (list lop argc))
- (when (and (number? argc) (>= argc 0))
+ (when (and (num? argc) (>= argc 0))
(put! ac lop argc)))
(set! lms (cons f lms))
(set! i (1+ i))))