From f64837ab210c06e9dc814823317b7a1553019865 Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Wed, 25 Jul 2012 11:31:59 -0400 Subject: [PATCH] All occurrences of 'while' and other looping macros have been purged from the codebase. all tests still pass --- source/lexer.scm | 47 ++++++++++++++++---------------- source/parse-utils.scm | 15 +++++++++++ source/parser.scm | 61 +++++++++++++++++++----------------------- 3 files changed, 66 insertions(+), 57 deletions(-) diff --git a/source/lexer.scm b/source/lexer.scm index c4d1fe8..7c616db 100644 --- 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 31318f6..7828996 100644 --- 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 3121305..2825222 100644 --- 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 + '() ))) -- 2.52.0