first-class scopes

9 files changed, 225 insertions, 23 deletions

diff --git a/ast.moon b/ast.moon
index c5bfd07..7996c0f 100644
--- a/ast.moon
+++ b/ast.moon
@@ -1,6 +1,15 @@
 import Const from require 'base'
+import Scope from require 'scope'
 unpack or= table.unpack
 
+hash = (tbl) ->
+  mt = getmetatable tbl
+  setmetatable tbl, nil
+  str = tostring tbl
+  setmetatable tbl, mt
+
+  '#' .. str\sub 10
+
 class ASTNode
   -- first pass (outin):
   -- * expand macros
@@ -23,13 +32,13 @@ class Atom
     str = str\gsub "\\\\", "\\"
     str
   expand: (scope) =>
-    @value = Const switch @atom_type
+    @value = switch @atom_type
       when 'num'
-        tonumber @raw
-      when 'sym'
-        assert scope[@raw], "undefined reference to symbol '#{@raw}'"
+        Const 'num', tonumber @raw
       when 'strq', 'strd'
-        unescape @raw
+        Const 'str', unescape @raw
+      when 'sym'
+        assert (scope\get @raw), "undefined reference to symbol '#{@raw}'"
       else
         error "unknown atom type: '#{@atom_type}'"
 
@@ -53,7 +62,8 @@ class Atom
   @make_strd: (match) -> Atom match, 'strd'
   @make_strq: (match) -> Atom match, 'strq'
 
-  __tostring: => @stringify!
+  __tostring: =>
+    "<Atom#{hash @} #{@stringify!}>"
 
 class Xpr
   type: 'Xpr'
@@ -76,8 +86,12 @@ class Xpr
       @white[i/2] = parts[i+1]
 
   expand: (scope) =>
+    scope = Scope @, scope
+    for child in *@
+      child\expand scope
 
   link: =>
+    head = @head!
 
   head: => @[1].value
   tail: => unpack [p.value for p in *@[2,]]
diff --git a/base.moon b/base.moon
index acade78..863305d 100644
--- a/base.moon
+++ b/base.moon
@@ -1,9 +1,14 @@
+import is_object from require 'moon'
+
 class Const
-  new: (@value) =>
+  types = { str: true, num: true, op: true, opdef: true }
+  new: (@type, @value) =>
+    assert types[@type], "invalid Const type: #{@type}"
+
   get: => @value
   getc: => @value
 
-  __tostring: => "<const: #{@value}>"
+  __tostring: => "<#{@type}: #{@value}>"
 
 class Op
   new: (@node) =>
diff --git a/copilot.moon b/copilot.moon
index d0dec92..cef664a 100644
--- a/copilot.moon
+++ b/copilot.moon
@@ -24,6 +24,7 @@ class Copilot
     @registry\patch_root root
     spit @file, root\stringify!
 
+  tb = (msg) -> debug.traceback msg, 2
   poll: =>
     { :mode, :modification } = (lfs.attributes @file) or {}
     if mode != 'file'
@@ -31,7 +32,7 @@ class Copilot
 
     if @last_modification < modification
       print "---"
-      ok, err = pcall @patch, @
+      ok, err = xpcall @patch, tb, @
       if not ok
         print "ERROR: #{err}"
 
