steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Some fixes for cond

db4
James Cash 2008-06-18 15:09:02 -04:00
parent 6d4a366787
commit 70baf7c9f7
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/lisp/lisp.factor
View File

@ -12,7 +12,6 @@ DEFER: lookup-var
DEFER: lookup-macro DEFER: lookup-macro
DEFER: lisp-macro? DEFER: lisp-macro?
DEFER: lisp-var? DEFER: lisp-var?
DEFER: macro-expand
DEFER: define-lisp-macro DEFER: define-lisp-macro
! Functions to convert s-exps to quotations ! Functions to convert s-exps to quotations
@ -24,7 +23,7 @@ DEFER: define-lisp-macro
cdr [ convert-form ] [ ] lmap-as '[ , [ call ] each ] ; cdr [ convert-form ] [ ] lmap-as '[ , [ call ] each ] ;
: convert-cond ( cons -- quot ) : convert-cond ( cons -- quot )
cdr [ 2car [ convert-form ] bi@ [ '[ @ call ] ] dip 2array ] cdr [ 2car [ convert-form ] bi@ 2array ]
{ } lmap-as '[ , cond ] ; { } lmap-as '[ , cond ] ;
: convert-general-form ( cons -- quot ) : convert-general-form ( cons -- quot )
@ -64,6 +63,9 @@ PRIVATE>
: convert-defmacro ( cons -- quot ) : convert-defmacro ( cons -- quot )
cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ; cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ;
: macro-expand ( cons -- quot )
uncons [ list>seq >quotation ] [ lookup-macro call ] bi* call call convert-form ;
: form-dispatch ( cons lisp-symbol -- quot ) : form-dispatch ( cons lisp-symbol -- quot )
name>> name>>
{ { "lambda" [ convert-lambda ] } { { "lambda" [ convert-lambda ] }
@ -89,9 +91,6 @@ PRIVATE>
[ 1quotation ] [ 1quotation ]
} cond ; } cond ;
: macro-expand ( cons -- quot )
uncons [ list>seq >quotation ] [ lookup-macro ] bi* call convert-form call ;
: lisp-string>factor ( str -- quot ) : lisp-string>factor ( str -- quot )
lisp-expr compile-form ; lisp-expr compile-form ;
@ -117,10 +116,10 @@ M: no-such-var summary drop "No such variable" ;
over name>> lisp-define ; over name>> lisp-define ;
: lisp-get ( name -- word ) : lisp-get ( name -- word )
dup lisp-env get at [ ] [ no-such-var ] ?if ; lisp-env get at ;
: lookup-var ( lisp-symbol -- quot ) : lookup-var ( lisp-symbol -- quot )
name>> lisp-get ; [ name>> ] [ lisp-var? ] bi [ lisp-get ] [ no-such-var ] if ;
: lisp-var? ( lisp-symbol -- ? ) : lisp-var? ( lisp-symbol -- ? )
dup lisp-symbol? [ name>> lisp-env get key? ] [ drop f ] if ; dup lisp-symbol? [ name>> lisp-env get key? ] [ drop f ] if ;