EMPTYHEAD/src/cljs/emptyhead/repl/core.cljs

(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.util.magic :as magic]
            [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 nil])))

(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 " (thought/operator parent) " ON ")
      (print "CONTEXT " ctx " WITH \n")
      (print "STACK: ")
      (print (:return ctx))
      (print "\n\n")
      [parent nil])))

(def sample (thought/register-thought! [:foo]))

;; XXX This has to have no :PRE-EXECUTE stage 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/extensions-of-stage [:PRE-EXECUTE])))

(defn name-idea
  [idea context name]
  (prop/register-property! idea [:emptyhead :name name (prtc/reference context)]))

(defn resolve-name
  [context name]
  (prop/just-property [:emptyhead :name name (prtc/reference context)]))

(defn deref-name
  [self name]
  (or (and (= (thought/operator self) [:emptyhead :core :context])
           (resolve-name self name))
      (and (prtc/val-fn :_parent self)
           (deref-name (prtc/val-fn :_parent self) name))))

(def/define! [:GRAB]
  (fn [thought parent]
    (let [arg-num (inc (or (get-in parent [:data :last-arg]) -1))]
      [(assoc-in parent [:data :last-arg] arg-num)
       (-> parent prtc/value :_parent prtc/value :return (#(nth % (- (count %) arg-num 1))))])))

(def/define! [:RETURN]
  (fn [thought parent]
    (let [[parent val] (thought/pop-stack parent)]
      [(update-in parent [:data :proc-ret] (fnil conj []) val) nil])))

;; FIXME this wil bind two things to the same name if you name severa things the same
;; FIXME this needs to wrap data in an [:emptyhead :core :return] and then evaluate that on deref
(def/define! [:emptyhead :core :assign-name]
  (fn [_ parent]
    (let [[parent name] (thought/pop-stack parent)
          [_ op] (thought/pop-stack parent)
          exe (prop/just-property op)]
      (extend/register-extension! exe (into [:_name] name))
      [parent nil])))

;; FIXME this is a weird use of the extension system -- figure out how names should actually work!
;; (in light of the way extensions usually work, see e.g. [emptyhead.thought.extend/get-extensions]) comment
;; FIXME this needs to wrap data in an [:emptyhead :core :return] and then evaluate that on deref
(def/define! [:emptyhead :core :deref-name]
  (fn [_ parent]
    (let [[parent name] (thought/pop-stack parent)
          deref (memtag/uid-of
                 (prop/just-property (magic/extension-prop (into [:_name] name))))]
      [parent deref])))

(def tst
  '(.BEGIN
    "<> -- COMMENCE PROCEDURE -- <>"
    emptyhead.io.print

    GRAB emptyhead.io.print
    GRAB emptyhead.io.print

    "<> -- PROCEDURE COMPLETE -- <>"

    42 RETURN
    69 RETURN
    .END
    emptyhead.io.print

    [:meme]
    emptyhead.core.assign-name

    "hello"
    "goodbye"
    [:meme]
    emptyhead.core.deref-name
    emptyhead.core.execute
    emptyhead.core.pop ;; pop deref'd name

    "\nReturn values of previous:\n"
    emptyhead.io.print
    emptyhead.core.pop

    [:meme]
    emptyhead.core.deref-name
    emptyhead.core.execute))