new AST approach, testing

1 files changed, 168 insertions, 65 deletions

diff --git a/base.moon b/base.moon
index cdc80e6..b623b7b 100644
--- a/base.moon
+++ b/base.moon
@@ -1,76 +1,79 @@
-import is_object from require 'moon'
 import Scope from require 'scope'
 
+unpack or= table.unpack
+
+ancestor = (klass) ->
+  assert klass, "cant find the ancestor of nil"
+  while klass.__parent
+    klass = klass.__parent
+  klass
+
 class Op
+-- common
   new: (...) =>
     @setup ...
 
-  update: (dt) =>
-
   get: => @value
   getc: =>
     L\warn "stream #{@} cast to constant"
     @value
 
+-- interface
+  update: (dt) =>
+
   destroy: =>
 
+-- static
   __tostring: => "<op: #{@@__name}>"
   __inherited: (cls) => cls.__base.__tostring = @__tostring
 
   spawn: (Opdef, ...) ->
     Opdef ...
 
-class Macro
-  new: (@node) =>
-    -- print "creating Macro #{@@__name}", debug.traceback!
-
-  -- forwarded from ASTNode
-  -- `scope` is the parent scope.
-  -- should :expand or :expand_quoted all subexprs
-  -- should return `Const` of `forward` if it has a value
-  expand: (scope) =>
-    L\trace "expanding #{@}"
-    for child in *@node[2,]
-      L\push child\expand, @node.scope
-
-    nil
-
-  -- forwarded from ASTNode
-  -- should dispatch :patch on all :expanded subexprs
-  -- should setup @value if it is an Op
-  patch: (map) =>
-    L\trace "patching #{@}"
-    for child in *@node[2,]
-      L\push child\patch, map
-
-  -- forwarded from ASTNode
-  -- should dispatch :update on all :expanded subexprs and @node.value
-  update: (dt) =>
-    L\trace "updating #{@}"
-    for child in *@node[2,]
-      L\push child\update, dt
+class Action
+-- common
+  new: (head, @tag, @registry) =>
+    @patch head
+
+  register: =>
+    @tag = @registry\register @, @tag
 
-    @node.value\update dt if @node.value
+-- interface
+  -- * eval args
+  -- * perform scope effects
+  -- * patch nested exprs
+  -- * return runtime-tree value
+  eval: (scope, tail) => error "not implemented"
 
-  -- forwarded from ASTNode
-  -- should dispatch :destroy to all allocated Ops
+  -- free resources
   destroy: =>
-    L\trace "destroying #{@}"
-    @node.value\destroy! if @node.value
 
-  __tostring: => "<macro: #{@@__name}>"
-  __inherited: (cls) => cls.__base.__tostring = @__tostring
+  -- update this instance for :eavl() with new head
+  -- if :patch() returns false, this instance is :destroy'ed and recreated instead
+  -- must *not* return false when called after :new()
+  -- only considered if Action types match
+  patch: (head) =>
+    if head == @head
+      true
 
-class Forward
-  new: (@node) =>
+    @head = head
 
-  get: => (assert @node.value, "node never patched! #{@}")\get!
-  getc: => (assert @node.value, "node never patched! #{@}")\getc!
+-- static
+  @get_or_create: (ActionType, head, tag, registry) ->
+    last = tag and registry\find tag
+    compatible = last and
+                 last.__class == ActionType and
+                 last\patch head
 
-  update: =>
-  destroy: =>
+    if not compatible
+      last\destroy! if last
+      compatible = ActionType head, tag, registry
 
-  __tostring: => "<fwd: #{@node}>"
+    with compatible
+      \register!
+
+  __tostring: => "<action: #{@@__name}>"
+  __inherited: (cls) => cls.__base.__tostring = @__tostring
 
 class Const
   types = {
@@ -80,27 +83,60 @@ class Const
     num: true
     op: true
     opdef: true
-    macrodef: true
+    builtin: true
   }
-  new: (@type, @value) =>
+
+-- Value interface
+  new: (@type, @value, @raw) =>
     assert types[@type], "invalid Const type: #{@type}"
 
-  get: => @value
-  getc: => @value
+  get: (type) =>
+    assert not type or type == @type, "#{@} is not a #{type}"
+    @value
 
