Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge remote branch 'seni/master'

Conflicts:
	Language/Atom/Expressions.hs
  • Loading branch information...
commit 1b3a0d9f269f7ca4d5dbf7a514ed55482d8a850d 2 parents 4382d32 + e9e9488
@leepike leepike 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
View
73 Language/Atom/Code.hs
@@ -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
View
352 Language/Atom/Expressions.hs
@@ -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 a b = 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'
View
415 Language/Atom/UeMap.hs
@@ -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.