50% of functions

7 files changed, 249 insertions, 66 deletions

diff --git a/ast.moon b/ast.moon
index a1e10ad..336f463 100644
--- a/ast.moon
+++ b/ast.moon
@@ -1,4 +1,4 @@
-import Const from require 'base'
+import Const, Forward from require 'base'
 import Scope from require 'scope'
 unpack or= table.unpack
 
@@ -18,7 +18,13 @@ class ASTNode
 
   -- second pass (inout):
   -- * setup expressions (spawn/patch)
-  patch: (prev) =>
+  patch: (map) =>
+
+  -- runtime pass (inout)
+  update: (dt) =>
+
+  -- return a copy
+  clone: (tag_prefix) =>
 
 class Atom extends ASTNode
   type: 'Atom'
@@ -43,6 +49,17 @@ class Atom extends ASTNode
 
     @value
 
+  expand_quoted: =>
+    switch @atom_type
+      when 'num'
+        Const 'num', tonumber @raw
+      when 'strq', 'strd'
+        Const 'str', unescape @raw
+      when 'sym'
+        Const 'sym', @raw
+      else
+        error "unknown atom type: '#{@atom_type}'"
+
   _walk: => coroutine.yield @type, @
 
   stringify: =>
@@ -56,6 +73,9 @@ class Atom extends ASTNode
       else
         error "unknown atom type: '#{@atom_type}'"
 
+  -- atoms are immutable
+  clone: (tag_prefix) => Atom @raw, @atom_type
+
   @make_num:  (match) -> Atom match, 'num'
   @make_sym:  (match) -> Atom match, 'sym'
   @make_strd: (match) -> Atom match, 'strd'
@@ -68,21 +88,26 @@ class Xpr extends ASTNode
   type: 'Xpr'
 
   -- either:
+  -- * style, tag, parts, white
   -- * style, tag, parts
   -- * style, parts
-  new: (@style, tag, parts) =>
-    if not parts
-      parts = tag
-      tag = nil
+  new: (@style, tag, parts, white) =>
+    if white
+      for i, part in ipairs parts
+        @[i] = part
+    else
+      if not parts
+        parts = tag
+        tag = nil
 
-    @tag = tag
+      @white = {}
+      @white[0] = parts[1]
 
-    @white = {}
-    @white[0] = parts[1]
+      for i = 2,#parts,2
+        @[i/2] = parts[i]
+        @white[i/2] = parts[i+1]
 
-    for i = 2,#parts,2
-      @[i/2] = parts[i]
-      @white[i/2] = parts[i+1]
+    @tag = tag
 
   expand: (scope) =>
     @[1]\expand scope
@@ -99,29 +124,47 @@ class Xpr extends ASTNode
         for child in *@[2,]
           child\expand @scope
 
-    @value
+    @value or Forward @
 
-  patch: (prev) =>
-    head = @head!
+  patch: (map) =>
+    L\trace "patching #{@deep_tostring!}"
+    prev = map[@tag]
+
+    if @macro
+      -- forward for macros
+      if prev and prev.macro then prev.macro\destroy!
+      elseif prev and prev.value then prev.value\destroy!
+      @macro\patch map
+      return
 
     compatible = prev and
                  prev.value and
                  prev\head! == head
 
-    if @macro
-      -- forward for macros
-      prev.value\destroy! if prev and prev.value
-      @macro\patch!
-    elseif compatible
+    for child in *@
+      L\push child\patch, map
+    head = @head!
+
+    if compatible
       -- continued existance
       @value = prev.value
       @value\setup @tail!
+      L\trace "continued with", @tail!
     else
       -- destroy + recreate
       prev.value\destroy! if prev and prev.value
       @value = head\getc!\spawn @tail!
+      L\trace "recreated with", @tail!
 
   update: (dt) =>
+    if @macro
+      @macro\update dt
+      return
+
+    L\trace "updating #{@}"
+    for child in *@[2,]
+      L\push child\update, dt
+
     @value\update dt
 
   head: => @[1].value
@@ -155,9 +198,21 @@ class Xpr extends ASTNode
       else
         error "unknown sexpr style: '#{@style}'"
 
+  clone: (tag_prefix) =>
+    parts = [part\clone tag_prefix for part in *@]
+    Xpr @style, "#{tag_prefix}.#{@tag}", parts, @white
+
   make_sexpr: (...) -> Xpr '(', ...
   make_nexpr: (...) -> Xpr 'naked', ...
 
+  deep_tostring: =>
+    buf = "("
+    buf ..= "[#{@tag}]" if @tag
+    buf ..= "#{@[1].raw}"
+    buf ..= " #{table.concat [tostring child for child in *@], ' '}" if #@ > 1
+    buf ..= ")"
+    buf
+
   __tostring: =>
     if @style == 'naked'
       return 'ROOT'
diff --git a/base.moon b/base.moon
index 0404e3d..cdc80e6 100644
--- a/base.moon
+++ b/base.moon
@@ -25,11 +25,38 @@ class Macro
     -- 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
