mame / nREPL support

editor/init.fnl

@@ -39,3 +39,12 @@
   "ctrl+v"    "tileedit:paste"
 })
 
+(fn inline-eval [eval]
+  (let [ldoc core.active_view.doc
+        (aline acol bline bcol) (ldoc:get_selection)
+        inject #(ldoc:insert bline bcol (eval $1))]
+    (if (and (= aline bline) (= acol bcol))
+      (inject (ldoc:get_text aline 1 aline 10000000))
+      (inject (ldoc:get_text aline acol bline bcol)))))
+
+{: inline-eval}

lib/bencode.lua

@@ -0,0 +1,89 @@
+-- Based on bencode.lua from the jeejah project by Phil Hagelberg
+-- Distributed under the MIT license
+-- https://gitlab.com/technomancy/jeejah/
+
+local encode, decode
+
+local function decode_list(str, t, total_len)
+   -- print("list", str, lume.serialize(t))
+   if #str == 0 then error("Incomplete") end
+   if(str:sub(1,1) == "e") then return t, total_len + 1 end
+   local value, v_len = decode(str)
+   table.insert(t, value)
+   total_len = total_len + v_len
+   return decode_list(str:sub(v_len + 1), t, total_len)
+end
+
+local function decode_table(str, t, total_len)
+   -- print("table", str, lume.serialize(t))
+   if #str == 0 then error("Incomplete") end
+   if(str:sub(1,1) == "e") then return t, total_len + 1 end
+   local key, k_len = decode(str)
+   local value, v_len = decode(str:sub(k_len+1))
+   local end_pos = 1 + k_len + v_len
+   t[key] = value
+   total_len = total_len + k_len + v_len
+   return decode_table(str:sub(end_pos), t, total_len)
+end
+
+function decode(str)
+   -- print("decoding", str)
+   if #str == 0 then
+     error("Incomplete")
+   elseif(str:sub(1,1) == "l") then
+      return decode_list(str:sub(2), {}, 1)
+   elseif(str:sub(1,1) == "d") then
+      return decode_table(str:sub(2), {}, 1)
+   elseif(str:sub(1,1) == "i") then
+      local iend = str:find("e")
+      if iend == nil then error("Incomplete") end
+      return(tonumber(str:sub(2, iend - 1))), iend
+   elseif(str:match("[0-9]+:")) then
+      local num_str = str:match("[0-9]+")
+      local beginning_of_string = #num_str + 2
+      local str_len = tonumber(num_str)
+      local total_len = beginning_of_string + str_len - 1
+      if #str < total_len then error("Incomplete") end
+      return str:sub(beginning_of_string, total_len), total_len
+   else
+      error("Could not parse "..str)
+   end
+end
+
+local function encode_str(s) return #s .. ":" .. s end
+local function encode_int(n) return "i" .. tostring(n) .. "e" end
+
+local function encode_table(t)
+   local s = "d"
+   for k,v in pairs(t) do s = s .. encode(k) .. encode(v) end
+   return s .. "e"
+end
+
+local function encode_list(l)
+   local s = "l"
+   for _,x in ipairs(l) do s = s .. encode(x) end
+   return s .. "e"
+end
+
+local function count(tbl)
+   local i = 0
+   for _ in pairs(tbl) do i = i + 1 end
+   return i
+end
+
+function encode(x)
+   local unpack = unpack or table.unpack
+   if(type(x) == "table" and select("#", unpack(x)) == count(x)) then
+      return encode_list(x)
+   elseif(type(x) == "table") then
+      return encode_table(x)
+   elseif(type(x) == "number" and math.floor(x) == x) then
+      return encode_int(x)
+   elseif(type(x) == "string") then
+      return encode_str(x)
+   else
+      error("Could not encode " .. type(x) .. ": " .. tostring(x))
+   end
+end
+
+return {decode=decode, encode=encode}

lib/util.fnl

@@ -1,5 +1,6 @@
 (local lume (require :lib.lume))
 (local json (require :lib.dkjson))
+(local core (require :core))
 
 (fn string.fromhex [str]
   (str:gsub ".." (fn [cc] (string.char (tonumber cc 16)))))
@@ -48,5 +49,17 @@
   (f:write (json.encode value))
   (f:close))
 
-{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson}
+(fn waitfor [pred]
+  (local coro (coroutine.running))
+  (core.add_thread
+    (fn []
+      (while (not (pred))
+        (coroutine.yield))
+      (coroutine.resume coro))
+    coro)
+  (coroutine.yield))
+
+(fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...)))
+
+{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson : waitfor : in-coro}
 

link/command.fnl

