shithub: sl

Download patch

ref: cc921b1f729e89c07aaaff880aaaf9b238d9eedb
parent: 4a1245bdde29a4664d70a1a3976178a4e8f51ef8
author: spew <spew@cbza.org>
date: Wed Apr 23 13:42:16 EDT 2025 

implement append in lisp


--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -50,14 +50,14 @@
 -group . builtin))  buffer ((:doc-group . io))  num? ((:doc-group . builtin))  rand-float ((:doc-group . rand))  builtin? ((:doc-group . builtin))  set-car! ((:doc-group . list)
   (:doc-group . builtin))  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)
-ltin))  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)
+ltin))  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))  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)
-doc-group . builtin))  vec? ((:doc-group . builtin))  / ((:doc-group . builtin))  equal? ((:doc-group . compare)
+? ((:doc-group . builtin))  vec? ((:doc-group . builtin))  / ((:doc-group . builtin))  equal? ((:doc-group . compare)
 ? ((:doc-group . compare) (:doc-group . builtin))  io? ((:doc-group . io))  eof-object? ((:doc-group . io))  list ((:doc-group . builtin))  apply ((:doc-group . 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)
-list)
+up . list)
 p . 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))))
@@ -95,12 +95,12 @@
 nless type-error quote if not aref assv :read-only error str "slot "
   " in struct " " is :read-only" aset!) 21)) 33)  make-label #fn("n120e1:" #(gensym) 5)  bcode:cenv #fn("n1200r3e3:" #(aref) 7)  mark-label #fn("n22002122e21e4:" #(emit
   quote label) 8)  quasiquote #fn("n1700E62:" #(bq-process) 7)  > #fn("z12021e1721510e163:" #(#fn(nconc)
-) 7)  > #fn("z12021e1721510e163:" #(#fn(nconc)
+) 7)  > #fn("z12021e1721510e163:" #(#fn(nconc)
 07588265275882752IIIIIb;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#
-K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
+K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
 m) ":doc-" doc getprop *doc* *formals-list* #0#
-                         #fn("n17050471A51472F0P61:" #(newline princ print) 7)
+                              #fn("n17050471A51472F0P61:" #(newline princ print) 7)
 0E8563:0:" #(#fn(str-find) "\n" #fn(str-sub)) first-line 9)
   #fn("n10B;3B040<20Q;38040T21Q:" #(doc group) doc-group? 6)
   #fn("n10H;3?0470A710225262:" #(member getprop *doc-extra*) doc-extra-term? 9)
@@ -110,7 +110,7 @@
 021522263:" #(getprop *formals-list* "    ") 9)
   void "no help for " #fn(str) " " "" " (undefined)") 21)  defstruct #fn("z0700=5185<85=0<I21228887>2?9514863H0738824862589Pe15252@30q42627e188e178875163:" #(separate-doc-from-body
   #0# #fn("n12002152853=0220E8553@300853<02208552@402324752627AF5351285229862:7;882<528764:" #(#fn(str-find)
-r #fn(list*) defstruct "\n" #fn(str) "\n\n    "
+to-str #fn(list*) defstruct "\n" #fn(str) "\n\n    "
 -fmt #fn(nconc) %defstruct% copy-list) 15)  bcode:ctable #fn("n1200Ke3:" #(aref) 7)  with-output-to #fn("z12021e1220e2e1e17315163:" #(#fn(nconc)
   with-bindings *io-out* copy-list) 9)  catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch
   λ #:g464 if and cons? eq? car quote thrown-value cadr caddr raise) 15)  let* #fn("z10H3E02021e1qe17215153e1:2021e173051e1e1720=B3H02024e10=e17215153e1@301515375051e2:" #(#fn(nconc)
@@ -136,6 +136,9 @@
 - #u8(56)  brn.l #u8(49)  optargs #u8(87)  closure #u8(14)  vec? #u8(45)  pop #u8(4)  eqv? #u8(51)  list #u8(53)  seta #u8(15)  seta.l #u8(73)  brnn #u8(26)  loadnil #u8(65)  loadg #u8(7)  loada #u8(8)  tcall #u8(6))
             S #fn("z1700215286380861}2:7223062:" #(getprop constructor error "no default constructor for struct: ") S 8)
             __finish #fn("n120Z3>021220>17062:q:" #(*exit-hooks* #fn(for-each)
+:7223062:" #(getprop constructor error "no default constructor for struct: ") S 8)
+            __finish #fn("n120Z3>021220>17062:q:" #(*exit-hooks* #fn(for-each)
+                                                    #fn("n10A61:" 6)) __finish 7)
 :7223062:" #(getprop constructor error "no default constructor for struct: ") S 8)
             __finish #fn("n120Z3>021220>17062:q:" #(*exit-hooks* #fn(for-each)
                                                     #fn("n10A61:" 6)) __finish 7)
@@ -196,13 +199,13 @@
 n bcode:stack compile-arglist emit tcall.l call.l
   builtin->instruction cadr length= λ inlineable? compile-let compile-builtin-call tcall call) compile-app 16)
             compile-arglist #fn("n3202101>282524228261:" #(#fn(for-each)
