[hoopl] constant folding for bif_minus and bif_divide

hoopl/ConstProp.hs

@@ -43,6 +43,8 @@ varHasLit = mkFTransfer ft
   ft :: Insn e x -> ConstFact -> Fact x ConstFact
 
   ft (BifPlus reg _ _)   f = Map.insert reg Top f
+  ft (BifDivide reg _ _)   f = Map.insert reg Top f
+  ft (BifMinus reg _ _)   f = Map.insert reg Top f
   ft (Subcall reg _) f = Map.insert reg Top f
   ft (Fetch reg _) f = Map.insert reg Top f
   ft (RegSet reg constant@(Double _)) f = Map.insert reg (PElem constant) f
@@ -78,6 +80,8 @@ 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 _ _ = return Nothing
 
 

hoopl/Insn.hs

@@ -10,16 +10,22 @@ data Insn e x where
     Fetch :: Int -> Expr -> Insn O O
     Subcall :: Int -> [Expr] -> Insn O O
     BifPlus :: Int -> Expr -> Expr -> Insn O O
+    BifMinus :: Int -> Expr -> Expr -> Insn O O
+    BifDivide :: Int -> Expr -> Expr -> Insn O O
     RegSet  :: Int -> Expr -> Insn O O
 
 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)
 
 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@(BifPlus   _ _ _)    = mkMiddle n
+insnToGraph n@(BifDivide _ _ _)    = mkMiddle n
+insnToGraph n@(BifMinus _ _ _)    = mkMiddle n
 insnToGraph n@(RegSet _ _)    = mkMiddle n

hoopl/Nam.hs

@@ -62,6 +62,18 @@ convert (Op.BifPlus a b) = do
     (setup2,val2) <- convert b
     return $ (setup1 <*> setup2 <*> (mkMiddle $ BifPlus id val1 val2),Reg id)
 
+convert (Op.BifDivide a b) = do
+    id <- freshId
+    (setup1,val1) <- convert a
+    (setup2,val2) <- convert b
+    return $ (setup1 <*> setup2 <*> (mkMiddle $ BifDivide id val1 val2),Reg id)
+
+convert (Op.BifMinus a b) = do
+    id <- freshId
+    (setup1,val1) <- convert a
+    (setup2,val2) <- convert b
+    return $ (setup1 <*> setup2 <*> (mkMiddle $ BifMinus id val1 val2),Reg id)
+
 convert (Op.Sink arg) = convert arg
 
 -- HACK those nodes shouldn't be ignored

hoopl/Op.hs

@@ -19,6 +19,8 @@ data Op =
     | Box String Op
     | Double Double
     | BifPlus Op Op
+    | BifDivide Op Op
+    | BifMinus Op Op
     | Sink Op
     deriving Show
 
@@ -35,7 +37,11 @@ rawOpsToOp (Array a) = case (V.toList a) of
     (str -> "prog"):rest -> Prog $ map rawOpsToOp rest
     [(str -> "fetch"),arg] -> Fetch $ rawOpsToOp arg
     [(str -> "const"),arg] -> Const $ rawOpsToOp arg
-    [(str -> "bif_plus"),a,b] -> BifPlus (rawOpsToOp a) (rawOpsToOp b)
+
+    [(str -> "bif_plus"),a,b]   -> BifPlus (rawOpsToOp a) (rawOpsToOp b)
+    [(str -> "bif_minus"),a,b]  -> BifMinus (rawOpsToOp a) (rawOpsToOp b)
+    [(str -> "bif_divide"),a,b] -> BifDivide (rawOpsToOp a) (rawOpsToOp b)
+
     [(str -> "scopedlex"),arg] -> ScopedLex $ rawOpsToOp arg
     [(str -> "box"),(str -> typeName),thing] -> Box typeName (rawOpsToOp thing)
     ((str -> "subcall"):sig:rest) -> Subcall (map rawOpsToOp rest)