impls/clojure/src/mal/step7_quote.cljc

   1 (ns mal.step7-quote
   2   (:require [mal.readline :as readline]
   3             #?(:clj [clojure.repl])
   4             [mal.reader :as reader]
   5             [mal.printer :as printer]
   6             [mal.env :as env]
   7             [mal.core :as core])
   8   #?(:clj (:gen-class)))
   9
  10 ;; read
  11 (defn READ [& [strng]]
  12   (reader/read-string strng))
  13
  14 ;; eval
  15 (declare EVAL)
  16
  17 (declare quasiquote)
  18 (defn starts_with [ast sym]
  19   (and (seq? ast)
  20        (= (first ast) sym)))
  21 (defn qq-iter [seq]
  22   (if (empty? seq)
  23     ()
  24     (let [elt (first seq)
  25           acc (qq-iter (rest seq))]
  26       (if (starts_with elt 'splice-unquote)
  27         (list 'concat (second elt)     acc)
  28         (list 'cons   (quasiquote elt) acc)))))
  29 (defn quasiquote [ast]
  30   (cond (starts_with ast 'unquote)    (second ast)
  31         (seq? ast)                    (qq-iter ast)
  32         (vector? ast)                 (list 'vec (qq-iter ast))
  33         (or (symbol? ast) (map? ast)) (list 'quote ast)
  34         :else                         ast))
  35
  36 (defn eval-ast [ast env]
  37   (cond
  38     (symbol? ast) (env/env-get env ast)
  39
  40     (seq? ast)    (doall (map #(EVAL % env) ast))
  41
  42     (vector? ast) (vec (doall (map #(EVAL % env) ast)))
  43
  44     (map? ast)    (apply hash-map (doall (map #(EVAL % env)
  45                                               (mapcat identity ast))))
  46
  47     :else         ast))
  48
  49 (defn EVAL [ast env]
  50   (loop [ast ast
  51          env env]
  52     ;;(prn "EVAL" ast (keys @env)) (flush)
  53     (if (not (seq? ast))
  54       (eval-ast ast env)
  55
  56       ;; apply list
  57           ;; indented to match later steps
  58           (let [[a0 a1 a2 a3] ast]
  59             (condp = a0
  60               nil
  61               ast
  62
  63               'def!
  64               (env/env-set env a1 (EVAL a2 env))
  65
  66               'let*
  67               (let [let-env (env/env env)]
  68                 (doseq [[b e] (partition 2 a1)]
  69                   (env/env-set let-env b (EVAL e let-env)))
  70                 (recur a2 let-env))
  71
  72               'quote
  73               a1
  74
  75               'quasiquoteexpand
  76               (quasiquote a1)
  77
  78               'quasiquote
  79               (recur (quasiquote a1) env)
  80
  81               'do
  82               (do (eval-ast (->> ast (drop-last) (drop 1)) env)
  83                   (recur (last ast) env))
  84
  85               'if
  86               (let [cond (EVAL a1 env)]
  87                 (if (or (= cond nil) (= cond false))
  88                   (if (> (count ast) 2)
  89                     (recur a3 env)
  90                     nil)
  91                   (recur a2 env)))
  92
  93               'fn*
  94               (with-meta
  95                 (fn [& args]
  96                   (EVAL a2 (env/env env a1 (or args '()))))
  97                 {:expression a2
  98                  :environment env
  99                  :parameters a1})
 100
 101               ;; apply
 102               (let [el (eval-ast ast env)
 103                     f (first el)
 104                     args (rest el)
 105                     {:keys [expression environment parameters]} (meta f)]
 106                 (if expression
 107                   (recur expression (env/env environment parameters args))
 108                   (apply f args))))))))
 109
 110 ;; print
 111 (defn PRINT [exp] (printer/pr-str exp))
 112
 113 ;; repl
 114 (def repl-env (env/env))
 115 (defn rep
 116   [strng]
 117   (PRINT (EVAL (READ strng) repl-env)))
 118
 119 ;; core.clj: defined using Clojure
 120 (doseq [[k v] core/core_ns] (env/env-set repl-env k v))
 121 (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env)))
 122 (env/env-set repl-env '*ARGV* ())
 123
 124 ;; core.mal: defined using the language itself
 125 (rep "(def! not (fn* [a] (if a false true)))")
 126 (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))")
 127
 128 ;; repl loop
 129 (defn repl-loop []
 130   (let [line (readline/readline "user> ")]
 131     (when line
 132       (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment
 133         (try
 134           (println (rep line))
 135           #?(:clj  (catch Throwable e (clojure.repl/pst e))
 136              :cljs (catch js/Error e (println (.-stack e))))))
 137       (recur))))
 138
 139 (defn -main [& args]
 140   (env/env-set repl-env '*ARGV* (rest args))
 141   (if args
 142     (rep (str "(load-file \"" (first args) "\")"))
 143     (repl-loop)))