shithub: femtolisp

--- a/flisp.boot

+++ b/flisp.boot

@@ -125,7 +125,8 @@

   #fn(top-level-value) length> 255 compile-in bcode:stack compile-arglist emit

   tcall.l call.l builtin->instruction cadr length= is-lambda? inlineable?

   compile-let compile-builtin-call tcall call) compile-app)

-	    compile-arglist #fn("8000n3702101>282524228261:" #(for-each #fn("9000n170AFO054471AK62:" #(compile-in

+	    compile-arglist #fn("8000n3202101>282524228261:" #(#fn(for-each)

+							       #fn("9000n170AFO054471AK62:" #(compile-in

   bcode:stack)) #fn(length)) compile-arglist)

 	    compile-begin #fn("9000n483H3?0700182715064:83=H3>070018283<64:7001O83<5447202352474018283=64:" #(compile-in

   void emit pop compile-begin) compile-begin)

@@ -149,7 +150,7 @@

   compile-in #fn(top-level-value) eof-object loadv in-env? compile-app quote

   self-evaluating? if compile-if begin compile-begin prog1 compile-prog1 λ

   call-with-values #fn("7000n070AF62:" #(compile-f-))

-  #fn("9000n270A2105341\x85K07223AF>2152470A242515163:D:" #(emit loadv for-each

+  #fn("9000n270A2105341\x85K02223AF>2152470A242515163:D:" #(emit loadv #fn(for-each)

 							    #fn("9000n170AF0O64:" #(compile-sym))

 							    closure #fn(length)))

   and compile-and or compile-or while compile-while cddr for compile-for caddr

@@ -249,8 +250,7 @@

 	    filter #fn("9000n2D200>1?648601qe163:" #(#fn("8000n382D1B3Q04A1<513?0821<qPN=?2@30D41=?1@\x0e/4=:" #() filter-)) filter)

 	    fits-i8 #fn("7000n10Y;3F04700r\xb052;3:04710r\xaf62:" #(>= <=) fits-i8)

 	    foldl #fn("9000n382J401:700082<15282=63:" #(foldl) foldl) foldr

-	    #fn(":000n382J401:082<700182=5362:" #(foldr) foldr) for-each #fn(">000z2D\x8a7872087>1_482JI0D1B3@0401<5141=?1@\x1f/@<087<0182P524D:" #(#fn("9000n21<B3J002071152f24A<0207215262:D:" #(#fn(map)

-  car cdr) for-each-n)) for-each)

+	    #fn(":000n382J401:082<700182=5362:" #(foldr) foldr)

 	    get-defined-vars #fn("7000n170A<05161:" #(delete-duplicates) #(#0=(#fn("8000n10H340q:0<20Q;36040=B3d00TR;37040Te1;IS040TB;3E0471051R;3:0471051e1;I404q:0<22C?07324A<0=52}2:q:" #(define

   caadr begin nconc #fn(map)) #(#0#)))))

 	    hex5 #fn("8000n170210r@52r52263:" #(string-lpad #fn(number->string)

@@ -336,24 +336,24 @@

 	    #fn("6000n170051S:" #(even?) odd?) positive? #fn("7000n1700E62:" #(>) positive?)

 	    princ #fn(";000z070Ow042185>1220>12386>1{86504:" #(*print-readably*

 							       #fn("5000n0Aw0:" #(*print-readably*))

-							       #fn("7000n07071A62:" #(for-each

+							       #fn("7000n02071A62:" #(#fn(for-each)

   write)) #fn("6000n1A50420061:" #(#fn(raise)))) princ)

-	    print #fn("9000z07071062:" #(for-each write) print) print-exception

-	    #fn("=000n10B;3D040<20Q;3:04710r3523T072230T2425760515127554787605151@ 00B;3D040<29Q;3:04710r3523I0722:760512;534780T51@\xee00B;3D040<2<Q;3:04710r2523?0722=0T2>53@\xc600B;38040<2?Q3B0722@514720=f2@\xa700B;38040<2AQ3G07B76051514722C0T52@\x8307D051;3:04710r2523c0780<51472275140T2E8551;I60485R37072@40788551^1@>0722F514780514727G61:" #(type-error

