schrodinger.clj

(declare lookup [sym env])
(defn lookup [sym [sym val & _]] val)
(defn lookup [sym [_ _ & rest]] (lookup sym rest))
(defn lookup [sym []] (error "Symbol " syn " not found"))


(declare eval [expr env])
(defn eval [expr _] (error "Invalid expression" expr))
(defn eval [(int n) env] n)
(defn eval [(float n) env] n)
(defn eval [(string n) env] n)
(defn eval [(symbol s) env] (lookup s env ! "with environment" env))
(defn eval [[] _] [])
(defn eval [[x & xs] env] [(eval x env) & (eval xs env)])

(declare eval-all [list])
(defn eval-all [() _] ())
(defn eval-all [(x & xs) env] ((eval x env) & (eval-all xs env)))

(declare env-with-args [params args env])
(defn env-with-args [[_ & _] () env] (error "too few arguments"))
(defn env-with-args [[] (_ & _) env] (error "too many arguments"))
(defn env-with-args [[] () env] env)
(defn env-with-args [[p & ps] (a & as) env]
    [p a & (env-with-args ps as env)])

(declare eval-closure [closure args])
(defn eval-closure [[params expr env] args env]
    (eval expr (env-with-args params args env)))

(defn eval [(func & args) env]
    (eval-closure (eval func) (eval-all args env)
        ! "in call to function" func))

(declare + [a b])
(defn + [(int a) (int b)]
    (int-+ a b))
(defn + [(float a) (float b)]
    (float-+ a b))
(defn eval [('+ a b) env] (+ (eval a env) (eval b env)))

(declare cond [c a b])
(defn cond ['true a _] a)
(defn cond ['false _ b] b)

(defn eval [('if c a b) env]
    (eval (cond (eval c env) a b)))

(defdef def [name value]
    (eval [name _] value))

(declare params [params])
(defn params [ps] (error "Illegal param list" ps))
(defn params [[]] [])
(defn params [[p & _]] (error "Illegal param" p))
(defn params [[(symbol p) & ps]] [p & (params ps)])

(defn eval [('fn params expr) env]
    [(params params) expr env])

(defdef defun [(symbol name) params expr]
    (eval [name _] [params expr []]))


;;;;;;

(defun factorial [n]
    (if (= n 0)
        1
        (* n (factorial (- n 1)))))

(defexp factorial [(int n)]
    (eval (factorial n) []))

(defun factorial2 [n]
    (mult-list (gen-list n)))

(defun gen-list [n]
    (if (= n 0)
        []
        [n & (gen-list (- n 1))]))

;; (0 (+ [] [int & 0]))

(defun mult-list [l]
    (if (empty? l)
        1 ;; []
        (* (first l) (mult-list (rest l))))) ;; (1 [int & (+ [] 1)])

(declare empty [l])
(defn empty [l] (error l "is not a list"))
(defn empty [[]] 'true)
(defn empty [[_ & _]] 'false)
(defn eval [('empty x) env]
    (empty (eval x env) ! "evaluated from " x))