From e4d3b79c3d6401b85bc415bce0cd1d22ef108bdf Mon Sep 17 00:00:00 2001
From: "Michael D. Lowis" <mike@mdlowis.com>
Date: Thu, 12 Jul 2012 01:29:58 -0400
Subject: [PATCH] Rough draft of dlang parser implemented. 0 unit tests for now

---
 source/parser.scm | 54 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 50 insertions(+), 4 deletions(-)

diff --git a/source/parser.scm b/source/parser.scm
index 7af96ee..bdcd7a0 100644
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -20,11 +20,57 @@
 
 (define (dlang/core-form in) '())
 
-(define (dlang/basic-expr in) '())
+(define (dlang/basic-expr in)
+  (if (buf-lookahead! in 1)
+    (dlang/operator-app in)
+    (dlang/literal in)))
 
-(define (dlang/literal in) '())
+(define (dlang/operator-app in)
+  (define tree (syntree 'apply "" '()))
+  (define parts '())
+  (define op '())
+  (token-match in 'lpar)
+  (set! parts (cons (dlang/expression in)))
+  (set! parts (cons (dlang/operator in)))
+  (set! parts (append parts (list (dlang/expression in))))
+  (token-match in 'rpar)
+  (syntree-children-set! tree parts)
+  tree)
 
-(define (dlang/expr-list in) '())
+(define (dlang/operator in)
+  (define tok (buf-lookahead! in 1))
+  (if (equal? 'id (token-type tok))
+    (syntree (token-type tok) (token-text tok) '())
+    (error "Expected an Id or operator.")))
 
-(define (dlang/id-list in) '())
+(define (dlang/literal in)
+  (define tok (buf-lookahead! in 1))
+  (if (or (equal? 'id tok)
+          (equal? 'character tok)
+          (equal? 'string tok)
+          (equal? 'symbol tok)
+          (equal? 'number tok))
+    (set! tok (buf-consume! in))
+    (error "Expected a literal"))
+  (syntree (token-type tok) (token-text tok) '()))
+
+(define (dlang/expr-list in term)
+  (define tree (syntree 'list "" '()))
+  (define chldrn '())
+  (while (equal? term (token-type (buf-lookahead! in 1)))
+    (set! chldrn (append chldrn (list (dlang/expression in)))))
+  (syntree-children-set! tree chldrn)
+  tree)
+
+(define (dlang/id-list in)
+  (define tree (syntree 'list "" '()))
+  (define chldrn '())
+  (token-match in 'lpar)
+  (while (equal? 'id (token-type (buf-lookahead! in 1)))
+    (define tok (buf-consume! in))
+    (set! tok (syntree (token-type tok) (token-text tok) '()))
+    (set! chldrn (append chldrn (list tok))))
+  (token-match in 'rpar)
+  (syntree-children-set! tree chldrn)
+  tree)
 
-- 
2.52.0