+	    print #fn("9000z02071062:" #(#fn(for-each) write) print)

+	    print-exception #fn("=000n10B;3D040<20Q;3:04710r3523T072230T2425760515127554787605151@ 00B;3D040<29Q;3:04710r3523I0722:760512;534780T51@\xee00B;3D040<2<Q;3:04710r2523?0722=0T2>53@\xc600B;38040<2?Q3B0722@514720=f2@\xa700B;38040<2AQ3G07B76051514722C0T52@\x8307D051;3:04710r2523c0780<51472275140T2E8551;I60485R37072@40788551^1@>0722F514780514727G61:" #(type-error

   length= princ "type error: expected " ", got " #fn(typeof) caddr ": " print

   bounds-error "index " " out of bounds for " unbound-error "eval: variable "

   " has no value" error "error: " load-error print-exception "in file " list?

   #fn(string?) "*** Unhandled exception: " *linefeed*) print-exception)

-	    print-stack-trace #fn("@000n1DD\x8a5\x8a6852085>1_4862185>1_472730r3523F074075370r5@40r452@30051767728292:505252E\x8a97;2<868889>38762:" #(#fn(">000n32005182P2105121151C?022232487e361:2505126E77288851512988A187>463:" #(#fn(function:name)

+	    print-stack-trace #fn("@000n1DD\x8a5\x8a6852085>1_4862185>1_472730r3523F074075370r5@40r452@30051767728292:505252E\x8a92;2<868889>38762:" #(#fn(">000n32005182P2105121151C?022232487e361:2505126E77288851512988A187>463:" #(#fn(function:name)

   #fn(function:code) #fn(raise) thrown-value ffound #fn(function:vals) #.for 1-

   #fn(length) #fn("8000n170A0G513>0F<A0G929363:D:" #(closure?))) find-in-f)

-  #fn(";000n220A01>321{863I02273247576865152275261:28:" #(#fn("8000n07021AF>292524O:" #(for-each

+  #fn(";000n220A01>321{863I02273247576865152275261:28:" #(#fn("8000n02021AF>292524O:" #(#fn(for-each)

   #fn("8000n1A<0Fq63:" #()))) #fn("6000n10B;3B040<20Q;38040T21Q38072061:23061:" #(thrown-value

   ffound caddr #fn(raise))) #fn(symbol) string-join #fn(map) string reverse! "/"

 							  λ) fn-name) reverse!

   length> list-tail *interactive* filter closure? #fn(map)

   #fn("6000n10Z;380420061:" #(#fn(top-level-value)))

-  #fn(environment) for-each #fn("8000n170A<0KGF5271051==P5147250492<El3?0730KG0EG52@30O49292<KM_:" #(print

+  #fn(environment) #fn(for-each) #fn("8000n170A<0KGF5271051==P5147250492<El3?0730KG0EG52@30O49292<KM_:" #(print

   vector->list newline disassemble))) print-stack-trace)

 	    print-to-string #fn("8000n1205021085524228561:" #(#fn(buffer)

 							      #fn(write)

@@ -393,8 +393,9 @@

   #fn("9000n22071051Ae17115163:" #(#fn(nconc) simple-sort))) simple-sort)

 	    splice-form? #fn("7000n10B;3X040<20Q;IN040<21Q;ID040<22Q;3:04730r252;I704022Q:" #(unquote-splicing

   unquote-nsplicing unquote length>) splice-form?)

-	    string-join #fn("9000n20J5020:215022860<5247324861>20=524258661:" #(""

-  #fn(buffer) #fn(io-write) for-each #fn("7000n120AF52420A062:" #(#fn(io-write)))

+	    string-join #fn("9000n20J5020:215022860<5242324861>20=524258661:" #(""

+  #fn(buffer) #fn(io-write) #fn(for-each)

+  #fn("7000n120AF52420A062:" #(#fn(io-write)))

   #fn(iostream->string)) string-join)

 	    string-lpad #fn(":000n3207182122051~52062:" #(#fn(string)

 							  string-rep #fn(string-length)) string-lpad)

--- a/flisp.c

+++ b/flisp.c

@@ -2089,6 +2089,25 @@

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