shithub: femtolisp

Download patch

ref: 176253d3aeab23f81935da43799cbd9895ca7436
parent: c30d393c163211378fc9d908aab41a6dde0330af
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Nov 12 14:44:26 EST 2024

Revert "import from Julia: "flisp: rewrite `for-each` in C for speed", by Jeff Bezanson"

This reverts commit 1a611fb29238402d52afca4b4f3c779c434afe84.

Looks like it also makes torture test fail.

--- a/flisp.boot
+++ b/flisp.boot
@@ -118,7 +118,7 @@
 	    cadar #fn("6000n10<T:" #() cadar) caddar
 	    #fn("6000n10<=T:" #() caddar) cadddr #fn("6000n10==T:" #() cadddr)
 	    caddr #fn("6000n10=T:" #() caddr) call-with-values
-	    #fn("7000n220>05061:" #(#fn("7000n10B;39049100<Q380F0=\x7f2:F061:" #())) #3=#((*values*)
+	    #fn("7000n220>05061:" #(#fn("7000n10B;39049100<Q380F0=\x7f2:F061:" #())) #2=#((*values*)
   ()))
 	    cdaaar #fn("6000n10<<<=:" #() cdaaar) cdaadr
 	    #fn("6000n10T<=:" #() cdaadr) cdaar #fn("6000n10<<=:" #() cdaar)
@@ -140,8 +140,7 @@
   in-env? #fn(top-level-value) #.cadr length= compile-in emit #fn("=000n1A3H070930931932933910A067:7193093237022@4023063:" #(compile-builtin-call
   emit tcall call)) compile-arglist)) builtin->instruction)) in-env? #fn(constant?)
   #fn(top-level-value)))) compile-app)
-	    compile-arglist #fn("8000n32021>82524228261:" #(#2=#fn(";000|220>D61:" #(#fn(":000n120>?04902JJ0DFB3A04AF<514F=z01@\x1e/@;00AF902P524D:" #(#fn(":000n21<B3I002021152f24A0202215262:D:" #(#fn(map)
-  #.car #.cdr) for-each-n)))) for-each) #fn(":000n170AFO064:" #(compile-in))
+	    compile-arglist #fn("8000n37021>82524228261:" #(for-each #fn(":000n170AFO064:" #(compile-in))
 							    #fn(length)) compile-arglist)
 	    compile-begin #fn(":000n483H3?0700182715064:83=H3>070018283<64:7001O83<5447202352474018283=64:" #(compile-in
   void emit pop compile-begin) compile-begin)
@@ -160,7 +159,7 @@
   largc lvargc vargc argc compile-in ret values #fn(function) encode-byte-code
   bcode:code const-to-idx-vec)) filter keyword-arg?))
   #fn(length))) #fn(length))) make-code-emitter lastcdr lambda-vars filter #.pair?
-  λ))) #0=#(#:g722 ()))
+  λ))) #0=#(#:g728 ()))
 	    compile-for #fn(":000n57084513X07101O825447101O835447101O845447202362:742561:" #(1arg-lambda?
   compile-in emit for error "for: third form must be a 1-argument lambda") compile-for)
 	    compile-if #fn("<000n420>710517105183T728351738351B3;0748351@60755065:" #(#fn(";000n582DC>070AF9028364:82OC>070AF9028464:70AFO8254471A22053470AF902835449023<071A2352@:071A24153475A052470AF9028454475A162:" #(compile-in
@@ -271,7 +270,8 @@
 	    filter #fn("7000n220>D61:" #(#fn("9000n120>?040AFqe163:" #(#fn("9000n382D1B3S049101<513?0821<qPN=?2@30D41=?1@\f/4=:" #() filter-)))) filter)
 	    fits-i8 #fn("8000n10Y;3F04700r\xb052;3:04710r\xaf62:" #(>= <=) fits-i8)
 	    foldl #fn(":000n382J401:700082<15282=63:" #(foldl) foldl) foldr
-	    #fn(";000n382J401:082<700182=5362:" #(foldr) foldr)
+	    #fn(";000n382J401:082<700182=5362:" #(foldr) foldr) for-each #fn(";000|220>D61:" #(#fn(":000n120>?04902JJ0DFB3A04AF<514F=z01@\x1e/@;00AF902P524D:" #(#fn(":000n21<B3I002021152f24A0202215262:D:" #(#fn(map)
+  #.car #.cdr) for-each-n)))) for-each)
 	    get-defined-vars #fn("8000n170A05161:" #(delete-duplicates) #1=#(#fn("9000n10H340q:0<20Q;36040=B3d00TR;37040Te1;IS040TB;3E0471051R;3:0471051e1;I404q:0<22C>02324A0=52\x7f2:q:" #(define
   caadr begin #fn(nconc) #fn(map)) #1#) ()))
 	    hex5 #fn("9000n170210r@52r52263:" #(string-lpad #fn(number->string)
@@ -358,12 +358,10 @@
 	    nreconc #fn("8000n2701062:" #(reverse!-) nreconc) odd?
 	    #fn("7000n170051S:" #(even?) odd?) positive? #fn("8000n1700E62:" #(>) positive?)
 	    princ #fn("9000|020>7161:" #(#fn("7000n1Ow0421>22>61:" #(*print-readably*
-  #fn("7000n120>21>}0504:" #(#fn("8000n0202192062:" #(#2#
-						      #fn(write)))
+  #fn("7000n120>21>}0504:" #(#fn("8000n0702192062:" #(for-each #fn(write)))
 			     #fn("7000n1A50420061:" #(#fn(raise)))))
   #fn("6000n0Aw0:" #(*print-readably*)))) *print-readably*) princ)
