From: Mike D. Lowis Date: Thu, 19 Jul 2012 18:54:53 +0000 (-0400) Subject: Added macro for checking exceptions and switched all rules to use the abort exception... X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=136f24c2409caf1a04a7cd748bcff021047d9910;p=archive%2Fdlang-scm.git Added macro for checking exceptions and switched all rules to use the abort exception raising function rather than the error function --- diff --git a/inc/test.scm b/inc/test.scm index 3ae1011..204706f 100644 --- a/inc/test.scm +++ b/inc/test.scm @@ -18,4 +18,13 @@ (set! error prev) (equal? expect result))))) +(define-syntax check-exception + (syntax-rules () + ((_ expect expr) + (equal? expect + (call/cc + (lambda (cont) + (with-exception-handler + (lambda (x) (cont x)) + (lambda () expr)))))))) diff --git a/source/lexer.scm b/source/lexer.scm index 1bdfeef..c1426c9 100644 --- a/source/lexer.scm +++ b/source/lexer.scm @@ -85,7 +85,7 @@ (char-numeric? (buf-lookahead! in 1))) (while (char-numeric? (buf-lookahead! in 1)) (set! text (string-append text (string (buf-consume! in))))) - (error "Expected an integer")) + (abort "Expected an integer")) text) (define (dlang/decimal in) @@ -108,7 +108,7 @@ (string-append (string (char-match in #\')) (if (eof-object? (buf-lookahead! in 1)) - (error "Unexpected EOF while parsing character literal") + (abort "Unexpected EOF while parsing character literal") (string (buf-consume! in))) (string (char-match in #\')) ))) @@ -130,11 +130,10 @@ (define (dlang/id in) (define acc "") (while (dlang/id-char? in) - (set! acc (string-append acc (string (buf-consume! in)))) - ) + (set! acc (string-append acc (string (buf-consume! in))))) (if (> (string-length acc) 0) (token 'id acc) - (error "An Id was expected but none found."))) + (abort "An Id was expected but none found."))) (define (dlang/id-char? in) (define ch (buf-lookahead! in 1)) diff --git a/source/parse-utils.scm b/source/parse-utils.scm index 4a7e60d..5b70533 100644 --- a/source/parse-utils.scm +++ b/source/parse-utils.scm @@ -25,10 +25,10 @@ (define (char-match buf expect) (define actual (buf-lookahead! buf 1)) (if (eof-object? actual) - (error (string-append "Expected '" (string expect) "', received EOF instead")) + (abort (string-append "Expected '" (string expect) "', received EOF instead")) (if (equal? expect actual) (buf-consume! buf) - (error + (abort (string-append "Expected '" (string expect) "', received '" (string actual) "' instead")))) actual) @@ -36,13 +36,13 @@ (define (token-match buf expect) (define actual (buf-lookahead! buf 1)) (if (eof-object? actual) - (error + (abort (string-append "Expected a token of type '" (symbol->string expect) "," " received EOF instead")) (if (equal? expect (token-type actual)) (buf-consume! buf) - (error + (abort (string-append "Expected a token of type '" (symbol->string expect) "," " received '" (symbol->string (token-type actual)) " instead")))) @@ -58,10 +58,20 @@ (if (and (token-matches? buf 'id) (equal? expect (token-text actual))) (buf-consume! buf) - (error + (abort (string-append - "Expected '" expect "', received '" (token-text actual) "' instead")))) + "Expected '" expect "', received '" (token-text actual) "' instead")))) (define (token->syntree tok) (syntree (token-type tok) (token-text tok) '())) +(define (test-apply fn buf . args) + (define result '()) + (buf-mark! buf) + (call/cc + (lambda (cont) + (with-exception-handler + (lambda (x) (cont '())) + (lambda () (set! result (apply fn (append buf args))))))) + (buf-release! buf) + (not (null? result))) diff --git a/source/parser.scm b/source/parser.scm index 57e2405..be2aa55 100644 --- a/source/parser.scm +++ b/source/parser.scm @@ -37,13 +37,7 @@ (if (dlang/core-form? in) (dlang/core-form in) (let ((result (dlang/basic-expr in))) - (if (equal? 'lpar (buf-lookahead! in 1)) - (begin - (match in 'lpar) - (set! result - (syntree 'apply (list result (dlang/expr-list in)))) - (match in 'rpar))) - result))) + (if (dlang/arg-list? in) (dlang/arg-list? in result) result)))) (define (dlang/core-form in) (define tok (buf-lookahead! in 1)) @@ -105,7 +99,8 @@ (define (dlang/func in) (define node (syntree 'func "" '())) (keyword-match in "func") - (syntree-children-set! node (list (dlang/id-list in) (dlang/expr-block in 'term))) + (syntree-children-set! node + (list (dlang/id-list in) (dlang/expr-block in 'term))) (token-match in 'term) (syntree-type-set! node 'func) node) @@ -141,11 +136,14 @@ (equal? 'symbol type) (equal? 'number type)) (set! tok (buf-consume! in)) - (error "Expected a literal")) + (abort "Expected a literal")) (syntree (token-type tok) (token-text tok) '())) (define (dlang/arg-list in) '()) +(define (dlang/arg-list? in) + (test-apply dlang/arg-list in)) + (define (dlang/id-list in) (define tree (syntree 'args "" '())) (define chldrn '()) diff --git a/tests/test_lexer.scm b/tests/test_lexer.scm index 0144318..ac4d7d8 100644 --- a/tests/test_lexer.scm +++ b/tests/test_lexer.scm @@ -334,14 +334,14 @@ (call-with-input-string "abc" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected an integer" + (check-exception "Expected an integer" (dlang/integer buffer))))) (def-test "dlang/integer should error when EOF" (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected an integer" + (check-exception "Expected an integer" (dlang/integer buffer))))) ; dlang/decimal @@ -374,14 +374,14 @@ (call-with-input-string ". " (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected an integer" + (check-exception "Expected an integer" (dlang/decimal buffer))))) (def-test "dlang/decimal should error when EOF" (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected '.', received EOF instead" + (check-exception "Expected '.', received EOF instead" (dlang/decimal buffer))))) ; dlang/exponent @@ -430,14 +430,14 @@ (call-with-input-string "e " (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected an integer" + (check-exception "Expected an integer" (dlang/exponent buffer))))) (def-test "dlang/exponent should error when EOF" (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected 'E', received EOF instead" + (check-exception "Expected 'E', received EOF instead" (dlang/exponent buffer))))) ; dlang/character @@ -455,21 +455,21 @@ (call-with-input-string "a'" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected ''', received 'a' instead" + (check-exception "Expected ''', received 'a' instead" (dlang/character buffer))))) (def-test "dlang/character should error when missing second single quote" (call-with-input-string "'a" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected ''', received EOF instead" + (check-exception "Expected ''', received EOF instead" (dlang/character buffer))))) (def-test "dlang/character should error when EOF reached" (call-with-input-string "'" (lambda (input) (define buffer (buf input read-char)) - (check-error "Unexpected EOF while parsing character literal" + (check-exception "Unexpected EOF while parsing character literal" (dlang/character buffer))))) ; dlang/string @@ -514,21 +514,21 @@ (call-with-input-string "a\"" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected '\"', received 'a' instead" + (check-exception "Expected '\"', received 'a' instead" (dlang/string buffer))))) (def-test "dlang/string should error when missing second double quote" (call-with-input-string "\"a" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected '\"', received EOF instead" + (check-exception "Expected '\"', received EOF instead" (dlang/string buffer))))) (def-test "dlang/string should error when EOF reached" (call-with-input-string "\"" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected '\"', received EOF instead" + (check-exception "Expected '\"', received EOF instead" (dlang/string buffer))))) ; dlang/symbol @@ -582,14 +582,14 @@ (call-with-input-string "$" (lambda (input) (define buffer (buf input read-char)) - (check-error "An Id was expected but none found." + (check-exception "An Id was expected but none found." (dlang/symbol buffer))))) (def-test "dlang/symbol should error when EOF" (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (check-error "Expected '$', received EOF instead" + (check-exception "Expected '$', received EOF instead" (dlang/symbol buffer))))) ; dlang/id @@ -643,7 +643,7 @@ (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (check-error "An Id was expected but none found." + (check-exception "An Id was expected but none found." (dlang/id buffer))))) (def-test "dlang/id should stop recognition when comment encountered" diff --git a/tests/test_parser.scm b/tests/test_parser.scm index f8ad857..0bb8f26 100644 --- a/tests/test_parser.scm +++ b/tests/test_parser.scm @@ -303,14 +303,14 @@ (call-with-input-string "1.0" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'id, received 'number instead" + (check-exception "Expected a token of type 'id, received 'number instead" (dlang/operator lxr))))) (def-test "dlang/operator should error if EOF" (call-with-input-string "" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'id, received EOF instead" + (check-exception "Expected a token of type 'id, received EOF instead" (dlang/operator lxr))))) ; dlang/literal @@ -354,14 +354,14 @@ (call-with-input-string "(" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a literal" + (check-exception "Expected a literal" (dlang/literal lxr))))) (def-test "dlang/literal should error when EOF" (call-with-input-string "" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a literal" + (check-exception "Expected a literal" (dlang/literal lxr))))) ; dlang/arg-list @@ -412,31 +412,56 @@ (call-with-input-string "(1.0)" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'id, received 'number instead" + (check-exception "Expected a token of type 'id, received 'number instead" (dlang/id-list lxr))))) (def-test "dlang/id-list should error when no comma in between ids" (call-with-input-string "(a b)" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'comma, received 'id instead" + (check-exception "Expected a token of type 'comma, received 'id instead" (dlang/id-list lxr))))) (def-test "dlang/id-list should error when left paren missing" (call-with-input-string ")" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'lpar, received 'rpar instead" + (check-exception "Expected a token of type 'lpar, received 'rpar instead" (dlang/id-list lxr))))) (def-test "dlang/id-list should error when right paren missing" (call-with-input-string "(" (lambda (input) (define lxr (make-lexer input)) - (check-error "Expected a token of type 'id, received EOF instead" + (check-exception "Expected a token of type 'id, received EOF instead" (dlang/id-list lxr))))) ; dlang/expr-block ;------------------------------------------------------------------------------ +(def-test "dlang/expr-block should parse a block of 0 expressions" + (call-with-input-string ";" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result (syntree 'block "" '()))))) +(def-test "dlang/expr-block should parse a block of 1 expression" + (call-with-input-string "1.0;" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result + (syntree 'block "" + (list + (syntree 'number "1.0" '()))))))) +(def-test "dlang/expr-block should parse a block of 2 expressions" + (call-with-input-string "1.0 2.0;" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result + (syntree 'block "" + (list + (syntree 'number "1.0" '()) + (syntree 'number "2.0" '())))))))