Commit 3844c623 authored by Luca Bataillard's avatar Luca Bataillard
Browse files

Merge branch 'improvedCC' of gitlab.epfl.ch:owsianko/acc-project into improvedCC

parents 5e1720d2 67178875
...@@ -62,6 +62,11 @@ sealed abstract class CPSInterpreter[M <: CPSTreeModule]( ...@@ -62,6 +62,11 @@ sealed abstract class CPSInterpreter[M <: CPSTreeModule](
case AppF(fun, retC, args) => case AppF(fun, retC, args) =>
val FunV(fRetC, fArgs, fBody, fEnv) = unwrapFunV(resolve(fun)) val FunV(fRetC, fArgs, fBody, fEnv) = unwrapFunV(resolve(fun))
if (fArgs.length != args.length) {
println(fun)
println(fArgs.length)
println(args.length)
}
assume(fArgs.length == args.length) assume(fArgs.length == args.length)
val rArgs = args map resolve val rArgs = args map resolve
val env1 = ((fRetC +: fArgs) zip (env(retC) +: rArgs)).toMap orElse fEnv val env1 = ((fRetC +: fArgs) zip (env(retC) +: rArgs)).toMap orElse fEnv
......
...@@ -37,12 +37,17 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) { ...@@ -37,12 +37,17 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
if (knownFuns.contains(fName)) { if (knownFuns.contains(fName)) {
val (wName, sName, fvs) = knownFuns(fName) val (wName, sName, fvs) = knownFuns(fName)
val newArgs = (args map rewrite) ++ (fvs map L.AtomN) val newArgs = (args map rewrite) ++ (fvs map L.AtomN)
L.AppF(L.AtomN(wName), retC, newArgs) val res = L.AppF(L.AtomN(wName), retC, newArgs)
res
} else { } else {
val f = Symbol.fresh("f") val f = Symbol.fresh("closure")
val newBody = L.AppF(L.AtomN(f), retC, rewrite(fun) +: args.map(rewrite)) val newBody = L.AppF(L.AtomN(f), retC, rewrite(fun) +: args.map(rewrite))
val newArgs = Seq(rewrite(fun), L.AtomL(0)) val newArgs = Seq(rewrite(fun), L.AtomL(0))
L.LetP(f, CPS.BlockGet, newArgs, newBody) val res = L.LetP(f, CPS.BlockGet, newArgs, newBody)
println("aaaaaaaaaaaa")
println(fName)
println(res)
res
} }
} }
...@@ -106,6 +111,10 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) { ...@@ -106,6 +111,10 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
val fv = fvs(fName) val fv = fvs(fName)
(fName -> (wName, sName, fv)) (fName -> (wName, sName, fv))
} }
println("eeeee")
println(initialFuns.map(_.name))
println(definedFuns)
println()
val knownFuns = oldKnownFuns ++ definedFuns val knownFuns = oldKnownFuns ++ definedFuns
val workers = initialFuns map { case H.Fun(fName, fRetC, fArgs, fBody) => val workers = initialFuns map { case H.Fun(fName, fRetC, fArgs, fBody) =>
...@@ -338,7 +347,12 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) { ...@@ -338,7 +347,12 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
case L3.CharToInt => case L3.CharToInt =>
L.LetP(n, CPS.ShiftRight, Seq(rewrite(x), L.AtomL(2)), transform(body)) L.LetP(n, CPS.ShiftRight, Seq(rewrite(x), L.AtomL(2)), transform(body))
case L3.Id => case L3.Id =>
L.LetP(n, CPS.Id, Seq(rewrite(x)), transform(body)) val newKnownFuns = x match {
case H.AtomN(xName) if knownFuns contains xName =>
knownFuns.updated(n, knownFuns(xName))
case _ => knownFuns
}
L.LetP(n, CPS.Id, Seq(rewrite(x)), transform(body)(newKnownFuns))
case L3.IntToChar => case L3.IntToChar =>
tempLetP(CPS.ShiftLeft, Seq(Left(x), Right(L.AtomL(2)))){ t1 => tempLetP(CPS.ShiftLeft, Seq(Left(x), Right(L.AtomL(2)))){ t1 =>
......
...@@ -17,6 +17,7 @@ object Main { ...@@ -17,6 +17,7 @@ object Main {
andThen CPSValueRepresenter andThen CPSValueRepresenter
andThen treePrinter("---------- After value representation") andThen treePrinter("---------- After value representation")
andThen treeChecker andThen treeChecker
andThen treePrinter("---------- After hoisting")
andThen CPSHoister andThen CPSHoister
andThen CPSInterpreterLow andThen CPSInterpreterLow
) )
......
...@@ -2,31 +2,39 @@ ...@@ -2,31 +2,39 @@
;; Test the "fun" expression ;; Test the "fun" expression
(@byte-write 73) ;;(@byte-write 73)
((fun (b) (@byte-write b)) 65) ;;((fun (b) (@byte-write b)) 65)
((fun (b) ;;((fun (b)
(@byte-write b) ;; (@byte-write b)
(@byte-write (@+ b 1))) ;; (@byte-write (@+ b 1)))
66) ;; 66)
(@byte-write ((fun (x) x) 68)) ;;(@byte-write ((fun (x) x) 68))
(let ((compose (fun (f g) ;;(let ((compose (fun (f g)
(fun (x) (f (g x))))) ;; (fun (x) (f (g x)))))
(succ (fun (x) (@+ x 1))) ;; (succ (fun (x) (@+ x 1)))
(twice (fun (x) (@+ x x)))) ;; (twice (fun (x) (@+ x x))))
(@byte-write ((compose succ twice) 34))) ;; (@byte-write ((compose succ twice) 34)))
((fun (x y z) #u) (let
(@byte-write 70) (
(@byte-write 71) (compose (fun (f)
(@byte-write 72)) (fun (x) (f x)))
)
)
((compose 1)))
(let* ((fact (fun (self x) ;;((fun (x y z) #u)
(if (@= 0 x) ;; (@byte-write 70)
1 ;; (@byte-write 71)
(@* x (self self (@- x 1)))))) ;; (@byte-write 72))
(fix (fun (f x)
(f f x)))) ;;(let* ((fact (fun (self x)
(if (@= (fix fact 5) 120) ;; (if (@= 0 x)
(@byte-write 73))) ;; 1
;; (@* x (self self (@- x 1))))))
;; (fix (fun (f x)
;; (f f x))))
;; (if (@= (fix fact 5) 120)
;; (@byte-write 73)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment