diff --git a/src/ludus/base.cljc b/src/ludus/base.cljc new file mode 100644 index 0000000..d2c96e7 --- /dev/null +++ b/src/ludus/base.cljc @@ -0,0 +1,289 @@ +(ns ludus.base + (:require + [ludus.data :as data] + [ludus.show :as show] + ;[ludus.draw :as d] + #?(:cljs [cljs.reader]) + #?(:cljs [goog.object :as o]) + )) + +;; TODO: make eq, and, or special forms that short-circuit +;; Right now, they evaluate all their args +(def eq {:name "eq" + ::data/type ::data/clj + :body =}) + +(defn- id [x] x) + +(def and- {:name "and" + ::data/type ::data/clj + :body (fn [& args] (every? id args))}) + +(def or- {:name "or" + ::data/type ::data/clj + :body (fn [& args] (some id args))}) + +(def add {:name "add" + ::data/type ::data/clj + :body +}) + +(def sub {:name "sub" + ::data/type ::data/clj + :body -}) + +(def mult {:name "mult" + ::data/type ::data/clj + :body *}) + +(def div {:name "div" + ::data/type ::data/clj + :body /}) + +(def gt {:name "gt" + ::data/type ::data/clj + :body >}) + +(def gte {:name "gte" + ::data/type ::data/clj + :body >=}) + +(def lt {:name "lt" + ::data/type ::data/clj + :body <}) + +(def lte {:name "lte" + ::data/type ::data/clj + :body <=}) + +(def inc- {:name "inc" + ::data/type ::data/clj + :body inc}) + +(def dec- {:name "dec" + ::data/type ::data/clj + :body dec}) + +(def ld-not {:name "not" + ::data/type ::data/clj + :body not}) + +(def panic! {:name "panic!" + ::data/type ::data/clj + :body (fn [& args] (throw (ex-info (apply show/show (interpose " " args)) {})))}) + +(defn- print-show [lvalue] + (if (string? lvalue) lvalue (show/show lvalue))) + +(def print- {:name "print" + ::data/type ::data/clj + :body (fn [& args] + (println (apply str (into [] (map print-show) args))) + :ok)}) + +(def deref- {:name "deref" + ::data/type ::data/clj + :body (fn [ref] + (if (::data/ref ref) + (deref (::data/value ref)) + (throw (ex-info "Cannot deref something that is not a ref" {}))))}) + +(def set!- {:name "set!" + ::data/type ::data/clj + :body (fn [ref value] + (if (::data/ref ref) + (reset! (::data/value ref) value) + (throw (ex-info "Cannot set! something that is not a ref" {}))))}) + +(def show {:name "show" + ::data/type ::data/clj + :body ludus.show/show}) + +(def conj- {:name "conj" + ::data/type ::data/clj + :body conj}) + +(def assoc- {:name "assoc" + ::data/type ::data/clj + :body assoc}) + +(def get- {:name "get" + ::data/type ::data/clj + :body (fn + ([key, map] + (if (map? map) + (get map key) + nil)) + ([key, map, default] + (if (map? map) + (get map key default) + default)))}) + +(def first- {:name "first" + ::data/type ::data/clj + :body (fn [v] (second v))}) + +(def rest- {:name "rest" + ::data/type ::data/clj + :body (fn [v] + (into [::data/list] (nthrest v 2)))}) + +(def nth- {:name "nth" + ::data/type ::data/clj + :body (fn + ([i, xs] + (cond + (> 0 i) nil + (contains? xs (inc i)) (nth xs (inc i)) + :else nil)) + ([i, xs, default] + (cond + (> 0 i) default + (contains? xs (inc i)) (nth xs (inc i)) + :else default)))}) + +(def types { + :keyword + #?( + :clj clojure.lang.Keyword + :cljs cljs.core/Keyword + ) + + :long + #?( + :clj java.lang.Long + :cljs js/Number + ) + + :double + #?( + :clj java.lang.Double + :cljs js/Number + ) + + :string + #?( + :clj java.lang.String + :cljs js/String + ) + + :boolean + #?( + :clj java.lang.Boolean + :cljs js/Boolean + ) + + :set + #?( + :clj clojure.lang.PersistentHashSet + :cljs cljs.core/PersistentHashSet + ) + + :vector + #?( + :clj clojure.lang.PersistentVector + :cljs cljs.core/PersistentVector + ) + + :map + #?( + :clj clojure.lang.PersistentArrayMap + :cljs cljs.core/PersistentArrayMap + ) + }) + +(defn get-type [value] + (let [t (type value)] + (cond + (nil? value) :nil + + (= (:keyword types) t) :keyword + + (= (:long types) t) :number + + (= (:double types) t) :number + + (= (:string types) t) :string + + (= (:boolean types) t) :boolean + + (= (:set types) t) :set + + ;; tuples and lists + (= (:vector types) t) + (if (= ::data/tuple (first value)) :tuple :list) + + ;; structs dicts namespaces refs + (= (:map types) t) + (cond + (::data/type value) (case (::data/type value) + (::data/fn ::data/clj) :fn + ::data/ns :ns) + (::data/dict value) :dict + (::data/struct value) :struct + :else :none + )))) + +(def type- {:name "type" + ::data/type ::data/clj + :body get-type}) + +(defn strpart [kw] (->> kw str rest (apply str))) + +(def readstr + #?( + :clj read-string + :cljs cljs.reader/read-string + )) + +(defn- resolve-str [str] + #?( + :clj (eval str) + :cljs (.bind (o/get js/window str) js/window) + )) + +(def extern {:name "extern" + ::data/type ::data/clj + :body (fn [& args] + ;(println "Args passed: " args) + (let [called (-> args first strpart readstr resolve-str) + fn-args (rest args)] + ;(println "Fn: " called) + ;(println "Args: " (clj->js fn-args)) + #?( + :clj (apply called fn-args) + :cljs (.apply called js/window (clj->js fn-args)))))}) + +(def count- {:name "count" + ::data/type ::data/clj + :body (fn [xs] (dec (count xs)))}) + +(def base { + "id" id + "eq" eq + "add" add + "print" print- + "sub" sub + "mult" mult + "div" div + "gt" gt + "gte" gte + "lt" lt + "lte" lte + "inc" inc- + "dec" dec- + "not" not + "show" show + "deref" deref- + "set!" set!- + "and" and- + "or" or- + "assoc" assoc- + "conj" conj- + "get" get- + "type" type- + "extern" extern + "first" first- + "rest" rest- + "nth" nth- + "count" count- + }) \ No newline at end of file diff --git a/src/ludus/core.clj b/src/ludus/core.clj new file mode 100644 index 0000000..6767476 --- /dev/null +++ b/src/ludus/core.clj @@ -0,0 +1,38 @@ +(ns ludus.core + "A tree-walk interpreter for the Ludus language." + (:require + [ludus.scanner :as scanner] + [ludus.parser :as p] + [ludus.grammar :as g] + [ludus.interpreter :as interpreter] + [ludus.show :as show] + [clojure.pprint :as pp] + [ludus.loader :as loader] + [ludus.repl :as repl]) + (:gen-class)) + +(defn- run [file source] + (let [scanned (scanner/scan source)] + (if (not-empty (:errors scanned)) + (do + (println "I found some scanning errors!") + (pp/pprint (:errors scanned)) + (System/exit 65)) + (let [parsed (p/apply-parser g/script (:tokens scanned))] + (if (p/fail? parsed) + (do + (println "I found some parsing errors!") + (println (p/err-msg parsed)) + (System/exit 66)) + (let [interpreted (interpreter/interpret source file parsed)] + (println (show/show interpreted)) + (System/exit 0))))))) + +(defn -main [& args] + (cond + (= (count args) 1) + (let [file (first args) + source (loader/load-import file)] + (run file source)) + + :else (repl/launch))) \ No newline at end of file diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index cd8157c..54f47bf 100644 --- a/src/ludus/interpreter.cljc +++ b/src/ludus/interpreter.cljc @@ -420,6 +420,7 @@ (get map kw)))))) (defn- call-fn [lfn args ctx] + (println "Calling function " (:name lfn)) (cond (= ::data/partial (first args)) {::data/type ::data/clj @@ -932,12 +933,19 @@ (do (def source " - :foo + let foo = fn () -> :foo + fn bar () -> :bar + & foo () + bar () ") (def tokens (-> source scanner/scan :tokens)) (def ast (p/apply-parser g/script tokens)) - (interpret-safe source ast {}) + (def result (interpret-safe source ast {})) + + ;(pp/pprint result) + + result ) \ No newline at end of file