Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Haley Sapphie Owsianko
ACC-project
Commits
3844c623
Commit
3844c623
authored
Apr 25, 2021
by
Luca Bataillard
Browse files
Merge branch 'improvedCC' of gitlab.epfl.ch:owsianko/acc-project into improvedCC
parents
5e1720d2
67178875
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/src/l3/CPSInterpreter.scala
View file @
3844c623
...
...
@@ -62,6 +62,11 @@ sealed abstract class CPSInterpreter[M <: CPSTreeModule](
case
AppF
(
fun
,
retC
,
args
)
=>
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
)
val
rArgs
=
args
map
resolve
val
env1
=
((
fRetC
+:
fArgs
)
zip
(
env
(
retC
)
+:
rArgs
)).
toMap
orElse
fEnv
...
...
compiler/src/l3/CPSValueRepresenter.scala
View file @
3844c623
...
...
@@ -37,12 +37,17 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
if
(
knownFuns
.
contains
(
fName
))
{
val
(
wName
,
sName
,
fvs
)
=
knownFuns
(
fName
)
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
{
val
f
=
Symbol
.
fresh
(
"
f
"
)
val
f
=
Symbol
.
fresh
(
"
closure
"
)
val
newBody
=
L
.
AppF
(
L
.
AtomN
(
f
),
retC
,
rewrite
(
fun
)
+:
args
.
map
(
rewrite
))
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) {
val
fv
=
fvs
(
fName
)
(
fName
->
(
wName
,
sName
,
fv
))
}
println
(
"eeeee"
)
println
(
initialFuns
.
map
(
_
.
name
))
println
(
definedFuns
)
println
()
val
knownFuns
=
oldKnownFuns
++
definedFuns
val
workers
=
initialFuns
map
{
case
H
.
Fun
(
fName
,
fRetC
,
fArgs
,
fBody
)
=>
...
...
@@ -338,7 +347,12 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
case
L3
.
CharToInt
=>
L
.
LetP
(
n
,
CPS
.
ShiftRight
,
Seq
(
rewrite
(
x
),
L
.
AtomL
(
2
)),
transform
(
body
))
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
=>
tempLetP
(
CPS
.
ShiftLeft
,
Seq
(
Left
(
x
),
Right
(
L
.
AtomL
(
2
)))){
t1
=>
...
...
compiler/src/l3/Main.scala
View file @
3844c623
...
...
@@ -17,6 +17,7 @@ object Main {
andThen
CPSValueRepresenter
andThen
treePrinter
(
"---------- After value representation"
)
andThen
treeChecker
andThen
treePrinter
(
"---------- After hoisting"
)
andThen
CPSHoister
andThen
CPSInterpreterLow
)
...
...
tests/expr-fun.l3
View file @
3844c623
...
...
@@ -2,31 +2,39 @@
;; Test the "fun" expression
(@byte-write 73)
;;
(@byte-write 73)
((fun (b) (@byte-write b)) 65)
((fun (b)
(@byte-write b)
(@byte-write (@+ b 1)))
66)
(@byte-write ((fun (x) x) 68))
;;
((fun (b) (@byte-write b)) 65)
;;
((fun (b)
;;
(@byte-write b)
;;
(@byte-write (@+ b 1)))
;;
66)
;;
(@byte-write ((fun (x) x) 68))
(let ((compose (fun (f g)
(fun (x) (f (g x)))))
(succ (fun (x) (@+ x 1)))
(twice (fun (x) (@+ x x))))
(@byte-write ((compose succ twice) 34)))
;;
(let ((compose (fun (f g)
;;
(fun (x) (f (g x)))))
;;
(succ (fun (x) (@+ x 1)))
;;
(twice (fun (x) (@+ x x))))
;;
(@byte-write ((compose succ twice) 34)))
((fun (x y z) #u)
(@byte-write 70)
(@byte-write 71)
(@byte-write 72))
(let
(
(compose (fun (f)
(fun (x) (f x)))
)
)
((compose 1)))
(let* ((fact (fun (self x)
(if (@= 0 x)
1
(@* x (self self (@- x 1))))))
(fix (fun (f x)
(f f x))))
(if (@= (fix fact 5) 120)
(@byte-write 73)))
;;((fun (x y z) #u)
;; (@byte-write 70)
;; (@byte-write 71)
;; (@byte-write 72))
;;(let* ((fact (fun (self x)
;; (if (@= 0 x)
;; 1
;; (@* x (self self (@- x 1))))))
;; (fix (fun (f x)
;; (f f x))))
;; (if (@= (fix fact 5) 120)
;; (@byte-write 73)))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment