(include "prelude/primitives.scm")
(include "util/table.scm")
(include "util/alist.scm")

(define (lift-bool expr) (if expr 'true 'false))

(define (tagged? expr tag)
  (if (pair? expr)
      (eq? (car expr) tag)
      #f))

;;; self-evaluating
(define (self-evaluating? expr)
  (or (number? expr)
      (string? expr)
      (bool? expr)))

(define variable? symbol?)

;;; if-else
(define (if-else? expr) (tagged? expr 'if))
(define (if-predicate expr) (cadr expr))
(define (if-consequent expr) (caddr expr))
(define (if-alternative expr) 
  (if (not (null? (cdddr expr)))
      (cadddr expr)
      'false))

;;; function application
(define (function-application? expr) (pair? expr))
(define (operator expr) (car expr))
(define (operands expr) (cdr expr))
(define (no-operands? expr) (null? expr))
(define (list-of-values ls env)
  (if (no-operands? ls)
      '()
      (let ([first (eval-expr (car ls) env)])
        (let ([rest (list-of-values (cdr ls) env)])
          (cons first rest)))))

;;; quoted expressions
(define (quote-form? expr) (tagged? expr 'quote))
(define (quotation-text expr) (cadr expr))

;;; assignment
(define (assignment? expr) (tagged? expr 'set!))

(define (eval-expr expr env)
  (cond
    [(self-evaluating? expr) expr]
    [(if-else? expr) (eval-if expr env)]
    [(quote-form? expr) (quotation-text expr)]
    [(function-application? expr)
     (apply-expr (operator expr)
                 (list-of-values (operands expr) env))]))

(define (eval-if expr env)
  (if (true? (eval-expr (if-predicate expr) env))
      (eval-expr (if-consequent expr) env)
      (eval-expr (if-alternative expr) env)))

(define (primitive? proc)
  (is-elem-assoc-list proc primitives))

(define (apply-primitive-proc proc args)
  (let ([p (lookup-assoc-list proc primitives)])
    (apply p args)))

(define (apply-expr proc args)
  (cond
    [(primitive? proc) (apply-primitive-proc proc args)]
    [else 'false]))