conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

adding functions max and min 

fixing make-system-image to save aliases of builtins
This commit is contained in:
JeffBezanson 2009-07-08 19:07:56 +00:00
parent e4e8d4dfdb
commit 2d4a0ae30e
5 changed files with 45 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
femtolisp/Makefile
View File

@ -12,7 +12,7 @@ FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAG
LIBS = $(LLT) -lm LIBS = $(LLT) -lm
DEBUGFLAGS = -g -DDEBUG $(FLAGS) DEBUGFLAGS = -g -DDEBUG $(FLAGS)
SHIPFLAGS = -O2 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS) SHIPFLAGS = -O2 -DNDEBUG -march=native $(FLAGS)
default: release test default: release test

10
femtolisp/flisp.boot
View File

@ -64,6 +64,8 @@ ref-int16-LE
#function(";000r2e0e1~\x7f`y[`32e1~\x7fay[b832y41;" [int16 ash]) #function(";000r2e0e1~\x7f`y[`32e1~\x7fay[b832y41;" [int16 ash])
random random
#function("8000r1e0~316<0e1e230~42;e330~T2;" [integer? mod rand rand.double]) #function("8000r1e0~316<0e1e230~42;e330~T2;" [integer? mod rand rand.double])
quotient
#.div0
quote-value quote-value
#function("7000r1e0~31640~;c1~L2;" [self-evaluating? quote]) #function("7000r1e0~31640~;c1~L2;" [self-evaluating? quote])
println println
@ -94,10 +96,14 @@ mod0
#function("8000r2~~\x7fV\x7fT2z;" []) #function("8000r2~~\x7fV\x7fT2z;" [])
mod mod
#function("9000r2~e0~\x7f32\x7fT2z;" [div]) #function("9000r2~e0~\x7f32\x7fT2z;" [div])
min
#function("<000s1\x7fA640~;e0c1q~\x7f43;" [foldl #function("7000r2~\x7fX640~;\x7f;" [])])
memv memv
#function("8000r2\x7f?640^;\x7fM~=640\x7f;e0~\x7fN42;" [memv]) #function("8000r2\x7f?640^;\x7fM~=640\x7f;e0~\x7fN42;" [memv])
member member
#function("8000r2\x7f?640^;\x7fM~>640\x7f;e0~\x7fN42;" [member]) #function("8000r2\x7f?640^;\x7fM~>640\x7f;e0~\x7fN42;" [member])
max
#function("<000s1\x7fA640~;e0c1q~\x7f43;" [foldl #function("7000r2~\x7fX640\x7f;~;" [])])
mark-label mark-label
#function("9000r2e0~e1\x7f43;" [emit :label]) #function("9000r2e0~e1\x7f43;" [emit :label])
map-int map-int
@ -105,9 +111,9 @@ map-int
map! map!
#function("9000r2\x7f^\x7fF6B02\x7f~\x7fM31O2\x7fNm15\x1d/2;" []) #function("9000r2\x7f^\x7fF6B02\x7f~\x7fM31O2\x7fNm15\x1d/2;" [])
map 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 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 make-label
#function("6000r1e040;" [gensym]) #function("6000r1e040;" [gensym])
make-code-emitter make-code-emitter

42
femtolisp/system.lsp
View File

@ -24,22 +24,21 @@
(list (list 'lambda (list name) (list 'set! name fn)) #f)) (list (list 'lambda (list name) (list 'set! name fn)) #f))
(define (map f lst . lsts) (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) (if (null? lsts)
((lambda (acc) (map1 f lst (list ()))
(cdr (mapn f (cons lst lsts))))
(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))))
(define-macro (let binds . body) (define-macro (let binds . body)
((lambda (lname) ((lambda (lname)
@ -115,6 +114,7 @@
(define (positive? x) (> x 0)) (define (positive? x) (> x 0))
(define (even? x) (= (logand x 1) 0)) (define (even? x) (= (logand x 1) 0))
(define (odd? x) (not (even? x))) (define (odd? x) (not (even? x)))
(define (identity x) x)
(define (1+ n) (+ n 1)) (define (1+ n) (+ n 1))
(define (1- n) (- n 1)) (define (1- n) (- n 1))
(define (mod0 x y) (- x (* (div0 x y) y))) (define (mod0 x y) (- x (* (div0 x y) y)))
@ -124,13 +124,19 @@
-1)) -1))
0))) 0)))
(define (mod x y) (- x (* (div x y) y))) (define (mod x y) (- x (* (div x y) y)))
(define quotient div0)
(define remainder mod0) (define remainder mod0)
(define (random n) (define (random n)
(if (integer? n) (if (integer? n)
(mod (rand) n) (mod (rand) n)
(* (rand.double) n))) (* (rand.double) n)))
(define (abs x) (if (< x 0) (- x) x)) (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 (char? x) (eq? (typeof x) 'wchar))
(define (array? x) (or (vector? x) (define (array? x) (or (vector? x)
(let ((t (typeof x))) (let ((t (typeof x)))
@ -787,7 +793,9 @@
(for-each (lambda (s) (for-each (lambda (s)
(if (and (bound? s) (if (and (bound? s)
(not (constant? 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 (memq s excludes))
(not (iostream? (top-level-value s)))) (not (iostream? (top-level-value s))))
(begin (begin

3
femtolisp/test.lsp
View File

@ -240,11 +240,10 @@
v))))) v)))))
(set! show-profiles (set! show-profiles
(lambda () (lambda ()
(define (max a b) (if (< a b) b a))
(define pr (filter (lambda (x) (> (cadr x) 0)) (define pr (filter (lambda (x) (> (cadr x) 0))
(table.pairs *profiles*))) (table.pairs *profiles*)))
(define width (+ 4 (define width (+ 4
(foldl max 0 (apply max
(map (lambda (x) (map (lambda (x)
(length (string x))) (length (string x)))
(cons 'Function (cons 'Function

12
femtolisp/todo
View File

@ -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 * new cvalues, types representation
* use the unused tag for TAG_PRIM, add smaller prim representation * use the unused tag for TAG_PRIM, add smaller prim representation
* finalizers in gc * finalizers in gc
@ -965,6 +965,14 @@ consolidated todo list as of 8/30:
- eliminate string copy in lerror() when possible - eliminate string copy in lerror() when possible
* fix printing lists of short strings * 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 c types
- remaining cvalues functions - remaining cvalues functions
- finish ios - finish ios
@ -1033,7 +1041,7 @@ new evaluator todo:
- lambda lifting - lambda lifting
* let optimization * let optimization
- fix equal? on functions - fix equal? on functions
- store function name and signature - store function name
* have macroexpand use its own global syntax table * have macroexpand use its own global syntax table
* be able to create/load an image file * be able to create/load an image file
* fix trace and untrace * fix trace and untrace