@@ -0,0 +1,43 @@
+(local util (require :lib.util))
+(local link (require :link))
+(local editor (require :editor))
+(local command (require :core.command))
+(local keymap (require :core.keymap))
+
+(each [_ linktype (ipairs link.types)]
+  (command.add #(not= link.name linktype) {
+    (.. "link:switch-to-" linktype) #(link:switch linktype)
+  }))
+
+(command.add #(and link.machine.run (not (link.machine:running?))) {
+  "link:boot" #(link.machine:run)
+})
+(command.add #(and link.machine.die (link.machine:running?)) {
+  "link:kill" #(link.machine:die)
+})
+(command.add #(not (link.machine:connected?)) {
+  "link:connect" #(link.machine:connect)
+})
+(command.add #(link.machine:connected?) {
+  "link:disconnect" #(link.machine:disconnect)
+})
+
+(let [connected-methods
+      {:reboot :reboot
+       :continue :continue
+       :step :step
+       :squelch :stop}]
+  (each [name method (pairs connected-methods)]
+    (command.add #(and (link.machine:connected?) (. link.machine method)) {
+      (.. "link:" name) #(: link.machine method)
+    })))
+
+(command.add #(and (link.machine:connected?) link.machine.coro-eval) {
+  "link:eval" #(util.in-coro #(editor.inline-eval #(link.machine:coro-eval $1)))
+})
+
+(keymap.add {
+  "alt+m" "link:eval"
+})
+
+{}

link/gsplus.fnl

@@ -28,6 +28,11 @@
  (fn [self]
    (when (not self.pid)
      (set self.pid (spawn [:nixGL gsplus-path :-debugport (tostring debug-port)]))))
+ :run
+ (fn [self]
+   (self:boot)
+   (while (not self.socket) (self:connect))
+   (self:hello))
  :die
  (fn [self]
    (self:disconnect)
@@ -47,6 +52,7 @@
      (self.socket:close)
      (set self.socket nil)))
  :connected? (fn [self] self.socket)
+ :running? (fn [self] self.pid)
  :cmd (fn [self cmd] (self.socket:send (.. cmd "\n")))
  :response
  (fn [self]
@@ -115,27 +121,12 @@
    (org:append :debug-stub [:jmp post-check-jump] :on-hotswap ...))
 })
 
-(command.add #(not machine.pid) {
-    "gsplus:launch-gsplus" #(machine:boot)
-    "gsplus:boot" (fn []
-      (machine:boot)
-      (while (not machine.socket) (machine:connect))
-      (machine:hello)
-    )
-})
-(command.add (fn [] machine.pid) {
-    "gsplus:kill-gsplus" #(machine:die)
-})
 (command.add (fn [] machine.socket) {
-    "gsplus:disconnect" #(machine:disconnect)
     "gsplus:hello" #(machine:hello)
     "gsplus:dump-cpu-state" #(pp (machine:getreg))
     "gsplus:step" #(pp (machine:step))
     "gsplus:continue" #(pp (machine:continue))
 })
-(command.add #(not machine.socket) {
-    "gsplus:connect" #(machine:connect)
-})
 
 machine
 

link/init.fnl

@@ -3,7 +3,7 @@
    (fn [self name]
      (set self.machine (require (.. "link." name)))
      (set self.name name))
-   :types [:serial :gsplus :tape]})
+   :types [:serial :gsplus :tape :mame]})
 
 (local serial (require :link.serial))
 (link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :gsplus))

link/mame.fnl

