path: root/alv/cell.moon

----
-- S-Expression Cell, implements the `AST` interface.
--
-- Consists of a head expression and any number of tail expressions (both `AST`
-- nodes), a `Tag`, and optionally the internal whitespace as parsed.
--
-- @classmod Cell
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'

parse_args = (tag, parts) ->
  if not parts
    parts, tag = tag, nil

  children, white = {}, { [0]: parts[1] }

  for i = 2,#parts,2
    children[i/2] = parts[i]
    white[i/2] = parts[i+1]

  tag, children, white

--- @type Cell
class Cell
--- members
-- @section members

  --- get the head of the cell.
  --
  -- @treturn AST
  head: => @children[1]

  --- get the tail of the cell.
  --
  -- @treturn {AST,...}
  tail: => [c for c in *@children[2,]]

  __tostring: => @stringify 2

  --- the parsed Tag.
  --
  -- @tfield Tag tag

  --- sequence of child AST Nodes
  --
  -- @tfield {AST,...} children

  --- optional sequence of whitespace segments.
  --
  -- If set, `whitespace[i]` is the whitespace between `children[i]` and
  -- `children[i+1]`, or the closing parenthesis of this Cell. `whitespace[0]`
  -- is the space between the opening parenthesis and `children[1]`.
  --
  -- @tfield ?{string,...} whitespace

--- AST interface
--
-- `Cell` implements the `AST` interface.
-- @section ast

  --- evaluate this Cell.
  --
  -- `AST:eval`uates the head of the expression, and finds the appropriate
  -- `Builtin` to invoke:
  --
  -- - if head is an `opdef`, use `invoke.op_invoke`
  -- - if head is a `fndef`, use `invoke.fn_invoke`
  -- - if head is a `builtin`, unwrap it
  --
  -- then calls `Builtin:eval_cell` on it.
  --
  -- @tparam Scope scope the scope to evaluate in
  -- @treturn RTNode the evaluation result
  eval: (scope) =>
    head = assert @head!, Error 'syntax', "cannot evaluate empty expr"
    head = (head\eval scope)\const!
    Builtin = switch head.type
      when T.opdef
        op_invoke
      when T.fndef
        fn_invoke
      when T.builtin
        head\unwrap!
      else
        error Error 'type', "#{head} is not an opdef, fndef or builtin"

    Builtin\eval_cell @, scope, head

  --- create a clone with its own identity.
  --
  -- creates a clone of this Cell with its own identity by prepending a `parent`
  -- to `tag` and cloning all child expressions recursively.
  --
  -- @tparam Tag parent
  -- @treturn Cell
  clone: (parent) =>
    tag = @tag\clone parent
    children = [child\clone parent for child in *@children]
    @@ tag, children, @white

  --- stringify this Cell.
  --
  -- 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 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 nextdepth
        buf ..= if depth > 0 then ' ' else @white[i]

      if depth > 0
        buf = buf\sub 1, #buf - 1

    tag = @tag\stringify nextdepth

    '(' .. tag .. buf .. ')'

--- static functions
-- @section static

  --- construct a new Cell.
  --
  -- @classmethod
  -- @tparam[opt] Tag tag
  -- @tparam {AST,...} children
  -- @tparam[opt] {string,...} white whitespace strings
  new: (@tag=Tag!, @children, @white) =>
    if not @white
      @white = [' ' for i=1,#@children]
      @white[0] = ''

    assert #@white == #@children, "mismatched whitespace length"

  --- parse a Cell (for parsing with Lpeg).
  --
  -- @tparam[opt] Tag tag
  -- @tparam table parts
  -- @treturn Cell
  @parse: (...) ->
    tag, children, white = parse_args ...
    Cell tag, children, white

--- @type RootCell
class RootCell extends Cell
  head: => Constant.sym 'do'
  tail: => @children

  new: (tag=(Tag "root"), ...) => super tag, ...

  stringify: =>
    buf = ''
    buf ..= @white[0]

    for i, child in ipairs @children
      buf ..= child\stringify!
      buf ..= @white[i]

    buf

  --- parse a root Cell (for parsing with Lpeg).
  --
  -- Root-Cells are at the root of an ALV document.
  -- They have an implicit head of 'do' and a `[0]` tag.
  --
  -- @tparam table parts
  -- @treturn Cell
  @parse: (parts) =>
    _, children, white = parse_args nil, parts
    @@ nil, children, white

--- @type ArrayCell
class ArrayCell extends RootCell
  head: => Constant.sym 'mkarray'
  tail: => @children
  stringify: => '[' .. super! .. ']'

  eval: (...) =>
    assert #@children > 0, Error 'syntax', "array literal can't be empty"
    super ...

  new: (tag=(Tag "array"), ...) => Cell.__init @, tag, ...

--- @type StructCell
class StructCell extends RootCell
  head: => Constant.sym 'mkstruct'
  tail: => @children
  stringify: => '{' .. super! .. '}'

  eval: (...) =>
    assert #@children > 0, Error 'syntax', "struct literal can't be empty"
    assert #@children % 2 == 0, Error 'syntax', "struct literal must have even number of values"
    super ...

  new: (tag=(Tag "struct"), ...) => Cell.__init @, tag, ...

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