From 2d4a0ae30e864f02db8788551f1290e1184997ac Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Wed, 8 Jul 2009 19:07:56 +0000 Subject: [PATCH] adding functions max and min fixing make-system-image to save aliases of builtins --- femtolisp/Makefile | 2 +- femtolisp/flisp.boot | 10 ++++++++-- femtolisp/system.lsp | 42 +++++++++++++++++++++++++----------------- femtolisp/test.lsp | 3 +-- femtolisp/todo | 12 ++++++++++-- 5 files changed, 45 insertions(+), 24 deletions(-) diff --git a/femtolisp/Makefile b/femtolisp/Makefile index 414039d..afae2fa 100644 --- a/femtolisp/Makefile +++ b/femtolisp/Makefile @@ -12,7 +12,7 @@ FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAG 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 diff --git a/femtolisp/flisp.boot b/femtolisp/flisp.boot index 30e809b..e0dc79a 100644 --- a/femtolisp/flisp.boot +++ b/femtolisp/flisp.boot @@ -64,6 +64,8 @@ ref-int16-LE #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 @@ mod0 #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-int 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 diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 5d386c1..a7cedd2 100644 --- 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,13 +124,19 @@ -1)) 0))) (define (mod x y) (- x (* (div x y) y))) +(define quotient div0) (define remainder mod0) (define (random n) (if (integer? n) (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 diff --git a/femtolisp/test.lsp b/femtolisp/test.lsp index bd40a0d..8a8ef96 100644 --- 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 diff --git a/femtolisp/todo b/femtolisp/todo index f31ea6f..ccd3f8d 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -952,7 +952,7 @@ switch to miser mode, otherwise default is ok, for example: ----------------------------------------------------------------------------- -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 @@ consolidated todo list as of 8/30: - 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 @@ new evaluator todo: - 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