From fcf9bd76e04f34a936cdcba5c4fd9c01a2016c72 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Thu, 30 Nov 2023 14:31:02 -0500 Subject: [PATCH] Wire up base and prelude --- src/ludus/interpreter.cljc | 42 +++--- src/ludus/prelude.cljc | 296 ++----------------------------------- 2 files changed, 31 insertions(+), 307 deletions(-) diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index ccee842..5c006c8 100644 --- a/src/ludus/interpreter.cljc +++ b/src/ludus/interpreter.cljc @@ -4,6 +4,7 @@ [ludus.grammar :as g] [ludus.scanner :as scanner] [ludus.ast :as ast] + [ludus.base :as base] [ludus.prelude :as prelude] [ludus.data :as data] ;;[ludus.loader :as loader] @@ -263,7 +264,7 @@ type (-> data second :data first)] (cond (contains? ctx name) {:success false :reason (str "Name " name "is already bound") :code :name-error} - (not (= type (prelude/get-type value))) {:success false :reason (str "Could not match " pattern " with " value ", because types do not match")} + (not (= type (base/get-type value))) {:success false :reason (str "Could not match " pattern " with " value ", because types do not match")} :else {:success true :ctx {name value}}))) (defn- match [pattern value ctx-vol] @@ -588,6 +589,9 @@ (let [[k v] kv] [k (f v)])))) +(defn- map-keys [f] + (map (fn [[k v]] [(f k) v]))) + ; (defn- interpret-import [ast ctx] ; (let [data (:data ast) ; path (-> data first :data first) @@ -852,30 +856,30 @@ (let [lines (clojure.string/split source #"\n")] (clojure.string/trim (nth lines (dec line)))))) -;; TODO: update this to use new parser pipeline & new AST representation -; (defn interpret-file [source path parsed] -; (try -; (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})] -; (interpret-ast parsed base-ctx)) -; (catch clojure.lang.ExceptionInfo e -; (println "Ludus panicked in" path) -; (println "On line" (get-in (ex-data e) [:ast :token :line])) -; (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line]))) -; (println (ex-message e)) -; (System/exit 67)))) - (def runtime-error #?( :clj clojure.lang.ExceptionInfo :cljs js/Object )) +(defn- ns->ctx [ns] + (into {} (map-keys kw->str) ns)) + +(def ludus-prelude + (let [scanned (scanner/scan prelude/prelude) + parsed (p/apply-parser g/script (:tokens scanned)) + base-ctx (volatile! {::parent (volatile! base/base)}) + interpreted (interpret-ast parsed base-ctx) + namespace (dissoc interpreted ::data/type ::data/name ::data/struct) + context (ns->ctx namespace)] + context)) + ;; TODO: update this to use new parser pipeline & new AST representation (defn interpret ([source parsed] (interpret source parsed {})) ([source parsed ctx] (try - (let [base-ctx (volatile! {::parent (volatile! (merge prelude/prelude ctx))})] + (let [base-ctx (volatile! {::parent (volatile! (merge ludus-prelude ctx))})] (interpret-ast parsed base-ctx)) (catch #?(:cljs :default :clj Throwable) e (println "Ludus panicked!") @@ -889,7 +893,7 @@ ;; TODO: update this to use new parser pipeline & new AST representation (defn interpret-file [source path parsed] (try - (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})] + (let [base-ctx (volatile! {::parent (volatile! ludus-prelude) :file path})] (interpret-ast parsed base-ctx)) (catch clojure.lang.ExceptionInfo e (println "Ludus panicked in" path) @@ -912,7 +916,7 @@ (defn interpret-safe [source parsed ctx] (try - (let [base-ctx (volatile! {::parent (volatile! (merge prelude/prelude ctx))})] + (let [base-ctx (volatile! {::parent (volatile! (merge ludus-prelude ctx))})] (interpret-ast parsed base-ctx)) (catch Throwable e (println "Ludus panicked!") @@ -927,14 +931,12 @@ (do (def source " -let one = 1 -ns foo {:zero 0, :one 1, :two 2} -use foo -two + two ") (def tokens (-> source scanner/scan :tokens)) (def ast (p/apply-parser g/script tokens)) + (interpret-safe source ast {}) ) \ No newline at end of file diff --git a/src/ludus/prelude.cljc b/src/ludus/prelude.cljc index ba3b498..bf74dee 100644 --- a/src/ludus/prelude.cljc +++ b/src/ludus/prelude.cljc @@ -1,289 +1,11 @@ -(ns ludus.prelude - (:require - [ludus.data :as data] - [ludus.show :as show] - ;[ludus.draw :as d] - #?(:cljs [cljs.reader]) - #?(:cljs [goog.object :as o]) - )) +(ns ludus.prelude) -;; 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 =}) +(def prelude " +let one = 1 +let two = :two -(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 prelude { - "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 +ns prelude { + one + two +} +") \ No newline at end of file