From 0c10c13e4d315f70ca72cce99ca7d3ff8e0b6b22 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Sat, 26 Apr 2008 17:20:12 -0400
Subject: [PATCH] Bug fixes
---
extra/lisp/lisp.factor | 66 +++++++++++++-----------------------------
1 file changed, 20 insertions(+), 46 deletions(-)
diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index 624f190fb1..729c136a95 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -1,53 +1,24 @@
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings combinators.lib
-namespaces combinators math bake locals.private accessors vectors syntax ;
+USING: kernel peg sequences arrays strings combinators.lib
+namespaces combinators math bake locals.private accessors vectors syntax lisp.parser ;
IN: lisp
-TUPLE: lisp-symbol name ;
-
-C: <lisp-symbol> lisp-symbol
-
-EBNF: lisp-expr
-_ = (" " | "\t" | "\n")*
-LPAREN = "("
-RPAREN = ")"
-dquote = '"'
-digit = [0-9]
-integer = (digit)+ => [[ string>number ]]
-float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] dipd 3append string>number ]]
-number = float
- | integer
-id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<"
- | " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
-letters = [a-zA-Z] => [[ 1array >string ]]
-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
-
DEFER: convert-form
-: convert-body ( lisp-form -- quot )
+: convert-body ( s-exp -- quot )
[ convert-form ] map [ ] [ compose ] reduce ; inline
-: convert-if ( lisp-form -- quot )
+: convert-if ( s-exp -- quot )
1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ;
-: convert-begin ( lisp-form -- quot )
+: convert-begin ( s-exp -- quot )
1 tail convert-body ;
-: convert-cond ( lisp-form -- quot )
+: convert-cond ( s-exp -- quot )
1 tail [ [ convert-body map ] map ] [ % cond ] bake ;
-: convert-general-form ( lisp-form -- quot )
+: convert-general-form ( s-exp -- quot )
unclip swap convert-body [ % , ] bake ;
<PRIVATE
@@ -56,20 +27,23 @@ DEFER: convert-form
[ dup vector? [ localize-body ] [ nip ] if ] if ] with map ; inline
PRIVATE>
-: convert-lambda ( lisp-form -- quot )
+: convert-lambda ( s-exp -- 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 )
-dup first dup lisp-symbol? [ name>>
- { { "lambda" [ convert-lambda ] }
- { "if" [ convert-if ] }
- { "begin" [ convert-begin ] }
- { "cond" [ convert-cond ] }
- [ drop convert-general-form ]
- } case ] [ drop convert-general-form ] if ;
+: convert-list-form ( s-exp -- quot )
+ dup first dup lisp-symbol? [ name>>
+ { { "lambda" [ convert-lambda ] }
+ { "if" [ convert-if ] }
+ { "begin" [ convert-begin ] }
+ { "cond" [ convert-cond ] }
+ [ drop convert-general-form ]
+ } case ] [ drop convert-general-form ] if ;
: convert-form ( lisp-form -- quot )
{ { [ dup vector? ] [ convert-list-form ] }
[ [ , ] [ ] make ]
- } cond ;
\ No newline at end of file
+ } cond ;
+
+: lisp-string>factor ( str -- quot )
+ lisp-expr parse-result-ast convert-form ;
\ No newline at end of file