new Registry tagging mechanism

13 files changed, 270 insertions, 143 deletions

diff --git a/copilot.moon b/copilot.moon
index fb88378..0d562f3 100644
--- a/copilot.moon
+++ b/copilot.moon
@@ -1,5 +1,5 @@
 lfs = require 'lfs'
-import parse from require 'core'
+import parse, globals, Scope, Registry from require 'core'
 
 slurp = (file) ->
   file = io.open file, 'r'
@@ -12,7 +12,9 @@ spit = (file, str) ->
   file\close!
 
 class Copilot
-  new: (@file, @registry) =>
+  new: (@file) =>
+    @registry = Registry!
+
     @last_modification = 0
 
     mode = lfs.attributes @file, 'mode'
@@ -20,19 +22,38 @@ class Copilot
       error "not a file: #{@file}"
 
   patch: =>
-    ast = parse slurp @file
+    ast, err = parse slurp @file
 
     if not ast
-      L\error "error parsing"
+      L\error "error parsing: #{err}"
+      return
+
+    ok, err = pcall @registry\prepare
+    if not ok
+      L\error "error preparing: #{err}"
+      return
+
+    scope = Scope ast, globals
+    ok, err = pcall ast\eval, scope, @registry
+    if not ok
+      L\error "error evaluating: #{err}"
       return
 
-    ok, err = pcall @registry\eval, ast
+    @root = err
+
+    ok, err = pcall @registry\finalize
     if not ok
-      L\error "error expanding: #{err}"
+      L\error "error finalizing: #{err}"
       return
 
     spit @file, ast\stringify!
 
+  update: (dt) =>
+    @poll!
+
+    if @root
+      @root\update dt
+
   tb = (msg) -> debug.traceback msg, 2
   poll: =>
     { :mode, :modification } = (lfs.attributes @file) or {}
diff --git a/core/base.moon b/core/base.moon
index 05f7590..3be2a98 100644
--- a/core/base.moon
+++ b/core/base.moon
@@ -22,12 +22,10 @@ class Op
 
 class Action
 -- common
-  new: (head, @tag, @registry) =>
+  new: (head, @tag) =>
+    @registry = @tag.registry -- @TODO: remove
     @patch head
 
-  register: =>
-    @tag = @registry\register @, @tag
-
 -- AST interface
   -- * eval args
   -- * perform scope effects
@@ -49,21 +47,29 @@ class Action
     @head = head
 
 -- static
-  @get_or_create: (ActionType, head, tag, registry) ->
-    last = tag and registry\prev tag
+  @get_or_create: (ActionType, head, tag) ->
+    last = tag\last!
     compatible = last and
                  (last.__class == ActionType) and
                  (last\patch head) and
                  last
 
-    if not compatible
+    L\trace if compatible
+      "reusing #{last} for #{tag} <#{ActionType.__name} #{head}>"
+    else if last
+      "replacing #{last} with new #{tag} <#{ActionType.__name} #{head}>"
+    else
+      "initializing #{tag} <#{ActionType.__name} #{head}>"
+
+    if compatible
+      tag\keep compatible
+      compatible
+    else
       last\destroy! if last
-      compatible = ActionType head, tag, registry
-
-    with compatible
-      \register!
+      with next = ActionType head, tag
+        tag\replace next
 
-  __tostring: => "<action: #{@@__name}>"
+  __tostring: => "<#{@@__name} #{@head}>"
   __inherited: (cls) => cls.__base.__tostring = @__tostring
 
 class FnDef
