Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

more type-safe paraiso!

  • Loading branch information...
commit 08487c43ac16d690720d9cb6ac37c20cc150e60b 1 parent f79bfab
@nushio3 authored
View
10 Language/Paraiso/OM/Arithmetic.hs
@@ -6,7 +6,8 @@ module Language.Paraiso.OM.Arithmetic
Operator(..)
) where
-import NumericPrelude hiding (Ordering(..), Eq(..), Ord(..))
+import qualified Data.Dynamic as Dynamic
+import NumericPrelude hiding (Ordering(..), Eq(..), Ord(..))
import qualified NumericPrelude as P
class Arity a where
@@ -60,8 +61,9 @@ data Operator =
Acos |
Atan |
Atan2 |
- Sincos
- deriving (P.Eq, P.Ord, P.Show, P.Read)
+ Sincos |
+ Cast Dynamic.TypeRep
+ deriving (P.Eq, P.Ord, P.Show)
instance Arity Operator where
arity a = case a of
@@ -105,4 +107,4 @@ instance Arity Operator where
Atan -> (1,1)
Atan2 -> (2,1)
Sincos -> (1,2)
-
+ Cast _ -> (1,1)
View
147 Language/Paraiso/OM/Builder/Internal.hs
@@ -166,13 +166,11 @@ bind = fmap return
-- | Load from a static value.
load :: (TRealm r, Typeable c) =>
- Named (Val.Value r c) -- the named static value to be loaded.
- -> B (Value r c) -- ^The loaded 'TArray' 'Value' as a result.
-load (Named name0 val0)= do
+ Named (Val.StaticValue r c) -- ^ the named static value to be loaded from.
+ -> B (Value r c) -- ^ The loaded 'Value' as a result.
+load (Named name0 (Val.StaticValue r0 c0))= do
let
- r0 = Val.realm val0
- c0 = Val.content val0
- type0 = toDyn val0
+ type0 = mkDyn r0 c0
nv = Named name0 type0
idx <- lookUpStatic nv
n0 <- addNodeE [] $ NInst (Load idx)
@@ -181,10 +179,10 @@ load (Named name0 val0)= do
-- | Store to a static value.
store :: (TRealm r, Typeable c) =>
- Name -- ^The 'Name' of the static value to store.
- -> Builder v g a (Value r c) -- ^The 'Value' to be stored.
- -> Builder v g a () -- ^The result.
-store name0 builder0 = do
+ Named (Val.StaticValue r c) -- ^ the named static value to be stored on.
+ -> Builder v g a (Value r c) -- ^ The 'Value' to be stored.
+ -> Builder v g a () -- ^ The result.
+store (Named name0 _) builder0 = do
val0 <- builder0
let
type0 = toDyn val0
@@ -243,27 +241,30 @@ shift vec builder1 = do
return (FromNode TArray c1 n3)
-- | Load the 'Axis' component of the mesh address, to a 'TArray' 'Value'.
-loadIndex :: (Typeable c) =>
- c -- ^The 'Val.content' type.
- -> Axis v -- ^ The axis for which index is required
- -> Builder v g a (Value TArray c) -- ^ The 'TArray' 'Value' that contains the address as a result.
-loadIndex c0 axis = do
- let type0 = mkDyn TArray c0
+loadIndex :: (Typeable g)
+ => Axis v -- ^ The axis for which index is required
+ -> Builder v g a (Value TArray g) -- ^ The 'TArray' 'Value' that contains the address as a result.
+loadIndex axis = do
+ -- create a phantom object of type g
+ c0 <- (return undefined) `asTypeOf` (fmap Val.content $ loadIndex axis)
+ let
+ type0 = mkDyn TArray c0
n0 <- addNodeE [] $ NInst (LoadIndex axis)
n1 <- addNodeE [n0] $ NValue type0
return (FromNode TArray c0 n1)
-- | Load the 'Axis' component of the mesh size, to either a 'TScalar' 'Value' or 'TArray' 'Value'..
-loadSize :: (TRealm r, Typeable c)
- => r -- ^ The 'TRealm'
- -> c -- ^The 'Val.content' type.
- -> Axis v -- ^ The axis for which the size is required
- -> Builder v g a (Value r c) -- ^ The 'TScalar' 'Value' that contains the size of the mesh in that direction.
-loadSize r0 c0 axis = do
- let type0 = mkDyn r0 c0
+loadSize :: (Typeable g)
+ => Axis v -- ^ The axis for which the size is required
+ -> Builder v g a (Value TScalar g) -- ^ The 'TScalar' 'Value' that contains the size of the mesh in that direction.
+loadSize axis = do
+ -- create a phantom object of type g
+ c0 <- (return undefined) `asTypeOf` (fmap Val.content $ loadSize axis)
+ let
+ type0 = mkDyn TScalar c0
n0 <- addNodeE [] $ NInst (LoadSize axis)
n1 <- addNodeE [n0] $ NValue type0
- return (FromNode r0 c0 n1)
+ return (FromNode TScalar c0 n1)
-- | Create an immediate 'Value' from a Haskell concrete value.
@@ -273,6 +274,13 @@ imm :: (TRealm r, Typeable c) =>
-> B (Value r c) -- ^'TArray' 'Value' with the @c@ stored.
imm c0 = return (FromImm unitTRealm c0)
+
+
+----------------------------------------------------------------
+-- Here comes the Arith instruction emitters.
+----------------------------------------------------------------
+
+
-- | Make a unary operator
mkOp1 :: (TRealm r, Typeable c) =>
A.Operator -- ^The operator symbol
@@ -307,40 +315,6 @@ mkOp2 op builder1 builder2 = do
return $ FromNode r1 c1 n01
--- | Execute the builder under modifed annotation.
-withAnnotation :: (a -> a) -> Builder v g a ret -> Builder v g a ret
-withAnnotation f builder1 = do
- stat0 <- State.get
- let curAnot0 = currentAnnotation (context stat0)
- curAnot1 = f curAnot0
- State.put $ stat0{ context = (context stat0){ currentAnnotation = curAnot1 } }
- ret <- builder1
- stat1 <- State.get
- State.put $ stat1{ context = (context stat1){ currentAnnotation = curAnot0} }
- return ret
-
-
--- | Execute the builder, and annotate the very result with the givin function.
-annotate :: (TRealm r, Typeable c) => (a -> a) -> Builder v g a (Value r c) -> Builder v g a (Value r c)
-annotate f builder1 = do
- v1 <- builder1
- n1 <- valueToNode v1
- let
- r1 = Val.realm v1
- c1 = Val.content v1
- annotator con@(ins, n2, node2, outs)
- | n1 /= n2 = con
- | otherwise = (ins, n2, fmap f node2, outs)
- stat0 <- State.get
- State.put $ stat0 {
- target = FGL.gmap annotator (target stat0)
- }
- return $ FromNode r1 c1 n1
-
--- | (<?>) = annotate
-infixr 0 <?>
-(<?>) :: (TRealm r, Typeable c) => (a -> a) -> Builder v g a (Value r c) -> Builder v g a (Value r c)
-(<?>) = annotate
-- | Builder is Additive 'Additive.C'.
-- You can use 'Additive.zero', 'Additive.+', 'Additive.-', 'Additive.negate'.
@@ -370,6 +344,8 @@ instance (TRealm r, Typeable c, Ring.C c) => Ring.C (Builder v g a (Value r c))
bx_n3 <- fmap return $ f x n3
modify $ bx_n3*bx_n3
+-- Here comes the Arith node creaters.
+
-- | Builder is Ring 'IntegralDomain.C'.
-- You can use div and mod.
instance (TRealm r, Typeable c, IntegralDomain.C c) => IntegralDomain.C (Builder v g a (Value r c)) where
@@ -438,3 +414,58 @@ instance (TRealm r, Typeable c, Transcendental.C c) =>
asin = mkOp1 A.Asin
acos = mkOp1 A.Acos
atan = mkOp1 A.Atan
+
+-- | A special Arith operation that keeps the realm and casts the content
+-- from one type to another.
+cast :: (TRealm r, Typeable c1,Typeable c2) => (Builder v g a (Value r c1)) -> (Builder v g a (Value r c2))
+cast builder1 = do
+ -- create a phantom object of type c2
+ v1 <- builder1
+ c2 <- return undefined `asTypeOf` (fmap Val.content $ cast builder1)
+ let
+ r1 = Val.realm v1
+ c1 = Val.content v1
+ n1 <- valueToNode v1
+ n0 <- addNodeE [n1] $ NInst (Arith $ A.Cast $ Dynamic.typeOf c2)
+ n01 <- addNodeE [n0] $ NValue (toDyn v1)
+ return $ FromNode r1 c2 n01
+
+
+
+
+
+-- | Execute the builder under modifed annotation.
+withAnnotation :: (a -> a) -> Builder v g a ret -> Builder v g a ret
+withAnnotation f builder1 = do
+ stat0 <- State.get
+ let curAnot0 = currentAnnotation (context stat0)
+ curAnot1 = f curAnot0
+ State.put $ stat0{ context = (context stat0){ currentAnnotation = curAnot1 } }
+ ret <- builder1
+ stat1 <- State.get
+ State.put $ stat1{ context = (context stat1){ currentAnnotation = curAnot0} }
+ return ret
+
+
+-- | Execute the builder, and annotate the very result with the givin function.
+annotate :: (TRealm r, Typeable c) => (a -> a) -> Builder v g a (Value r c) -> Builder v g a (Value r c)
+annotate f builder1 = do
+ v1 <- builder1
+ n1 <- valueToNode v1
+ let
+ r1 = Val.realm v1
+ c1 = Val.content v1
+ annotator con@(ins, n2, node2, outs)
+ | n1 /= n2 = con
+ | otherwise = (ins, n2, fmap f node2, outs)
+ stat0 <- State.get
+ State.put $ stat0 {
+ target = FGL.gmap annotator (target stat0)
+ }
+ return $ FromNode r1 c1 n1
+
+-- | (<?>) = annotate
+infixr 0 <?>
+(<?>) :: (TRealm r, Typeable c) => (a -> a) -> Builder v g a (Value r c) -> Builder v g a (Value r c)
+(<?>) = annotate
+
View
14 Language/Paraiso/OM/DynValue.hs
@@ -20,9 +20,19 @@ data DynValue = DynValue {realm :: R.Realm, typeRep :: TypeRep} deriving (Eq, Sh
mkDyn :: (R.TRealm r, Typeable c) => r -> c -> DynValue
mkDyn r0 c0 = DynValue (R.tRealm r0) (typeOf c0)
+
+-- | Something that can be converted to 'DynValue'
+class ToDynable a where
+ toDyn :: a -> DynValue
+
-- | Convert 'Val.Value' to 'DynValue'
-toDyn :: (R.TRealm r, Typeable c) => Val.Value r c -> DynValue
-toDyn x = mkDyn (Val.realm x) (Val.content x)
+instance (R.TRealm r, Typeable c) => ToDynable (Val.Value r c) where
+ toDyn x = mkDyn (Val.realm x) (Val.content x)
+
+-- | Convert 'Val.StaticValue' to 'DynValue'
+instance (R.TRealm r, Typeable c) => ToDynable (Val.StaticValue r c) where
+ toDyn (Val.StaticValue r c) = mkDyn r c
+
instance R.Realmable DynValue where
realm = realm
View
5 Language/Paraiso/OM/Value.hs
@@ -6,7 +6,7 @@
module Language.Paraiso.OM.Value
(
- Value(..)
+ Value(..), StaticValue(..)
) where
import Data.Typeable
@@ -27,6 +27,9 @@ data
-- 'content' is the immediate value to be stored.
FromImm {realm :: rea, content :: con} deriving (Eq, Show)
+-- | static value type.
+data StaticValue rea con = StaticValue rea con deriving (Eq, Show)
+
instance (R.TRealm rea, Typeable con) => R.Realmable (Value rea con) where
realm (FromNode r _ _) = R.tRealm r
Please sign in to comment.
Something went wrong with that request. Please try again.