shithub: femtolisp

--- a/femtolisp/Makefile

+++ b/femtolisp/Makefile

@@ -12,7 +12,7 @@

 LIBS = $(LLT) -lm

 DEBUGFLAGS = -g -DDEBUG $(FLAGS)

-SHIPFLAGS = -O2 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS)

+SHIPFLAGS = -O2 -DNDEBUG -march=native $(FLAGS)

 default: release test

--- a/femtolisp/flisp.boot

+++ b/femtolisp/flisp.boot

@@ -64,6 +64,8 @@

 #function(";000r2e0e1~\x7f`y[`32e1~\x7fay[b832y41;" [int16 ash])

 random

 #function("8000r1e0~316<0e1e230~42;e330~T2;" [integer? mod rand rand.double])

+quotient

+#.div0

 quote-value

 #function("7000r1e0~31640~;c1~L2;" [self-evaluating? quote])

 println

@@ -94,10 +96,14 @@

 #function("8000r2~~\x7fV\x7fT2z;" [])

mod

 #function("9000r2~e0~\x7f32\x7fT2z;" [div])

+min

+#function("<000s1\x7fA640~;e0c1q~\x7f43;" [foldl #function("7000r2~\x7fX640~;\x7f;" [])])

 memv

 #function("8000r2\x7f?640^;\x7fM~=640\x7f;e0~\x7fN42;" [memv])

 member

 #function("8000r2\x7f?640^;\x7fM~>640\x7f;e0~\x7fN42;" [member])

+max

+#function("<000s1\x7fA640~;e0c1q~\x7f43;" [foldl #function("7000r2~\x7fX640\x7f;~;" [])])

 mark-label

 #function("9000r2e0~e1\x7f43;" [emit :label])

 map-int

@@ -105,9 +111,9 @@

 map!

 #function("9000r2\x7f^\x7fF6B02\x7f~\x7fM31O2\x7fNm15\x1d/2;" [])

map

-#function("=000s2g2A6;0c0_L1u42;c1^u32~\x7fg2K42;" [#function("9000v~^\x81F6H02~\x80\x81M31_KPNm02\x81No015\x17/2N;" []) #function("6000vc0qm0;" [#function("\xb7000r2\x7fMA640_;~e0e1\x7f32Q2\x80~e0e2\x7f3232K;" [map car cdr])])])

+#function("=000s2c0^^u43;" [#function("9000vc0qm02c1qm12i02A6;0~\x80\x81_L143;\x7f\x80\x81i02K42;" [#function("9000r3g2^\x7fF6H02g2~\x7fM31_KPNm22\x7fNm15\x17/2N;" []) #function("\xb7000r2\x7fMA640_;~\x80e0\x7f32Q2\x81~\x80e1\x7f3232K;" [car cdr])])])

 make-system-image

-#function(";000r1c0e1~e2e3e434c5e6u44;" [#function("8000v^k02c1c2qu42;" [*print-pretty* #function("7000vc0qc1qt~302;" [#function(":000r0e0c1qe2e3e430313142;" [for-each #function("9000r1~E16b02e0~31@16W02e1~31G@16K02e2~i1132@16=02e3e1~3131@6\\0e4i10~322e5i10c6322e4i10e1~31322e5i10c642;^;" [constant? top-level-value memq iostream? io.print io.write "\n"]) reverse! simple-sort environment]) #function("7000r1\x80302e0~41;" [raise])]) #function("7000r0e0\x80312i02k1;" [io.close *print-pretty*])]) file :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width* *print-readably*) *print-pretty*])

+#function(";000r1c0e1~e2e3e434c5e6u44;" [#function("8000v^k02c1c2qu42;" [*print-pretty* #function("7000vc0qc1qt~302;" [#function(":000r0e0c1qe2e3e430313142;" [for-each #function("9000r1~E16w02e0~31@16l02e1~31G@17C02e2~31e2e1~3131>@16K02e3~i1132@16=02e4e1~3131@6\\0e5i10~322e6i10c7322e5i10e1~31322e6i10c742;^;" [constant? top-level-value string memq iostream? io.print io.write "\n"]) reverse! simple-sort environment]) #function("7000r1\x80302e0~41;" [raise])]) #function("7000r0e0\x80312i02k1;" [io.close *print-pretty*])]) file :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width* *print-readably*) *print-pretty*])

 make-label

 #function("6000r1e040;" [gensym])

 make-code-emitter

--- a/femtolisp/system.lsp

+++ b/femtolisp/system.lsp