-                                              #fn("n170AFq054471AK62:" #(compile-in
+                                              #fn("n170AFq054471AK62:" #(compile-in
 egin #fn("n483H3?0700182715064:83=H3>070018283<64:7001q83<5447202352474018283=64:" #(compile-in
   void emit pop compile-begin) compile-begin 9)
             compile-builtin-call #fn("n7I202186850>3?;514227385q538<3I07483=8<52J=075858<52@30q4858=26CL086El23:07702862:770858663:8=29C708;60:8=2:C708;60:8=2;C]086El23:07702<62:86r2l23:07702=62:770858663:8=2>Cm086El23:07585K62:86Kl23:07702?62:86r2l23:07702@62:770858663:8=2ACL086El23:07702B62:770858663:8=2CCL086El23:07585K62:770858663:8=2DCN086El23<07702E2F63:770858663:8=2GCX086r2L23;07585r262:770823702H@402G8663:8=2ICb086r2l23:07702J62:r286L23?07708586r3~63:7585r262:7708562:" #(#0#
-8;60:8=2;C]086El23:07702<62:86r2l23:07702=62:770858663:8=2>Cm086El23:07585K62:86Kl23:07702?62:86r2l23:07702@62:770858663:8=2ACL086El23:07702B62:770858663:8=2CCL086El23:07585K62:770858663:8=2DCN086El23<07702E2F63:770858663:8=2GCX086r2L23;07585r262:770823702H@402G8663:8=2ICb086r2l23:07702J62:r286L23?07708586r3~63:7585r262:7708562:" #(#0#
-  #fn("n0AEl239070FK62:7192FA63:" #(argc-error emit) num-compare 8)
-  #fn(get) arg-counts length= argc-error list emit loadnil < = + load0 add2 - neg sub2 * load1 /
+8;60:8=2;C]086El23:07702<62:86r2l23:07702=62:770858663:8=2>Cm086El23:07585K62:86Kl23:07702?62:86r2l23:07702@62:770858663:8=2ACL086El23:07702B62:770858663:8=2CCL086El23:07585K62:770858663:8=2DCN086El23<07702E2F63:770858663:8=2GCX086r2L23;07585r262:770823702H@402G8663:8=2ICb086r2l23:07702J62:r286L23?07708586r3~63:7585r262:7708562:" #(#0#
+  #fn("n0AEl239070FK62:7192FA63:" #(argc-error emit) num-compare 8)
+  #fn(get) arg-counts length= argc-error list emit loadnil < = + load0 add2 - neg sub2 * load1 /
 62:770823702H@402G8663:8=2ICb086r2l23:07702J62:r286L23?07708586r3~63:7585r262:7708562:" #(#0#
   #fn("n0AEl239070FK62:7192FA63:" #(argc-error emit) num-compare 8)
   #fn(get) arg-counts length= argc-error list emit loadnil < = + load0 add2 - neg sub2 * load1 /
@@ -346,8 +349,8 @@
 bda:body #fn("n170061:" #(caddr) lambda:body 6) lambda:vars
             #fn("n1700T61:" #(lambda-vars) lambda:vars 6) last-pair #fn("n10=H3400:700=61:" #(last-pair) last-pair 6)
             lastcdr #fn("n10H3400:70051=:" #(last-pair) lastcdr 6) length=
-;34040:0B3<0700=1K~62:121051L2:" #(length> #fn(length)) length> 8)
-            list->vec #fn("n1202172063:" #(#fn(map) vec identity) list->vec 8) list-ref
+;34040:0B3<0700=1K~62:121051L2:" #(length> #fn(length)) length> 8)
+            list->vec #fn("n1202172063:" #(#fn(map) vec identity) list->vec 8) list-ref
 85>12385>1{:" #(#fn(file) :read #fn("n0Ib48420A84>2_484<^1III63:" #(#fn("n320A51JG0F<21A510721514735063:24A514737215161:" #(#fn(io-eof?)
   #fn(read) load-process void #fn(io-close)) 9)) 8)
                                             #fn("n120A51421220e261:" #(#fn(io-close)
@@ -491,12 +494,12 @@
 182122051~52062:" #(#fn(str) str-rep #fn(str-length)) str-lpad 10)
             str-map #fn("n2205021151EI8887L23O0422860231885251524748851?8@\f/^14258661:" #(#fn(buffer)
   #fn(str-length) #fn(io-putrune) #fn(str-rune) 1+ #fn(io->str)) str-map 13)
-p #fn("n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=
+p #fn("n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=
 (str-sub)) str-tail 7) str-trim
             #fn("n3IIb7b820872187>1_51420882288>1_5142305124087<01E895488<082895363:" #(#0#
                                                                                         #fn("n48283L23P02012108252523A0A<017282518364:82:" #(#fn(str-find)
   #fn(str-rune) 1+) trim-start 9) #fn("n3E82L23R020121072825152523?0A<0172825163:82:" #(#fn(str-find)
