+stixExpr_ConFold :: StixExpr -> StixExpr
+stixStmt_ConFold :: StixStmt -> StixStmt
+
+stixStmt_ConFold stmt
+ = case stmt of
+ StAssignReg pk reg@(StixTemp _) src
+ -> StAssignReg pk reg (stixExpr_ConFold src)
+ StAssignReg pk reg@(StixMagicId mid) src
+ -- Replace register leaves with appropriate StixTrees for
+ -- the given target. MagicIds which map to a reg on this arch are left unchanged.
+ -- Assigning to BaseReg is always illegal, so we check for that.
+ -> case mid of {
+ BaseReg -> panic "stixStmt_ConFold: assignment to BaseReg";
+ other ->
+ case get_MagicId_reg_or_addr mid of
+ Left realreg
+ -> StAssignReg pk reg (stixExpr_ConFold src)
+ Right baseRegAddr
+ -> stixStmt_ConFold (StAssignMem pk baseRegAddr src)
+ }
+ StAssignMem pk addr src
+ -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
+ StVoidable expr
+ -> StVoidable (stixExpr_ConFold expr)
+ StJump dsts addr
+ -> StJump dsts (stixExpr_ConFold addr)
+ StCondJump addr test
+ -> let test_opt = stixExpr_ConFold test
+ in
+ if manifestlyZero test_opt
+ then StComment (mkFastString ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+ else StCondJump addr (stixExpr_ConFold test)
+ StData pk datas
+ -> StData pk (map stixExpr_ConFold datas)
+ other
+ -> other
+ where
+ manifestlyZero (StInt 0) = True
+ manifestlyZero other = False
+
+stixExpr_ConFold expr
+ = case expr of
+ StInd pk addr
+ -> StInd pk (stixExpr_ConFold addr)
+ StCall fn cconv pk args
+ -> StCall fn cconv pk (map stixExpr_ConFold args)
+ StIndex pk (StIndex pk' base off) off'
+ -- Fold indices together when the types match:
+ | pk == pk'
+ -> StIndex pk (stixExpr_ConFold base)
+ (stixExpr_ConFold (StMachOp MO_Nat_Add [off, off']))
+ StIndex pk base off
+ -> StIndex pk (stixExpr_ConFold base) (stixExpr_ConFold off)
+
+ StMachOp mop args
+ -- For PrimOps, we first optimize the children, and then we try
+ -- our hand at some constant-folding.
+ -> stixMachOpFold mop (map stixExpr_ConFold args)
+ StReg (StixMagicId mid)
+ -- Replace register leaves with appropriate StixTrees for
+ -- the given target. MagicIds which map to a reg on this arch are left unchanged.
+ -- For the rest, BaseReg is taken to mean the address of the reg table
+ -- in MainCapability, and for all others we generate an indirection to
+ -- its location in the register table.
+ -> case get_MagicId_reg_or_addr mid of
+ Left realreg -> expr
+ Right baseRegAddr
+ -> case mid of
+ BaseReg -> stixExpr_ConFold baseRegAddr
+ other -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
+ other
+ -> other