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
|
import Const from require 'core.const'
import op_invoke, fn_invoke from require 'core.invoke'
import Tag from require 'core.tag'
class Cell
-- common
new: (@tag, @children, @white) =>
if not @white
@white = ['' for i=1,#@children+1]
if not @tag
@tag = Tag.blank!
head: => @children[1]
tail: => [c for c in *@children[2,]]
destroy: =>
-- AST interface
eval: (scope) =>
head = @head!\eval scope
Action = switch head.type
when 'opdef'
-- scope\get 'op-invoke'
op_invoke
when 'fndef'
-- scope\get 'fn-invoke'
fn_invoke
when 'builtin'
head\getc!
else
print head
for k,v in pairs head
print k,v
print head.__class.__name
error "cannot evaluate expr with head #{head}"
action = Action\get_or_create head, @tag
action\eval scope, @tail!
quote: (scope) =>
children = [child\quote scope for child in *@children]
Cell @tag, children, @white
clone: (parent) =>
@tag\ensure!
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 .. ')'
-- 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
class RootCell extends Cell
head: => Const.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
|