-  -- note: if prev_value is passed, it has to be :destroy'ed or returned
-  patch: (prev_value) => prev_value
+  -- 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
+
+    @node.value\update dt if @node.value
+
+  -- forwarded from ASTNode
+  -- should dispatch :destroy to all allocated Ops
+  destroy: =>
+    L\trace "destroying #{@}"
+    @node.value\destroy! if @node.value
 
   __tostring: => "<macro: #{@@__name}>"
   __inherited: (cls) => cls.__base.__tostring = @__tostring
@@ -37,8 +64,13 @@ class Macro
 class Forward
   new: (@node) =>
 
-  get: => (assert @node.value, "node never patched!")\get!
-  getc: => (assert @node.value, "node never patched!")\getc!
+  get: => (assert @node.value, "node never patched! #{@}")\get!
+  getc: => (assert @node.value, "node never patched! #{@}")\getc!
+
+  update: =>
+  destroy: =>
+
+  __tostring: => "<fwd: #{@node}>"
 
 class Const
   types = {
@@ -56,6 +88,7 @@ class Const
   get: => @value
   getc: => @value
 
+  update: =>
   destroy: =>
 
   __tostring: =>
diff --git a/lib/builtin.moon b/lib/builtin.moon
index 8615afa..440e553 100644
--- a/lib/builtin.moon
+++ b/lib/builtin.moon
@@ -1,34 +1,56 @@
 import Macro, Const, Forward from require 'base'
 import Scope from require 'scope'
 
+-- (def sym1 val-expr1
+--     [sym2 val-expr2]...)
+--
+-- declare symbols in parent scope
+--
+-- if val-expr is a expand-time constant, defines a `Const`,
+-- otherwise places a `Forward` for the expr
 class def extends Macro
   expand: (scope) =>
+    L\trace "expanding #{@}"
     assert #@node > 2, "'def' requires at least 3 arguments"
     assert #@node % 2 == 1, "'def' requires an even number of arguments"
 
-    L\trace @
     L\push ->
       for i=2,#@node,2
-        name, val = @node[i], @node[i+1]
+        name, val_expr = @node[i], @node[i+1]
         assert name.atom_type == 'sym', "'def's argument ##{i} has to be a symbol"
-        val\expand @node.scope
-
-        if val.value
-          -- expand-time constant
-          scope\set name.raw, val.value
-        else
-          -- patch-time expression
-          scope\set name.raw, Forward val
+        name = name\expand_quoted!\getc!
+
+        scope\set name, val_expr\expand @node.scope
+
+        -- @TODO: expand to Forward in Xpr:expand
+        -- if val = val_expr\expand @node.scope
+        --   -- expand-time constant
+        --   scope\set name, val
+        -- else
+        --   -- patch-time expression
+        --   scope\set name, Forward val_expr
     nil
 
+  patch: (map) =>
+    L\trace "patching #{@}"
+    for child in *@node[3,,2]
+      L\push child\patch, map
+
+  update: (dt) =>
+    L\trace "updating #{@}"
+    for child in *@node[3,,2]
+      L\push child\update, dt
+
+-- (require name-str)
+--
+-- require a lua module and return its `Scope`
+-- name-str has to be an expand-time constant
 class _require extends Macro
   expand: (scope) =>
+    L\trace "expanding #{@}"
     assert #@node == 2, "'require' takes only one parameter"
-
-    L\trace @
-    L\push ->
-      for child in *@node[2,]
-        child\expand @node.scope
+    for child in *@node[2,]
+      L\push child\expand, @node.scope
 
     name = @node\tail!
     assert name.type == 'str', "'require' only works on strings"
@@ -37,20 +59,91 @@ class _require extends Macro
     scope = Scope.from_table require "lib.#{name\getc!}"
     Const 'scope', scope
 
+-- (use scope1 [scope2]...)
+--
+-- merge scopes into parent scope
+-- scopes have to be expand-time constants
 class use extends Macro
   expand: (scope) =>
-    L\trace @
-    L\push ->
-      for child in *@node[2,]
-        value = child\expand @node.scope
-        L\trace @, "merging #{value} into #{scope}"
-        assert value.type == 'scope', "'use' only works on scopes"
-        scope\use value\getc!
+    L\trace "expanding #{@}"
+    for child in *@node[2,]
+      value = L\push child\expand, @node.scope
+      L\trace @, "merging #{value} into #{scope}"
+      assert value.type == 'scope', "'use' only works on scopes"
+      scope\use value\getc!
 
     nil
 
+-- ((fn ...) arg-expr1 [arg-expr2]...)
+--
+-- invoke a function
+class FunctionInvocation extends Macro
+  new: (@node, @params, @body_tpl) =>
+    super @node
+
+  expand: (scope) =>
+    L\trace "expanding #{@}"
+    assert (#@params + 1) == #@node, "argument count mismatch in #{@node[1]}"
+
+    for i=1,#@params
+      param = @params[i]\getc!
+      argument = @node[i+1]
+      L\trace "EXPANDING ARG", argument
+      @node.scope\set param, L\push argument\expand, scope
+
+    @body = @body_tpl\clone @node.tag
+    val = @body\expand @node.scope
+    val
+
+  patch: (map) =>
+    L\trace "patching #{@}:"
+    for child in *@node[2,]
+      L\push child\patch, map
+
+    @body\patch map
+
+  update: (dt) =>
+    L\trace "updating #{@}:"
+    @body\update dt
+
+    for child in *@node[2,]
+      L\push child\update, dt
+
+  destroy: (dt) =>
+    L\trace "destroying #{@}"
+    @body.value\destroy! if @body.value
+
+  mt = { __call: (...) => @call ... }
+  with_def: (params, body) ->
+    call = (node) => FunctionInvocation node, params, body
+    setmetatable { :call, __name: 'Invocation' }, mt
+
+-- (fn (p1 [p2]...) body-expr)
+--
+-- declare a function
+--
+-- pX are symbols that will resolve to a 'Forward' in the body
+class fn extends Macro
+  expand: (scope) =>
+    L\trace "expanding #{@}"
+    assert #@node == 3, "'fn' takes exactly three arguments"
+    params, body = @node[2], @node[3]
+
+    assert params.type == 'Xpr', "'fn's first argument has to be an expression"
+    param_symbols = for param in *params
+      assert param.atom_type == 'sym', "function parameter declaration has to be a symbol"
+      param\expand_quoted!
+
+    Const 'macrodef', FunctionInvocation.with_def param_symbols, body
+
+  patch: (map) =>
+    L\trace "patching #{@}"
+
+  update: (dt) =>
+
 {
   :def
   require: _require
   :use
+  :fn
 }
diff --git a/lib/time.moon b/lib/time.moon
index 4fe5d7c..3252b9f 100644
--- a/lib/time.moon
+++ b/lib/time.moon
@@ -6,9 +6,9 @@ class lfo extends Op
     super ...
     @phase = 0
 
-
   default_wave = Const 'str', 'sin'
   setup: (@freq, @wave=default_wave) =>
+    L\trace "setup #{@}, freq=#{@freq}, wave=#{@wave}"
 
   update: (dt) =>
     @phase += dt * @freq\get!
diff --git a/logger.moon b/logger.moon
index e660289..c1ac02d 100644
--- a/logger.moon
+++ b/logger.moon
@@ -19,9 +19,17 @@ class Logger
     for name, level in pairs levels
       @[name] = (first, ...) =>
         return unless @level <= level
+
         where = debug.traceback nil, 2
-        where = where\match '^.*\n%s+([%w:/%.]+): '
-        print "[#{where}]#{@prefix}#{first}", ...
+        line = where\match '^.-\n%s+([%w:/%.]+): '
+        line = line\match '[%./]*(.*)'
+        line ..= string.rep ' ', 20-#line
+
+        if level == levels.error or @level == levels.debug
+          print "[#{line}]#{@prefix}#{first}", ...
+          print where
+        else
+          print "[#{line}]#{@prefix}#{first}", ...
 
     if level == levels.print
       @push = (fn, ...) => fn ...
diff --git a/registry.moon b/registry.moon
index c9682fa..58a7f82 100644
--- a/registry.moon
+++ b/registry.moon
@@ -48,23 +48,16 @@ class Registry
   patch: =>
     -- third pass (inout):
     -- * patch expressions (spawn/patch)
-    for typ, node in @root\walk 'inout', false
-      L\trace "patching #{node}"
-      node\patch @map[node.tag]
+    for child in *@root
+      child\patch @map
 
   --
 
-  tb = (msg) -> debug.traceback msg, 2
   update: (dt) =>
-    for typ, sexpr in @root\walk 'inout', false
-      continue unless typ == 'Xpr'
+    return unless @root
 
-      head = sexpr\head!
-      continue unless head and head.type == 'opdef'
-      continue unless sexpr.value
-
-      ok, err = xpcall sexpr.value.update, tb, sexpr.value, dt
-      if not ok
-        L\error "while updating #{sexpr}: #{err}"
+    -- runtime pass (inout)
+    for child in *@root
+      child\update dt
 
 :Registry
diff --git a/test.alv b/test.alv
index 01988fd..9e7ad1f 100644
--- a/test.alv
+++ b/test.alv
@@ -2,8 +2,9 @@
 ([4]use ([3]require 'osc'))
 ([6]use ([5]require 'time'))
 
-([8]def my-lfo ([7]lfo 0.2 'sin'))
+([17]def sin-lfo ([13]fn ([11]f)
+                 ([12]lfo f 'sin')))
 
-([8]out '127.0.0.1' 9000 '/param/radius/set' my-lfo)
-([10]out '127.0.0.1' 9000 '/param/offset/set' my-lfo)
-([10]out '127.0.0.1' 9000 '/param/offset/set' my-lfo)
+#([19]out '127.0.0.1' 9000 '/param/radius/set' ([18]lfo 0.2 'sin'))
+([8]out '127.0.0.1' 9000 '/param/radius/set' ([18]sin-lfo 0.1))
+([10]out '127.0.0.1' 9000 '/param/offset/set' ([15]sin-lfo 1))