template strings as syntax sugar for Ops

10 files changed, 215 insertions, 176 deletions

diff --git a/alv-lib/glsl-view.moon b/alv-lib/glsl-view.moon
index c2d57ee..e0b8678 100644
--- a/alv-lib/glsl-view.moon
+++ b/alv-lib/glsl-view.moon
@@ -1,4 +1,4 @@
-import Constant, Op, TemplateString, Input, T, Array, Struct, sig, const from require 'alv.base'
+import Constant, PureOp, Op, template_subst, Input, T, Array, Struct, sig, const from require 'alv.base'
 import Message, Bundle, Timetag, add_item from require 'alv-lib._osc'
 import dns, udp from require 'socket'
 
@@ -107,86 +107,103 @@ tsv_input = Constant.meta
       with @inputs.socket!
         \send Message.pack { address: "/texture/#{name}/tsv", types: "ss", "TEXTURE_#{type}", name }
 
-shader = Constant.meta
+shader_ = Constant.meta
   meta:
     name: 'shader'
-    summary: "control a GLSL shader via OSC."
-    examples: { '(shader [socket] code-tpl-str)' }
+    summary: "compile a GLSL shader with uniforms."
+    examples: { '#shader"code…"' }
     description: "Syncs code and parameters with glsl-view via OSC.
 
-- `socket` must be an `osc/out~` or read from `*oscout*`
-- `code-tpl-str` is a `str=` that can contain `~-stream` template substitutions
-  that are mapped as follows:
+- `code…` is a template string that can contain `~-stream` template substitutions that are used as follows:
   - `str`: substituted directly as GLSL
   - `{type: str val: …}`: reference to uniform of type `type` (instead of infered as follows)
   - `num`, `bool`: reference to `uniform float/bool`
   - `num[I]`, `bool[I]`: reference to `uniform vecI/bvecI`
   - `num[I][J]`: reference to `uniform matIxJ`"
 
-  value: class extends Op
-    pattern = -sig['osc/out'] + const.str + sig!^0
+  value: class extends PureOp
+    pattern: const! + sig!^0
 
-    default_sender = (input) -> input\type!, input!
-    get_code: =>
-      uniforms = { '#version 330 core' }
+    name: (i) => "alv_u_#{i}"
 
-      @state = {}
-      code = TemplateString.subst @inputs.code!, (i) ->
-        param = @inputs.params[i]
-        type = param\type!
-        return param! if type == T.str
+    type: (args) =>
+      uniforms = {}
+      for i, val in ipairs args[2]
+        type = val\type!
+        if type == T.str
+          continue
+        elseif type.__class == Struct
+          assert (type\get 'type') == T.str, "struct substituton needs type key"
+          type = assert (type\get 'val'), "struct substituton needs val key"
 
-        id = tostring math.random!
-        name = "alv_param_#{id\sub 3}"
+        uniforms[@name i] = type
 
-        typestr = GLSL_TYPES[tostring type]
+      uniforms = Struct uniforms
+      Struct shader: T.str, :uniforms
 
-        -- NOTE: can't close over @ or input or breaks when forked
-        if type.__class == Struct
-          assert type.types.type == T.str, "struct substituton needs type key"
-          val_type = assert type.types.val, "struct substituton needs val key"
+    tick: =>
+      uniforms = {}
+
+      preamble = { '#version 330 core' }
+      pieces = for i, input in ipairs @inputs[2]
+        name, input = (@name i), input
+        val, type = input!, input\type!
 
-          typestr = param!.type
-          @state[i] = => "/uniform/#{name}", val_type, @inputs.params[i]!.val
+        typestr = GLSL_TYPES[tostring type]
+        if type == T.str
+          val
         else
+          if type.__class == Struct
+            typestr = val.type
+            val, type = val.val, val.type
+
           assert typestr, "unsupported type #{type}"
-          @state[i] = => "/uniform/#{name}", type, @inputs.params[i]!
+          table.insert preamble, "uniform #{typestr} #{name};"
+          uniforms[name] = val
+          name
 