-                                                   #fn(str-rune)
+                                                   #fn(str-rune)
                #fn(str-rune)
                                                                                         1-) trim-end 10)
                                                                                         #fn(str-length)
@@ -515,7 +518,7 @@
 
   #fn("n10H3700:@30q40<85B3I07085r2523>07185Er253@4085A<0=51P:" #(length> subseq) formals-clean 9)
   #fn(str?) #fn(map) str-join #fn(str-split) "\n" any #fn("n1E20051L2;3B04210E5222Q;34040:" #(#fn(str-length)
-tra* getprop *formals-list* filter #fn("n1700A52S:" #(member) 7)
+oc-extra* getprop *formals-list* filter #fn("n1700A52S:" #(member) 7)
 0)
             table-clone #fn("n12050212285>1q053485:" #(#fn(table)
                                                        #fn(table-foldl)
--- a/src/sl.c
+++ b/src/sl.c
@@ -747,34 +747,6 @@
 }
 
 static sl_v
-copy_list(sl_v L)
-{
-	if(!iscons(L))
-		return sl_nil;
-	usize plcons = sl.sp - sl.stack;
-	usize pL = plcons+1;
-	PUSH(sl_nil);
-	PUSH(L);
-	sl_v c;
-	c = alloc_cons(); PUSH(c);  // save first cons
-	car_(c) = car_(sl.stack[pL]);
-	cdr_(c) = sl_nil;
-	sl.stack[plcons] = c;
-	sl.stack[pL] = cdr_(sl.stack[pL]);
-	while(iscons(sl.stack[pL])){
-		c = alloc_cons();
-		car_(c) = car_(sl.stack[pL]);
-		cdr_(c) = sl_nil;
-		cdr_(sl.stack[plcons]) = c;
-		sl.stack[plcons] = c;
-		sl.stack[pL] = cdr_(sl.stack[pL]);
-	}
-	c = POP();  // first cons
-	POPN(2);
-	return c;
-}
-
-static sl_v
 do_trycatch(void)
 {
 	usize osp = sl.sp - sl.stack;
@@ -1096,31 +1068,6 @@
 	if(isfn(v))
 		return size_wrap(fn_maxstack(v));
 	bthrow(type_error(nil, "fn", v));
-}
-
-BUILTIN("append", append)
-{
-	if(nargs == 0)
-		return sl_nil;
-
-	sl_v first = sl_nil, lastcons = sl_nil;
-	sl_gc_handle(&first);
-	sl_gc_handle(&lastcons);
-	for(int i = 0; i < nargs; i++){
-		sl_v lst = args[i];
-		if(iscons(lst)){
-			lst = copy_list(lst);
-			if(first == sl_nil)
-				first = lst;
-			else
-				cdr_(lastcons) = lst;
-			lastcons = tagptr((((sl_cons*)slg.curheap)-1), TAG_CONS);
-		}else if(lst != sl_nil){
-			bthrow(type_error(nil, "cons", lst));
-		}
-	}
-	sl_free_gc_handles(2);
-	return first;
 }
 
 BUILTIN("list*", liststar)
--- a/src/system.sl
+++ b/src/system.sl
@@ -513,15 +513,32 @@
         ((cons? seq) (length> (cdr seq) (- n 1)))
         (else        (> (length seq) n))))
 
-(def (copy-list seq (n NIL))
-  (def (copy- last seq n)
+(def (append . lists)
+  (def (copy- last l)
+    (if (not l)
+        last
+        (let {[next (cons (car l) NIL)]}
+          (set-cdr! last next)
+          (copy- next (cdr l)))))
+  (def (append- last lists)
+    (unless (cdr lists)
+            (set-cdr! last (car lists))
+            (return))
+    (let {[next (copy- last (car lists))]}
+      (append- next (cdr lists))))
+  (let {[fst (cons NIL NIL)]}
+    (append- fst lists)
+    (cdr fst)))
+
+(def (copy-list l (n NIL))
+  (def (copy- last l n)
     (and n (= n 0) (return))
-    (unless seq (return))
-    (let {[next (cons (car seq) NIL)]}
+    (unless l (return))
+    (let {[next (cons (car l) NIL)]}
       (set-cdr! last next)
-      (copy- next (cdr seq) (and n (1- n)))))
+      (copy- next (cdr l) (and n (1- n)))))
   (let {[fst (cons NIL NIL)]}
-    (copy- fst seq n)
+    (copy- fst l n)
     (cdr fst)))
 
 (def (subseq seq start (end NIL))
--- a/test/unittest.sl
+++ b/test/unittest.sl
@@ -379,8 +379,8 @@
 (assert (equal? `(a `(b c)) '(a (quasiquote (b c)))))
 (assert (equal? ````x '```x))
 
-(assert-fail (eval '(append 1)))
-(assert-fail (eval '(append NIL 1)))
+(assert (equal? (append 1) 1))
+(assert (equal? (append NIL 1) 1))
 (assert (equal? (append) NIL))
 (assert (equal? (append NIL) NIL))
 (assert (equal? (append NIL NIL) NIL))