blob: 20738cd1ceb6d9090367c9ae0cecd172c651d506 (
plain)
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
|
MakeVar โ { program ๐ name:
vโ@
Get โ !โ"Runtime: Variable referenced before definition"
SetU โ !โ"โฉ: Variable modified before definition"
SetN โ {
Get โฉ {๐คโv}
(SetU โฉ {vโฉ๐ฉ}) ๐ฉ
}
SetQ โ 0โSetN
GetC โ {
r โ Get๐ฉ
GetโฉSetUโฉSetNโฉ!โ"Internal error: Variable used after clear"
r
}
GetF โ {program ๐ฉ.Field name}
}
vnot โ { SetUโSetNโโข โ SetQโ0ห }
MakeEnv โ { ๐pโฟvโฟnโฟe:
ns โ v-โ n # Number of special names
parent โ p
program โ p.program
vars โ programโธMakeVarยจ (nsโฅยฏ1) โพ n
MakeNS โ {๐ค
v โ @ โฃยดยจ n โ nsโvars # Lookup table
Field โ {๐จ๐i:
cross โ ๐จ { ๐จ1โโก๐ฉ ? โข ; โ ๐ฉ.names โ โโ๐จ.names } program
(Cross i) โ v
}
}
}
VO โ { dโ๐@, sโ๐@, sโยท{๐ฉ.vars}{๐ฉ.parent}โd }
nothing โ {โ}
skipMark โ {โ}
Namespace โ {๐ฉ.MakeNS@}
ReadNS โ { eโฟi ๐ ๐ฉ:
"Key lookup in non-namespace" ! 6=โขType๐ฉ
(e.program ๐ฉ.Field i).Get @
}
ref โ {
Matcher โ {๐ const:
SetQ โ constห โข โข
}
Array โ {๐ arr:
Get โ {๐ฉ.Get@}ยจ arrห
_set_ โ {S _๐ฃ_ e:
Err โ {(eโพ": "โพ๐ฉ)!eโก@ โ โจ1โฉ}
{
0=โขType๐ฉ ? arr โกโโขโถโจErrโ"Target and value shapes don't match", Sยจโฉ ๐ฉ ;
# TODO "Cannot extract non-name from namespace" if ๐จ.GetF doesn't exist
6=โขType๐ฉ ? Sโ({(๐จ.GetF ๐ฉ).Get@}โ๐ฉ)ยจ arr ;
Err "Multiple targets but atomic value"
}
}
SetN โ {๐จ.SetN๐ฉ}_set_"โ"
SetU โ {๐จ.SetU๐ฉ}_set_"โฉ"
SetQ โ โจยด {๐จ.SetQ๐ฉ}_set_@โโจ1โฉ # TODO fix GetF errors and avoid โ
}
Alias โ {envโฟname ๐ r:
SetNโฟSetUโฟSetQ โ r
GetF โ {env.program ๐ฉ.Field name}
}
}
Get โ {๐ฉ.Get @}โ0
MakeStack โ {
s โ ๐ฉ # Stack (a list)
cont โ 1 # Whether to continue execution
rslt โ skipMark # Result: skipMark to abort current body
Push โ {sโพโฉ<๐ฉ} # Push a value
Pop โ {tโ-๐ฉ โ (sโหโฉt) โข โฝtโs} # Pop ๐ฉ values; return as list
Peek โ {๐คโยฏ1โs} # Return but don't pop top value
Ret โ {rsltโฉ๐ฉ โ contโฉ0 โ "Internal compiler error: Wrong stack size"!๐จโฅโ s}
Skip โ {๐คโ contโฉ0}
}
ops โ ((!โ"Unknown opcode")หโฃยดโข)ยจ โห โ> โจ
# Constants and drop
0โฟ{iโ๐@ โ {s๐e: s.Push iโe.program.consts } }
1โฟ{iโ๐@ โ {s๐e: s.Push e {๐๐ฉ}ห iโe.program.blocks } }
6โฟ( {s๐e: s.Pop 1 }ห)
# Returns
7โฟ( {s๐e: 0 s.Ret โs.Pop 1 }ห)
8โฟ( {s๐e: 1 s.Ret Namespace e }ห)
# Arrays
11โฟ{iโ๐@ โ {s๐e: s.Push โฝs.Pop i } }
12โฟ{iโ๐@ โ {s๐e: s.Push ref.Array โฝs.Pop i } }
# Application
16โฟ( {s๐e: s.Push { fโฟx: F x } s.Pop 2 }ห)
17โฟ( {s๐e: s.Push { wโฟfโฟx: w F x } s.Pop 3 }ห)
20โฟ( {s๐e: s.Push { gโฟh: G H } s.Pop 2 }ห)
21โฟ( {s๐e: s.Push { fโฟgโฟh: F G H } s.Pop 3 }ห)
26โฟ( {s๐e: s.Push { fโฟm : F _m } s.Pop 2 }ห)
27โฟ( {s๐e: s.Push { fโฟmโฟg: F _m_ g } s.Pop 3 }ห)
# Application with Nothing
18โฟ( {s๐e: s.Push { fโฟx: Fโ(nothingโธโข) x } s.Pop 2 }ห) # Like 16
19โฟ( {s๐e: s.Push { wโฟfโฟx: (nothingโขwห)โถโจF,wหโธFโฉโ(nothingโธโข) x } s.Pop 3 }ห) # Like 17
23โฟ( {s๐e: s.Push { fโฟgโฟh: {fโกnothing?G H;F G H} } s.Pop 3 }ห) # Like 21
22โฟ( {s๐e: "Left argument required" ! nothingโขs.Peek@ }ห)
# Variables
32โฟ{vโVO๐ฉโ {s๐e: s.Push (V e).Get @ } }
34โฟ{vโVO๐ฉโ {s๐e: s.Push (V e).GetC@ } }
33โฟ{vโVO๐ฉโ {s๐e: s.Push V e } }
# Headers
42โฟ( {s๐e: {0:s.Skip@; 1:@; ๐:!"Predicate value must be 0 or 1"} โs.Pop 1 }ห)
43โฟ( {s๐e: s.Push ref.Matcher โs.Pop 1 }ห)
44โฟ( {s๐e: s.Push vnot }ห)
# Assignment
47โฟ( {s๐e: s.Skipโโข{rโฟ v: r.SetQ v } s.Pop 2 }ห) # r:
48โฟ( {s๐e: s.Push { rโฟ v: r.SetNโธโข v } s.Pop 2 }ห) # r โv
49โฟ( {s๐e: s.Push { rโฟ v: r.SetUโธโข v } s.Pop 2 }ห) # r โฉv
50โฟ( {s๐e: s.Push { rโฟfโฟx: r.SetUโธโข (r.Get@)F x } s.Pop 3 }ห) # r Fโฉx
51โฟ( {s๐e: s.Push { rโฟf : r.SetUโธโข F r.Get@ } s.Pop 2 }ห) # r Fโฉ
# Namespaces
64โฟ{iโ๐@ โ {s๐e: s.Push eโฟi ReadNS โs.Pop 1 } }
66โฟ{iโ๐@ โ {s๐e: s.Push eโฟi ref.Alias โs.Pop 1 } }
โฉ
RunBC โ { bcโฟposโฟenv:
Next โ {๐คโ (pos+โฉ1) โข posโbc }
stack โ MakeStack โจโฉ
Step โ {๐:
op โ (Next@) โ ops
op โฉ Op next
stack Op env
stack.cont
}
_while_ โ {๐ฝโ๐พโ๐ฝ_๐ฃ_๐พโ๐ฝโ๐พ๐ฉ}
Step _while_ โข 1
stack.rslt
}
{ VM bcโฟconstsโฟblockInfoโฟbodyInfoโฟlocโฟtoken:
bodies โ {startโฟvarsโฟnamesโฟexport:
{parent ๐ args:
env โ MakeEnv parentโฟvarsโฟnamesโฟexport
(โข {๐ฉ.SetN ๐จ}ยจ โ โenv.varsห) args
RunBC bcโฟstartโฟenv
}
}ยจ bodyInfo
blocks โ {typeโฟimmโฟbody:
inner โ imm โ type โ โจ
2โฅโจ{๐n: N โจโฉ}โฉ
{๐n: {dโN ๐ฃโฟ๐ โ๐จD๐ฉ}}โฟ{๐n: {N ๐ฃโฟ๐ }}
{๐n: {dโN ๐ฃโฟ๐โฟ๐โ๐จD๐ฉ}}โฟ{๐n: {N ๐ฃโฟ๐โฟ๐}}
โฉ
outer โ imm โ โจ
{
mโฟd: {๐v: {M ๐คโฟ๐ฉโฟnothingโพv;D ๐คโฟ๐ฉโฟ๐จโพv}} ;
โจbโฉ: {๐v: {B ๐คโฟ๐ฉโฟ(๐จโฃnothing)โพv}}
}
โ
โฉ
nmc โ "No matching case"
Then โ {first ๐ next: {skipMarkโขrโ๐จFirst๐ฉ ? r ; ๐จNext๐ฉ}}
run โ {
1=โขType ๐ฉ ?
โจ(๐ฉโbodies) Then {!โnmc}โฉ
;
"Internal compiler error: Invalid body indices" ! 1==๐ฉ
! (โ ๐ฉ) โก 2-imm
e โ {imm ? โจnmcโฉ ;
(0=โ ยจ๐ฉ) nmcโโฃยจ "Left argument "โธโพยจโจ"not allowed","required"โฉ
}๐ฉ
๐ฉ Thenยดโ(โโbodies)หโ{!โ๐ฉ}ยจ e
} body
{๐ parent:
Inner Outer {parentห ๐ โข}ยจ run
}
}ยจ blockInfo
program โ {
constsโconsts
blocksโblocks
namesโ0โ2โtoken
}
(โblocks){๐ฝ} {programโprogram}
}
|
