shithub: femtolisp

--- a/flisp.boot

+++ b/flisp.boot

@@ -79,7 +79,7 @@

 	  __start #fn("8000r1e0302|NF6D0|Nk12^k22e3|\x84315E0|k12]k22e4e5312e6302e7`41;" [__init_globals

   *argv* *interactive* __script princ *banner* repl exit] __start)

 	  abs #fn("7000r1|`X650|y;|;" [] abs) any

-	  #fn("8000r2}F16D02|}M3117:02e0|}N42;" [any] any) arg-counts #table(#.not 1  #.atom? 1  #.number? 1  #.cons 2  #.set-cdr! 2  #.equal? 2  #.fixnum? 1  #.bound? 1  #.eq? 2  #.symbol? 1  #.builtin? 1  #.< 2  #.aset! 3  #.div0 2  #.cdr 1  #.null? 1  #.eqv? 2  #.compare 2  #.aref 2  #.car 1  #.set-car! 2  #.pair? 1  #.= 2  #.vector? 1  #.boolean? 1)

+	  #fn("8000r2}F16D02|}M3117:02e0|}N42;" [any] any) arg-counts #table(#.equal? 2  #.atom? 1  #.set-cdr! 2  #.symbol? 1  #.car 1  #.eq? 2  #.aref 2  #.boolean? 1  #.not 1  #.null? 1  #.eqv? 2  #.number? 1  #.pair? 1  #.builtin? 1  #.aset! 3  #.div0 2  #.= 2  #.bound? 1  #.compare 2  #.vector? 1  #.cdr 1  #.set-car! 2  #.< 2  #.fixnum? 1  #.cons 2)

 	  argc-error #fn("<000r2e0c1|c2}}aW670c3540c445;" [error "compile error: "

 							   " expects " " argument."

 							   " arguments."] argc-error)

@@ -104,7 +104,7 @@

   #.cons bq-process nconc list*]) lastcdr map #fn("8000r1e0|\x7f42;" [bq-bracket1])

   #fn("6000r1c0qm02|;" [#fn(">000r2|\x85;0c0e1}31K;|F6s0|Mc2\x82[0c0e3}i11`W670|N5E0c4c5L2e6|Ni11ax32L232K;~|Ne7|Mi1132}K42;c0e1e6|i1132}K31K;" [nconc

   reverse! unquote nreconc #.list 'unquote bq-process bq-bracket])])] bq-process)

-	  builtin->instruction #fn("9000r1e0~|^43;" [get] [#table(#.number? number?  #.cons cons  #.fixnum? fixnum?  #.equal? equal?  #.eq? eq?  #.symbol? symbol?  #.div0 div0  #.builtin? builtin?  #.aset! aset!  #.- -  #.boolean? boolean?  #.not not  #.apply apply  #.atom? atom?  #.set-cdr! set-cdr!  #./ /  #.function? function?  #.vector vector  #.list list  #.bound? bound?  #.< <  #.* *  #.cdr cdr  #.null? null?  #.+ +  #.eqv? eqv?  #.compare compare  #.aref aref  #.set-car! set-car!  #.car car  #.pair? pair?  #.= =  #.vector? vector?)

+	  builtin->instruction #fn("9000r1e0~|^43;" [get] [#table(#.equal? equal?  #.* *  #.car car  #.apply apply  #.aref aref  #.- -  #.boolean? boolean?  #.builtin? builtin?  #.null? null?  #.eqv? eqv?  #.function? function?  #.bound? bound?  #.cdr cdr  #.list list  #.set-car! set-car!  #.cons cons  #.atom? atom?  #.set-cdr! set-cdr!  #.symbol? symbol?  #.eq? eq?  #.vector vector  #.not not  #.pair? pair?  #.number? number?  #.div0 div0  #.aset! aset!  #.+ +  #.= =  #.compare compare  #.vector? vector?  #./ /  #.< <  #.fixnum? fixnum?)

 							   ()])

 	  caaaar #fn("6000r1|MMMM;" [] caaaar) caaadr

 	  #fn("6000r1|\x84MM;" [] caaadr) caaar #fn("6000r1|MMM;" [] caaar)

@@ -154,7 +154,7 @@

   keyargs emit-optional-arg-inits > 255 largc lvargc vargc argc compile-in ret

   values function encode-byte-code bcode:code const-to-idx-vec]) filter

   keyword-arg?]) length]) length]) make-code-emitter lastcdr lambda-vars filter

-  #.pair? lambda])] #0=[#:g709 ()])

+  #.pair? lambda])] #0=[#:g711 ()])

 	  compile-for #fn(":000r5e0g4316X0e1|}^g2342e1|}^g3342e1|}^g4342e2|c342;e4c541;" [1arg-lambda?

   compile-in emit for error "for: third form must be a 1-argument lambda"] compile-for)

 	  compile-if #fn("<000r4c0qe1|31e1|31g3\x84e2g331e3g331F6;0e4g331560e53045;" [#fn(";000r5g2]\x82>0e0~\x7fi02g344;g2^\x82>0e0~\x7fi02g444;e0~\x7f^g2342e1~c2|332e0~\x7fi02g3342i026<0e1~c3325:0e1~c4}332e5~|322e0~\x7fi02g4342e5~}42;" [compile-in

@@ -187,8 +187,9 @@

   #fn("8000r2~}|\\;" []) bcode:ctable]) vector.alloc bcode:nconst] const-to-idx-vec)

 	  copy-tree #fn("8000r1|?640|;e0|M31e0|N31K;" [copy-tree] copy-tree)

 	  count #fn("7000r2c0q]41;" [#fn("9000r1c0qm02|~\x7f`43;" [#fn(":000r3}\x8550g2;~|}N|}M31690g2aw540g243;" [] count-)])] count)

