ref: 1712b18a90b80757dbc96850744aa4c0c14fcfd1
parent: 39517070479e7453b62fb8aeb2cb52e869b33fbb
author: spew <spew@cbza.org>
date: Tue Apr 22 18:32:56 EDT 2025
implement subseq, replace list head and tail calls Fixes: https://todo.sr.ht/~ft/sl/29
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -51,17 +51,17 @@
ltin)) cons? ((:doc-group . builtin)) doc-group ((:doc-group . doc)) aref ((:doc-group . builtin)) *properties* ((:doc-group . prop)) vec ((:doc-group . builtin)) >= ((:doc-group . compare)) sym? ((:doc-group . builtin)) zero? ((:doc-group . compare)) length= ((:doc-group . list)) positive? ((:doc-group . compare)) doc-for ((:doc-group . doc)) aset! ((:doc-group . builtin)) T ((:doc-see)) car ((:doc-group . list)
(:doc-group . builtin)) *builtins* ((:doc-group . builtin)) str ((:doc-group . string)) cons ((:doc-group . list)
(:doc-group . builtin)) - ((:doc-group . builtin)) remprop ((:doc-group . prop)) <= ((:doc-group . compare)) rand ((:doc-group . rand)) negative? ((:doc-group . compare)) Instructions ((:doc-group . builtin)) file ((:doc-group . io)) rand-double ((:doc-group . rand)) cdr ((:doc-group . list)
-ist)
- (:doc-group . builtin)) *builtins* ((:doc-group . builtin)) str ((:doc-group . string)) cons ((:doc-group . list)
- (:doc-group . builtin)) - ((:doc-group . builtin)) remprop ((:doc-group . prop)) <= ((:doc-group . compare)) rand ((:doc-group . rand)) negative? ((:doc-group . compare)) Instructions ((:doc-group . builtin)) file ((:doc-group . io)) rand-double ((:doc-group . rand)) cdr ((:doc-group . list)
- (:doc-group . builtin)) atom? ((:doc-group . builtin)) vec? ((:doc-group . builtin)) / ((:doc-group . builtin)) equal? ((:doc-group . compare)
+ist)
+ (:doc-group . builtin)) *builtins* ((:doc-group . builtin)) str ((:doc-group . string)) cons ((:doc-group . list)
+ (:doc-group . builtin)) - ((:doc-group . builtin)) remprop ((:doc-group . prop)) <= ((:doc-group . compare)) rand ((:doc-group . rand)) negative? ((:doc-group . compare)) Instructions ((:doc-group . builtin)) file ((:doc-group . io)) rand-double ((:doc-group . rand)) cdr ((:doc-group . list)
+ (:doc-group . builtin)) atom? ((:doc-group . builtin)) vec? ((:doc-group . builtin)) / ((:doc-group . builtin)) equal? ((:doc-group . compare)
-group . compare)
-ltin)) help ((:doc-group . doc)) rand-u32 ((:doc-group . rand)) = ((:doc-group . compare)
- (:doc-group . builtin)) rand-u64 ((:doc-group . rand)) not ((:doc-group . builtin)) separate-doc-from-body ((:doc-group . doc)) set-cdr! ((:doc-group . list)
- (:doc-group . builtin)) fn? ((:doc-group . builtin)) help-print-header ((:doc-group . doc)) lz-pack ((:doc-group . compress)) arg-counts ((:doc-group . builtin)) eq? ((:doc-group . compare)
- (:doc-group . builtin)) getprop ((:doc-group . prop) (:doc-see . putprop)) vm-stats ((:doc-group . vm)) * ((:doc-group . builtin)) putprop ((:doc-group . prop)
- (:doc-see . getprop)) io->str ((:doc-group . io))))
- *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("z10B86;35040<;J404086;35040=70211225251<863I0232487e22489e22488e2e4:232487e22489e2e3:" #(separate-doc-from-body+roup . builtin)) help ((:doc-group . doc)) rand-u32 ((:doc-group . rand)) = ((:doc-group . compare)
+ (:doc-group . builtin)) rand-u64 ((:doc-group . rand)) not ((:doc-group . builtin)) separate-doc-from-body ((:doc-group . doc)) set-cdr! ((:doc-group . list)
+ (:doc-group . builtin)) fn? ((:doc-group . builtin)) help-print-header ((:doc-group . doc)) lz-pack ((:doc-group . compress)) arg-counts ((:doc-group . builtin)) eq? ((:doc-group . compare)
+ (:doc-group . builtin)) getprop ((:doc-group . prop) (:doc-see . putprop)) vm-stats ((:doc-group . vm)) * ((:doc-group . builtin)) putprop ((:doc-group . prop)
+ (:doc-see . getprop)) io->str ((:doc-group . io))))
+ *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("z10B86;35040<;J404086;35040=70211225251<863I0232487e22489e22488e2e4:232487e22489e2e3:" #(separate-doc-from-body58551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:272:85<e2e1282:7585512:e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else
begin or => 1arg-lambda? caddr caadr let if cddr #:g19) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map) car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g415 λ if #fn(nconc) begin #fn(copy-list))) assert-fail #fn("z12021220qe32324e113E0252624e2271<e2e3@30De3e3e2:" #(assert@@ -70,10 +70,10 @@
e2:" #(assert
trycatch begin λ e eq? car quote)) bcode:code #fn("n1200Ee3:" #(aref)) let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc) λ #fn(map) #fn("n10B3500<:0:") #fn(copy-list) #fn("n10B3500T:7060:" #(void)) letrec)) with-bindings #fn("z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)-rec)) with-bindings #fn("z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)- car cadr #fn("n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list)- #fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!)))) %defstruct% #fn("O10005000*///z6W1000J7021?14W2000;J60D?24W3000;J60D?34W4000;J60D?44W5000;J60D?54II22230>1??5142224?@514258651262786528@8651268?8652121C60D@C0128C60q@90792:1528E3B082;J904792;51@;082;35048;;36040e185DQ;3:042<02=52;J504858G;3L048F3708G@A08>3;0792>51@30q8E3:02?0e2@7002@e283DQ83;3\\0483H;3M0483DQ;3:042<2A052;J504838CP;J5048384DQ;3:042B02C52;J50484I222D8E108B8F>5?M5142E2Fe18H3{02G8H2He28E3E02I2J2He22K8Ie2e3@V02L2M2N2HEe32K0e2e32O2P2He27Q8A51e3e3e3@30qe18K3C02G8K<8M8K=51e3@30qe18E3U02R2K0e22K2Se28J3808K<@808M8C51e4@30qe12T7U2V8D8B8L8E8H8I8F0>88A525165:" #(#(:constructor- 2 :predicate 4 NIL NIL :type 0 :named 1 :conc-name 3 NIL NIL) vec #0#
+) letrec)) with-bindings #fn("z12071052207205220230522425e12076888653e17720288687535129242:e17715152242:e177202;8688535152e3e164:" #(#fn(map)+ car cadr #fn("n12060:" #(#fn(gensym))) #fn(nconc) let list copy-list #fn("n22001e3:" #(set!))+ unwind-protect begin #fn("n22001e3:" #(set!)))) %defstruct% #fn("O10005000*///z6W1000J7021?14W2000;J60D?24W3000;J60D?34W4000;J60D?44W5000;J60D?54II22230>1??5142224?@514258651262786528@8651268?8652121C60D@C0128C60q@90792:1528E3B082;J904792;51@;082;35048;;36040e185DQ;3:042<02=52;J504858G;3L048F3708G@A08>3;0792>51@30q8E3:02?0e2@7002@e283DQ83;3\\0483H;3M0483DQ;3:042<2A052;J504838CP;J5048384DQ;3:042B02C52;J50484I222D8E108B8F>5?M5142E2Fe18H3{02G8H2He28E3E02I2J2He22K8Ie2e3@V02L2M2N2HEe32K0e2e32O2P2He27Q8A51e3e3e3@30qe18K3C02G8K<8M8K=51e3@30qe18E3U02R2K0e22K2Se28J3808K<@808M8C51e4@30qe17T7U2V8D8B8L8E8H8I8F0>88A525165:" #(#(:constructor+ 2 :predicate 4 NIL NIL :type 0 :named 1 :conc-name 3 NIL NIL) vec #0#
92>51@30q8E3:02?0e2@7002@e283DQ83;3\\0483H;3M0483DQ;3:042<2A052;J504838CP;J5048384DQ;3:042B02C52;J50484I222D8E108B8F>5?M5142E2Fe18H3{02G8H2He28E3E02I2J2He22K8Ie2e3@V02L2M2N2HEe32K0e2e32O2P2He27Q8A51e3e3e3@30qe18K3C02G8K<8M8K=51e3@30qe18E3U02R2K0e22K2Se28J3808K<@808M8C51e4@30qe12T7U2V8D8B8L8E8H8I8F0>88A525165:" #(#(:constructor2 :predicate 4 NIL NIL :type 0 :named 1 :conc-name 3 NIL NIL) vec #0#
#fn("n10H370q:@30q4207172051f22324850A>38652486:" #((:read-only) assoc-list cddr #fn(for-each)@@ -91,24 +91,23 @@
ef
#fn(sym) def s v v-supplied? unless type-error quote if not aref assv :read-only error str "slot "
" in struct " " is :read-only" aset!)))) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) mark-label #fn("n22002122e21e4:" #(emit-#fn("n1700E62:" #(bq-process)) > #fn("z12021e1721510e163:" #(#fn(nconc)+#fn("n1700E62:" #(bq-process)) > #fn("z12021e1721510e163:" #(#fn(nconc)241;3<0422231520P13;02410e3@3007588265275882752IIIIIb;b<288;29_514288<2:_514282;?=514282<87>1?>514282=??51402>CM02?2@8<>18?2A7B26528=5252@$089;J5048:3\xe3082888:2C154475882D527E2F8@527E2G8@52893H07H7I2J898A535147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
-5147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
- 0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
- #fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each)- #fn("n17050471A51472F0P61:" #(newline princ print))- newline princ print) print-sig)
- #fn("n12002152853;0220E8563:0:" #(#fn(str-find) "\n" #fn(str-sub)) first-line)+5147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
+ 0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
+ #fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each)+ #fn("n17050471A51472F0P61:" #(newline princ print))+ newline princ print) print-sig)
#fn("n3A051370082P:82:") <) table-keys-filter-sort) groups #fn(for-each) #fn("n1707105122A<7302452515347560:" #(princ caddr ": " getprop *doc* newline)) #fn(get) *properties* :kind *doc-extra* filter #fn("n10<20Q:" #(:doc-fmt)) #fn("n10<20Q:" #(:doc-see)) princ foldl #fn("n20=161:") newline "See also:" #fn("n1A<0=700=21522263:" #(getprop-
+formals-list* " ")) void
H0738824862589Pe15252@30q42627e188e128875163:" #(separate-doc-from-body
-0E8553@300853<02208552@402324752627AF5351285229862:7;882<528764:" #(#fn(str-find)
- "\n\n" #fn(str-sub) "" #fn(str-split) print-to-str #fn(list*) defstruct "\n" #fn(str) "\n\n "
- str-join "\n ") fmt) sym-set-doc #fn(append) :doc-fmt #fn(nconc) %defstruct% #fn(copy-list))) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)+ #0# #fn("n12002152853=0220E8553@300853<02208552@402324752627AF5351285229862:7;882<528764:" #(#fn(str-find)+ "\n\n" #fn(str-sub) "" #fn(str-split) print-to-str #fn(list*) defstruct "\n" #fn(str) "\n\n "
+ str-join "\n ") fmt) sym-set-doc #fn(append) :doc-fmt #fn(nconc) %defstruct% copy-list)) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e17315163:" #(#fn(nconc) -bindings *io-out* #fn(copy-list))) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch λ #:g438 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)@@ -141,7 +140,8 @@
;857<865387;3D042=8751;39047>8761:" #(*os-name*
"unknown" "plan9" "home" "macos" princ "\e]0;StreetLISP v0.999\a" "HOME" #fn(os-getenv) "lib/slrc"
".slrc" #fn(str) *directory-separator* #fn(path-exists?) load) __rcscript)
-0>121{:" #(#fn("n070A61:" #(load))+0>121{:" #(#fn("n070A61:" #(load))+ #fn("n1700514212205161:" #(top-level-exception-handlervel-exception-handler
#fn(exit)
#fn(str)))) __script)
@@ -179,8 +179,8 @@
"n10<T:" #() cadar) caddar #fn("n10<=T:" #() caddar) cadddr #fn("n10==T:" #() cadddr) caddr #4=#fn("n10=T:" #() caddr) call-with-values #fn("n205086B3@0A86<C90186=}2:18661:" #() #(#3=(*values*))) capture-var! #fn("n20r3G70186E5387;JG042186510r322861e152p4:" #(index-of-0r322861e152p4:" #(index-of
- #fn(length) #fn(nconc)) capture-var!)
+0r322861e152p4:" #(index-of
+ #fn(length) #fn(nconc)) capture-var!)
fn("n10=T=:" #() cdaddr) cdadr #fn("n10T=:" #() cdadr) cdar #fn("n10<=:" #() cdar) cddaar #fn("n10<<==:" #() cddaar) cddadr #fn("n10T==:" #() cddadr) cddar@@ -234,6 +234,8 @@
540r40r4GKMp486360q@9072023524720858;5340r40r4Gr/Mp486360q@907202452475018283=84858657486340q:720268;63:" #(compile-in
#fn(gensym) emit dup pop compile-short-circuit label) compile-short-circuit)
compile-sym #fn("n470821E538821C`02282513M073248251513@07502624825163:750278263:88<El23W0750287988=51534833A088=T3:07502:62:q:7502;7<08252534833A088=T3:07502:62:q:" #(lookup-sym+251513@07502624825163:750278263:88<El23W0750287988=51534833A088=T3:07502:62:q:7502;7<08252534833A088=T3:07502:62:q:" #(lookup-sym
+ global #fn(const?) printable? #fn(top-level-value) emit loadv loadg loada vinfo:index car loadc
251513@07502624825163:750278263:88<El23W0750287988=51534833A088=T3:07502:62:q:7502;7<08252534833A088=T3:07502:62:q:" #(lookup-sym
global #fn(const?) printable? #fn(top-level-value) emit loadv loadg loada vinfo:index car loadc
capture-var!) compile-sym)
@@ -248,8 +250,8 @@
("n1700AqF929366:" #(complex-bindings-))) complex-bindings-) const-to-idx-vec #fn("n1200r2G51212285>10KG52485:" #(#fn(vec-alloc)#fn(for-each)
-for-each)
- #fn("n2A10p:")) const-to-idx-vec)+" #(#0#
+ #fn("n382;3?0482El2;3504I:41360q@40I:41<qP087N4A<871=82;390470825163:" #(1-) copy-) 1-) copy-list) #fn("n31J5082:A<01=01<5139082KM@408263:" #() count-)) count) delete-duplicates #fn("n1700rD523O02150Ib686228586>2_486<^10q62:0H3400:0<0=73858652390748661:85748651P:" #(length> #fn(table) #fn("n20H38070161:21A0<523:0F<0=162:22A0<D534F<0=0<1P62:" #(reverse! #fn(has?)@@ -263,17 +265,17 @@
oadc.l)) loada (0) loada0 (1) loada1 loadc loadc0 loadc1 brn not brnn eq? brne nreconc) emit)
emit-optional-arg-inits #fn("n582B3\xa60205071022845347382513<07102452@30q4710258953476077178838452q53q7982515447102:845347102;5247102<895347=0182=8384KM65:q:" #(#fn(gensym)emit bounda cddar dup brnn compile-in extend-env list-head cadar seta pop label
-q:" #(#fn(gensym)
- emit bounda cddar dup brnn compile-in extend-env list-head cadar seta pop label
+65:q:" #(#fn(gensym)
+ emit bounda cddar dup brnn compile-in extend-env subseq cadar seta pop label
r2ki2M2452255025502650qqEI8>87L23\xbc14868>G?<48<27CP02889868>KMG298;515348>r2M?>@\x8b12:8;2;7<883k08<8C2=C702>@X08C2?C702@@L08C2AC702B@@08C2CC702D@408<^1@408<525248>KM?>48>87L2;3804868>G?=42E8<2F523`0288:298;518=5342:8;883707G@407HE515248>KM?>@\xeb08<2ICH02:8;2J8=515248>KM?>@\xce08=X3\xc708<2E8?2K523H02:8;2J8=515248>KM?>@\x9f02E8?2L523\x8102:8;2J8=515248>KM?>42:8;2J868>G515248>KM?>48<2MCK02:8;2J868>G515248>KM?>@30q@E02:8;2N8=515248>KM?>^1@30q@\x9f.42O2P8;8889>38:5242Q8;61:" #(reverse!
list->vec #fn(length) >= 65536 #fn(table) #fn(buffer) label #fn(put!)
#fn(sizeof) #fn(io-write) #fn(get) Instructions jmp jmp.l brne brne.l brnn brnn.l brn brn.l #fn(memq)
(jmp brne brnn brn) s32 s16 bounda #fn(s32) (loadv.l loadg.l setg.l loada.l seta.l argc.l vargc.l
call.l tcall.l loadc.l box.l) (optargs keyargs)
-) label #fn(put!)
+uffer) label #fn(put!)
.l loadg.l setg.l loada.l seta.l argc.l vargc.l
call.l tcall.l loadc.l box.l) (optargs keyargs)
-72@407324921520~5162:" #(#fn(io-seek)
+ch) #fn("n220A052421AF37072@407324921520~5162:" #(#fn(io-seek)#fn(io-write) s32 s16
#fn(get)))
#fn(io->str)) encode-byte-code)
@@ -322,12 +324,12 @@
#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-int-K021220512386K24865153^161:0:" #(#fn(keyword?)
- #fn(sym)
- #fn(str)
- #fn(str-sub)
- #fn(str-length)) keyword->sym)
- keyword-arg? #fn("n10B;3904200<61:" #(#fn(keyword?)) keyword-arg?) lambda-vars+K021220512386K24865153^161:0:" #(#fn(keyword?)
+ #fn(sym)
+ #fn(str)
+ #fn(str-sub)
+ #fn(str-length)) keyword->sym)
+ keyword-arg? #fn("n10B;3904200<61:" #(#fn(keyword?)) keyword-arg?) lambda-vars"n40S;J5040R340D:0B3Z00<R3T082;J504833<0702112263:A<0=1828364:0B3\xa500<B3\x9f073051R3Y0740<r252;JF04740<r352;390475051R360q@=070260<2715442873051513=0A<0=182D64:833<0702112963:A<0=1D8364:0B3>0702:0<27164:01C:07021162:702:027164:" #(compile-error
"invalid argument list " ": optional arguments must come after required" caar length= caddar "invalid optional argument "
" in list " #fn(keyword?) ": keyword arguments must come last."
@@ -477,8 +479,13 @@
10B;3X040<20Q;JN040<21Q;JD040<22Q;3:04730r252;J704022Q:" #(unquote-splicing
unquote-nsplicing unquote length>) splice-form?)
str-join #fn("n20J5020:215022860<5242324861>20=524258661:" #("" #fn(buffer)+ #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/^14258661:" #(#fn(buffer)#fn(for-each)
- str-lpad #fn("n3207182122051~52062:" #(#fn(str) str-rep #fn(str-length)) str-lpad)+ail #fn("n2200162:" #(#fn(str-sub)) str-tail) str-trim str-map #fn("n2205021151EI8887L23O0422860231885251524748851?8@\f/^14258661:" #(#fn(buffer)#fn(str-length) #fn(io-putrune) #fn(str-rune) 1+ #fn(io->str)) str-map)
str-rep #fn("n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=@@ -502,7 +509,7 @@
A<0=51P:" #(length> list-head) formals-clean)
#fn(str?) #fn(map) str-join #fn(str-split) "\n" any #fn("n1E20051L2;3B04210E5222Q;34040:" #(#fn(str-length) #fn(str-rune) #\space)) #fn(length) str-trim " " "" #fn("n170A2105152390220A62:0:" #(<= #fn(length)-(str-sub)))
+(str-sub)))
))
#fn(append) void) sym-set-doc)
table-clone #fn("n12050212285>1q053485:" #(#fn(table)--- a/src/compiler.sl
+++ b/src/compiler.sl
@@ -217,8 +217,8 @@
(cond ((= nref 1)
(compile-app g env NIL (cons 'aset! args)))
((> nref 1)
- (compile-app g env NIL (cons 'aref (list-head args nref)))
- (let ((nargs (compile-arglist g env (list-tail args nref))))
+ (compile-app g env NIL (cons 'aref (subseq args 0 nref)))
+ (let ((nargs (compile-arglist g env (subseq args nref))))
(bcode:stack g (- nargs))
(emit g 'aset!)))
(else (argc-error 'aset! 3)))))
@@ -576,7 +576,7 @@
(when (cddar opta)
(emit g 'dup))
(emit g 'brnn nxt)
- (compile-in g (extend-env env (list-head vars i) NIL) NIL (cadar opta))
+ (compile-in g (extend-env env (subseq vars 0 i) NIL) NIL (cadar opta))
(emit g 'seta i)
(emit g 'pop)
(mark-label g nxt)
--- a/src/sl.c
+++ b/src/sl.c
@@ -1063,12 +1063,6 @@
bthrow(type_error(nil, "fn", v));
}
-BUILTIN("copy-list", copy_list)-{- argcount(nargs, 1);
- return copy_list(args[0]);
-}
-
BUILTIN("append", append) {sl_v first = sl_nil, lst, lastcons = sl_nil;
--- a/src/system.sl
+++ b/src/system.sl
@@ -165,7 +165,7 @@
(let ((f (car fs)))
(cons (if (and (cons? f)
(length> f 2))
- (list-head f 2)
+ (subseq f 0 2)
f)
(formals-clean (cdr fs)))))
(let* {[doc-only (str? doc-seq)]@@ -490,11 +490,6 @@
lst
(list-tail (cdr lst) (- n 1))))
-(def (list-head lst n)
- (and (> n 0)
- (cons (car lst)
- (list-head (cdr lst) (- n 1)))))
-
(def (list-ref lst n)
(car (list-tail lst n)))
@@ -513,11 +508,43 @@
(else (= (length seq) n))))
(def (length> seq n)
- (cond ((< n 0) seq)
+ (cond ((< n 0) T)
((= n 0) (and (cons? seq) seq))
((cons? seq) (length> (cdr seq) (- n 1)))
- (else (= (length seq) n))))
+ (else (> (length seq) n))))
+(def (copy-list seq (n NIL))
+ (def (copy- tail seq n)
+ (and n (= n 0) (return))
+ (unless seq (return))
+ (let {[next (cons (car seq) NIL)]}+ (set-cdr! tail next)
+ (copy- next (cdr seq) (and n (1- n)))))
+ (and (if n (> n 0) T)
+ seq
+ (let {[head (cons (car seq) NIL)]}+ (copy- head (cdr seq) (and n (1- n)))
+ head)))
+
+(def (subseq seq start (end NIL))
+ (unless (length> seq (1- start)) (bounds-error "start" start))
+ (unless (<= start end) (bounds-error "start <= end" (list start end)))
+ (and end (not (length> seq (1- end))) (bounds-error "end" end))
+ (def (subseq-l seq n)
+ (if (= n 0)
+ (copy-list seq (and end (- end start)))
+ (subseq-l (cdr seq) (1- n))))
+ (def (subseq-av alloc)
+ (let* {[end (or end (length seq))]+ [av (alloc (- end start))]}
+ (for start (1- end)
+ (λ (i) (aset! av (- i start) (aref seq i))))
+ av))
+ (cond ((list? seq) (subseq-l seq start))
+ ((vec? seq) (subseq-av vec-alloc))
+ ((arr? seq) (let {[atype (cadr (type-of seq))]}+ (subseq-av (λ (n) (arr-alloc atype n 0)))))))
+
(def (last-pair l)
(if (atom? (cdr l))
l
@@ -638,8 +665,7 @@
(if (or (not lst) (p (key (car lst))))
(car lst)
(find-if- (cdr lst))))
- (set! lst (list-tail lst start))
- (when end (set! lst (list-head lst (- end start))))
+ (set! lst (subseq lst start end))
(when from-end (set! lst (reverse! lst)))
(find-if- lst))
@@ -859,6 +885,9 @@
(def (type-error . args)
(raise (cons 'type-error args)))
+
+(def (bounds-error . args)
+ (raise (cons 'bounds-error args)))
(defmacro (throw tag value)
`(raise (list 'thrown-value ,tag ,value)))
--- a/test/unittest.sl
+++ b/test/unittest.sl
@@ -427,6 +427,35 @@
(assert (equal? (map (λ (x y) (+ x y)) '(1 2) '(3)) '(4)))
(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2) '(3) '(4 5)) '(8)))
+;; list copying
+(assert (equal? (copy-list (iota 50)) (iota 50)))
+(assert (equal? (copy-list (iota 50) 25) (iota 25)))
+(let* {[l (iota 10)]+ [c (copy-list l)]}
+ (aset! l 3 5)
+ (aset! c 4 23)
+ (assert (= (aref l 3) 5))
+ (assert (= (aref c 3) 3))
+ (assert (= (aref l 4) 4))
+ (assert (= (aref c 4) 23)))
+
+(assert (equal? (subseq (iota 20) 10) '(10 11 12 13 14 15 16 17 18 19)))
+(assert (equal? (subseq (iota 20) 10 15) '(10 11 12 13 14)))
+(assert (equal? (subseq (apply vec (iota 20)) 10) (vec 10 11 12 13 14 15 16 17 18 19)))
+(assert (equal? (subseq (apply vec (iota 20)) 10 15) (vec 10 11 12 13 14)))
+(assert (equal? (subseq (apply arr (cons 'u32 (iota 20))) 10) (arr 'u32 10 11 12 13 14 15 16 17 18 19)))
+(assert (equal? (subseq (apply arr (cons 'u32 (iota 20))) 10 15) (arr 'u32 10 11 12 13 14)))
+(assert-fail (subseq (iota 10) 11))
+(assert-fail (subseq (iota 10) 5 11))
+(assert-fail (subseq (iota 10) 6 5))
+(assert-fail (subseq (apply vec (iota 10)) 11))
+(assert-fail (subseq (apply vec (iota 10)) 5 11))
+(assert-fail (subseq (apply vec (iota 10)) 6 5))
+(assert (not (subseq (iota 10) 10)))
+(assert (not (subseq NIL 0)))
+(assert (equal? (subseq (apply vec (iota 10)) 10) (vec)))
+(assert (equal? (subseq (vec) 0) (vec)))
+
;; map with different return types
(assert (equal? (map 'vec + '(1 2 3) '(4 5 6) '(7 8 9)) (vec 12 15 18)))
(assert (equal? (map '(arr s32) + '(1 2 3) '(4 5 6) '(7 8 9)) (arr 's32 12 15 18)))