diff --git a/lib/builtin.moon b/core/builtin.moon
index 0ae2bd5..833f7a0 100644
--- a/lib/builtin.moon
+++ b/core/builtin.moon
@@ -1,17 +1,8 @@
-import Const, Cell, Action, FnDef, Scope from require 'core'
-
-class UpdateChildren
-  new: (@children) =>
-
-  update: (dt) =>
-    for child in *@children
-      L\trace "updating #{child}"
-      L\push child\update, dt
-
-  get: => @children[#@children]\get!
-  getc: => @children[#@children]\getc!
-
-  __tostring: => '<forwarder>'
+import Action, FnDef from require 'core.base'
+import Const from require 'core.const'
+import Cell from require 'core.cell'
+import Scope from require 'core.scope'
+import UpdateChildren from require 'core.invoke'
 
 class doc extends Action
   @doc: "(doc sym) - print documentation in console
@@ -33,7 +24,7 @@ defines the symbols sym1, sym2, ... to resolve to the values of val-expr1, val-e
 updates all val-exprs."
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail > 1, "'def' requires at least 2 arguments"
     assert #tail % 2 == 0, "'def' requires an even number of arguments"
 
@@ -55,7 +46,7 @@ adds all symbols from scope1, scope2, ... to the parent scope.
 all scopes have to be eval-time constants."
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     for child in *tail
       value = L\push child\eval, scope, @registry
       L\trace @, "merging #{value} into #{scope}"
@@ -71,7 +62,7 @@ returns the module's scope
 name-str has to be an eval-time constant."
 
   eval: (scope,  tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail == 1, "'require' takes exactly one parameter"
 
     name = L\push tail[1]\eval, scope, @registry
@@ -85,7 +76,7 @@ class import_ extends Action
 requires modules sym1, sym2, ... and defines them as sym1, sym2, ... in the current scope"
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail > 0, "'import' requires at least one arguments"
 
 
@@ -101,7 +92,7 @@ class import_star extends Action
 requires modules sym1, sym2, ... and merges them into the current scope"
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail > 0, "'import' requires at least one arguments"
 
 
@@ -117,7 +108,7 @@ class fn extends Action
 the symbols p1, p2, ... will resolve to the arguments passed to the function."
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail == 2, "'fn' takes exactly two arguments"
     { params, body } = tail
 
@@ -135,7 +126,7 @@ class defn extends Action
 declares a lambda (see (doc fn)) and defines it in the current scope"
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail == 3, "'defn' takes exactly three arguments"
     { name, params, body } = tail
 
@@ -168,7 +159,7 @@ bool has to be an eval-time constant. If it is truthy, this expression is equiva
 to then-expr, otherwise it is equivalent to else-xpr if given, or nil otherwise."
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail >= 2, "'if' needs at least two parameters"
     assert #tail <= 3, "'if' needs at most three parameters"
 
@@ -186,7 +177,7 @@ class trace extends Action
   @doc: "(trace expr) - print an eval-time constant to the console"
 
   eval: (scope, tail) =>
-    L\trace "expanding #{@}"
+    L\trace "evaling #{@}"
     assert #tail == 1, "'trace' takes exactly one parameter"
 
     with val = L\push tail[1]\eval, scope, @registry
diff --git a/core/cell.moon b/core/cell.moon
index 8f31f27..65273d8 100644
--- a/core/cell.moon
+++ b/core/cell.moon
@@ -1,5 +1,6 @@
 import Const from require 'core.const'
 import op_invoke, fn_invoke from require 'core.invoke'
+import Tag from require 'core.registry'
 
 class Cell
 -- common
@@ -7,6 +8,9 @@ class Cell
     if not @white
       @white = ['' for i=1,#@children+1]
 
+    if not @tag
+      @tag = Tag.blank!
+
   head: => @children[1]
   tail: => [c for c in *@children[2,]]
 
@@ -25,21 +29,23 @@ class Cell
       when 'builtin'
         head\getc!
       else
+        print head
+        for k,v in pairs head
+          print k,v
+          print head.__class.__name
         error "cannot evaluate expr with head #{head}"
 
-    action = Action\get_or_create head, @tag, registry
-    @tag or= action.tag
+    @tag.registry = registry
+    action = Action\get_or_create head, @tag
     action\eval scope, @tail!
 
   quote: (scope, registry) =>
     children = [child\quote scope, registry for child in *@children]
-    with cell = Cell nil, children, @white
-      cell.tag = registry\register cell, @tag
-      @tag = cell.tag -- for writing back to file
+    Cell @tag, children, @white
 
-  clone: (prefix) =>
-    tag = Const.sym prefix\getc! .. '.' .. @tag\getc!
-    children = [child\clone prefix for child in *@children]
+  clone: (parent) =>
+    tag = @tag\clone parent
+    children = [child\clone parent for child in *@children]
     Cell tag, children, @white
 
   stringify: (depth=-1) =>
@@ -53,10 +59,9 @@ class Cell
         buf ..= if depth > 0 then ' ' else @white[i]
 
       if depth > 0
-        buf = buf\sub 1, #buf - 1
+        buf = buf\sub 1, #b@uf - 1
 
-    tag = if @tag then "[#{@tag\stringify!}]" else ''
-    '(' .. tag .. buf .. ')'
+    '(' .. @tag\stringify! .. buf .. ')'
 
 -- static
   __tostring: => @stringify 2
@@ -91,6 +96,6 @@ class RootCell extends Cell
     buf
 
   @parse: (...) =>
-    @__parent.parse @, (Const.num 0), ...
+    @__parent.parse @, (Tag\parse '0'), ...
 
 :Cell, :RootCell
diff --git a/core/init.moon b/core/init.moon
index c91f0e4..c8f0265 100644
--- a/core/init.moon
+++ b/core/init.moon
@@ -6,28 +6,38 @@ import Const, load_ from require 'core.const'
 import Scope from require 'core.scope'
 load_!
 
+import Registry from require 'core.registry'
+
 import Cell, RootCell from require 'core.cell'
 import cell, program from require 'core.parsing'
 
+globals = Scope.from_table require 'core.builtin'
+
 {
   :Const, :Cell, :RootCell
   :Op, :Action, :FnDef
   :Scope
 
+  :Registry
+  :globals
+
   parse: program\match
   eval: do
     class BuiltinRegistry
       new: =>
-        @last = 1
+        @cnt = 1
+
+      init: (tag, expr) =>
+        tag\set @cnt
+        @cnt += 1
 
-      register: (thing, tag) =>
-        with tag or Const.sym "builtin.#{@last}"
-          @last += 1
+      last: (index) =>
+      replace: (index, expr) =>
 
     registry = BuiltinRegistry!
 
     (str, inject) ->
-      scope = Scope.from_table require 'lib.builtin'
+      scope = Scope nil, globals
       scope\use inject if inject
 
       ast = assert (cell\match str), "failed to parse: #{str}"
diff --git a/core/invoke.moon b/core/invoke.moon
index 9955bce..9c324e1 100644
--- a/core/invoke.moon
+++ b/core/invoke.moon
@@ -7,7 +7,7 @@ class UpdateChildren
 
   update: (dt) =>
     for child in *@children
-      L\trace "updating #{child}"
+      -- L\trace "updating #{child}"
       L\push child\update, dt
 
   get: => @children[#@children]\get!
@@ -28,7 +28,9 @@ class op_invoke extends Action
     true
     
   eval: (scope, tail) =>
-    args = [expr\eval scope, @registry for expr in *tail]
+    L\trace "evaling #{@}"
+    args = L\push -> [L\push expr\eval, scope, @registry for expr in *tail]
+
     -- Const 'op', with @op
     with @op
       \setup unpack args
@@ -63,19 +65,10 @@ class fn_invoke extends Action
     body\eval fn_scope, @registry
 
 class do_expr extends Action
-  class DoWrapper
-    new: (@children) =>
-
-    update: (dt) =>
-      for child in *@children
-        L\push child\update, dt
-
-    get: => @children[#@children]\get!
-    getc: => @children[#@children]\getc!
-
-    __tostring: => '<dowrapper>'
-
   eval: (scope, tail) =>
     UpdateChildren [(expr\eval scope, @registry) or Const.empty! for expr in *tail]
 
-:op_invoke, :fn_invoke
+{
+  :op_invoke, :fn_invoke
+  :UpdateChildren
+}
diff --git a/core/parsing.moon b/core/parsing.moon
index 5186cb8..c23b7b7 100644
--- a/core/parsing.moon
+++ b/core/parsing.moon
@@ -1,5 +1,6 @@
 import Const from require 'core.const'
 import Cell, RootCell from require 'core.cell'
+import Tag from require 'core.registry'
 import R, S, P, V, C, Ct from require 'lpeg'
 
 -- whitespace
@@ -29,7 +30,7 @@ atom = num + sym + str
 expr = (V 'cell') + atom
 explist = Ct mspace * (V 'expr') * (space * (V 'expr'))^0 * mspace
 
-tag = (P '[') * atom * (P ']')
+tag = (P '[') * (digit^1 / Tag\parse) * (P ']')
 cell = (P '(') * tag^-1 * (V 'explist') * (P ')') / Cell\parse
 
 root = P {
diff --git a/core/registry.moon b/core/registry.moon
new file mode 100644
index 0000000..7c89fa4
--- /dev/null
+++ b/core/registry.moon
@@ -0,0 +1,114 @@
+import Const from require 'core.const'
+import Scope from require 'core.scope'
+
+local ClonedTag
+
+class Tag
+  new: (@value) =>
+
+  clone: (parent) => ClonedTag @, parent
+
+  last: =>
+    if index = @index!
+      @registry\last index
+
+  keep: (expr) =>
+    index = assert @index!
+    assert expr == @registry\last index
+    @registry\replace index, expr
+
+  replace: (expr) =>
+    if index = @index!
+      @registry\replace index, expr
+    else
+      @registry\init @, expr
+
+index: => @value
+
+  set: (value) =>
+    assert not @value, "setting #{@} again"
+    @value = value
+
+  @blank: -> Tag!
+  @parse: (num) => @ tonumber num
+
+  stringify: => if @value then "[#{@value}]" else ''
+
+  __tostring: => if @value then "#{@value}" else '[blank]'
+
+class ClonedTag extends Tag
+  class DummyReg
+    destroy: =>
+
+  new: (@original, @parent) =>
+    @registry = @original.registry
+    @dummy = DummyReg!
+
+  keep: (expr) =>
+    super\keep expr
+    @original.registry or= @registry
+    @original\replace @dummy
+
+  replace: (expr) =>
+    super\replace expr
+    @original.registry or= @registry
+    @original\replace @dummy
+
+  index: =>
+    orig = @original\index!
+    parent = @parent\index!
+    if orig and parent
+      "#{parent}.#{orig}"
+
+  set: (value) => @original\set value
+
+  stringify: => error "cant stringify ClonedTag"
+
+  __tostring: =>
+    if @parent
+      "#{@parent}.#{@original}"
+    else
+      tostring @original
+
+class Registry
+  new: () =>
+    @map = {}
+
+-- methods for Tag
+
+  last: (index) => @last_map[index]
+
+  replace: (index, expr) =>
+    L\trace "reg: setting #{index} to #{expr}"
+    assert not @map[index], "duplicate tags with index #{index}!"
+    @map[index] = expr
+
+  init: (tag, expr) =>
+    L\trace "reg: init pending to #{expr}"
+    table.insert @pending, { :tag, :expr }
+
+-- public methods
+
+  prepare: =>
+    @last_map, @map, @pending = @map, {}, {}
+
+  finalize: =>
+    for tag, val in pairs @last_map
+      if not @map[tag]
+        val\destroy!
+
+    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!
+
+      L\trace "assigning new tag #{value} to #{tag} #{expr}"
+      tag\set @next_tag!
+      @map[tag\index!] = expr
+
+  next_tag: => #@map + 1
+
+{
+  :Tag
+  :Registry
+}
diff --git a/init.moon b/init.moon
index 41acabe..d4f7e85 100644
--- a/init.moon
+++ b/init.moon
@@ -1,7 +1,6 @@
 -- run from CLI
 import monotime, sleep from require 'system'
 import Logger from require 'logger'
-import Registry from require 'registry'
 import Copilot from require 'copilot'
 
 arguments, key = {}
@@ -33,11 +32,9 @@ delta = do
     with time - (last or time)
       last = time
 
-env = Registry!
-copilot = Copilot arguments[1], env
+copilot = Copilot arguments[1]
 
 while true
   dt = delta!
 
-  copilot\poll!
-  env\update dt
+  copilot\update dt
diff --git a/lib/gui.moon b/lib/gui.moon
index 5ec7883..a2fee4b 100644
--- a/lib/gui.moon
+++ b/lib/gui.moon
@@ -2,7 +2,6 @@ assert love, "this module only works from within love2d!"
 { graphics: lg, keyboard: lk } = love
 
 import Op from require 'core'
-import Registry from require 'registry'
 import Copilot from require 'copilot'
 import Logger from require 'logger'
 
@@ -62,12 +61,10 @@ for a in *arg
 
 Logger.init arguments.log
 
-env = Registry!
-copilot = Copilot arguments[#arguments], env
+copilot = Copilot arguments[#arguments]
 
 love.update = (dt) ->
-  copilot\poll!
-  env\update dt
+  copilot\update dt
  
 love.draw = ->
   out.draw_all!
diff --git a/pilot.alv b/pilot.alv
new file mode 100644
index 0000000..1623d46
--- /dev/null
+++ b/pilot.alv
@@ -0,0 +1,46 @@
+([1]import* math time string util)
+([2]import osc envelope midi pilot)
+
+([3]defn make-lfo (type)
+  ([8]fn ([5]f) ([7]lfo ([6]* f 0.5) type)))
+
+([9]def sin-lfo ([10]make-lfo 'sin'))
+
+([11]defn send (name value)
+  ([13]osc/out '127.0.0.1' 9000
+    ([12].. '/param/' name '/set')
+    value))
+
+([28]def trigger ([48]edge ([47]switch ([45]tick .3) true false)))
+
+([29]pilot/play
+  trigger #(trigger)
+  ([30]ramp 8) #(ch)
+  3 #(oct) 
+  ([37]switch #(note)
+    ([46]tick .5)
+    'a' 'c' 'e' 'b' 'c')
+  4 4)
+
+([54]def f false t true)
+
+([67]def kick ([50]edge ([59]switch ([60]tick .15) t f f f t f f f)))
+
+([23]send 'radius' ([25]
+  ([24]envelope/ar ([14]midi/cc 0) ([15]midi/cc 1))
+  kick))
+
+([33]pilot/play kick
+  12 2 ([55]switch ([56]tick 2) 'c' 'a' 'f') 2)
+([51]pilot/play ([52]edge ([61]switch ([62]tick .15) f f t f f f f t)) 13 3 'c' 1)
+
+([31]defn cc-effect (name a b)
+  ([41]pilot/effect name ([32]midi/cc a 0 16) ([40]midi/cc b 0 16)))
+
+([42]cc-effect 'FEE' 16 17)
+#([43]cc-effect 'REV' 18 19)
+([44]cc-effect 'BIT' 20 21)
+
+([63]pilot/effect "REV" ([66]+ 1 ([64]* ([65]lfo .18) 2)) 2)
+
+([19]send 'offset' ([20]sin-lfo ([16]keep ([26]midi/cc 24 0 4))))
diff --git a/registry.moon b/registry.moon
deleted file mode 100644
index a946e9a..0000000
--- a/registry.moon
+++ /dev/null
@@ -1,54 +0,0 @@
-import Const, Scope from require 'core'
-
-class Registry
-  new: () =>
-    @globals = Scope!
-    @globals\use Scope.from_table require 'lib.builtin'
-
-    @prev_map = {}
-    @map = {}
-
-  --
-
-  step: =>
-    for tag, val in pairs @prev_map
-      if not @map[tag]
-        val\destroy!
-
-    @prev_map, @map = @map, {}
-
-  register: (expr, tag) =>
-    tag or= @gentag!
-    L\trace "registering #{expr} for tag #{tag}"
-    num = tag\getc!
-    if old = @map[num]
-      error "double registration: #{num}\n(old: #{old}, new: #{expr})"
-    @map[num] = expr
-    tag
-
-  prev: (tag) =>
-    @prev_map[tag\getc!]
-
-  gentag: =>
-    num = (math.max #@map, #@prev_map) + 1
-
-    while @map[num] or @prev_map[num]
-      num += 1
-
-    Const.num num
-
-  eval: (ast) =>
-    @map = {} -- in case we errored last time
-    scope = Scope ast, @globals
-
-    @root = ast\eval scope, @
-    @step!
-
-  --
-
-  update: (dt) =>
-    return unless @root
-
-    @root\update dt
-
-:Registry
diff --git a/spec/cell_spec.moon b/spec/cell_spec.moon
index 6ec9fc8..f55ab4d 100644
--- a/spec/cell_spec.moon
+++ b/spec/cell_spec.moon
@@ -1,4 +1,4 @@
-import Cell, RootCell, Const, Scope from require 'core'
+import Cell, RootCell, Const, Scope, globals from require 'core'
 import Registry from require 'registry'
 import Logger from require 'logger'
 Logger.init 'silent'
@@ -40,13 +40,13 @@ describe 'Cell', ->
       (assert.spy reg.register).was.called_with reg, match._, Const.num 2
 
   describe 'evaluation', ->
+    globals\use Scope.from_table require 'lib.math'
     registry = Registry!
-    registry.globals\use Scope.from_table require 'lib.math'
 
     local op, action
 
     it 'instantiates the op + action', ->
-      op = two_plus_two\eval registry.globals, registry
+      op = two_plus_two\eval globals, registry
       action = registry.map[two_plus_two.tag.value]
 
       assert.is.equal 'add', op.__class.__name
@@ -57,7 +57,7 @@ describe 'Cell', ->
       two_plus_two.children[3] = Const.num 3
 
       s = spy.on op, 'setup'
-      assert.is.equal op, two_plus_two\eval registry.globals, registry
+      assert.is.equal op, two_plus_two\eval globals, registry
       assert.is.equal action, registry.map[two_plus_two.tag.value]
       (assert.spy s).was.called_with (match.is_ref op), (Const.num 2), (Const.num 3)
       registry\step!
@@ -67,7 +67,7 @@ describe 'Cell', ->
       two_plus_two.children[2] = Const.num 6
 
       s = spy.on op, 'destroy'
-      assert.not.equal op, two_plus_two\eval registry.globals, registry
+      assert.not.equal op, two_plus_two\eval globals, registry
       assert.is.equal action, registry.map[two_plus_two.tag.value]
       assert.is.equal 'sub', action.op.__class.__name
       (assert.spy s).was.called_with match.is_ref op