Permalink
Browse files

[hoopl] refactor the op conversion process

  • Loading branch information...
1 parent 4db171f commit fb79b12852023c09a74b300133666871f9324123 @pmurias pmurias committed Apr 24, 2011
Showing with 44 additions and 47 deletions.
  1. +1 −1 hoopl/ConstProp.hs
  2. +2 −2 hoopl/DeadRegs.hs
  3. +12 −10 hoopl/Insn.hs
  4. +29 −34 hoopl/Nam.hs
View
@@ -18,7 +18,7 @@ import Compiler.Hoopl
-- Type and definition of the lattice
type M = CheckingFuelMonad (SimpleUniqueMonad)
-type ConstFact = Map.Map Int (WithTop Expr)
+type ConstFact = Map.Map Reg (WithTop Expr)
constLattice :: DataflowLattice ConstFact
constLattice = DataflowLattice
{ fact_name = "Constant propagation"
View
@@ -15,11 +15,11 @@ import Compiler.Hoopl
-- DeadRegsFact:
-- The set of registers alive at that point
-type DeadRegsFact = S.Set Int
+type DeadRegsFact = S.Set Reg
type M = CheckingFuelMonad (SimpleUniqueMonad)
-deadRegsInitFact :: S.Set Int
+deadRegsInitFact :: S.Set Reg
deadRegsInitFact = S.empty
deadRegsLattice :: DataflowLattice DeadRegsFact
View
@@ -1,18 +1,20 @@
{-# LANGUAGE ViewPatterns,GADTs,StandaloneDeriving,NoMonomorphismRestriction #-}
-module Insn (Insn(..),Expr(..),mapE,insnToGraph,insnTarget,exprs) where
+module Insn (Reg,Insn(..),Expr(..),mapE,insnToGraph,insnTarget,exprs) where
import Compiler.Hoopl
-- a side effect free expression
-- FIXME handle Box and Ann smartly
-data Expr = Double Double | StrLit String | ScopedLex String | Reg Int
+
+type Reg = Int
+data Expr = Double Double | StrLit String | ScopedLex String | Reg Reg
deriving (Show,Eq)
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
+ 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
deriving instance Show (Insn e x)
@@ -46,10 +48,10 @@ insnToGraph n@(RegSet _ _) = mkMiddle n
-- the register the instruction writes to
-insnTarget :: Insn e x -> Maybe Int
+insnTarget :: Insn e x -> Maybe Reg
insnTarget insn = Just $ r insn
where
- r :: Insn e x -> Int
+ r :: Insn e x -> Reg
r (Fetch reg _) = reg
r (Subcall reg _) = reg
r (BifPlus reg _ _) = reg
View
@@ -17,16 +17,33 @@ import Util
instance NonLocal (Insn)
+type CM a = State Int a
-freshId = do
+freshID :: CM Reg
+freshID = do
id <- get
put (id+1)
return $ id
simple val = return $ (emptyGraph,val)
-convert :: Op.Op -> State Int ((Graph Insn O O),Expr)
+-- TODO: pick better name?
+composit args func = do
+ converted <- mapM convert args
+ let (setup,vals) = unzip converted
+ (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 args transform = do
+ id <- freshID
+ composit args (\vals ->
+ return (mkMiddle $ transform id vals,Reg id))
+
+
+convert :: Op.Op -> CM ((Graph Insn O O),Expr)
-- ops which map directly to Expr
@@ -41,39 +58,17 @@ convert (Op.Box _ op) = convert op
convert (Op.Const op) = convert op
-convert (Op.Prog ops) = do
- converted <- mapM convert ops
- let (setup,vals) = unzip converted
- return $ (foldl1 (<*>) setup,last vals)
+convert (Op.Prog ops) = composit ops (\vals -> return (emptyGraph,last vals))
-convert (Op.Subcall args) = do
- converted <- mapM convert args
- let (setup,vals) = unzip converted
- id <- freshId
- return $ (((foldl1 (<*>) setup) <*> (mkMiddle $ Subcall id vals)),Reg id)
-
-convert (Op.Fetch arg) = do
- id <- freshId
- (setup,val) <- convert arg
- return $ (setup <*> (mkMiddle $ Fetch id val),Reg id)
-
-convert (Op.BifPlus a b) = do
- id <- freshId
- (setup1,val1) <- convert a
- (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.Subcall args) = basicInsn args Subcall
+
+convert (Op.Fetch arg) = basicInsn [arg] (\reg [arg] -> Fetch reg arg)
+
+convert (Op.BifPlus a b) = basicInsn [a,b] (\reg [a,b] -> BifPlus reg a b)
+
+convert (Op.BifDivide a b) = basicInsn [a,b] (\reg [a,b] -> BifDivide reg a b)
+
+convert (Op.BifMinus a b) = basicInsn [a,b] (\reg [a,b] -> BifMinus reg a b)
convert (Op.Sink arg) = convert arg

0 comments on commit fb79b12

Please sign in to comment.