Add parser and ast generation for trivial programs

4 files changed, 65 insertions, 14 deletions

diff --git a/src/gscc b/src/gscc
index 82ed649..c5ddbd3 100755
--- a/src/gscc
+++ b/src/gscc
@@ -4,7 +4,8 @@
 
 
 (use-modules (ice-9 getopt-long)
-	     (modules lexer lexer))
+	     (modules lexer lexer)
+	     (modules parser parser))
 
 
 (define version "v0.1")
@@ -36,8 +37,8 @@ file on a success."
   (let* ((port (open-input-file file))
 	 (tokens (begin (set-current-input-port port)
 			(read-tokens))))
-    ;; (when parse?
-    ;;   )
+    (when parse?
+      (p-program tokens))
     (close-input-port port)))
 
 (define (postprocess file dest)
diff --git a/src/modules/lexer/lexer.scm b/src/modules/lexer/lexer.scm
index dae7107..e6d96df 100644
--- a/src/modules/lexer/lexer.scm
+++ b/src/modules/lexer/lexer.scm
@@ -18,15 +18,15 @@ current input port."
      ((char-whitespace? chr)
       (read-token))
 
-      ((eq? chr #\()
+      ((eqv? chr #\()
        'left-paren)
-      ((eq? chr #\))
+      ((eqv? chr #\))
        'right-paren)
-      ((eq? chr #\{)
+      ((eqv? chr #\{)
        'open-brace)
-      ((eq? chr #\})
+      ((eqv? chr #\})
        'close-brace)
-      ((eq? chr #\;)
+      ((eqv? chr #\;)
        'semi-colon)
 
       ((char-alphabetic? chr)
@@ -53,7 +53,7 @@ current input port."
       (cond ((and (not (eof-object? chr))
 	      (or (char-alphabetic? chr)
 		  (char-numeric? chr)
-		  (eq? chr #\_)))
+		  (eqv? chr #\_)))
 	     (read-identifier-helper (cons (read-char) chrs-so-far)))
 	    (#t (reverse chrs-so-far)))))
   (list->string (read-identifier-helper (list chr))))
diff --git a/src/modules/parser/parser.scm b/src/modules/parser/parser.scm
index b2ca12f..e70a825 100644
--- a/src/modules/parser/parser.scm
+++ b/src/modules/parser/parser.scm
@@ -1 +1,34 @@
-(define-module (modules parser parser))
+(define-module (modules parser parser)
+  #:use-module (ice-9 match)
+  #:export (p-program))
+
+
+(define (die)
+  (error "syntax error"))
+
+
+(define (p-program tokens)
+  (match tokens
+    ((func ...)
+     `(program ,(p-function func)))
+    (_ (die))))
+
+(define (p-function tokens)
+  (match tokens
+    (('int (? string? id) 'left-paren 'void 'right-paren 'open-brace stmt ... 'close-brace)
+     `(function (identifier ,id) ,(p-statement stmt)))
+    (_ (die))))
+
+(define (p-statement tokens)
+  (match tokens
+    (`(return ,expr semi-colon)
+     `(return ,(p-exp (list expr))))
+    (_ (die))))
+
+(define (p-exp tokens)
+  "Matches any list containing a single number,
+"
+  (match tokens
+    (((? number? const))
+     `(constant ,const))
+    (_ (die))))
diff --git a/src/unit-tests/parser/parser-test.scm b/src/unit-tests/parser/parser-test.scm
index d099329..8baedda 100644
--- a/src/unit-tests/parser/parser-test.scm
+++ b/src/unit-tests/parser/parser-test.scm
@@ -3,9 +3,26 @@
              (modules parser parser))
 
 
-(test-begin "lexer-harness")
+(test-begin "parser-harness")
 
-(test-equal "hi"
-  "hi")
 
-(test-end "lexer-harness")
+
+(test-equal "trivial function main 2"
+  '(program (function (identifier "main") (return (constant 2))))
+  (p-program '(int "main" left-paren void right-paren open-brace return 2 semi-colon close-brace)))
+
+(test-equal "trivial function foo 4"
+  '(program (function (identifier "foo") (return (constant 4))))
+  (p-program '(int "foo" left-paren void right-paren open-brace return 4 semi-colon close-brace)))
+
+(test-error "trivial function bad double return"
+	    (p-program '(int "foo" left-paren void right-paren open-brace return return 4 semi-colon close-brace)))
+
+(test-error "trivial function bad parens"
+	    (p-program '(int "foo" right-paren void left-paren open-brace return return 4 semi-colon close-brace)))
+
+(test-error "trivial function bad int parameter"
+	    (p-program '(int "foo" right-paren int left-paren open-brace return return 4 semi-colon close-brace)))
+
+
+(test-end "parser-harness")