shithub: femtolisp

Download patch

ref: 1a611fb29238402d52afca4b4f3c779c434afe84
parent: ea47856f32ee8063d5fe7eb3b1fe5b6094320db2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Nov 11 14:24:06 EST 2024

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

This is 2f0f7f16e514cb5609b1ae14fddd41edcc10010d in Julia.

--- 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:" #())) #2=#((*values*)
+	    #fn("7000n220>05061:" #(#fn("7000n10B;39049100<Q380F0=\x7f2:F061:" #())) #3=#((*values*)
   ()))
 	    cdaaar #fn("6000n10<<<=:" #() cdaaar) cdaadr
 	    #fn("6000n10T<=:" #() cdaadr) cdaar #fn("6000n10<<=:" #() cdaar)
@@ -140,7 +140,8 @@
   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("8000n37021>82524228261:" #(for-each #fn(":000n170AFO064:" #(compile-in))
+	    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))
 							    #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)
@@ -159,7 +160,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=#(#:g728 ()))
+  λ))) #0=#(#:g722 ()))
 	    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
@@ -270,8 +271,7 @@
 	    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) 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)
+	    #fn(";000n382J401:082<700182=5362:" #(foldr) foldr)
 	    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,10 +358,12 @@
 	    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("8000n0702192062:" #(for-each #fn(write)))
+  #fn("7000n120>21>}0504:" #(#fn("8000n0202192062:" #(#2#
+						      #fn(write)))
 			     #fn("7000n1A50420061:" #(#fn(raise)))))
   #fn("6000n0Aw0:" #(*print-readably*)))) *print-readably*) princ)
-	    print #fn(":000|07021062:" #(for-each #fn(write)) print)
+	    print #fn(":000|02021062:" #(#2#
+					 #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
@@ -373,9 +375,11 @@
   #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("8000n07021>F524O:" #(for-each #fn("9000n19100Aq63:" #())))
+			    #fn("8000n02021>F524O:" #(#2#
+						      #fn("9000n19100Aq63:" #())))
 			    #fn("7000n10B;3B040<20Q;38040T21Q38072061:23061:" #(thrown-value
-  ffound caddr #fn(raise)))) fn-name) #fn("8000n37021>062:" #(for-each #fn("9000n1709110KGF5271051==P51472504902El3?0730KG0EG52@30O4902KMz02:" #(print
+  ffound caddr #fn(raise)))) fn-name) #fn("8000n32021>062:" #(#2#
+							      #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)
@@ -415,8 +419,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<5247122>A=52423061:" #(#fn(io-write)
-  for-each #fn("8000n120A91152420A062:" #(#fn(io-write)))
+	    string-join #fn("7000n20J5020:21>225061:" #("" #fn("8000n1200A<5242122>A=52423061:" #(#fn(io-write)
+  #2# #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)
@@ -461,7 +465,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:" #() #2#) vector->list
+	    values #fn("9000|00B;36040=V3500<:A0P:" #() #3#) 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
@@ -2073,7 +2073,7 @@
 	if(!iscons(args[1]))
 		return FL(Nil);
 	value_t first, last, v;
-	int64_t argSP = args-FL(stack);
+	intptr_t argSP = args-FL(stack);
 	assert(argSP >= 0 && argSP < FL(nstack));
 	if(nargs == 2){
 		if(FL(sp)+3 > FL(nstack))
@@ -2135,6 +2135,25 @@
 		fl_free_gc_handles(2);
 	}
 	return 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)
--- a/system.lsp
+++ b/system.lsp
@@ -510,18 +510,6 @@
 
 (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))