comments, actual working things

11 files changed, 371 insertions, 102 deletions

diff --git a/ast.moon b/ast.moon
index 4927cbc..cfa51df 100644
--- a/ast.moon
+++ b/ast.moon
@@ -1,3 +1,6 @@
+import Constant from require 'base'
+unpack or= table.unpack
+
 unescape = (str) ->
   str = str\gsub '\\"', '"'
   str = str\gsub "\\'", "'"
@@ -5,7 +8,8 @@ unescape = (str) ->
   str
 
 class Atom
-  new: (@raw, @style='', @value) =>
+  new: (@raw, @style='', value) =>
+    @value = Constant value
 
   _walk_sexpr: =>
 
@@ -25,6 +29,8 @@ class Atom
   @make_strd: (match) -> Atom match, '"', unescape match
   @make_strq: (match) -> Atom match, "'", unescape match
 
+  __tostring: => @stringify!
+
 class Xpr
   new: (parts, @style='(', tag) =>
     @white = {}
@@ -35,7 +41,7 @@ class Xpr
       @white[i/2] = parts[i+1]
 
     if tag
-      @tag = tag.value
+      @tag = tag.value\getc!
 
   _walk_sexpr: =>
     -- depth first
@@ -45,6 +51,9 @@ class Xpr
     if @style == '('
       coroutine.yield @
 
+  head: => @[1].value
+  tail: => unpack [p.value for p in *@[2,]]
+
   walk_sexpr: =>
     coroutine.wrap -> @_walk_sexpr!
 
@@ -72,6 +81,8 @@ class Xpr
 
   make_nexpr: (parts) -> Xpr parts, 'naked'
 
