From b1bd228cb5c73be4988f4b1f261a2e9719074b32 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Mon, 21 Apr 2008 20:25:55 -0400
Subject: [PATCH] if-conversion working

---
 extra/lisp/lisp.factor | 51 +++++++++++++++++++++++++++++++++---------
 1 file changed, 41 insertions(+), 10 deletions(-)

diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index 3dba8cfb1d..b2cb975f47 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -1,16 +1,47 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel peg.ebnf peg.expr math.parser sequences arrays ;
+USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings combinators.lib
+namespaces combinators math ;
 IN: lisp
 
+TUPLE: lisp-symbol name ;
+
+C: <symbol> lisp-symbol
+
 EBNF: lisp-expr
-digit      = [0-9]                     => [[ digit> ]]
-integer    = (digit)+                  => [[ 10 digits>integer ]]
-float      = (digit)+ "." (digit)*     => [[ 3 head 3append string>number ]]
-number     = integer
-             | float
-identifier = [a-zA-Z] ([a-zA-Z0-9])*
+_          = (" " | "\t" | "\n")*
+LPAREN     = "("
+RPAREN     = ")"
+digit      = [0-9]
+integer    = (digit)+                   => [[ string>number ]]
+float      = (digit)+ "." (digit)*      => [[ first3 >string [ >string ] 2 ndip 3append string>number ]]
+number     = float
+             | integer
+identifier = [a-zA-Z] ([^(){} ])*       => [[ [ 1 head ] [ second ] bi append >string <symbol> ]]
 atom       = number
-             | identifier          
-list       = "(" (atom|list)* ")"      =>  [[ second 1array ]]
-;EBNF
\ No newline at end of file
+             | identifier
+list-item  = _ (atom|list) _            => [[ second ]]
+list       = LPAREN (list-item)* RPAREN => [[ second ]]
+;EBNF
+  
+DEFER: convert-form
+
+: convert-body ( lisp-form -- quot )
+  [ convert-form ] map [ ] [ compose ] reduce ; inline
+  
+: convert-if ( lisp-form -- quot )
+  1 tail [ convert-form ] map reverse first3  [ % , , \ if , ] [ ] make ;
+  
+: convert-general-form ( lisp-form -- quot )  
+  unclip swap convert-body [ % , ] [ ] make ;
+
+: convert-list-form ( lisp-form -- quot )  
+dup first
+  { { [ dup "if" <symbol> equal? ] [ convert-if ] }
+   [ drop convert-general-form ]
+  } cond ;
+  
+: convert-form ( lisp-form -- quot )
+  { { [ dup [ sequence? ] [ number? not ] bi and ] [ convert-list-form ] }
+   [ [ , ] [ ] make ]
+  } cond ;
\ No newline at end of file