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
aa303d4e
Commit
aa303d4e
authored
Apr 30, 2021
by
Sapphie
Browse files
Implement halt untagging and improve modulo representation
parent
8314f274
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/src/l3/CPSValueRepresenter.scala
View file @
aa303d4e
...
...
@@ -28,7 +28,20 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
L
.
AppC
(
cnt
,
lArgs
)
case
H
.
If
(
cond
,
args
,
thenC
,
elseC
)
=>
transformIf
(
cond
,
args
,
thenC
,
elseC
)
case
H
.
Halt
(
v
)
=>
L
.
Halt
(
rewrite
(
v
))
case
H
.
Halt
(
v
)
=>
v
match
{
case
H
.
AtomL
(
UnitLit
)
=>
L
.
Halt
(
L
.
AtomL
(
0
))
case
H
.
AtomL
(
IntLit
(
i
))
=>
L
.
Halt
(
L
.
AtomL
(
i
.
toInt
))
case
H
.
AtomL
(
CharLit
(
c
))
=>
L
.
Halt
(
L
.
AtomL
(
c
.
toInt
))
case
H
.
AtomL
(
BooleanLit
(
b
))
=>
L
.
Halt
(
L
.
AtomL
(
if
(
b
)
1
else
0
))
case
v1
@
H
.
AtomN
(
_
)
=>
val
haltContName
=
Symbol
.
fresh
(
"c-halt"
)
val
haltContArgs
=
Seq
(
Symbol
.
fresh
(
"halt_arg"
))
val
haltContBody
=
L
.
Halt
(
L
.
AtomN
(
haltContArgs
(
0
)))
val
letCBody
=
makeUntaggingTree
(
v1
,
haltContName
)
L
.
LetC
(
Seq
(
L
.
Cnt
(
haltContName
,
haltContArgs
,
haltContBody
)),
letCBody
)
}
case
_
=>
throw
new
Exception
(
"Unimplemented: "
+
tree
.
getClass
.
toString
)
}
...
...
@@ -46,6 +59,52 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
}
}
def
makeUntaggingTree
(
v
:
H.AtomN
,
haltCont
:
Symbol
)
:
L.Tree
=
{
def
mkeUntagCont
(
name
:
String
,
nBitsShift
:
Int
)
:
L.Cnt
=
{
val
contName
=
Symbol
.
fresh
(
"c-"
+
name
)
val
argName
=
Symbol
.
fresh
(
name
+
"_arg"
)
val
shiftedName
=
Symbol
.
fresh
(
name
+
"_arg_untagged"
)
L
.
Cnt
(
contName
,
Seq
(
argName
),
L
.
LetP
(
shiftedName
,
CPS
.
ShiftRight
,
Seq
(
L
.
AtomN
(
argName
),
L
.
AtomL
(
nBitsShift
)),
L
.
AppC
(
haltCont
,
Seq
(
L
.
AtomN
(
shiftedName
)))))
}
def
mkeCheckCont
(
name
:
String
,
body
:
L.Tree
)
:
L.Cnt
=
{
val
contName
=
Symbol
.
fresh
(
name
)
L
.
Cnt
(
contName
,
Seq
(),
body
)
}
val
untagIntCont
=
mkeUntagCont
(
"int_untag"
,
1
)
val
untagCharCont
=
mkeUntagCont
(
"char_untag"
,
3
)
val
untagBoolCont
=
mkeUntagCont
(
"bool_untag"
,
4
)
val
untagUnitCont
=
mkeUntagCont
(
"unit_untag"
,
2
)
// If it's a unit, untag it, otherwise, immediately skip to halt
val
unitCheckCont
=
mkeCheckCont
(
"unit_check"
,
transformIf
(
L3
.
UnitP
,
Seq
(
v
),
untagUnitCont
.
name
,
haltCont
))
// If it's a boolean, untag it, otherwise check if it's a unit
val
boolCheckCont
=
mkeCheckCont
(
"bool_check"
,
transformIf
(
L3
.
BoolP
,
Seq
(
v
),
untagBoolCont
.
name
,
unitCheckCont
.
name
))
// if it's a character, untag it, otherwise check if it's a boolean
val
charCheckCont
=
mkeCheckCont
(
"char_check"
,
transformIf
(
L3
.
CharP
,
Seq
(
v
),
untagCharCont
.
name
,
boolCheckCont
.
name
))
//etc
val
letCBody
=
transformIf
(
L3
.
IntP
,
Seq
(
v
),
untagIntCont
.
name
,
charCheckCont
.
name
)
val
conts
=
Seq
(
untagIntCont
,
untagCharCont
,
untagBoolCont
,
untagUnitCont
,
unitCheckCont
,
charCheckCont
,
boolCheckCont
)
L
.
LetC
(
conts
,
letCBody
)
}
private
def
transformLetF
(
initialFuns
:
Seq
[
H.Fun
],
body
:
H.Tree
)(
implicit
oldKnownFuns
:
KnownFunsMap
)
:
L.LetF
=
{
def
funsFV
(
definedFuns
:
Seq
[
H.Fun
],
prevKnownFuns
:
KnownFunsMap
)
:
Map
[
Symbol
,
Seq
[
Symbol
]]
=
{
...
...
@@ -268,7 +327,13 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
// I don't think there is a way to do this in a smart way
case
L3
.
IntDiv
=>
rawBinaryTree
(
CPS
.
Div
)
case
L3
.
IntMod
=>
rawBinaryTree
(
CPS
.
Mod
)
case
L3
.
IntMod
=>
tempLetP
(
CPS
.
XOr
,
Seq
(
Left
(
x
),
lAtomOne
))
{
x1
=>
tempLetP
(
CPS
.
XOr
,
Seq
(
Left
(
y
),
lAtomOne
))
{
y1
=>
tempLetP
(
CPS
.
Mod
,
Seq
(
Right
(
x1
),
Right
(
y1
)))
{
untaggedModRes
=>
L
.
LetP
(
n
,
CPS
.
XOr
,
Seq
(
untaggedModRes
,
L
.
AtomL
(
1
)),
transform
(
body
))
}
}
}
case
L3
.
IntShiftLeft
=>
tempLetP
(
CPS
.
Sub
,
Seq
(
Left
(
x
),
lAtomOne
))
{
x1
=>
...
...
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