A simple lisp POC implemented in clojure. Dynamically bound. Lambdas can receive code unevaluated. Written just to prove a point LOL

stupid-lisp-interpreter.clj

(comment
  ;; To run code from the file:
  (stupid-eval
    '()
    (read-string (slurp "code.lisp")))
)

(declare stupid-eval)

(defn third [lst]
  (nth lst 2))

(def special-forms
  {'+
   (fn [bindings arguments]
     (apply + (map #(stupid-eval bindings %) arguments)))

   '=
   (fn [bindings arguments]
     (if (apply = (map #(stupid-eval bindings %) arguments))
       'T
       '()))

   'eval
   (fn [bindings arguments]
     (assert (= 1 (count arguments))
             "eval accepts only 1 argument")
     (stupid-eval bindings
                  (stupid-eval bindings (first arguments))))

   'push
   (fn [bindings arguments]
     (assert (= 2 (count arguments))
             "push requires 2 arguments") cons
     (apply conj (reverse (map #(stupid-eval bindings %) arguments))))

   'head
   (fn [bindings arguments]
     (assert (= 1 (count arguments))
             "head accepts only 1 argument")
     (first (stupid-eval bindings (first arguments))))


   'tail
   (fn [bindings arguments]
     (assert (= 1 (count arguments))
             "head accepts only 1 argument")
     (let [lst (stupid-eval bindings (first arguments))]
       (rest lst)))


   'let
   (fn [bindings arguments]
     (let [var (first (first arguments))
           val (stupid-eval bindings (second (first arguments)))
           body-form (second arguments)]
       (assert (symbol? var))
       (stupid-eval (cons (list var val)
                      bindings)
                body-form)))


   'if
   (fn [bindings arguments]
     (assert (= 3 (count arguments))
             "malformed if-statement: requires condition, then, else")
     (if (not= '() (stupid-eval bindings (first arguments)))
       (stupid-eval bindings (second arguments))
       (stupid-eval bindings (third arguments))))})


(defn get-bound-val [bindings sym]
  ;; (println "bindings:" bindings)
  (if-let [special-fn (get special-forms sym)]
    special-fn
    (if-let [b (some #(when (= sym (first %)) %) bindings)]
      (second b)
      (throw (Error. (str sym " not bound"))))))


(defn stupid-eval [bindings form]
  (cond
    (number? form)
    form

    (some #(= form %) (vals special-forms))
    form

    (or (= 'NIL form) (= '() form))
    '()

    (symbol? form)
    (get-bound-val bindings form)

    (and (list? form) (= (first form) 'lambda))
    (do
      (assert (= 3 (count form))
              (str "Malformed lambda: format is (lambda (params*) body-form)\n"
                   form))
      (assert (or (symbol? (second form))
                  (and (list? (second form)) (every? symbol? (second form))))
              (form "Malformed lambda: params should be a symbol or a list of symbols"
                    form))
      ;; lambda simply evaluates to itself. functions are DaTa
      form)

    ;; basically, `apply`
    (and (list? form) (not (empty? form)))
    (let [f (stupid-eval bindings (first form))
          arguments (rest form)]
      (println "executing" form)
      (cond
        (some #(= f %) (vals special-forms))
        (f bindings arguments)

        (and (list? f) (= 'lambda (first f)))
        (let [params (second f)
              lambda-body (third f)]
          (when (list? params)
            (assert (= (count params) (count arguments))
                    "apply error: arguments not matching params"))

          (let [lambda-bindings (if (symbol? params)
                                  (list (list params arguments))
                                  (->> arguments
                                       (map #(stupid-eval bindings %))
                                       (map list params)))]
            (stupid-eval
              (reduce #(cons %2 %1) bindings lambda-bindings)
              lambda-body)))

        :else
        (throw (Error. (str "apply error: " form)))))

    :else
    (do
      (println (type form) (list? form) (clojure.pprint/pprint form))
      (throw (Error. (str "eval error: "  form))))))




(do
  (assert (= 123
             (stupid-eval
               '()
               123)))

  (assert (= 4567
             (stupid-eval
               '((x 4567))
               'x)))

  (assert (= 3
             (stupid-eval
               '()
               '(+ 1 2))))

  ;; let-statement
  (assert (= 234
             (stupid-eval
               '()
               '(let (x 234)
                  x))))

  (assert (= 725
             (stupid-eval
               '()
               '(let (x 434)
                  (let (y 291)
                    (+ x y))))))

  ;; variable overshadowing
  (assert (= 798
             (stupid-eval
               '((x 234))
               '(let (x 798)
                  x))))

  ;; lambdas evaluate into themselves. iT's aLl DaTa
  (assert (= '(lambda (x) x)
             (stupid-eval
               '()
               '(lambda (x) x))))


  ;; calling lambdas
  (assert (= 123
             (stupid-eval
               '()
               '((lambda (x) x) 123))))


  ;; defining functions
  (assert (= 1000
             (stupid-eval
               '()
               '(let (double (lambda (x) (+ x x)))
                  (double 500)))))

  ;; if-statement
  (assert (= 2347
             (stupid-eval
               '()
               '(let (x 5)
                  (if (= x (+ 2 3))
                    2347
                    993)))))

  (assert (= 993
             (stupid-eval
               '()
               '(let (x 5)
                  (if (= x 9)
                    2347
                    993)))))


  ;; recursion
  (assert
    (= 543
       (stupid-eval
         '()
         '(let (f (lambda (x) (if (= 10 x) 543 (f (+ x 1)))))
            (f 0)))))


  ;; lambdas can accept unevaled params
  (assert
    (= '(+ 3 4)
       (stupid-eval
         '()
         '(let (unevaled-2nd (lambda forms (head (tail forms))))
            (unevaled-2nd x (+ 3 4) y)))))

  ;; quote
  (assert
    (= '(let (y 8) (+ x y))
       (stupid-eval
         '()
         '(let (quote (lambda forms (head forms)))
            (quote (let (y 8) (+ x y)))))))


  ;; eval
  (assert
    (= 11
       (stupid-eval
         '()
         '(let (quote (lambda forms (head forms)))
            (eval (quote (let (x 8) (+ x 3))))))))


  ;; bug: clojure's cons works weirdly when using empty list
  (let [actual (stupid-eval
                 '()
                 '(push 2 (push 1 NIL)))
        expectation '(2 1)]
    (assert (= expectation actual))
    (assert (= (type expectation) (type actual))))
)

stupid-lisp.lisp

(let (quote (lambda forms (head forms)))
  (let (let* (lambda forms
               (let (LET*-AUX
                     (lambda (bindings)
                       (if bindings
                           (eval (push (quote let)
                                       (push
                                        (head bindings)
                                        (push (quote (LET*-AUX (tail bindings)))
                                              NIL))))
                           (eval (head (tail forms))))))
                 (LET*-AUX (head forms)))))

    (let* ((reverse (lambda (lst)
                      (let (aux (lambda (result rest)
                                  (if rest
                                      (aux (push (head rest) result)
                                           (tail rest))
                                      result)))
                        (aux NIL lst))))
           (list (lambda forms
                   (let (aux (lambda (reversed-result rest)
                               (if rest
                                   (aux (push (eval (head rest)) reversed-result)
                                        (tail rest))
                                   (reverse reversed-result))))
                     (aux NIL forms))))
           (T (quote T))
           (not (lambda (val) (if val NIL T)))
           (compose (lambda (f1 f2) (list (quote lambda) (quote (x))
                                          (list f1 (list f2 (quote x))))))
           (first head)
           (second (compose head tail))
           (when (lambda cond-pair
                   (if (eval (first cond-pair))
                       (eval (second cond-pair))
                       NIL)))
           (apply (lambda fn-and-args
                    (eval (push (first fn-and-args)
                                (eval (second fn-and-args))))))
           (cond (lambda cond-pairs
                   (when cond-pairs
                     (let (c-pair (head cond-pairs))
                       (if (eval (first c-pair))
                           (eval (second c-pair))
                           (apply cond (tail cond-pairs))))))))

      (cond
        ((= 4 (+ 1 2))
         (quote first))
        ((= 4 (+ 2 2))
         (quote second))
        (T
         (quote neither))))))