-	    print #fn(":000|02021062:" #(#2#
-					 #fn(write)) print)
+	    print #fn(":000|07021062:" #(for-each #fn(write)) print)
 	    print-exception #fn("=000n10B;3D040<20Q;3:04710r3523I072230T24534757605151@\x0600B;3D040<27Q;3:04710r3523I072287605129534750T51@\xd400B;3D040<2:Q;3:04710r2523?0722;0T2<53@\xac00B;38040<2=Q3B0722>514720=f2@\x8d00B;38040<2?Q3G07@76051514722A0T52@i07B051;3:04710r2523I0750<514722C5142D0T51@>0722E514750514727F61:" #(type-error
   length= princ "type error: expected " ", got " print caddr bounds-error "index "
   " out of bounds for " unbound-error "eval: variable " " has no value" error
@@ -375,11 +373,9 @@
   #fn(function:vals))) #fn(function:name)) find-in-f)
   #fn("8000n22021>22}61:" #(#fn(";000n103H0207122237405152255261:26:" #(#fn(symbol)
   string-join #fn(map) #fn(string) reverse! "/" λ))
-			    #fn("8000n02021>F524O:" #(#2#
-						      #fn("9000n19100Aq63:" #())))
+			    #fn("8000n07021>F524O:" #(for-each #fn("9000n19100Aq63:" #())))
 			    #fn("7000n10B;3B040<20Q;38040T21Q38072061:23061:" #(thrown-value
-  ffound caddr #fn(raise)))) fn-name) #fn("8000n32021>062:" #(#2#
-							      #fn("9000n1709110KGF5271051==P51472504902El3?0730KG0EG52@30O4902KMz02:" #(print
+  ffound caddr #fn(raise)))) fn-name) #fn("8000n37021>062:" #(for-each #fn("9000n1709110KGF5271051==P51472504902El3?0730KG0EG52@30O4902KMz02:" #(print
   vector->list newline disassemble)))) reverse! length> list-tail *interactive*
   filter closure? #fn(map) #fn("7000n10Z;380420061:" #(#fn(top-level-value)))
   #fn(environment)))) print-stack-trace)
@@ -419,8 +415,8 @@
   #fn(":000n22071051Ae17115163:" #(#fn(nconc) simple-sort))))) simple-sort)
 	    splice-form? #fn("8000n10B;3X040<20Q;IN040<21Q;ID040<22Q;3:04730r252;I704022Q:" #(unquote-splicing
   unquote-nsplicing unquote length>) splice-form?)
-	    string-join #fn("7000n20J5020:21>225061:" #("" #fn("8000n1200A<5242122>A=52423061:" #(#fn(io-write)
-  #2# #fn("8000n120A91152420A062:" #(#fn(io-write)))
+	    string-join #fn("7000n20J5020:21>225061:" #("" #fn("8000n1200A<5247122>A=52423061:" #(#fn(io-write)
+  for-each #fn("8000n120A91152420A062:" #(#fn(io-write)))
   #fn(iostream->string))) #fn(buffer)) string-join)
 	    string-lpad #fn(";000n3207182122051\x8052062:" #(#fn(string)
 							     string-rep #fn(string-length)) string-lpad)
@@ -465,7 +461,7 @@
 	    untrace #fn("8000n120>2105161:" #(#fn("9000n1700513@021A22051r2G62:D:" #(traced?
   #fn(set-top-level-value!) #fn(function:vals)))
 					      #fn(top-level-value)) untrace)
-	    values #fn("9000|00B;36040=V3500<:A0P:" #() #3#) vector->list
+	    values #fn("9000|00B;36040=V3500<:A0P:" #() #2#) vector->list
 	    #fn("8000n120>21051q62:" #(#fn(":000n2K020>~41:" #(#fn("8000n1910A0\x80GFPz01:" #())))
 				       #fn(length)) vector->list)
 	    vector-map #fn("8000n220>2115161:" #(#fn("8000n120>2105161:" #(#fn(":000n1EAK\x8020>~40:" #(#fn(":000n1A09209210G51p:" #())))
--- a/flisp.c
+++ b/flisp.c
@@ -2144,25 +2144,6 @@
 	return FL(stack)[first];
 }
 
-BUILTIN("for-each", for_each)
-{
-	argcount(nargs, 2);
-	intptr_t argSP = args-FL(stack);
-	assert(argSP >= 0 && argSP < FL(nstack));
-	if(FL(sp)+2 > FL(nstack))
-		grow_stack();
-	PUSH(FL(t));
-	PUSH(FL(t));
-	while(iscons(FL(stack)[argSP+1])){
-		FL(stack)[FL(sp)-2] = FL(stack)[argSP];
-		FL(stack)[FL(sp)-1] = car_(FL(stack)[argSP+1]);
-		_applyn(1);
-		FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
-	}
-	POPN(2);
-	return FL(t);
-}
-
 BUILTIN("sleep", fl_sleep)
 {
 	if(nargs > 1)
--- a/system.lsp
+++ b/system.lsp
@@ -510,6 +510,18 @@
 
 (define (iota n) (map-int identity n))
 
+(define (for-each f l . lsts)
+  (define (for-each-n f lsts)
+    (if (pair? (car lsts))
+        (begin (apply f (map car lsts))
+               (for-each-n f (map cdr lsts)))))
+  (if (null? lsts)
+      (while (pair? l)
+             (begin (f (car l))
+                    (set! l (cdr l))))
+      (for-each-n f (cons l lsts)))
+  #t)
+
 (define-macro (with-bindings binds . body)
   (let ((vars (map car binds))
         (vals (map cadr binds))