@@ -0,0 +1,64 @@
+(local util (require :lib.util))
+(local {: spawn : kill} (util.require :lib.spawn))
+(local nrepl (require :link.nrepl))
+(local Session (require :link.nrepl-session))
+(local bencode (require :lib.bencode))
+(local lume (require :lib.lume))
+
+(fn start-mame [platform]
+  (spawn [:mame :-debug :-plugins :-pluginspath "/home/jeremy/src;/usr/share/mame/plugins" :-plugin :jeejah platform]))
+
+(local Machine (Session:extend))
+(fn Machine.new [self]
+  (Machine.super.new self {:out (fn []) :value (fn [])}))
+(fn Machine.boot [self]
+  (when (not self.pid)
+    (set self.pid (start-mame :apple2p))))
+(fn Machine.run [self]
+  (self:boot)
+  (self:connect))
+(fn Machine.die [self]
+  (self:disconnect)
+  (when self.pid
+    (kill (- self.pid) 1)
+    (set self.pid nil)))
+(fn Machine.running? [self] self.pid)
+(fn Machine.connected? [self] self.session)
+(fn Machine.connect [self]
+  (util.in-coro (fn []
+    (when (not (nrepl:connected?))
+      (util.waitfor
+        #(if (nrepl:connected?) true
+           (do (pcall #(nrepl:connect)) false))))
+    (self:init-session))))
+(fn Machine.disconnect [self]
+  (when (nrepl:connected?) (nrepl:disconnect))
+  (set self.session nil))
+(fn Machine.write [self addr bytes]
+  (self:send
+    {:op :eval
+     :code
+     "(let [bencode (require :bencode)
+            {: addr : bytes} (bencode.decode (io.read))
+            mem (-> (manager:machine) (. :devices ::maincpu :spaces :program))]
+        (print :writing (bytes:len) :to addr)
+        (for [i 1 (bytes:len)]
+          (mem:write_u8 (+ addr i -1) (string.byte (bytes:sub i i)))))"}
+    {:status/need-input #(self:send-oob {:op :stdin :stdin (bencode.encode {: addr : bytes})})}))
+(fn Machine.reboot [self] (self:eval "(: (manager:machine) :hard_reset)"))
+(fn Machine.coro-eval [self code]
+  (var result nil)
+  (self:eval code
+    (self:coro-handlers (coroutine.running) {:out #(set result $2)}))
+  (coroutine.yield)
+  (or result "<no result?>"))
+(fn Machine.dbgcmd [self cmd]
+  (self:eval (.. "(-> (manager:machine) (: :debugger) (: :command \"" cmd "\"))")))
+(fn Machine.continue [self] (self:dbgcmd :go))
+(fn Machine.step [self] (self:dbgcmd :s))
+(fn Machine.stop-at [self addr])
+(Machine:new)
+
+Machine
+
+

link/nrepl-session.fnl

@@ -0,0 +1,61 @@
+(local Object (require :core.object))
+(local nrepl (require :link.nrepl))
+(local lume (require :lib.lume))
+
+(local Session (Object:extend))
+
+(fn Session.new [self ?handlers]
+  (set self.queue [])
+  (set self.in-progress false)
+  (set self.handlers ?handlers))
+
+(fn Session.init-session [self]
+  (when (nrepl:connected?)
+    (self:do #(nrepl:new-session
+                #(do (set self.session $2)
+                     (self:done-msg))
+                (self:make-handlers)))))
+
+(fn Session.cleanup-handlers [self]
+  {:status/done #(self:done-msg)
+   :status/interrupted #(self:done-msg)})
+
+(fn Session.make-handlers [self]
+  (lume.merge
+    (or self.handlers {})
+    (nrepl:chain-handlers [:status/done :status/interrupted]
+      (or self.handlers {})
+      (self:cleanup-handlers))))
+
+(fn Session.coro-handlers [self coro ?handlers]
+  (lume.merge
+    (or ?handlers {})
+    (nrepl:chain-handlers [:status/done :status/interrupted]
+      (self:cleanup-handlers)
+      {:status/done #(coroutine.resume coro)
+       :status/interrupted #(coroutine.resume coro)})))
+       
+(fn Session.do [self f]
+  (if self.in-progress (table.insert self.queue f)
+    (do (set self.in-progress true)
+        (f))))
+
+(fn Session.done-msg [self]
+  (if (> (length self.queue) 0) ((table.remove self.queue 1))
+    (set self.in-progress false)))
+
+(fn Session.send [self message ?handlers]
+  (self:do #(nrepl:send message ?handlers self.session)))
+
+(fn Session.send-oob [self message ?handlers]
+  (local handlers
+    (lume.merge
+      (nrepl:chain-handlers [:status/done :status/interrupted]
+        (or self.handlers {}))
+      (or ?handlers {})))
+  (nrepl:send message handlers self.session))
+
+(fn Session.eval [self code ?handlers]
+  (self:send {:op :eval : code} ?handlers))
+
+Session

link/nrepl.fnl

@@ -0,0 +1,114 @@
+(local core (require :core))
+(local socket (require :socket))
+(local bencode (require :lib.bencode))
+(local lume (require :lib.lume))
+
+(fn contains? [tbl item]
+  (or (= tbl item) (lume.find tbl item)))
+
+(local nrepl
+  {:active-requests {}
+   :session-handlers {}
+   :default-handlers
+   {:out                #(core.log $2)
+    :value              #(core.log $2)
+    :ex                 #(core.err $2)
+    :status/interrupted #($1:done $3.id)
+    :status/done        #($1:done $3.id)}
+   :merge-handlers
+   (fn [self message]
+     (lume.merge self.default-handlers
+       (or (. self.session-handlers message.session) {})
+       (or (. self.active-requests message.id) {})))
+   :chain-handlers
+   (fn [self keys ...]
+     (local new-handlers {})
+     (each [_ key (ipairs keys)]
+       (each [_ handlers (ipairs [self.default-handlers ...])]
+         (local next-handler (. handlers key))
+         (local prev-handler (. new-handlers key))
+         (if (and next-handler prev-handler)
+             (tset new-handlers key
+               #(do (prev-handler $1 $2 $3) (next-handler $1 $2 $3)))
+             next-handler
+             (tset new-handlers key next-handler))))
+     new-handlers)
+   :counter 1
+   :input ""
+   :parse-input
+   (fn [self]
+     (match (pcall #(bencode.decode self.input))
+       (true val len)
+       (do (set self.input (self.input:sub (+ len 1)))
+           val)
+       (false :Incomplete) nil
+       (false _)
+       (do (set self.input "")
+           nil)))
+   :receive
+   (fn [self]
+     (when self.connection
+       (local (data err part) (self.connection:receive "*a"))
+       (local response (or data part))
+       (when (> (response:len) 0)
+         (print "Got some data")
+         (set self.input (.. self.input response)))
+       (match (self:parse-input) nil nil
+         input (self:handle input))
+       (when (= err :closed)
+         (self:disconnect))))
+   :send
+   (fn [self msg ?handlers ?session]
+     (when self.connection
+       (when (not msg.id)
+         (set msg.id self.counter)
+         (set self.counter (+ self.counter 1)))
+       (when (not msg.session)
+         (set msg.session (or ?session self.default-session)))
+       (when ?handlers
+         (tset self.active-requests msg.id ?handlers))
+       (self.connection:send (bencode.encode msg))))
+   :done
+   (fn [self msg-id]
+     (tset self.active-requests msg-id nil))
+   :handle
+   (fn [self response]
+     (pp response)
+     (local handlers (self:merge-handlers response))
+     (each [prop handler (pairs handlers)]
+       (local idiv (prop:find :/))
+       (local key (if idiv (prop:sub 1 (- idiv 1)) prop))
+       (print "checking" key (and idiv (prop:sub (+ idiv 1))))
+       (when (and (. response key)
+               (or (= idiv nil)
+                   (contains? (. response key) (prop:sub (+ idiv 1)))))
+         (print "handling")
+         (handler self (. response key) response))))
+   :disconnect
+   (fn [self]
+     (when self.connection
+       (self.connection:close)
+       (set self.connection nil)
+       (set self.default-session nil)
+       (set self.active-requests {})
+       (set self.session-handlers {})))
+   :connect
+   (fn [self ?port ?host]
+     (when (not self.connection)
+       (local (port host) (values (or ?port 7888) (or ?host :localhost)))
+       (set self.connection (assert (socket.connect host port)))
+       (self.connection:settimeout 0)
+       (core.add_thread #(while true (self:receive) (coroutine.yield)) self)
+       (self:send {:op :clone}
+         {:new-session #(set self.default-session $2)})))
+   :connected?
+   (fn [self] (not= self.default-session nil))
+   :new-session
+   (fn [self callback ?handler]
+     (self:send {:op :clone}
+       {:new-session
+        (fn [self session message]
+          (tset self.session-handlers session ?handler)
+          (callback self session message))}))})
+
+nrepl

wrap.fnl

@@ -1,19 +1,13 @@
-(require "editor")
-(local util (require "lib.util"))
-(local lume (require "lib.lume"))
-(local link (require "link"))
-(local core (require "core"))
-(local command (require "core.command"))
-(local keymap (require "core.keymap"))
-(local translate (require "core.doc.translate"))
+(local editor (require :editor))
+(local util (require :lib.util))
+(local lume (require :lib.lume))
+(local link (require :link))
+(require :link.command)
+(local core (require :core))
+(local command (require :core.command))
+(local keymap (require :core.keymap))
+(local translate (require :core.doc.translate))
 
-(each [_ linktype (ipairs link.types)]
-  (command.add #(not= link.name linktype) {
-    (.. "honeylisp:switch-to-" linktype) #(link:switch linktype)
-  }))
-(command.add #(= link.name :tape) {
-  "honeylisp:squelch" #(link.machine:stop)
-})
 (command.add #(link.machine:connected?) {
   "honeylisp:upload" (fn []
     (local p (util.reload "game"))
@@ -39,14 +33,7 @@
   (ldoc:get_text aline acol bline bcol))
 
 (command.add "core.docview" {
-  "fennel:eval" (fn []
-    (let [ldoc core.active_view.doc
-          (aline acol bline bcol) (ldoc:get_selection)
-          options {:env _G :compiler-env _G}
-          inject #(ldoc:insert bline bcol (fv (fennel.eval $1 options) {}))]
-      (if (and (= aline bline) (= acol bcol))
-        (inject (ldoc:get_text aline 1 aline 10000000))
-        (inject (ldoc:get_text aline acol bline bcol)))))
+  "fennel:eval" #(editor.inline-eval #(fv (fennel.eval $1 {:env _G :compiler-env _G}) {}))
   "lume:hotswap" (fn []
     (local modname
       (-> core.active_view.doc.filename