re-fix functions

12 files changed, 228 insertions, 113 deletions

diff --git a/base.moon b/base.moon
index b623b7b..bfdf7da 100644
--- a/base.moon
+++ b/base.moon
@@ -10,16 +10,16 @@ ancestor = (klass) ->
 
 class Op
 -- common
-  new: (...) =>
-    @setup ...
+  new: =>
+  -- (...) => @setup ...
 
   get: => @value
   getc: =>
     L\warn "stream #{@} cast to constant"
     @value
 
--- interface
-  update: (dt) =>
+-- Value interface
+  update: =>
 
   destroy: =>
 
@@ -38,7 +38,7 @@ class Action
   register: =>
     @tag = @registry\register @, @tag
 
--- interface
+-- AST interface
   -- * eval args
   -- * perform scope effects
   -- * patch nested exprs
@@ -60,10 +60,11 @@ class Action
 
 -- static
   @get_or_create: (ActionType, head, tag, registry) ->
-    last = tag and registry\find tag
+    last = tag and registry\prev tag
     compatible = last and
-                 last.__class == ActionType and
-                 last\patch head
+                 (last.__class == ActionType) and
+                 (last\patch head) and
+                 last
 
     if not compatible
       last\destroy! if last
@@ -78,18 +79,19 @@ class Action
 class Const
   types = {
     sym: true
-    scope: true
     str: true
     num: true
+    scope: true
     op: true
     opdef: true
+    fndef: true
     builtin: true
   }
 
--- Value interface
   new: (@type, @value, @raw) =>
     assert types[@type], "invalid Const type: #{@type}"
 
+-- Value interface
   get: (type) =>
     assert not type or type == @type, "#{@} is not a #{type}"
     @value
@@ -98,13 +100,18 @@ class Const
     assert not type or type == @type, "#{@} is not a #{type}"
     @value
 
+  update: (dt) =>
+    switch @type
+      when 'op'
+        @value\update dt
+
 -- AST interface
   eval: (scope) =>
     switch @type
       when 'num', 'str'
         @
       when 'sym'
-        assert (scope\get @value), "undefined reference to symbol '#{@raw}'"
+        assert (scope\get @value), "undefined reference to symbol '#{@value}'"
       else
         error "cannot evaluate #{@}"
 
@@ -114,17 +121,13 @@ class Const
 
 -- static
   __tostring: =>
-    value = if @type\match 'def$' then @value.__name else @value
+    value = if @type == 'opdef' or @type == 'builtin' then @value.__name else @value
     "<#{@type}: #{value}>"
 
   __eq: (other) =>
     other.type == @type and other.value == @value
 
-  unescape = (str) ->
-    str = str\gsub '\\"', '"'
-    str = str\gsub "\\'", "'"
-    str = str\gsub "\\\\", "\\"
-    str
+  unescape = (str) -> str\gsub '\\([\'"\\])', '%1'
 
   @parse: (type, sep) =>
     switch type
@@ -132,9 +135,10 @@ class Const
       when 'sym' then (match) -> @ 'sym', match, match
       when 'str' then (match) -> @ 'str', (unescape match), sep .. match .. sep
 
-  @num: (num) -> Const 'num', num
-  @str: (str) -> Const 'str', str
-  @sym: (sym) -> Const 'sym', sym
+  @num: (num) -> Const 'num', num, tostring num
+  @str: (str) -> Const 'str', str, "'#{str}'"
+  @sym: (sym) -> Const 'sym', sym, sym
+  @empty: -> Const 'str', '', "''"
 
   @wrap: (val, name='(unknown)') ->
     typ = switch type val
@@ -169,6 +173,9 @@ local builtin
 class Cell
 -- common
   new: (@tag, @children, @white) =>
