lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

some renaming and reorganizing 

using more scheme-like names append! and reverse!
This commit is contained in:
JeffBezanson 2009-05-31 21:06:04 +00:00
parent ba32e4b0e9
commit 7c48f6ae53
4 changed files with 65 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
femtolisp/builtins.c
View File

@ -423,6 +423,7 @@ static builtinspec_t builtin_info[] = {
{ "integer?", fl_integerp }, { "integer?", fl_integerp },
{ "integer-valued?", fl_integer_valuedp }, { "integer-valued?", fl_integer_valuedp },
{ "nconc", fl_nconc }, { "nconc", fl_nconc },
{ "append!", fl_nconc },
{ "assq", fl_assq }, { "assq", fl_assq },
{ "memq", fl_memq }, { "memq", fl_memq },
{ "length", fl_length }, { "length", fl_length },

38
femtolisp/compiler.lsp
View File

@ -1,13 +1,8 @@
; -*- scheme -*- ; -*- scheme -*-
(define (make-enum-table offset keys)
(let ((e (table)))
(for 0 (1- (length keys))
(lambda (i)
(put! e (aref keys i) (+ offset i))))))
(define Instructions (define Instructions
(make-enum-table 0 (let ((e (table))
(keys
[:nop :dup :pop :call :tcall :jmp :brf :brt :jmp.l :brf.l :brt.l :ret [:nop :dup :pop :call :tcall :jmp :brf :brt :jmp.l :brf.l :brt.l :ret
:eq? :eqv? :equal? :atom? :not :null? :boolean? :symbol? :eq? :eqv? :equal? :atom? :not :null? :boolean? :symbol?
@ -24,9 +19,13 @@
:loadg :loada :loadc :loadg.l :loadg :loada :loadc :loadg.l
:setg :seta :setc :setg.l :setg :seta :setc :setg.l
:closure :argc :vargc :trycatch :copyenv :let :for :tapply :add2 :sub2 :neg :closure :argc :vargc :trycatch :copyenv :let :for :tapply
:add2 :sub2 :neg
dummy_t dummy_f dummy_nil])) dummy_t dummy_f dummy_nil]))
(for 0 (1- (length keys))
(lambda (i)
(put! e (aref keys i) i)))))
(define arg-counts (define arg-counts
(table :eq? 2 :eqv? 2 (table :eq? 2 :eqv? 2
@ -67,19 +66,10 @@
(define (make-label e) (gensym)) (define (make-label e) (gensym))
(define (mark-label e l) (emit e :label l)) (define (mark-label e l) (emit e :label l))
(define (count f l)
(define (count- f l n)
(if (null? l)
n
(count- f (cdr l) (if (f (car l))
(+ n 1)
n))))
(count- f l 0))
; convert symbolic bytecode representation to a byte array. ; convert symbolic bytecode representation to a byte array.
; labels are fixed-up. ; labels are fixed-up.
(define (encode-byte-code e) (define (encode-byte-code e)
(let* ((cl (nreverse e)) (let* ((cl (reverse! e))
(long? (>= (+ (length cl) (long? (>= (+ (length cl)
(* 3 (count (lambda (i) (* 3 (count (lambda (i)
(memq i '(:loadv :loadg :setg (memq i '(:loadv :loadg :setg
@ -265,19 +255,13 @@
(define (list-partition l n) (define (list-partition l n)
(define (list-part- l n i subl acc) (define (list-part- l n i subl acc)
(cond ((atom? l) (if (> i 0) (cond ((atom? l) (if (> i 0)
(cons (nreverse subl) acc) (cons (reverse! subl) acc)
acc)) acc))
((>= i n) (list-part- l n 0 () (cons (nreverse subl) acc))) ((>= i n) (list-part- l n 0 () (cons (reverse! subl) acc)))
(else (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc)))) (else (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc))))
(if (<= n 0) (if (<= n 0)
(error "list-partition: invalid count") (error "list-partition: invalid count")
(nreverse (list-part- l n 0 () ())))) (reverse! (list-part- l n 0 () ()))))
(define (length> lst n)
(cond ((< n 0) lst)
((= n 0) (and (pair? lst) lst))
((null? lst) (< n 0))
(else (length> (cdr lst) (- n 1)))))
(define (just-compile-args g lst env) (define (just-compile-args g lst env)
(for-each (lambda (a) (for-each (lambda (a)

20
femtolisp/flisp.boot
View File

@ -48,6 +48,8 @@ separate
#function("n2g00f0f1__44;" [] #0=[#function("n4f1A6>0f2f3K;f0f1M316[0g00f0f1Nf1Mf2Kf344;g00f0f1Nf2f1Mf3K44;" [] #0#) ()]) #function("n2g00f0f1__44;" [] #0=[#function("n4f1A6>0f2f3K;f0f1M316[0g00f0f1Nf1Mf2Kf344;g00f0f1Nf2f1Mf3K44;" [] #0#) ()])
self-evaluating? self-evaluating?
#function("n1f0?16>02f0C@17_02e0f03116_02f0C16_02f0e1f031<;" [constant? top-level-value]) #function("n1f0?16>02f0C@17_02e0f03116_02f0C16_02f0e1f031<;" [constant? top-level-value])
reverse!
#function("n1c0_q42;" [#function("r^g00F6Q02g00Ng00f0g00j02P2k005202f0;" [])])
reverse reverse
#function("n1e0e1_f043;" [foldl cons]) #function("n1e0e1_f043;" [foldl cons])
revappend revappend
@ -78,10 +80,8 @@ positive?
#function("n1e0f0`42;" [>]) #function("n1e0f0`42;" [>])
odd? odd?
#function("n1e0f031@;" [even?]) #function("n1e0f031@;" [even?])
nreverse
#function("n1c0_q42;" [#function("r^g00F6Q02g00Ng00f0g00j02P2k005202f0;" [])])
nreconc nreconc
#function("n2e0e1f031f142;" [nconc nreverse]) #function("n2e0e1f031f142;" [nconc reverse!])
newline newline
#function("n0e0e1312];" [princ *linefeed*]) #function("n0e0e1312];" [princ *linefeed*])
nestlist nestlist
@ -107,11 +107,9 @@ map!
map map
#function("n2f1?6;0f1;f0f1M31e0f0f1N32K;" [map]) #function("n2f1?6;0f1;f0f1M31e0f0f1N32K;" [map])
make-system-image make-system-image
#function("n1c0e1f0e2e3e434c5e6q44;" [#function("r^i02c1c2mq42;" [*print-pretty* #function("rc0mc1mpf0302;" [#function("n0e0c1me2e3e430313142;" [for-each #function("n1f0E16m02e0f031@16m02e1f031G@16m02e2f0g1132@16m02e3e1f03131@6\x9c0e4g10f0322e5g10c6322e4g10e1f031322e5g10c642;^;" [constant? top-level-value memq iostream? io.print io.write "\n"]) nreverse simple-sort environment]) #function("n1g00302e0f041;" [raise])]) #function("n0e0g00312g02i1;" [io.close *print-pretty*])]) file :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width* *print-readably*) *print-pretty*]) #function("n1c0e1f0e2e3e434c5e6q44;" [#function("r^i02c1c2mq42;" [*print-pretty* #function("rc0mc1mpf0302;" [#function("n0e0c1me2e3e430313142;" [for-each #function("n1f0E16m02e0f031@16m02e1f031G@16m02e2f0g1132@16m02e3e1f03131@6\x9c0e4g10f0322e5g10c6322e4g10e1f031322e5g10c642;^;" [constant? top-level-value memq iostream? io.print io.write "\n"]) reverse! simple-sort environment]) #function("n1g00302e0f041;" [raise])]) #function("n0e0g00312g02i1;" [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("n1e040;" [gensym]) #function("n1e040;" [gensym])
make-enum-table
#function("n2c0e130q42;" [#function("r`e0e1g013131c2ms;" [1- length #function("n1e0g00g11f0[g10f0u43;" [put!])]) table])
make-code-emitter make-code-emitter
#function("n0_e030`Z3;" [table]) #function("n0_e030`Z3;" [table])
macroexpand-1 macroexpand-1
@ -133,7 +131,7 @@ list-tail
list-ref list-ref
#function("n2e0f0f132M;" [list-tail]) #function("n2e0f0f132M;" [list-tail])
list-partition list-partition
#function("n2c0^q42;" [#function("rc0mj02e1g01`326I0e2c341;e4f0g00g01`__3541;" [#function("n5f0?6O0e0f2`326L0e1f331f4K;f4;e2f2f1326o0g00f0f1`_e1f331f4K45;g00f0Nf1af2uf0Mf3Kf445;" [> nreverse >=]) <= error "list-partition: invalid count" nreverse])]) #function("n2c0^q42;" [#function("rc0mj02e1g01`326I0e2c341;e4f0g00g01`__3541;" [#function("n5f0?6O0e0f2`326L0e1f331f4K;f4;e2f2f1326o0g00f0f1`_e1f331f4K45;g00f0Nf1af2uf0Mf3Kf445;" [> reverse! >=]) <= error "list-partition: invalid count" reverse!])])
list-head list-head
#function("n2e0f1`326>0_;f0Me1f0Nf1av32K;" [<= list-head]) #function("n2e0f1`326>0_;f0Me1f0Nf1av32K;" [<= list-head])
list->vector list->vector
@ -143,9 +141,9 @@ length>
length= length=
#function("n2f1`X6;0^;f1`W6F0f0A;f0A6Q0f1`W;e0f0Nf1av42;" [length=]) #function("n2f1`X6;0^;f1`W6F0f0A;f0A6Q0f1`W;e0f0Nf1av42;" [length=])
lastcdr lastcdr
#function("n1f0?6;0f0;e0f0N41;" [lastcdr]) #function("n1f0?6;0f0;e0f031N;" [last-pair])
last-pair last-pair
#function("n1f0?6;0f0;f0N?6E0f0;e0f0N41;" [last-pair]) #function("n1f0N?6<0f0;e0f0N41;" [last-pair])
just-compile-args just-compile-args
#function("n3e0c1mf142;" [for-each #function("n1e0g00g02^f044;" [compile-in])]) #function("n3e0c1mf142;" [for-each #function("n1e0g00g02^f044;" [compile-in])])
iota iota
@ -183,7 +181,7 @@ eval
error error
#function("o0e0c1f0K41;" [raise error]) #function("o0e0c1f0K41;" [raise error])
encode-byte-code encode-byte-code
#function("n1c0e1f031q42;" [#function("rc0e1e2f031b3e3c4mf032T2uc532q42;" [#function("rc0e1g0031q42;" [#function("rc0e1f031`e230e230e330^q47;" [#function("r^f1f0X6\xbc02g00f1[j52f5e0<6k0e1f2g00f1au[e2f431332f1b2uj15\xb90e3f4e4e5e6g1016\x8502e7f5c8326\x920c9f5q325\x940f53231322f1auj12f1f0X6\xb80c:g00f1[q325\xb90^5202e;c<mf3322e=f441;" [:label put! sizeof io.write byte get Instructions memq (:jmp :brt :brf) #function("rf0e0=6<0e1;f0e2=6G0e3;f0e4=6R0e5;^;" [:jmp :jmp.l :brt :brt.l :brf :brf.l]) #function("rc0g05q42;" [#function("re0f0c1326T0e2g14e3g0031322g11auk11;e0f0c4326w0e2g14e5g0031322g11auk11;e0f0c6326\xb60e2g14e5g0031322g11auk112e2g14e5g20g11[31322g11auk11;e0f0c7326\xf40e8g13e9g1431g00332e2g14g306\xe30e35\xe50e:`31322g11auk11;^;" [memv (:loadv.l :loadg.l :setg.l) io.write uint32 (:loada :seta :call :tcall :loadv :loadg :setg :list :+ :- :* :/ :vector :argc :vargc :loadi8 :apply :tapply) uint8 (:loadc :setc) (:jmp :brf :brt) put! sizeof uint16])]) table.foreach #function("n2e0g04f0322e1g04g206L0e25N0e3e4g02f1323142;" [io.seek io.write uint32 uint16 get]) io.tostring!]) length table buffer]) list->vector]) >= length count #function("n1e0f0c142;" [memq (:loadv :loadg :setg :jmp :brt :brf)]) 65536]) nreverse]) #function("n1c0e1f031q42;" [#function("rc0e1e2f031b3e3c4mf032T2uc532q42;" [#function("rc0e1g0031q42;" [#function("rc0e1f031`e230e230e330^q47;" [#function("r^f1f0X6\xbc02g00f1[j52f5e0<6k0e1f2g00f1au[e2f431332f1b2uj15\xb90e3f4e4e5e6g1016\x8502e7f5c8326\x920c9f5q325\x940f53231322f1auj12f1f0X6\xb80c:g00f1[q325\xb90^5202e;c<mf3322e=f441;" [:label put! sizeof io.write byte get Instructions memq (:jmp :brt :brf) #function("rf0e0=6<0e1;f0e2=6G0e3;f0e4=6R0e5;^;" [:jmp :jmp.l :brt :brt.l :brf :brf.l]) #function("rc0g05q42;" [#function("re0f0c1326T0e2g14e3g0031322g11auk11;e0f0c4326w0e2g14e5g0031322g11auk11;e0f0c6326\xb60e2g14e5g0031322g11auk112e2g14e5g20g11[31322g11auk11;e0f0c7326\xf40e8g13e9g1431g00332e2g14g306\xe30e35\xe50e:`31322g11auk11;^;" [memv (:loadv.l :loadg.l :setg.l) io.write uint32 (:loada :seta :call :tcall :loadv :loadg :setg :list :+ :- :* :/ :vector :argc :vargc :loadi8 :apply :tapply) uint8 (:loadc :setc) (:jmp :brf :brt) put! sizeof uint16])]) table.foreach #function("n2e0g04f0322e1g04g206L0e25N0e3e4g02f1323142;" [io.seek io.write uint32 uint16 get]) io.tostring!]) length table buffer]) list->vector]) >= length count #function("n1e0f0c142;" [memq (:loadv :loadg :setg :jmp :brt :brf)]) 65536]) reverse!])
emit emit
#function("o2e0f1c1326I0c2f0a[q325J0^2f0`e3f1f2Kf0`[32\\2f0;" [memq (:loadv :loadg :setg) #function("rc0g00b2[q42;" [#function("rc0g12Mq42;" [#function("rc0e1g10f0326K0e2g10f0325f0e3g10f0g00332g00auk002g00avq42;" [#function("rg30b2g10\\2f0L1k322e0f0c1326Z0c2g31q32k31;^;" [>= 256 #function("rf0e0=6<0e1;f0e2=6G0e3;f0e4=6R0e5;^;" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) has? get put!])])]) nreconc]) #function("o2e0f1c1326I0c2f0a[q325J0^2f0`e3f1f2Kf0`[32\\2f0;" [memq (:loadv :loadg :setg) #function("rc0g00b2[q42;" [#function("rc0g12Mq42;" [#function("rc0e1g10f0326K0e2g10f0325f0e3g10f0g00332g00auk002g00avq42;" [#function("rg30b2g10\\2f0L1k322e0f0c1326Z0c2g31q32k31;^;" [>= 256 #function("rf0e0=6<0e1;f0e2=6G0e3;f0e4=6R0e5;^;" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) has? get put!])])]) nreconc])
div div
@ -265,7 +263,7 @@ caaar
builtin->instruction builtin->instruction
#function("n1c0e1e2c3f03231q42;" [#function("re0e1f03216@02f0;" [has? Instructions]) intern string #\:]) #function("n1c0e1e2c3f03231q42;" [#function("re0e1f03216@02f0;" [has? Instructions]) intern string #\:])
bq-process bq-process
#function("n1c0^q42;" [#function("rc0mj02e1g00316]0g00H6Y0c2e3e4g003131q42;g00;g00?6l0c5g00L2;g00Mc6<6\x860e3e3e7g00313141;g00Mc8<6\x980e7g0041;e9f0g0032@6\xbb0c:e;g0031e<e=g0032q43;c>g00_q43;" [#function("n1f0F16K02f0Mc0<17K02f0Mc1<17U02f0c2<;" [*comma-at* *comma-dot* *comma*]) self-evaluating? #function("rf0Mc0<6A0e1f0NK;e2e1f0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any #function("rf0A6=0c0f1K;e1c2f1Ke3f031L142;" [list nconc list* bq-process]) lastcdr map bq-bracket1 #function("r^f0F16A02f0Mc0<@6Z02e1f0M31f1Kj12f0Nj05202c2f0F6t0e3f1e4f031L1325\x910f0A6\x830e5f1315\x910e3f1e6f031L132q42;" [*comma* bq-bracket #function("rf0NA6<0f0M;c0f0K;" [nconc]) nreconc cadr nreverse bq-process])])]) #function("n1c0^q42;" [#function("rc0mj02e1g00316]0g00H6Y0c2e3e4g003131q42;g00;g00?6l0c5g00L2;g00Mc6<6\x860e3e3e7g00313141;g00Mc8<6\x980e7g0041;e9f0g0032@6\xbb0c:e;g0031e<e=g0032q43;c>g00_q43;" [#function("n1f0F16K02f0Mc0<17K02f0Mc1<17U02f0c2<;" [*comma-at* *comma-dot* *comma*]) self-evaluating? #function("rf0Mc0<6A0e1f0NK;e2e1f0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any #function("rf0A6=0c0f1K;e1c2f1Ke3f031L142;" [list nconc list* bq-process]) lastcdr map bq-bracket1 #function("r^f0F16A02f0Mc0<@6Z02e1f0M31f1Kj12f0Nj05202c2f0F6t0e3f1e4f031L1325\x910f0A6\x830e5f1315\x910e3f1e6f031L132q42;" [*comma* bq-bracket #function("rf0NA6<0f0M;c0f0K;" [nconc]) nreconc cadr reverse! bq-process])])])
bq-bracket1 bq-bracket1
#function("n1f0F16@02f0Mc0<6J0e1f041;e2f041;" [*comma* cadr bq-process]) #function("n1f0F16@02f0Mc0<6J0e1f041;e2f041;" [*comma* cadr bq-process])
bq-bracket bq-bracket

36
femtolisp/system.lsp
View File

@ -177,14 +177,21 @@
((null? lst) (= n 0)) ((null? lst) (= n 0))
(else (length= (cdr lst) (- n 1))))) (else (length= (cdr lst) (- n 1)))))
(define (lastcdr l) (define (length> lst n)
(if (atom? l) l (cond ((< n 0) lst)
(lastcdr (cdr l)))) ((= n 0) (and (pair? lst) lst))
((null? lst) (< n 0))
(else (length> (cdr lst) (- n 1)))))
(define (last-pair l) (define (last-pair l)
(cond ((atom? l) l) (if (atom? (cdr l))
((atom? (cdr l)) l) l
(#t (last-pair (cdr l))))) (last-pair (cdr l))))
(define (lastcdr l)
(if (atom? l)
l
(cdr (last-pair l))))
(define (to-proper l) (define (to-proper l)
(cond ((null? l) l) (cond ((null? l) l)
@ -226,6 +233,15 @@
(separate- pred (cdr lst) yes (cons (car lst) no))))))) (separate- pred (cdr lst) yes (cons (car lst) no)))))))
(lambda (pred lst) (separate- pred lst () ())))) (lambda (pred lst) (separate- pred lst () ()))))
(define (count f l)
(define (count- f l n)
(if (null? l)
n
(count- f (cdr l) (if (f (car l))
(+ n 1)
n))))
(count- f l 0))
(define (nestlist f zero n) (define (nestlist f zero n)
(if (<= n 0) () (if (<= n 0) ()
(cons zero (nestlist f (f zero) (- n 1))))) (cons zero (nestlist f (f zero) (- n 1)))))
@ -240,7 +256,7 @@
(define (reverse lst) (foldl cons () lst)) (define (reverse lst) (foldl cons () lst))
(define (nreverse l) (define (reverse! l)
(let ((prev ())) (let ((prev ()))
(while (pair? l) (while (pair? l)
(set! l (prog1 (cdr l) (set! l (prog1 (cdr l)
@ -266,7 +282,7 @@
; backquote ------------------------------------------------------------------- ; backquote -------------------------------------------------------------------
(define (revappend l1 l2) (nconc (reverse l1) l2)) (define (revappend l1 l2) (nconc (reverse l1) l2))
(define (nreconc l1 l2) (nconc (nreverse l1) l2)) (define (nreconc l1 l2) (nconc (reverse! l1) l2))
(define (self-evaluating? x) (define (self-evaluating? x)
(or (and (atom? x) (or (and (atom? x)
@ -305,7 +321,7 @@
(set! p (cdr p))) (set! p (cdr p)))
(let ((forms (let ((forms
(cond ((pair? p) (nreconc q (list (cadr p)))) (cond ((pair? p) (nreconc q (list (cadr p))))
((null? p) (nreverse q)) ((null? p) (reverse! q))
(#t (nreconc q (list (bq-process p))))))) (#t (nreconc q (list (bq-process p)))))))
(if (null? (cdr forms)) (if (null? (cdr forms))
(car forms) (car forms)
@ -754,7 +770,7 @@
(begin (begin
(io.print f s) (io.write f "\n") (io.print f s) (io.write f "\n")
(io.print f (top-level-value s)) (io.write f "\n")))) (io.print f (top-level-value s)) (io.write f "\n"))))
(nreverse (simple-sort (environment)))) (reverse! (simple-sort (environment))))
(begin (begin
(io.close f) (io.close f)
(set! *print-pretty* pp))))) (set! *print-pretty* pp)))))