|
1 /* |
|
2 |
|
3 Code in Scala for the paper |
|
4 |
|
5 From System F to Typed Assembly Language |
|
6 |
|
7 by Morrisett, Walker, Crary and Glew |
|
8 |
|
9 The interesting feature is that the compiler deals with closure conversions |
|
10 and hoisting of nested functions. |
|
11 |
|
12 It works with Scala 3 (scala-cli) by typing |
|
13 |
|
14 $ scala-cli SystemF-compiler.sc |
|
15 |
|
16 */ |
|
17 |
|
18 |
|
19 type Num = Int |
|
20 type Idn = String |
|
21 |
|
22 var counter = -1 |
|
23 // for generating new variables |
|
24 |
|
25 def Fresh(x: Idn) = { |
|
26 counter += 1 |
|
27 x ++ "_" ++ counter.toString() |
|
28 } |
|
29 |
|
30 def commas(s: List[String]) : String = s match { |
|
31 case Nil => "" |
|
32 case s::Nil => s |
|
33 case s::ss => s + "," + commas(ss) |
|
34 } |
|
35 def cutlines(s: List[String]) : String = s match { |
|
36 case Nil => "" |
|
37 case s::ss => s + "\n" + cutlines(ss) |
|
38 } |
|
39 |
|
40 |
|
41 abstract class Prim |
|
42 case class PLUS() extends Prim { override def toString = "+" } |
|
43 case class MINUS() extends Prim { override def toString = "-" } |
|
44 case class MULT() extends Prim { override def toString = "*" } |
|
45 |
|
46 abstract class FTerm |
|
47 case class FVar(x : Idn) extends FTerm { override def toString = x } |
|
48 case class FNum(i : Num) extends FTerm { override def toString = i.toString } |
|
49 case class FFix(x : Idn, x1: Idn, e : FTerm) extends FTerm { |
|
50 override def toString = s"fix $x ($x1).$e" |
|
51 } |
|
52 case class FApp(e1 : FTerm, e2 : FTerm) extends FTerm { |
|
53 override def toString = s"($e1) ($e2)" |
|
54 } |
|
55 case class FTuple(es : List[FTerm]) extends FTerm { |
|
56 override def toString = s"<${commas(es.map(_.toString))}>" |
|
57 } |
|
58 case class FProj(i : Num, e : FTerm) extends FTerm { |
|
59 override def toString = s"proj$i $e" |
|
60 } |
|
61 case class FPrimOp(e1 : FTerm, p : Prim, e2 : FTerm) extends FTerm { |
|
62 override def toString = s"$e1 $p $e2" |
|
63 } |
|
64 case class FIf0(e1 : FTerm, e2 : FTerm, e3 : FTerm) extends FTerm { |
|
65 override def toString = s"if0($e1, $e2, $e3)" |
|
66 } |
|
67 |
|
68 |
|
69 abstract class KTerm |
|
70 abstract class KVal |
|
71 |
|
72 case class KApp(v : KVal, vs : List[KVal]) extends KTerm { |
|
73 override def toString = s"v(${commas(vs.map(_.toString))})" |
|
74 } |
|
75 case class KIf0(v : KVal, e1 : KTerm, e2 : KTerm) extends KTerm { |
|
76 override def toString = s"if0($v, $e1, $e2)" |
|
77 } |
|
78 case class KHalt(v : KVal) extends KTerm { override def toString = "halt " + v } |
|
79 case class KLet(x : Idn, v : KVal, e : KTerm) extends KTerm { |
|
80 override def toString = s"let $x = $v in $e" |
|
81 } |
|
82 case class KLetProj(x : Idn, i : Num, v : KVal, e : KTerm) extends KTerm { |
|
83 override def toString = s"let $x =$i $v in $e" |
|
84 } |
|
85 case class KLetPrimOp(x : Idn, v1 : KVal, p : Prim, v2 : KVal, e : KTerm) extends KTerm { |
|
86 override def toString = s"let x = $v1 $p $v2 in $e" |
|
87 } |
|
88 |
|
89 |
|
90 case class KVVar(x : Idn) extends KVal { override def toString = x } |
|
91 case class KVNum(i : Num) extends KVal { override def toString = i.toString } |
|
92 case class KVTuple(vs : List[KVal]) extends KVal { |
|
93 override def toString = s"<${commas(vs.map(_.toString))}>" |
|
94 } |
|
95 case class KVFix(x : Idn, args : List[Idn], e : KTerm) extends KVal { |
|
96 override def toString = s"fix $x (${commas(args)}). $e" |
|
97 } |
|
98 |
|
99 // CPS tail translation |
|
100 def CPST(e: FTerm) : (KVal => KTerm) = e match { |
|
101 case FVar(x) => (c: KVal) => KApp(c, List(KVVar(x))) |
|
102 case FNum(i) => (c: KVal) => KApp(c, List(KVNum(i))) |
|
103 case FIf0(e1, e2, e3) => (c: KVal) => { |
|
104 val e1_prime = CPS(e1) |
|
105 val e2_prime = CPST(e2) |
|
106 val e3_prime = CPST(e3) |
|
107 e1_prime((y: KVal) => KIf0(y, e2_prime(c), e3_prime(c))) |
|
108 } |
|
109 case FPrimOp(e1, op, e2) => (c: KVal) => { |
|
110 val z = Fresh("z") |
|
111 val e1_prime = CPS(e1) |
|
112 val e2_prime = CPS(e2) |
|
113 e1_prime((y1: KVal) => |
|
114 e2_prime((y2: KVal) => |
|
115 KLetPrimOp(z, y1, op, y2, KApp(c, List(KVVar(z)))))) |
|
116 } |
|
117 case FFix(x, x1, e) => (c: KVal) => { |
|
118 val c_prime = Fresh("c'") |
|
119 val e_prime = CPST(e) |
|
120 KApp(c, List(KVFix(x, List(x1, c_prime), e_prime(KVVar(c_prime))))) |
|
121 } |
|
122 case FApp(e1, e2) => (c: KVal) => { |
|
123 val e1_prime = CPS(e1) |
|
124 val e2_prime = CPS(e2) |
|
125 e1_prime((y1: KVal) => |
|
126 e2_prime((y2: KVal) => |
|
127 KApp(y1, List(y2, c)))) |
|
128 } |
|
129 case FTuple(es) => (c: KVal) => { |
|
130 def aux(es: List[FTerm], vs: List[KVal]) : KTerm = es match { |
|
131 case Nil => KApp(c, vs.reverse) |
|
132 case (e::es) => CPS(e)((y: KVal) => aux(es, y::vs)) |
|
133 } |
|
134 aux(es, Nil) |
|
135 } |
|
136 case FProj(i, e) => (c: KVal) => { |
|
137 val z = Fresh("z") |
|
138 CPS(e)((y: KVal) => KLetProj(z, i, y, KApp(c, List(KVVar(z))))) |
|
139 } |
|
140 } |
|
141 |
|
142 // CPS translation |
|
143 def CPS(e: FTerm) : (KVal => KTerm) => KTerm = e match { |
|
144 case FVar(i) => (k: KVal => KTerm) => k(KVVar(i)) |
|
145 case FNum(i) => (k: KVal => KTerm) => k(KVNum(i)) |
|
146 case FFix(x, x1, e) => (k: KVal => KTerm) => { |
|
147 val c = Fresh("c") |
|
148 val e_prime = CPST(e) |
|
149 k(KVFix(x, List(x1, c), e_prime(KVVar(c)))) |
|
150 } |
|
151 case FApp(e1, e2) => (k: KVal => KTerm) => { |
|
152 val fr = Fresh("") |
|
153 val z = Fresh("z") |
|
154 val e1_prime = CPS(e1) |
|
155 val e2_prime = CPS(e2) |
|
156 e1_prime((y1: KVal) => |
|
157 e2_prime((y2: KVal) => |
|
158 KApp(y1, List(y2, KVFix(fr, List(z), k(KVVar(z))))))) |
|
159 } |
|
160 case FIf0(e1, e2, e3) => (k: KVal => KTerm) => { |
|
161 val fr = Fresh("") |
|
162 val c = Fresh("c") |
|
163 val z = Fresh("z") |
|
164 val e1_prime = CPS(e1) |
|
165 val e2_prime = CPST(e2) |
|
166 val e3_prime = CPST(e3) |
|
167 e1_prime((y: KVal) => |
|
168 KLet(c, KVFix(fr, List(z), k(KVVar(z))), |
|
169 KIf0(y, e2_prime(KVVar(c)), e3_prime(KVVar(c))))) |
|
170 } |
|
171 case FPrimOp(e1, op, e2) => (k: KVal => KTerm) => { |
|
172 val z = Fresh("z") |
|
173 val e1_prime = CPS(e1) |
|
174 val e2_prime = CPS(e2) |
|
175 e1_prime((y1: KVal) => e2_prime((y2: KVal) => KLetPrimOp(z, y1, op, y2, k(KVVar(z))))) |
|
176 } |
|
177 case FTuple(es) => (k: KVal => KTerm) => { |
|
178 def aux(es: List[FTerm], vs: List[KVal]) : KTerm = es match { |
|
179 case Nil => k(KVTuple(vs.reverse)) |
|
180 case (e::es) => CPS(e)((y: KVal) => aux(es, y::vs)) |
|
181 } |
|
182 aux(es, Nil) |
|
183 } |
|
184 case FProj(i, e) => (k: KVal => KTerm) => { |
|
185 val z = Fresh("z") |
|
186 CPS(e)((y: KVal) => KLetProj(z, i, y, k(KVVar(z)))) |
|
187 } |
|
188 } |
|
189 |
|
190 |
|
191 |
|
192 //free variable function |
|
193 def FVKval(v: KVal) : Set[Idn] = v match { |
|
194 case KVVar(x) => Set(x) |
|
195 case KVNum(i) => Set() |
|
196 case KVTuple(vs) => vs.flatMap{FVKval}.toSet |
|
197 case KVFix(x, args, e) => FVKexp(e) -- args - x |
|
198 } |
|
199 |
|
200 def FVKexp(e: KTerm) : Set[Idn] = e match { |
|
201 case KApp(v, vs) => FVKval(v) ++ vs.flatMap{FVKval}.toSet |
|
202 case KIf0(v, e1, e2) => FVKval(v) ++ FVKexp(e1) ++ FVKexp(e2) |
|
203 case KHalt(v) => FVKval(v) |
|
204 case KLet(x, v, e) => FVKval(v) ++ (FVKexp(e) - x) |
|
205 case KLetProj(x, i, v, e) => FVKval(v) ++ (FVKexp(e) - x) |
|
206 case KLetPrimOp(x, v1, p, v2, e) => (FVKexp(e) - x) ++ FVKval(v1) ++ FVKval(v2) |
|
207 } |
|
208 |
|
209 |
|
210 abstract class CTerm |
|
211 abstract class CVal |
|
212 |
|
213 case class CApp(v : CVal, vs : List[CVal]) extends CTerm { |
|
214 override def toString = s"$v(${commas(vs.map(_.toString))})" |
|
215 } |
|
216 case class CIf0(v : CVal, e1 : CTerm, e2 : CTerm) extends CTerm { |
|
217 override def toString = s"if0($v, $e1, $e2)" |
|
218 } |
|
219 case class CHalt(v : CVal) extends CTerm { override def toString = "halt " + v } |
|
220 case class CLet(x : Idn, v : CVal, e : CTerm) extends CTerm { |
|
221 override def toString = s"let $x = $v in\n$e" |
|
222 } |
|
223 case class CLetProj(x : Idn, i : Num, v : CVal, e : CTerm) extends CTerm { |
|
224 override def toString = s"let $x =$i v in\n$e" |
|
225 } |
|
226 case class CLetPrimOp(x : Idn, v1 : CVal, p : Prim, v2 : CVal, e : CTerm) extends CTerm { |
|
227 override def toString = s"let $x = $v1 $p $v2 in\n$e" |
|
228 } |
|
229 |
|
230 case class CVVar(x : Idn) extends CVal { override def toString = x } |
|
231 case class CVNum(i : Num) extends CVal { override def toString = i.toString } |
|
232 case class CVTuple(vs : List[CVal]) extends CVal { |
|
233 override def toString = s"<${commas(vs.map(_.toString))}>" |
|
234 } |
|
235 case class CVFixCode(x : Idn, args : List[Idn], e : CTerm) extends CVal { |
|
236 override def toString = s"fixcode $x(${commas(args)}).$e" |
|
237 } |
|
238 |
|
239 |
|
240 |
|
241 // closure conversion |
|
242 def CExp(e: KTerm) : CTerm = e match { |
|
243 case KApp(v, vs) => { |
|
244 val z = Fresh("z") |
|
245 val z_code = Fresh("zcode") |
|
246 val z_env = Fresh("zenv") |
|
247 CLet(z, CVal(v), |
|
248 CLetProj(z_code, 0, CVVar(z), |
|
249 CLetProj(z_env, 1, CVVar(z), |
|
250 CApp(CVVar(z_code), CVVar(z_env) :: vs.map{CVal})))) |
|
251 } |
|
252 case KIf0(v, e1, e2) => CIf0(CVal(v), CExp(e1), CExp(e2)) |
|
253 case KHalt(v) => CHalt(CVal(v)) |
|
254 case KLet(x, v, e) => CLet(x, CVal(v), CExp(e)) |
|
255 case KLetProj(x, i, v, e) => CLetProj(x, i, CVal(v), CExp(e)) |
|
256 case KLetPrimOp(x, v1, p, v2, e) => CLetPrimOp(x, CVal(v1), p, CVal(v2), CExp(e)) |
|
257 } |
|
258 |
|
259 def CVal(v: KVal) : CVal = v match { |
|
260 case KVVar(x) => CVVar(x) |
|
261 case KVNum(i) => CVNum(i) |
|
262 case KVTuple(vs) => CVTuple(vs.map{CVal}) |
|
263 case KVFix(x, args, e) => { |
|
264 val x_env = Fresh(x + ".env") |
|
265 val ys = FVKval(KVFix(x, args, e)).toList |
|
266 val ys_index = |
|
267 ys.zipWithIndex.foldRight(CExp(e)) {case ((x, n), e) => CLetProj(x, n, CVVar(x_env), e) } |
|
268 val v_code = CVFixCode(x, x_env :: args, ys_index) |
|
269 val v_env = CVTuple(ys.map{CVVar(_)}) |
|
270 CVTuple(List(v_code, v_env)) |
|
271 } |
|
272 } |
|
273 |
|
274 abstract class HTerm |
|
275 abstract class HVal { |
|
276 def eval(env: Map[Idn, HVal]) : HVal |
|
277 } |
|
278 |
|
279 case class HApp(v : HVal, vs : List[HVal]) extends HTerm { |
|
280 override def toString = s"$v(${commas(vs.map(_.toString))})" |
|
281 } |
|
282 case class HIf0(v : HVal, e1 : HTerm, e2 : HTerm) extends HTerm { |
|
283 override def toString = s"if0($v, $e1, $e2)" |
|
284 } |
|
285 case class HHalt(v : HVal) extends HTerm { |
|
286 override def toString = s"halt $v" |
|
287 } |
|
288 case class HLet(x : Idn, v : HVal, e : HTerm) extends HTerm { |
|
289 override def toString = s"let $x = $v in\n$e" |
|
290 } |
|
291 case class HLetProj(x : Idn, i : Num, v : HVal, e : HTerm) extends HTerm { |
|
292 override def toString = s"let $x =$i $v in\n$e" |
|
293 } |
|
294 case class HLetPrimOp(x : Idn, v1 : HVal, p : Prim, v2 : HVal, e : HTerm) extends HTerm { |
|
295 override def toString = s"let $x = $v1 $p $v2 in\n$e" |
|
296 } |
|
297 |
|
298 case class HVVar(x : Idn) extends HVal { |
|
299 override def toString = x |
|
300 def eval(env: Map[Idn, HVal]) : HVal = env(x) |
|
301 } |
|
302 case class HVNum(i : Num) extends HVal { |
|
303 override def toString = i.toString |
|
304 def eval(env: Map[Idn, HVal]) : HVal = HVNum(i) |
|
305 } |
|
306 case class HVTuple(vs : List[HVal]) extends HVal { |
|
307 override def toString = "<" + commas (vs.map(_.toString)) + ">" |
|
308 def eval(env: Map[Idn, HVal]) : HVal = HVTuple(vs.map(_.eval(env))) |
|
309 } |
|
310 case class HVLabel(l: Idn) extends HVal { |
|
311 override def toString = l |
|
312 def eval(env: Map[Idn, HVal]) : HVal = HVLabel(l) |
|
313 } |
|
314 |
|
315 |
|
316 case class HBlock(args: List[Idn], term: HTerm) { |
|
317 override def toString = "code(" + commas(args) + ").\n" + term + "\n" |
|
318 } |
|
319 |
|
320 case class HProg(blocks: Map[Idn, HBlock], term: HTerm) { |
|
321 override def toString = "\nheap:\n" + |
|
322 cutlines(blocks.toList.map(_ match { case (x, y) => x + " -> " + y.toString })) + |
|
323 "in start:\n" + term.toString |
|
324 |
|
325 def run_block(pretty: Boolean, l: Idn, as: List[HVal], env: Map[Idn, HVal]) : Unit = { |
|
326 val blk = blocks(l) |
|
327 val env_prime = (blk.args zip as).toMap |
|
328 if (pretty) println("Referenced: " + l + " -> " + blk) |
|
329 run(pretty, blk.term, env ++ env_prime) |
|
330 } |
|
331 |
|
332 def run(pretty: Boolean, e: HTerm, env: Map[Idn, HVal]) : Unit = { |
|
333 if (pretty) println("Env:" + env.toList.length + " stored values)\n" + |
|
334 cutlines(env.toList.sortBy {_._1}.map(_.toString))) |
|
335 if (pretty) println("Term:\n" + e.toString) |
|
336 if (pretty) scala.io.StdIn.readLine() |
|
337 e match { |
|
338 case HHalt(v) => println ("Finished with result " + v.eval(env)) |
|
339 case HApp(v, vs) => (v.eval(env), vs.map(_.eval(env))) match { |
|
340 case (HVLabel(l), vs) => run_block(pretty, l, vs, env) |
|
341 case _ => throw new IllegalArgumentException("not a label") |
|
342 } |
|
343 case HLet(x, v, e) => run(pretty, e, env + (x -> v.eval(env))) |
|
344 case HLetProj(x, i, v, e) => v.eval(env) match { |
|
345 case HVTuple(vs) => run(pretty, e, env + (x -> vs(i))) |
|
346 case _ => throw new IllegalArgumentException("not a tuple") |
|
347 } |
|
348 case HLetPrimOp(x, v1, p, v2, e) => (v1.eval(env), p, v2.eval(env)) match { |
|
349 case (HVNum(m), PLUS(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m + n))) |
|
350 case (HVNum(m), MINUS(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m - n))) |
|
351 case (HVNum(m), MULT(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m * n))) |
|
352 case _ => throw new IllegalArgumentException("not a number") |
|
353 } |
|
354 case HIf0(v, e1, e2) => v.eval(env) match { |
|
355 case HVNum(0) => run(pretty, e1, env) |
|
356 case _ => run(pretty, e2, env) |
|
357 } |
|
358 } |
|
359 } |
|
360 |
|
361 def run_prog(pretty: Boolean) = run(pretty, term, Map()) |
|
362 } |
|
363 |
|
364 |
|
365 |
|
366 // hoisting |
|
367 def H(e: CTerm, ls: Map[Idn, HVal]) : (HTerm, Map[Idn, HBlock]) = e match { |
|
368 case CApp(v, vs) => { |
|
369 val (v_prime, hs) = HV(v, ls) |
|
370 val (vs_prime, hss) = vs.map{HV(_, ls)}.unzip |
|
371 (HApp(v_prime, vs_prime), hs ++ hss.flatten) |
|
372 } |
|
373 case CIf0(v, e1, e2) => { |
|
374 val (v_prime, hs1) = HV(v, ls) |
|
375 val (e1_prime, hs2) = H(e1, ls) |
|
376 val (e2_prime, hs3) = H(e2, ls) |
|
377 (HIf0(v_prime, e1_prime, e2_prime), hs1 ++ hs2 ++ hs3) |
|
378 } |
|
379 case CHalt(v) => { |
|
380 val (v_prime, hs) = HV(v, ls) |
|
381 (HHalt(v_prime), hs) |
|
382 } |
|
383 case CLet(x, v, e) => { |
|
384 val (v_prime, hs1) = HV(v, ls) |
|
385 val (e_prime, hs2) = H(e, ls) |
|
386 (HLet(x, v_prime, e_prime), hs1 ++ hs2) |
|
387 } |
|
388 case CLetProj(x, i, v, e) => { |
|
389 val (v_prime, hs1) = HV(v, ls) |
|
390 val (e_prime, hs2) = H(e, ls) |
|
391 (HLetProj(x, i, v_prime, e_prime), hs1 ++ hs2) |
|
392 } |
|
393 case CLetPrimOp(x, v1, p, v2, e) => { |
|
394 val (v1_prime, hs1) = HV(v1, ls) |
|
395 val (v2_prime, hs2) = HV(v2, ls) |
|
396 val (e_prime, hs3) = H(e, ls) |
|
397 (HLetPrimOp(x, v1_prime, p, v2_prime, e_prime), hs1 ++ hs2 ++ hs3) |
|
398 } |
|
399 } |
|
400 |
|
401 def HV(v: CVal, ls: Map[Idn, HVal]) : (HVal, Map[Idn, HBlock]) = v match { |
|
402 case CVVar(x) => ls.get(x) match { |
|
403 case Some(v) => (v, Map()) |
|
404 case None => (HVVar(x), Map()) |
|
405 } |
|
406 case CVNum(i) => (HVNum(i), Map()) |
|
407 case CVTuple(vs) => { |
|
408 val (vs_prime, hss) = vs.map{HV(_, ls)}.unzip |
|
409 (HVTuple(vs_prime), hss.flatten.toMap) |
|
410 } |
|
411 case CVFixCode(x, args, e) => { |
|
412 val l = Fresh(x + ".block") |
|
413 val (e_prime, hs) = H(e, ls + (x -> HVTuple(List(HVLabel(l), HVVar(args.head))))) |
|
414 (HVLabel(l), hs + (l -> HBlock(args, e_prime))) |
|
415 } |
|
416 } |
|
417 |
|
418 def HP(e: CTerm) = { |
|
419 val (e_prime, hs) = H(e, Map()) |
|
420 HProg(hs, e_prime) |
|
421 } |
|
422 |
|
423 |
|
424 abstract class TALVal { |
|
425 def eval(regs: Map[Idn, TALVal]) : TALVal |
|
426 } |
|
427 abstract class TALInstr { |
|
428 def update_regs(regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = regs |
|
429 } |
|
430 |
|
431 case class TALReg(r: Idn) extends TALVal { |
|
432 override def toString = r |
|
433 def eval(regs: Map[Idn, TALVal]) = regs(r).eval(regs) |
|
434 } |
|
435 case class TALLabel(l: Idn) extends TALVal { |
|
436 override def toString = l |
|
437 def eval(regs: Map[Idn, TALVal]) = TALLabel(l) |
|
438 } |
|
439 case class TALNum(i: Int) extends TALVal { |
|
440 override def toString = i.toString |
|
441 def eval(regs: Map[Idn, TALVal]) = TALNum(i) |
|
442 } |
|
443 case class TALTuple(vs: List[TALVal]) extends TALVal { |
|
444 override def toString = "<" + commas (vs.map(_.toString)) + ">" |
|
445 def eval(regs: Map[Idn, TALVal]) = TALTuple(vs.map(_.eval(regs))) |
|
446 } |
|
447 |
|
448 |
|
449 case class TALAdd(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { |
|
450 override def toString = "Add " + r1 + " " + r2 + " " + v |
|
451 override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { |
|
452 case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum(n + m)) |
|
453 case (TALNum(n), TALReg(r3)) => regs(r3) match { |
|
454 case TALNum(m) => regs + (r1 -> TALNum (n + m)) |
|
455 case _ => throw new IllegalArgumentException("not a number") |
|
456 } |
|
457 case _ => throw new IllegalArgumentException("not a number") |
|
458 } |
|
459 } |
|
460 case class TALSub(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { |
|
461 override def toString = "Sub " + r1 + " " + r2 + " " + v |
|
462 override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { |
|
463 case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum(n - m)) |
|
464 case (TALNum(n), TALReg(r3)) => regs(r3) match { |
|
465 case TALNum(m) => regs + (r1 -> TALNum (n - m)) |
|
466 case _ => throw new IllegalArgumentException("not a number") |
|
467 } |
|
468 case _ => throw new IllegalArgumentException("not a number") |
|
469 } |
|
470 } |
|
471 case class TALMul(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { |
|
472 override def toString = "Mul " + r1 + " " + r2 + " " + v |
|
473 override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { |
|
474 case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum (n * m)) |
|
475 case (TALNum(n), TALReg(r3)) => regs(r3) match { |
|
476 case TALNum(m) => regs + (r1 -> TALNum (n * m)) |
|
477 case _ => throw new IllegalArgumentException("not a number") |
|
478 } |
|
479 case _ => throw new IllegalArgumentException("not a number") |
|
480 } |
|
481 } |
|
482 case class TALBnz(r: Idn, v: TALVal) extends TALInstr { |
|
483 override def toString = "Bnz " + r + " " + v |
|
484 } |
|
485 case class TALMov(r: Idn, v: TALVal) extends TALInstr { |
|
486 override def toString = "Mov " + r + " " + v |
|
487 override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = v match { |
|
488 case TALReg(r1) => regs + (r -> regs(r1)) |
|
489 case _ => regs + (r -> v) |
|
490 } |
|
491 } |
|
492 case class TALProj(r1: Idn, r2: Idn, i: Num) extends TALInstr { |
|
493 override def toString = "Ldi " + r1 + " <- " + r2 + "[" + i + "]" |
|
494 override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = { |
|
495 regs(r2) match { |
|
496 case TALTuple(vs) => regs + (r1 -> vs(i)) |
|
497 case _ => throw new IllegalArgumentException("not a tuple: ") |
|
498 } |
|
499 } |
|
500 } |
|
501 |
|
502 case class TALJmp(v: TALVal) extends TALInstr { |
|
503 override def toString = "Jmp " + v |
|
504 } |
|
505 case class TALHalt() extends TALInstr { |
|
506 override def toString = "halt" |
|
507 } |
|
508 |
|
509 |
|
510 case class TALBlock(regs: List[Idn], cs: List[TALInstr]) { |
|
511 override def toString = "code(" + commas(regs) + ").\n" + cutlines(cs.map{_.toString}) + "\n" |
|
512 } |
|
513 |
|
514 case class TALProg(blocks: Map[Idn, TALBlock], start: List[TALInstr]) { |
|
515 override def toString = "heap:\n" + |
|
516 cutlines(blocks.toList.map(_ match { case (x, y) => x + " -> " + y.toString })) + |
|
517 "start block:\n" + cutlines(start.map(_.toString)) |
|
518 |
|
519 def run_block(pretty: Boolean, l: Idn, regs: Map[Idn, TALVal]) : Unit = { |
|
520 val blk = blocks(l) |
|
521 if (pretty) println("Referenced: " + l + " -> " + blk) |
|
522 val regs_prime = for ((r, n) <- blk.regs.zipWithIndex) yield (r, TALReg("RArg_" + n.toString).eval(regs)) |
|
523 run(pretty, blk.cs, regs ++ regs_prime.toMap) |
|
524 } |
|
525 |
|
526 def run(pretty: Boolean, cs: List[TALInstr], regs: Map[Idn, TALVal]) : Unit = { |
|
527 if (pretty) println("Regs:(" + regs.toList.length + " stored values)\n" + |
|
528 cutlines(regs.toList.sortBy {_._1}.map(_.toString))) |
|
529 if (pretty) println("Instrs:\n" + cutlines(cs.map(_.toString))) |
|
530 if (pretty) scala.io.StdIn.readLine() |
|
531 cs match { |
|
532 case (TALHalt() :: _) => println ("Finished with result " + regs("RArg_0")) |
|
533 case (TALJmp(TALLabel(l)) :: _) => run_block(pretty, l, regs) |
|
534 case (TALJmp(TALReg(r)) :: _) => regs(r) match { |
|
535 case TALLabel(l) => run_block(pretty, l, regs) |
|
536 case _ => throw new IllegalArgumentException("jump to non-label") |
|
537 } |
|
538 case (TALBnz(r, TALLabel(l)) :: cs) => regs(r) match { |
|
539 case TALNum(0) => run(pretty, cs, regs) |
|
540 case _ => run_block(pretty, l, regs) |
|
541 } |
|
542 case (c :: cs) => run(pretty, cs, c.update_regs(regs)) |
|
543 case Nil => throw new IllegalArgumentException("no instruction left") |
|
544 } |
|
545 } |
|
546 |
|
547 def run_prog(pretty: Boolean) : Unit = run(pretty, start, Map()) |
|
548 } |
|
549 |
|
550 def mk_vreg(s: String) = "Reg_" + s |
|
551 def mk_areg(i: Int) = "RArg_" + i.toString |
|
552 |
|
553 |
|
554 def Tval(v: HVal) : TALVal = v match { |
|
555 case HVVar(x) => TALReg("Reg_" + x) |
|
556 case HVNum(i) => TALNum(i) |
|
557 case HVTuple(vs) => TALTuple(vs.map(Tval)) |
|
558 case HVLabel(l) => TALLabel(l) |
|
559 } |
|
560 |
|
561 def Texp(e: HTerm) : (Map[Idn, TALBlock], List[TALInstr]) = e match { |
|
562 case HApp(v, vs) => { |
|
563 val fr_reg0 = Fresh("r0") |
|
564 val fr_regs = vs.map((v) => Fresh("r")) |
|
565 val movs0 = List(TALMov(fr_reg0, Tval(v))) |
|
566 val movs1 = for ((r, v) <- (fr_regs zip vs)) yield TALMov(r, Tval(v)) |
|
567 val movs2 = for ((r, i) <- fr_regs.zipWithIndex) yield TALMov(mk_areg(i), TALReg(r)) |
|
568 val movs3 = List(TALJmp(TALReg(fr_reg0))) |
|
569 (Map(), movs0 ::: movs1 ::: movs2 ::: movs3) |
|
570 } |
|
571 case HIf0(v, e1, e2) => { |
|
572 val l = Fresh("else_branch") |
|
573 val r = Fresh("r") |
|
574 val (h1, comp1) = Texp(e1) |
|
575 val (h2, comp2) = Texp(e2) |
|
576 val code = List(TALMov(r, Tval(v)), TALBnz(r, TALLabel(l))) |
|
577 val h3 = TALBlock(Nil, comp2) |
|
578 (h1 ++ h2 + (l -> h3), code ::: comp1) |
|
579 } |
|
580 case HHalt(v) => { |
|
581 (Map(), List(TALMov(mk_areg(0), Tval(v)), TALHalt())) |
|
582 } |
|
583 case HLet(x, v, e) => { |
|
584 val (h, comp) = Texp(e) |
|
585 val code = TALMov(mk_vreg(x), Tval(v)) |
|
586 (h, code :: comp) |
|
587 } |
|
588 case HLetPrimOp(x, v1, PLUS(), v2, e) => { |
|
589 val r = mk_vreg(x) |
|
590 val (h, comp) = Texp(e) |
|
591 val code = List(TALMov(r, Tval(v1)), TALAdd(r, r, Tval(v2))) |
|
592 (h, code ::: comp) |
|
593 } |
|
594 case HLetPrimOp(x, v1, MINUS(), v2, e) => { |
|
595 val r = mk_vreg(x) |
|
596 val (h, comp) = Texp(e) |
|
597 val code = List(TALMov(r, Tval(v1)), TALSub(r, r, Tval(v2))) |
|
598 (h, code ::: comp) |
|
599 } |
|
600 case HLetPrimOp(x, v1, MULT(), v2, e) => { |
|
601 val r = mk_vreg(x) |
|
602 val (h, comp) = Texp(e) |
|
603 val code = List(TALMov(r, Tval(v1)), TALMul(r, r, Tval(v2))) |
|
604 (h, code ::: comp) |
|
605 } |
|
606 case HLetProj(x, i, v, e) => { |
|
607 val r = mk_vreg(x) |
|
608 val (h, comp) = Texp(e) |
|
609 val code = List(TALMov(r, Tval(v)), TALProj(r, r, i)) |
|
610 (h, code ::: comp) |
|
611 } |
|
612 } |
|
613 |
|
614 def Tblock(l: Idn, hb: HBlock) : List[(Idn, TALBlock)] = hb match { |
|
615 case HBlock(args, e) => { |
|
616 val (h, comp) = Texp(e) |
|
617 (l, TALBlock(args.map("Reg_" + _), comp)) :: h.toList |
|
618 } |
|
619 } |
|
620 |
|
621 def Tprog(prog: HProg) = prog match { |
|
622 case HProg(heaps, e) => { |
|
623 val (hs, comp) = Texp(e) |
|
624 val heap_prime = for ((l, hb) <- heaps) yield Tblock(l, hb) |
|
625 TALProg(hs ++ heap_prime.flatten.toMap, comp) |
|
626 } |
|
627 } |
|
628 |
|
629 /* Simple examples |
|
630 |
|
631 // tuple <1,2,3> |
|
632 val prog0 = FTuple(List(FNum(1), FNum(2), FNum(3))) |
|
633 val Kresult0 = CPS(prog0)((y:KVal) => KHalt(y)) |
|
634 val Cresult0 = CExp(Kresult0) |
|
635 val Hresult0 = HP(Cresult0) |
|
636 val Tresult0 = Tprog(Hresult0) |
|
637 |
|
638 println("tuple example: \n") |
|
639 println("F: " + prog0.toString) |
|
640 println("K: " + Kresult0.toString) |
|
641 println("C: " + Cresult0.toString) |
|
642 println("H: " + Hresult0.toString) |
|
643 println("T: " + Tresult0.toString + "\n") |
|
644 Tresult0.run_prog(true) |
|
645 scala.io.StdIn.readLine() |
|
646 |
|
647 // tuple Proj 1 <1,2,3> |
|
648 val prog1 = FProj(1, FTuple(List(FNum(1), FNum(2), FNum(3)))) |
|
649 val Kresult1 = CPS(prog1)((y:KVal) => KHalt(y)) |
|
650 val Cresult1 = CExp(Kresult1) |
|
651 val Hresult1 = HP(Cresult1) |
|
652 val Tresult1 = Tprog(Hresult1) |
|
653 |
|
654 println("tuple - proj: \n") |
|
655 println("F: " + prog1.toString) |
|
656 println("K: " + Kresult1.toString) |
|
657 println("C: " + Cresult1.toString) |
|
658 println("H: " + Hresult1.toString) |
|
659 println("T: " + Tresult1.toString + "\n") |
|
660 Tresult1.run_prog(true) |
|
661 scala.io.StdIn.readLine() |
|
662 |
|
663 // 3 + 4 |
|
664 val prog2 = FPrimOp(FNum(3),PLUS(),FNum(4)) |
|
665 val Kresult2 = CPS(prog2)((y:KVal) => KHalt(y)) |
|
666 val Cresult2 = CExp(Kresult2) |
|
667 val Hresult2 = HP(Cresult2) |
|
668 val Tresult2 = Tprog(Hresult2) |
|
669 |
|
670 println("3 + 4: \n") |
|
671 println("F: " + prog2.toString) |
|
672 println("K: " + Kresult2.toString) |
|
673 println("C: " + Cresult2.toString) |
|
674 println("H: " + Hresult2.toString) |
|
675 println("T: " + Tresult2.toString + "\n") |
|
676 Tresult2.run_prog(true) |
|
677 scala.io.StdIn.readLine() |
|
678 |
|
679 // (fix f(x). 18 * x + 32) 24 |
|
680 val d1 = FPrimOp(FPrimOp(FNum(18), MULT(), FVar("x")), PLUS(), FNum(32)) |
|
681 val prog3 = FApp(FFix("f", "x", d1), FNum(24)) |
|
682 val Kresult3 = CPS(prog3)((y:KVal) => KHalt(y)) |
|
683 val Cresult3 = CExp(Kresult3) |
|
684 val Hresult3 = HP(Cresult3) |
|
685 val Tresult3 = Tprog(Hresult3) |
|
686 |
|
687 println("(fix f(x). 18 * x + 32) 24 \n") |
|
688 println("F: " + prog3.toString + "\n") |
|
689 println("K: " + Kresult3.toString + "\n") |
|
690 println("C: " + Cresult3.toString + "\n") |
|
691 println("H: " + Hresult3.toString + "\n") |
|
692 Hresult3.run_prog(true) |
|
693 scala.io.StdIn.readLine() |
|
694 println("T: " + Tresult3.toString + "\n") |
|
695 Tresult3.run_prog(true) |
|
696 scala.io.StdIn.readLine() |
|
697 */ |
|
698 |
|
699 |
|
700 /* |
|
701 // twice-apply example |
|
702 // fix twice(f)._(x). f (f x) |
|
703 val fun = FFix("id", "x", FPrimOp(FVar("x"), MULT(), FVar("x"))) |
|
704 val ffx = FApp(FVar("f"), FApp(FVar("f"), FVar("x"))) |
|
705 val f1 = FFix("twice", "f", FFix("twicef", "x", ffx)) |
|
706 val prog4 = FApp(FApp(f1, fun), FNum(2)) |
|
707 val Kresult4 = CPS(prog4)((y:KVal) => KHalt(y)) |
|
708 val Cresult4 = CExp(Kresult4) |
|
709 val Hresult4 = HP(Cresult4) |
|
710 val Tresult4 = Tprog(Hresult4) |
|
711 |
|
712 println("twice fun 2\n") |
|
713 println("F: " + prog4.toString + "\n") |
|
714 println("K: " + Kresult4.toString + "\n") |
|
715 println("C: " + Cresult4.toString + "\n") |
|
716 println("H: " + Hresult4.toString + "\n") |
|
717 //Hresult4.run_prog(false) |
|
718 //scala.io.StdIn.readLine() |
|
719 println("T: " + Tresult4.toString + "\n") |
|
720 Tresult4.run_prog(false) |
|
721 scala.io.StdIn.readLine() |
|
722 */ |
|
723 |
|
724 /* |
|
725 //identity function |
|
726 //fix id(x). x |
|
727 val id = FFix("id", "x", FVar("x")) |
|
728 val id_three = FApp(id, FNum(3)) |
|
729 |
|
730 val Kresult5 = CPS(id_three)((y:KVal) => KHalt(y)) |
|
731 val Cresult5 = CExp(Kresult5) |
|
732 val Hresult5 = HP(Cresult5) |
|
733 val Tresult5 = Tprog(Hresult5) |
|
734 |
|
735 println("id 3:") |
|
736 println("F: " + id_three.toString) |
|
737 println("K: " + Kresult5.toString + "\n") |
|
738 println("C: " + Cresult5.toString + "\n") |
|
739 println("H: " + Hresult5.toString + "\n") |
|
740 println("T: " + Tresult5.toString + "\n") |
|
741 Tresult5.run_prog(false) |
|
742 scala.io.StdIn.readLine() |
|
743 */ |
|
744 |
|
745 /* |
|
746 //example: factorial |
|
747 val f = FVar("f") |
|
748 val n = FVar("n") |
|
749 val one = FNum(1) |
|
750 val six = FNum(15) |
|
751 val e0 = FPrimOp(n, MINUS(), one) |
|
752 val e1 = FApp(f, e0) |
|
753 val e2 = FPrimOp(n, MULT(), e1) |
|
754 val fact: FTerm = FFix("f", "n", FIf0(n, one, e2)) |
|
755 val fact_six = FApp(fact, six) |
|
756 |
|
757 |
|
758 val Kresult6 = CPS(fact_six)((y:KVal) => KHalt(y)) |
|
759 val Cresult6 = CExp(Kresult6) |
|
760 val Hresult6 = HP(Cresult6) |
|
761 val Tresult6 = Tprog(Hresult6) |
|
762 |
|
763 println("fact 6: \n") |
|
764 println("F: " + fact_six) |
|
765 scala.io.StdIn.readLine() |
|
766 println("K: " + Kresult6.toString + "\n") |
|
767 scala.io.StdIn.readLine() |
|
768 println("C: " + Cresult6.toString + "\n") |
|
769 scala.io.StdIn.readLine() |
|
770 println("H: " + Hresult6.toString + "\n") |
|
771 println("-----------------------------") |
|
772 println("Execution") |
|
773 Hresult6.run_prog(false) |
|
774 scala.io.StdIn.readLine() |
|
775 println("T: " + Tresult6.toString + "\n") |
|
776 println("-----------------------------") |
|
777 println("Execution") |
|
778 Tresult6.run_prog(false) |
|
779 scala.io.StdIn.readLine() |
|
780 */ |
|
781 |
|
782 |
|
783 //example: fibonacci |
|
784 // fib(n).if0(n, 1,if0(n - 1, 1, fib(n - 1) + fib(n - 2))) |
|
785 val fib = FVar("fib") |
|
786 val n = FVar("n") |
|
787 val one = FNum(1) |
|
788 val two = FNum(2) |
|
789 val minus_one = FPrimOp(n, MINUS(), one) |
|
790 val minus_two = FPrimOp(n, MINUS(), two) |
|
791 val fibonacci = |
|
792 FFix("fib", "n", |
|
793 FIf0(n, one, |
|
794 FIf0(minus_one, one, FPrimOp(FApp(fib, minus_one), PLUS(), FApp(fib, minus_two))))) |
|
795 val fib_apply = FApp(fibonacci, FNum(4)) |
|
796 |
|
797 val Kresult7 = CPS(fib_apply)((y:KVal) => KHalt(y)) |
|
798 val Cresult7 = CExp(Kresult7) |
|
799 val Hresult7 = HP(Cresult7) |
|
800 val Tresult7 = Tprog(Hresult7) |
|
801 |
|
802 println("fib: \n") |
|
803 println("F: " + fib_apply) |
|
804 scala.io.StdIn.readLine() |
|
805 println("K: " + Kresult7.toString + "\n") |
|
806 scala.io.StdIn.readLine() |
|
807 println("C: " + Cresult7.toString + "\n") |
|
808 scala.io.StdIn.readLine() |
|
809 println("H: " + Hresult7.toString + "\n") |
|
810 println("-----------------------------") |
|
811 println("H Prog") |
|
812 Hresult7.run_prog(false) |
|
813 scala.io.StdIn.readLine() |
|
814 println("T: " + Tresult7.toString + "\n") |
|
815 println("-----------------------------") |
|
816 println("TAL") |
|
817 Tresult7.run_prog(false) |
|
818 scala.io.StdIn.readLine() |