timelines, debug helpers, exponential speedups

editor/imgui.fnl

@@ -79,7 +79,7 @@
 (fn make-tag [tag]
   (match (type tag)
     :string tag
-    :table  (table.concat tag "::")
+    :table  (table.concat (icollect [_ t (ipairs tag)] (make-tag t)) "::")
     _       (tostring tag)))
 
 (fn mouse-inside [x y w h]

editor/replview.fnl

@@ -39,10 +39,10 @@
     (when (textbutton (reform form {:x (+ x w (* -60 SCALE)) :into {}}) :!)
       (view:submit cmd))))
 
-(fn ReplView.draw-val [{: w &as form} {: vals : states}]
+(fn ReplView.draw-val [{: w &as form} {: vals : states} iline]
   (let [g (group-wrapper form)]
     (each [i v (ipairs vals)]
-      (g inspector.draw (under (g) {: w}) (. states i) v))
+      (g inspector.draw (under (g) {: w :tag [:repl-line iline]}) (. states i) v))
     (g)))
 
 (fn ReplView.submit [self ?cmd]

game/meta/vats.fnl

@@ -7,7 +7,8 @@
 (local {: deepmerge} (require :lib.util))
 
 (local game-vat
-  (doto (Vat.module-vat:new)
+  (doto (Vat.new-tracked)
+    (: :playback-from Vat.module-vat 1 (Vat.module-vat:stepcount))
     (: :inject (deepmerge {:state {}} basic-sandbox multimethod (gen-random-env) love-input))))
 
 (local base-module-vat

inspector/registry.fnl

@@ -1,6 +1,7 @@
 (local util (require :lib.util))
 (local {: defmulti : defmethod} (util.require :lib.multimethod))
 (local {: mouse-inside : dropdown : reform : restyle : under : right-of : textbutton : group-wrapper : horiz-wrapper} (util.require :editor.imgui))
+
 (local inspector (util.hot-table ...))
 
 (fn inspector.all-inspectors [v]
@@ -21,15 +22,15 @@
   (tset inspector.inspectors name {: predicate : priority :inspector inspect-func})
   (defmethod inspector.inspect name inspect-func))
 
-(fn inspector.select-inspector [form state value]
-  (let [(selection selected) (dropdown form state.inspector state.inspectors)]
+(fn inspector.select-inspector [{: tag &as form} state value]
+  (let [(selection selected) (dropdown (reform form {:tag [tag :inspector]}) state.inspector state.inspectors)]
     (when selected
       (set state.inspector selection)
       true)))
 
-(fn inspector.draw [{:w orig-w &as form} state value]
+(fn inspector.draw [{:w orig-w : tag &as form} state value]
   (let [g (group-wrapper (restyle form))
-        _ (when (g textbutton form ::)
+        _ (when (g textbutton (reform form {:tag [tag :action-selector]}) ::)
             (set state.inspectors (inspector.all-inspectors value))
             (set state.selecting-action (not state.selecting-action)))
         w (when orig-w (- orig-w form.w))
@@ -39,7 +40,7 @@
       (let [h (horiz-wrapper {:x form.x : w})
             ag (group-wrapper form)]
         (fn draw-action [action]
-          (when (ag #(g action $...) (h form) state value)
+          (when (ag #(g action $...) (h form {: tag}) state value)
             (set state.selecting-action false)))
 
         (draw-action inspector.select-inspector)
@@ -49,7 +50,7 @@
             (draw-action action)))
         (under (ag) {:into form})))
 
-    (g #(inspector.inspect $...) (under form {: w}) state value)
+    (g #(inspector.inspect $...) (under form {: w : tag}) state value)
     (g) (values)))
 
 inspector.hot

test/vat.fnl

@@ -6,6 +6,7 @@
 
 (local Vat (require :vat))
 (local {: basic-sandbox} (require :vat.env))
+(local {: Timeline : tick-trial} (require :vat.timeline))
 
 (fn test-binary-search []
   (t.= [true 1] [(binary-search [1 2 3 4 5] 1)])
@@ -94,4 +95,24 @@
   (t.= 187 (-> (vat:vat-at-tick 187) (. :env :counter)))
   (t.= 200 (-> (vat:vat-at-tick 200) (. :env :counter))))
 
-{: test-binary-search : test-fork : test-rewind-fork : test-vat-io : test-include-modules : test-tracked-vat}
+(fn test-timeline []
+  (local vat (Vat.new-tracked {:ticks-per-snap 3}))
+  (vat:inject {:tick (fn [] (set _G.counter (+ _G.counter 1))) :counter 1})
+  (for [_ 1 30] (vat:tick))
+  (local t1 (Timeline.new (tick-trial vat) 10 20))
+  (t.= 11 (length t1.snapshots))
+  (t.= 10 (. t1.snapshots 1 :vat :env :counter))
+  (t.= 15 (. t1.snapshots 6 :vat :env :counter))
+  (t.= 20 (. t1.snapshots 11 :vat :env :counter))
+  (local t2 (Timeline.new (tick-trial vat #($1:inject {:tick (fn [] (set _G.counter (+ _G.counter 10)))})) 20 25))
+  (t.= 6 (length t2.snapshots))
+  (t.= 20 (. t2.snapshots 1 :vat :env :counter))
+  (t.= 70 (. t2.snapshots 6 :vat :env :counter)))
+
+{: test-binary-search
+ : test-fork
+ : test-rewind-fork
+ : test-vat-io
+ : test-include-modules
+ : test-tracked-vat
+ : test-timeline}

vat/debug.fnl

@@ -0,0 +1,56 @@
+(local profiler (require :jit.p))
+
+(fn callstack-listener [store]
+  (fn gather-locals [depth loc locals]
+    (let [(name val) (debug.getlocal (+ depth 1) loc)]
+      (if (not= name nil)
+          (do (table.insert locals [name val])
+              (gather-locals depth (+ loc 1) locals))
+          locals)))
+  (fn gather-stackframe [depth]
+    (let [info (debug.getinfo (+ depth 1))]
+      (when info {: info :locals (gather-locals (+ depth 1) 1 [])})))
+  (fn gather-stack [depth stack]
+    (let [frame (gather-stackframe (+ depth 1))]
+      (if (not= frame nil)
+          (do (table.insert stack frame)
+              (gather-stack (+ depth 1) stack))
+          stack)))
+  (fn [key]
+    (let [stack (gather-stack 2 [])]
+      (if (= key nil)
+          (table.insert store stack)
+          (tset store key stack)))))
+
+(fn run-profiler [profiler f ...]
+  (profiler.start ...)
+  (let [vals (table.pack (f))]
+    (profiler.stop)
+    (unpack vals 1 vals.n)))
+
+(fn profile [f ...]
+  (run-profiler profiler f ...))
+
+(fn start-timer [name]
+  (let [start-time (love.timer.getTime)]
+    (fn [] (let [duration (- (love.timer.getTime) start-time)]
+             (print name "completed in" duration "sec")))))
+
+(fn time [f name]
+  (local timer {})
+  (fn timer.start [] (set timer.stop (start-timer name)))
+  (run-profiler timer f))
+
+(fn install [vat]
+  (set vat.callstacks {})
+  (set vat.timers {})
+  (vat:listen :callstack (callstack-listener vat.callstacks))
+  (vat:listen :profile #(if (= $1 :start) (profiler.start $2 $3) (profiler.stop)))
+  (vat:listen :timer #(if (= $1 :start) (table.insert vat.timers (start-timer $2)) ((table.remove vat.timers))))
+  (let [inner-profiler {:start #(_G.event :profile :start $...) :stop #(_G.event :profile :stop)}
+        inner-timer {:start #(_G.event :timer :start $...) :stop #(_G.event :timer :stop)}]
+    (vat:inject {:traceback #(_G.event :callstack $...)
+                 :profile #(run-profiler inner-profiler $...)
+                 :time #(run-profiler inner-timer)})))
+
+{: install : profile : time : start-timer}

vat/history.fnl

@@ -110,18 +110,8 @@
             snapshot (. self.snapshots (if found isnap (- isnap 1)))
             vat (snapshot.vat:new)]
         (if found vat
-            (let [first-step (+ (vat:stepcount) 1)
-                  ptr (LogPtr.new self.log first-step)]
-              (assert (= first-step ptr.step))
-              (var ticks-to-advance (- tick snapshot.tick))
-              (assert (> ticks-to-advance 0))
-              ; on-tick marks the point _just before_ a tick is recorded
-              ; therefore we want to advance _past_ the nth tick to just before the n+1th tick
-              (ptr:advance-to #(when (= $1.type :tick)
-                                 (if (= ticks-to-advance 0) true
-                                     (do (set ticks-to-advance (- ticks-to-advance 1))
-                                         false))))
-              (vat:playback-from self first-step (- ptr.step first-step))
+            (let [first-step (+ (vat:stepcount) 1)]
+              (vat:playback-ticks-from self first-step (- tick snapshot.tick))
               vat))))
     tracked))
 

vat/init.fnl

@@ -3,6 +3,7 @@
 (local {: snapshot : inject : new-env} (require :vat.snapshot))
 (local {: det} (require :vat.env))
 (local {: make-tracked-vat : LogPtr : step-lim} (require :vat.history))
+(local {: profile : time} (require :vat.debug))
 (local fennel (require :lib.fennel))
 (local fv fennel.view)
 
@@ -55,6 +56,10 @@
 (fn Vat.new-tracked [?opts] (make-tracked-vat (Vat.new) ?opts))
 
 (fn Vat.stepcount [self] (- self.logptr.step 1))
+(fn Vat.nextstep [self] self.logptr.step)
+(fn Vat.parent [self]
+  (when (> (length self.log) 0) (. self.log 1 :vat)))
+
 (fn Vat.inject [self state]
   (assert (= state.event nil) "It is illegal to override the vat event func!")
   (self:append-logentry :inject {:state (snapshot state)})
@@ -97,8 +102,7 @@
     (let [entry (self.logptr:read)
           event self.eventfunc]
       (set self.eventfunc self.eventfunc-ignore)
-      (assert entry (.. "Tried to replay empty event " (tostring self.logptr.step)
-                        " [" (tostring (length self.log)) " entries, " (tostring (step-lim (. self.log (length self.log)))) " step limit, " (fv self.logptr) "]"))
+      (assert entry "Tried to replay empty event")
       (case entry.type
         :tick (self.env.tick)
         :inject (inject self.env entry.state)
@@ -111,6 +115,19 @@
   (self:append-reference vat step count true)
   (self:replay count))
 
+(fn Vat.playback-ticks-from [self vat first-step ?tick-count]
+  (var ticks-to-advance (or ?tick-count 1))
+  (assert (> ticks-to-advance 0))
+  (let [ptr (LogPtr.new vat.log first-step)]
+    (assert (= first-step ptr.step))
+    ; on-tick marks the point _just before_ a tick is recorded
+    ; therefore we want to advance _past_ the nth tick to just before the n+1th tick
+    (ptr:advance-to #(when (= $1.type :tick)
+                       (if (= ticks-to-advance 0) true
+                           (do (set ticks-to-advance (- ticks-to-advance 1))
+                               false))))
+    (self:playback-from vat first-step (- ptr.step first-step))))
+
 (fn Vat.eventfunc-ignore [self ...] nil)
 (fn Vat.eventfunc-listener-dispatch [self event ...]
   (let [listener (. self.listeners event)]

vat/snapshot.fnl

@@ -67,7 +67,11 @@
                            (rawset dst k nil))))
             (apply-replacements (getmetatable dst) visited replacements snap))
 
-        (= (type dst) :function)
+        (and (= (type dst) :function)
+             ; don't dig into wrapped functions
+             (let [funcenv (getfenv dst)
+                   mt (getmetatable funcenv)]
+               (or (not mt) (not mt.__snapshotfunc))))
         (each [_ upcell (ipairs (or (Upcell.saveall dst) []))]
           (replace (Upcell.get upcell) #(Upcell.set upcell $1))))))
 
@@ -113,7 +117,9 @@
             o)))
 
     (build-injection-mapping dst src mappings replacements changes)
-    (apply-replacements dst {} replacements snap)
+    ; don't bother walk the entire destination tree when there are no replacements to apply
+    (when (not= (next replacements) nil)
+      (apply-replacements dst {} replacements snap))
     (each [_ change (ipairs changes)]
       (case change.action
         :tset (rawset change.dst change.key (snap change.value))

vat/timeline.fnl

@@ -0,0 +1,63 @@
+(fn tick-trial [parent-vat ?f]
+  (fn [start-tick]
+    (let [vat (parent-vat:vat-at-tick start-tick)
+          steplim-pre-tweak (vat:nextstep)
+          _ (when ?f (?f vat))
+          steplim-post-tweak (vat:nextstep)
+          step-delta (- steplim-post-tweak steplim-pre-tweak)]
+      {: vat
+       :next (fn [self]
+               (let [vat (self.vat:new)]
+                 (vat:playback-ticks-from parent-vat (- (self.vat:nextstep) step-delta))
+                 {: vat :next self.next}))})))
+
+(local Timeline {})
+(set Timeline.__index Timeline)
+
+(fn Timeline.new [trial start-tick end-tick]
+  (let [self (setmetatable {: trial} Timeline)]
+    (self:rebuild start-tick end-tick)
+    self))
+
+(fn Timeline.rebuild [self start-tick end-tick]
+  (set self.snapshots [])
+  (set self.start-tick start-tick)
+  (set self.end-tick end-tick)
+  (self:insert-snapshot 1 (self.trial start-tick) start-tick)
+  (self:insert-snapshots 1 (- end-tick start-tick)))
+
+(fn Timeline.move-end [self new-end-tick]
+  (assert (>= new-end-tick self.start-tick))
+  (if (> new-end-tick self.end-tick)
+      (let [isnap-last (length self.snapshots)
+        count (- new-end-tick self.end-tick)]
+        (self:insert-snapshots isnap-last count))
+
+      (< new-end-tick self.end-tick)
+      (for [i 1 (- self.end-tick new-end-tick)]
+        (table.remove self.snapshots)))
+  (set self.end-tick new-end-tick))
+
+(fn Timeline.move-start [self new-start-tick]
+  (assert (<= new-start-tick self.end-tick))
+  (if (< new-start-tick self.start-tick)
+      (self:rebuild new-start-tick self.end-tick)
+
+      (> new-start-tick self.start-tick)
+      (for [isnap (- new-start-tick self.start-tick) 1 -1]
+        (table.remove self.snapshots isnap)))
+  (set self.start-tick new-start-tick))
+
+(fn Timeline.insert-snapshot [self isnap snap tick]
+  (set snap.tick tick)
+  (table.insert self.snapshots isnap snap))
+
+(fn Timeline.insert-snapshots [self isnap-prev count]
+  (when (> count 0)
+    (let [prev-snap (. self.snapshots isnap-prev)
+          snap (prev-snap:next)
+          isnap (+ isnap-prev 1)]
+      (self:insert-snapshot isnap snap (+ prev-snap.tick 1))
+      (self:insert-snapshots isnap (- count 1)))))
+
+{: Timeline : tick-trial}