macros and scopes

10 files changed, 141 insertions, 45 deletions

diff --git a/ast.moon b/ast.moon
index 7996c0f..99b200a 100644
--- a/ast.moon
+++ b/ast.moon
@@ -86,9 +86,17 @@ class Xpr
       @white[i/2] = parts[i+1]
 
   expand: (scope) =>
-    scope = Scope @, scope
-    for child in *@
-      child\expand scope
+    head = @[1]
+    head\expand scope
+
+    @scope = Scope @, scope
+
+    if head.value.type == 'macro'
+      macro = head.value\getc!
+      macro scope, @
+    else
+      for child in *@[2,]
+        child\expand scope
 
   link: =>
     head = @head!
@@ -128,10 +136,15 @@ class Xpr
   make_nexpr: (...) -> Xpr 'naked', ...
 
   __tostring: =>
-    if @tag
-      "<Xpr[#{@tag}] #{@value}>"
-    else
-      "<Xpr #{@value}>"
+    if @style == 'naked'
+      return 'ROOT'
+
+    buf = "("
+    buf ..= "[#{@tag}]" if @tag
+    buf ..= "#{@[1].raw}"
+    buf ..= " ..." if #@ > 1
+    buf ..= ")"
+    buf
 
 {
   :Atom
diff --git a/base.moon b/base.moon
index 863305d..72dd62f 100644
--- a/base.moon
+++ b/base.moon
@@ -1,7 +1,7 @@
 import is_object from require 'moon'
 
 class Const
-  types = { str: true, num: true, op: true, opdef: true }
+  types = { sym: true, scope: true, str: true, num: true, op: true, opdef: true, macro: true }
   new: (@type, @value) =>
     assert types[@type], "invalid Const type: #{@type}"
 
diff --git a/init.moon b/init.moon
index c9536de..bd54613 100644
--- a/init.moon
+++ b/init.moon
@@ -1,17 +1,6 @@
-import Registry from require 'registry'
-
-env = Registry!
-env\add_module 'math'
-env\add_module 'time'
-env\add_module 'util'
-env\add_module 'osc'
-env\add_module 'debug'
-
-if ... == 'init'
-  return env
-
 -- run from CLI
 import clock_gettime, nanosleep, CLOCK_MONOTONIC from require 'posix.time'
+import Registry from require 'registry'
 import Copilot from require 'copilot'
 
 delta = do
@@ -25,7 +14,9 @@ delta = do
     with time - (last or time)
       last = time
 
+env = Registry!
 copilot = Copilot arg[1], env
+
 while true
   copilot\poll!
 
diff --git a/lib/builtin.moon b/lib/builtin.moon
new file mode 100644
index 0000000..e7586da
--- /dev/null
+++ b/lib/builtin.moon
@@ -0,0 +1,29 @@
+import Const from require 'base'
+import Scope from require 'scope'
+
+module = {
+  def: (scope, xpr) ->
+    assert #xpr > 2, "'def' requires at least 3 arguments"
+    assert #xpr % 2 == 1, "'def' requires an even number of arguments"
+    for i=2,#xpr,2
+      assert xpr[i].atom_type == 'sym', "'def's argument ##{i} has to be a symbol"
+      xpr[i+1]\expand xpr.scope
+      scope\set xpr[i].raw, xpr[i+1].value
+
+  use: (scope, xpr) ->
+    for value in *xpr[2,]
+      value\expand xpr.scope
+      assert value.value.type == 'scope', "'use' only works on scopes"
+      scope\use value.value\getc!
+
+  require: (scope, xpr) ->
+    assert #xpr == 2, "'require' takes only one parameter"
+
+    xpr[2]\expand xpr.scope
+    name = xpr[2].value
+    assert name.type == 'str', "'require' only works on strings"
+
+    xpr.value = Const 'scope', Scope.from_table require "lib.#{name\getc!}"
+}
+
+{ k, Const 'macro', v for k, v in pairs module }
diff --git a/lib/gui.moon b/lib/gui.moon
index 979854f..20d3bcc 100644
--- a/lib/gui.moon
+++ b/lib/gui.moon
@@ -1,5 +1,6 @@
 { graphics: lg } = love
 import Op from require 'base'
+import Registry from require 'registry'
 import Copilot from require 'copilot'
 
 class out extends Op
@@ -31,6 +32,7 @@ class out extends Op
       lg.print name, x, MARGIN + HEIGHT + MARGIN
       x += WIDTH + MARGIN
 
+env = Registry!
 copilot = Copilot arg[#arg], env
 
 love.update = (dt) ->
diff --git a/main.lua b/main.lua
index b5a9d4a..173eca1 100644
--- a/main.lua
+++ b/main.lua
@@ -1,3 +1,2 @@
 require 'moonscript'
-env = require 'init'
-env:add_module 'gui'
+require 'lib.gui'
diff --git a/registry.moon b/registry.moon
index 27dc201..2a751cc 100644
--- a/registry.moon
+++ b/registry.moon
@@ -3,6 +3,9 @@ import Scope from require 'scope'
 class Registry
   new: (@env) =>
     @globals = Scope!
+    for k, v in pairs require 'lib.builtin'
+      @globals\set_raw k, v
+
     @map = {}
 
   add_module: (name) =>
@@ -27,7 +30,8 @@ class Registry
     to_tag = {}
 
     scope = Scope @root, @globals
-    @root\expand scope
+    for child in *@root
+      child\expand scope
 
     for typ, node in @root\walk 'inout', false
       node\link!
@@ -54,7 +58,10 @@ class Registry
         @map[tag] = nil
 
   spawn_expr: (sexpr) =>
-    def = sexpr\head!\getc!
+    head = sexpr\head!
+    return if head.type == 'macro'
+
+    def = head\getc!
     if sexpr.tag
       print "respawning [#{sexpr.tag}]: '#{def}'"
     else
@@ -63,8 +70,12 @@ class Registry
     sexpr.value = def sexpr
 
   patch_expr: (new, old) =>
-    if new\head!\getc! == old\head!\getc!
+    head = new\head!
+
+    if head\getc! == old\head!\getc!
       -- same function, can be patched
+      return if head.type == 'macro'
+
       print "patching [#{new.tag}]"
       new.value = old.value
       new.value\patch new
@@ -73,6 +84,9 @@ class Registry
       @spawn_expr new
 
   destroy_expr: (sexpr) =>
+    head = sexpr\head!
+    return if head.type == 'macro'
+
     sexpr.value\destroy!
     print "destroying [#{sexpr.tag}]"
 
@@ -80,10 +94,10 @@ class Registry
 
   tb = (msg) -> debug.traceback msg, 2
   update: (dt) =>
-    -- for tag, sexpr in pairs @map
     for typ, sexpr in @root\walk 'inout', false
       continue unless typ == 'Xpr'
-      continue unless sexpr.value
+      -- continue unless sexpr.value and sexpr.value.update
+      continue unless sexpr\head!.type == 'opdef'
 
       ok, err = xpcall sexpr.value.update, tb, sexpr.value, dt
       if not ok
diff --git a/scope.moon b/scope.moon
index a72a606..907269e 100644
--- a/scope.moon
+++ b/scope.moon
@@ -27,12 +27,14 @@ constify = (val, key) ->
         switch ancestor klass
           when Op
             'op'
+          when Scope
+            'scope'
           when Const
             return val
           else
             error "#{key}: cannot constify '#{klass.__name}' instance"
       else
-        return Scope.from_table val
+        return Const 'scope', Scope.from_table val
     else
       error "#{key}: cannot constify Lua type '#{type val}'"
 
@@ -42,26 +44,53 @@ class Scope
   new: (@node, @parent) =>
     @values = {}
 
+  log: (msg) => -- print msg .. " in #{@}"
+
   set_raw: (key, val) => @values[key] = constify val, key
   set: (key, val) =>
+    @log "setting #{key} = #{val}"
     @values[key] = val
 
-  get: (key) =>
+  get: (key, prefix='') =>
+    @log "checking for #{key}"
     if val = @values[key]
+      @log "found #{val}"
       return val
 
-    if val = @parent and @parent\get key
-      return val
+    start, rest = key\match '^(.-)/(.*)'
+
+    if not start
+      return @parent\get key
 
-    part, key = key\match '^(.-)/(.*)'
-    return unless part and key
-    scope = assert (@get part), "no such scope: '#{key}'"
-    scope\get key
+    scope = @get start
+    assert scope and scope.type == 'scope', "cant find '#{prefix}#{start}' for '#{prefix}#{key}'"
+    scope\getc!\get rest, "#{prefix}#{start}/"
+
+  use: (other) =>
+    for k, v in pairs other.values
+      @values[k] = v
 
   from_table: (tbl) ->
     with Scope!
       .values = { k, constify v, k for k,v in pairs tbl }
 
+  __tostring: =>
+    buf = "<Scope"
+    buf ..= "@#{@node}" if @node
+
+    depth = -1
+    parent = @parent
+    while parent
+      depth += 1
+      parent = parent.parent
+    buf ..= " ^#{depth}" if depth != 0
+
+    buf ..= " [#{table.concat [key for key in pairs @values], ', '}]"
+
+    buf ..= ">"
+    buf
+
+
 {
   :Scope
 }
diff --git a/spec/scope_spec.moon b/spec/scope_spec.moon
index f00763d..465e5fa 100644
--- a/spec/scope_spec.moon
+++ b/spec/scope_spec.moon
@@ -35,13 +35,22 @@ describe 'Scope', ->
       assert.is.equal 'opdef', got.type
       assert.is.equal TestOp, got.value
 
+    test 'Scopes', ->
+      sub = Scope!
+      scope\set_raw 'sub', sub
+
+      got = scope\get 'sub'
+      assert.is.equal 'scope', got.type
+      assert.is.equal sub, got.value
+
     test 'tables', ->
       pi = Const 'num', 3.14
       scope\set_raw 'math',  { :pi }
 
-      math = scope\get 'math'
-      assert.is.equal Scope, math.__class
-      assert.is.equal pi, math\get 'pi'
+      got = scope\get 'math'
+      assert.is.equal 'scope', got.type
+      assert.is.equal Scope, got.value.__class
+      assert.is.equal pi, got.value\get 'pi'
       assert.is.equal pi, scope\get 'math/pi'
 
   it 'constifies in from_table', ->
@@ -68,8 +77,8 @@ describe 'Scope', ->
     assert.is.equal 'opdef', got.type
     assert.is.equal TestOp, got.value
 
-    assert.is.equal Scope, (scope\get 'math').__class
-    assert.is.equal pi, (scope\get 'math')\get 'pi'
+    got = scope\get 'math'
+    assert.is.equal 'scope', got.type
     assert.is.equal pi, scope\get 'math/pi'
 
   it 'gets from nested scopes', ->
@@ -78,9 +87,9 @@ describe 'Scope', ->
     b = Scope!
 
     pi = Const 'num', 3.14
-    b\set 'test', pi
-    a\set 'child', b
-    root\set 'deep', a
+    b\set_raw 'test', pi
+    a\set_raw 'child', b
+    root\set_raw 'deep', a
 
     assert.is.equal pi, root\get 'deep/child/test'
 
diff --git a/test.alv b/test.alv
index fb24105..692c3be 100644
--- a/test.alv
+++ b/test.alv
@@ -1,4 +1,14 @@
+#(this is equivalent to:
+  (def osc (require 'osc'))
+  (def out osc/out))
+([2]use ([1]require 'osc'))
+
+#(there should probably be a shorthand for this,
+  but i'm not sure what to call it.
+  maybe it could be just
+  (require time) - note its a symbol not a string here)
+([4]def time ([3]require 'time'))
  
-([6]osc/out '127.0.0.1' 9000 '/param/radius/set' ([1]time/lfo 0.5))
-([7]osc/out '127.0.0.1' 9000 '/param/offset/set' ([5]time/lfo 1.2 'saw'))
+([6]out '127.0.0.1' 9000 '/param/radius/set' ([5]time/lfo 0.5))
+([8]out '127.0.0.1' 9000 '/param/offset/set' ([7]time/lfo 1.2 'saw'))