-  update: =>
-  destroy: =>
+  getc: (type) =>
+    assert not type or type == @type, "#{@} is not a #{type}"
+    @value
+
+-- AST interface
+  eval: (scope) =>
+    switch @type
+      when 'num', 'str'
+        @
+      when 'sym'
+        assert (scope\get @value), "undefined reference to symbol '#{@raw}'"
+      else
+        error "cannot evaluate #{@}"
 
+  quote: => @
+
+  stringify: => @raw
+
+-- static
   __tostring: =>
     value = if @type\match 'def$' then @value.__name else @value
     "<#{@type}: #{value}>"
 
-  ancestor = (klass) ->
-    assert klass, "cant find the ancestor of nil"
-    while klass.__parent
-      klass = klass.__parent
-    klass
-  wrap: (val, name='(unknown)') ->
+  __eq: (other) =>
+    other.type == @type and other.value == @value
+
+  unescape = (str) ->
+    str = str\gsub '\\"', '"'
+    str = str\gsub "\\'", "'"
+    str = str\gsub "\\\\", "\\"
+    str
+
+  @parse: (type, sep) =>
+    switch type
+      when 'num' then (match) -> @ 'num', (tonumber match), match
+      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
+
+  @wrap: (val, name='(unknown)') ->
     typ = switch type val
       when 'number' then 'num'
       when 'string' then 'str'
@@ -109,18 +145,18 @@ class Const
           -- a class
           switch ancestor val
             when Op then 'opdef'
-            when Macro then 'macrodef'
+            when Action then 'builtin'
             else
               error "#{name}: cannot wrap class '#{val.__name}'"
-        elseif klass = val.__class
+        elseif val.__class
           -- an instance
-          switch ancestor klass
+          switch ancestor val.__class
             when Op then 'op'
             when Scope then 'scope'
-            when Const, Forward
+            when Const
               return val
             else
-              error "#{name}: cannot wrap '#{klass.__name}' instance"
+              error "#{name}: cannot wrap '#{val.__class.__name}' instance"
         else
           -- plain table
           return Const 'scope', Scope.from_table val
@@ -129,9 +165,76 @@ class Const
 
     Const typ, val
 
+local builtin
+class Cell
+-- common
+  new: (@tag, @children, @white) =>
+    builtin or= require 'lib.builtin'
+
+  head: => @children[1]
+  tail: => [c for c in *@children[2,]]
+
+-- AST interface
+  eval: (scope, registry) =>
+    head = @head!\eval scope, registry
+    Action = switch head.type
+      when 'opdef'
+        -- scope\get 'op-invoke'
+        builtin['op-invoke']
+      when 'fndef'
+        -- scope\get 'fn-invoke'
+        builtin['fn-invoke']
+      when 'builtin'
+        head\getc!
+      else
+        error "cannot evaluate expr with head #{head}"
+
+    action = Action\get_or_create head, tag, registry
+    action\eval scope, @tail!
+
+  quote: (scope, registry) =>
+    tag = registry\register @, @tag
+    children = [child\quote scope, registry for child in *@children]
+    Cell tag, children, @white, @style
+
+  stringify: (inner=false) =>
+    buf = ''
+    buf ..= @white[0]
+    for i, child in ipairs @children
+      buf ..= child\stringify!
+      buf ..= @white[i]
+
+    return buf if inner
+
+    tag = if @tag then "[#{@tag\stringify!}]" else ''
+    '(' .. tag .. buf .. ')'
+
+-- static
+  parse_args = (tag, parts) ->
+    if not parts
+      parts, tag = tag, nil
+
+    children, white = {}, { [0]: parts[1] }
+
+    for i = 2,#parts,2
+      children[i/2] = parts[i]
+      white[i/2] = parts[i+1]
+
+    tag, children, white
+  @parse: (...) =>
+    tag, children, white = parse_args ...
+    @ tag, children, white
+
+class RootCell extends Cell
+  head: => Const.sym 'do'
+  tail: => @children
+
+  stringify: =>
+    super\stringify true
+
 {
   :Op
-  :Macro
-  :Forward
   :Const
+  :Action
+  :Cell, :RootCell
 }