refactor Tag/Registry, reuse deleted tags

10 files changed, 77 insertions, 76 deletions

diff --git a/alv/builtins.moon b/alv/builtins.moon
index 6e36c7e..abffaf2 100644
--- a/alv/builtins.moon
+++ b/alv/builtins.moon
@@ -457,7 +457,7 @@ trace = Constant.meta
       L\trace "evaling #{@}"
       assert #tail == 1, "'trace' takes exactly one parameter"
 
-      tag = @tag\clone Tag.parse '-1'
+      tag = (Tag 'trace')\clone @tag
       inner = Cell tag, {
         Dummy.literal T.opdef, traceOp
         Constant.str tail[1]\stringify 2
@@ -669,7 +669,7 @@ with a different set of arguments, e.g. to sum the first `5` integers:
       def_scope = Scope scope
       def_scope\set '*recur*', RTNode result: Constant.wrap loop_fn
 
-      tag = @tag\clone Tag.parse '-1'
+      tag = (Tag 'loop')\clone @tag
       inner = Cell tag, inner
       super inner\eval def_scope
 
diff --git a/alv/cell.moon b/alv/cell.moon
index 989d4ad..6e141aa 100644
--- a/alv/cell.moon
+++ b/alv/cell.moon
@@ -138,7 +138,7 @@ class Cell
   -- @tparam[opt] Tag tag
   -- @tparam {AST,...} children
   -- @tparam[opt] {string,...} white whitespace strings
-  new: (@tag=Tag.blank!, @children, @white) =>
+  new: (@tag=Tag!, @children, @white) =>
     if not @white
       @white = [' ' for i=1,#@children]
       @white[0] = ''
@@ -159,9 +159,7 @@ class RootCell extends Cell
   head: => Constant.sym 'do'
   tail: => @children
 
-  new: (...) =>
-    super ...
-    @tag = Tag.parse '0'
+  new: (tag=(Tag "root"), ...) => super tag, ...
 
   stringify: =>
     buf = ''
@@ -194,7 +192,7 @@ class ArrayCell extends RootCell
     assert #@children > 0, Error 'syntax', "array literal can't be empty"
     super ...
 
-  new: (...) => Cell.__init @, ...
+  new: (tag=(Tag "array"), ...) => Cell.__init @, tag, ...
 
 --- @type StructCell
 class StructCell extends RootCell
@@ -207,7 +205,7 @@ class StructCell extends RootCell
     assert #@children % 2 == 0, Error 'syntax', "struct literal must have even number of values"
     super ...
 
-  new: (...) => Cell.__init @, ...
+  new: (tag=(Tag "struct"), ...) => Cell.__init @, tag, ...
 
 --- @type TemplateString
 class TemplateString extends Cell
diff --git a/alv/init.moon b/alv/init.moon
index 0637c5c..f1fa8b0 100644
--- a/alv/init.moon
+++ b/alv/init.moon
@@ -19,7 +19,7 @@ import Constant, SigStream, EvtStream from require 'alv.result'
 import RTNode from require 'alv.rtnode'
 import Scope from require 'alv.scope'
 import Error from require 'alv.error'
-import Registry, SimpleRegistry from require 'alv.registry'
+import Registry from require 'alv.registry'
 import Tag from require 'alv.tag'
 
 import Cell, RootCell from require 'alv.cell'
@@ -60,7 +60,7 @@ cycle\resolve!
 
   :T, :Primitive, :Struct, :Array
 
-  :Registry, :SimpleRegistry, :Tag
+  :Registry, :Tag
   :Logger
 
   globals: globals!
diff --git a/alv/module.moon b/alv/module.moon
index 2fa24d9..6eeb10b 100644
--- a/alv/module.moon
+++ b/alv/module.moon
@@ -42,7 +42,7 @@ class Module
     @ast = Error.wrap "parsing '#{@name true}'", -> program\match @slurp!
     assert @ast, Error 'syntax', "failed to parse"
 
-    @registry\scan_ast @ast
+    @registry\assign_tags!
 
     scope = Scope builtins!, parent_scope
     @root = Error.wrap "evaluating '#{@name true}'", @ast\eval, scope, @registry
diff --git a/alv/registry.moon b/alv/registry.moon
index 35f396d..b625c1f 100644
--- a/alv/registry.moon
+++ b/alv/registry.moon
@@ -16,33 +16,53 @@ class Registry
   --- set the current registration.
   --
   -- @tparam Tag tag the Tag to register
-  -- @tparam any expr the registration value
-  -- @tparam[default=false] boolean ignore_dup ignore duplicate registrations
-  register: (tag, ignore_dup=false) =>
+  -- @treturn boolean whether the tag is new
+  register: (tag) =>
     index = tag\index!
 
     if index and not @map[index] or ignore_dup
+      L\trace "reg: registering #{index} (#{ignore_dup})"
       @map[index] = tag
+      nil
     else
       if index
         L\warn "duplicate tag [#{index}], reassigning repeated occurrence"
         tag\set nil
 
       table.insert @pending, tag
-      L\trace "reg: setting #{index} to #{expr}"
+      L\trace "reg: registered pending"
+      true
 
 --- members
 -- @section members
 
   --- begin an evaluation cycle.
   --
-  -- All calls go `begin_eval` must be matched with either a call to
-  -- `end_eval` or `rollback_eval`.
+  -- All calls go `begin_eval` must be matched with a call to
+  -- `assign_tags` followed by either `end_eval` or `rollback_eval`.
   begin_eval: =>
     assert not @map, "unfinished evaluation cycle"
     @map, @pending = {}, {}
 
+  --- assign unique tags to pending registrations.
+  --
+  -- Assigns a unique number to each tag added in this evaluation cycle.
+  assign_tags: =>
+    next_tag = 1
+
+    for tag in *@pending
+      if not tag\index!
+        while @map[next_tag]
+          next_tag += 1
+
+        L\trace "assigned new tag #{next_tag} to #{tag}"
+        tag\set next_tag
+
+      @map[tag\index!] = tag
+
   --- abort an evaluation cycle.
+  --
+  -- Destroys all pending registrations
   rollback_eval: =>
     assert @map, "no eval cycle to abort"
     for tag in *@pending
@@ -51,33 +71,19 @@ class Registry
 
     @map, @pending = nil, nil
 
-  scan_ast_node: (ast) =>
-    if ast.tag
-      @register ast.tag
-
-    if ast.children
-      for child in *ast.children
-        @scan_ast_node child
-
-  scan_ast: (ast) =>
-    @scan_ast_node ast
-
-    for tag 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 = #@map + 1
-      L\trace "assigned new tag #{next_tag} to #{tag} #{expr}"
-      tag\set next_tag
-
   --- end an evaluation cycle.
   --
   -- Register all pending `Tag`s and destroy all orphaned registrations.
   -- @treturn bool whether any changes to the AST were made
   end_eval: =>
+    -- destroy old registrations
     for index, tag in pairs @last_map
-      tag.builtin\destroy!
+      if builtin = tag.builtin
+        builtin\destroy!
+
+    -- mark all regisrations complete
+    for index, tag in pairs @map
+      tag.pending = nil
 
     dirty = #@pending > 0
     @last_map, @map, @pending = @map, nil, nil
@@ -89,7 +95,8 @@ class Registry
   destroy: =>
     assert not @tag, "unfinished evaluation cycle"
     for index, tag in pairs @last_map
-      tag.builtin\destroy!
+      if builtin = tag.builtin
+        builtin\destroy!
 
     @last_map = {}
 
@@ -101,18 +108,6 @@ class Registry
   new: =>
     @last_map = {}
 
-class SimpleRegistry extends Registry
-  new: =>
-    @cnt = 1
-
-  init: (tag, expr) =>
-    tag\set @cnt
-    @cnt += 1
-
-  last: (index) =>
-  register: (index, expr) =>
-
 {
   :Registry
-  :SimpleRegistry
 }
diff --git a/alv/tag.moon b/alv/tag.moon
index ed59be6..1ad9b28 100644
--- a/alv/tag.moon
+++ b/alv/tag.moon
@@ -4,10 +4,10 @@
 -- Tags are one of:
 -- - 'blank' (`[?]`, to be auto-assigned by the Copilot)
 -- - literal (`[1]`)
+-- - virtual (`[str]`, won't be tracked)
 -- - cloned (`[X.Y]`, obtained by cloning Y with parent X)
 --
 -- @classmod Tag
-import Registry from require 'alv.registry'
 
 local ClonedTag
 
@@ -22,6 +22,7 @@ class Tag
   --
   -- @treturn ?any
   last: =>
+    return if @pending
     if index = @index!
       COPILOT.active_module.registry\last index
 
@@ -32,6 +33,7 @@ class Tag
   -- @tparam Tag parent the parent tag
   -- @treturn Tag the cloned tag
   clone: (parent) =>
+    @builtin or= false
     assert parent, "need parent to clone!"
     ClonedTag @, parent
 
@@ -42,6 +44,9 @@ class Tag
 -- @section internals
 
   new: (@value) =>
+    if COPILOT and "string" != type @value
+      registry = COPILOT.active_module.registry
+      @pending = registry\register @
 
   --- get a unique index value for this Tag.
   --
@@ -64,11 +69,6 @@ class Tag
 --- static functions
 -- @section static
 
-  --- create a blank `Tag`.
-  --
-  -- @treturn Tag
-  @blank: -> Tag!
-
   --- parse a `Tag` (for Lpeg parsing).
   --
   -- @tparam string num the number-string
@@ -77,6 +77,13 @@ class Tag
 
 class ClonedTag extends Tag
   new: (@original, @parent) =>
+    if 'string' == type @original.value
+      return
+
+    registry = COPILOT.active_module.registry
+    registry\register @
+
+    @pending = @original.pending or @parent.pending
 
   index: =>
     orig = @original\index!
diff --git a/spec/internal/cell_spec.moon b/spec/internal/cell_spec.moon
index c9ccb39..bcc5700 100644
--- a/spec/internal/cell_spec.moon
+++ b/spec/internal/cell_spec.moon
@@ -1,6 +1,6 @@
 import do_setup from require 'spec.test_setup'
 import Cell, RootCell from require 'alv.cell'
-import Constant, Scope, Tag, SimpleRegistry, globals from require 'alv'
+import Constant, Scope, Tag, globals from require 'alv'
 
 setup do_setup
 
@@ -13,7 +13,7 @@ two_plus_two = Cell.parse Tag.parse('3'), {
 
 describe 'Cell', ->
   describe 'when cloned', ->
-    parent = Tag.blank '1'
+    parent = Tag!
     with hello_world\clone parent
       it 'keeps children', ->
         assert.is.equal Cell, .__class
@@ -38,9 +38,9 @@ describe 'Cell', ->
       assert.spy(s).was_called_with (match.is_ref head), (match.is_ref globals)
 
 describe 'RootCell', ->
-  test 'tag is always [0]', ->
+  test 'tag is always [root]', ->
     cell = RootCell\parse {}
-    assert.is.equal '[0]', cell.tag\stringify!
+    assert.is.equal '[root]', cell.tag\stringify!
 
   test 'head is always "do"', ->
     cell = RootCell\parse {}
diff --git a/spec/internal/rtnode_spec.moon b/spec/internal/rtnode_spec.moon
index f757067..dfade3e 100644
--- a/spec/internal/rtnode_spec.moon
+++ b/spec/internal/rtnode_spec.moon
@@ -1,5 +1,5 @@
 import do_setup from require 'spec.test_setup'
-import RTNode, Scope, SimpleRegistry from require 'alv'
+import RTNode, Scope from require 'alv'
 import T, Input, Op, Constant from require 'alv.base'
 
 class IOOp extends Op
diff --git a/spec/internal/tag_spec.moon b/spec/internal/tag_spec.moon
index f92dca0..3fffcb7 100644
--- a/spec/internal/tag_spec.moon
+++ b/spec/internal/tag_spec.moon
@@ -1,8 +1,9 @@
-import do_setup from require 'spec.test_setup'
+import do_setup, do_teardown from require 'spec.test_setup'
 import Tag from require 'alv.tag'
 import Registry from require 'alv.registry'
 
-setup do_setup
+before_each do_setup
+after_each do_teardown
 
 describe 'Tag', ->
   describe 'should be constructable', ->
@@ -14,7 +15,7 @@ describe 'Tag', ->
       assert.is.equal '2', tostring tag
 
     it 'as blank Tags', ->
-      tag = Tag.blank!
+      tag = Tag!
       assert tag
       assert.is.nil tag.value
       assert.is.equal '', tag\stringify!
@@ -35,19 +36,19 @@ describe 'Tag', ->
 
     it 'but not from blank tags', ->
       parent = Tag.parse '1'
-      original = Tag.blank!
+      original = Tag!
       tag = original\clone parent
       do_asserts tag, '1.?'
 
     it 'with blank parent', ->
-      parent = Tag.blank!
+      parent = Tag!
       original = Tag.parse '2'
       tag = original\clone parent
       do_asserts tag, '?.2'
 
     it 'completely blank', ->
-      parent = Tag.blank!
-      original = Tag.blank!
+      parent = Tag!
+      original = Tag!
       tag = original\clone parent
       do_asserts tag, '?.?'
 
@@ -59,17 +60,17 @@ describe 'Tag', ->
       clone = tag\clone Tag.parse '3'
       assert.has.error -> clone\set 42
 
-      clone = tag\clone Tag.blank!
+      clone = tag\clone Tag!
       assert.has.error -> clone\set 42
 
     it 'and stores the value', ->
-      blank = Tag.blank!
+      blank = Tag!
       blank\set 12
 
       assert.is.equal blank.value, 12
 
     it 'sets the original if cloned', ->
-      original = Tag.blank!
+      original = Tag!
       parent = Tag.parse '7'
 
       o_set = spy.on original, 'set'
@@ -84,8 +85,8 @@ describe 'Tag', ->
       assert.is.equal original.value, 11
  
     it 'requires the parent to be registered if cloned', ->
-      original = Tag.blank!
-      parent = Tag.blank!
+      original = Tag!
+      parent = Tag!
 
       clone = original\clone parent
       assert.has.error -> clone\set 11
diff --git a/spec/test_setup.moon b/spec/test_setup.moon
index 53d1451..e58b53a 100644
--- a/spec/test_setup.moon
+++ b/spec/test_setup.moon
@@ -88,8 +88,8 @@ class TestPilot extends Copilot
     fake_cell =
       head: -> 'test_op'
       tail: -> tail
-      tag: Tag.blank!
+      tag: Tag!
 
-    COPILOT.active_module.registry\scan_ast fake_cell
+    COPILOT.active_module.registry\assign_tags!
     op_invoke\eval_cell fake_cell, Scope!, Constant.wrap op
 }