From 41597427bbbebb1feab318d98463f59d346b3e3c Mon Sep 17 00:00:00 2001
From: Scott Owens <sowens@cs.utah.edu>
Date: Thu, 12 Aug 2004 23:23:17 +0000
Subject: [PATCH] *** empty log message ***

original commit: f98d94e1e4359e7ee4798a3a9f05a0173bfcc9fd
---
 collects/parser-tools/examples/calc.ss     | 29 +++++++++++-----------
 collects/parser-tools/private-lex/token.ss |  2 +-
 collects/parser-tools/yacc.ss              | 12 ++++-----
 3 files changed, 22 insertions(+), 21 deletions(-)

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"