diff options
Diffstat (limited to 'clojure')
| -rw-r--r-- | clojure/Makefile | 17 | ||||
| -rw-r--r-- | clojure/project.clj | 25 | ||||
| -rw-r--r-- | clojure/src/reader.clj | 32 | ||||
| -rw-r--r-- | clojure/src/readline.clj | 36 | ||||
| -rw-r--r-- | clojure/src/step0_repl.clj | 26 | ||||
| -rw-r--r-- | clojure/src/step1_read_print.clj | 33 | ||||
| -rw-r--r-- | clojure/src/step2_eval.clj | 61 | ||||
| -rw-r--r-- | clojure/src/step3_env.clj | 76 | ||||
| -rw-r--r-- | clojure/src/step4_if_fn_do.clj | 92 | ||||
| -rw-r--r-- | clojure/src/step5_tco.clj | 101 | ||||
| -rw-r--r-- | clojure/src/step6_file.clj | 109 | ||||
| -rw-r--r-- | clojure/src/step7_quote.clj | 132 | ||||
| -rw-r--r-- | clojure/src/step8_macros.clj | 158 | ||||
| -rw-r--r-- | clojure/src/step9_interop.clj | 161 | ||||
| -rw-r--r-- | clojure/src/stepA_more.clj | 178 | ||||
| -rw-r--r-- | clojure/src/types.clj | 71 |
16 files changed, 1308 insertions, 0 deletions
diff --git a/clojure/Makefile b/clojure/Makefile new file mode 100644 index 0000000..d18eb50 --- /dev/null +++ b/clojure/Makefile @@ -0,0 +1,17 @@ + +TESTS = + +SOURCES = src/types.clj src/readline.clj src/reader.clj src/stepA_more.clj + +all: + +.PHONY: stats tests $(TESTS) + +stats: $(SOURCES) + @wc $^ + +tests: $(TESTS) + +$(TESTS): + @echo "Running $@"; \ + lein with-profile XXX$@XXX trampoline run || exit 1; \ diff --git a/clojure/project.clj b/clojure/project.clj new file mode 100644 index 0000000..4e7a15f --- /dev/null +++ b/clojure/project.clj @@ -0,0 +1,25 @@ +(defproject mal "0.0.1-SNAPSHOT" + :description "Make-A-Lisp" + + :dependencies [[org.clojure/clojure "1.5.1"] + [org.clojure/tools.reader "0.8.3"] + [net.n01se/clojure-jna "1.0.0"]] + + ;; To run a step with correct readline behavior: + ;; lein trampoline with-profile stepX run + ;; To load step in repl: + ;; lein with-profile +stepX repl + :profiles {:step0 {:main step0-repl} + :step1 {:main step1-read-print} + :step2 {:main step2-eval} + :step3 {:main step3-env} + :step4 {:main step4-if-fn-do} + :step5 {:main step5-tco} + :step6 {:main step6-file} + :step7 {:main step7-quote} + :step8 {:main step8-macros} + :step9 {:main step9-interop} + :stepA {:main stepA-more}} + + :main stepA-more) + diff --git a/clojure/src/reader.clj b/clojure/src/reader.clj new file mode 100644 index 0000000..8f14767 --- /dev/null +++ b/clojure/src/reader.clj @@ -0,0 +1,32 @@ +(ns reader + (:refer-clojure :exclude [read-string]) + (:require [clojure.tools.reader :as r] + [clojure.tools.reader.reader-types :as rt])) + +;; change tools.reader syntax-quote to quasiquote +(defn- wrap [sym] + (fn [rdr _] (list sym (#'r/read rdr true nil true)))) + +(defn- wrap-with [sym] + (fn [rdr arg _] (list sym (#'r/read rdr true nil true) arg))) + +;; Override some tools.reader reader macros so that we can do our own +;; metadata and quasiquote handling +(alter-var-root #'r/macros + (fn [f] + (fn [ch] + (case ch + \` (wrap 'quasiquote) + \~ (fn [rdr comma] + (if-let [ch (rt/peek-char rdr)] + (if (identical? \@ ch) + ((wrap 'splice-unquote) (doto rdr rt/read-char) \@) + ((wrap 'unquote) rdr \~)))) + \^ (fn [rdr comma] + (let [m (#'r/read rdr)] + ((wrap-with 'with-meta) rdr m \^))) + \@ (wrap 'deref) + (f ch))))) + +(defn read-string [s] + (r/read-string s)) diff --git a/clojure/src/readline.clj b/clojure/src/readline.clj new file mode 100644 index 0000000..dbd4872 --- /dev/null +++ b/clojure/src/readline.clj @@ -0,0 +1,36 @@ +(ns readline + (:require [clojure.string :refer [split]] + [net.n01se.clojure-jna :as jna])) + +(defonce history-loaded (atom nil)) +(def HISTORY-FILE "/home/joelm/.mal-history") + +;; +;; Uncomment one of the following readline libraries +;; + +;; editline (BSD) +#_ +(do + (def readline-call (jna/to-fn String edit/readline)) + (def add-history (jna/to-fn Void edit/add_history)) + (def load-history #(doseq [line (split (slurp %) #"\n")] + (jna/invoke Void edit/add_history line)))) + +;; GNU Readline (GPL) +;; WARNING: distributing your code with GNU readline enabled means you +;; must release your program as GPL +;#_ +(do + (def readline-call (jna/to-fn String readline/readline)) + (def add-history (jna/to-fn Void readline/add_history)) + (def load-history (jna/to-fn Integer readline/read_history))) + +(defn readline [prompt & [lib]] + (if (not @history-loaded) + (load-history HISTORY-FILE)) + (let [line (readline-call prompt)] + (when line + (add-history line) + (spit HISTORY-FILE (str line "\n") :append true)) + line)) diff --git a/clojure/src/step0_repl.clj b/clojure/src/step0_repl.clj new file mode 100644 index 0000000..7a050c7 --- /dev/null +++ b/clojure/src/step0_repl.clj @@ -0,0 +1,26 @@ +(ns step0-repl + (:require [readline])) + + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + strng)) + +;; eval +(defn EVAL [ast env] + (eval (read-string ast))) + +;; print +(defn PRINT [exp] + exp) + +;; repl +(defn rep [strng] (PRINT (EVAL (READ strng), {}))) + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (println (rep line)) + (recur))))) diff --git a/clojure/src/step1_read_print.clj b/clojure/src/step1_read_print.clj new file mode 100644 index 0000000..a99a0ed --- /dev/null +++ b/clojure/src/step1_read_print.clj @@ -0,0 +1,33 @@ +(ns step1-read-print + (:require [clojure.repl] + [types] + [readline] + [reader])) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn EVAL [ast env] + ast) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(defn rep + [strng] + (PRINT (EVAL (READ strng), {}))) + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur))))) diff --git a/clojure/src/step2_eval.clj b/clojure/src/step2_eval.clj new file mode 100644 index 0000000..6ff9eb3 --- /dev/null +++ b/clojure/src/step2_eval.clj @@ -0,0 +1,61 @@ +(ns step2-eval + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn eval-ast [ast env] + (cond + (symbol? ast) (or (get env ast) + (throw (Error. (str ast " not found")))) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [el (eval-ast ast env) + f (first el) + args (rest el)] + (apply f args)))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env {'+ + + '- - + '* * + '/ /}) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur))))) diff --git a/clojure/src/step3_env.clj b/clojure/src/step3_env.clj new file mode 100644 index 0000000..c0c4e8e --- /dev/null +++ b/clojure/src/step3_env.clj @@ -0,0 +1,76 @@ +(ns step3-env + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el)] + (apply f args)))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) +(_ref '+ +) +(_ref '- -) +(_ref '* *) +(_ref '/ /) + + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur))))) diff --git a/clojure/src/step4_if_fn_do.clj b/clojure/src/step4_if_fn_do.clj new file mode 100644 index 0000000..4171848 --- /dev/null +++ b/clojure/src/step4_if_fn_do.clj @@ -0,0 +1,92 @@ +(ns step4-if-fn-do + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'do + (last (eval-ast (rest ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (EVAL a3 env) + nil) + (EVAL a2 env))) + + 'fn* + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el)] + (apply f args)))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur))))) diff --git a/clojure/src/step5_tco.clj b/clojure/src/step5_tco.clj new file mode 100644 index 0000000..2ed07b4 --- /dev/null +++ b/clojure/src/step5_tco.clj @@ -0,0 +1,101 @@ +(ns step5-tco + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") + +(defn -main [& args] + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur))))) diff --git a/clojure/src/step6_file.clj b/clojure/src/step6_file.clj new file mode 100644 index 0000000..80eedef --- /dev/null +++ b/clojure/src/step6_file.clj @@ -0,0 +1,109 @@ +(ns step6-file + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(_ref 'read-string reader/read-string) +(_ref 'eval (fn [ast] (EVAL ast repl-env))) +(_ref 'slurp slurp) +(_ref 'slurp-do (fn [f] (str "(do " (slurp f) ")"))) + +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (slurp-do f)))))") + +(defn -main [& args] + (if args + (rep (str "(load-file \"" (first args) "\")")) + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))))) diff --git a/clojure/src/step7_quote.clj b/clojure/src/step7_quote.clj new file mode 100644 index 0000000..8f190dd --- /dev/null +++ b/clojure/src/step7_quote.clj @@ -0,0 +1,132 @@ +(ns step7-quote + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'quote + a1 + + 'quasiquote + (EVAL (quasiquote a1) env) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng), repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(_ref 'read-string reader/read-string) +(_ref 'eval (fn [ast] (EVAL ast repl-env))) +(_ref 'slurp slurp) +(_ref 'slurp-do (fn [f] (str "(do " (slurp f) ")"))) + +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (slurp-do f)))))") + +(defn -main [& args] + (if args + (rep (str "(load-file \"" (first args) "\")")) + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))))) diff --git a/clojure/src/step8_macros.clj b/clojure/src/step8_macros.clj new file mode 100644 index 0000000..8b95ba8 --- /dev/null +++ b/clojure/src/step8_macros.clj @@ -0,0 +1,158 @@ +(ns step8-macros + (:refer-clojure :exclude [macroexpand]) + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn is-macro-call [ast env] + (and (seq? ast) + (symbol? (first ast)) + (types/env-find env (first ast)) + (:ismacro (meta (types/env-get env (first ast)))))) + +(defn macroexpand [ast env] + (loop [ast ast] + (if (is-macro-call ast env) + (let [mac (types/env-get env (first ast))] + (recur (apply mac (rest ast)))) + ast))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [ast (macroexpand ast env)] + (if (not (seq? ast)) + ast + + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'quote + a1 + + 'quasiquote + (EVAL (quasiquote a1) env) + + 'defmacro! + (let [func (with-meta (EVAL a2 env) + {:ismacro true})] + (types/env-set env a1 func)) + + 'macroexpand + (macroexpand a1 env) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(_ref 'read-string reader/read-string) +(_ref 'eval (fn [ast] (EVAL ast repl-env))) +(_ref 'slurp slurp) +(_ref 'slurp-do (fn [f] (str "(do " (slurp f) ")"))) + +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (slurp-do f)))))") + +(defn -main [& args] + (if args + (rep (str "(load-file \"" (first args) "\")")) + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))))) diff --git a/clojure/src/step9_interop.clj b/clojure/src/step9_interop.clj new file mode 100644 index 0000000..48ae687 --- /dev/null +++ b/clojure/src/step9_interop.clj @@ -0,0 +1,161 @@ +(ns step9-interop + (:refer-clojure :exclude [macroexpand]) + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn is-macro-call [ast env] + (and (seq? ast) + (symbol? (first ast)) + (types/env-find env (first ast)) + (:ismacro (meta (types/env-get env (first ast)))))) + +(defn macroexpand [ast env] + (loop [ast ast] + (if (is-macro-call ast env) + (let [mac (types/env-get env (first ast))] + (recur (apply mac (rest ast)))) + ast))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [ast (macroexpand ast env)] + (if (not (seq? ast)) + ast + + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'quote + a1 + + 'quasiquote + (EVAL (quasiquote a1) env) + + 'defmacro! + (let [func (with-meta (EVAL a2 env) + {:ismacro true})] + (types/env-set env a1 func)) + + 'macroexpand + (macroexpand a1 env) + + 'clj* + (eval (reader/read-string a1)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(_ref 'read-string reader/read-string) +(_ref 'eval (fn [ast] (EVAL ast repl-env))) +(_ref 'slurp slurp) +(_ref 'slurp-do (fn [f] (str "(do " (slurp f) ")"))) + +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (slurp-do f)))))") + +(defn -main [& args] + (if args + (rep (str "(load-file \"" (first args) "\")")) + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))))) diff --git a/clojure/src/stepA_more.clj b/clojure/src/stepA_more.clj new file mode 100644 index 0000000..19a0c36 --- /dev/null +++ b/clojure/src/stepA_more.clj @@ -0,0 +1,178 @@ +(ns stepA-more + (:refer-clojure :exclude [macroexpand]) + (:require [clojure.repl] + [types] + [readline] + [reader])) + +(declare EVAL) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn is-macro-call [ast env] + (and (seq? ast) + (symbol? (first ast)) + (types/env-find env (first ast)) + (:ismacro (meta (types/env-get env (first ast)))))) + +(defn macroexpand [ast env] + (loop [ast ast] + (if (is-macro-call ast env) + (let [mac (types/env-get env (first ast))] + (recur (apply mac (rest ast)))) + ast))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (types/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [ast (macroexpand ast env)] + (if (not (seq? ast)) + ast + + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (types/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (types/env env)] + (doseq [[b e] (partition 2 a1)] + (types/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'quote + a1 + + 'quasiquote + (EVAL (quasiquote a1) env) + + 'defmacro! + (let [func (with-meta (EVAL a2 env) + {:ismacro true})] + (types/env-set env a1 func)) + + 'macroexpand + (macroexpand a1 env) + + 'clj* + (eval (reader/read-string a1)) + + 'try* + (if (= 'catch* (nth a2 0)) + (try + (EVAL a1 env) + (catch clojure.lang.ExceptionInfo ei + (EVAL (nth a2 2) (types/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) + (catch Throwable t + (EVAL (nth a2 2) (types/env env + [(nth a2 1)] + [(.getMessage t)])))) + (EVAL a1 env)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + ^{:expression a2 + :environment env + :parameters a1} + (fn [& args] + (EVAL a2 (types/env env a1 args))) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (types/env environment parameters args)) + (apply f args)))))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (types/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +(defn _ref [k,v] (types/env-set repl-env k v)) + +;; Import types related functions +(doseq [[k v] types/types_ns] (_ref k v)) + +;; Defined using the language itself +(_ref 'readline readline/readline) +(_ref 'read-string reader/read-string) +(_ref 'eval (fn [ast] (EVAL ast repl-env))) +(_ref 'slurp slurp) +(_ref 'slurp-do (fn [f] (str "(do " (slurp f) ")"))) + +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") +(rep "(def! load-file (fn* [f] (eval (read-string (slurp-do f)))))") + +(defn -main [& args] + (if args + (rep (str "(load-file \"" (first args) "\")")) + (loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))))) diff --git a/clojure/src/types.clj b/clojure/src/types.clj new file mode 100644 index 0000000..922cf79 --- /dev/null +++ b/clojure/src/types.clj @@ -0,0 +1,71 @@ +(ns types) + +;; Custom printing + +(defmethod clojure.core/print-method clojure.lang.Atom [a writer] + (.write writer "(atom ") + (.write writer (pr-str @a)) + (.write writer ")")) + +;; Errors/exceptions +(defn mal_throw [obj] + (throw (ex-info "mal exception" {:data obj}))) + + +;; Atoms +(defn atom? [atm] + (= (type atm) clojure.lang.Atom)) + + +;; env + +(defn env [& [outer binds exprs]] + ;;(prn "env" binds exprs) + ;; (when (not= (count binds) (count exprs)) + ;; (throw (Exception. "Arity mistmatch in env call"))) + (atom + (loop [env {:outer outer} + b binds + e exprs] + (cond + (= nil b) + env + + (= '& (first b)) + (assoc env (nth b 1) e) + + :else + (recur (assoc env (first b) (first e)) (next b) (next e)))))) + +(defn env-find [env k] + (cond + (contains? @env k) env + (:outer @env) (env-find (:outer @env) k) + :else nil)) + +(defn env-get [env k] + (let [e (env-find env k)] + (when-not e + (throw (Exception. (str "'" k "' not found")))) + (get @e k))) + +(defn env-set [env k v] + (swap! env assoc k v) + v) + +(def types_ns + [['pr-str pr-str] ['str str] ['prn prn] ['println println] + ['with-meta with-meta] ['meta meta] ['= =] + ['nil? nil?] ['true? true?] ['false? false?] ['symbol? symbol?] + ['> >] ['>= >=] ['< <] ['<= <=] ['+ +] ['- -] ['* *] ['/ /] + ['hash-map hash-map] ['map? map?] + ['assoc assoc] ['dissoc dissoc] ['get get] + ['contains? contains?] ['keys keys] ['vals vals] + ['throw mal_throw] + ['list list] ['list? seq?] ['vector vector] ['vector? vector?] + ['atom atom] ['atom? atom?] ['deref deref] + ['reset! reset!] ['swap! swap!] + ['sequential? sequential?] ['cons cons] ['nth nth] + ['empty? empty?] ['count count] ['concat concat] + ['conj conj] ['first first] ['rest rest] + ['apply apply] ['map #(doall (map %1 %2))]]) |