Wire up base and prelude
This commit is contained in:
parent
f4e2171e09
commit
fcf9bd76e0
|
@ -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
|
two
|
||||||
ns foo {:zero 0, :one 1, :two 2}
|
|
||||||
use foo
|
|
||||||
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 {})
|
||||||
)
|
)
|
|
@ -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-
|
|
||||||
})
|
|
Loading…
Reference in New Issue
Block a user