[hoopl] refactor all the ops from Insn to Op

hoopl/ConstProp.hs

@@ -42,9 +42,8 @@ varHasLit = mkFTransfer3 hack1 ft hack2 -- HACK: we don't have thsoe node types
  where
   ft :: Insn O O -> ConstFact ->  ConstFact
 
-  ft (RegSet reg constant@(Double _)) f = Map.insert reg (PElem constant) f
-  ft (insnTarget -> Just reg)  f = (Map.insert reg Top f)
-  ft _ f = f
+  ft (Op reg (RegSet constant@(Double _))) f = Map.insert reg (PElem constant) f
+  ft (Op reg _)  f = (Map.insert reg Top f)
 
   hack1 _ f = f
   hack2 _ _ = noFacts
@@ -79,9 +78,15 @@ simplify :: FuelMonad m => FwdRewrite m Insn ConstFact
 simplify = mkFRewrite s
  where
     s :: (Monad m) => Insn e x -> a -> m (Maybe (Graph Insn e x))
-    s (BifPlus reg (Double a) (Double b)) _ = singleInsn $ RegSet reg (Double (a+b))
-    s (BifMinus reg (Double a) (Double b)) _ = singleInsn $ RegSet reg (Double (a-b))
-    s (BifDivide reg (Double a) (Double b)) _ = singleInsn $ RegSet reg (Double (a/b))
+    s (Op reg op) _ = case op of  
+        BifPlus (Double a) (Double b) -> double (a+b)
+        BifMinus (Double a) (Double b) -> double (a-b)
+        BifDivide (Double a) (Double b) -> double (a/b)
+        _ -> return Nothing
+        where
+            double = singleInsn . (Op reg) . RegSet . Double
+
     s _ _ = return Nothing
 
 
+

hoopl/DeadRegs.hs

@@ -37,7 +37,7 @@ usedRegs :: BwdTransfer Insn DeadRegsFact
 usedRegs = mkBTransfer3 hack1 ft hack2 -- HACK: we don't have those node types yet
  where
   ft :: Insn O O -> DeadRegsFact ->  DeadRegsFact
-  ft insn f = S.union f (S.fromList $ mapMaybe regID $ exprs insn)
+  ft (Op r op) f = S.union f (S.fromList $ mapMaybe regID $ exprs op)
   hack1 _ f = f
   hack2 _ _ = S.empty
   regID (Reg r) = Just r
@@ -57,7 +57,7 @@ removeNoop :: FuelMonad m => BwdRewrite m Insn DeadRegsFact
 removeNoop = mkBRewrite s
  where
     s :: (Monad m) => Insn e x -> Fact x DeadRegsFact -> m (Maybe (Graph Insn e x))
-    s (RegSet r _) live =
+    s (Op r (RegSet _)) live =
             if (S.member r live) then return $ Nothing
             else return $ Just emptyGraph
     s _ _ = return $ Nothing

hoopl/Insn.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE ViewPatterns,GADTs,StandaloneDeriving,NoMonomorphismRestriction #-}
-module Insn (Reg,Insn(..),Expr(..),mapE,insnToGraph,insnTarget,exprs) where
+module Insn (Reg,Insn(..),Expr(..),Op(..),mapE,insnToGraph,exprs) where
 import Compiler.Hoopl
 -- a side effect free expression
 -- FIXME handle Box and Ann smartly
@@ -9,16 +9,20 @@ data Expr = Double Double |  StrLit String | ScopedLex String | CoreLex String |
     deriving (Show,Eq)
 
 data Insn e x where
-    Fetch :: Reg -> Expr -> Insn O O
-    Subcall :: Reg -> [Expr] -> Insn O O
-    BifPlus :: Reg -> Expr -> Expr -> Insn O O
-    BifMinus :: Reg -> Expr -> Expr -> Insn O O
-    BifDivide :: Reg -> Expr -> Expr -> Insn O O
-    RegSet  :: Reg -> Expr -> Insn O O
-    ObjGetBool  :: Reg -> Expr -> Insn O O
     CondBranch  :: Expr -> Label -> Label -> Insn O C
     Goto :: Label -> Insn O C
     Label :: Label -> Insn C O
+    Op :: Reg -> Op  -> Insn O O
+
+data Op where
+    Fetch :: Expr -> Op
+    Subcall :: [Expr] -> Op
+    BifPlus :: Expr -> Expr -> Op
+    BifMinus :: Expr -> Expr -> Op
+    BifDivide :: Expr -> Expr -> Op
+    RegSet  ::  Expr -> Op
+    ObjGetBool  :: Expr -> Op
+    deriving (Show,Eq)
 
 deriving instance Show (Insn e x)
 
@@ -32,42 +36,35 @@ instance HooplNode (Insn) where
     mkLabelNode = Label
 
 -- map over all the expressions inside
+-- BOILERPLATE
+mapEO :: (Expr -> Expr) -> Op -> Op
+mapEO func (BifPlus a b) = BifPlus (func a) (func b)
+mapEO func (BifDivide a b) = BifDivide (func a) (func b)
+mapEO func (BifMinus a b) = BifMinus (func a) (func b)
+mapEO func (Subcall args)   = Subcall (map func args)
+mapEO func (RegSet a) = RegSet (func a) 
+mapEO func (Fetch a) = Fetch (func a)
+
 mapE :: (Expr -> Expr) -> Insn e x -> Insn e x
