;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;        ARITHMETICAL EXPRESSIONS WITH          ;;
;;        CONDITIONALS AND IDENTIFIERS           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#lang play

#|
<expr> ::= (num <num>)
         | (add <expr> <expr>)
         | (sub <expr> <expr>)
         | (if0 <expr> <expr> <expr>)
         | (with <id> <expr> <expr>)
         | (id <id>)
|#
;; Inductive type for representing arith-
;; metical expressions with conditionals
;; and identifiers
(deftype Expr
  (num n)
  (add l r)
  (sub l r)
  (if0 c t f)
  (with id named-expr body)
  (id x))


#|
<s-expr> ::= <num>
           | (list '+  <s-expr> <s-expr>)
           | (list '-  <s-expr> <s-expr>)
           | (list 'if0  <s-expr> <s-expr> <s-expr>)
           | (list 'with (list <sym> <s-expr>) <s-expr>)
           | <sym>
|#
;; s-expressions used as concrete syntax
;; for writing arithmetical expressions
;; with conditionals and identifiers


;; parse :: s-expr -> Expr
;; converts s-expressions into Exprs
(define (parse s-expr)
  (match s-expr
    [ n #:when (number? n) (num n) ]
    [ x #:when (symbol? x) (id x) ]
    [(list '+ l r) (add (parse l) (parse r))]
    [(list '- l r) (sub (parse l) (parse r))]
    [(list 'if0 c t f) (if0 (parse c)
                            (parse t)
                            (parse f))]
    [(list 'with (list x e) b) #:when (symbol? x)
         (with x (parse e) (parse b))]))


;; Parsing in action...
(printf "\nParsing in action...\n")
(define my-s-expr '(with (x (+ 5 5)) (with (y (- 3 x)) (+ x y))))
(printf "Input expression:  ")
 my-s-expr
(printf "Abstract representation:  ")
(parse my-s-expr) 


;; subst: Expr symbol Expr -> Expr
;; (subst in what for) substitutes all free occurrences of
;; identifier 'what' in expresion 'in' for expression 'for'
(define (subst in what for)
  (match in
    [(num n) (num n)]
    [(add l r) (add (subst l what for)
                    (subst r what for))]
    [(sub l r) (sub (subst l what for)
                    (subst r what for))]
    [(if0 c t f) (if0 (subst c what for)
                      (subst t what for)
                      (subst f what for))]
    [(with x e b)
     (with x
           (subst e what for)
           (if (symbol=? x what)
               b   ; x does not occur free in b
               (subst b what for)))]
    [(id x) (if (symbol=? x what) for (id x))]))


;; Substitution in action
(printf "\nSubstitution in action...\n")
(define my-s-expr-2 '(+ x (with (x 4) (+ x y))))
(printf "Original expression:  ")
(parse my-s-expr-2)
(printf "Substitute (free occurrences of) x with 10:  ")
(subst (parse my-s-expr-2) 'x (num 10))


;; calc :: Expr -> number
;; evaluates arithmetical expressions
;; with conditionals and identifiers
(define (calc expr)
  (match expr
    [(num n) n]
    [(add l r) (+ (calc l) (calc r))]
    [(sub l r) (- (calc l) (calc r))]
    [(if0 c t f) (if  (zero? (calc c)) (calc t) (calc f))]
    [(with x e b) (calc (subst b x (num (calc e))))]
    [(id x) (error 'calc "Open expression (free occurrence of ~a)" x)]))


;; run :: s-expr -> number
;; evaluates an arithmetical expression with
;; conditionals given in concrete syntax
(define (run prog)
  (calc (parse prog)))


;; A bunch of test cases from the PLAI
(print-only-errors #t)
(test (run '5) 5)
(test (run '(+ 5 5)) 10)
(test (run '(with (x (+ 5 5)) (+ x x))) 20)
(test (run '(with (x 5) (+ x x))) 10)
(test (run '(with (x (+ 5 5)) (with (y (- x 3)) (+ y y)))) 14)
(test (run '(with (x 5) (with (y (- x 3)) (+ y y)))) 4)
(test (run '(with (x 5) (+ x (with (x 3) 10)))) 15)
(test (run '(with (x 5) (+ x (with (x 3) x)))) 8)
(test (run '(with (x 5) (+ x (with (y 3) x)))) 10)
(test (run '(with (x 5) (with (y x) y))) 5)
(test (run '(with (x 5) (with (x x) x))) 5)
(test/exn (run '(+ 5 x)) "Open expression")