Adding lambda conversion and strings
parent
1069db6d05
commit
ec79b7823f
|
@ -1,29 +1,38 @@
|
||||||
! 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
|
||||||
|
|
||||||
: convert-body ( lisp-form -- quot )
|
: convert-body ( lisp-form -- quot )
|
||||||
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue