From 27586218e82c904b7edb782f73ab936e76c17a08 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Sun, 1 Jun 2008 18:50:22 -0400
Subject: [PATCH] Replacing s-exp tuple with cons cells in parser, updating
 tests

---
 extra/lisp/parser/parser-tests.factor | 45 ++++++++++++++++++++-------
 extra/lisp/parser/parser.factor       | 23 +++++++++-----
 2 files changed, 49 insertions(+), 19 deletions(-)

diff --git a/extra/lisp/parser/parser-tests.factor b/extra/lisp/parser/parser-tests.factor
index 98a6d2a6ba..712a1f9b9e 100644
--- a/extra/lisp/parser/parser-tests.factor
+++ b/extra/lisp/parser/parser-tests.factor
@@ -9,38 +9,61 @@ IN: lisp.parser.tests
 ] unit-test
 
 { -42  }  [
-  "-42" "atom" \ lisp-expr rule parse parse-result-ast
+    "-42" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { 37/52 } [
-  "37/52" "atom" \ lisp-expr rule parse parse-result-ast
+    "37/52" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { 123.98 } [
-  "123.98" "atom" \ lisp-expr rule parse parse-result-ast
+    "123.98" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { "" } [
-  "\"\"" "atom" \ lisp-expr rule parse parse-result-ast
+    "\"\"" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { "aoeu" } [
-  "\"aoeu\"" "atom" \ lisp-expr rule parse parse-result-ast
+    "\"aoeu\"" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { "aoeu\"de" } [
-  "\"aoeu\\\"de\"" "atom" \ lisp-expr rule parse parse-result-ast
+    "\"aoeu\\\"de\"" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { T{ lisp-symbol f "foobar" } } [
-  "foobar" "atom" \ lisp-expr rule parse parse-result-ast
+    "foobar" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
 { T{ lisp-symbol f "+" } } [
-  "+" "atom" \ lisp-expr rule parse parse-result-ast
+    "+" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
-{ T{ s-exp f
-     V{ T{ lisp-symbol f "foo" } 1 2 "aoeu" } } } [
-  "(foo 1 2 \"aoeu\")" lisp-expr parse-result-ast
+{ T{ cons f f f }
+} [
+    "()" lisp-expr parse-result-ast
+] unit-test
+
+{ T{
+    cons
+    f
+    T{ lisp-symbol f "foo" }
+    T{
+        cons
+        f
+        1
+        T{ cons f 2 T{ cons f "aoeu" T{ cons f f f } } }
+    } } } [
+    "(foo 1 2 \"aoeu\")" lisp-expr parse-result-ast
+] unit-test
+
+{ T{ cons f
+       1
+       T{ cons f
+           T{ cons f 3 T{ cons f 4 T{ cons f f f } } }
+           T{ cons f 2 T{ cons f f } } }
+   }
+} [
+    "(1 (3 4) 2)" lisp-expr parse-result-ast
 ] unit-test
\ No newline at end of file
diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor
index cf5ff56331..dad6a7dc24 100644
--- a/extra/lisp/parser/parser.factor
+++ b/extra/lisp/parser/parser.factor
@@ -1,16 +1,22 @@
 ! 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 math ;
+USING: kernel peg peg.ebnf peg.expr math.parser sequences arrays strings
+combinators.lib math fry accessors ;
 
 IN: lisp.parser
 
 TUPLE: lisp-symbol name ;
 C: <lisp-symbol> lisp-symbol
 
-TUPLE: s-exp body ;
-C: <s-exp> s-exp
+TUPLE: cons car cdr ;
+: cons \ cons new ;
 
+: <car> ( x -- cons )
+    cons swap >>car ;
+
+: seq>cons ( seq -- cons )
+    <reversed> cons [ <car> swap >>cdr ] reduce ;
+    
 EBNF: lisp-expr
 _            = (" " | "\t" | "\n")*
 LPAREN       = "("
@@ -24,8 +30,9 @@ rational     = integer "/" (digit)+                      => [[ first3 nip string
 number       = float
               | rational
               | integer
-id-specials  = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<" | "#"
-              | " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
+id-specials  = "!" | "$" | "%" | "&" | "*" | "/" | ":"
+              | "<" | "#" | " =" | ">" | "?" | "^" | "_"
+              | "~" | "+" | "-" | "." | "@"
 letters      = [a-zA-Z]                                  => [[ 1array >string ]]
 initials     = letters | id-specials
 numbers      = [0-9]                                     => [[ 1array >string ]]
@@ -36,6 +43,6 @@ string       = dquote ( escaped | !(dquote) . )*  dquote => [[ second >string ]]
 atom         = number
               | identifier
               | string
-list-item    = _ (atom|s-expression) _                   => [[ second ]]
-s-expression = LPAREN (list-item)* RPAREN                => [[ second <s-exp> ]]
+list-item    = _ ( atom | s-expression ) _               => [[ second ]]
+s-expression = LPAREN (list-item)* RPAREN                => [[ second seq>cons ]]
 ;EBNF
\ No newline at end of file