1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
-- ALV Cell type
import Value from require 'core.value'
import op_invoke, fn_invoke from require 'core.invoke'
import Tag from require 'core.tag'
-- An S-Expression with a head expression and any number of tail expressions,
-- an optional tag, and optionally the internal whitespace as parsed.
class Cell
-- AST interface
eval: (scope) =>
head = (@head!\eval scope)\const!
Action = switch head.type
when 'opdef'
-- scope\get 'op-invoke'
op_invoke
when 'fndef'
-- scope\get 'fn-invoke'
fn_invoke
when 'builtin'
head\unwrap!
else
error "cannot evaluate expr with head #{head}"
Action\eval_cell scope, @tag, head, @tail!
-- quoting a Cell recursively quotes children, but preserves identity. This
-- means that a quoted Cell may only be 'used' once. Use :clone() otherwise.
quote: (scope) =>
children = [child\quote scope for child in *@children]
Cell @tag, children, @white
-- creates a clone of this Cell with its own identity by prepending a `parent`
-- tag and cloning all child expressoins recursively.
clone: (parent) =>
tag = @tag\clone parent
children = [child\clone parent for child in *@children]
Cell tag, children, @white
stringify: (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 depth - 1
buf ..= if depth > 0 then ' ' else @white[i]
if depth > 0
buf = buf\sub 1, #b@uf - 1
'(' .. @tag\stringify! .. buf .. ')'
-- internal
-- tag: the parsed Tag
-- children: sequence of child AST Nodes
-- white: optional sequence of whitespace segments ([0 .. #@children])
new: (@tag=Tag.blank!, @children, @white) =>
if not @white
@white = [' ' for i=1,#@children]
@white[0] = ''
assert #@white == #@children, "mismatched whitespace length"
head: => @children[1]
tail: => [c for c in *@children[2,]]
-- static
__tostring: => @stringify 2
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
@parse: (...) =>
tag, children, white = parse_args ...
@ tag, children, white
-- A parenthesis-less Cell (root of an ALV document).
--
-- has an implicit head of 'do'.
class RootCell extends Cell
head: => Value.sym 'do'
tail: => @children
stringify: =>
buf = ''
buf ..= @white[0]
for i, child in ipairs @children
buf ..= child\stringify!
buf ..= @white[i]
buf
@parse: (...) =>
@__parent.parse @, (Tag\parse '0'), ...
{
:Cell
:RootCell
}
|
