#lang plait

(define-type-alias Env (Hashof Symbol Value))

(define-type Value
  (v-num
   [value : Number])
  (v-str
   [value : String])
  (v-bool
   [value : Boolean])
  (v-fun
   [param : Symbol]
   [body : Expr]
   [env : Env]))

(define-type Expr
  (e-num
   [value : Number])
  (e-str
   [value : String])
  (e-bool
   [value : Boolean])
  (e-op
   [op : Operator]
   [left : Expr]
   [right : Expr])
  (e-if
   [cond : Expr]
   [consq : Expr]
   [altern : Expr])
  (e-lam
   [param : Symbol]
   [body : Expr])
  (e-app
   [func : Expr]
   [arg : Expr])
  (e-id
   [name : Symbol]))

(define-type Operator
  (op-plus)
  (op-append)
  (op-str-eq)
  (op-num-eq))

(define-type InterpError
  (err-if-got-non-boolean [val : Value])
  (err-bad-arg-to-op [op : Operator]
                     [val : Value])
  (err-unbound-id [name : Symbol])
  (err-not-a-function [val : Value]))

(define-syntax-rule (~a arg ...)
  (foldl (lambda (val string) (string-append string val)) "" (list (to-string arg) ...)))

(define (raise-error [err : InterpError])
  (type-case InterpError err
    [(err-if-got-non-boolean val) (error 'err-if-got-non-boolean (~a "if got non boolean value " val))]
    [(err-bad-arg-to-op op val) (error 'err-bad-arg-to-op (~a "operator " op " got bad arg " val))]
    [(err-unbound-id name) (error 'err-unbound-id-name (~a name " is unbound"))]
    [(err-not-a-function val) (error 'err-not-a-function (~a val " is not a function"))]))

(define (parse [input : S-Exp]): Expr
  (cond
    [(s-exp-number? input) (e-num (s-exp->number input))]
    [(s-exp-string? input) (e-str (s-exp->string input))]
    [(s-exp-match? `true input) (e-bool #t)]
    [(s-exp-match? `false input) (e-bool #f)]
    [(s-exp-match? `{if ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 4)
           (e-if (parse (second inlst)) (parse (third inlst)) (parse (fourth inlst)))
           (error '+ "incorrect number of args to +")))]
    [(s-exp-match? `{+ ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 3)
           (e-op (op-plus) (parse (second inlst)) (parse (third inlst)))
           (error '+ "incorrect number of args to +")))]
    [(s-exp-match? `{++ ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 3)
           (e-op (op-append) (parse (second inlst)) (parse (third inlst)))
           (error '++ "incorrect number of args to ++")))]
    [(s-exp-match? `{num= ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 3)
           (e-op (op-num-eq) (parse (second inlst)) (parse (third inlst)))
           (error 'num= "incorrect number of args to num=")))]
    [(s-exp-match? `{str= ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 3)
           (e-op (op-str-eq) (parse (second inlst)) (parse (third inlst)))
           (error 'str= "incorrect number of args to str=")))]
    [(s-exp-match? `{lam SYMBOL ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 3)
           (e-lam (s-exp->symbol (second inlst)) (parse (third inlst)))
           (error 'lam "lambdas should only have one body")))]
    [(s-exp-match? `{lam ANY ...} input)
     (error 'lam "lambda parameters must be symbols")]
    [(s-exp-match? `{ANY ...} input)
     (let ([inlst (s-exp->list input)])
       (if (equal? (length inlst) 2)
           (e-app (parse (first inlst)) (parse (second inlst)))
           (error 'app "incorrect number of args to app")))]
    [(s-exp-symbol? input) (e-id (s-exp->symbol input))]))