add Result spec

Close #10

10 files changed, 278 insertions, 39 deletions

diff --git a/core/cell.moon b/core/cell.moon
index 3567a6d..2109ade 100644
--- a/core/cell.moon
+++ b/core/cell.moon
@@ -164,7 +164,7 @@ class Cell
   -- @tparam table parts
   -- @treturn Cell
   @parse_root: (...) ->
-    tag, children, white = parse_args (Tag\parse '0'), ...
+    tag, children, white = parse_args (Tag.parse '0'), ...
     RootCell tag, children, white
 
 -- @type RootCell
diff --git a/core/init.moon b/core/init.moon
index c4e8ffd..a5e892d 100644
--- a/core/init.moon
+++ b/core/init.moon
@@ -17,7 +17,7 @@ L or= setmetatable {}, __index: => ->
 import Value from require 'core.value'
 import Result from require 'core.result'
 import Scope from require 'core.scope'
-import Registry from require 'core.registry'
+import Registry, SimpleRegistry from require 'core.registry'
 import Tag from require 'core.tag'
 
 import Cell from require 'core.cell'
@@ -44,7 +44,7 @@ globals = Scope.from_table require 'core.builtin'
   :Cell, :RootCell
   :Scope
 
-  :Registry, :Tag
+  :Registry, :SimpleRegistry, :Tag
 
   :globals
   parse: program\match
diff --git a/core/parsing.moon b/core/parsing.moon
index 52dde27..b96f173 100644
--- a/core/parsing.moon
+++ b/core/parsing.moon
@@ -35,7 +35,7 @@ atom = num + sym + str
 expr = (V 'cell') + atom
 explist = Ct mspace * ((V 'expr') * (space * (V 'expr'))^0 * mspace)^-1
 
