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

adding array? 

adding vararg apply
This commit is contained in:
JeffBezanson 2009-05-08 04:08:31 +00:00
parent af72c4f5bd
commit afa77a8c5f
3 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
femtolisp/compiler.lsp
View File

@ -346,6 +346,14 @@
head)))
(let ((b (and (builtin? head)
(builtin->instruction head))))
(if (eq? b :apply)
(cond ((length= x 4)
(set! x `(,head ,(cadr x) (cons ,@(cddr x)))))
((length> x 4)
(set! x `(,head ,(cadr x)
(nconc (list ,@(list-head (cddr x)
(- (length x) 3)))
,(car (last-pair x))))))))
(if (not b)
(compile-in g env #f head))
(let ((nargs (compile-arglist g env (cdr x))))

4
femtolisp/flisp.boot
View File

@ -239,7 +239,7 @@ compile-for
compile-f
#function("o2b0d130d2e131p43;" [#function("qf02A@6D0d0e0d1325w0d2e131A6_0d0e0d3d4e131335w0d0e0d5e1?6o0_5u0d4e131332d6e0d7e131f00K\\d8f0131342d0e0d9322d:d;e0_Z31d<e03142;" [emit :let lastcdr :argc length :vargc compile-in to-proper caddr :ret function encode-byte-code const-to-idx-vec]) make-code-emitter cadr])
compile-call
#function("n4b0e3Mp42;" [#function("qb0e0C16d02d1e0f0132@16d02e0E16d02d2e03116d02d3e031G6p0d3e0315r0e0p42;" [#function("qb0e0G16A02d1e031p42;" [#function("qe0@6H0d0f20f21]f00345I0]2b1d2f20f21f23N33p42;" [compile-in #function("qf006G0b0d1d2f00]33p42;d3f30f326W0d45Y0d5e043;" [#function("qe016C02d0f43Ne032@6R0d1f20e0325S0]2b2f10p42;" [length= argc-error #function("qe0d0=6Y0f10_V6K0d1f50d242;d1f50f20f1043;e0d3=6\x940f10_V6s0d1f50d442;f10a2V6\x860d1f50d542;d1f50f20f1043;e0d6=6\xe00f10_V6\xad0d7f30`42;f10`V6\xbf0d1f50d842;f10a2V6\xd20d1f50d942;d1f50f20f1043;e0d:=6\x080f10_V6\xfa0d1f50d;42;d1f50f20f1043;e0d<=6/0f10_V6!0d7f30`42;d1f50f20f1043;e0d==6Y1f10_V6K1d1f50d>b?43;d1f50f20f1043;d1f50f5216l12f20d@<6t1dA5w1f2042;" [:list emit :loadnil :+ :load0 :add2 :- argc-error :neg :sub2 :* :load1 :/ :vector :loadv [] :apply :tapply])]) get arg-counts emit :tcall :call]) compile-arglist]) builtin->instruction]) in-env? constant? top-level-value])])
#function("n4b0e3Mp42;" [#function("qb0e0C16d02d1e0f0132@16d02e0E16d02d2e03116d02d3e031G6p0d3e0315r0e0p42;" [#function("qb0e0G16A02d1e031p42;" [#function("qe0d0<6\xb90d1f23a4326j0f00d2f2331d3b4L1d5d6f23313132L3j235\xb60d7f23a4326\xb50f00d2f2331b3d3b8L1d5d9d6f2331d:f2331a3u323132d;f2331ML3L3j235\xb60]5\xba0]2e0@6\xd20d<f20f21]f00345\xd30]2b=d>f20f21f23N33p42;" [:apply length= cadr nconc cons copy-list cddr length> list list-head length last-pair compile-in #function("qf006G0b0d1d2f00]33p42;d3f30f326W0d45Y0d5e043;" [#function("qe016C02d0f43Ne032@6R0d1f20e0325S0]2b2f10p42;" [length= argc-error #function("qe0d0=6Y0f10_V6K0d1f50d242;d1f50f20f1043;e0d3=6\x940f10_V6s0d1f50d442;f10a2V6\x860d1f50d542;d1f50f20f1043;e0d6=6\xe00f10_V6\xad0d7f30`42;f10`V6\xbf0d1f50d842;f10a2V6\xd20d1f50d942;d1f50f20f1043;e0d:=6\x080f10_V6\xfa0d1f50d;42;d1f50f20f1043;e0d<=6/0f10_V6!0d7f30`42;d1f50f20f1043;e0d==6Y1f10_V6K1d1f50d>b?43;d1f50f20f1043;d1f50f5216l12f20d@<6t1dA5w1f2042;" [:list emit :loadnil :+ :load0 :add2 :- argc-error :neg :sub2 :* :load1 :/ :vector :loadv [] :apply :tapply])]) get arg-counts emit :tcall :call]) compile-arglist]) builtin->instruction]) in-env? constant? top-level-value])])
compile-begin
#function("n4e3?6D0d0e0e1e2]44;e3N?6Y0d0e0e1e2e3M44;d0e0e1]e3M342d1e0d2322d3e0e1e2e3N44;" [compile-in emit :pop compile-begin])
compile-arglist
@ -290,6 +290,8 @@ assv
#function("n2e1?6:0];d0e131e0=6J0e1M;d1e0e1N42;" [caar assv])
assoc
#function("n2e1?6:0];d0e131e0>6J0e1M;d1e0e1N42;" [caar assoc])
array?
#function("n1e0H17E02b0d1e031p42;" [#function("qe0F16?02e0Mb0<;" [array]) typeof])
argc-error
#function("n2d0d1b2e0b3e1e1`V6J0b45L0b53541;" [error string "compile error: " " expects " " argument." " arguments."])
arg-counts

13
femtolisp/system.lsp
View File

@ -111,6 +111,9 @@
(define (abs x) (if (< x 0) (- x) x))
(define (identity x) x)
(define (char? x) (eq? (typeof x) 'wchar))
(define (array? x) (or (vector? x)
(let ((t (typeof x)))
(and (pair? t) (eq? (car t) 'array)))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
@ -200,7 +203,7 @@
(set! mapcar
(lambda (f . lsts) (mapcar- f lsts))))
(define (transpose M) (apply mapcar (cons list M)))
(define (transpose M) (apply mapcar list M))
(letrec ((filter-
(lambda (pred lst accum)
@ -488,8 +491,8 @@
; text I/O --------------------------------------------------------------------
(define (print . args) (apply io.print (cons *output-stream* args)))
(define (princ . args) (apply io.princ (cons *output-stream* args)))
(define (print . args) (apply io.print *output-stream* args))
(define (princ . args) (apply io.princ *output-stream* args))
(define (newline) (princ *linefeed*) #t)
(define (display x) (princ x) #t)
@ -691,8 +694,8 @@
(newline))
(define (print-exception e)
(define (eprinc . args) (apply io.princ (cons *error-stream* args)))
(define (eprint . args) (apply io.print (cons *error-stream* args)))
(define (eprinc . args) (apply io.princ *error-stream* args))
(define (eprint . args) (apply io.print *error-stream* args))
(cond ((and (pair? e)
(eq? (car e) 'type-error)
(length= e 4))