template strings as syntax sugar for Ops

8 files changed, 107 insertions, 110 deletions

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
-}