Permalink
Browse files

fixed nested tuple codegen

  • Loading branch information...
1 parent 740d368 commit d7f41e637ca7b4395ca0ef828b560f0736eaa231 @csabahruska csabahruska committed Mar 14, 2013
Showing with 20 additions and 2 deletions.
  1. +14 −1 lambdacube-core/LC_C_Convert.hs
  2. +6 −1 lambdacube-core/LC_T_DSLType.hs
@@ -23,6 +23,19 @@ prjToInt :: TupleIdx t e -> Int
prjToInt ZeroTupIdx = 0
prjToInt (SuccTupIdx i) = 1 + prjToInt i
+genTupLen :: GPU a => Int -> a -> Int
+genTupLen i a = cnt i 0 $ T.tupleType a
+ where
+ size :: TupleType a -> Int
+ size UnitTuple = 0
+ size (SingleTuple a) = 1
+ size (PairTuple a b ) = size a + size b
+
+ cnt :: Int -> Int -> TupleType a -> Int
+ cnt 0 s _ = s
+ cnt n s (PairTuple a b) = cnt (n-1) (s + size b) a
+ cnt _ _ _ = error "internal error: genTupLen"
+
type Layout = [[Ty]]
genTy :: GPU a => a -> Ty
@@ -156,7 +169,7 @@ convertOpenExp lyt = cvt
cvt (H.PrimVar v :: H.Exp stage t') = primVar (genTy (undefined :: t')) (fst $ T.toInput v)
cvt (H.Uni v :: H.Exp stage t') = uni (genTy (undefined :: t')) (fst $ T.toInput v)
cvt (H.Tup tupl :: H.Exp stage t') = tup (genTy (undefined :: t')) $ convertTuple lyt tupl
- cvt (H.Prj idx e :: H.Exp stage t') = prj (genTy (undefined :: t')) (prjToInt idx) $ cvt e
+ cvt (H.Prj idx (e :: H.Exp stage e') :: H.Exp stage t') = prj (genTy (undefined :: t')) (genTupLen (prjToInt idx) (undefined :: e')) $ cvt e
cvt (H.Cond e1 e2 e3 :: H.Exp stage t') = cond (genTy (undefined :: t')) (cvt e1) (cvt e2) (cvt e3)
cvt (H.PrimApp p e :: H.Exp stage t') = primApp (genTy (undefined :: t')) (convertPrimFun p) $ cvt e
cvt (H.Sampler f em t :: H.Exp stage t') = sampler (genTy (undefined :: t')) f em $ convertTexture t
@@ -689,9 +689,14 @@ tix8 = SuccTupIdx tix7
-- used in shader codegen
data TupleType a where
UnitTuple :: TupleType ()
- SingleTuple :: IsScalar a => a -> TupleType a
+ SingleTuple :: (IsScalar a,Typeable a) => a -> TupleType a
PairTuple :: !(TupleType a) -> !(TupleType b) -> TupleType (a, b)
+instance Show (TupleType a) where
+ show UnitTuple = "UnitTuple"
+ show (SingleTuple v) = "SingleTuple '"++ show (typeOf v) ++"'"
+ show (PairTuple a b) = "PairTuple (" ++ show a ++ ") (" ++ show b ++ ")"
+
-- Extend Typeable support for 8- and 9-tuple
-- ------------------------------------------

3 comments on commit d7f41e6

This seems to cause lambdacube-core not to build (using ghc 7.6.2), with the following error:
LC_C_Convert.hs:172:51:
GHC internal error: `stage' is not in scope during type checking, but it passed the renamer
tcl_env of environment: [... lots of identifiers that aren't for "Type variable stage", which is what it's looking for I think ...]
In the type H.Exp stage t'
In a pattern type signature: H.Exp stage t'
In the pattern: H.Prj idx (e :: H.Exp stage e') :: H.Exp stage t'

Owner

csabahruska replied Apr 8, 2013

Thanks!

Please sign in to comment.