-mapE func (BifPlus reg a b) = BifPlus reg (func a) (func b)
-mapE func (BifDivide reg a b) = BifDivide reg (func a) (func b)
-mapE func (BifMinus reg a b) = BifMinus reg (func a) (func b)
-mapE func (Subcall reg args)   = Subcall reg (map func args)
-mapE func (RegSet reg a) = RegSet reg (func a) 
-mapE func (Fetch reg a) = Fetch reg (func a)
+mapE func (Op r op) = Op (r :: Reg) (mapEO func (op :: Op))
+mapE func (CondBranch cond true false) = CondBranch (func cond) true false
+mapE _ n@(Goto _) = n
+mapE _ n@(Label _) = n
 
--- expresions in the instruction
-exprs :: Insn e x -> [Expr]
-exprs (BifPlus reg a b) = [a,b]
-exprs (BifDivide reg a b) = [a,b]
-exprs (BifMinus reg a b) = [a,b]
-exprs (Subcall reg args) = args
-exprs (RegSet reg a) = [a] 
-exprs (Fetch reg a) = [a]
+-- BOILERPLATE
+exprs :: Op -> [Expr]
+exprs (BifPlus a b) = [a,b]
+exprs (BifDivide a b) = [a,b]
+exprs (BifMinus a b) = [a,b]
+exprs (Subcall args) = args
+exprs (RegSet a) = [a] 
+exprs (Fetch a) = [a]
 
 
 -- convert an expression to a graph containing only it
 insnToGraph :: Insn e x -> Graph Insn e x
-insnToGraph n@(Fetch _ _)   = mkMiddle n
-insnToGraph n@(Subcall _ _)    = mkMiddle n
-insnToGraph n@(BifPlus   _ _ _)    = mkMiddle n
-insnToGraph n@(BifDivide _ _ _)    = mkMiddle n
-insnToGraph n@(BifMinus _ _ _)    = mkMiddle n
-insnToGraph n@(RegSet _ _)    = mkMiddle n
-
+insnToGraph n@(Op _ _)   = mkMiddle n
+insnToGraph n@(CondBranch _ _ _)   = mkLast n
+insnToGraph n@(Goto _)   = mkLast n
+insnToGraph n@(Label _)   = mkFirst n
 
--- the register the instruction writes to
-insnTarget :: Insn e x -> Maybe Reg
-insnTarget insn = Just $ r insn
-    where 
-          r :: Insn e x -> Reg
-          r (Fetch reg _) = reg
-          r (Subcall reg _) = reg
-          r (BifPlus reg _ _) = reg
-          r (BifMinus reg _ _) = reg
-          r (BifDivide reg _ _) = reg
-          r (RegSet reg _) = reg

hoopl/Nam.hs

@@ -39,12 +39,12 @@ composit args func = do
     (extraSetup,ret) <- func vals
     return ((foldl (<*>) emptyGraph  setup) <*> extraSetup,ret)
 
-basicInsn :: [Op.Op] -> (Reg -> [Expr] -> Insn O O) ->  CM ((Graph Insn O O),Expr)
+basicInsn :: [Op.Op] -> ([Expr] -> Op) ->  CM ((Graph Insn O O),Expr)
 
 basicInsn args transform = do
     id <- freshID
     composit args (\vals ->
-        return (mkMiddle $ transform id vals,Reg id))
+        return (mkMiddle $ Op id (transform vals),Reg id))
 
 branch :: Expr -> Label -> Label -> AGraph Insn O C
 branch cond' trueLabel falseLabel = 
@@ -71,14 +71,14 @@ convert (Op.Prog ops) = composit ops (\vals -> return (emptyGraph,last vals))
 
 convert (Op.Subcall args) = basicInsn args Subcall
 
-convert (Op.Fetch arg) = basicInsn [arg] (\reg [arg] -> Fetch reg arg)
-convert (Op.ObjGetBool arg) = basicInsn [arg] (\reg [arg] -> ObjGetBool reg arg)
+convert (Op.Fetch arg) = basicInsn [arg] (\[arg] -> Fetch arg)
+convert (Op.ObjGetBool arg) = basicInsn [arg] (\[arg] -> ObjGetBool arg)
 
-convert (Op.BifPlus a b) = basicInsn [a,b] (\reg [a,b] -> BifPlus reg a b)
+convert (Op.BifPlus a b) = basicInsn [a,b] (\[a,b] -> BifPlus a b)
 
-convert (Op.BifDivide a b) = basicInsn [a,b] (\reg [a,b] -> BifDivide reg a b)
+convert (Op.BifDivide a b) = basicInsn [a,b] (\[a,b] -> BifDivide a b)
 
-convert (Op.BifMinus a b) = basicInsn [a,b] (\reg [a,b] -> BifMinus reg a b)
+convert (Op.BifMinus a b) = basicInsn [a,b] (\[a,b] -> BifMinus a b)
 
 convert (Op.Sink arg) = convert arg