#lang plai (print-only-errors) (define-type F1WAE [num (n number?)] [add (lhs F1WAE?) (rhs F1WAE?)] [sub (lhs F1WAE?) (rhs F1WAE?)] [id (name symbol?)] [with (name symbol?) (named-expr F1WAE?) (body F1WAE?)] [app (fun-name symbol?) (arg-expr F1WAE?)]) ;(define-type DefSub ; [mtSub] ; [aSub (name symbol?) ; (value number?) ; (rest DefSub?)]) (define (mtSub) (hash)) (define (aSub name value rest) (hash-set rest name value)) (define (lookup name ds) (hash-ref ds name (lambda () (error 'interp "free identifier")))) (define-type FunDef [fundef (fun-name symbol?) (param-name symbol?) (body F1WAE?)]) ;; interp : F1WAE? (listof FunDef?) DefSub? -> number? (define (interp an-ae fundefs ds) (type-case F1WAE an-ae [num (n) n] [add (l r) (+ (interp l fundefs ds) (interp r fundefs ds))] [sub (l r) (- (interp l fundefs ds) (interp r fundefs ds))] [id (name) (lookup name ds)] [with (name named-expr body) (interp body fundefs (aSub name (interp named-expr fundefs ds) ds))] [app (fun-name arg-expr) (define the-fundef (lookup-fundef fun-name fundefs)) (interp (fundef-body the-fundef) fundefs (aSub (fundef-param-name the-fundef) (interp arg-expr fundefs ds) (mtSub)))])) ;; lookup : symbol? DefSub? -> number? ;(define (lookup name ds) ; (type-case DefSub ds ; [mtSub () (error 'interp "free identifier")] ; [aSub (name2 val rest) ; (if (equal? name name2) ; val ; (lookup name rest))])) ;; lookup-fundef : symbol? (listof FunDef?) -> FunDef? (define (lookup-fundef fun-name fundefs) (cond [(empty? fundefs) (error 'interp "undefined function ~a" fun-name)] [else (if (equal? fun-name (fundef-fun-name (first fundefs))) (first fundefs) (lookup-fundef fun-name (rest fundefs)))])) ;; parse : s-exp -> F1WAE? (define (parse s-exp) (cond [(number? s-exp) (num s-exp)] [(symbol? s-exp) (id s-exp)] [(list? s-exp) (when (empty? s-exp) (error 'parse "the empty list is not an F1WAE")) (case (first s-exp) [(+) (check-pieces s-exp 3 "add") (add (parse (second s-exp)) (parse (third s-exp)))] [(-) (check-pieces s-exp 3 "sub") (sub (parse (second s-exp)) (parse (third s-exp)))] [(with) (check-pieces s-exp 3 "with") (check-pieces (second s-exp) 2 "with binding pair") (with (first (second s-exp)) (parse (second (second s-exp))) (parse (third s-exp)))] [else (cond [(symbol? (first s-exp)) (check-pieces s-exp 2 "app") (app (first s-exp) (parse (second s-exp)))] [else (error 'parse "expected an F1WAE, got ~a" s-exp)])])] [else (error 'parse "expected an F1WAE, got ~a" s-exp)])) (define (check-pieces s-exp n who) (unless (= (length s-exp) n) (error 'parse "expected ~a, got ~a" who s-exp))) ;; ---------------------------------------------------------------------- ;; tests from last time, updated (define initial-def-sub (mtSub)) (test/exn (interp (parse `{with {y 2} {f 10}}) (list (fundef 'f 'x (parse `{+ y x}))) (mtSub)) "free identifier") (test (interp (parse `{with {y 2} {f y}}) (list (fundef 'f 'x (parse `{+ 1 x}))) initial-def-sub) 3) ;; 5 (test (parse `5) (num 5)) (test (interp (num 5) '() initial-def-sub) 5) ;; {+ 5 2} (test (parse `{+ 5 2}) (add (num 5) (num 2))) (test (interp (add (num 5) (num 2)) '() initial-def-sub) 7) ;; {{+ 3 4} + {- 2 5}} ;; WRONG ;; {- 3 {+ 4 5}} (test (parse `{- 3 {+ 4 5}}) (sub (num 3) (add (num 4) (num 5)))) (test (interp (sub (num 3) (add (num 4) (num 5))) '() initial-def-sub) -6) ;; x (test (parse `x) (id 'x)) (test/exn (interp (id 'x) '() initial-def-sub) "free identifier") ;; {with {x 3} x} (test (parse `{with {x 3} x}) (with 'x (num 3) (id 'x))) (test (interp (with 'x (num 3) (id 'x)) '() initial-def-sub) 3) (test (parse `{with {x {+ 1 2}} x}) (with 'x (add (num 1) (num 2)) (id 'x))) (test (interp (with 'x (add (num 1) (num 2)) (id 'x)) '() initial-def-sub) 3) (test (parse `{with {x 3} {with {x 2} x}}) (with 'x (num 3) (with 'x (num 2) (id 'x)))) (test (interp (with 'x (num 3) (with 'x (num 2) (id 'x))) '() initial-def-sub) 2) (test (parse `{with {y 3} {with {x 2} {+ x y}}}) (with 'y (num 3) (with 'x (num 2) (add (id 'x) (id 'y))))) (test (interp (with 'y (num 3) (with 'x (num 2) (add (id 'x) (id 'y)))) '() initial-def-sub) 5) ;; {with {x x} {+ x 1}} (test (parse `{with {x x} {+ x 1}}) (with 'x (id 'x) (add (id 'x) (num 1)))) (test/exn (interp (with 'x (id 'x) (add (id 'x) (num 1))) '() initial-def-sub) "free identifier") (test (parse `{with {x {with {y 3} y}} {+ x 4}}) (with 'x (with 'y (num 3) (id 'y)) (add (id 'x) (num 4)))) (test (interp (with 'x (with 'y (num 3) (id 'y)) (add (id 'x) (num 4))) '() initial-def-sub) 7) (test (parse `{with {x {with {x 3} x}} {+ x 4}}) (with 'x (with 'x (num 3) (id 'x)) (add (id 'x) (num 4)))) (test (interp (with 'x (with 'x (num 3) (id 'x)) (add (id 'x) (num 4))) '() initial-def-sub) 7) (test (parse `5) (num 5)) (test (parse `x) (id 'x)) (test (parse `{+ 1 23}) (add (num 1) (num 23))) (test (parse `{- 2 3}) (sub (num 2) (num 3))) (test (parse `{with {x 4} {+ x 5}}) (with 'x (num 4) (add (id 'x) (num 5)))) (test (parse `{f 10}) (app 'f (num 10))) (test/exn (parse `{2 3}) "expected an F1WAE")