Compare commits
4 Commits
c7a887b694
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
| 076fce6e52 | |||
| 4514f9c8e8 | |||
| 9cf2e4476c | |||
| 1bb55f4d36 |
3
README.org
Normal file
3
README.org
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
* EMPTYHEAD
|
||||||
|
WIP +overengineered game engine+ programming language VM/runtime
|
||||||
|
Apologies for the mess/lack of documentation, it's slowly moving towards something that's easier to explain but currently on a bit of a research break as I nail down language semantics
|
||||||
71
src/cljs/emptyhead/lib/object/core.cljs
Normal file
71
src/cljs/emptyhead/lib/object/core.cljs
Normal file
@@ -0,0 +1,71 @@
|
|||||||
|
(ns emptyhead.lib.object.core
|
||||||
|
(:require [emptyhead.thought.crud :as thought]
|
||||||
|
[emptyhead.thought.define :as def]
|
||||||
|
[emptyhead.idea.property :as prop]
|
||||||
|
[emptyhead.thought.extend :as extend]
|
||||||
|
[emptyhead.thought.eval :as eval]
|
||||||
|
))
|
||||||
|
|
||||||
|
(def/define! [:EH :CORE :RETURN]
|
||||||
|
(fn [thought parent]
|
||||||
|
[parent (thought/data thought)]))
|
||||||
|
|
||||||
|
(def/define! [:EH :DEBUG :PRINT-DATA]
|
||||||
|
(fn [thought parent]
|
||||||
|
(print (thought/data thought))
|
||||||
|
[parent nil]))
|
||||||
|
|
||||||
|
(def/define! [:EH :NOP] (fn [parent _] [parent nil]))
|
||||||
|
|
||||||
|
(def/define! [:EH :CALL] (fn [parent _] [parent nil]))
|
||||||
|
|
||||||
|
(def/define! [:EH :DEBUG :WHOAMI]
|
||||||
|
(fn [_ parent]
|
||||||
|
(let [[_ self] (thought/pop-stack parent)]
|
||||||
|
(println "Hello from " self "!")
|
||||||
|
(println parent)
|
||||||
|
[parent nil])))
|
||||||
|
|
||||||
|
(def/define! [:EH :DEBUG :PRINT-TOS]
|
||||||
|
(fn [_ parent]
|
||||||
|
(let [[parent self] (thought/pop-stack parent)
|
||||||
|
[_ stack] (thought/pop-stack parent)
|
||||||
|
val (last stack)]
|
||||||
|
(println val)
|
||||||
|
[parent nil])))
|
||||||
|
|
||||||
|
(def sexer (thought/register-thought! [:EH :DEBUG :WHOAMI]))
|
||||||
|
|
||||||
|
;; TODO magic identifiers
|
||||||
|
(defn create []
|
||||||
|
[:EH :OBJ (keyword (gensym "O-"))])
|
||||||
|
|
||||||
|
(defn extend [object name daughter]
|
||||||
|
(extend/register-extension!
|
||||||
|
(thought/register-thought! [:EH :CORE :RETURN] :data daughter)
|
||||||
|
(conj object name)))
|
||||||
|
|
||||||
|
(defn implement [object thought]
|
||||||
|
(extend/register-extension! thought (conj object :_CALL)))
|
||||||
|
|
||||||
|
(defn call [object thought]
|
||||||
|
(eval/execute!
|
||||||
|
(thought/make-thought [:EH :CALL]
|
||||||
|
:return [(thought/stack thought) object]
|
||||||
|
:ext-stages [(conj object :_CALL)])
|
||||||
|
thought))
|
||||||
|
|
||||||
|
(defn val->obj [val]
|
||||||
|
(let [obj (create)
|
||||||
|
val-th (thought/register-thought! [:EH :CORE :RETURN] :data val)]
|
||||||
|
(implement obj val-th)
|
||||||
|
obj))
|
||||||
|
|
||||||
|
(defn th->obj [op & [data]]
|
||||||
|
(let [obj (create)
|
||||||
|
val-th (thought/register-thought! op :data data)]
|
||||||
|
(implement obj val-th)
|
||||||
|
obj))
|
||||||
|
|
||||||
|
(defn val->obj [val]
|
||||||
|
(th->obj [:EH :CORE :RETURN] val))
|
||||||
@@ -8,13 +8,14 @@
|
|||||||
(defn make-thought
|
(defn make-thought
|
||||||
"Helper function to make thought object.
|
"Helper function to make thought object.
|
||||||
You may want `register-thought!` instead."
|
You may want `register-thought!` instead."
|
||||||
[operator & {:keys [data ext-stages]
|
[operator & {:keys [data ext-stages return]
|
||||||
:or {data {}
|
:or {data {}
|
||||||
ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]}}]
|
ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]
|
||||||
|
return []}}]
|
||||||
(hash-map :operator operator
|
(hash-map :operator operator
|
||||||
:data data
|
:data data
|
||||||
:ext-stages ext-stages
|
:ext-stages ext-stages
|
||||||
:return []))
|
:return return))
|
||||||
|
|
||||||
(defn register-thought!
|
(defn register-thought!
|
||||||
"Create a thought and register it in the state.
|
"Create a thought and register it in the state.
|
||||||
|
|||||||
@@ -14,12 +14,14 @@
|
|||||||
(if-not impl-idea
|
(if-not impl-idea
|
||||||
(logging/error (str "No implementation for thought `" (thought/operator thought) "`.")
|
(logging/error (str "No implementation for thought `" (thought/operator thought) "`.")
|
||||||
{:thought thought :parent parent :type :unimplemented-thought})
|
{:thought thought :parent parent :type :unimplemented-thought})
|
||||||
((:implementation impl-idea) thought parent))))
|
((prtc/val-fn :implementation impl-idea) thought parent))))
|
||||||
|
|
||||||
|
;; FIXME I don't think omitting the parent here is actually valid?
|
||||||
|
;; might need to use thought.crud/root-thought, but better making parent mandatory tabun
|
||||||
(defn execute!
|
(defn execute!
|
||||||
"Execute `thought` with `parent`, applying aspects to `thought` according to its :extension-stages.
|
"Execute `thought` with `parent`, applying aspects to `thought` according to its :extension-stages.
|
||||||
Returns (potentially modified) `parent`."
|
Returns (potentially modified) `parent`."
|
||||||
[thought parent]
|
[thought & [parent]]
|
||||||
(loop [th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)
|
(loop [th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)
|
||||||
parent parent]
|
parent parent]
|
||||||
(let [[extensions th cur] (extend/pop-stage th)
|
(let [[extensions th cur] (extend/pop-stage th)
|
||||||
|
|||||||
@@ -3,11 +3,11 @@
|
|||||||
(:require [emptyhead.idea.protocol :as prtc]))
|
(:require [emptyhead.idea.protocol :as prtc]))
|
||||||
|
|
||||||
(defn with-return
|
(defn with-return
|
||||||
"Returns a copy of the thought with all values in data
|
"Returns the thought with all values in data
|
||||||
added to the top of its stack."
|
added to the top of its stack."
|
||||||
[thought data]
|
[thought data]
|
||||||
(if (first data)
|
(if (first data)
|
||||||
(prtc/copy-fn
|
(prtc/val-fn
|
||||||
#(update % :return (fnil into []) data) thought)
|
#(update % :return (fnil into []) data) thought)
|
||||||
thought))
|
thought))
|
||||||
|
|
||||||
|
|||||||
@@ -9,5 +9,10 @@
|
|||||||
(defn thought-impl-prop [operator]
|
(defn thought-impl-prop [operator]
|
||||||
(conj thought-impl-ns operator))
|
(conj thought-impl-ns operator))
|
||||||
|
|
||||||
|
(def extension-ns (conj thought-ns :extends))
|
||||||
|
|
||||||
|
(defn extension-prop [stage]
|
||||||
|
(conj extension-ns stage))
|
||||||
|
|
||||||
(defn symbolize-ns [ns]
|
(defn symbolize-ns [ns]
|
||||||
(str/join "." (map name ns)))
|
(str/join "." (map name ns)))
|
||||||
|
|||||||
Reference in New Issue
Block a user