-	  delete-duplicates #fn("8000r1|?640|;c0|M|N42;" [#fn("8000r2e0|}32680e1}41;|e1}31K;" [member

-  delete-duplicates])] delete-duplicates)

+	  delete-duplicates #fn("8000r1e0|bD326<0c1qe23041;|?640|;c3|M|N42;" [length>

+  #fn("8000r1e0c1q~322e2|41;" [for-each #fn("9000r1e0~|]43;" [put!]) table.keys])

+  table #fn("8000r2e0|}32680e1}41;|e1}31K;" [member delete-duplicates])] delete-duplicates)

 	  disassemble #fn("=000s1}\x85C0e0|`322e1302];530]2c2}Me3|31e4|3143;" [disassemble

   newline #fn("7000r3c0q]41;" [#fn(":000r1c0qm02`~axc1u2e2c3e4\x7f`32c5332c6qb4e7\x7f3142;" [#fn("9000r1|J16602|G@6D0e0c1312e2|i10aw42;e3|41;" [princ

   "\n" disassemble print] print-val) #fn("7000r1e0c141;" [princ "\t"]) princ "maxstack "

--- a/flisp.c

+++ b/flisp.c

@@ -604,7 +604,7 @@

         gc(0);

-static void grow_stack()

+static void grow_stack(void)

     size_t newsz = N_STACK + (N_STACK>>1);

     value_t *ns = realloc(Stack, newsz*sizeof(value_t));

@@ -796,7 +796,7 @@

     return c;

-static value_t do_trycatch()

+static value_t do_trycatch(void)

     uint32_t saveSP = SP;

     value_t v;

@@ -2148,21 +2148,23 @@

         lerror(ArgError, "map: too few arguments");

     if (!iscons(args[1])) return NIL;

     value_t first, last, v;

+    int64_t argSP = args-Stack;

+    assert(argSP >= 0 && argSP < N_STACK);

     if (nargs == 2) {

         if (SP+3 > N_STACK) grow_stack();

-        PUSH(args[0]);

-        PUSH(car_(args[1]));

+        PUSH(Stack[argSP]);

+        PUSH(car_(Stack[argSP+1]));

         v = _applyn(1);

         PUSH(v);

         v = mk_cons();

         car_(v) = POP(); cdr_(v) = NIL;

         last = first = v;

-        args[1] = cdr_(args[1]);

+        Stack[argSP+1] = cdr_(Stack[argSP+1]);

         fl_gc_handle(&first);

         fl_gc_handle(&last);

-        while (iscons(args[1])) {

-            Stack[SP-2] = args[0];

-            Stack[SP-1] = car_(args[1]);

+        while (iscons(Stack[argSP+1])) {

+            Stack[SP-2] = Stack[argSP];

+            Stack[SP-1] = car_(Stack[argSP+1]);

             v = _applyn(1);

             PUSH(v);

             v = mk_cons();

@@ -2169,7 +2171,7 @@

             car_(v) = POP(); cdr_(v) = NIL;

             cdr_(last) = v;

             last = v;

-            args[1] = cdr_(args[1]);

+            Stack[argSP+1] = cdr_(Stack[argSP+1]);

         POPN(2);

         fl_free_gc_handles(2);

@@ -2177,10 +2179,10 @@

     else {

         size_t i;

         while (SP+nargs+1 > N_STACK) grow_stack();

-        PUSH(args[0]);

+        PUSH(Stack[argSP]);

         for(i=1; i < nargs; i++) {

-            PUSH(car(args[i]));

-            args[i] = cdr_(args[i]);

+            PUSH(car(Stack[argSP+i]));

+            Stack[argSP+i] = cdr_(Stack[argSP+i]);

         v = _applyn(nargs-1);

         PUSH(v);

@@ -2189,11 +2191,11 @@

         last = first = v;

         fl_gc_handle(&first);

         fl_gc_handle(&last);

-        while (iscons(args[1])) {

-            Stack[SP-nargs] = args[0];

+        while (iscons(Stack[argSP+1])) {

+            Stack[SP-nargs] = Stack[argSP];

             for(i=1; i < nargs; i++) {

-                Stack[SP-nargs+i] = car(args[i]);

-                args[i] = cdr_(args[i]);

+                Stack[SP-nargs+i] = car(Stack[argSP+i]);

+                Stack[argSP+i] = cdr_(Stack[argSP+i]);

             v = _applyn(nargs-1);

             PUSH(v);

--- a/system.lsp

+++ b/system.lsp

@@ -340,14 +340,18 @@

           (copy-tree (cdr l)))))

 (define (delete-duplicates lst)

-  (if (atom? lst)

-      lst

-      (let ((elt  (car lst))

-	    (tail (cdr lst)))

-	(if (member elt tail)

-	    (delete-duplicates tail)

-	    (cons elt

-		  (delete-duplicates tail))))))

+  (if (length> lst 20)

+      (let ((t (table)))

+	(for-each (lambda (elt) (put! t elt #t)) lst)

+	(table.keys t))

+      (if (atom? lst)

+	  lst

+	  (let ((elt  (car lst))

+		(tail (cdr lst)))

+	    (if (member elt tail)

+		(delete-duplicates tail)

+		(cons elt

+		      (delete-duplicates tail)))))))

 ; backquote -------------------------------------------------------------------