Rollback registry changes fully for evaltime errors.

Close #2

8 files changed, 147 insertions, 91 deletions

diff --git a/copilot.moon b/copilot.moon
index 8b3602a..a196d9b 100644
--- a/copilot.moon
+++ b/copilot.moon
@@ -21,28 +21,34 @@ class Copilot
     if mode != 'file'
       error "not a file: #{@file}"
 
-  patch: =>
+  tick: =>
+    @poll!
+
+    if @root
+      @registry\begin_tick!
+      L\try "error evaluating:", ->
+        @root\tick_io!
+        @root\tick!
+      @registry\end_tick!
+
+  eval: =>
+    @registry\begin_eval!
     ast = L\try "error parsing:", parse, slurp @file
     if not ast
       L\error "error parsing"
+      @registry\rollback_eval!
       return
 
     scope = Scope globals
     root = L\try "error evaluating:", ast\eval, scope, @registry
-    return unless root
-
-    @root = root if root
-    ast
-
-  tick: =>
-    @poll!
+    if not root
+      @registry\rollback_eval!
+      return
 
-    if @root
-      L\try "error evaluating:", @registry\wrap_tick ->
-        @root\tick_io!
-        @root\tick!
+    @registry\end_eval!
+    @root = root
+    spit @file, ast\stringify!
 
-  tb = (msg) -> debug.traceback msg, 2
   poll: =>
     { :mode, :modification } = (lfs.attributes @file) or {}
     if mode != 'file'
@@ -50,8 +56,9 @@ class Copilot
 
     if @last_modification < modification
       L\log "#{@file} changed at #{modification}"
-      ast = L\push @registry\wrap_eval @\patch
-      spit @file, ast\stringify! if ast
+      @eval!
       @last_modification = os.time!
 
-:Copilot
+{
+  :Copilot
+}
diff --git a/core/base/action.moon b/core/base/action.moon
index 1822b58..cfca919 100644
--- a/core/base/action.moon
+++ b/core/base/action.moon
@@ -1,8 +1,8 @@
 ----
 -- Builtin / Special Form evaluation Strategy (`builtin`).
 --
--- Responsible for quoting/evaluating subexpressions, instantiating and patching
--- `Op`s, updating the current `Scope`, etc.
+-- Responsible for quoting/evaluating subexpressions, instantiating and setting
+-- up `Op`s, updating the current `Scope`, etc.
 -- See `builtin` and `invoke` for examples.
 --
 -- @classmod Action
@@ -17,8 +17,7 @@ class Action
   --
   -- @tparam Value head the (`AST:eval`d) `head` of the Cell to evaluate
   -- @tparam Tag tag the Tag of the expression to evaluate
-  new: (head, @tag) =>
-    @patch head
+  new: (@head, @tag) =>
 
   --- perform the actual evaluation.
   --
@@ -36,21 +35,15 @@ class Action
   --- free resources
   destroy: =>
 
-  --- attempt to update this instance with a new `head` prior to `eval`.
+  --- setup or copy state from previous instance of same type.
   --
-  -- If `patch` returns `false`, this instance is `destroy`ed and recreated.
-  -- Must *not* return `false` when called immediately after `new`.
-  -- Only considered if Action types of old and new expression match.
+  -- `prev` is only passed if Action types of prev and current expression match.
+  -- Otherwise, or when no previous expression exists, `nil` is passed.
   --
-  -- @tparam AST head the new head value
-  -- @treturn bool whether patching was successful
-  patch: (head) =>
-    if head == @head
-      true
+  -- @tparam ?Action prev the previous Action instance
+  setup: (prev) =>
 
-    @head = head
-
-  --- the last head used to construct this instance
+  --- the head of the `Cell` this Action was created for.
   --
   -- @tfield AST head
 
@@ -61,11 +54,12 @@ class Action
 --- static functions
 -- @section static
 
-  --- get-or-update an `Action` for a given tag, then evaluate it.
+  --- create and setup an `Action` for a given tag, then evaluate it.
   --
