Rough draft of dlang parser implemented. 0 unit tests for now

diff --git a/source/parser.scm b/source/parser.scm
index 7af96ee3ab7693f273e5a56bccb8d8b07d976b72..bdcd7a0050fda1e956094dbad804656b4a931e30 100644 (file)
--- 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)