+  __tostring: => @stringify!
+
 {
   :Atom
   :Xpr
diff --git a/base.moon b/base.moon
new file mode 100644
index 0000000..4fc2c98
--- /dev/null
+++ b/base.moon
@@ -0,0 +1,32 @@
+class Constant
+  new: (@value) =>
+  get: => @value
+  getc: => @value
+
+  __tostring: => "<const: #{@value}>"
+
+class OP
+  new: (@node) =>
+    @setup @node\tail!
+
+  patch: (next) =>
+    @node = next
+    @setup @node\tail!
+
+  update: (dt) =>
+
+  get: => @value
+  getc: =>
+    print "WARN: stream to constant", debug.traceback!
+    @value
+
+  destroy: =>
+
+  __tostring: => "<op: #{@@__name}>"
+  __inherited: (cls) =>
+        cls.__base.__tostring = @__tostring
+
+{
+  :Constant
+  :OP
+}
diff --git a/boot.lua b/boot.lua
new file mode 100644
index 0000000..4226cba
--- /dev/null
+++ b/boot.lua
@@ -0,0 +1,22 @@
+require 'moonscript'
+
+MODS = MODS or {}
+-- table.insert(MODS, 'base')
+-- table.insert(MODS, 'debug')
+-- table.insert(MODS, 'math')
+-- table.insert(MODS, 'time')
+
+for _,mod in ipairs(MODS) do
+ package.loaded[mod] = nil
+end
+for _,mod in ipairs(MODS) do
+  require(mod)
+end
+for k,v in pairs(require 'base') do
+  _G[k] = v
+end
+
+function reload()
+ package.loaded.boot = nil
+ require 'boot'
+end
diff --git a/copilot.moon b/copilot.moon
new file mode 100644
index 0000000..88aa8fa
--- /dev/null
+++ b/copilot.moon
@@ -0,0 +1,36 @@
+lfs = require 'lfs'
+import program from require 'parsing'
+
+slurp = (file) ->
+  file = io.open file, 'r'
+  with file\read '*all'
+    file\close!
+
+spit = (file, str) ->
+  file = io.open file, 'w'
+  file\write str
+  file\close!
+
+class Copilot
+  new: (@file, @registry) =>
+    @last_modification = 0
+
+    mode = lfs.attributes @file, 'mode'
+    if mode != 'file'
+      error "not a file: #{@file}"
+
+  patch: =>
+    { :mode, :modification } = (lfs.attributes @file) or {}
+    if mode != 'file'
+      return
+
+    if @last_modification < modification
+      print "---"
+
+      root = assert (program\match slurp @file), "error parsing"
+      @registry\patch_root root
+
+      spit @file, root\stringify!
+      @last_modification = os.time!
+
+:Copilot
diff --git a/gui.moon b/gui.moon
new file mode 100644
index 0000000..804e212
--- /dev/null
+++ b/gui.moon
@@ -0,0 +1,85 @@
+{ graphics: lg } = love
+import Registry from require 'registry'
+import Copilot from require 'copilot'
+import Constant, OP from require 'base'
+
+env = Registry!
+copilot = Copilot arg[#arg], env
+
+env.globals.lfo = class LFO extends OP
+  tau = math.pi * 2
+  new: (...) =>
+    super ...
+    @phase = 0
+
+  setup: (@speed, @wave=Constant 'sin') =>
+
+  update: (dt) =>
+    @phase += dt * @speed\get!
+    @value = switch @wave\get!
+      when 'sin' then .5 + .5 * math.cos @phase * tau
+      when 'saw' then @phase % 1
+      when 'tri' then math.abs (2*@phase % 2) - 1
+      else error "unknown wave type"
+
+env.globals.tick = class Tick extends OP
+  new: (...) =>
+    super ...
+    @phase = 0
+
+  setup: (@speed, @wave=Constant 'sin') =>
+
+  update: (dt) =>
+    @phase += dt / @speed\get!
+    @value = math.floor @phase
+
+env.globals.pick = class Pick extends OP
+  setup: (@i, ...) =>
+    @choices = { ... }
+
+  update: =>
+    i = 1 + (math.floor @i\get!) % #@choices
+    @value = @choices[i]\get!
+
+env.globals.mix = class Mix extends OP
+  setup: (@a, @b, @i) =>
+
+  update: (dt) =>
+    i = @i\get!
+    @value = i*@b\get! + (1-i)*@a\get!
+
+env.globals['gui/out'] = class Out extends OP
+  setup: (name, @chld) =>
+    @@instances[@name] = nil if @name
+    @name = name\getc!
+    @@instances[@name] = @
+
+  update: =>
+    @value = @chld\get!
+
+  destroy: =>
+    @@instances[@name] = nil
+
+  MARGIN = 16
+  WIDTH = 24
+  HEIGHT = 120 
+  @instances: {}
+  @draw_all: ->
+    outs = [name for name in pairs @@instances]
+    table.sort outs
+
+    x = MARGIN
+    lg.setColor 1, 1, 1
+    for name in *outs
+      value = @@instances[name].value * HEIGHT
+      lg.rectangle 'line', x, MARGIN, WIDTH, HEIGHT
+      lg.rectangle 'fill', x, MARGIN + HEIGHT - value, WIDTH, value
+      lg.print name, x, MARGIN + HEIGHT + MARGIN
+      x += WIDTH + MARGIN
+
+love.update = (dt) ->
+  copilot\patch!
+  env\update dt
+ 
+love.draw = ->
+  Out.draw_all!
diff --git a/main.lua b/main.lua
new file mode 100644
index 0000000..2bb6e04
--- /dev/null
+++ b/main.lua
@@ -0,0 +1,2 @@
+MODS = {'gui'}
+require 'boot'
diff --git a/main.moon b/main.moon
index a301101..9d15f34 100644
--- a/main.moon
+++ b/main.moon
@@ -1,20 +1,7 @@
-lfs = require 'lfs'
 sleep = require 'sleep'
-import program from require 'parsing'
+import Copilot from require 'copilot'
 
-filename = arg[1]
-
-slurp = (file) ->
-  file = io.open file, 'r'
-  with file\read '*all'
-    file\close!
-
-spit = (file, str) ->
-  file = io.open file, 'w'
-  file\write str
-  file\close!
-
-class Runtime
+class Environment
   spawn: (sexpr) =>
     print "spawning [#{sexpr.tag}]"
 
@@ -24,64 +11,9 @@ class Runtime
   destroy: (sexpr) =>
     print "destroying [#{sexpr.tag}]"
 
-runtime = Runtime!
-
-class Registry
-  new: =>
-    @last_tag = 0
-    @map = {}
-
-  spawn: (sexpr) =>
-    @last_tag += 1
-
-    sexpr.tag or= @last_tag
-    @map[sexpr.tag] = sexpr
-
-    runtime\spawn sexpr
-    sexpr.tag
-
-  patch: (sexpr) =>
-    old = @map[sexpr.tag]
-
-    if not old
-      return @spawn sexpr
-
-    @map[sexpr.tag] = sexpr
-
-    runtime\patch sexpr, old
-    sexpr.tag
-
-  patch_root: (root) =>
-    seen = {}
-
-    for sexpr in root\walk_sexpr!
-      tag = if not sexpr.tag
-        @spawn sexpr
-      else
-        @patch sexpr
-      seen[tag] = true
-
-    for tag, expr in pairs @map
-      if not seen[tag]
-        runtime\destroy expr
-        @map[tag] = nil
-
-registry = Registry!
-last_modification = 0
-
-while true
-  sleep 10
-
-  { :mode, :modification } = (lfs.attributes filename) or {}
-  if mode != 'file'
-    return
-
-  if last_modification >= modification
-    continue
-
-  last_modification = modification
-
-  root = assert (program\match slurp filename), "error parsing"
-  registry\patch_root root
+env = Environment!
+copilot = Copilot arg[1], env
 
-  spit filename, root\stringify!
+while True
+  sleep 0.01
+  copilot\patch!
diff --git a/old_base.moon b/old_base.moon
new file mode 100644
index 0000000..950ea16
--- /dev/null
+++ b/old_base.moon
@@ -0,0 +1,70 @@
+DISP, OP, OUT = {}, {}, {}
+
+class Value
+  new: (@value) =>
+
+  __tostring: => "<value: #{@value}>"
+
+class Dispatcher
+  new: =>
+    @operators = {}
+
+  dispatch: (...) =>
+    for op in pairs @operators
+      op\dispatch ...
+      op\update!
+
+  register: (op, params=true) =>
+    @operators[op] = params
+
+  unregister: (op) =>
+    @operators[op] = nil
+
+class Op
+  new: (opts={}, defaults) =>
+    assert defaults, "OP-def needs default arguments"
+    for k,v in pairs defaults
+      @[k] = opts[k] or v
+
+    @parents = 0
+    @setup!
+
+  setup: =>
+  destroy: =>
+  update: => -- return current value (pure)
+
+  mount: (lastval) =>
+    @parents += 1
+
+    if lastval and @parents == 1
+      @setup lastval
+
+  unmount: =>
+    @parents -= 1
+    if @parents == 0
+      @destroy!
+
+class Out
+  new: (@handle) =>
+    @values = {}
+    @mapping = {}
+
+  __call: (key, op) =>
+    if @mapping[key]
+      @mapping[key]\unmount!
+
+    @mapping[key] = op
+    @mapping[key]\mount @values[key]
+
+  update: =>
+    for key, op in pairs @mapping
+      @values[key] = op\update!
+
+    @handle! if @handle
+
+{
+  :Value,
+  :DISP, :Dispatcher
+  :OP,   :Op
+  :OUT,  :Out
+}
diff --git a/parsing.moon b/parsing.moon
index 9466d9e..5c3995f 100644
--- a/parsing.moon
+++ b/parsing.moon
@@ -2,14 +2,16 @@ import Atom, Xpr from require 'ast'
 import R, S, P, V, C, Ct from require 'lpeg'
 
 -- whitespace
-space  = (S ' \t\r\n') ^ 1 / 1 -- required whitespace
-mspace = (S ' \t\r\n') ^ 0 / 1 -- optional whitespace
+wc = S ' \t\r\n'
+comment = (P '#(') * (1 - P ')')^0 * (P ')')
+space  = (wc^1 * (comment * wc^1)^0) / 1 -- required whitespace
+mspace = (comment + wc)^0 / 1            -- optional whitespace
 
 -- atoms
 sym = ((R 'az', 'AZ') + (S '-_+*/.!?')) ^ 1 / Atom.make_sym
 
-strd = '"' * (C ((P'\\"') + (P '\\\\') + (1 - P '"')) ^ 0) * '"' / Atom.make_strd
-strq = "'" * (C ((P"\\'") + (P '\\\\') + (1 - P "'")) ^ 0) * "'" / Atom.make_strq
+strd = '"' * (C ((P '\\"') + (P '\\\\') + (1 - P '"'))^0) * '"' / Atom.make_strd
+strq = "'" * (C ((P "\\'") + (P '\\\\') + (1 - P "'"))^0) * "'" / Atom.make_strq
 str = strd + strq
 
 digit = R '09'
@@ -20,7 +22,7 @@ num = (float + int) / Atom.make_num
 atom = num + sym + str
 
 expr = (V 'sexpr') + atom
-explist = Ct mspace * (V 'expr') * (space * (V 'expr')) ^ 0 * mspace
+explist = Ct mspace * (V 'expr') * (space * (V 'expr'))^0 * mspace
 
 tag = (P '[') * num * (P ']')
 sexpr = (P '(') * tag^-1 * (V 'explist') * (P ')') / Xpr.make_sexpr
diff --git a/registry.moon b/registry.moon
new file mode 100644
index 0000000..65c26a5
--- /dev/null
+++ b/registry.moon
@@ -0,0 +1,72 @@
+class Registry
+  new: (@env) =>
+    @globals = {}
+    @map = {}
+
+  gentag: => #@map + 1
+
+  patch: (sexpr) =>
+    old = @map[sexpr.tag]
+    @map[sexpr.tag] = sexpr
+
+    if not old
+      @spawn_expr sexpr
+    else
+      @patch_expr sexpr, old
+    sexpr.tag
+
+  patch_root: (@root) =>
+    seen = {}
+    to_tag = {}
+
+    for sexpr in @root\walk_sexpr!
+      if not sexpr.tag
+        @spawn_expr sexpr
+        table.insert to_tag, sexpr
+      else
+        tag = @patch sexpr
+        seen[tag] = true
+
+    for sexpr in *to_tag
+      tag = @gentag!
+      sexpr.tag = tag
+      @map[tag] = sexpr
+      seen[tag] = true
+
+    for tag, expr in pairs @map
+      if not seen[tag]
+        @destroy_expr expr
+        @map[tag] = nil
+
+  --
+
+  update: (dt) =>
+    -- for tag, sexpr in pairs @map
+    for sexpr in @root\walk_sexpr!
+      sexpr.value\update dt
+
+  spawn_expr: (sexpr) =>
+    ref = sexpr\head!\getc!
+    if sexpr.tag
+      print "respawning [#{sexpr.tag}]: '#{ref}'"
+    else
+      print "spawning '#{ref}'"
+
+    def = rawget @globals, ref
+    sexpr.value = def sexpr
+
+  patch_expr: (new, old) =>
+    if new\head!\getc! == old\head!\getc!
+      -- same function, can be patched
+      print "patching [#{new.tag}]"
+      new.value = old.value
+      new.value\patch new
+    else
+      -- different function
+      @spawn_expr new
+
+  destroy_expr: (sexpr) =>
+    sexpr.value\destroy!
+    print "destroying [#{sexpr.tag}]"
+
+:Registry
diff --git a/spec/parsing_spec.moon b/spec/parsing_spec.moon
index 7e8e5a7..f1c85f2 100644
--- a/spec/parsing_spec.moon
+++ b/spec/parsing_spec.moon
@@ -4,46 +4,46 @@ describe 'atom parsing', ->
   test 'symbols', ->
     sym = atom\match 'some-toast help'
     assert.is.equal 'some-toast', sym.raw
-    assert.is.equal 'some-toast', sym.value
+    assert.is.equal 'some-toast', sym.value\getc!
     assert.is.equal 'some-toast', sym\stringify!
 
   describe 'numbers', ->
     it 'parses ints', ->
       num = atom\match '1234 nope'
       assert.is.equal '1234', num.raw
-      assert.is.equal 1234, num.value
+      assert.is.equal 1234, num.value\getc!
       assert.is.equal '1234', num\stringify!
 
     it 'parses floats', ->
       num = atom\match '0.123 nope'
-      assert.is.equal 0.123, num.value
+      assert.is.equal 0.123, num.value\getc!
       assert.is.equal '0.123', num\stringify!
 
       num = atom\match '.123 nope'
-      assert.is.equal .123, num.value
+      assert.is.equal .123, num.value\getc!
       assert.is.equal '.123', num\stringify!
 
       num = atom\match '0. nope'
-      assert.is.equal 0, num.value
+      assert.is.equal 0, num.value\getc!
       assert.is.equal '0.', num\stringify!
 
   describe 'strings', ->
     it 'parses double-quote strings', ->
       str = atom\match '"help some stuff!" nope'
       assert.is.equal 'help some stuff!', str.raw
-      assert.is.equal 'help some stuff!', str.value
+      assert.is.equal 'help some stuff!', str.value\getc!
       assert.is.equal '"help some stuff!"', str\stringify!
 
     it 'parses single-quote strings', ->
       str = atom\match "'help some stuff!' nope"
       assert.is.equal "help some stuff!", str.raw
-      assert.is.equal "help some stuff!", str.value
+      assert.is.equal "help some stuff!", str.value\getc!
       assert.is.equal "'help some stuff!'", str\stringify!
 
     it 'handles escapes', ->
       str = atom\match '"string with \\"quote\\"s"'
       assert.is.equal 'string with \\"quote\\"s', str.raw
-      assert.is.equal 'string with "quote"s', str.value
+      assert.is.equal 'string with "quote"s', str.value\getc!
       assert.is.equal '"string with \\"quote\\"s"', str\stringify!
 
 test 'whitespace parsing', ->
@@ -55,8 +55,8 @@ describe 'nexpr parsing', ->
     node = nexpr\match ' 3\tok-yes'
 
     assert.is.equal 2, #node
-    assert.is.equal 3, node[1].value
-    assert.is.equal 'ok-yes', node[2].value
+    assert.is.equal 3, node[1].value\getc!
+    assert.is.equal 'ok-yes', node[2].value\getc!
 
     assert.is.equal ' 3\tok-yes', node\stringify!
 
@@ -64,8 +64,8 @@ describe 'nexpr parsing', ->
     node = nexpr\match '3\tok-yes\n'
 
     assert.is.equal 2, #node
-    assert.is.equal 3, node[1].value
-    assert.is.equal 'ok-yes', node[2].value
+    assert.is.equal 3, node[1].value\getc!
+    assert.is.equal 'ok-yes', node[2].value\getc!
 
     assert.is.equal '3\tok-yes\n', node\stringify!
 
@@ -73,8 +73,8 @@ describe 'nexpr parsing', ->
     node = nexpr\match ' 3\tok-yes\n'
 
     assert.is.equal 2, #node
-    assert.is.equal 3, node[1].value
-    assert.is.equal 'ok-yes', node[2].value
+    assert.is.equal 3, node[1].value\getc!
+    assert.is.equal 'ok-yes', node[2].value\getc!
 
     assert.is.equal ' 3\tok-yes\n', node\stringify!
 
@@ -86,9 +86,9 @@ describe 'sexpr', ->
 
     assert.is.equal '(', node.style
     assert.is.equal 3, #node
-    assert.is.equal 3, node[1].value
-    assert.is.equal 'ok-yes', node[2].value
-    assert.is.equal 'friend', node[3].value
+    assert.is.equal 3, node[1].value\getc!
+    assert.is.equal 'ok-yes', node[2].value\getc!
+    assert.is.equal 'friend', node[3].value\getc!
 
     assert.is.equal str, node\stringify!
 
@@ -98,8 +98,8 @@ describe 'sexpr', ->
 
     assert.is.equal '(', node.style
     assert.is.equal 2, #node
-    assert.is.equal 'tagged', node[1].value
-    assert.is.equal 2, node[2].value
+    assert.is.equal 'tagged', node[1].value\getc!
+    assert.is.equal 2, node[2].value\getc!
 
     assert.is.equal 42, node.tag
     assert.is.equal str, node\stringify!
@@ -113,15 +113,20 @@ describe 'resynthesis', ->
 
   test 'complex', ->
     str = '
+  #(send a CC controlled LFO to /radius)
   (osc "/radius" (lfo (cc 14)))
 
   (osc rot
     (step
+      #(whenever a kick is received...)
       (note "kick")
+
+      #(..cycle through random rotation values)
       (random-rot)
       (random-rot)
       (random-rot)
       (random-rot)
     )
   ) '
-    assert.is.equal str, (program\match str)\stringify!
+    matched = assert.is.truthy program\match str
+    assert.is.equal str, matched\stringify!