refactor Tag/Registry, reuse deleted tags

6 files changed, 57 insertions, 57 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!