-tag = (P '[') * (digit^1 / Tag\parse) * (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
index 7c785a6..374337a 100644
--- a/core/registry.moon
+++ b/core/registry.moon
@@ -71,11 +71,11 @@ class Registry
 
   grab: =>
     assert not @prev, "already have a previous registry? #{@prev}"
-    @prev, @@active_registry = @@active_registry, @
+    @prev, Registry.active_registry = Registry.active_registry, @
 
   release: =>
-    assert @ == @@active_registry, "not the active registry!"
-    @@active_registry, @prev = @prev, nil
+    assert @ == Registry.active_registry, "not the active registry!"
+    Registry.active_registry, @prev = @prev, nil
 
 --- static functions
 -- @section static
@@ -100,6 +100,8 @@ class SimpleRegistry extends Registry
   new: =>
     @cnt = 1
 
+  tick: 0
+
   init: (tag, expr) =>
     tag\set @cnt
     @cnt += 1
@@ -107,6 +109,11 @@ class SimpleRegistry extends Registry
   last: (index) =>
   replace: (index, expr) =>
 
+  wrap: (fn) => (...) ->
+    @grab!
+    with fn ...
+      @release!
+
 {
   :Registry
   :SimpleRegistry
diff --git a/core/tag.moon b/core/tag.moon
index 5819aae..a3ce1ae 100644
--- a/core/tag.moon
+++ b/core/tag.moon
@@ -97,7 +97,7 @@ class Tag
   --
   -- @tparam string num the number-string
   -- @treturn Tag
-  @parse: (num) => @ tonumber num
+  @parse: (num) -> Tag tonumber num
 
 class ClonedTag extends Tag
   new: (@original, @parent) =>
diff --git a/core/value.moon b/core/value.moon
index 1e528ed..2e93e70 100644
--- a/core/value.moon
+++ b/core/value.moon
@@ -130,7 +130,6 @@ class Value
   -- @tparam string raw the raw string that resulted in this value. Used by `parsing`.
   new: (@type, @value, @raw) =>
 
-
   unescape = (str) -> str\gsub '\\([\'"\\])', '%1'
   --- create a capture-function (for parsing with Lpeg).
   --
diff --git a/spec/core/cell_spec.moon b/spec/core/cell_spec.moon
index 8b6d68b..710b252 100644
--- a/spec/core/cell_spec.moon
+++ b/spec/core/cell_spec.moon
@@ -1,34 +1,74 @@
 import Cell, RootCell from require 'core.cell'
-import Value, Scope, Registry, globals from require 'core'
+import Value, Scope, Tag, SimpleRegistry, globals from require 'core'
 import Logger from require 'logger'
 Logger.init 'silent'
 
-hello_world = Cell nil, { (Value.sym 'hello'), (Value.str 'world') }
-two_plus_two = Cell nil, { (Value.sym '+'), (Value.num 2), (Value.num 2) }
+hello_world = Cell.parse (Tag.parse '2'), { '', (Value.sym 'hello'), ' ', (Value.str 'world'), '' }
+two_plus_two = Cell.parse (Tag.parse '3'), { '', (Value.sym '+'), ' ', (Value.num 2), ' ', (Value.num 2), '' }
+
+reg = SimpleRegistry!
+setup -> reg\grab!
+teardown -> reg\release!
 
 describe 'Cell', ->
-  it 'supports quoting', ->
+  describe 'when quoted', ->
     with hello_world\quote!
-      assert.is.equal Cell, .__class
-      assert.is.equal (Value.sym 'hello'), \head!
-      assert.is.same { Value.str 'world' }, \tail!
+      it 'stays equal', ->
+        assert.is.equal Cell, .__class
+        assert.is.equal (Value.sym 'hello'), \head!
+        assert.is.same { Value.str 'world' }, \tail!
+
+      it 'shares the tag', ->
+        assert.is.equal hello_world.tag, .tag
 
     with two_plus_two\quote!
-      assert.is.equal Cell, .__class
-      assert.is.equal (Value.sym '+'), \head!
-      assert.is.same { (Value.num 2), (Value.num 2) }, \tail!
+      it 'stays equal', ->
+        assert.is.equal Cell, .__class
+        assert.is.equal (Value.sym '+'), \head!
+        assert.is.same { (Value.num 2), (Value.num 2) }, \tail!
+
+      it 'shares the tag', ->
+        assert.is.equal two_plus_two.tag, .tag
+
+  describe 'when cloned', ->
+    parent = Tag.blank '1'
+    with hello_world\clone parent
+      it 'keeps children', ->
+        assert.is.equal Cell, .__class
+        assert.is.equal (Value.sym 'hello'), \head!
+        assert.is.same { Value.str 'world' }, \tail!
 
+      it 'clones the tag', ->
+        assert.is.equal hello_world.tag, .tag.original
+        assert.is.equal parent, .tag.parent
+
+  describe 'when evaluated', ->
+    it 'errors when empty', ->
+      cell = Cell.parse {''}
+      assert.has.error -> cell\eval globals
+
+    it 'evaluates its head', ->
+      head = Value.sym 'trace'
+      cell = Cell.parse { '', head, ' ', (Value.sym 'true'), '' }
+
+      s = spy.on head, 'eval'
+      cell\eval globals
+      assert.spy(s).was_called_with (match.is_ref head), (match.is_ref globals)
 
 describe 'RootCell', ->
+  test 'tag is always [0]', ->
+    cell = Cell.parse_root {}
+    assert.is.equal '[0]', cell.tag\stringify!
+
   test 'head is always "do"', ->
-    cell = Cell\parse_root {}
+    cell = Cell.parse_root {}
     assert.is.equal (Value.sym 'do'), cell\head!
 
     cell = RootCell nil, { hello_world, two_plus_two }
     assert.is.equal (Value.sym 'do'), cell\head!
 
   test 'tail is all children', ->
-    cell = Cell\parse_root {}
+    cell = Cell.parse_root {}
     assert.is.same {}, cell\tail!
 
     cell = RootCell nil, { hello_world, two_plus_two }
diff --git a/spec/core/result_spec.moon b/spec/core/result_spec.moon
new file mode 100644
index 0000000..cc7cd71
--- /dev/null
+++ b/spec/core/result_spec.moon
@@ -0,0 +1,185 @@
+import Result, Value, Scope, SimpleRegistry from require 'core'
+import Input, Op, IO from require 'core.base'
+import Logger from require 'logger'
+Logger.init 'silent'
+
+op_with_inputs = (inputs) ->
+  with Op!
+    \setup inputs if inputs
+
+result_with_sideinput = (value, input) ->
+  with Result :value
+    .side_inputs = { [value]: input }
+
+reg = SimpleRegistry!
+setup -> reg\grab!
+teardown -> reg\release!
+
+class DirtyIO extends IO
+  tick: =>
+  dirty: => true
+
+describe 'Result', ->
+  it 'wraps value, children', ->
+    value = Value.num 3
+
+    a = Result!
+    b = Result!
+    children = { a, b }
+
+    result = Result :value, :children
+
+    assert.is.equal value, result.value
+    assert.is.same children, result.children
+
+  it ':type gets type and assets value', ->
+    result = Result value: Value.num 2
+    assert.is.equal 'num', result\type!
+
+    result = Result!
+    assert.has.error -> result\type!
+
+  it ':is_const', ->
+    value = Value.num 2
+    pure = Result :value
+    impure = result_with_sideinput value, {}
+
+    assert.is.true pure\is_const!
+    assert.is.false impure\is_const!
+
+    assert.is.equal value, pure\const!
+    assert.has.error -> impure\const!
+    assert.has.error (-> impure\const 'test'), 'test'
+
+  it ':make_ref', ->
+    value = Value.num 2
+    input = Input.value value
+    op = op_with_inputs { input }
+    thick = Result :value, :op, children: { Result!, Result! }
+    ref = thick\make_ref!
+
+    assert ref
+    assert.is.equal thick.value, ref.value
+    assert.is.same thick.side_inputs, ref.side_inputs
+    assert.is.same {}, ref.children
+    assert.is.nil ref.op
+
+  it 'lifts up inputs from op', ->
+    event = Value 'bang', false
+    event_input = Input.event event
+
+    value = Value 'num', 4
+    value_input = Input.value value
+
+    op = op_with_inputs { event_input, value_input }
+    result = Result op: op, :value
+
+    assert.is.equal op, result.op
+    assert.is.same { [event]: event_input, [value]: value_input },
+                   result.side_inputs
+
+  it 'does not lift up op inputs that are also child values', ->
+    event = Value 'bang', false
+    event_input = Input.event event
+
+    value = Value 'num', 4
+    value_input = Input.value value
+
+    op = op_with_inputs { event_input, value_input }
+    result = Result op: op, :value, children: { Result :value }
+
+    assert.is.same { [event]: event_input }, result.side_inputs
+
+  it 'lifts up side_inputs from children', ->
+    event_value = Value 'bang', false
+    event_input = Input.event event_value
+    event = Result op: op_with_inputs { event_input }
+    assert.is.same { [event_value]: event_input }, event.side_inputs
+
+    value_value = Value 'num', 4
+    value_input = Input.value value_value
+    value = Result op: op_with_inputs { value_input }
+    assert.is.same { [value_value]: value_input }, value.side_inputs
+
+    result = Result children: { event, value }
+    assert.is.same { [event_value]: event_input, [value_value]: value_input },
+                   result.side_inputs
+
+  describe ':tick', ->
+    local a_value, a_child, a_input
+    local b_value, b_child, b_input
+    before_each ->
+      a_value = Value 'num'
+      a_input = Input.event a_value
+      a_child = result_with_sideinput a_value, a_input
+
+      b_value = Value 'num'
+      b_input = Input.event b_value
+      b_child = result_with_sideinput b_value, b_input
+
+    it 'updates children when a side_input is dirty', ->
+      a_value\set 1
+      assert.is.true a_input\dirty!
+      assert.is.false b_input\dirty!
+
+      a = spy.on a_child, 'tick'
+      b = spy.on b_child, 'tick'
+
+      result = Result children: { a_child, b_child }
+      result\tick!
+
+      assert.spy(a).was_called_with match.ref a_child
+      assert.spy(b).was_called_with match.ref b_child
+
+    it 'early-outs when no side_inputs are dirty', ->
+      assert.is.false a_input\dirty!
+      assert.is.false b_input\dirty!
+
+      a = spy.on a_child, 'tick'
+      b = spy.on b_child, 'tick'
+
+      result = Result children: { a_child, b_child }
+      result\tick!
+
+      assert.spy(a).was_not_called!
+      assert.spy(b).was_not_called!
+
+    it 'updates op when any op-inputs are dirty', ->
+      a_value\set 1
+      assert.is.true a_input\dirty!
+      assert.is.false b_input\dirty!
+
+      op = op_with_inputs a: Input.event a_value
+      s = spy.on op, 'tick'
+
+      result = Result :op, children: { a_child, b_child }
+      result\tick!
+
+      assert.spy(s).was_called_with match.ref op
+
+    it 'early-outs when no op-inputs are dirty', ->
+      a_value\set 1
+      assert.is.true a_input\dirty!
+      assert.is.false b_input\dirty!
+
+      op = op_with_inputs { Input.event b_value }
+      s = spy.on op, 'tick'
+
+      result = Result :op, children: { a_child, b_child }
+      result\tick!
+
+      assert.spy(s).was_not_called!
+
+  describe ':tick_io', ->
+    it 'ticks IOs referenced in side_inputs', ->
+      io = DirtyIO!
+      value = Value 'an_io', io
+      input = Input.io value
+      op = op_with_inputs { input }
+      result = Result :op
+
+      s = spy.on io, 'tick'
+      assert.is.same { [value]: input }, result.side_inputs
+      result\tick_io!
+
+      assert.spy(s).was_called_with match.ref io
diff --git a/spec/core/tag_spec.moon b/spec/core/tag_spec.moon
index 7855fd6..a4491b0 100644
--- a/spec/core/tag_spec.moon
+++ b/spec/core/tag_spec.moon
@@ -16,14 +16,14 @@ do_reg = (fn) ->
 describe 'Tag', ->
   describe 'should be constructable', ->
     it 'by parsing', ->
-      tag = Tag\parse '2'
+      tag = Tag.parse '2'
       assert tag
       assert.is.equal 2, tag.value
       assert.is.equal '[2]', tag\stringify!
       assert.is.equal '2', tostring tag
 
     it 'as blank Tags', ->
-      tag = Tag\blank!
+      tag = Tag.blank!
       assert tag
       assert.is.nil tag.value
       assert.is.equal '', tag\stringify!
@@ -37,49 +37,49 @@ describe 'Tag', ->
       assert.has.error tag\stringify
 
     it 'from parsed tags', with_reg ->
-      parent = Tag\parse '1'
-      original = Tag\parse '2'
+      parent = Tag.parse '1'
+      original = Tag.parse '2'
       tag = original\clone parent
       do_asserts tag, '1.2'
 
     it 'but not from blank tags', with_reg ->
-      parent = Tag\parse '1'
-      original = Tag\blank!
+      parent = Tag.parse '1'
+      original = Tag.blank!
       tag = original\clone parent
       do_asserts tag, '1.?'
 
     it 'with blank parent', with_reg ->
-      parent = Tag\blank!
-      original = Tag\parse '2'
+      parent = Tag.blank!
+      original = Tag.parse '2'
       tag = original\clone parent
       do_asserts tag, '?.2'
 
     it 'completely blank', with_reg ->
-      parent = Tag\blank!
-      original = Tag\blank!
+      parent = Tag.blank!
+      original = Tag.blank!
       tag = original\clone parent
       do_asserts tag, '?.?'
 
   describe 'should be set-able', ->
     it 'only if blank', with_reg ->
-      tag = Tag\parse '42'
+      tag = Tag.parse '42'
       assert.has.error -> tag\set 43
 
-      clone = tag\clone Tag\parse '3'
+      clone = tag\clone Tag.parse '3'
       assert.has.error -> clone\set 42
 
-      clone = tag\clone Tag\blank!
+      clone = tag\clone Tag.blank!
       assert.has.error -> clone\set 42
 
     it 'and stores the value', with_reg ->
-      blank = Tag\blank!
+      blank = Tag.blank!
       blank\set 12
 
       assert.is.equal blank.value, 12
 
     it 'sets the original if cloned', with_reg ->
-      original = Tag\blank!
-      parent = Tag\parse '7'
+      original = Tag.blank!
+      parent = Tag.parse '7'
 
       o_set = spy.on original, 'set'
       p_set = spy.on parent, 'set'
@@ -93,8 +93,8 @@ describe 'Tag', ->
       assert.is.equal original.value, 11
  
     it 'requires the parent to be registered if cloned', with_reg ->
-      original = Tag\blank!
-      parent = Tag\blank!
+      original = Tag.blank!
+      parent = Tag.blank!
 
       clone = original\clone parent
       assert.has.error -> clone\set 11
diff --git a/spec/core/value_spec.moon b/spec/core/value_spec.moon
index 4e56c31..2436371 100644
--- a/spec/core/value_spec.moon
+++ b/spec/core/value_spec.moon
@@ -122,3 +122,11 @@ describe 'Value', ->
       assert_noop Value.num 2
       assert_noop Value.str 'hello'
       assert_noop Value.sym 'world'
+
+  describe 'clones literals', ->
+    test 'as themselves', ->
+      assert_noop = (val) -> assert.is.equal val, val\clone!
+
+      assert_noop Value.num 2
+      assert_noop Value.str 'hello'
+      assert_noop Value.sym 'world'