-  -- Find the action for the expression with `Tag` `tag` if it exists,
-  -- and is compatible with the new `head`, otherwise instantiate one.
-  -- Register the `Action` with `tag`, evaluate it and return the `Result`.
+  -- Create a new instance using `tag` and `head` and call `setup` on it.
+  -- If a previous instance with the same `tag` exists and has the same `head`,
+  -- it pass it to `setup`. Register the `Action` with `tag`, evaluate it
+  -- and return the `Result`.
   --
   -- @tparam Scope scope the active scope
   -- @tparam Tag tag the tag of the `Cell` being evaluated
@@ -74,10 +68,7 @@ class Action
   -- @treturn Result the result of evaluation
   @eval_cell: (scope, tag, head, tail) =>
     last = tag\last!
-    compatible = last and
-                 (last.__class == @) and
-                 (last\patch head) and
-                 last
+    compatible = last and (last.__class == @) and last.head == head
 
     L\trace if compatible
       "reusing #{last} for #{tag} <#{@__name} #{head}>"
@@ -86,14 +77,14 @@ class Action
     else
       "initializing #{tag} <#{@__name} #{head}>"
 
-    action = if compatible
-      tag\keep compatible
-      compatible
+    action = @ head, tag
+    if compatible
+      action\setup last
     else
       last\destroy! if last
-      with next = @ head, tag
-        tag\replace next
+      action\setup nil
 
+    tag\replace action
     action\eval scope, tail
 
   __tostring: => "<#{@@__name} #{@head}>"
diff --git a/core/base/io.moon b/core/base/io.moon
index 3370fe1..cbb5823 100644
--- a/core/base/io.moon
+++ b/core/base/io.moon
@@ -32,6 +32,9 @@ class IO
   -- @treturn bool whether processing is required
   dirty: =>
 
+  __tostring: => "<IO #{@@__name}>"
+  __inherited: (cls) => cls.__base.__tostring = @__tostring
+
 {
   :IO
 }
diff --git a/core/base/op.moon b/core/base/op.moon
index 08c47ab..a8da100 100644
--- a/core/base/op.moon
+++ b/core/base/op.moon
@@ -4,6 +4,15 @@
 -- @classmod Op
 import Value from require 'core.value'
 
+ident = (tbl) ->
+  mt = getmetatable tbl
+  setmetatable tbl, nil
+
+  id = tostring tbl
+
+  setmetatable tbl, mt
+  id\sub #'table: 0x'
+
 class Op
 --- members
 -- @section members
diff --git a/core/invoke.moon b/core/invoke.moon
index 23207b7..736f284 100644
--- a/core/invoke.moon
+++ b/core/invoke.moon
@@ -11,18 +11,21 @@ import Scope from require 'core.scope'
 --
 -- @type op_invoke
 class op_invoke extends Action
-  --- `Action:patch` implementation.
-  patch: (head) =>
-    if head == @head
-      @op = @op\fork!
-      return true
-
-    @op\destroy! if @op
-
-    def = head\unwrap 'opdef', "cant op-invoke #{@head}"
-    @head, @op = head, def!
-
-    true
+  --- `Action:setup` implementation.
+  --
+  -- `Op:fork`s the `prev`'s `Op` instance if given. Creates a new instance
+  -- otherwise.
+  setup: (prev) =>
+    if prev
+      @op = prev.op\fork!
+    else
+      def = @head\unwrap 'opdef', "cant op-invoke #{@head}"
+      @op = def!
+
+  --- `Action:destroy` implementation.
+  --
+  -- calls `op`:@{Op:destroy|destroy}.
+  destroy: => @op\destroy!
 
   --- evaluate an `Op` invocation.
   --
@@ -61,14 +64,6 @@ class op_invoke extends Action
 --
 -- @type fn_invoke
 class fn_invoke extends Action
-  --- `Action:patch` implementation.
-  patch: (head) =>
-    return true if head == @head
-
-    @head = head
-
-    true
-
   --- evaluate a user-function invocation.
   --
   -- Creates a new `Scope` that inherits from `FnDef.scope` and has
diff --git a/core/registry.moon b/core/registry.moon
index 9627447..981f815 100644
--- a/core/registry.moon
+++ b/core/registry.moon
@@ -6,6 +6,8 @@
 import Value from require 'core.value'
 import Result from require 'core.result'
 
+unpack or= table.unpack
+
 class Registry
 -- methods for Tag
 
@@ -33,24 +35,71 @@ class Registry
   -- @treturn function `fn` wrapped with eval-cycle logic
   wrap_eval: (fn) => (...) ->
     @grab!