@@ -24,22 +24,21 @@

   (list (list 'lambda (list name) (list 'set! name fn)) #f))

 (define (map f lst . lsts)

+  (define (map1 f lst acc)

+    (cdr

+     (prog1 acc

+      (while (pair? lst)

+	     (begin (set! acc

+			  (cdr (set-cdr! acc (cons (f (car lst)) ()))))

+		    (set! lst (cdr lst)))))))

+  (define (mapn f lsts)

+    (if (null? (car lsts))

+	()

+	(cons (apply f (map1 car lsts))

+	      (mapn  f (map1 cdr lsts)))))

   (if (null? lsts)

-      ((lambda (acc)

-	 (cdr

-	  (prog1 acc

-	   (while (pair? lst)

-		  (begin (set! acc

-			       (cdr (set-cdr! acc (cons (f (car lst)) ()))))

-			 (set! lst (cdr lst)))))))

-       (list ()))

-      ((label mapn

-	      (lambda (f lsts)

-		(if (null? (car lsts))

-		    ()

-		    (cons (apply f (map car lsts))

-			  (mapn  f (map cdr lsts))))))

-       f (cons lst lsts))))

+      (map1 f lst (list ()))

+      (mapn f (cons lst lsts))))

 (define-macro (let binds . body)

   ((lambda (lname)

@@ -115,6 +114,7 @@

 (define (positive? x) (> x 0))

 (define (even? x) (= (logand x 1) 0))

 (define (odd? x) (not (even? x)))

+(define (identity x) x)

 (define (1+ n) (+ n 1))

 (define (1- n) (- n 1))

 (define (mod0 x y) (- x (* (div0 x y) y)))

@@ -124,6 +124,7 @@

 				  -1))

 			 0)))

 (define (mod x y) (- x (* (div x y) y)))

+(define quotient div0)

 (define remainder mod0)

 (define (random n)

   (if (integer? n)

@@ -130,7 +131,12 @@

       (mod (rand) n)

       (* (rand.double) n)))

 (define (abs x)   (if (< x 0) (- x) x))

-(define (identity x) x)

+(define (max x0 . xs)

+  (if (null? xs) x0

+      (foldl (lambda (a b) (if (< a b) b a)) x0 xs)))

+(define (min x0 . xs)

+  (if (null? xs) x0

+      (foldl (lambda (a b) (if (< a b) a b)) x0 xs)))

 (define (char? x) (eq? (typeof x) 'wchar))

 (define (array? x) (or (vector? x)

 		       (let ((t (typeof x)))

@@ -787,7 +793,9 @@

      (for-each (lambda (s)

 		 (if (and (bound? s)

 			  (not (constant? s))

-			  (not (builtin? (top-level-value s)))

+			  (or (not (builtin? (top-level-value s)))

+			      (not (equal? (string s)

+					   (string (top-level-value s)))))

 			  (not (memq s excludes))

 			  (not (iostream? (top-level-value s))))

 		     (begin

--- a/femtolisp/test.lsp

+++ b/femtolisp/test.lsp

@@ -240,11 +240,10 @@

 	       v)))))

   (set! show-profiles

 	(lambda ()

-	  (define (max a b) (if (< a b) b a))

 	  (define pr (filter (lambda (x) (> (cadr x) 0))

 			     (table.pairs *profiles*)))

 	  (define width (+ 4

-			   (foldl max 0

+			   (apply max

 				  (map (lambda (x)

 					 (length (string x)))

 				       (cons 'Function

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -952,7 +952,7 @@

 -----------------------------------------------------------------------------

-consolidated todo list as of 8/30:

+consolidated todo list as of 7/8:

 * new cvalues, types representation

 * use the unused tag for TAG_PRIM, add smaller prim representation

 * finalizers in gc

@@ -965,6 +965,14 @@

 - eliminate string copy in lerror() when possible

 * fix printing lists of short strings

+- evaluator improvements, perf & debugging (below)

+* fix make-system-image to save aliases of builtins

+- reading named characters, e.g. #\newline etc.

+- #+, #- reader macros

+- printing improvements: *print-big*, keep track of horiz. position

+  per-stream so indenting works across print calls

+- improve bootstrapping process so compiled version can recompile

+  itself for a broader set of changes

 - remaining c types

 - remaining cvalues functions

 - finish ios

@@ -1033,7 +1041,7 @@

 - lambda lifting

 * let optimization

 - fix equal? on functions

-- store function name and signature

+- store function name

 * have macroexpand use its own global syntax table

 * be able to create/load an image file

 * fix trace and untrace