In this assignment you will be implementing an interpreter for the ARITHMETIC Language, a language of arithmetic expressions.
The language consists of the following:
- 1. Concrete syntax
- for programs in the arithmetic language. Specified as a CFG. Given
- 2. Abstract syntax
- for programs in the arithmetic
language. Specified using a
define-datatype
. Given. - 3. Parser
- converts concrete syntax to abstract syntax. To be implemented by you.
- 4. Expressible values
- a definition of domain of values expressed, or returned as a result of evaluation. Given.
- 5. Interpreter Error Domain
- Divide by zero error, and type errors. Given.
- 6. Interpreter
- A program that maps abstract syntax to expressible values. To be implemented by you
The concrete syntax of ARITHMETIC programs is given below:
<exp> := <number> | <boolean> | (if <exp> <exp> <exp>) ; (if <test> <then> <else>) | (<binop> <exp> <exp>) <binop> := + | - | * | / | < | ==
(define-datatype ast ast?
[binop (op binop?) (rand1 ast?) (rand2 ast?)]
[ifte (c ast?) (t ast?) (e ast?)]
[num (n number?)]
[bool (b boolean?)])
define-datatype
auto-defines the following constructors (their signatures are shown for clarity):binop
:: [binop? ast? ast?] -> ast?ifte
:: [ast? ast? ast?] -> ast?num
:: number? -> ast?bool
:: boolean? -> ast?
(binop? op)
checks if op
one of the legal binary
operators.
(define binop?
(lambda (x)
(match x
['add #t]
['sub #t]
['mul #t]
['div #t]
['lt? #t]
['eq? #t]
[_ #f])))
In the example below, =’foobar= is not a binary operator. Therefore the binop constructor will reject it as an argument.
(check-exn exn:fail (lambda () (binop 'foobar (num 10) (num 20))))
A parser parses an expression in concrete syntax according to a given grammar.
If the expression is not grammatical legal, the parser raises an
exception. Exceptions in Racket are structures. Specialised
exceptions like exn:parse-error
are built by inheriting from
the base exception exn:fail
.
(struct exn:parse-error exn:fail ())
The function raise-parse-error
, given below raises an
exn:parse-err
exception when invoked.
(define raise-parse-error
(lambda (err-msg)
(raise (exn:parse-error err-msg (current-continuation-marks)))))
;;; parse :: any/c -> ast? Raises exception exn:parse-error?
(define (parse exp)
(cond
[(number? exp) (num exp)] ;; simple number case
[(boolean? exp) (bool exp)] ;; boolean case
[(and (list? exp) (= (length exp) 4) ;; if/then/else case
(eq? (first exp) 'if)
(boolean? (second exp)))
(ifte (parse (second exp)) (parse (third exp)) (parse (fourth exp)))]
[(and (list? exp) (= (length exp) 3)) ;; binary ops
(cond
[(eq? (first exp) '+) (binop 'add (parse (second exp)) (parse (third exp)))]
[(eq? (first exp) '-) (binop 'sub (parse (second exp)) (parse (third exp)))]
[(eq? (first exp) '*) (binop 'mul (parse (second exp)) (parse (third exp)))]
[(eq? (first exp) '/) (binop 'div (parse (second exp)) (parse (third exp)))]
[(eq? (first exp) '<) (binop 'lt? (parse (second exp)) (parse (third exp)))]
[(eq? (first exp) '=) (binop 'eq? (parse (second exp)) (parse (third exp)))]
[else (raise-parse-error "invalid syntax ~a") exp] ;; invalid operation
)]
[else (raise-parse-error "invalid syntax ~a") exp] ;; invalid operation
)
)
;;; Tests for parsing
(define ts-parsing
(test-suite "parsing"
(test-case "num" (check-equal? (parse 10) (num 10)))
(test-case "add" (check-equal? (parse '(+ 10 20)) (binop 'add (num 10) (num 20))))
(test-case "sub" (check-equal? (parse '(- 10 20)) (binop 'sub (num 10) (num 20))))
(test-case "mul" (check-equal? (parse '(* 10 20)) (binop 'mul (num 10) (num 20))))
(test-case "div" (check-equal? (parse '(/ 10 20)) (binop 'div (num 10) (num 20))))
(test-case "bool-t" (check-equal? (parse #t) (bool #t)))
(test-case "bool-f" (check-equal? (parse #f) (bool #f)))
(test-case "if" (check-equal? (parse '(if #t 10 20)) (ifte (bool #t) (num 10) (num 20))))
(test-case "failure"
(check-exn exn:parse-error?
(lambda () (parse '(** 10 20)))))
(test-case "recur" (check-equal?
(parse '(+ (- 10 20) (* 20 30)))
(binop 'add
(binop 'sub (num 10) (num 20))
(binop 'mul (num 20) (num 30)))))
))
Expressible values are those that are returned as the result of evaluating an expression. For the ARITHMETIC language, expressible values are numbers and booleans.
#+NAME expressible
(require racket/contract)
(define expressible-value? (or/c number? boolean?))
The interpreter receives an AST, and produces a number, boolean, or throws an error. We first define the types of errors it can throw.
Like before, errors are specialised exceptions. We are concerned with two kinds of exceptions raised during evaluation, or execution time: divide-by-zero and type-error.
exec-divide-by-zero
is raised when the numerator of a division is
zero. exec-type-error
is raised when there is an argument type
mismatch, e.g., a non-boolean value to the test of a
conditional, or a boolean argument to addition, etc.
(struct exn:exec-div-by-zero exn:fail ())
(define raise-exec-div-by-zero
(lambda ()
(raise (exn:exec-div-by-zero "div-by-0!" (current-continuation-marks)))))
(struct exn:exec-type-mismatch exn:fail ())
(define raise-exec-type-mismatch
(lambda ()
(raise (exn:exec-type-mismatch "type mismatch!" (current-continuation-marks)))))
These errors are raised as follows:
(raise-exec-div-by-zero)
(raise-exec-type-mismatch)
Your interpreter will be expected to raise the above exceptions under the appropriate conditions.
The functions typecheck-num
, typecheck-bool
and
check-non-zero
defined below check whether a value has the
right type and raise the appropriate runtime evaluator
exceptions.
;;; runtime-check :: [expressible? -> boolean?], exn? -> [expressible? -> expressible? || exn?]
(define runtime-check
(lambda (pred? exn)
(lambda (v)
(if (pred? v)
v
(exn)))))
(define typecheck-num
(runtime-check number? raise-exec-type-mismatch))
(define typecheck-bool
(runtime-check boolean? raise-exec-type-mismatch))
(define check-non-zero
(runtime-check (not/c zero?) raise-exec-div-by-zero))
This function below maps the operators to their interpretation, i.e., actual functions that operate on expressible values.
(define op-interpretation
(lambda (op)
(match op
['add +]
['sub -]
['mul *]
['lt? <]
['eq? =]
[_ error 'op-interpretation "unknown op"])))
;;; eval-ast :: ast? -> expressible? || (or/c exn:exec-div-by-zero exn:exec-type-mismatch)
(define eval-ast
(λ (a)
(cases ast a
[bool (b) b]
[num (n) n]
[binop (op lhs rhs)
(if (equal? op 'div)
(/ (typecheck-num (eval-ast lhs)) (check-non-zero (eval-ast rhs)))
((op-interpretation op) (typecheck-num (eval-ast lhs))
(typecheck-num (eval-ast rhs)))
)
]
[ifte (condition if-true-exp if-false-exp)
(if (typecheck-bool (eval-ast condition))
(eval-ast if-true-exp)
(eval-ast if-false-exp))
]
)
)
)
(define ts-evaluation
(test-suite
"evaluation"
(test-case "num" (check-equal? (eval-ast (num 10)) 10))
(test-case "add" (check-equal? (eval-ast (binop 'add (num 10) (num 20))) 30))
(test-case "sub" (check-equal? (eval-ast (binop 'sub (num 10) (num 20))) -10))
(test-case "mul" (check-equal? (eval-ast (binop 'mul (num 10) (num 20))) 200))
(test-case "lt" (check-equal? (eval-ast (binop 'lt? (num 10) (num 20))) #t))
(test-case "eq" (check-equal? (eval-ast (binop 'eq? (num 10) (num 10))) #t))
(test-case "div-success" (check-equal? (eval-ast (binop 'div (num 20) (num 10))) 2))
;; raise an exception, so use the correct `raise' function!
(test-case "div-failure"
(check-exn exn:exec-div-by-zero?
(lambda () (eval-ast (binop 'div (num 20) (num 0))) 2)))
(test-case "bool-t" (check-equal? (eval-ast (bool #t)) #t))
(test-case "bool-f" (check-equal? (eval-ast (bool #f)) #f))
(test-case "if-true" (check-equal? (eval-ast (ifte (bool #t) (num 10) (num 20))) 10))
(test-case "if-false" (check-equal? (eval-ast (ifte (bool #f) (num 10) (num 20))) 20))
(test-case "if-type-mismatch" (check-exn exn:exec-type-mismatch?
(lambda () (eval-ast (ifte (num 42) (num 10) (num 20))))))))
(define ts-numop-incorrect-param-rand1
(test-suite
"wrongly typed rand1 parameters"
(for/list ([numerical-op '(add sub mul div lt? eq?)])
(test-case (string-append (symbol->string numerical-op) "-type-mismatch-rand1")
(check-exn exn:exec-type-mismatch?
(lambda ()
(eval-ast (binop numerical-op
(binop 'lt? (num 10) (num 20)) ; boolean
(num 10)))))))))
(define ts-numop-incorrect-param-rand2
(test-suite
"wrongly typed rand2 parameters"
(for/list ([numerical-op '(add sub mul div)])
(test-case (string-append (symbol->string numerical-op) "-type-mismatch-rand1")
(check-exn exn:exec-type-mismatch?
(lambda ()
(eval-ast (binop numerical-op (num 10)
(binop 'lt? (num 10) (num 20))))))))))
These run the tests that have been written in this file. When submitting, please ensure that all these tests pass.
(define run-all-tests
(lambda ()
(run-tests ts-parsing)
(run-tests ts-evaluation)
(run-tests ts-numop-incorrect-param-rand1)
(run-tests ts-numop-incorrect-param-rand2)))
We will use raco command line utility to run the tests.
raco test test.rkt
will run the test suite.
(module+ test
(run-all-tests))
#lang racket
(require eopl)
(require rackunit)
(require racket/match)
(provide (all-defined-out))
<<define-ast>>
<<binop>>
<<exn>>
<<parser>>
<<parse>>
<<expressible>>
<<interpreter>>
<<runtime-check-helpers>>
<<binop-helper>>
<<eval-ast>>
<<rand1>>
<<rand2>>
#lang racket
(require eopl)
(require rackunit)
(require racket/match)
(require rackunit/text-ui)
(require "main.rkt")
<<parsing-test>>
<<eval-ast-test>>
<<test-runners>>
<<run-test>>