-        table.insert uniforms, "uniform #{typestr} #{name};"
+      shader = template_subst @inputs[1]!, pieces
 
-        name
+      table.insert preamble, shader
+      shader = table.concat preamble, '\n'
 
-      table.insert uniforms, code
-      table.concat uniforms, '\n'
+      @out\set :shader, :uniforms
 
-    setup: (inputs, scope) =>
-      { socket, code, params } = pattern\match inputs
+draw = Constant.meta
+  meta:
+    name: 'draw'
+    summary: "draw a GLSL shader via OSC."
+    examples: { '(draw [socket] shader)' }
+    description: "Syncs code and parameters with glsl-view via OSC.
 
+- `socket` must be an `osc/out~` or read from `*oscout*`
+- `shader` is a struct~ with
+  - `shader` (`str`): GLSL source
+  - `uniforms`: struct mapping uniform names to values"
+
+  value: class extends Op
+    pattern = -sig['osc/out'] + sig!
+
+    setup: (inputs, scope) =>
+      { socket, shader } = pattern\match inputs
       super
         socket: Input.hot socket or scope\get '*oscout*'
-        code: Input.hot code
-        params: [Input.hot param for param in *params]
-
-    tick: (setup) =>
-      bundle = Bundle.new Timetag.new!
-      recompile = setup or @inputs.code\dirty! or @inputs.socket\dirty!
-      if recompile
-        bundle\add content: { address: '/shader', types: 's', @get_code! }
-
-      for i, input in ipairs @inputs.params
-        continue unless recompile or input\dirty!
-
-        if sender = @state[i]
-          addr, type, val = sender @
-          bundle\add with msg = Message.new addr
-            add_item msg, type, val
-        elseif not recompile
-          -- text-only piece is dirty, force recompile
-          return @tick true
-
-      return unless #bundle.content > 0
-      with @inputs.socket!
-        \send Bundle.pack bundle.content
+        shader: Input.hot shader
+
+    tick: =>
+      { :socket, :shader } = @unwrap_all!
+
+      with Bundle.new Timetag.new!
+        \add content: { address: '/shader', types: 's', shader.shader }
+
+        types = @inputs.shader\type!\get 'uniforms'
+        for key, val in pairs shader.uniforms
+          type = types\get key
+          msg = Message.new "/uniform/#{key}"
+          add_item msg, type, val
+          \add msg
+
+        socket\send Bundle.pack .content
 
 Constant.meta
   meta:
@@ -197,4 +214,5 @@ Constant.meta
     :video
     'tsv-input': tsv_input
     :texture
-    :shader
+    shader: shader_
+    :draw
diff --git a/alv/ast.moon b/alv/ast.moon
index 52117c6..878dc10 100644
--- a/alv/ast.moon
+++ b/alv/ast.moon
@@ -32,8 +32,7 @@
   -- @function stringify
   -- @treturn string the exact string this Node was parsed from
 
-import Cell, RootCell, ArrayCell, StructCell from require 'alv.cell'
-import TemplateString from require 'alv.template_string'
+import Cell, RootCell, ArrayCell, StructCell, TemplateString from require 'alv.cell'
 import Constant from require 'alv.result.const'
 import Dummy from require 'alv.dummy'
 import Tag from require 'alv.tag'
diff --git a/alv/base/builtin.moon b/alv/base/builtin.moon
index 4b8ee5a..558a65a 100644
--- a/alv/base/builtin.moon
+++ b/alv/base/builtin.moon
@@ -6,7 +6,6 @@
 -- See `builtin` and `invoke` for examples.
 --
 -- @classmod Builtin
-import TemplateString from require 'alv.template_string'
 
 class Builtin
 --- Builtin interface.
@@ -108,16 +107,7 @@ class Builtin
     else
       builtin\setup nil
 
