Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

changed shift and rotate so they allow expressions as both parameters

  • Loading branch information...
commit e9e94883b145f18e55060106152662ef9830de29 1 parent 1dfe072
seni authored
Showing with 433 additions and 407 deletions.
  1. +37 −36 Language/Atom/Code.hs
  2. +186 −166 Language/Atom/Expressions.hs
  3. +210 −205 Language/Atom/UeMap.hs
73 Language/Atom/Code.hs
View
@@ -133,43 +133,44 @@ codeUE mp config ues d (ue, n) =
MUVRef (MUVArray (UA _ n _) _) -> [cStateName config, ".", n, "[", a, "]"]
MUVRef (MUVArray (UAExtern n _) _) -> [n, "[", a, "]"]
MUVRef (MUVExtern n _) -> [n]
- MUCast _ _ -> ["(", cType (typeOf ue mp), ") ", a]
- MUConst c -> [showConst c]
- MUAdd _ _ -> [a, " + ", b]
- MUSub _ _ -> [a, " - ", b]
- MUMul _ _ -> [a, " * ", b]
- MUDiv _ _ -> [a, " / ", b]
- MUMod _ _ -> [a, " % ", b]
- MUNot _ -> ["! ", a]
- MUAnd _ -> intersperse " && " operands
- MUBWNot _ -> ["~ ", a]
- MUBWAnd _ _ -> [a, " & ", b]
- MUBWOr _ _ -> [a, " | ", b]
- MUBWXor _ _ -> [a, " ^ ", b]
- MUShift _ n -> (if n >= 0 then [a, " << ", show n] else [a, " >> ", show (negate n)])
- MUEq _ _ -> [a, " == ", b]
- MULt _ _ -> [a, " < " , b]
- MUMux _ _ _ -> [a, " ? " , b, " : ", c]
- MUF2B _ -> ["*((", ct Word32, " *) &(", a, "))"]
- MUD2B _ -> ["*((", ct Word64, " *) &(", a, "))"]
- MUB2F _ -> ["*((", ct Float , " *) &(", a, "))"]
- MUB2D _ -> ["*((", ct Double, " *) &(", a, "))"]
+ MUCast _ _ -> ["(", cType (typeOf ue mp), ") ", a]
+ MUConst c -> [showConst c]
+ MUAdd _ _ -> [a, " + ", b]
+ MUSub _ _ -> [a, " - ", b]
+ MUMul _ _ -> [a, " * ", b]
+ MUDiv _ _ -> [a, " / ", b]
+ MUMod _ _ -> [a, " % ", b]
+ MUNot _ -> ["! ", a]
+ MUAnd _ -> intersperse " && " operands
+ MUBWNot _ -> ["~ ", a]
+ MUBWAnd _ _ -> [a, " & ", b]
+ MUBWOr _ _ -> [a, " | ", b]
+ MUBWXor _ _ -> [a, " ^ ", b]
+ MUBWShiftL _ _ -> [a, " << ", b]
+ MUBWShiftR _ _ -> [a, " >> ", b]
+ MUEq _ _ -> [a, " == ", b]
+ MULt _ _ -> [a, " < " , b]
+ MUMux _ _ _ -> [a, " ? " , b, " : ", c]
+ MUF2B _ -> ["*((", ct Word32, " *) &(", a, "))"]
+ MUD2B _ -> ["*((", ct Word64, " *) &(", a, "))"]
+ MUB2F _ -> ["*((", ct Float , " *) &(", a, "))"]
+ MUB2D _ -> ["*((", ct Double, " *) &(", a, "))"]
-- math.h:
- MUPi -> [ "M_PI" ]
- MUExp _ -> [ "exp", f, " ( ", a, " )"]
- MULog _ -> [ "log", f, " ( ", a, " )"]
- MUSqrt _ -> [ "sqrt", f, " ( ", a, " )"]
- MUPow _ _ -> [ "pow", f, " ( ", a, ", ", b, " )"]
- MUSin _ -> [ "sin", f, " ( ", a, " )"]
- MUAsin _ -> [ "asin", f, " ( ", a, " )"]
- MUCos _ -> [ "cos", f, " ( ", a, " )"]
- MUAcos _ -> [ "acos", f, " ( ", a, " )"]
- MUSinh _ -> [ "sinh", f, " ( ", a, " )"]
- MUCosh _ -> [ "cosh", f, " ( ", a, " )"]
- MUAsinh _ -> [ "asinh", f, " ( ", a, " )"]
- MUAcosh _ -> [ "acosh", f, " ( ", a, " )"]
- MUAtan _ -> [ "atan", f, " ( ", a, " )"]
- MUAtanh _ -> [ "atanh", f, " ( ", a, " )"]
+ MUPi -> [ "M_PI" ]
+ MUExp _ -> [ "exp", f, " ( ", a, " )"]
+ MULog _ -> [ "log", f, " ( ", a, " )"]
+ MUSqrt _ -> [ "sqrt", f, " ( ", a, " )"]
+ MUPow _ _ -> [ "pow", f, " ( ", a, ", ", b, " )"]
+ MUSin _ -> [ "sin", f, " ( ", a, " )"]
+ MUAsin _ -> [ "asin", f, " ( ", a, " )"]
+ MUCos _ -> [ "cos", f, " ( ", a, " )"]
+ MUAcos _ -> [ "acos", f, " ( ", a, " )"]
+ MUSinh _ -> [ "sinh", f, " ( ", a, " )"]
+ MUCosh _ -> [ "cosh", f, " ( ", a, " )"]
+ MUAsinh _ -> [ "asinh", f, " ( ", a, " )"]
+ MUAcosh _ -> [ "acosh", f, " ( ", a, " )"]
+ MUAtan _ -> [ "atan", f, " ( ", a, " )"]
+ MUAtanh _ -> [ "atanh", f, " ( ", a, " )"]
where
ct = cType
a = head operands
352 Language/Atom/Expressions.hs
View
@@ -47,8 +47,10 @@ module Language.Atom.Expressions
, complement
, (.|.)
, xor
- , shift
- , rotate
+ , (.<<.)
+ , (.>>.)
+ , rol
+ , ror
, bitSize
, isSigned
-- * Equality and Comparison
@@ -192,45 +194,46 @@ data UA
-- | A typed expression.
data E a where
- VRef :: V a -> E a
- Const :: a -> E a
- Cast :: (NumE a, NumE b) => E a -> E b
- Add :: NumE a => E a -> E a -> E a
- Sub :: NumE a => E a -> E a -> E a
- Mul :: NumE a => E a -> E a -> E a
- Div :: NumE a => E a -> E a -> E a
- Mod :: IntegralE a => E a -> E a -> E a
- Not :: E Bool -> E Bool
- And :: E Bool -> E Bool -> E Bool
- BWNot :: IntegralE a => E a -> E a
- BWAnd :: IntegralE a => E a -> E a -> E a
- BWOr :: IntegralE a => E a -> E a -> E a
- BWXor :: IntegralE a => E a -> E a -> E a
- Shift :: IntegralE a => E a -> Int -> E a
- Eq :: EqE a => E a -> E a -> E Bool
- Lt :: OrdE a => E a -> E a -> E Bool
- Mux :: E Bool -> E a -> E a -> E a
- F2B :: E Float -> E Word32
- D2B :: E Double -> E Word64
- B2F :: E Word32 -> E Float
- B2D :: E Word64 -> E Double
- Retype :: UE -> E a
+ VRef :: V a -> E a
+ Const :: a -> E a
+ Cast :: (NumE a, NumE b) => E a -> E b
+ Add :: NumE a => E a -> E a -> E a
+ Sub :: NumE a => E a -> E a -> E a
+ Mul :: NumE a => E a -> E a -> E a
+ Div :: NumE a => E a -> E a -> E a
+ Mod :: IntegralE a => E a -> E a -> E a
+ Not :: E Bool -> E Bool
+ And :: E Bool -> E Bool -> E Bool
+ BWNot :: IntegralE a => E a -> E a
+ BWAnd :: IntegralE a => E a -> E a -> E a
+ BWOr :: IntegralE a => E a -> E a -> E a
+ BWXor :: IntegralE a => E a -> E a -> E a
+ BWShiftL :: ( IntegralE a, IntegralE b ) => E a -> E b -> E a
+ BWShiftR :: ( IntegralE a, IntegralE b ) => E a -> E b -> E a
+ Eq :: EqE a => E a -> E a -> E Bool
+ Lt :: OrdE a => E a -> E a -> E Bool
+ Mux :: E Bool -> E a -> E a -> E a
+ F2B :: E Float -> E Word32
+ D2B :: E Double -> E Word64
+ B2F :: E Word32 -> E Float
+ B2D :: E Word64 -> E Double
+ Retype :: UE -> E a
-- math.h:
- Pi :: FloatingE a => E a
- Exp :: FloatingE a => E a -> E a
- Log :: FloatingE a => E a -> E a
- Sqrt :: FloatingE a => E a -> E a
- Pow :: FloatingE a => E a -> E a -> E a
- Sin :: FloatingE a => E a -> E a
- Asin :: FloatingE a => E a -> E a
- Cos :: FloatingE a => E a -> E a
- Acos :: FloatingE a => E a -> E a
- Sinh :: FloatingE a => E a -> E a
- Cosh :: FloatingE a => E a -> E a
- Asinh :: FloatingE a => E a -> E a
- Acosh :: FloatingE a => E a -> E a
- Atan :: FloatingE a => E a -> E a
- Atanh :: FloatingE a => E a -> E a
+ Pi :: FloatingE a => E a
+ Exp :: FloatingE a => E a -> E a
+ Log :: FloatingE a => E a -> E a
+ Sqrt :: FloatingE a => E a -> E a
+ Pow :: FloatingE a => E a -> E a -> E a
+ Sin :: FloatingE a => E a -> E a
+ Asin :: FloatingE a => E a -> E a
+ Cos :: FloatingE a => E a -> E a
+ Acos :: FloatingE a => E a -> E a
+ Sinh :: FloatingE a => E a -> E a
+ Cosh :: FloatingE a => E a -> E a
+ Asinh :: FloatingE a => E a -> E a
+ Acosh :: FloatingE a => E a -> E a
+ Atan :: FloatingE a => E a -> E a
+ Atanh :: FloatingE a => E a -> E a
instance Show (E a) where
show _ = error "Show (E a) not implemented"
@@ -240,44 +243,45 @@ instance Expr a => Eq (E a) where
-- | An untyped term.
data UE
- = UVRef UV
- | UConst Const
- | UCast Type UE
- | UAdd UE UE
- | USub UE UE
- | UMul UE UE
- | UDiv UE UE
- | UMod UE UE
- | UNot UE
- | UAnd [UE]
- | UBWNot UE
- | UBWAnd UE UE
- | UBWOr UE UE
- | UBWXor UE UE
- | UShift UE Int
- | UEq UE UE
- | ULt UE UE
- | UMux UE UE UE
- | UF2B UE
- | UD2B UE
- | UB2F UE
- | UB2D UE
+ = UVRef UV
+ | UConst Const
+ | UCast Type UE
+ | UAdd UE UE
+ | USub UE UE
+ | UMul UE UE
+ | UDiv UE UE
+ | UMod UE UE
+ | UNot UE
+ | UAnd [UE]
+ | UBWNot UE
+ | UBWAnd UE UE
+ | UBWOr UE UE
+ | UBWXor UE UE
+ | UBWShiftL UE UE
+ | UBWShiftR UE UE
+ | UEq UE UE
+ | ULt UE UE
+ | UMux UE UE UE
+ | UF2B UE
+ | UD2B UE
+ | UB2F UE
+ | UB2D UE
-- math.h:
| UPi
- | UExp UE
- | ULog UE
- | USqrt UE
- | UPow UE UE
- | USin UE
- | UAsin UE
- | UCos UE
- | UAcos UE
- | USinh UE
- | UCosh UE
- | UAsinh UE
- | UAcosh UE
- | UAtan UE
- | UAtanh UE
+ | UExp UE
+ | ULog UE
+ | USqrt UE
+ | UPow UE UE
+ | USin UE
+ | UAsin UE
+ | UCos UE
+ | UAcos UE
+ | USinh UE
+ | UCosh UE
+ | UAsinh UE
+ | UAcosh UE
+ | UAtan UE
+ | UAtanh UE
deriving (Show, Eq, Ord, Data, Typeable)
class Width a where
@@ -341,44 +345,45 @@ instance TypeOf (A a) where
instance TypeOf UE where
typeOf t = case t of
- UVRef uvar -> typeOf uvar
- UCast t _ -> t
- UConst c -> typeOf c
- UAdd a _ -> typeOf a
- USub a _ -> typeOf a
- UMul a _ -> typeOf a
- UDiv a _ -> typeOf a
- UMod a _ -> typeOf a
- UNot _ -> Bool
- UAnd _ -> Bool
- UBWNot a -> typeOf a
- UBWAnd a _ -> typeOf a
- UBWOr a _ -> typeOf a
- UBWXor a _ -> typeOf a
- UShift a _ -> typeOf a
- UEq _ _ -> Bool
- ULt _ _ -> Bool
- UMux _ a _ -> typeOf a
- UF2B _ -> Word32
- UD2B _ -> Word64
- UB2F _ -> Float
- UB2D _ -> Double
+ UVRef uvar -> typeOf uvar
+ UCast t _ -> t
+ UConst c -> typeOf c
+ UAdd a _ -> typeOf a
+ USub a _ -> typeOf a
+ UMul a _ -> typeOf a
+ UDiv a _ -> typeOf a
+ UMod a _ -> typeOf a
+ UNot _ -> Bool
+ UAnd _ -> Bool
+ UBWNot a -> typeOf a
+ UBWAnd a _ -> typeOf a
+ UBWOr a _ -> typeOf a
+ UBWXor a _ -> typeOf a
+ UBWShiftL a _ -> typeOf a
+ UBWShiftR a _ -> typeOf a
+ UEq _ _ -> Bool
+ ULt _ _ -> Bool
+ UMux _ a _ -> typeOf a
+ UF2B _ -> Word32
+ UD2B _ -> Word64
+ UB2F _ -> Float
+ UB2D _ -> Double
-- math.h:
- UPi -> Double
- UExp a -> typeOf a
- ULog a -> typeOf a
- USqrt a -> typeOf a
- UPow a _ -> typeOf a
- USin a -> typeOf a
- UAsin a -> typeOf a
- UCos a -> typeOf a
- UAcos a -> typeOf a
- USinh a -> typeOf a
- UCosh a -> typeOf a
- UAsinh a -> typeOf a
- UAcosh a -> typeOf a
- UAtan a -> typeOf a
- UAtanh a -> typeOf a
+ UPi -> Double
+ UExp a -> typeOf a
+ ULog a -> typeOf a
+ USqrt a -> typeOf a
+ UPow a _ -> typeOf a
+ USin a -> typeOf a
+ UAsin a -> typeOf a
+ UCos a -> typeOf a
+ UAcos a -> typeOf a
+ USinh a -> typeOf a
+ UCosh a -> typeOf a
+ UAsinh a -> typeOf a
+ UAcosh a -> typeOf a
+ UAtan a -> typeOf a
+ UAtanh a -> typeOf a
instance Expr a => TypeOf (E a) where
typeOf = eType
@@ -565,25 +570,39 @@ instance (Num a, Fractional a, Floating a, FloatingE a) => Floating (E a) where
instance (Expr a, OrdE a, EqE a, IntegralE a, Bits a) => Bits (E a) where
(Const a) .&. (Const b) = Const $ a .&. b
- a .&. b = BWAnd a b
- complement (Const a) = Const $ complement a
- complement a = BWNot a
+ a .&. b = BWAnd a b
+ complement (Const a) = Const $ complement a
+ complement a = BWNot a
(Const a) .|. (Const b) = Const $ a .|. b
- a .|. b = BWOr a b
- xor = BWXor a b
- shift (Const a) n = Const $ shift a n
- shift a n = Shift a n
- rotate a n | n >= width a = error "E rotates too far."
- rotate (Const a) n = Const $ rotate a n
- rotate a n | n > 0 = shift a n .|. shift a (width a - n) .&. Const (mask n)
- | n < 0 = shift a n .&. Const (mask $ width a + n) .|. shift a (width a + n)
- | otherwise = a
- where
- mask 0 = 0
- mask n = shiftL (mask $ n - 1) 1 + 1
+ a .|. b = BWOr a b
+ xor = BWXor
+
+ shiftL a b = error "shiftL undefined, for left-shifting use .<<."
+ shiftR a b = error "shiftR undefined, for right-shifting use .>>."
+
+ rotateL a n = error "rotateL undefined, for left-rotation use rol"
+ rotateR a n = error "rotateR undefined, for right-rotation use ror"
bitSize = width
isSigned = signed
+-- | Bitwise left-shifting.
+(.<<.) :: ( Bits a, IntegralE a, IntegralE n ) => E a -> E n -> E a
+( Const a ) .<<. ( Const n ) = Const $ shiftL a $ fromIntegral n
+a .<<. n = BWShiftL a n
+
+-- | Bitwise right-shifting.
+(.>>.) :: ( Bits a, IntegralE a, IntegralE n ) => E a -> E n -> E a
+( Const a ) .>>. ( Const n ) = Const $ shiftR a $ fromIntegral n
+a .>>. n = BWShiftR a n
+
+-- | Bitwise left-rotation.
+rol (Const a) (Const n) = Const $ rotateL a $ fromIntegral n
+rol a n = a .<<. n .|. a .>>. ( ( Const . fromIntegral . width ) a - n )
+
+-- | Bitwise right-rotation.
+ror (Const a) (Const n) = Const $ rotateR a $ fromIntegral n
+ror a n = a .>>. n .|. a .<<. ( ( Const . fromIntegral . width ) a - n )
+
-- | True term.
true :: E Bool
true = Const True
@@ -725,45 +744,46 @@ a !. i = value $ a ! i
-- | Converts an typed expression (E a) to an untyped expression (UE).
ue :: Expr a => E a -> UE
ue t = case t of
- VRef (V v) -> UVRef v
- Const a -> UConst $ constant a
- Cast a -> UCast tt (ue a)
- Add a b -> UAdd (ue a) (ue b)
- Sub a b -> USub (ue a) (ue b)
- Mul a b -> UMul (ue a) (ue b)
- Div a b -> UDiv (ue a) (ue b)
- Mod a b -> UMod (ue a) (ue b)
- Not a -> unot (ue a)
- And a b -> uand (ue a) (ue b)
- BWNot a -> UBWNot (ue a)
- BWAnd a b -> UBWAnd (ue a) (ue b)
- BWOr a b -> UBWOr (ue a) (ue b)
- BWXor a b -> UBWXor (ue a) (ue b)
- Shift a b -> UShift (ue a) b
- Eq a b -> ueq (ue a) (ue b)
- Lt a b -> ult (ue a) (ue b)
- Mux a b c -> umux (ue a) (ue b) (ue c)
- F2B a -> UF2B (ue a)
- D2B a -> UD2B (ue a)
- B2F a -> UB2F (ue a)
- B2D a -> UB2D (ue a)
- Retype a -> a
+ VRef (V v) -> UVRef v
+ Const a -> UConst $ constant a
+ Cast a -> UCast tt (ue a)
+ Add a b -> UAdd (ue a) (ue b)
+ Sub a b -> USub (ue a) (ue b)
+ Mul a b -> UMul (ue a) (ue b)
+ Div a b -> UDiv (ue a) (ue b)
+ Mod a b -> UMod (ue a) (ue b)
+ Not a -> unot (ue a)
+ And a b -> uand (ue a) (ue b)
+ BWNot a -> UBWNot (ue a)
+ BWAnd a b -> UBWAnd (ue a) (ue b)
+ BWOr a b -> UBWOr (ue a) (ue b)
+ BWXor a b -> UBWXor (ue a) (ue b)
+ BWShiftL a b -> UBWShiftL (ue a) (ue b)
+ BWShiftR a b -> UBWShiftR (ue a) (ue b)
+ Eq a b -> ueq (ue a) (ue b)
+ Lt a b -> ult (ue a) (ue b)
+ Mux a b c -> umux (ue a) (ue b) (ue c)
+ F2B a -> UF2B (ue a)
+ D2B a -> UD2B (ue a)
+ B2F a -> UB2F (ue a)
+ B2D a -> UB2D (ue a)
+ Retype a -> a
-- math.h:
Pi -> UPi
- Exp a -> UExp (ue a)
- Log a -> ULog (ue a)
- Sqrt a -> USqrt (ue a)
- Pow a b -> UPow (ue a) (ue b)
- Sin a -> USin (ue a)
- Asin a -> UAsin (ue a)
- Cos a -> UCos (ue a)
- Acos a -> UAcos (ue a)
- Sinh a -> USinh (ue a)
- Cosh a -> UCosh (ue a)
- Asinh a -> UAsinh (ue a)
- Acosh a -> UAcosh (ue a)
- Atan a -> UAtan (ue a)
- Atanh a -> UAtanh (ue a)
+ Exp a -> UExp (ue a)
+ Log a -> ULog (ue a)
+ Sqrt a -> USqrt (ue a)
+ Pow a b -> UPow (ue a) (ue b)
+ Sin a -> USin (ue a)
+ Asin a -> UAsin (ue a)
+ Cos a -> UCos (ue a)
+ Acos a -> UAcos (ue a)
+ Sinh a -> USinh (ue a)
+ Cosh a -> UCosh (ue a)
+ Asinh a -> UAsinh (ue a)
+ Acosh a -> UAcosh (ue a)
+ Atan a -> UAtan (ue a)
+ Atanh a -> UAtanh (ue a)
where
tt = eType t
@@ -880,7 +900,7 @@ balance ue = case ue of
UBWNot a -> UBWNot (balance a)
UBWAnd a b -> UBWAnd (balance a) (balance b)
UBWOr a b -> UBWOr (balance a) (balance b)
- UShift a n -> UShift (balance a) n
+ UShift a b -> UShift (balance a) (balance b)
UEq a b -> UEq (balance a) (balance b)
ULt a b -> ULt (balance a) (balance b)
UMux a t f -> rotate $ umux a t' f'
415 Language/Atom/UeMap.hs
View
@@ -1,6 +1,6 @@
-- | Sharing for UEs, based on IntMaps. The idea is to share subexpressions of 'UE's.
-module Language.Atom.UeMap
+module Language.Atom.UeMap
( UeElem (..)
, MUV (..)
, UeMap
@@ -39,7 +39,7 @@ data MUV
-- | Transforms a 'UV' into a 'MUV', returning the possibly updated map.
newUV :: UV -> UeMap -> (MUV, UeMap)
-newUV uv mp =
+newUV uv mp =
case uv of
UV i j k -> (MUV i j k, mp)
UVExtern i j -> (MUVExtern i j, mp)
@@ -48,89 +48,91 @@ newUV uv mp =
-- | Corresponds to 'UE's --- the elements in the sharing structure.
data UeElem
- = MUVRef !MUV
- | MUConst !Const
- | MUCast !Type !Hash
- | MUAdd !Hash !Hash
- | MUSub !Hash !Hash
- | MUMul !Hash !Hash
- | MUDiv !Hash !Hash
- | MUMod !Hash !Hash
- | MUNot !Hash
- | MUAnd [Hash]
- | MUBWNot !Hash
- | MUBWAnd !Hash !Hash
- | MUBWOr !Hash !Hash
- | MUBWXor !Hash !Hash
- | MUShift !Hash !Int
- | MUEq !Hash !Hash
- | MULt !Hash !Hash
- | MUMux !Hash !Hash !Hash
- | MUF2B !Hash
- | MUD2B !Hash
- | MUB2F !Hash
- | MUB2D !Hash
+ = MUVRef !MUV
+ | MUConst !Const
+ | MUCast !Type !Hash
+ | MUAdd !Hash !Hash
+ | MUSub !Hash !Hash
+ | MUMul !Hash !Hash
+ | MUDiv !Hash !Hash
+ | MUMod !Hash !Hash
+ | MUNot !Hash
+ | MUAnd [Hash]
+ | MUBWNot !Hash
+ | MUBWAnd !Hash !Hash
+ | MUBWOr !Hash !Hash
+ | MUBWXor !Hash !Hash
+ | MUBWShiftL !Hash !Hash
+ | MUBWShiftR !Hash !Hash
+ | MUEq !Hash !Hash
+ | MULt !Hash !Hash
+ | MUMux !Hash !Hash !Hash
+ | MUF2B !Hash
+ | MUD2B !Hash
+ | MUB2F !Hash
+ | MUB2D !Hash
-- math.h:
| MUPi
- | MUExp !Hash
- | MULog !Hash
- | MUSqrt !Hash
- | MUPow !Hash !Hash
- | MUSin !Hash
- | MUAsin !Hash
- | MUCos !Hash
- | MUAcos !Hash
- | MUSinh !Hash
- | MUCosh !Hash
- | MUAsinh !Hash
- | MUAcosh !Hash
- | MUAtan !Hash
- | MUAtanh !Hash
+ | MUExp !Hash
+ | MULog !Hash
+ | MUSqrt !Hash
+ | MUPow !Hash !Hash
+ | MUSin !Hash
+ | MUAsin !Hash
+ | MUCos !Hash
+ | MUAcos !Hash
+ | MUSinh !Hash
+ | MUCosh !Hash
+ | MUAsinh !Hash
+ | MUAcosh !Hash
+ | MUAtan !Hash
+ | MUAtanh !Hash
deriving (Show, Eq, Ord)
typeOf :: Hash -> UeMap -> Type
typeOf h mp = case getUE h mp of
- MUVRef (MUV _ _ a) -> E.typeOf a
- MUVRef (MUVArray a _) -> E.typeOf a
- MUVRef (MUVExtern _ t) -> t
- MUCast t _ -> t
- MUConst c -> E.typeOf c
- MUAdd a _ -> typeOf' a
- MUSub a _ -> typeOf' a
- MUMul a _ -> typeOf' a
- MUDiv a _ -> typeOf' a
- MUMod a _ -> typeOf' a
- MUNot _ -> Bool
- MUAnd _ -> Bool
- MUBWNot a -> typeOf' a
- MUBWAnd a _ -> typeOf' a
- MUBWOr a _ -> typeOf' a
- MUBWXor a _ -> typeOf' a
- MUShift a _ -> typeOf' a
- MUEq _ _ -> Bool
- MULt _ _ -> Bool
- MUMux _ a _ -> typeOf' a
- MUF2B _ -> Word32
- MUD2B _ -> Word64
- MUB2F _ -> Float
- MUB2D _ -> Double
+ MUVRef (MUV _ _ a) -> E.typeOf a
+ MUVRef (MUVArray a _) -> E.typeOf a
+ MUVRef (MUVExtern _ t) -> t
+ MUCast t _ -> t
+ MUConst c -> E.typeOf c
+ MUAdd a _ -> typeOf' a
+ MUSub a _ -> typeOf' a
+ MUMul a _ -> typeOf' a
+ MUDiv a _ -> typeOf' a
+ MUMod a _ -> typeOf' a
+ MUNot _ -> Bool
+ MUAnd _ -> Bool
+ MUBWNot a -> typeOf' a
+ MUBWAnd a _ -> typeOf' a
+ MUBWOr a _ -> typeOf' a
+ MUBWXor a _ -> typeOf' a
+ MUBWShiftL a _ -> typeOf' a
+ MUBWShiftR a _ -> typeOf' a
+ MUEq _ _ -> Bool
+ MULt _ _ -> Bool
+ MUMux _ a _ -> typeOf' a
+ MUF2B _ -> Word32
+ MUD2B _ -> Word64
+ MUB2F _ -> Float
+ MUB2D _ -> Double
-- math.h:
- MUPi -> Double
- MUExp a -> typeOf' a
- MULog a -> typeOf' a
- MUSqrt a -> typeOf' a
- MUPow a _ -> typeOf' a
- MUSin a -> typeOf' a
- MUAsin a -> typeOf' a
- MUCos a -> typeOf' a
- MUAcos a -> typeOf' a
- MUSinh a -> typeOf' a
- MUCosh a -> typeOf' a
- MUAsinh a -> typeOf' a
- MUAcosh a -> typeOf' a
- MUAtan a -> typeOf' a
- MUAtanh a -> typeOf' a
- where
+ MUPi -> Double
+ MUExp a -> typeOf' a
+ MULog a -> typeOf' a
+ MUSqrt a -> typeOf' a
+ MUPow a _ -> typeOf' a
+ MUSin a -> typeOf' a
+ MUAsin a -> typeOf' a
+ MUCos a -> typeOf' a
+ MUAcos a -> typeOf' a
+ MUSinh a -> typeOf' a
+ MUCosh a -> typeOf' a
+ MUAsinh a -> typeOf' a
+ MUAcosh a -> typeOf' a
+ MUAtan a -> typeOf' a
+ MUAtanh a -> typeOf' a
+ where
typeOf' h' = typeOf h' mp
-- | An entry in the Map.
@@ -142,7 +144,7 @@ type UeState a = State UeMap a
-- | Get the element associated with a 'Hash' value. It's an error if the
-- element is not in the map.
getUE :: Hash -> UeMap -> UeElem
-getUE h (_,mp) =
+getUE h (_,mp) =
case M.lookup h mp of
Nothing -> error $ "Error looking up hash " ++ show h ++ " in the UE map\n" ++ show mp
Just e -> e
@@ -157,71 +159,72 @@ emptyMap = (0, M.empty)
-- | Create the sharing map.
share :: UE -> UeState Hash
-share e = case e of
- UVRef (UV i j k) -> maybeUpdate (MUVRef $ MUV i j k)
- UVRef (UVExtern i j) -> maybeUpdate (MUVRef $ MUVExtern i j)
- UVRef (UVArray arr a) -> unOp a (\x -> MUVRef (MUVArray arr x))
- UConst a -> maybeUpdate (MUConst a)
- UCast t a -> unOp a (MUCast t)
- UAdd a b -> binOp (a,b) MUAdd
- USub a b -> binOp (a,b) MUSub
- UMul a b -> binOp (a,b) MUMul
- UDiv a b -> binOp (a,b) MUDiv
- UMod a b -> binOp (a,b) MUMod
- UNot a -> unOp a MUNot
- UAnd ls -> listOp ls MUAnd
- UBWNot a -> unOp a MUBWNot
- UBWAnd a b -> binOp (a,b) MUBWAnd
- UBWOr a b -> binOp (a,b) MUBWOr
- UBWXor a b -> binOp (a,b) MUBWXor
- UShift a b -> unOp a (\x -> MUShift x b)
- UEq a b -> binOp (a,b) MUEq
- ULt a b -> binOp (a,b) MULt
- UMux a b c -> triOp (a,b,c) MUMux
- UF2B a -> unOp a MUF2B
- UD2B a -> unOp a MUD2B
- UB2F a -> unOp a MUB2F
- UB2D a -> unOp a MUB2D
+share e = case e of
+ UVRef (UV i j k) -> maybeUpdate (MUVRef $ MUV i j k)
+ UVRef (UVExtern i j) -> maybeUpdate (MUVRef $ MUVExtern i j)
+ UVRef (UVArray arr a) -> unOp a (\x -> MUVRef (MUVArray arr x))
+ UConst a -> maybeUpdate (MUConst a)
+ UCast t a -> unOp a (MUCast t)
+ UAdd a b -> binOp (a,b) MUAdd
+ USub a b -> binOp (a,b) MUSub
+ UMul a b -> binOp (a,b) MUMul
+ UDiv a b -> binOp (a,b) MUDiv
+ UMod a b -> binOp (a,b) MUMod
+ UNot a -> unOp a MUNot
+ UAnd ls -> listOp ls MUAnd
+ UBWNot a -> unOp a MUBWNot
+ UBWAnd a b -> binOp (a,b) MUBWAnd
+ UBWOr a b -> binOp (a,b) MUBWOr
+ UBWXor a b -> binOp (a,b) MUBWXor
+ UBWShiftL a b -> binOp (a,b) MUBWShiftL
+ UBWShiftR a b -> binOp (a,b) MUBWShiftR
+ UEq a b -> binOp (a,b) MUEq
+ ULt a b -> binOp (a,b) MULt
+ UMux a b c -> triOp (a,b,c) MUMux
+ UF2B a -> unOp a MUF2B
+ UD2B a -> unOp a MUD2B
+ UB2F a -> unOp a MUB2F
+ UB2D a -> unOp a MUB2D
-- math.h:
- UPi -> maybeUpdate (MUPi)
- UExp a -> unOp a MUExp
- ULog a -> unOp a MULog
- USqrt a -> unOp a MUSqrt
- UPow a b -> binOp (a,b) MUPow
- USin a -> unOp a MUSin
- UAsin a -> unOp a MUAsin
- UCos a -> unOp a MUCos
- UAcos a -> unOp a MUAcos
- USinh a -> unOp a MUSinh
- UCosh a -> unOp a MUCosh
- UAsinh a -> unOp a MUAsinh
- UAcosh a -> unOp a MUAcosh
- UAtan a -> unOp a MUAtan
- UAtanh a -> unOp a MUAtanh
+ UPi -> maybeUpdate (MUPi)
+ UExp a -> unOp a MUExp
+ ULog a -> unOp a MULog
+ USqrt a -> unOp a MUSqrt
+ UPow a b -> binOp (a,b) MUPow
+ USin a -> unOp a MUSin
+ UAsin a -> unOp a MUAsin
+ UCos a -> unOp a MUCos
+ UAcos a -> unOp a MUAcos
+ USinh a -> unOp a MUSinh
+ UCosh a -> unOp a MUCosh
+ UAsinh a -> unOp a MUAsinh
+ UAcosh a -> unOp a MUAcosh
+ UAtan a -> unOp a MUAtan
+ UAtanh a -> unOp a MUAtanh
-- XXX I could combine some of the following functions (unOp, binOp, etc.) to
-- slightly reduce code...
unOp :: UE -> (Hash -> UeElem) -> UeState Hash
unOp e code = do
- h <- share e
+ h <- share e
maybeUpdate (code h)
binOp :: (UE, UE) -> (Hash -> Hash -> UeElem) -> UeState Hash
binOp (e0,e1) code = do
- h0 <- share e0
- h1 <- share e1
+ h0 <- share e0
+ h1 <- share e1
maybeUpdate (code h0 h1)
triOp :: (UE, UE, UE) -> (Hash -> Hash -> Hash -> UeElem) -> UeState Hash
triOp (e0,e1,e2) code = do
- h0 <- share e0
- h1 <- share e1
- h2 <- share e2
+ h0 <- share e0
+ h1 <- share e1
+ h2 <- share e2
maybeUpdate (code h0 h1 h2)
listOp :: [UE] -> ([Hash] -> UeElem) -> UeState Hash
listOp es code = do
- hashes <- foldM (\hashes e -> do h <- share e
+ hashes <- foldM (\hashes e -> do h <- share e
return (h:hashes)
) [] es
maybeUpdate (code hashes)
@@ -252,91 +255,93 @@ maybeUpdate e = do
-- | Get a 'UE' back out of the 'UeMap'.
recoverUE :: UeMap -> Hash -> UE
recoverUE st h = case getUE h st of
- MUVRef (MUV i j k) -> UVRef (UV i j k)
- MUVRef (MUVArray i a) -> UVRef (UVArray i (recover' a))
- MUVRef (MUVExtern i j) -> UVRef (UVExtern i j)
- MUCast t a -> UCast t (recover' a)
- MUConst a -> UConst a
- MUAdd a b -> UAdd (recover' a) (recover' b)
- MUSub a b -> USub (recover' a) (recover' b)
- MUMul a b -> UMul (recover' a) (recover' b)
- MUDiv a b -> UDiv (recover' a) (recover' b)
- MUMod a b -> UMod (recover' a) (recover' b)
- MUNot a -> UNot (recover' a)
- MUAnd a -> UAnd $ map recover' a
- MUBWNot a -> UBWNot (recover' a)
- MUBWAnd a b -> UBWAnd (recover' a) (recover' b)
- MUBWOr a b -> UBWOr (recover' a) (recover' b)
- MUBWXor a b -> UBWXor (recover' a) (recover' b)
- MUShift a b -> UShift (recover' a) b
- MUEq a b -> UEq (recover' a) (recover' b)
- MULt a b -> ULt (recover' a) (recover' b)
- MUMux a b c -> UMux (recover' a) (recover' b) (recover' c)
- MUF2B a -> UF2B (recover' a)
- MUD2B a -> UD2B (recover' a)
- MUB2F a -> UB2F (recover' a)
- MUB2D a -> UB2D (recover' a)
+ MUVRef (MUV i j k) -> UVRef (UV i j k)
+ MUVRef (MUVArray i a) -> UVRef (UVArray i (recover' a))
+ MUVRef (MUVExtern i j) -> UVRef (UVExtern i j)
+ MUCast t a -> UCast t (recover' a)
+ MUConst a -> UConst a
+ MUAdd a b -> UAdd (recover' a) (recover' b)
+ MUSub a b -> USub (recover' a) (recover' b)
+ MUMul a b -> UMul (recover' a) (recover' b)
+ MUDiv a b -> UDiv (recover' a) (recover' b)
+ MUMod a b -> UMod (recover' a) (recover' b)
+ MUNot a -> UNot (recover' a)
+ MUAnd a -> UAnd $ map recover' a
+ MUBWNot a -> UBWNot (recover' a)
+ MUBWAnd a b -> UBWAnd (recover' a) (recover' b)
+ MUBWOr a b -> UBWOr (recover' a) (recover' b)
+ MUBWXor a b -> UBWXor (recover' a) (recover' b)
+ MUBWShiftL a b -> UBWShiftL (recover' a) (recover' b)
+ MUBWShiftR a b -> UBWShiftR (recover' a) (recover' b)
+ MUEq a b -> UEq (recover' a) (recover' b)
+ MULt a b -> ULt (recover' a) (recover' b)
+ MUMux a b c -> UMux (recover' a) (recover' b) (recover' c)
+ MUF2B a -> UF2B (recover' a)
+ MUD2B a -> UD2B (recover' a)
+ MUB2F a -> UB2F (recover' a)
+ MUB2D a -> UB2D (recover' a)
-- math.h:
- MUPi -> UPi
- MUExp a -> UExp (recover' a)
- MULog a -> ULog (recover' a)
- MUSqrt a -> USqrt (recover' a)
- MUPow a b -> UPow (recover' a) (recover' b)
- MUSin a -> USin (recover' a)
- MUAsin a -> UAsin (recover' a)
- MUCos a -> UCos (recover' a)
- MUAcos a -> UAcos (recover' a)
- MUSinh a -> USinh (recover' a)
- MUCosh a -> UCosh (recover' a)
- MUAsinh a -> UAsinh (recover' a)
- MUAcosh a -> UAcosh (recover' a)
- MUAtan a -> UAtan (recover' a)
- MUAtanh a -> UAtanh (recover' a)
+ MUPi -> UPi
+ MUExp a -> UExp (recover' a)
+ MULog a -> ULog (recover' a)
+ MUSqrt a -> USqrt (recover' a)
+ MUPow a b -> UPow (recover' a) (recover' b)
+ MUSin a -> USin (recover' a)
+ MUAsin a -> UAsin (recover' a)
+ MUCos a -> UCos (recover' a)
+ MUAcos a -> UAcos (recover' a)
+ MUSinh a -> USinh (recover' a)
+ MUCosh a -> UCosh (recover' a)
+ MUAsinh a -> UAsinh (recover' a)
+ MUAcosh a -> UAcosh (recover' a)
+ MUAtan a -> UAtan (recover' a)
+ MUAtanh a -> UAtanh (recover' a)
where recover' h' = recoverUE st h'
-- | The list of Hashes to adjacent upstream of a UE.
ueUpstream :: Hash -> UeMap -> [Hash]
ueUpstream h t = case getUE h t of
- MUVRef (MUV _ _ _) -> []
- MUVRef (MUVArray _ a) -> [a]
- MUVRef (MUVExtern _ _) -> []
- MUCast _ a -> [a]
- MUConst _ -> []
- MUAdd a b -> [a, b]
- MUSub a b -> [a, b]
- MUMul a b -> [a, b]
- MUDiv a b -> [a, b]
- MUMod a b -> [a, b]
- MUNot a -> [a]
- MUAnd a -> a
- MUBWNot a -> [a]
- MUBWAnd a b -> [a, b]
- MUBWOr a b -> [a, b]
- MUBWXor a b -> [a, b]
- MUShift a _ -> [a]
- MUEq a b -> [a, b]
- MULt a b -> [a, b]
- MUMux a b c -> [a, b, c]
- MUF2B a -> [a]
- MUD2B a -> [a]
- MUB2F a -> [a]
- MUB2D a -> [a]
+ MUVRef (MUV _ _ _) -> []
+ MUVRef (MUVArray _ a) -> [a]
+ MUVRef (MUVExtern _ _) -> []
+ MUCast _ a -> [a]
+ MUConst _ -> []
+ MUAdd a b -> [a, b]
+ MUSub a b -> [a, b]
+ MUMul a b -> [a, b]
+ MUDiv a b -> [a, b]
+ MUMod a b -> [a, b]
+ MUNot a -> [a]
+ MUAnd a -> a
+ MUBWNot a -> [a]
+ MUBWAnd a b -> [a, b]
+ MUBWOr a b -> [a, b]
+ MUBWXor a b -> [a, b]
+ MUBWShiftL a b -> [a, b]
+ MUBWShiftR a b -> [a, b]
+ MUEq a b -> [a, b]
+ MULt a b -> [a, b]
+ MUMux a b c -> [a, b, c]
+ MUF2B a -> [a]
+ MUD2B a -> [a]
+ MUB2F a -> [a]
+ MUB2D a -> [a]
-- math.h:
- MUPi -> []
- MUExp a -> [a]
- MULog a -> [a]
- MUSqrt a -> [a]
- MUPow a b -> [a, b]
- MUSin a -> [a]
- MUAsin a -> [a]
- MUCos a -> [a]
- MUAcos a -> [a]
- MUSinh a -> [a]
- MUCosh a -> [a]
- MUAsinh a -> [a]
- MUAcosh a -> [a]
- MUAtan a -> [a]
- MUAtanh a -> [a]
+ MUPi -> []
+ MUExp a -> [a]
+ MULog a -> [a]
+ MUSqrt a -> [a]
+ MUPow a b -> [a, b]
+ MUSin a -> [a]
+ MUAsin a -> [a]
+ MUCos a -> [a]
+ MUAcos a -> [a]
+ MUSinh a -> [a]
+ MUCosh a -> [a]
+ MUAsinh a -> [a]
+ MUAcosh a -> [a]
+ MUAtan a -> [a]
+ MUAtanh a -> [a]
-- | The list of all UVs that directly control the value of an expression.
nearestUVs :: Hash -> UeMap -> [MUV]
@@ -359,7 +364,7 @@ arrayIndices h mp = nub $ f h
-- XXX can put this back after making UE map---won't be expensive.
isMathHCall :: UeElem -> Bool
-isMathHCall fc =
+isMathHCall fc =
case fc of
MUPi -> True
MUExp _ -> True
Please sign in to comment.
Something went wrong with that request. Please try again.