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))