-    tail = {}
-    for child in *cell\tail!
-      if child.__class == TemplateString
-        table.insert tail, child.string
-        for inner in *child.children
-          table.insert tail, inner
-      else
-        table.insert tail, child
-
-    builtin\eval scope, tail
+    builtin\eval scope, cell\tail!
 
   __tostring: => "<#{@@__name}[#{@tag}] #{@head}>"
   __inherited: (cls) => cls.__base.__tostring = @__tostring
diff --git a/alv/base/init.moon b/alv/base/init.moon
index a5d0b88..f7eb0e2 100644
--- a/alv/base/init.moon
+++ b/alv/base/init.moon
@@ -20,7 +20,6 @@
 -- @see type.Primitive
 -- @see type.Array
 -- @see type.Struct
--- @see TemplateString
 -- @see RTNode
 -- @see Error
 
@@ -32,7 +31,7 @@ import Input from require 'alv.base.input'
 import const, sig, evt, any from require 'alv.base.match'
 import Constant, SigStream, EvtStream from require 'alv.result'
 import T, Primitive, Array, Struct from require 'alv.type'
-import TemplateString from require 'alv.template_string'
+import TemplateString from require 'alv.cell'
 import RTNode from require 'alv.rtnode'
 import Error from require 'alv.error'
 
@@ -51,7 +50,8 @@ import Error from require 'alv.error'
   -- Types
   :T, :Primitive, :Array, :Struct
 
-  :TemplateString
   :RTNode
   :Error
+
+  template_subst: TemplateString.subst
 }
diff --git a/alv/cell.moon b/alv/cell.moon
index 7f2c027..8d1e5f6 100644
--- a/alv/cell.moon
+++ b/alv/cell.moon
@@ -5,8 +5,9 @@
 -- nodes), a `Tag`, and optionally the internal whitespace as parsed.
 --
 -- @classmod Cell
-import T from require 'alv.type'
+import T, Array from require 'alv.type'
 import Constant from require 'alv.result'
+import Dummy from require 'alv.dummy'
 import Error from require 'alv.error'
 import op_invoke, fn_invoke from require 'alv.invoke'
 import Tag from require 'alv.tag'
@@ -23,6 +24,7 @@ parse_args = (tag, parts) ->
 
   tag, children, white
 
+--- @type Cell
 class Cell
 --- members
 -- @section members
@@ -109,19 +111,21 @@ class Cell
   -- @treturn string the exact string this Cell was parsed from, unless `@tag`
   -- changed
   stringify: (depth=-1) =>
+    nextdepth = if depth == -1 then -1 else depth - 1
+
     buf = ''
     buf ..= if depth > 0 then '' else @white[0]
     if depth == 0
       buf ..= '...'
     else
       for i, child in ipairs @children
-        buf ..= child\stringify if depth == -1 then -1 else depth - 1
+        buf ..= child\stringify nextdepth
         buf ..= if depth > 0 then ' ' else @white[i]
 
       if depth > 0
         buf = buf\sub 1, #buf - 1
 
-    tag = if depth == -1 then @tag\stringify! else ''
+    tag = @tag\stringify nextdepth
 
     '(' .. tag .. buf .. ')'
 
@@ -150,7 +154,7 @@ class Cell
     tag, children, white = parse_args ...
     Cell tag, children, white
 
--- @type RootCell
+--- @type RootCell
 class RootCell extends Cell
   head: => Constant.sym 'do'
   tail: => @children
@@ -180,7 +184,7 @@ class RootCell extends Cell
     _, children, white = parse_args nil, parts
     @@ nil, children, white
 
--- @type ArrayCell
+--- @type ArrayCell
 class ArrayCell extends RootCell
   head: => Constant.sym 'mkarray'
   tail: => @children
@@ -190,7 +194,7 @@ class ArrayCell extends RootCell
     Cell.__init @, ...
     assert #@children > 0, Error 'syntax', "array literal can't be empty"
 
--- @type StructCell
+--- @type StructCell
 class StructCell extends RootCell
   head: => Constant.sym 'mkstruct'
   tail: => @children