-    @last_map, @map, @pending = @map, {}, {}
+    @map, @pending = {}, {}
+    @tick += 1
+    L\log "eval at tick #{@tick}"
 
-    with fn ...
-      for tag, val in pairs @last_map
-        if not @map[tag]
-          val\destroy!
+    results = { pcall fn, ... }
+    ok = table.remove results, 1
 
-      for { :tag, :expr } in *@pending
-        -- tag was solved by another pending registration
-        -- (e.g. first [A] is solved, then [5.A] is solved)
-        continue if tag\index!
+    if not ok
+      @tick -= 1
+      @release!
+      L\log "rollback to tick #{@tick}"
+      error unpack results
+      error "WHAT?"
 
-        next_tag = @next_tag!
-        L\trace "assigned new tag #{next_tag} to #{tag} #{expr}"
-        tag\set next_tag
-        @map[tag\index!] = expr
+    for tag, val in pairs @last_map
+      val\destroy! unless @map[tag]
 
-      @release!
+    for { :tag, :expr } in *@pending
+      -- tag was solved by another pending registration
+      -- (e.g. first [A] is solved, then [5.A] is solved)
+      continue if tag\index!
+
+      next_tag = @next_tag!
+      L\trace "assigned new tag #{next_tag} to #{tag} #{expr}"
+      tag\set next_tag
+      @map[tag\index!] = expr
+
+    @last_map = @map
+    @release!
+    unpack results
+
+  begin_eval: =>
+    @latest_map = @last_map
+    @begin_tick!
+    @map, @pending = {}, {}
+
+  end_eval: =>
+    for tag, val in pairs @last_map
+      val\destroy! unless @map[tag]
+
+    for { :tag, :expr } in *@pending
+      -- tag was solved by another pending registration
+      -- (e.g. first [A] is solved, then [5.A] is solved)
+      continue if tag\index!
+
+      next_tag = @next_tag!
+      L\trace "assigned new tag #{next_tag} to #{tag} #{expr}"
+      tag\set next_tag
+      @map[tag\index!] = expr
+
+    @last_map = @map
+    @end_tick!
+
+  rollback_eval: =>
+    @end_tick!
+
+  next_tick: =>
+    @tick += 1
+
+  begin_tick: =>
+    @grab!
+    @next_tick!
+
+  end_tick: =>
+    @release!
 
   --- wrap a function with a tick.
   --
@@ -61,13 +110,16 @@ class Registry
   wrap_tick: (fn) => (...) ->
     @grab!
     @tick += 1
-    @kr.value\set true
 
-    for io in pairs @io
-      io\tick!
+    results = { pcall fn, ... }
+    ok = table.remove results, 1
 
-    with fn ...
+    if not ok
       @release!
+      error unpack results
+
+    @release!
+    unpack results
 
   grab: =>
     assert not @prev, "already have a previous registry? #{@prev}"
@@ -83,11 +135,8 @@ class Registry
   --- create a new Registry.
   -- @classmethod
   new: =>
-    @map = {}
-    @io = {}
-
+    @last_map, @map = {}, {}
     @tick = 0
-    @kr = Result value: Value.bool true
 
   --- get the active Registry.
   --
diff --git a/core/result.moon b/core/result.moon
index 5ad5734..357a868 100644
--- a/core/result.moon
+++ b/core/result.moon
@@ -63,7 +63,7 @@ class Result
           self_dirty = true
           break
 
-      L\trace "#{@op} is #{if self_dirty then 'dirty' else 'clean'}"
+      -- L\trace "#{@op} is #{if self_dirty then 'dirty' else 'clean'}"
       return unless self_dirty
 
       @op\tick!
diff --git a/logger.moon b/logger.moon
index 97b3c0d..b187a95 100644
--- a/logger.moon
+++ b/logger.moon
@@ -49,12 +49,14 @@ class Logger
       error unpack res
 
   try: (msg, fn, ...) =>
-    ok, err = xpcall fn, debug.traceback, ...
+    result = { xpcall fn, debug.traceback, ... }
+    ok = table.remove result, 1
 
     if not ok
-      @error msg, err
+      @error msg, unpack result
+      return
 
-    if ok then err
+    unpack result
 
 -- static
   init: (...) ->