#lang plai-typed

;; Start with "function.rkt"
;; Add a division operator

(define-type ExprC
  [numC (n : number)]
  [idC (s : symbol)]
  [plusC (l : ExprC) 
         (r : ExprC)]
  [multC (l : ExprC)
         (r : ExprC)]
  [divC (l : ExprC)
        (r : ExprC)]
  [appC (s : symbol)
        (arg : ExprC)])

(define-type FunDefC
  [fdC (name : symbol) 
       (arg : symbol) 
       (body : ExprC)])

;; Example:
;; Concrete syntax
;;  {define {f x} {+ x 1}}
;; is represented as the plai-typed value:
;;  (fdC 'f 'x (plusC (idC 'x) (numC 1)))

(module+ test
  (define double-def
    (fdC 'double 'x (plusC (idC 'x) (idC 'x))))
  (define quadruple-def
    (fdC 'quadruple 'x (appC 'double (appC 'double (idC 'x))))))

;; interp ----------------------------------------
(define (interp [a : ExprC] [fds : (listof FunDefC)]) : number
  (type-case ExprC a
    [numC (n) n]
    [idC (s) (error 'interp "free variable")]
    [plusC (l r) (+ (interp l fds) (interp r fds))]
    [multC (l r) (* (interp l fds) (interp r fds))]
    [divC (l r) (/ (interp l fds) (interp r fds))]
    [appC (s arg) (local [(define fd (get-fundef s fds))]
                    (interp (subst (numC (interp arg fds))
                                   (fdC-arg fd)
                                   (fdC-body fd))
                            fds))]))

(module+ test
  (test (interp (numC 2) empty)
        2)
  (test/exn (interp (idC 'x) empty)
            "free variable")
  (test (interp (plusC (numC 2) (numC 1)) empty)
        3)
  (test (interp (multC (numC 2) (numC 1)) empty)
        2)
  (test (interp (divC (numC 10) (numC 2)) empty) 5)
  (test (interp (appC 'f (numC 2)) (list (fdC 'f 'x (divC (idC 'x) (numC 1))))) 2)
  (test (interp (plusC (multC (numC 2) (numC 3))
                       (plusC (numC 5) (numC 8)))
                empty)
        19)
  (test (interp (appC 'double (numC 8))
                (list double-def))
        16)
  (test (interp (appC 'quadruple (numC 8))
                (list double-def quadruple-def))
        32))


;; get-fundef ----------------------------------------
(define (get-fundef [s : symbol] [fds : (listof FunDefC)]) : FunDefC
  (cond
    [(empty? fds) (error 'get-fundef "undefined function")]
    [(cons? fds) (if (eq? s (fdC-name (first fds)))
                     (first fds)
                     (get-fundef s (rest fds)))]))

(module+ test
  (test (get-fundef 'double (list double-def))
        double-def)
  (test (get-fundef 'double (list double-def quadruple-def))
        double-def)
  (test (get-fundef 'double (list quadruple-def double-def))
        double-def)
  (test (get-fundef 'quadruple (list quadruple-def double-def))
        quadruple-def)
  (test/exn (get-fundef 'double empty)
            "undefined function"))

;; subst ----------------------------------------

(define (subst [what : ExprC] [for : symbol] [in : ExprC])
  (type-case ExprC in
    [numC (n) in]
    [idC (s) (if (eq? for s)
                 what
                 in)]
    [plusC (l r) (plusC (subst what for l)
                        (subst what for r))]
    [multC (l r) (multC (subst what for l)
                        (subst what for r))]
    [divC (l r) (divC (subst what for l)
                      (subst what for r))]
    [appC (s arg) (appC s (subst what for arg))]))



(module+ test
  (test (subst (numC 8) 'x (numC 9))
        (numC 9))
  (test (subst (numC 8) 'x (idC 'x))
        (numC 8))
  (test (subst (numC 8) 'x (idC 'y))
        (idC 'y))
  (test (subst (numC 8) 'x (plusC (idC 'x) (idC 'y)))
        (plusC (numC 8) (idC 'y)))
  (test (subst (numC 8) 'x (multC (idC 'y) (idC 'x)))
        (multC (idC 'y) (numC 8)))
  (test (subst (numC 8) 'x (appC 'double (idC 'x)))
        (appC 'double (numC 8))))