@@ -201,9 +205,88 @@ class StructCell extends RootCell
     assert #@children > 0, Error 'syntax', "struct literal can't be empty"
     assert #@children % 2 == 0, Error 'syntax', "struct literal can't have uneven number values"
 
+--- @type TemplateString
+class TemplateString extends Cell
+--- AST interface
+--
+-- `TemplateString` partially implements the `AST` interface.
+-- @section ast
+
+  --- stringify this TemplateString.
+  --
+  -- if `depth` is passed, does not faithfully recreate the original string but
+  -- rather create useful debug output.
+  --
+  -- @tparam[opt] int depth the maximum depth, defaults to infinite
+  -- @treturn string the exact string this TemplateString was parsed from
+  stringify: (depth=-1) =>
+    nextdepth = if depth == -1 then -1 else depth - 1
+
+    strings = [s\gsub '(["\\$])', '\\%1' for s in *@children[2].node.result!]
+    children = ['$' .. child\stringify nextdepth for child in *@children[3,]]
+    str = @@.subst strings, children
+
+    if depth > 0 and #str > 19
+      str = str\gsub '\n', '\\n'
+      str = (str\sub 1, 20) .. '…'
+
+    tag = @tag\stringify nextdepth
+    head = @children[1]\stringify nextdepth
+    "$#{tag}#{head}\"#{str}\""
+
+--- static functions
+-- @section static
+
+  --- apply substitutions to a template string.
+  --
+  -- Equivalent to `strings[1] .. children[1] .. strings[2] … strings[N+1]`
+  --
+  -- @tparam {string,...} strings the pieces of template string
+  -- @tparam {any,...} children the pieces to substitute
+  -- @treturn string
+  @subst: (strings, children) ->
+    assert #strings == #children + 1, "need one more string than child to substitute"
+
+    elems = {}
+    for i, string in ipairs strings
+      table.insert elems, string
+      table.insert elems, children[i]
+
+    table.concat elems
+
+  --- parse a TemplateString (for parsing with Lpeg).
+  --
+  -- @classmethod
+  -- @tparam string tag
+  -- @tparam string head
+  -- @tparam {string|AST,...} pieces
+  -- @treturn TemplateString
+  @parse: (tag, head, pieces) =>
+    if not pieces
+      tag, head, pieces = nil, tag, head
+
+    strings, children = {''}, {}
+    for elem in *pieces
+      if 'string' == type elem
+        strings[#strings] ..= elem
+      else
+        table.insert children, elem
+        table.insert strings, ''
+
+    if #strings == #children
+      table.insert strings, ''
+    assert #strings == #children + 1
+
+    strings = [s\gsub '\\(["\\$])', '%1' for s in *strings]
+
+    table.insert children, 1, head
+    table.insert children, 2, Dummy.literal (Array #strings, T.str), strings
+    @@ tag, children
+
 {
   :Cell
   :RootCell
   :ArrayCell
   :StructCell
+  :TemplateString
 }
diff --git a/alv/invoke.moon b/alv/invoke.moon
index a84b9e1..56e6511 100644
--- a/alv/invoke.moon
+++ b/alv/invoke.moon
@@ -3,7 +3,7 @@
 --
 -- @module invoke
 import RTNode from require 'alv.rtnode'
-import Builtin from require 'alv.base'
+import Builtin from require 'alv.base.builtin'
 import Scope from require 'alv.scope'
 import T from require 'alv.type'
 import Error from require 'alv.error'
diff --git a/alv/parsing.moon b/alv/parsing.moon
index e8cc5b6..0ae2586 100644
--- a/alv/parsing.moon
+++ b/alv/parsing.moon
@@ -29,13 +29,15 @@ fract = digit^1 * '/' * digit^1
 float = (digit^1 * '.' * digit^0) + (digit^0 * '.' * digit^1)
 num = ((P '-')^-1 * (float + fract + int)) / Constant\parse 'num'
 
-tplcont = ((P '\\"') + (P '\\\\') + (1 - (P '"') - (P '#')))^1 / 1
-tplstr = (P '#"') * ((P '##') / 1 + ('#' * (V 'expr')) + tplcont)^0 * '"' / TemplateString\parse
+tag = (P '[') * (digit^1 / Tag.parse) * (P ']')
+
+tpltext = ((P '\\"') + (P '\\\\') + (P '\\$') + (1 - (P '"') - (P '$')))^1 / 1
+tplcont = Ct ((P '$$') / 1 + ('$' * (V 'expr')) + tpltext)^0
+tplstr = (P '$') * tag^-1 * sym * '"' * tplcont * '"' / TemplateString\parse
 
 expitem = tplstr + (V 'expr')
 explist = Ct mspace * (expitem * (space * expitem)^0 * mspace)^-1
 
-tag = (P '[') * (digit^1 / Tag.parse) * (P ']')
 cell = (P '(') * tag^-1 * explist * (P ')') / Cell.parse
 array = (P '[') * explist * (P ']') / ArrayCell\parse
 struct = (P '{') * explist * (P '}') / StructCell\parse
@@ -53,6 +55,11 @@ cell = P {
   :expr
 }
 
+tplstr = P {
+  tplstr
+  :expr
+}
+
 program = root * -1
 
 --- exports
@@ -72,6 +79,7 @@ program = root * -1
   :atom
   :expr
   :explist
+  :tplstr
   :cell
   :root
   :program
diff --git a/alv/tag.moon b/alv/tag.moon
index 4b39bcb..d46bf0a 100644
--- a/alv/tag.moon
+++ b/alv/tag.moon
@@ -53,7 +53,7 @@ class Tag
     assert parent, "need parent to clone!"
     ClonedTag @, parent
 
-  stringify: => if @value then "[#{@value}]" else ''
+  stringify: (depth=-1) => if @value and depth == -1 then "[#{@value}]" else ''
   __tostring: => if @value then "#{@value}" else '?'
 
 --- internals for `Registry`
diff --git a/alv/template_string.moon b/alv/template_string.moon
deleted file mode 100644
index bd6ae0f..0000000
--- a/alv/template_string.moon
+++ /dev/null
@@ -1,83 +0,0 @@
-----
--- A string with substitutions, partially implements the `AST` interface.
---
--- Is automatically "splatted" into multiple expressions when the containing
--- `Cell` is evaluated: the original string (str=), but with with substitution
--- markers like `#{1}`, `#{2}` and so on and one expression for each substitution.
---
--- `#` symbols in the original string are escaped to `##`.
---
--- @classmod TemplateString
-import Constant from require 'alv.result'
-
--- @type TemplateString
-class TemplateString
---- AST interface
---
--- `TemplateString` partially implements the `AST` interface.
--- @section ast
-
-  --- create a clone with its own identity.
-  --
-  -- creates a clone of this TemplateString by cloning all child expressions
-  -- recursively.
-  --
-  -- @tparam Tag parent
-  -- @treturn TemplateString
-  clone: (parent) =>
-    children = [child\clone parent for child in *@children]
-    @@ @string, children
-
-  --- stringify this TemplateString.
-  --
-  -- if `depth` is passed, does not faithfully recreate the original string but
-  -- rather create useful debug output.
-  --
-  -- @tparam[opt] int depth the maximum depth, defaults to infinite
-  -- @treturn string the exact string this TemplateString was parsed from
-  stringify: (depth=-1) =>
-    children = ['#' .. child\stringify depth for child in *@children]
-    str = @@.subst @.string!, (i) -> '#' .. @children[i]\stringify depth
-    '#"' .. str .. '"'
-
---- static functions
--- @section static
-
-  new: (@string, @children) =>
-
-  --- apply substitutions to a template string.
-  --
-  -- This also reverses the escaping that the parser applied.
-  --
-  -- @classmethod
-  -- @tparam string str the evaluated `TemplateString.string`
-  -- @tparam function fn function called with index i to obtain string to substitute
-  -- @treturn string
-  @subst: (str, fn) ->
-    str = str\gsub '##', '#'
-    str\gsub '#{(%d+)}', (i) -> fn tonumber i
-
-  --- parse a TemplateString (for parsing with Lpeg).
-  --
-  -- @classmethod
-  -- @tparam {string|AST,...} pieces
-  -- @treturn TemplateString
-  @parse: (...) =>
-    string = ''
-    children = {}
-
-    i = 1
-    for elem in *{...}
-      string ..= if elem == '##' then elem
-      elseif 'string' == type elem then elem\gsub '#', '##'
-      else
-        table.insert children, elem
-        '#{' .. #children .. '}'
-
-    string = Constant.str string
-
-    @@ string, children
-
-{
-  :TemplateString
-}
diff --git a/spec/internal/parsing_spec.moon b/spec/internal/parsing_spec.moon
index 534155f..da70824 100644
--- a/spec/internal/parsing_spec.moon
+++ b/spec/internal/parsing_spec.moon
@@ -1,10 +1,10 @@
-import space, atom, cell, program, comment from require 'alv.parsing'
+import space, atom, cell, program, tplstr, comment from require 'alv.parsing'
 import Constant from require 'alv'
 import Logger from require 'alv.logger'
 Logger\init 'silent'
 
 verify_parse = (parser, val) ->
-  with assert parser\match val
+  with assert (parser\match val), "unable to parse '#{val}'"
     assert.is.equal val, \stringify!
 
 verify_parse_nope = (parser, val) ->
@@ -90,13 +90,6 @@ describe 'Cell', ->
     assert.is.equal 2, #node.children
     assert.is.equal 42, node.tag.value
 
-  test 'template strings', ->
-    node = verify_parse cell, '( hi #" string with #3#5 some #(= "contents") "
-                                "friend" )'
-
-    assert.is.equal 3, #node.children
-    assert.is.equal (Constant.str 'friend'), node.children[3]
-
 describe 'RootCell parsing', ->
   describe 'handles whitespace', ->
     verify = (str) ->
@@ -115,6 +108,37 @@ describe 'RootCell parsing', ->
     it 'everywhere', ->
       verify ' 3\tok-yes\n'
 
+describe 'TemplateString parsing', ->
+  test 'basic parsing', ->
+    verify_parse tplstr, '$hi"me"'
+    verify_parse tplstr, '$[123]hi"me"'
+    node = verify_parse tplstr, '$[123]hi" string with $3$5 some $(= "contents") "'
+
+    assert.is.equal 5, #node.children
+    assert.is.equal (Constant.sym 'hi'), node.children[1]
+    assert.is.same {' string with ', '', ' some ', ' '}, node.children[2]\eval!.result!
+    assert.is.equal (Constant.num 3), node.children[3]
+    assert.is.equal (Constant.num 5), node.children[4]
+    assert.is.equal (Constant.sym '='), node.children[5]\head!
+
+  test 'can be empty', ->
+    node = verify_parse tplstr, '$hi""'
+    assert.is.equal 2, #node.children
+    assert.is.equal (Constant.sym 'hi'), node.children[1]
+    assert.is.same {''}, node.children[2]\eval!.result!
+
+  test 'can contain escapes', ->
+    node = verify_parse tplstr, '$hi"hi\nmy \\$friend"'
+    assert.is.same {'hi\nmy $friend'}, node.children[2]\eval!.result!
+
+    node = verify_parse tplstr, '$hi"\\$(this would\\${3}be invalid!"'
+    assert.is.same {'$(this would${3}be invalid!'}, node.children[2]\eval!.result!
+
+  test 'can be applied', ->
+    node = verify_parse tplstr, '$[123]hi" string with $3$5 some $(= "contents") "'
+    substituted = node.__class.subst node.children[2]\eval!.result!, {123, "foot", " where "}
+    assert.is.equal " string with 123foot some  where  ", substituted
+
 test 'whitespace', ->
   assert.is.equal '  ', space\match '  '
   assert.is.equal '\n\t ', space\match '\n\t '