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

Adding lambda conversion and strings

db4
James Cash 2008-04-24 16:35:42 -04:00
parent 1069db6d05
commit ec79b7823f
1 changed files with 46 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
extra/lisp/lisp.factor
View File

@ -1,27 +1,36 @@
! Copyright (C) 2008 James Cash ! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings combinators.lib USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings combinators.lib
namespaces combinators math bake ; namespaces combinators math bake locals.private accessors vectors syntax ;
IN: lisp IN: lisp
TUPLE: lisp-symbol name ; TUPLE: lisp-symbol name ;
C: <symbol> lisp-symbol C: <lisp-symbol> lisp-symbol
EBNF: lisp-expr EBNF: lisp-expr
_ = (" " | "\t" | "\n")* _ = (" " | "\t" | "\n")*
LPAREN = "(" LPAREN = "("
RPAREN = ")" RPAREN = ")"
digit = [0-9] dquote = '"'
integer = (digit)+ => [[ string>number ]] digit = [0-9]
float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] 2 ndip 3append string>number ]] integer = (digit)+ => [[ string>number ]]
number = float float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] dipd 3append string>number ]]
| integer number = float
identifier = [a-zA-Z] ([^(){} ])* => [[ [ 1 head ] [ second ] bi append >string <symbol> ]] | integer
atom = number id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<"
| identifier | " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
list-item = _ (atom|list) _ => [[ second ]] letters = [a-zA-Z] => [[ 1array >string ]]
list = LPAREN (list-item)* RPAREN => [[ second ]] initials = letters | id-specials
numbers = [0-9] => [[ 1array >string ]]
subsequents = initials | numbers
identifier = initials (subsequents)* => [[ first2 concat append <lisp-symbol> ]]
string = dquote ("\" . | !(dquote) . )* dquote => [[ second >string ]]
atom = number
| identifier
| string
list-item = _ (atom|list) _ => [[ second ]]
list = LPAREN (list-item)* RPAREN => [[ second ]]
;EBNF ;EBNF
DEFER: convert-form DEFER: convert-form
@ -32,12 +41,31 @@ DEFER: convert-form
: convert-if ( lisp-form -- quot ) : convert-if ( lisp-form -- quot )
1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ;
: convert-begin ( lisp-form -- quot )
1 tail convert-body ;
: convert-cond ( lisp-form -- quot )
1 tail [ [ convert-body map ] map ] [ % cond ] bake ;
: convert-general-form ( lisp-form -- quot ) : convert-general-form ( lisp-form -- quot )
unclip swap convert-body [ % , ] bake ; unclip swap convert-body [ % , ] bake ;
<PRIVATE
: localize-body ( vars body -- newbody )
[ dup lisp-symbol? [ tuck name>> swap member? [ name>> make-local ] [ ] if ]
[ dup vector? [ localize-body ] [ nip ] if ] if ] with map ; inline
PRIVATE>
: convert-lambda ( lisp-form -- quot )
1 tail unclip reverse [ name>> ] map dup make-locals dup push-locals
[ swap localize-body convert-body ] dipd pop-locals swap <lambda> ;
: convert-list-form ( lisp-form -- quot ) : convert-list-form ( lisp-form -- quot )
dup first dup first
{ { [ dup "if" <symbol> equal? ] [ drop convert-if ] } { { [ dup "if" <lisp-symbol> equal? ] [ drop convert-if ] }
{ [ dup "begin" <lisp-symbol> equal? ] [ drop convert-begin ] }
{ [ dup "cond" <lisp-symbol> equal? ] [ drop convert-cond ] }
{ [ dup "lambda" <lisp-symbol> equal? ] [ drop convert-lambda ] }
[ drop convert-general-form ] [ drop convert-general-form ]
} cond ; } cond ;