#lang racket/base ;; An interactive calculator inspired by the calculator example in the bison manual. ;; Import the parser and lexer generators. (require yaragg/parser-tools/yacc yaragg/parser-tools/lex (prefix-in : yaragg/parser-tools/lex-sre)) (define-tokens value-tokens (NUM VAR FNCT)) (define-empty-tokens op-tokens (newline = OP CP + - * / ^ EOF NEG)) ;; A hash table to store variable values in for the calculator (define vars (make-hash)) (define-lex-abbrevs (lower-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"))) (define calc-lex (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. [(:or #\tab #\space) (calc-lex 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)] [(:+ (:or lower-letter upper-letter)) (token-VAR (string->symbol lexeme))] [(:+ digit) (token-NUM (string->number lexeme))] [(:: (:+ digit) #\. (:* digit)) (token-NUM (string->number lexeme))])) (define calc-parse (parser (start start) (end newline EOF) (tokens value-tokens op-tokens) (error (lambda (a b c) (void))) (precs (right =) (left - +) (left * /) (left NEG) (right ^)) (grammar (start [() #f] ;; If there is an error, ignore everything before the error ;; and try to start over right after the error [(error start) $2] [(exp) $1]) (exp [(NUM) $1] [(VAR) (hash-ref vars $1 0)] [(VAR = exp) (begin (hash-set! vars $1 $3) $3)] [(FNCT OP exp CP) ($1 $3)] [(exp + exp) (+ $1 $3)] [(exp - exp) (- $1 $3)] [(exp * exp) (* $1 $3)] [(exp / exp) (/ $1 $3)] [(- exp) (prec NEG) (- $2)] [(exp ^ exp) (expt $1 $3)] [(OP exp CP) $2])))) ;; run the calculator on the given input-port (define (calc ip) (port-count-lines! ip) (let loop () (define result (calc-parse (λ () (calc-lex ip)))) (when result (printf "~a\n" result) (loop)))) (module+ test (require rackunit) (check-equal? (let ([o (open-output-string)]) (parameterize ([current-output-port o]) (calc (open-input-string "x=1\n(x + 2 * 3) - (1+2)*3"))) (get-output-string o)) "1\n-2\n"))