fix some example parsers

svn: r10871
This commit is contained in:
Matthew Flatt 2008-07-23 13:01:11 +00:00
parent 8e1add79c9
commit fc87f01bb7
2 changed files with 15 additions and 13 deletions

View File

@ -1,16 +1,18 @@
#lang scheme
;; An interactive calculator inspired by the calculator example in the bison manual. ;; An interactive calculator inspired by the calculator example in the bison manual.
;; Import the parser and lexer generators. ;; Import the parser and lexer generators.
(require parser-tools/yacc (require parser-tools/yacc
parser-tools/lex parser-tools/lex
(prefix : parser-tools/lex-sre)) (prefix-in : parser-tools/lex-sre))
(define-tokens value-tokens (NUM VAR FNCT)) (define-tokens value-tokens (NUM VAR FNCT))
(define-empty-tokens op-tokens (newline = OP CP + - * / ^ EOF NEG)) (define-empty-tokens op-tokens (newline = OP CP + - * / ^ EOF NEG))
;; A hash table to store variable values in for the calculator ;; A hash table to store variable values in for the calculator
(define vars (make-hash-table)) (define vars (make-hash))
(define-lex-abbrevs (define-lex-abbrevs
(lower-letter (:/ "a" "z")) (lower-letter (:/ "a" "z"))
@ -61,8 +63,8 @@
[(exp) $1]) [(exp) $1])
(exp [(NUM) $1] (exp [(NUM) $1]
[(VAR) (hash-table-get vars $1 (lambda () 0))] [(VAR) (hash-ref vars $1 (lambda () 0))]
[(VAR = exp) (begin (hash-table-put! vars $1 $3) [(VAR = exp) (begin (hash-set! vars $1 $3)
$3)] $3)]
[(FNCT OP exp CP) ($1 $3)] [(FNCT OP exp CP) ($1 $3)]
[(exp + exp) (+ $1 $3)] [(exp + exp) (+ $1 $3)]
@ -79,10 +81,9 @@
(letrec ((one-line (letrec ((one-line
(lambda () (lambda ()
(let ((result (calcp (lambda () (calcl ip))))) (let ((result (calcp (lambda () (calcl ip)))))
(if result (when result
(begin (printf "~a~n" result)
(printf "~a~n" result) (one-line))))))
(one-line)))))))
(one-line))) (one-line)))
(calc (open-input-string "(1 + 2 * 3) - (1+2)*3")) (calc (open-input-string "x=1\n(x + 2 * 3) - (1+2)*3"))

View File

@ -7,8 +7,9 @@
(provide malgol-lexer malgol-parser) (provide malgol-lexer malgol-parser)
(define-tokens regular (ID LITNUM STRING)) (define-tokens regular (ID LITNUM STRING LBRACK RBRACK COMMA LPAREN RPAREN))
(define-empty-tokens keywords (PROCEDURE SEMI BEGIN IN END IF ELSE EQUALS EOF)) (define-empty-tokens keywords (PROCEDURE SEMI BEGIN IN END IF THEN ELSE EQUALS EOF
ARROW TRUE FALSE DATATYPE CASES))
(display (equal? (token-ID "foo") (token-ID "foo"))) (newline) (display (equal? (token-ID "foo") (token-ID "foo"))) (newline)
@ -19,13 +20,13 @@
(digit (:/ "0" "9")) (digit (:/ "0" "9"))
(id-cont (:or id-start digit))) (id-cont (:or id-start digit)))
(define example-lexer (define malgol-lexer
(lexer ((eof) (token-EOF)) (lexer ((eof) (token-EOF))
(whitespace (malgol-lexer input-port)) (whitespace (malgol-lexer input-port))
("=" (token-EQUALS)) ("=" (token-EQUALS))
(";" (token-SEMI)) (";" (token-SEMI))
("begin" (token-BEGIN)) ("begin" (token-BEGIN))
("end" (token-end)) ("end" (token-END))
((:+ digit) (token-LITNUM lexeme)) ((:+ digit) (token-LITNUM lexeme))
((:: id-start (:* id-cont)) (token-ID lexeme)) ((:: id-start (:* id-cont)) (token-ID lexeme))
((:: #\" (:* (:or (:~ #\") "\\\"")) #\") (token-STRING (substring lexeme 1 (- (string-length lexeme) 1)))))) ((:: #\" (:* (:or (:~ #\") "\\\"")) #\") (token-STRING (substring lexeme 1 (- (string-length lexeme) 1))))))