Merge branch 'master' of git://factorcode.org/git/jamesnvc
Slava Pestov
commit
9061a0a18c
|
|
@ -0,0 +1,15 @@
|
|||
IN: lisp
|
||||
USING: help.markup help.syntax ;
|
||||
|
||||
ARTICLE: "lisp" "Lisp in Factor"
|
||||
"This is a simple implementation of a Lisp dialect, which somewhat resembles Scheme." $nl
|
||||
"It works in two main stages: "
|
||||
{ $list
|
||||
{ "Parse (via " { $vocab-link "lisp.parser" } " the Lisp code into a "
|
||||
{ $snippet "s-exp" } " tuple." }
|
||||
{ "Transform the " { $snippet "s-exp" } " into a Factor quotation, via " { $link convert-form } }
|
||||
}
|
||||
|
||||
{ $subsection "lisp.parser" } ;
|
||||
|
||||
ABOUT: "lisp"
|
||||
|
|
@ -6,14 +6,40 @@ IN: lisp.test
|
|||
|
||||
init-env
|
||||
|
||||
"+" [ first2 + ] lisp-define
|
||||
"#f" [ f ] lisp-define
|
||||
"#t" [ t ] lisp-define
|
||||
|
||||
{ [ first2 + ] } [
|
||||
"+" lisp-get
|
||||
"+" "math" "+" define-primitve
|
||||
"-" "math" "-" define-primitve
|
||||
|
||||
{ 5 } [
|
||||
[ 2 3 ] "+" <lisp-symbol> funcall
|
||||
] unit-test
|
||||
|
||||
{ 8.3 } [
|
||||
[ 10.4 2.1 ] "-" <lisp-symbol> funcall
|
||||
] unit-test
|
||||
|
||||
{ 3 } [
|
||||
[
|
||||
"((lambda (x y) (+ x y)) 1 2)" lisp-string>factor call
|
||||
] with-interactive-vocabs
|
||||
"((lambda (x y) (+ x y)) 1 2)" lisp-string>factor call
|
||||
] unit-test
|
||||
|
||||
{ 42 } [
|
||||
"((lambda (x y z) (+ x (- y z))) 40 3 1)" lisp-string>factor call
|
||||
] unit-test
|
||||
|
||||
{ 1 } [
|
||||
"(if #t 1 2)" lisp-string>factor call
|
||||
] unit-test
|
||||
|
||||
{ "b" } [
|
||||
"(cond (#f \"a\") (#t \"b\"))" lisp-string>factor call
|
||||
] unit-test
|
||||
|
||||
{ 5 } [
|
||||
"(begin (+ 1 4))" lisp-string>factor call
|
||||
] unit-test
|
||||
|
||||
{ 3 } [
|
||||
"((lambda (x) (if x (begin (+ 1 2)) (- 3 5))) #t)" lisp-string>factor call
|
||||
] unit-test
|
||||
|
|
@ -2,11 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel peg sequences arrays strings combinators.lib
|
||||
namespaces combinators math bake locals locals.private accessors
|
||||
vectors syntax lisp.parser assocs parser sequences.lib ;
|
||||
vectors syntax lisp.parser assocs parser sequences.lib words quotations ;
|
||||
IN: lisp
|
||||
|
||||
DEFER: convert-form
|
||||
DEFER: funcall
|
||||
DEFER: lookup-var
|
||||
|
||||
! Functions to convert s-exps to quotations
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
@ -17,14 +18,16 @@ DEFER: funcall
|
|||
rest [ convert-form ] map reverse first3 [ % , , if ] bake ;
|
||||
|
||||
: convert-begin ( s-exp -- quot )
|
||||
rest convert-form ;
|
||||
rest [ convert-form ] map >quotation [ , [ funcall ] each ] bake ;
|
||||
|
||||
: convert-cond ( s-exp -- quot )
|
||||
rest [ [ convert-form map ] map ] [ % cond ] bake ;
|
||||
rest [ body>> >array [ convert-form ] map first2 swap `{ [ % funcall ] , } bake ]
|
||||
map >array [ , cond ] bake ;
|
||||
|
||||
: convert-general-form ( s-exp -- quot )
|
||||
unclip convert-form swap convert-body [ , % funcall ] bake ;
|
||||
|
||||
|
||||
! words for convert-lambda
|
||||
<PRIVATE
|
||||
: localize-body ( assoc body -- assoc newbody )
|
||||
[ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ]
|
||||
|
|
@ -34,8 +37,6 @@ DEFER: funcall
|
|||
: localize-lambda ( body vars -- newbody newvars )
|
||||
make-locals dup push-locals swap
|
||||
[ swap localize-body <s-exp> convert-form swap pop-locals ] dip swap ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: split-lambda ( s-exp -- body vars )
|
||||
first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline
|
||||
|
|
@ -47,6 +48,7 @@ PRIVATE>
|
|||
|
||||
: normal-lambda ( body vars -- quot )
|
||||
localize-lambda <lambda> [ , compose ] bake ;
|
||||
PRIVATE>
|
||||
|
||||
: convert-lambda ( s-exp -- quot )
|
||||
split-lambda dup "&rest" swap member? [ rest-lambda ] [ normal-lambda ] if ;
|
||||
|
|
@ -67,8 +69,10 @@ PRIVATE>
|
|||
[ drop convert-general-form ] if ;
|
||||
|
||||
: convert-form ( lisp-form -- quot )
|
||||
dup s-exp? [ body>> convert-list-form ]
|
||||
[ [ , ] [ ] make ] if ;
|
||||
{ { [ dup s-exp? ] [ body>> convert-list-form ] }
|
||||
{ [ dup lisp-symbol? ] [ [ , lookup-var ] bake ] }
|
||||
[ [ , ] bake ]
|
||||
} cond ;
|
||||
|
||||
: lisp-string>factor ( str -- quot )
|
||||
lisp-expr parse-result-ast convert-form lambda-rewrite call ;
|
||||
|
|
@ -85,7 +89,13 @@ ERROR: no-such-var var ;
|
|||
swap lisp-env get set-at ;
|
||||
|
||||
: lisp-get ( name -- word )
|
||||
dup lisp-env get at [ ] [ no-such-var ] ?if ;
|
||||
dup lisp-env get at [ ] [ no-such-var throw ] ?if ;
|
||||
|
||||
: lookup-var ( lisp-symbol -- quot )
|
||||
name>> lisp-get ;
|
||||
|
||||
: funcall ( quot sym -- * )
|
||||
dup lisp-symbol? [ name>> lisp-get ] when call ; inline
|
||||
dup lisp-symbol? [ lookup-var ] when call ; inline
|
||||
|
||||
: define-primitve ( name vocab word -- )
|
||||
swap lookup [ [ , ] compose call ] bake lisp-define ;
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
IN: lisp.parser
|
||||
USING: help.markup help.syntax ;
|
||||
|
||||
ARTICLE: "lisp.parser" "Parsing strings of Lisp"
|
||||
"This vocab uses " { $vocab-link "peg.ebnf" } " to turn strings of Lisp into " { $snippet "s-exp" } "s, which are then used by"
|
||||
{ $vocab-link "lisp" } " to produce Factor quotations." ;
|
||||
|
|
@ -24,7 +24,7 @@ rational = integer "/" (digit)+ => [[ first3 nip string
|
|||
number = float
|
||||
| rational
|
||||
| integer
|
||||
id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<"
|
||||
id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<" | "#"
|
||||
| " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
|
||||
letters = [a-zA-Z] => [[ 1array >string ]]
|
||||
initials = letters | id-specials
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
A Lisp interpreter in Factor
|
||||
A Lisp interpreter/compiler in Factor
|
||||
|
|
|
|||
Loading…
Reference in New Issue