diff --git a/collects/parser-tools/examples/calc.ss b/collects/parser-tools/examples/calc.ss index 871ac3c..ba65091 100644 --- a/collects/parser-tools/examples/calc.ss +++ b/collects/parser-tools/examples/calc.ss @@ -4,7 +4,7 @@ ;; Import the parser and lexer generators. (require (lib "yacc.ss" "parser-tools") (lib "lex.ss" "parser-tools") - (lib "readerr.ss" "syntax")) + (prefix : (lib "lex-sre.ss" "parser-tools"))) (define-tokens value-tokens (NUM VAR FNCT)) (define-empty-tokens op-tokens (newline = OP CP + - * / ^ EOF NEG)) @@ -13,30 +13,29 @@ (define vars (make-hash-table)) (define-lex-abbrevs - (lower-letter (- "a" "z")) + (lower-letter (:/ "a" "z")) - (upper-letter (- #\A #\Z)) + (upper-letter (:/ #\A #\Z)) - ;; (- 0 9) would not work because the lexer does not understand numbers. (- #\0 #\9) is ok too. - (digit (- "0" "9"))) + ;; (:/ 0 9) would not work because the lexer does not understand numbers. (:/ #\0 #\9) is ok too. + (digit (:/ "0" "9"))) (define calcl (lexer [(eof) 'EOF] ;; recursively call the lexer on the remaining input after a tab or space. Returning the ;; result of that operation. This effectively skips all whitespace. - [(: #\tab #\space) (calcl input-port)] - ;; The parser will treat the return of 'newline the same as (token-newline) - [#\newline 'newline] - [(: "=" "+" "-" "*" "/" "^") (string->symbol lexeme)] + [(:or #\tab #\space) (calcl input-port)] + ;; (token-newline) returns 'newline + [#\newline (token-newline)] + ;; Since (token-=) returns '=, just return the symbol directly + [(:or "=" "+" "-" "*" "/" "^") (string->symbol lexeme)] ["(" 'OP] [")" 'CP] ["sin" (token-FNCT sin)] - [(+ (: lower-letter upper-letter)) (token-VAR (string->symbol lexeme))] - [(+ digit) (token-NUM (string->number lexeme))] - ;; Strings which dr/mzscheme does not think of as symbols (such as . or ,) must be - ;; entered as a string or character. "." would also be ok. - [(@ (+ digit) #\. (* digit)) (token-NUM (string->number lexeme))])) + [(:+ (:or lower-letter upper-letter)) (token-VAR (string->symbol lexeme))] + [(:+ digit) (token-NUM (string->number lexeme))] + [(:: (:+ digit) #\. (:* digit)) (token-NUM (string->number lexeme))])) (define calcp @@ -85,3 +84,5 @@ (printf "~a~n" result) (one-line))))))) (one-line))) + +(calc (open-input-string "(1 + 2 * 3 3) 3)\n(1.2 + 3.3) / 44 \n !")) diff --git a/collects/parser-tools/private-lex/token.ss b/collects/parser-tools/private-lex/token.ss index 9c8007b..ee917e4 100644 --- a/collects/parser-tools/private-lex/token.ss +++ b/collects/parser-tools/private-lex/token.ss @@ -16,7 +16,7 @@ ;; A token is either ;; - symbol ;; - (make-token symbol any) - (define-struct token (name value)) + (define-struct token (name value) (make-inspector)) ;; token-name*: token -> symbol (define (token-name* t) diff --git a/collects/parser-tools/yacc.ss b/collects/parser-tools/yacc.ss index 0ab4922..d36c0f8 100644 --- a/collects/parser-tools/yacc.ss +++ b/collects/parser-tools/yacc.ss @@ -207,7 +207,7 @@ (define (extract-no-src-pos ip) (extract-helper ip #f #f)) - (define-struct stack-frame (state value start-pos end-pos)) + (define-struct stack-frame (state value start-pos end-pos) (make-inspector)) (define (make-empty-stack i) (list (make-stack-frame i #f #f #f))) @@ -230,14 +230,14 @@ (let ((a (find-action stack tok val start-pos end-pos))) (cond ((shift? a) - ;;(printf "shift:~a~n" (shift-state a)) + ;; (printf "shift:~a~n" (shift-state a)) (cons (make-stack-frame (shift-state a) val start-pos end-pos) stack)) (else - ;;(printf "discard input:~a~n" tok) + ;; (printf "discard input:~a~n" tok) (let-values (((tok val start-pos end-pos) (extract (get-token)))) (remove-input tok val start-pos end-pos)))))))) @@ -245,7 +245,7 @@ (let ((a (find-action stack 'error #f start-pos end-pos))) (cond ((shift? a) - ;;(printf "shift:~a~n" (shift-state a)) + ;; (printf "shift:~a~n" (shift-state a)) (set! stack (cons (make-stack-frame (shift-state a) @@ -253,9 +253,9 @@ start-pos end-pos) stack)) - (remove-input)) + (remove-input tok val start-pos end-pos)) (else - ;;(printf "discard state:~a~n" (car stack)) + ;; (printf "discard state:~a~n" (car stack)) (cond ((< (length stack) 2) (raise-read-error "parser: Cannot continue after error"