sdfsdfs

src/cljs/emptyhead/repl/core.cljs

@@ -0,0 +1,112 @@
+(ns emptyhead.repl.core
+  (:require [clojure.string :as str]
+            [emptyhead.thought.extend :as extend]
+            [emptyhead.thought.eval :as teval]
+            [emptyhead.idea.property :as prop]
+            [emptyhead.idea.protocol :as prtc]
+            [emptyhead.idea.memtag :as memtag]
+            [emptyhead.thought.define :as def]
+            [emptyhead.thought.crud :as thought]
+            [emptyhead.lib.core]
+            [emptyhead.lib.context :as ctx]))
+
+(defonce context (ctx/new-context))
+(defn clear-context [] (set! context (ctx/new-context)))
+
+(defn undot-operator [dotted-sym]
+  (mapv keyword (str/split (name dotted-sym) #"\.")))
+
+(defn eval! [thought & [parent]]
+  (set! context (teval/execute! thought parent)))
+
+(defn parse-command [cmd]
+  (cond
+    (= cmd '.BEGIN)         (thought/register-thought! [:emptyhead :repl :begin-block])
+    (= cmd '.END)           (thought/register-thought! [:emptyhead :repl :end-block])
+
+    (symbol? cmd)           (thought/register-thought!
+                             [:emptyhead :compose :append]
+                             :data (thought/register-thought! (undot-operator cmd)))
+
+    :else                   (thought/register-thought!
+                             [:emptyhead :compose :append]
+                             :data (thought/register-thought! [:emptyhead :core :return] :data cmd))))
+
+(def/define! [:emptyhead :repl :begin-block]
+  (fn [thought parent]
+    (let [ctx-creator (thought/register-thought! [:emptyhead :core :context :construct])
+          ;; Create a new context with `parent` as parent.
+          [parent ctx] (->> parent (teval/execute! ctx-creator) thought/pop-stack)
+          ctx (prop/just-property ctx)
+          ;; Make `parent` put the new context on its stack during its execution flow
+          ;; TODO refactor
+          parent (teval/execute! (thought/register-thought!
+                                  [:emptyhead :compose :append]
+                                  :data (thought/register-thought! [:emptyhead :core :return]
+                                                                   :data (memtag/uid-of ctx)))
+                                 parent)]
+
+      ;; NOTE `ctx` becomes the new `parent`!
+      [ctx
+       ctx])))
+
+(def/define! [:emptyhead :repl :end-block]
+  ;; Exiting context, so its parent becomes the new parent.
+  (fn [thought parent]
+    (let [parent-ctx (-> parent prtc/value :data :parent prop/just-property)]
+      [parent-ctx (memtag/uid-of parent)])))
+
+(defn read [& input]
+  (map parse-command input))
+
+(defn pprint-tos [thought]
+  (let [printer #(println (str "EMPTYHEAD> " %))
+        tos (-> thought prtc/value :return last)]
+    (-> tos printer)
+    tos))
+
+(defn run [& input]
+  (clear-context)
+  (run! #(eval! % context) (apply read input))
+  (pprint-tos context)
+  (prtc/reference (teval/execute! context context)))
+
+;; XXX an annoying class of bug is eg  forgetting the return value here, which yields just
+;; >No protocol method Idea.value defined for type null:
+;; In this case originationg from [[emptyhead.thought.eval/execute!]]
+;; Widely catching these errors earlier would be wise since we don't have
+;; a good stack trace for this stuff
+(def/define! [:emptyhead :debug :track]
+  (fn [thought parent]
+    (let [ctx (:_parent (prtc/value parent))]
+      (print "RUNNING " (:operator (prtc/value parent)) " ON ")
+      (print "CONTEXT " (prtc/reference ctx) " WITH ")
+      (print "STACK: ")
+      (print (:return ctx))
+      (print "\n\n")
+      [parent nil]
+      )))
+
+(def sample (thought/register-thought! [:foo]))
+
+;; XXX This has to have no stages otherwise it will loop on itself ww
+(defonce tracker (thought/register-thought! [:emptyhead :debug :track] :ext-stages [[:EXECUTE]]))
+
+(defn enable-tracking []
+  (extend/register-extension! tracker [:PRE-EXECUTE]))
+
+;; XXX accidentally registering one extension multiple times is a known footgun right now
+;; and probably needs some feature to prevent this
+;; (but mind that it shouldn't be *illegal*)
+;; Another issue is just general... garbage collection, that's a big thing
+(defn disable-tracking []
+  (map #(extend/remove-extension! % [:PRE-EXECUTE]) (extend/get-extensions [:PRE-EXECUTE])))
+
+;; FIXME something is going wrong with the context management here
+;; It would probably be good to name contexts somehow to keep easier track of them
+(def tst
+  '(.BEGIN
+    "hello"
+    emptyhead.io.print
+    .END
+    ))