Wire up base and prelude

This commit is contained in:
Scott Richmond 2023-11-30 14:31:02 -05:00
parent f4e2171e09
commit fcf9bd76e0
2 changed files with 31 additions and 307 deletions

View File

@ -4,6 +4,7 @@
[ludus.grammar :as g] [ludus.grammar :as g]
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.ast :as ast] [ludus.ast :as ast]
[ludus.base :as base]
[ludus.prelude :as prelude] [ludus.prelude :as prelude]
[ludus.data :as data] [ludus.data :as data]
;;[ludus.loader :as loader] ;;[ludus.loader :as loader]
@ -263,7 +264,7 @@
type (-> data second :data first)] type (-> data second :data first)]
(cond (cond
(contains? ctx name) {:success false :reason (str "Name " name "is already bound") :code :name-error} (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}}))) :else {:success true :ctx {name value}})))
(defn- match [pattern value ctx-vol] (defn- match [pattern value ctx-vol]
@ -588,6 +589,9 @@
(let [[k v] kv] (let [[k v] kv]
[k (f v)])))) [k (f v)]))))
(defn- map-keys [f]
(map (fn [[k v]] [(f k) v])))
; (defn- interpret-import [ast ctx] ; (defn- interpret-import [ast ctx]
; (let [data (:data ast) ; (let [data (:data ast)
; path (-> data first :data first) ; path (-> data first :data first)
@ -852,30 +856,30 @@
(let [lines (clojure.string/split source #"\n")] (let [lines (clojure.string/split source #"\n")]
(clojure.string/trim (nth lines (dec line)))))) (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 (def runtime-error
#?( #?(
:clj clojure.lang.ExceptionInfo :clj clojure.lang.ExceptionInfo
:cljs js/Object :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 ;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret (defn interpret
([source parsed] (interpret source parsed {})) ([source parsed] (interpret source parsed {}))
([source parsed ctx] ([source parsed ctx]
(try (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)) (interpret-ast parsed base-ctx))
(catch #?(:cljs :default :clj Throwable) e (catch #?(:cljs :default :clj Throwable) e
(println "Ludus panicked!") (println "Ludus panicked!")
@ -889,7 +893,7 @@
;; TODO: update this to use new parser pipeline & new AST representation ;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret-file [source path parsed] (defn interpret-file [source path parsed]
(try (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)) (interpret-ast parsed base-ctx))
(catch clojure.lang.ExceptionInfo e (catch clojure.lang.ExceptionInfo e
(println "Ludus panicked in" path) (println "Ludus panicked in" path)
@ -912,7 +916,7 @@
(defn interpret-safe [source parsed ctx] (defn interpret-safe [source parsed ctx]
(try (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)) (interpret-ast parsed base-ctx))
(catch Throwable e (catch Throwable e
(println "Ludus panicked!") (println "Ludus panicked!")
@ -927,14 +931,12 @@
(do (do
(def source " (def source "
let one = 1
ns foo {:zero 0, :one 1, :two 2}
use foo
two two
") ")
(def tokens (-> source scanner/scan :tokens)) (def tokens (-> source scanner/scan :tokens))
(def ast (p/apply-parser g/script tokens)) (def ast (p/apply-parser g/script tokens))
(interpret-safe source ast {}) (interpret-safe source ast {})
) )

View File

@ -1,289 +1,11 @@
(ns ludus.prelude (ns ludus.prelude)
(: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 (def prelude "
;; Right now, they evaluate all their args let one = 1
(def eq {:name "eq" let two = :two
::data/type ::data/clj
:body =})
(defn- id [x] x) ns prelude {
one
(def and- {:name "and" two
::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-
})