GPipe 2.1 → 2.1.1

raw patch · 7 files changed

+33/−16 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• GPipe.cabal +1/−1
• src/Graphics/GPipe/Expr.hs +3/−3
• src/Graphics/GPipe/Internal/Buffer.hs +3/−1
• src/Graphics/GPipe/Internal/Expr.hs +12/−10
• src/Graphics/GPipe/Internal/PrimitiveStream.hs +4/−1
• src/Graphics/GPipe/Internal/Uniform.hs +4/−0

@@ -1,3 +1,9 @@+### 2.1.1
+
+- Made ifB use ifThenElse' instead to avoid unwanted strictness 
+- Fixed bug where ShaderBaseType for () wasn't lazy enough, causing error in ifThenElse'
+- Added missing () instances
+
 ### 2.1
 
 - Making dangling finalizers work with shared and unshared contexts (#10) 

@@ -1,5 +1,5 @@ name:           GPipe
-version:        2.1
+version:        2.1.1
 cabal-version:  >= 1.8
 build-type:     Simple
 author:         Tobias Bexelius

@@ -33,12 +33,12 @@     fwidth,
 
     -- * Shader control structures    
-    ShaderBase(),
-    ShaderType(..),   
     while,
     ifThen,
     ifThenElse,
-    ifThenElse'    
+    ifThenElse',    
+    ShaderBase(),
+    ShaderType(..)   
 )
 where
 

@@ -251,7 +251,9 @@                 (a', b', c', d') <- toBuffer -< (a, b, c, d)
                 returnA -< V4 a' b' c' d'
 
-   
+instance BufferFormat () where
+    type HostFormat () = ()
+    toBuffer = arr (const ())   
 instance (BufferFormat a, BufferFormat b) => BufferFormat (a, b) where
     type HostFormat (a,b) = (HostFormat a, HostFormat b)
     toBuffer = proc ~(a, b) -> do

@@ -303,7 +303,7 @@     
 instance ShaderType () x where
     type ShaderBaseType () = ()
-    toBase _ () = ShaderBaseUnit
+    toBase _ _ = ShaderBaseUnit
     fromBase _ ShaderBaseUnit = ()
 
 instance ShaderType a x => ShaderType (V0 a) x where
@@ -340,9 +340,13 @@     toBase x ~(a,b,c,d) = ShaderBaseProd (toBase x a) (ShaderBaseProd (toBase x b) (ShaderBaseProd (toBase x c) (toBase x d)))
     fromBase x (ShaderBaseProd a (ShaderBaseProd b (ShaderBaseProd c d))) = (fromBase x a, fromBase x b, fromBase x c, fromBase x d)
     
+-- | Works just like 'ifB', return second argument if first is 'true' otherwise return third argument. The difference from 'ifB' is that it 
+-- might generate more efficient code when a is a compound type (e.g. a tuple or a vector). This is especially true if either of the two branch arguments
+-- contain a 'while' loop.
 ifThenElse' :: forall a x. (ShaderType a x) => S x Bool -> a -> a -> a
 ifThenElse' b t e = ifThenElse b (const t) (const e) ()
 
+-- | @ifThenElse c f g x@ will return @f x@ if @c@ evaluates to 'true' or @g x@ otherwise.
 ifThenElse :: forall a b x. (ShaderType a x, ShaderType b x) => S x Bool -> (a -> b) -> (a -> b) -> a -> b
 ifThenElse c t e i = fromBase x $ ifThenElse_ c (toBase x . t . fromBase x) (toBase x . e . fromBase x) (toBase x i)
     where
@@ -362,6 +366,7 @@                            return decls
             in evalState (runReaderT (shaderbaseReturn (toBase x (undefined :: b))) ifM) 0
 
+-- | @ifThen c f x@ will return @f x@ if @c@ evaluates to 'true' or @x@ otherwise.
 ifThen :: forall a x. (ShaderType a x) => S x Bool -> (a -> a) -> a -> a
 ifThen c t i = fromBase x $ ifThen_ c (toBase x . t . fromBase x) (toBase x i)
     where
@@ -381,6 +386,8 @@ 
 tellIf :: RValue -> ExprM ()
 tellIf boolStr = T.lift $ T.lift $ tell $ mconcat ["if(", boolStr, "){\n" ]
+
+-- | @while f g x@ will iteratively transform @x@ with @g@ as long as @f@ generates 'true'.
 while :: forall a x. (ShaderType a x) => (a -> S x Bool) -> (a -> a) -> a -> a
 while c f i = fromBase x $ while_ (c . fromBase x) (toBase x . f . fromBase x) (toBase x i)            
     where
@@ -587,15 +594,10 @@   (>=*) = bin STypeBool ">="
   (>*) = bin STypeBool ">"
 
-instance IfB (S a Float) where ifB = ifBs STypeFloat
-instance IfB (S a Int) where ifB = ifBs STypeInt
-instance IfB (S a Word) where ifB = ifBs STypeUInt
-instance IfB (S a Bool) where ifB = ifBs STypeBool
-
-ifBs stype (S c) (S t) (S e) = S $ tellAssignment stype $ do c' <- c
-                                                             t' <- t
-                                                             e' <- e
-                                                             return $ '(' : c' ++ '?' : t' ++ ':' : e' ++")"
+instance IfB (S a Float) where ifB = ifThenElse'
+instance IfB (S a Int) where ifB = ifThenElse'
+instance IfB (S a Word) where ifB = ifThenElse'
+instance IfB (S a Bool) where ifB = ifThenElse'
 
 instance Conjugate (S a Float)
 instance Conjugate (S a Int)

@@ -270,7 +270,10 @@     type VertexFormat (B4 Word8) = V4 VWord
     toVertex = ToVertex $ Kleisli $ makeVertexI 4 vec4S (STypeUVec 4) GL_UNSIGNED_BYTE . unB4
 
-                                             
+instance VertexInput () where
+    type VertexFormat () = ()
+    toVertex = arr (const ())
+    
 instance (VertexInput a, VertexInput b) => VertexInput (a,b) where
     type VertexFormat (a,b) = (VertexFormat a, VertexFormat b)
     toVertex = proc ~(a,b) -> do a' <- toVertex -< a

@@ -162,6 +162,10 @@                                          d' <- toUniform -< d
                                          returnA -< V4 a' b' c' d'                                                   
 
+instance UniformInput () where
+    type UniformFormat () x = ()
+    toUniform = arr (const ())
+    
 instance (UniformInput a, UniformInput b) => UniformInput (a,b) where
     type UniformFormat (a,b) x = (UniformFormat a x, UniformFormat b x)
     toUniform = proc ~(a,b) -> do a' <- toUniform -< a