Skip to content

Instantly share code, notes, and snippets.

@jacobstanley

jacobstanley/Input.ddc

Created August 2, 2015 05:39
Show Gist options
  • Save jacobstanley/45eb81f5448871095fd3 to your computer and use it in GitHub Desktop.
Save jacobstanley/45eb81f5448871095fd3 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
Input.ddc
module Collect
export value collectInit : Nat# -> Unit;
export value collectHeap : Addr# -> Addr# -> Addr# -> Addr# -> Unit;
import foreign c value
malloc : Nat# -> Addr#;
import foreign c value
formatOfObject : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
sizeOfObject : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
readBrokenHeart : [r1 r2 : Region].Ptr# r1 Obj -> Ptr# r2 Obj;
import foreign c value
writeBrokenHeart : [r1 r2 : Region].Ptr# r1 Obj -> Ptr# r2 Obj -> Void#;
import foreign c value
isAnchored : [r : Region].Ptr# r Obj -> Bool#;
import foreign c value
argsOfThunk : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfThunk : [r : Region].Ptr# r Obj -> Nat# -> Addr#;
import foreign c value
arityOfBoxed : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfBoxed : [r : Region].Ptr# r Obj -> Nat# -> Ptr# r Obj;
import foreign c value
arityOfMixed : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfMixed : [r : Region].Ptr# r Obj -> Nat# -> Ptr# r Obj;
with
letrec {
collectInit : Nat# -> Unit
= \(maxGCSlots : Nat#).
let x0 : Nat# = size# [Addr#] in
let x1 : Nat# = mul# [Nat#] maxGCSlots x0 in
let pSlotBaseA : Addr# = malloc x1 in
let x2 : Nat# = sub# [Nat#] maxGCSlots 1# in
let pSlotMaxA : Addr# = plusAddr# pSlotBaseA x2 in
let x3 : Addr# = slotBase# in
let _ : Void# = write# [Addr#] x3 0# pSlotBaseA in
let x4 : Addr# = slotTop# in
let _ : Void# = write# [Addr#] x4 0# pSlotBaseA in
let x5 : Addr# = slotMax# in
let _ : Void# = write# [Addr#] x5 0# pSlotMaxA in
return# [Unit] ();
collectHeap : Addr# -> Addr# -> Addr# -> Addr# -> Unit
= \(pHeapBaseA pHeapTopA pBackBaseA ppBackTopA : Addr#).
let _ : Void# = write# [Addr#] ppBackTopA 0# pBackBaseA in
let x6 : Addr# = slotTop# in
let pSlotTopA : Addr# = read# [Addr#] x6 0# in
let x7 : Addr# = slotBase# in
let _ : Unit = evacuateRoots x7 pSlotTopA ppBackTopA in
return# [Unit] (scanHeap pBackBaseA ppBackTopA);
evacuateRoots : Addr# -> Addr# -> Addr# -> Unit
= \(ppSlotA pSlotTopA ppBackA : Addr#).
let pSlotA : Addr# = read# [Addr#] ppSlotA 0# in
let x8 : Bool# = ge# [Addr#] pSlotA pSlotTopA in
case x8 of {
True#
-> return# [Unit] ();
False#
-> let null : Addr# = promote# [Addr#] [Nat#] 0# in
let x9 : Bool# = eq# [Addr#] pSlotA null in
let _ : Unit
= case x9 of {
True#
-> ();
False#
-> let pSlotA' : Addr# = evacuateObject pSlotA ppBackA in
let _ : Void# = write# [Addr#] ppSlotA 0# pSlotA' in
()
} in
let x10 : Nat# = size# [Addr#] in
let ppSlotA' : Addr# = plusAddr# ppSlotA x10 in
tailcall3# [Addr#] [Addr#] [Addr#] [Unit] evacuateRoots ppSlotA' pSlotTopA ppBackA
};
evacuateObject : Addr# -> Addr# -> Addr#
= \(pObjA ppBackA : Addr#).
let pObj : Ptr# ?14 Obj = makePtr# [?14] [Obj] pObjA in
let format : Nat# = formatOfObject [?14] pObj in
case format of {
1#
-> let pNewObj0 : Ptr# ?18 Obj = readBrokenHeart [?14] [?18] pObj in
return# [Addr#] (takePtr# [?18] [Obj] pNewObj0);
_
-> let x11 : Bool# = isAnchored [?14] pObj in
case x11 of {
True#
-> return# [Addr#] pObjA;
False#
-> let size : Nat# = sizeOfObject [?14] pObj in
let pNewObj : Ptr# ?24 Obj
= read# [Ptr# ?24 Obj] ppBackA 0# in
let pNewObjA : Addr# = takePtr# [?24] [Obj] pNewObj in
let _ : Void# = copy# pNewObjA pObjA size in
let x12 : Addr# = plusAddr# pNewObjA size in
let _ : Void# = write# [Addr#] ppBackA 0# x12 in
let _ : Void# = writeBrokenHeart [?14] [?24] pObj pNewObj in
return# [Addr#] pNewObjA
}
};
scanHeap : Addr# -> Addr# -> Unit
= \(pScanA ppBackTopA : Addr#).
let pBackTopA : Addr# = read# [Addr#] ppBackTopA 0# in
let x13 : Bool# = ge# [Addr#] pScanA pBackTopA in
case x13 of {
True#
-> return# [Unit] ();
False#
-> let pScan : Ptr# ?31 Obj = makePtr# [?31] [Obj] pScanA in
let _ : Unit = scanObject [?31] pScan ppBackTopA in
let x14 : Nat# = sizeOfObject [?31] pScan in
let pScanA' : Addr# = plusAddr# pScanA x14 in
tailcall2# [Addr#] [Addr#] [Unit] scanHeap pScanA' ppBackTopA
};
scanObject : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x15 : Nat# = formatOfObject [r] pObj in
case x15 of {
0#
-> fail# [Unit];
1#
-> fail# [Unit];
2#
-> return# [Unit] (scanThunk [r] pObj ppBackTopA);
3#
-> return# [Unit] (scanBoxed [r] pObj ppBackTopA);
4#
-> return# [Unit] ();
5#
-> return# [Unit] (scanMixed [r] pObj ppBackTopA);
6#
-> return# [Unit] ();
_
-> fail# [Unit]
};
scanThunk : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x16 : Nat# = argsOfThunk [r] pObj in
return# [Unit] (scanThunk_arg [r] pObj x16 ppBackTopA);
scanThunk_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x17 : Bool# = eq# [Nat#] argsRemaining 0# in
case x17 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let pFieldA : Addr# = fieldOfThunk [r] pObj argIx in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] (scanThunk_arg [r]) pObj argIx ppBackTopA
};
scanBoxed : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x18 : Nat# = arityOfBoxed [r] pObj in
return# [Unit] (scanBoxed_arg [r] pObj x18 ppBackTopA);
scanBoxed_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x19 : Bool# = eq# [Nat#] argsRemaining 0# in
case x19 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let x20 : Ptr# r Obj = fieldOfBoxed [r] pObj argIx in
let pFieldA : Addr# = takePtr# [r] [Obj] x20 in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] (scanBoxed_arg [r]) pObj argIx ppBackTopA
};
scanMixed : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x21 : Nat# = arityOfMixed [r] pObj in
return# [Unit] (scanMixed_arg [r] pObj x21 ppBackTopA);
scanMixed_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x22 : Bool# = eq# [Nat#] argsRemaining 0# in
case x22 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let x23 : Ptr# r Obj = fieldOfMixed [r] pObj argIx in
let pFieldA : Addr# = takePtr# [r] [Obj] x23 in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] (scanMixed_arg [r]) pObj argIx ppBackTopA
}
}
Raw
Output.ddc
module Collect
export value collectInit : Nat# -> Unit;
export value collectHeap : Addr# -> Addr# -> Addr# -> Addr# -> Unit;
import foreign c value
malloc : Nat# -> Addr#;
import foreign c value
formatOfObject : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
sizeOfObject : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
readBrokenHeart : [r1 r2 : Region].Ptr# r1 Obj -> Ptr# r2 Obj;
import foreign c value
writeBrokenHeart : [r1 r2 : Region].Ptr# r1 Obj -> Ptr# r2 Obj -> Void#;
import foreign c value
isAnchored : [r : Region].Ptr# r Obj -> Bool#;
import foreign c value
argsOfThunk : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfThunk : [r : Region].Ptr# r Obj -> Nat# -> Addr#;
import foreign c value
arityOfBoxed : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfBoxed : [r : Region].Ptr# r Obj -> Nat# -> Ptr# r Obj;
import foreign c value
arityOfMixed : [r : Region].Ptr# r Obj -> Nat#;
import foreign c value
fieldOfMixed : [r : Region].Ptr# r Obj -> Nat# -> Ptr# r Obj;
with
letrec {
collectInit : Nat# -> Unit
= \(maxGCSlots : Nat#).
let x0 : Nat# = size# [Addr#] in
let x1 : Nat# = mul# [Nat#] maxGCSlots x0 in
let pSlotBaseA : Addr# = malloc x1 in
let x2 : Nat# = sub# [Nat#] maxGCSlots 1# in
let pSlotMaxA : Addr# = plusAddr# pSlotBaseA x2 in
let x3 : Addr# = slotBase# in
let _ : Void# = write# [Addr#] x3 0# pSlotBaseA in
let x4 : Addr# = slotTop# in
let _ : Void# = write# [Addr#] x4 0# pSlotBaseA in
let x5 : Addr# = slotMax# in
let _ : Void# = write# [Addr#] x5 0# pSlotMaxA in
return# [Unit] ();
collectHeap : Addr# -> Addr# -> Addr# -> Addr# -> Unit
= \(pHeapBaseA pHeapTopA pBackBaseA ppBackTopA : Addr#).
let _ : Void# = write# [Addr#] ppBackTopA 0# pBackBaseA in
let x6 : Addr# = slotTop# in
let pSlotTopA : Addr# = read# [Addr#] x6 0# in
let x7 : Addr# = slotBase# in
let _ : Unit = evacuateRoots x7 pSlotTopA ppBackTopA in
let x10000 : Unit = scanHeap pBackBaseA ppBackTopA in
return# [Unit] x10000;
evacuateRoots : Addr# -> Addr# -> Addr# -> Unit
= \(ppSlotA pSlotTopA ppBackA : Addr#).
let pSlotA : Addr# = read# [Addr#] ppSlotA 0# in
let x8 : Bool# = ge# [Addr#] pSlotA pSlotTopA in
case x8 of {
True#
-> return# [Unit] ();
False#
-> let null : Addr# = promote# [Addr#] [Nat#] 0# in
let x9 : Bool# = eq# [Addr#] pSlotA null in
let _ : Unit
= case x9 of {
True#
-> ();
False#
-> let pSlotA' : Addr# = evacuateObject pSlotA ppBackA in
let _ : Void# = write# [Addr#] ppSlotA 0# pSlotA' in
()
} in
let x10 : Nat# = size# [Addr#] in
let ppSlotA' : Addr# = plusAddr# ppSlotA x10 in
tailcall3# [Addr#] [Addr#] [Addr#] [Unit] evacuateRoots ppSlotA' pSlotTopA ppBackA
};
evacuateObject : Addr# -> Addr# -> Addr#
= \(pObjA ppBackA : Addr#).
let pObj : Ptr# ?14 Obj = makePtr# [?14] [Obj] pObjA in
let format : Nat# = formatOfObject [?14] pObj in
case format of {
1#
-> let pNewObj0 : Ptr# ?18 Obj = readBrokenHeart [?14] [?18] pObj in
let x10001 : Addr# = takePtr# [?18] [Obj] pNewObj0 in
return# [Addr#] x10001;
_
-> let x11 : Bool# = isAnchored [?14] pObj in
case x11 of {
True#
-> return# [Addr#] pObjA;
False#
-> let size : Nat# = sizeOfObject [?14] pObj in
let pNewObj : Ptr# ?24 Obj
= read# [Ptr# ?24 Obj] ppBackA 0# in
let pNewObjA : Addr# = takePtr# [?24] [Obj] pNewObj in
let _ : Void# = copy# pNewObjA pObjA size in
let x12 : Addr# = plusAddr# pNewObjA size in
let _ : Void# = write# [Addr#] ppBackA 0# x12 in
let _ : Void# = writeBrokenHeart [?14] [?24] pObj pNewObj in
return# [Addr#] pNewObjA
}
};
scanHeap : Addr# -> Addr# -> Unit
= \(pScanA ppBackTopA : Addr#).
let pBackTopA : Addr# = read# [Addr#] ppBackTopA 0# in
let x13 : Bool# = ge# [Addr#] pScanA pBackTopA in
case x13 of {
True#
-> return# [Unit] ();
False#
-> let pScan : Ptr# ?31 Obj = makePtr# [?31] [Obj] pScanA in
let _ : Unit = scanObject [?31] pScan ppBackTopA in
let x14 : Nat# = sizeOfObject [?31] pScan in
let pScanA' : Addr# = plusAddr# pScanA x14 in
tailcall2# [Addr#] [Addr#] [Unit] scanHeap pScanA' ppBackTopA
};
scanObject : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x15 : Nat# = formatOfObject [r] pObj in
case x15 of {
0#
-> fail# [Unit];
1#
-> fail# [Unit];
2#
-> let x10002 : Unit = scanThunk [r] pObj ppBackTopA in
return# [Unit] x10002;
3#
-> let x10003 : Unit = scanBoxed [r] pObj ppBackTopA in
return# [Unit] x10003;
4#
-> return# [Unit] ();
5#
-> let x10004 : Unit = scanMixed [r] pObj ppBackTopA in
return# [Unit] x10004;
6#
-> return# [Unit] ();
_
-> fail# [Unit]
};
scanThunk : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x16 : Nat# = argsOfThunk [r] pObj in
let x10005 : Unit = scanThunk_arg [r] pObj x16 ppBackTopA in
return# [Unit] x10005;
scanThunk_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x17 : Bool# = eq# [Nat#] argsRemaining 0# in
case x17 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let pFieldA : Addr# = fieldOfThunk [r] pObj argIx in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
let x10006 : Ptr# r Obj -> Nat# -> Addr# -> Unit = scanThunk_arg [r] in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] x10006 pObj argIx ppBackTopA
};
scanBoxed : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x18 : Nat# = arityOfBoxed [r] pObj in
let x10007 : Unit = scanBoxed_arg [r] pObj x18 ppBackTopA in
return# [Unit] x10007;
scanBoxed_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x19 : Bool# = eq# [Nat#] argsRemaining 0# in
case x19 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let x20 : Ptr# r Obj = fieldOfBoxed [r] pObj argIx in
let pFieldA : Addr# = takePtr# [r] [Obj] x20 in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
let x10008 : Ptr# r Obj -> Nat# -> Addr# -> Unit = scanBoxed_arg [r] in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] x10008 pObj argIx ppBackTopA
};
scanMixed : [r : Region].Ptr# r Obj -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(ppBackTopA : Addr#).
let x21 : Nat# = arityOfMixed [r] pObj in
let x10009 : Unit = scanMixed_arg [r] pObj x21 ppBackTopA in
return# [Unit] x10009;
scanMixed_arg : [r : Region].Ptr# r Obj -> Nat# -> Addr# -> Unit
= /\(r : Region).
\(pObj : Ptr# r Obj).\(argsRemaining : Nat#).\(ppBackTopA : Addr#).
let x22 : Bool# = eq# [Nat#] argsRemaining 0# in
case x22 of {
True#
-> return# [Unit] ();
False#
-> let argIx : Nat# = sub# [Nat#] argsRemaining 1# in
let x23 : Ptr# r Obj = fieldOfMixed [r] pObj argIx in
let pFieldA : Addr# = takePtr# [r] [Obj] x23 in
let _ : Addr# = evacuateObject pFieldA ppBackTopA in
let x10010 : Ptr# r Obj -> Nat# -> Addr# -> Unit = scanMixed_arg [r] in
tailcall3# [Ptr# r Obj] [Nat#] [Addr#] [Unit] x10010 pObj argIx ppBackTopA
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment