All occurrences of 'while' and other looping macros have been purged from the codebas...

diff --git a/source/lexer.scm b/source/lexer.scm
index c4d1fe82c50ed2ccfd2fdd82f1ee27c01ddc0a85..7c616db1c0dd16a322f7611b7be4c96f3790eb3c 100644 (file)
--- a/source/lexer.scm
+++ b/source/lexer.scm
@@ -1,7 +1,4 @@
-(include "loop.scm")
-(declare (unit lexer)
-         (uses parse-utils)
-         (uses buf))
+(declare (unit lexer) (uses parse-utils))
 
 (define (dlang/lexer input)
   (buf (buf input read-char) dlang/tokenize))
@@ -55,17 +52,21 @@
     tok))
 
 (define (dlang/whitespace in)
-  (while (char-whitespace? (buf-lookahead! in 1))
-    (buf-consume! in))
+  (consume-all in dlang/whitespace?)
   (dlang/tokenize in))
 
+(define (dlang/whitespace? in)
+  (char-whitespace? (buf-lookahead! in 1)))
+
 (define (dlang/comment in)
   (char-match in #\#)
-  (while (and (not (char=? (buf-lookahead! in 1) #\newline))
-              (not (eof-object? (buf-lookahead! in 1))))
-    (buf-consume! in))
+  (consume-all in dlang/comment?)
   (dlang/tokenize in))
 
+(define (dlang/comment? in)
+  (and (not (char=? (buf-lookahead! in 1) #\newline))
+       (not (eof-object? (buf-lookahead! in 1)))))
+
 (define (dlang/number in)
   (token 'number
     (string-append
@@ -79,14 +80,14 @@
         (dlang/exponent in) ""))))
 
 (define (dlang/integer in)
-  (define text "")
   (if (and
         (not (eof-object? (buf-lookahead! in 1)))
         (char-numeric? (buf-lookahead! in 1)))
-    (while (char-numeric? (buf-lookahead! in 1))
-      (set! text (string-append text (string (buf-consume! in)))))
-    (abort "Expected an integer"))
-  text)
+    (collect-char in dlang/integer? "")
+    (abort "Expected an integer")))
+
+(define (dlang/integer? in)
+  (char-numeric? (buf-lookahead! in 1)))
 
 (define (dlang/decimal in)
   (string-append
@@ -95,7 +96,6 @@
 
 (define (dlang/exponent in)
   (string-append
-    ;(string (char-match-one-of in "eE"))
     (string
       (if (char=? (buf-lookahead! in 1) #\e)
         (char-match in #\e) (char-match in #\E)))
@@ -113,10 +113,11 @@
       (string (char-match in #\')) )))
 
 (define (dlang/string in)
-  (define text (string (char-match in #\")))
-  (while (dlang/string-char? in)
-    (set! text (string-append text (string (buf-consume! in)))))
-  (set! text (string-append text (string (char-match in #\"))))
+  (define text
+    (string-append
+      (string (char-match in #\"))
+      (collect-char in dlang/string-char? "")
+      (string (char-match in #\"))))
   (token 'string text))
 
 (define (dlang/string-char? in)
@@ -132,11 +133,9 @@
       (token-text (dlang/id in)))))
 
 (define (dlang/id in)
-  (define acc "")
-  (while (dlang/id-char? in)
-    (set! acc (string-append acc (string (buf-consume! in)))))
-  (if (> (string-length acc) 0)
-    (token 'id acc)
+  (define str(collect-char in dlang/id-char? ""))
+  (if (> (string-length str) 0)
+    (token 'id str)
     (abort "An Id was expected but none found.")))
 
 (define (dlang/id-char? in)

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 31318f6c10431a7e8293881181af069a23d21f06..7828996171e239737e2162a3d3177a4181c0c6dc 100644 (file)
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -76,3 +76,18 @@
           (lambda ()  (apply fn (append (list buf) args)))))))
   (buf-release! buf)
   (not (null? result)))
+
+(define (collect-char in fn str)
+  (if (fn in)
+    (collect-char in fn (string-append str (string (buf-consume! in))))
+    str))
+
+(define (consume-all in fn)
+  (when (fn in)
+    (buf-consume! in)
+    (consume-all in fn)))
+
+(define (collect in fn rulefn lst)
+  (if (fn in)
+    (collect in fn rulefn (append lst (list (rulefn in))))
+    lst))

diff --git a/source/parser.scm b/source/parser.scm
index 312130529ed882edc5223b132213c4aa532046d5..28252221f2126da9fce9cb0513ae214db8dbdded 100644 (file)
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -1,6 +1,4 @@
-(include "loop.scm")
-(declare (unit parser)
-         (uses buf))
+(declare (unit parser) (uses buf))
 
 ;------------------------------------------------------------------------------
 ; Formal EBNF Syntax:
@@ -29,10 +27,10 @@
 ;------------------------------------------------------------------------------
 
 (define (dlang/program in)
-  (define result '())
-  (while (not (eof-object? (buf-lookahead! in 1)))
-    (set! result (append result (list (dlang/expression in)))))
-  result)
+  (collect in dlang/has-expression? dlang/expression '()))
+
+(define (dlang/has-expression? in)
+  (not (eof-object? (buf-lookahead! in 1))))
 
 (define (dlang/expression in)
   (if (dlang/core-form? in)
@@ -144,44 +142,41 @@
 
 (define (dlang/arg-list in)
   (define tree (syntree 'arglist "" '()))
-  (define chldrn '())
   (token-match in 'lpar)
-  (if (not (token-matches? in 'rpar))
-    (begin
-      (set! chldrn
-        (append chldrn (list (dlang/expression in))))
-      (while (not (token-matches? in 'rpar))
-        (token-match in 'comma)
-        (set! chldrn
-          (append chldrn (list (dlang/expression in)))))))
+  (syntree-children-set! tree
+    (collect in dlang/list-end? dlang/arg-list-item '()))
   (token-match in 'rpar)
-  (syntree-children-set! tree chldrn)
   tree)
 
+(define (dlang/arg-list-item in)
+  (define itm (dlang/expression in))
+  (if (dlang/list-end? in) (token-match in 'comma))
+  itm)
+
 (define (dlang/arg-list? in)
   (test-apply dlang/arg-list in))
 
 (define (dlang/id-list in)
   (define tree (syntree 'args "" '()))
-  (define chldrn '())
   (token-match in 'lpar)
-  (if (not (token-matches? in 'rpar))
-    (begin
-      (set! chldrn
-        (append chldrn (list (token->syntree (token-match in 'id)))))
-      (while (not (token-matches? in 'rpar))
-        (token-match in 'comma)
-        (set! chldrn
-          (append chldrn (list (token->syntree (token-match in 'id))))))))
+  (syntree-children-set! tree
+    (collect in dlang/list-end? dlang/id-list-item '()))
   (token-match in 'rpar)
-  (syntree-children-set! tree chldrn)
   tree)
 
+(define (dlang/id-list-item in)
+  (define itm (token->syntree (token-match in 'id)))
+  (if (dlang/list-end? in) (token-match in 'comma))
+  itm)
+
+(define (dlang/list-end? in)
+  (not (token-matches? in 'rpar)))
+
 (define (dlang/expr-block in term)
-  (define tree (syntree 'block "" '()))
-  (define chldrn '())
-  (while (not (token-matches? in term))
-    (set! chldrn (append chldrn (list (dlang/expression in)))))
-  (syntree-children-set! tree chldrn)
-  tree)
+  (syntree 'block ""
+    (collect
+      in
+      (lambda (buf) (not (token-matches? buf term)))
+      dlang/expression
+      '() )))