forked from min-lang/min
-
Notifications
You must be signed in to change notification settings - Fork 0
/
group.m
212 lines (173 loc) · 9.61 KB
/
group.m
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
# delimited, lexical sub-term, glue / associate
http://en.wikipedia.org/wiki/Indent_style
rev_exps_trees spot:!Spot rev_exps:Exps trees:Exps : Exps =
| rev_exps &
| rev_exps.List.tail &
exps = List.rev rev_exps
((spot | Exp.spot2 exps.List.head rev_exps.List.head), Tree exps), trees
|
x = rev_exps.List.head
(spot & (spot, x.Exp.tree) | x), trees # singleton tree
| trees # empty tree
# f [] = 0
# f [a] = a
# f [b, a] s = Tree (;, a, b)
# f [c, b, a] = Tree (;, a, (;, b, c))
# : Term
rev_exps_op_semi rev_exps:Exps : !Exp =
| rev_exps &
| rev_exps.List.tail &
spot, tree = rev_exps.List.head
spot, Tree [(spot, tree), (spot, Op ';'), rev_exps_op_semi rev_exps.List.tail]
| rev_exps.List.head
# add rev seq of exps as a sequence of steps to trees of exps
# f [] s = s
# f [a] s = a, s
# f [b, a] s = Tree (;, a, b), s
# f [c, b, a] s = Tree (;, a, (;, b, c)), s
# : Exp
rev_exps_steps rev_exps:Exps trees:Exps : Exps =
exp = rev_exps_op_semi rev_exps.List.rev
| exp & exp, trees
| trees # empty tree
exps_trees_at space:N line_exps:Exps block_trees:Exps : Exps ? Exps, Exps =
(spot, Level space0), exps?
| (_, Level _? 1) exps.List.opt0 & # skip consecutive newlines
exps_trees_at space line_exps block_trees exps
| space0 < space & # pop, keep exps.head to keep popping
#Type.log ((rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps))
#Type.log ((spot, Level space0), exps)
(rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps)
| space0 > space & # sub-block
block, exps2 = exps_trees_at space0 0 0 exps
| space0 == space + 1 & # arguments
exps_trees_at space block.List.rev+line_exps block_trees exps2
| # space0 == space + 2 # steps
exps_trees_at space (rev_exps_steps block.List.rev line_exps) block_trees exps2
| # space0 == space &
exps_trees_at space0 0 (rev_exps_trees 0 line_exps block_trees) exps # same line
exp, exps? exps_trees_at space (exp, line_exps) block_trees exps
? (rev_exps_trees 0 line_exps block_trees).List.rev, [] # line_exps == 0 if there's a trailing newline
# linear terms to tree terms
# a$. b c$. d e --> a (b c) (d e)
# a$. b c$. d e --> a (; (b c) (d e))
# : inner-block:*exp, remaining-exps:Terms
exps_trees_at space:N line_exps:Exps block_trees:Exps : Exps ? Exps, Exps =
(spot, Level space0), exps?
| (_, Level _? 1) exps.List.opt0 & # skip consecutive newlines
exps_trees_at space line_exps block_trees exps
| space0 < space & # pop, keep exps.head to keep popping
(rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps)
| space0 > space & # sub-block
block, exps2 = exps_trees_at space0 0 0 exps
| space0 == space + 1 & # arguments
exps_trees_at space block.List.rev+line_exps block_trees exps2
| # space0 == space + 2 # steps
exps_trees_at space (rev_exps_steps block.List.rev line_exps) block_trees exps2
| # space0 == space &
exps_trees_at space0 0 (rev_exps_trees 0 line_exps block_trees) exps # same line
exp, exps? exps_trees_at space (exp, line_exps) block_trees exps
? (rev_exps_trees 0 line_exps block_trees).List.rev, [] # line_exps == 0 if there's a trailing newline
exps_trees x:Exps : Exps = exps_trees_at 0 0 0 x . 0
# limit: a '(' b c' )' d --> a (b c) d
# : inner-groups:*exp, end-exp:Exp remaining-exp:*exp
limit_exps_to groups:Exps end_char:!S : Exps ? Exps, !Spot, Exps =
(spot, Op '('), exps?
groups2, end_spot, exps2 = limit_exps_to 0 ')' exps # sub-group
end_spot | Exp.seq_error $Fun 'missing )' groups2
# must use end-exp with exp2_spot to calculate the largest span of positions for [glue_exp] below, e.g. x+(y + z)
spot2 = Spot.spot2 spot end_spot
limit_exps_to (rev_exps_trees spot2 groups2 groups) end_char exps2
(spot, Op '['), exps?
groups2, end_spot, exps2 = limit_exps_to 0 ']' exps
end_spot | Exp.seq_error $Fun 'missing ]' groups2
# [a,b] vs [a, b] vs [f x], hence invalid to append ,0 since a,b,0 but f x,0 vs (f x), 0 - fix glue_exps
# [a, (b, c)] vs [a, b, c], hence invalid to rewrite as (list (a, (b, c))) which is the same as (list (a, b, c)) - fix associate_exps
# [a, b] vs [(a, b)], hence list vs list1 - fix List.size groups2
list =
| groups2 &
glued = groups2.List.rev.glue_exps
spot1 = groups2.List.head.Exp.spot.Spot.end # list's last element
spot2 = Spot.spot2 spot1 end_spot # list's end marker
spot0 = Spot.spot2 spot end_spot # the whole list
spot3 = !groups2 > 1 & !glued > 1 & spot2 | spot1 # [f a] or [(a, b)]
#exps_spot_exp spot0 ((spot2, Nat 0), (spot3, Op ','), groups2).List.rev
spot0, Tree [(spot2, Name 'List'), (spot2, Tree ((spot2, Nat 0), ((spot3, Op ','), groups2)).List.rev)]
# spot0, Tree [(spot2, Name 'List'), (spot2, Tree groups2.List.rev)]
| end_spot, Nat 0
limit_exps_to list,groups end_char exps2 # [a,b] => list (a,b)
(spot, Op o), exps & end_char & o == end_char? groups, spot, exps
(_, Tree s), exps?
limit_exps_to (exps_exp (limit_exps_to 0 end_char s).0, groups) end_char exps
exp, exps? limit_exps_to exp,groups end_char exps
? List.rev groups, 0, 0
limit_exps exps:Exps : Exps = limit_exps_to 0 0 exps . 0
exps_exp exps:Exps : Exp = exps.List.tail & Exp.spot_new exps.List.head, Tree exps | exps.List.head
exps_spot_exp spot:Spot exps:Exps : Exp = exps.List.tail & spot, Tree exps | exps.List.head
# left-leaning: a, b --> (, a b) not (, a) b
# right-associative: a, b, c --> a, (b, c) not (a, b), c
op_lean name:S : B = List.in S.eq [';', ',', '?'] name
# glue tight adjucent-column exps: a b+c d --> a (b + c) d
# [glue] comes after [limit], else f (x + y) becomes f [(x] + [y)]
glue_exps_to groups:Exps : Exps? Exps =
exp, exps?
_, _, _, line0, column0 = exp.Exp.spot
_, line11, column11, line12, column12 = exps.List.opt0.Exp.spot_new
_, line2, column2, _ = exps.List.opt1.Exp.spot_new
exp .
_ & line11 == line0 & column11 == column0 & (!((_, Op o? op_lean o) exps.0) | line2 == line12 & column2 == column12)?
glue_exps_to (glue_exp exp, groups) exps
_, Tree s?
exps_exp (List.rev (exps_exp (glue_exps s), groups)), glue_exps exps
? exps_exp (List.rev (exp, groups)), glue_exps exps
? groups
glue_exps exps:Exps : Exps = glue_exps_to 0 exps
glue_exp : Exp? Exp =
_, Tree s? exps_exp (glue_exps s)
a? a
# split a + b ^ c = [a], +, [b ^ c] where + has a lower rank/precedence than ^
#split_exps left:Exp op:Exp rank:N right:Exp exps:Exps : left:Exps, op:Exp, right:Exps =
split_exps left:Exps op:!Exp rank:N right:Exps exps0:Exps : Exps = exps0,op .
exp,exps, _?
rank2 = (_, Op o? Op.rank o) exp
same = (_, Op o? Op.right o) exp
| rank2 & (same & rank2 < rank | rank2 <= rank) &
# given f x + g y = h z
# at reading op=, x f, +, y g
# change left to y g + x f for f x + g y reversed
right2 = op & (op, right.List.rev) | right.List.rev
split_exps (left.List.rev + right2).List.rev exp rank2 0 exps
|
split_exps left op rank exp,right exps
_, (spot, Op op2)?
left2 = left & exps_exp (associate_exps left.List.rev)
right0 = right & associate_exps right.List.rev
#right2 = right & exps_exp (associate_exps right.List.rev)
right2 = right,right0 .
[(_, Tree _)], [(_, Binary _ ',' _)] & op2 == ','? spot, Tree right0
? right & exps_exp right0
| left & right & op2 == '|' & left2.Exp.tree .
Binary a '&' b & !left > 1? [(spot, Tree [(spot, Name 'op_if'), a, b, right2])] # a & b | c -> op_if a b c
? [(spot, Tree [(spot, Name 'op_if0'), left2, right2])] # a | b -> op_if0 a b
| left & right & [(spot, Binary left2 op2 right2)] # (a & b) | c -> (a & b) | c
| left & [(spot, Post left2 op2)]
| right & [(spot, Pre op2 right2)]
# associate by operator precedence: a + b ^ c --> a + (b ^ c)
associate_exps exps:Exps : Exps = exps & (split_exps 0 0 0ffff 0 exps | exps associate_exp) # 0ffff = max precedence
associate_exp : Exp? Exp =
_, Tree s? exps_exp (associate_exps s)
a? a
exps s:Exps : Exps = s.exps_trees.limit_exps.glue_exps.associate_exps
of x:S : S = x.Exp.str_exps.exps.0.Exp.str
#of x:S : S = x.Exp.str_exps.exps.0.Exp.str.Log.id
Fact (of 'a' == 'a')
Fact (of 'a+b' == '(a + b)')
Fact (of 'f a+b' == '(f (a + b))')
Fact (of 'a,b' == '(a, b)')
Fact (of 'a,b,c' == '(a, (b, c))')
Fact (of 'a,(b,c)' == '(a, ((b, c)))')
Fact (of 'x = a, b' == '(x = (a, b))')
Fact (of 'a+[b]' == '(a + (List (b, 0)))')
Fact (of '[a,b]' == '(List (a, (b, 0)))')
Fact (of '[a,b,c]' == '(List (a, (b, (c, 0))))')
Fact (of '[a,(b,c)]' == '(List (a, ((b, c), 0)))')