diff --git a/lib/math.moon b/lib/math.moon
index 8ada38a..8e54bbd 100644
--- a/lib/math.moon
+++ b/lib/math.moon
@@ -50,6 +50,8 @@ module = {
   :div, '/': div
 
   mix: func_op 'mix', 3, (a, b, i) -> i*b + (1-i)*a
+
+  pi: math.pi, huge: math.huge
 }
 
 for name, arity in pairs {
diff --git a/lib/time.moon b/lib/time.moon
index f2ad70c..4fe5d7c 100644
--- a/lib/time.moon
+++ b/lib/time.moon
@@ -6,7 +6,9 @@ class lfo extends Op
     super ...
     @phase = 0
 
-  setup: (@freq, @wave=Const 'sin') =>
+
+  default_wave = Const 'str', 'sin'
+  setup: (@freq, @wave=default_wave) =>
 
   update: (dt) =>
     @phase += dt * @freq\get!
diff --git a/registry.moon b/registry.moon
index 950ec38..27dc201 100644
--- a/registry.moon
+++ b/registry.moon
@@ -1,11 +1,12 @@
+import Scope from require 'scope'
+
 class Registry
   new: (@env) =>
-    @globals = {}
+    @globals = Scope!
     @map = {}
 
-  add_module: (name, tbl=require "lib.#{name}") =>
-    for k,v in pairs tbl
-      @globals["#{name}/#{k}"] = v
+  add_module: (name) =>
+    @globals\set_raw name, require "lib.#{name}"
 
   --
 
@@ -25,12 +26,14 @@ class Registry
     seen = {}
     to_tag = {}
 
-    for typ, atom in @root\walk 'outin', false
-      continue unless typ == 'Atom'
-      atom\expand @globals
+    scope = Scope @root, @globals
+    @root\expand scope
+
+    for typ, node in @root\walk 'inout', false
+      node\link!
 
-    for typ, sexpr in @root\walk 'inout', false
       continue unless typ == 'Xpr'
+      sexpr = node
 
       if not sexpr.tag
         @spawn_expr sexpr
@@ -75,13 +78,14 @@ 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
 
-      ok, err = pcall sexpr.value.update, sexpr.value, dt
+      ok, err = xpcall sexpr.value.update, tb, sexpr.value, dt
       if not ok
         print "@#{sexpr}: #{err}"
 
diff --git a/scope.moon b/scope.moon
new file mode 100644
index 0000000..a72a606
--- /dev/null
+++ b/scope.moon
@@ -0,0 +1,67 @@
+import Const, Op from require 'base'
+
+ancestor = (klass) ->
+  assert klass, "cant find the ancestor of nil"
+  while klass.__parent
+    klass = klass.__parent
+  klass
+
+local Scope
+
+constify = (val, key) ->
+  typ = switch type val
+    when 'number'
+      'num'
+    when 'string'
+      'str'
+    when 'table'
+      if base = rawget val, '__base'
+        -- a class
+        switch ancestor val
+          when Op
+            'opdef'
+          else
+            error "#{key}: cannot constify klass '#{val.__name}'"
+      elseif klass = val.__class
+        -- an instance
+        switch ancestor klass
+          when Op
+            'op'
+          when Const
+            return val
+          else
+            error "#{key}: cannot constify '#{klass.__name}' instance"
+      else
+        return Scope.from_table val
+    else
+      error "#{key}: cannot constify Lua type '#{type val}'"
+
+  Const typ, val
+
+class Scope
+  new: (@node, @parent) =>
+    @values = {}
+
+  set_raw: (key, val) => @values[key] = constify val, key
+  set: (key, val) =>
+    @values[key] = val
+
+  get: (key) =>
+    if val = @values[key]
+      return val
+
+    if val = @parent and @parent\get key
+      return val
+
+    part, key = key\match '^(.-)/(.*)'
+    return unless part and key
+    scope = assert (@get part), "no such scope: '#{key}'"
+    scope\get key
+
+  from_table: (tbl) ->
+    with Scope!
+      .values = { k, constify v, k for k,v in pairs tbl }
+
+{
+  :Scope
+}
diff --git a/spec/ast_spec.moon b/spec/ast_spec.moon
index 6e5ca32..5c1e1a7 100644
--- a/spec/ast_spec.moon
+++ b/spec/ast_spec.moon
@@ -1,4 +1,5 @@
 import Atom, Xpr from require 'ast'
+import Scope from require 'scope'
 
 describe 'Atom', ->
   expand = (typ, str, ...) ->
@@ -8,11 +9,13 @@ describe 'Atom', ->
 
   describe 'sym', ->
     it 'expand correctly', ->
-      env = { a: 1, b: 2, c: 44, 'long_name': 'str',
-              'name/with/slash': {} }
+      values = { a: 1, b: 2, c: 44, 'long_name': 'str',
+                 'name/with/slash': 3 }
 
-      for k,v in pairs env
-        assert.is.equal v, expand 'sym', k, env
+      scope = Scope.from_table values
+
+      for k,v in pairs values
+        assert.is.equal v, expand 'sym', k, scope
 
   describe 'num', ->
     it 'expand correctly', ->
diff --git a/spec/scope_spec.moon b/spec/scope_spec.moon
new file mode 100644
index 0000000..f00763d
--- /dev/null
+++ b/spec/scope_spec.moon
@@ -0,0 +1,104 @@
+import Op, Const from require 'base'
+import Scope from require 'scope'
+
+class TestOp extends Op
+  new: (...) => super ...
+
+describe 'Scope', ->
+  describe 'constifies', ->
+    scope = Scope!
+
+    test 'numbers', ->
+      scope\set_raw 'num', 3
+
+      got = scope\get 'num'
+      assert.is.equal 'num', got.type
+      assert.is.equal 3, got.value
+
+    test 'strings', ->
+      scope\set_raw 'str', "im a happy string"
+
+      got = scope\get 'str'
+      assert.is.equal 'str', got.type
+      assert.is.equal "im a happy string", got.value
+
+    test 'Consts', ->
+      pi = Const 'num', 3.14
+      scope\set_raw 'pi', pi
+
+      assert.is.equal pi, scope\get 'pi'
+
+    test 'Opdefs', ->
+      scope\set_raw 'test', TestOp
+
+      got = scope\get 'test'
+      assert.is.equal 'opdef', got.type
+      assert.is.equal TestOp, 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'
+      assert.is.equal pi, scope\get 'math/pi'
+
+  it 'constifies in from_table', ->
+    pi = Const 'num', 3.14
+    scope = Scope.from_table {
+      num: 3
+      str: "im a happy string"
+      :pi
+      math: :pi
+      test: TestOp
+    }
+
+    got = scope\get 'num'
+    assert.is.equal 'num', got.type
+    assert.is.equal 3, got.value
+
+    got = scope\get 'str'
+    assert.is.equal 'str', got.type
+    assert.is.equal "im a happy string", got.value
+
+    assert.is.equal pi, scope\get 'pi'
+
+    got = scope\get 'test'
+    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'
+    assert.is.equal pi, scope\get 'math/pi'
+
+  it 'gets from nested scopes', ->
+    root = Scope!
+    a = Scope!
+    b = Scope!
+
+    pi = Const 'num', 3.14
+    b\set 'test', pi
+    a\set 'child', b
+    root\set 'deep', a
+
+    assert.is.equal pi, root\get 'deep/child/test'
+
+  describe 'inheritance', ->
+    root = Scope!
+    root\set_raw 'hidden', 1234
+    root\set_raw 'inherited', "inherited string"
+
+    scope = Scope nil, root
+
+    it 'allows access', ->
+      got = scope\get 'inherited'
+      assert.is.equal 'str', got.type
+      assert.is.equal "inherited string", got.value
+
+    it 'can keep defs', ->
+      scope\set_raw 'hidden', "overwritten"
+
+      got = scope\get 'hidden'
+      assert.is.equal 'str', got.type
+      assert.is.equal "overwritten", got.value