+    if not @white
+      @white = ['' for i=1,#@children+1]
+
     builtin or= require 'lib.builtin'
 
   head: => @children[1]
@@ -189,27 +196,31 @@ class Cell
       else
         error "cannot evaluate expr with head #{head}"
 
-    action = Action\get_or_create head, tag, registry
+    action = Action\get_or_create head, @tag, registry
+    @tag or= action.tag
     action\eval scope, @tail!
 
   quote: (scope, registry) =>
-    tag = registry\register @, @tag
+    @tag = registry\register @, @tag
     children = [child\quote scope, registry for child in *@children]
-    Cell tag, children, @white, @style
+    @
 
-  stringify: (inner=false) =>
+  stringify: (depth=-1) =>
     buf = ''
-    buf ..= @white[0]
-    for i, child in ipairs @children
-      buf ..= child\stringify!
-      buf ..= @white[i]
-
-    return buf if inner
+    buf ..= if depth > 0 then ' ' else @white[0]
+    if depth == 0
+      buf ..= '...'
+    else
+      for i, child in ipairs @children
+        buf ..= child\stringify depth - 1
+        buf ..= if depth > 0 then ' ' else @white[i]
 
     tag = if @tag then "[#{@tag\stringify!}]" else ''
     '(' .. tag .. buf .. ')'
 
 -- static
+  __tostring: => @stringify 2
+
   parse_args = (tag, parts) ->
     if not parts
       parts, tag = tag, nil
@@ -230,7 +241,14 @@ class RootCell extends Cell
   tail: => @children
 
   stringify: =>
-    super\stringify true
+    buf = ''
+    buf ..= @white[0]
+
+    for i, child in ipairs @children
+      buf ..= child\stringify!
+      buf ..= @white[i]
+
+    buf
 
 {
   :Op
diff --git a/copilot.moon b/copilot.moon
index 71820fc..3e07dc7 100644
--- a/copilot.moon
+++ b/copilot.moon
@@ -20,22 +20,18 @@ class Copilot
       error "not a file: #{@file}"
 
   patch: =>
-    root = program\match slurp @file
+    ast = program\match slurp @file
 
-    if not root
+    if not ast
       L\error "error parsing"
       return
 
-    ok, err = pcall @registry\retag, root
+    ok, err = pcall @registry\eval, ast
     if not ok
       L\error "error expanding: #{err}"
       return
 
-    spit @file, root\stringify!
-
-    ok, err = pcall @registry\patch
-    if not ok
-      L\error "error patching: #{err}"
+    spit @file, ast\stringify!
 
   tb = (msg) -> debug.traceback msg, 2
   poll: =>
diff --git a/lib/builtin.moon b/lib/builtin.moon
index 96eb0f0..5c3d7d4 100644
--- a/lib/builtin.moon
+++ b/lib/builtin.moon
@@ -1,6 +1,19 @@
 import Action, Const, Cell from require 'base'
 import Scope from require 'scope'
 
+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>'
+
 -- (def sym1 val-expr1
 --     [sym2 val-expr2]...)
 --
@@ -9,45 +22,35 @@ import Scope from require 'scope'
 -- if val-expr is a expand-time constant, defines a `Const`,
 -- otherwise places a `Forward` for the expr
 class def extends Action
-  expand: (scope, tail) =>
+  eval: (scope, tail) =>
     L\trace "expanding #{@}"
     assert #tail > 1, "'def' requires at least 2 arguments"
     assert #tail % 2 == 0, "'def' requires an even number of arguments"
 
-    L\push ->
-      for i=1,#tail,2
+    values = L\push ->
+      return for i=1,#tail,2
         name, val_expr = tail[i], tail[i+1]
-        name = (name\quote scope, @registry)!\getc!
-        assert name.type == 'sym', "'def's argument ##{i} has to be a symbol"
-
-        scope\set name, val_expr\eval scope, @registry
+        name = (name\quote scope, @registry)\getc 'sym'
 
-    nil
-
-  patch: (registry) =>
-    L\trace "patching #{@}"
-    for child in *@node[3,,2]
-      L\push child\patch, registry
+        val = val_expr\eval scope, @registry
+        scope\set name, val
+        val
 
-  update: (dt) =>
-    L\trace "updating #{@}"
-    for child in *@node[3,,2]
-      L\push child\update, dt
+    UpdateChildren values
 
 -- (require name-str)
 --
 -- require a lua module and return its `Scope`
 -- name-str has to be an expand-time constant
 class require_mod extends Action
-  expand: (scope,  tail) =>
+  eval: (scope,  tail) =>
     L\trace "expanding #{@}"
     assert #tail == 1, "'require' takes only one parameter"
 
     name = L\push tail[1]\eval, scope, @registry
-    assert name.type == 'str', "'require' only works on strings"
 
     L\trace @, "loading module #{name}"
-    scope = Scope.from_table require "lib.#{name\getc!}"
+    scope = Scope.from_table require "lib.#{name\getc 'str'}"
     Const 'scope', scope
 
 -- (use scope1 [scope2]...)
@@ -61,26 +64,28 @@ class use extends Action
       value = L\push child\eval, scope, @registry
       L\trace @, "merging #{value} into #{scope}"
       assert value.type == 'scope', "'use' only works on scopes"
-      scope\use value\getc!
+      scope\use value\getc 'scope'
 
     nil
 
 -- (fn (p1 [p2]...) body-expr)
 --
 -- declare a function
---
--- pX are symbols that will resolve to a 'Forward' in the body
 class fn extends Action
   class FnDef
     new: (@params, @body) =>
 
+    __tostring: =>
+      table.concat [p\stringify! for p in *@params], ' '
+
   eval: (scope, tail) =>
     L\trace "expanding #{@}"
     assert #tail == 2, "'fn' takes exactly two arguments"
     { params, body } = tail
 
+
     assert params.__class == Cell, "'fn's first argument has to be an expression"
-    param_symbols = for param in *params
+    param_symbols = for param in *params.children
       assert param.type == 'sym', "function parameter declaration has to be a symbol"
       param\quote scope, @registry
 
@@ -94,15 +99,16 @@ class op_invoke extends Action
     @op\destroy! if @op
 
     @head = head
-    assert @head.type == 'fndef', "cant op-invoke #{@head}"
+    assert @head.type == 'opdef', "cant op-invoke #{@head}"
     @op = @head\getc!!
   
     true
     
   eval: (scope, tail) =>
     args = [expr\eval scope, @registry for expr in *tail]
+    -- Const 'op', with @op
     with @op
-      \patch unpack args
+      \setup unpack args
 
 class fn_invoke extends Action
   -- @TODO:
@@ -127,10 +133,9 @@ class fn_invoke extends Action
     for i=1,#params
       name = params[i]\getc!
       argm = tail[i]
-      L\trace "EXPANDING ARG", argument
       fn_scope\set name, L\push argm\eval, scope, @registry
 
-    body\expand fn_scope, @registry
+    body\eval fn_scope, @registry
 
 class do_expr extends Action
   class DoWrapper
@@ -138,13 +143,15 @@ class do_expr extends Action
 
     update: (dt) =>
       for child in *@children
-        child\update dt
+        L\push child\update, dt
 
     get: => @children[#@children]\get!
     getc: => @children[#@children]\getc!
 
+    __tostring: => '<dowrapper>'
+
   eval: (scope, tail) =>
-    DoWrapper [expr\eval scope, @registry for expr in *tail]
+    UpdateChildren [(expr\eval scope, @registry) or Const.empty! for expr in *tail]
 
 {
   'op-invoke': op_invoke
diff --git a/lib/debug.moon b/lib/debug.moon
index 3b5df47..f87b06a 100644
--- a/lib/debug.moon
+++ b/lib/debug.moon
@@ -4,7 +4,8 @@ class out extends Op
   setup: (name, @chld) =>
     @name = name\getc!
 
-  update: =>
+  update: (dt) =>
+    @chld\update dt
     L\print "@name", @chld\get!
 
 {
diff --git a/lib/gui.moon b/lib/gui.moon
index 20d3bcc..37df233 100644
--- a/lib/gui.moon
+++ b/lib/gui.moon
@@ -9,7 +9,8 @@ class out extends Op
     @name = name\getc!
     @@instances[@name] = @
 
-  update: =>
+  update: (dt) =>
+    @chld\update dt
     @value = @chld\get!
 
   destroy: =>
diff --git a/lib/math.moon b/lib/math.moon
index 8e54bbd..0a514a6 100644
--- a/lib/math.moon
+++ b/lib/math.moon
@@ -6,26 +6,38 @@ class BinOp extends Op
     @children = { ... }
     assert #@children >= 2, "#{@} needs at least two parameters"
 
+  update: (dt) =>
+    for child in *@children
+      child\update dt
+
 class add extends BinOp
-  update: =>
+  update: (dt) =>
+    super\update dt
+
     @value = 0
     for child in *@children
       @value += child\get!
 
 class sub extends BinOp
-  update: =>
+  update: (dt) =>
+    super\update dt
+
     @value = @children[1]\get!
     for child in *@children[2,]
       @value -= child\get!
 
 class mul extends BinOp
-  update: =>
+  update: (dt) =>
+    super\update dt
+
     @value = 1
     for child in *@children
       @value *= child\get!
 
 class div extends BinOp
-  update: =>
+  update: (dt) =>
+    super\update dt
+
     @value = @children[1]\get!
     for child in *@children[2,]
       @value /= child\get!
@@ -37,8 +49,12 @@ func_op = (name, arity, func) ->
       if arity != '*'
         assert #@params == arity, "#{@} needs exactly #{arity} parameters"
 
-    update: =>
-      @value = func unpack [param\get! for param in *@params]
+    update: (dt) =>
+      params = for param in *@params
+        param\update dt
+        param\get!
+
+      @value = func unpack params
 
   k.__name = name
   k
diff --git a/lib/osc.moon b/lib/osc.moon
index a99aab0..02e3ade 100644
--- a/lib/osc.moon
+++ b/lib/osc.moon
@@ -10,7 +10,11 @@ class out extends Op
 
   setup: (@host, @port, @path, @value) =>
 
-  update: =>
+  update: (dt) =>
+    L\trace "updating #{@}"
+    for p in *{@host, @port, @path, @value}
+      L\push p\update, dt
+
     ip = dns.toip @host\get!
     port = @port\get!
     msg = pack @path\get!, @value\get!
diff --git a/lib/time.moon b/lib/time.moon
index 3252b9f..22457bb 100644
--- a/lib/time.moon
+++ b/lib/time.moon
@@ -11,6 +11,9 @@ class lfo extends Op
     L\trace "setup #{@}, freq=#{@freq}, wave=#{@wave}"
 
   update: (dt) =>
+    @freq\update dt
+    @wave\update dt
+
     @phase += dt * @freq\get!
     @value = switch @wave\get!
       when 'sin' then .5 + .5 * math.cos @phase * tau
@@ -26,6 +29,8 @@ class tick extends Op
   setup: (@freq) =>
 
   update: (dt) =>
+    @freq\update dt
+
     @phase += dt / @freq\get!
     @value = math.floor @phase
 
diff --git a/lib/util.moon b/lib/util.moon
index 7306fbc..5079b1b 100644
--- a/lib/util.moon
+++ b/lib/util.moon
@@ -4,7 +4,11 @@ class pick extends Op
   setup: (@i, ...) =>
     @choices = { ... }
 
-  update: =>
+  update: (dt) =>
+    @i\update dt
+    for choice in *@choices
+      choice\update dt
+
     i = 1 + (math.floor @i\get!) % #@choices
     @value = @choices[i]\get!
 
diff --git a/registry.moon b/registry.moon
index 3fb5533..70955cb 100644
--- a/registry.moon
+++ b/registry.moon
@@ -34,42 +34,17 @@ class Registry
 
     Const.num num
 
-  retag: (@root) =>
-    scope = Scope @root, @globals
-
-    @prev, @next, @tmp = @next, {}, {}
-
-    -- first pass (outin):
-    -- * expand macros (mutate scopes)
-    -- * resolve symbols
-    -- * :register exprs
-    for child in *@root
-      child\expand scope, @
-
-    -- destroy removed expr values
-    for tag, expr in pairs @prev
-      if not @next[i]
-        expr.value\destroy! if expr.value
-
-    -- upgrade tmp tags
-    for _, expr in pairs @tmp
-      tag = @gentag!
-      expr.tag = tag
-      @next[tag] = expr
-
-  patch: =>
-    -- third pass (inout):
-    -- * patch expressions (spawn/patch)
-    for child in *@root
-      child\patch @
+  eval: (ast) =>
+    scope = Scope ast, @globals
+
+    @root = ast\eval scope, @
+    @step!
 
   --
 
   update: (dt) =>
     return unless @root
 
-    -- runtime pass (inout)
-    for child in *@root
-      child\update dt
+    @root\update dt
 
 :Registry
diff --git a/spec/cell_spec.moon b/spec/cell_spec.moon
new file mode 100644
index 0000000..2b0860c
--- /dev/null
+++ b/spec/cell_spec.moon
@@ -0,0 +1,90 @@
+import Cell, RootCell, Const  from require 'base'
+import Scope from require 'scope'
+import Registry from require 'registry'
+import Logger from require 'logger'
+Logger.init 'silent'
+
+hello_world = Cell nil, { (Const.sym 'hello'), (Const.str 'world') }
+two_plus_two = Cell nil, { (Const.sym '+'), (Const.num 2), (Const.num 2) }
+
+
+describe 'Cell', ->
+  describe 'quoting', ->
+    it 'quotes children', ->
+      reg = mock register: =>
+      with hello_world\quote nil, reg
+        assert.is.equal Cell, .__class
+        assert.is.equal (Const.sym 'hello'), \head!
+        assert.is.same { Const.str 'world' }, \tail!
+
+      with two_plus_two\quote nil, reg
+        assert.is.equal Cell, .__class
+        assert.is.equal (Const.sym '+'), \head!
+        assert.is.same { (Const.num 2), (Const.num 2) }, \tail!
+
+    it 'registers recursively', ->
+      root = Cell nil, { (Const.sym 'out'), hello_world, two_plus_two }
+
+      reg = mock register: =>
+      root\quote nil, reg
+
+      (assert.spy reg.register).was.called_with reg, root, nil
+      (assert.spy reg.register).was.called_with reg, hello_world, nil
+      (assert.spy reg.register).was.called_with reg, two_plus_two, nil
+
+    it 'passes parsed tag', ->
+      root = Cell (Const.num 2), { (Const.sym 'out'), hello_world, two_plus_two }
+
+      reg = mock register: =>
+      root\quote nil, reg
+
+      (assert.spy reg.register).was.called_with reg, root, (Const.num 2)
+
+  describe 'evaluation', ->
+    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
+      action = registry.map[two_plus_two.tag.value]
+
+      assert.is.equal 'add', op.__class.__name
+      assert.is.equal 'op_invoke', action.__class.__name
+      registry\step!
+
+    it 'calls :setup() when parameters change', ->
+      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 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!
+
+    it 'calls :destroy() when opdef changes', ->
+      two_plus_two.children[1] = Const.sym 'sub'
+      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.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
+
+describe 'RootCell', ->
+  test 'head is always "do"', ->
+    cell = RootCell\parse {}
+    assert.is.equal (Const.sym 'do'), cell\head!
+
+    cell = RootCell nil, { hello_world, two_plus_two }
+    assert.is.equal (Const.sym 'do'), cell\head!
+
+  test 'tail is all children', ->
+    cell = RootCell\parse {}
+    assert.is.same {}, cell\tail!
+
+    cell = RootCell nil, { hello_world, two_plus_two }
+    assert.is.same { hello_world, two_plus_two },
+                   cell\tail!
diff --git a/spec/registry_spec.moon b/spec/registry_spec.moon
index fd33981..53a406c 100644
--- a/spec/registry_spec.moon
+++ b/spec/registry_spec.moon
@@ -2,9 +2,7 @@ import Registry from require 'registry'
 import Const from require 'base'
 
 mk = ->
-  mock {
-    destroy: =>
-  }
+  mock destroy: =>
 
 describe 'registry', ->
   registry = Registry!