Merge pull request #15 from deepfire/integer-image-capability

compValue:  allow literal integers to be processed

9 files changed, 520 insertions, 127 deletions

diff --git a/.gitignore b/.gitignore
index e43f36f9..efddb985 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,9 +1,12 @@
 *~
 dist
+dist-newstyle
 *.hi
 *.o
 lambdacube-compiler-test-suite.prof
 lambdacube-compiler-test-suite.tix
 *cabal-sandbox*
 *cabal.sandbox*
+.ghc.environment.*
+.dir-locals.el
 .stack-work
diff --git a/lambdacube-compiler.cabal b/lambdacube-compiler.cabal
index 5d57aece..6d47d950 100644
--- a/lambdacube-compiler.cabal
+++ b/lambdacube-compiler.cabal
@@ -96,7 +96,7 @@ library
     binary,
     bytestring,
     time,
-    aeson >=1.1,
+    aeson,
     base >=4.9,
     semigroups,
     containers >=0.5,
@@ -129,12 +129,12 @@ executable lc
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    base < 5,
+    base ,
     lambdacube-compiler,
-    optparse-applicative >=0.12 && <0.15,
-    aeson >=1.1 && <1.3,
+    optparse-applicative >=0.12,
+    aeson,
     bytestring,
-    filepath >=1.4 && <1.5
+    filepath >=1.4
 
 ------------------------
 -- tests for development
@@ -152,14 +152,14 @@ executable lambdacube-compiler-unit-tests
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    base < 5,
+    base,
     semigroups,
-    containers >=0.5 && <0.6,
+    containers >=0.5,
     lambdacube-compiler,
     megaparsec >= 6,
-    QuickCheck >= 2.8.2 && <2.11,
-    tasty >= 0.11 && <0.12,
-    tasty-quickcheck >=0.8 && <0.10
+    QuickCheck >= 2.8.2,
+    tasty >= 0.11,
+    tasty-quickcheck >=0.8
 
 executable lambdacube-compiler-test-suite
   hs-source-dirs:   test
@@ -178,26 +178,26 @@ executable lambdacube-compiler-test-suite
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    aeson >=1.1 && <1.3,
-    async >= 2.0 && <2.2,
-    base < 5,
+    aeson,
+    async >= 2.0,
+    base,
     semigroups,
-    containers >=0.5 && <0.6,
-    deepseq >=1.4 && <1.5,
-    directory >=1.3 && <1.4,
-    exceptions >= 0.8 && <0.9,
-    filepath >=1.4 && <1.5,
+    containers >=0.5,
+    deepseq >=1.4,
+    directory >=1.3,
+    exceptions >= 0.8,
+    filepath >=1.4,
     lambdacube-compiler,
-    mtl >=2.2 && <2.3,
-    monad-control >= 1.0 && <1.1,
-    optparse-applicative >=0.12 && <0.15,
+    mtl >=2.2,
+    monad-control >= 1.0,
+    optparse-applicative >=0.12,
     megaparsec >= 6,
-    ansi-wl-pprint >=0.6 && <0.7,
-    patience >= 0.1 && < 0.2,
-    text >= 1.2 && <1.3,
-    time >= 1.5 && <1.9,
+    ansi-wl-pprint >=0.6,
+    patience >= 0.1,
+    text >= 1.2,
+    time >= 1.5,
     lambdacube-ir == 0.3.*,
-    vector >= 0.12 && <0.13
+    vector >= 0.12
 
 executable lambdacube-compiler-performance-report
   hs-source-dirs:   test
@@ -211,11 +211,11 @@ executable lambdacube-compiler-performance-report
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    base < 5,
-    directory >=1.3 && <1.4,
-    filepath >=1.4 && <1.5,
-    containers >=0.5 && <0.6,
-    optparse-applicative >=0.12 && <0.15
+    base,
+    directory >=1.3,
+    filepath >=1.4,
+    containers >=0.5,
+    optparse-applicative >=0.12
 
 executable lambdacube-backend-test-server
   hs-source-dirs:   backendtest
@@ -231,23 +231,23 @@ executable lambdacube-backend-test-server
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    base < 5,
+    base,
     semigroups,
-    containers >=0.5 && <0.6,
-    text >= 1.2 && <1.3,
+    containers >=0.5,
+    text >= 1.2,
     lambdacube-compiler,
     lambdacube-ir == 0.3.*,
     pretty-show >= 1.6.9,
-    optparse-applicative >=0.12 && <0.15,
-    aeson >=1.1 && <1.3,
+    optparse-applicative >=0.12,
+    aeson,
     bytestring,
-    filepath >=1.4 && <1.5,
-    directory >=1.3 && <1.4,
+    filepath >=1.4,
+    directory >=1.3,
     websockets >= 0.9.6.1,
-    JuicyPixels >=3.2.7 && <3.3,
+    JuicyPixels >=3.2.7,
     vect >= 0.4.7,
     base64-bytestring >= 1.0.0.1,
-    vector >= 0.12 && <0.13,
+    vector >= 0.12,
     process >= 1.2
 
 executable lambdacube-compiler-coverage-test-suite
@@ -267,25 +267,25 @@ executable lambdacube-compiler-coverage-test-suite
 
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
   build-depends:
-    aeson >=1.1 && <1.3,
-    async >= 2.0 && <2.2,
-    base < 5,
+    aeson,
+    async >= 2.0,
+    base,
     bytestring,
     binary,
     semigroups,
-    containers >=0.5 && <0.6,
-    deepseq >=1.4 && <1.5,
-    directory >=1.3 && <1.4,
-    exceptions >= 0.8 && <0.9,
-    filepath >=1.4 && <1.5,
+    containers >=0.5,
+    deepseq >=1.4,
+    directory >=1.3,
+    exceptions >= 0.8,
+    filepath >=1.4,
     lambdacube-ir == 0.3.*,
-    mtl >=2.2 && <2.3,
-    monad-control >= 1.0 && <1.1,
-    optparse-applicative >=0.12 && <0.15,
+    mtl >=2.2,
+    monad-control >= 1.0,
+    optparse-applicative >=0.12,
     megaparsec >= 6,
-    ansi-wl-pprint >=0.6 && <0.7,
+    ansi-wl-pprint >=0.6,
     pretty-show >= 1.6.9,
-    patience >= 0.1 && < 0.2,
-    text >= 1.2 && <1.3,
-    time >= 1.5 && <1.9,
-    vector >= 0.12 && <0.13
+    patience >= 0.1,
+    text >= 1.2,
+    time >= 1.5,
+    vector >= 0.12
diff --git a/lc/Builtins.lc b/lc/Builtins.lc
index 03970dbd..15840268 100644
--- a/lc/Builtins.lc
+++ b/lc/Builtins.lc
@@ -539,6 +539,7 @@ PrjImageColor       :: FrameBuffer 1 '[ 'Depth, 'Color (Vec 4 Float)] -> Image 1
 
 data Output where
   ScreenOut           :: FrameBuffer a b -> Output
+  TextureOut          :: Vec 2 Int -> FrameBuffer a b -> Output
 
 renderFrame = ScreenOut
 
diff --git a/src/LambdaCube/Compiler.hs b/src/LambdaCube/Compiler.hs
index c0fef7a0..6a65c811 100644
--- a/src/LambdaCube/Compiler.hs
+++ b/src/LambdaCube/Compiler.hs
@@ -157,9 +157,9 @@ loadModule ex imp mname_ = do
             ms <- forM (moduleImports e) $ \(m, is) -> loadModule ex (Just fname) (Right $ sName m) <&> \r -> case r of
                       Left err -> Left $ pShow m <+> "is not found"
                       Right (fb, (src, dsge)) ->
-                         either (Left . const (pShow m <+> "couldn't be parsed"))
+                         either (Left . (\errm-> pShow m <+> "couldn't be parsed:\n" <+> errm))
                                 (\(pm, x, e) -> either
-                                    (Left . const (pShow m <+> "couldn't be typechecked"))
+                                    (Left .  (\errm-> pShow m <+> "couldn't be typechecked:\n" <+> errm))
                                     (\(ds, ge) -> Right (ds{-todo: filter-}, Map.filterWithKey (\k _ -> filterImports is k) ge))
                                     e)
                                 dsge
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 4b75c182..feb1d6e2 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -21,6 +21,8 @@ import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Vector as Vector
+import GHC.Stack
+import GHC.Word
 import Control.Arrow hiding ((<+>))
 import Control.Monad.Writer
 import Control.Monad.State
@@ -36,6 +38,8 @@ import LambdaCube.Compiler.Core (Subst(..), down, nType)
 import qualified LambdaCube.Compiler.Core as I
 import LambdaCube.Compiler.Infer (neutType', makeCaseFunPars')
 
+import Debug.Trace
+
 import Data.Version
 import Paths_lambdacube_compiler (version)
 
@@ -57,7 +61,12 @@ compilePipeline backend exp = IR.Pipeline
     ((subCmds,cmds), (streams, programs, targets, slots, textures))
         = flip runState ((0, mempty), mempty, (0, mempty), mempty, (0, mempty)) $ case toExp exp of
             A1 "ScreenOut" a -> addTarget backend a [IR.TargetItem s $ Just $ IR.Framebuffer s | s <- getSemantics a]
-            x -> error $ "ScreenOut expected inststead of " ++ ppShow x
+            A2 "TextureOut" rtexDimE rtexE -> do
+              let rtexDim  = case compValue rtexDimE of
+                               IR.VV2I v -> fromIntegral <$> v
+                               x -> error "Render texture dimensions should be a pair of non-negative integrals."
+              getTextureRenderTargetCommands backend rtexDim rtexE
+            x -> error $ "ScreenOut or TextureOut expected inststead of " ++ ppShow x
 
 type CG = State (List IR.StreamData, Map IR.Program Int, List IR.RenderTarget, Map String (Int, IR.Slot), List IR.TextureDescriptor)
 
@@ -77,11 +86,16 @@ addLEq l x = modL l $ \sv -> maybe (let i = length sv in i `seq` (i, Map.insert
 
 ---------------------------------------------------------
 
+addTarget
+  :: Backend
+  -> ExpTV
+  -> [IR.TargetItem]
+  -> CG ([IR.Command], [IR.Command])
 addTarget backend a tl = do
     rt <- addL targetLens $ IR.RenderTarget $ Vector.fromList tl
     second (IR.SetRenderTarget rt:) <$> getCommands backend a
 
-getCommands :: Backend -> ExpTV{-FrameBuffer-} -> CG ([IR.Command],[IR.Command])
+getCommands :: HasCallStack => Backend -> ExpTV{-FrameBuffer-} -> CG ([IR.Command],[IR.Command])
 getCommands backend e = case e of
 
     A1 "FrameBuffer" (ETuple a) -> return ([], [IR.ClearRenderTarget $ Vector.fromList $ map compFrameBuffer a])
@@ -90,7 +104,7 @@ getCommands backend e = case e of
 
       A3 "foldr" (A0 "++") (A0 "Nil") (A2 "map" (EtaPrim3 "rasterizePrimitive" ints rctx) (getVertexShader -> (vert, input_))) -> mdo
 
-        let 
+        let
             (vertexInput, pUniforms, vertSrc, fragSrc) = case backend of
               -- disabled DX11 codegen, due to it's incomplete
               --IR.DirectX11 -> genHLSLs backend (compRC' rctx) ints vert frag ffilter
@@ -98,11 +112,20 @@ getCommands backend e = case e of
 
             pUniforms' = snd <$> Map.filter ((\case UTexture2D{} -> False; _ -> True) . fst) pUniforms
 
+            imageSemantics   = getSemantics  e
+            imageTypes       = getImageInputTypes e
+            outImageType
+              = case imageTypes of
+                  []  -> error "Component-free pipelines are not supported."
+                  [x] -> x
+                  xs  -> flip fromMaybe (lookup IR.Color $ zip imageSemantics xs) $
+                         error "Multiple outputs, but no Color buffer?"
+
             prg = IR.Program
                 { IR.programUniforms    = pUniforms'
                 , IR.programStreams     = Map.fromList $ zip vertexInput $ map (uncurry IR.Parameter) input
                 , IR.programInTextures  = snd <$> Map.filter ((\case UUniform{} -> False; _ -> True) . fst) pUniforms
-                , IR.programOutput      = pure $ IR.Parameter "f0" IR.V4F -- TODO
+                , IR.programOutput      = pure $ IR.Parameter "f0" outImageType
                 , IR.vertexShader       = show vertSrc
                 , IR.geometryShader     = mempty -- TODO
                 , IR.fragmentShader     = show fragSrc
@@ -168,6 +191,7 @@ getCommands backend e = case e of
             let (a, tf) = case img of
                     A1 "PrjImageColor" a -> (,) a $ \[_, x] -> x
                     A1 "PrjImage" a      -> (,) a $ \[x] -> x
+                    x -> error $ "Unexpected image: " <> ppShow x
             tl <- forM (getSemantics a) $ \semantic -> do
                 texture <- addL textureLens IR.TextureDescriptor
                     { IR.textureType      = IR.Texture2D (if semantic == IR.Color then IR.FloatT IR.RGBA else IR.FloatT IR.Red) 1
@@ -194,6 +218,37 @@ getCommands backend e = case e of
             return ([(n, tx)], subCmds ++ cmds)
         _ -> return mempty
 
+getTextureRenderTargetCommands :: IR.Backend -> IR.V2 Word32 -> ExpTV -> CG ([IR.Command],[IR.Command])
+getTextureRenderTargetCommands backend dim body = do
+  let semantics  = getSemantics body
+      imageTypes = getImageTextureTypes body
+  targetItems <- forM (zip semantics imageTypes)
+                       $ \(semantic, imageType) -> do
+    texture <- addL textureLens IR.TextureDescriptor
+        { IR.textureType      = IR.Texture2D (if semantic == IR.Color
+                                              then imageType IR.RGBA
+                                              else IR.FloatT IR.Red)
+                                             1
+        , IR.textureSize      = IR.VV2U dim
+        , IR.textureSemantic  = semantic
+        , IR.textureSampler   = IR.SamplerDescriptor
+            { IR.samplerWrapS       = IR.Repeat
+            , IR.samplerWrapT       = Just IR.Repeat
+            , IR.samplerWrapR       = Nothing
+            , IR.samplerMinFilter   = IR.Nearest
+            , IR.samplerMagFilter   = IR.Nearest
+            , IR.samplerBorderColor = IR.VV4F (IR.V4 0 0 0 1)
+            , IR.samplerMinLod      = Nothing
+            , IR.samplerMaxLod      = Nothing
+            , IR.samplerLodBias     = 0
+            , IR.samplerCompareFunc = Nothing
+            }
+        , IR.textureBaseLevel = 0
+        , IR.textureMaxLevel  = 0
+        }
+    return $ IR.TargetItem semantic $ Just $ IR.TextureImage texture 0 Nothing
+  addTarget backend body targetItems
+
 type SamplerBinding = (IR.UniformName,IR.ImageRef)
 
 ----------------------------------------------------------------
@@ -201,7 +256,17 @@ type SamplerBinding = (IR.UniformName,IR.ImageRef)
 frameBufferType (A2 "FrameBuffer" _ ty) = ty
 frameBufferType x = error $ "illegal target type: " ++ ppShow x
 
-getSemantics = compSemantics . frameBufferType . tyOf
+getFramebufferType :: ExpTV -> [ExpTV]
+getFramebufferType = compList . frameBufferType . tyOf
+
+getSemantics :: ExpTV -> [IR.ImageSemantic]
+getSemantics = map compSemantic . getFramebufferType
+
+getImageTextureTypes :: ExpTV -> [IR.ColorArity -> IR.TextureDataType]
+getImageTextureTypes = map (imageInputTypeTextureType . compImageInputType) . getFramebufferType
+
+getImageInputTypes :: ExpTV -> [IR.InputType]
+getImageInputTypes = map compImageInputType . getFramebufferType
 
 getFragFilter (A2 "map" (EtaPrim2 "filterFragment" p) x) = (Just p, x)
 getFragFilter x = (Nothing, x)
@@ -226,8 +291,6 @@ compFrameBuffer = \case
   A1 "ColorImage" a -> IR.ClearImage IR.Color $ compValue a
   x -> error $ "compFrameBuffer " ++ ppShow x
 
-compSemantics = map compSemantic . compList
-
 compList (A2 ":" a x) = a : compList x
 compList (A0 "Nil") = []
 compList x = error $ "compList: " ++ ppShow x
@@ -249,6 +312,34 @@ compSemantic = \case
   A1 "Color" _   -> IR.Color
   x -> error $ "compSemantic: " ++ ppShow x
 
+imageInputTypeTextureType :: HasCallStack => IR.InputType -> (IR.ColorArity -> IR.TextureDataType)
+imageInputTypeTextureType = \case
+  IR.Float -> IR.FloatT
+  IR.Int   -> IR.IntT
+  IR.V2I   -> IR.IntT
+  IR.V3I   -> IR.IntT
+  IR.V4I   -> IR.IntT
+  IR.V2F   -> IR.FloatT
+  IR.V3F   -> IR.FloatT
+  IR.V4F   -> IR.FloatT
+  x -> error $ "Unsupported input type: " <> show x
+
+-- mirrors Builtins.lc:imageType
+compImageInputType :: HasCallStack => ExpTV -> IR.InputType
+compImageInputType = \case
+  A0 "Depth"     -> IR.Float
+  A0 "Stencil"   -> IR.Int
+  A1 "Color" c   -> case c of
+    (A2 "VecS" x y) -> flip fromMaybe (compInputType_ c) $
+                       error $ "Unexpected (compInputType) color image element type: " <> ppShow c
+      -- -> case x of
+      --      A0 "Float" -> (IR.Float, y)
+      --      A0 "Int"   -> (IR.Int, y)
+      --      A0 "Word"  -> (IR.Int, y)
+      --      _ -> error $ "Unexpected color image component type: " <> ppShow x
+    _ -> error $ "Unexpected color image element type: " <> ppShow c
+  x -> error $ "compImageType: " ++ ppShow x
+
 compAC (ETuple x) = IR.AccumulationContext Nothing $ map compFrag x
 
 compBlending x = case x of
@@ -359,6 +450,7 @@ showGLSLType msg = \case
 
 supType = isJust . compInputType_
 
+compInputType_ :: ExpTV -> Maybe IR.InputType
 compInputType_ x = case x of
   TFloat          -> Just IR.Float
   TVec 2 TFloat   -> Just IR.V2F
@@ -428,12 +520,16 @@ compFetchPrimitive x = case x of
   A0 "TriangleAdjacency" -> IR.TrianglesAdjacency
   x -> error $ "compFetchPrimitive " ++ ppShow x
 
+compValue :: HasCallStack => ExpTV -> IR.Value
 compValue x = case x of
   EFloat a -> IR.VFloat $ realToFrac a
   EInt a -> IR.VInt $ fromIntegral a
   A2 "V2" (EFloat a) (EFloat b) -> IR.VV2F $ IR.V2 (realToFrac a) (realToFrac b)
   A3 "V3" (EFloat a) (EFloat b) (EFloat c) -> IR.VV3F $ IR.V3 (realToFrac a) (realToFrac b) (realToFrac c)
   A4 "V4" (EFloat a) (EFloat b) (EFloat c) (EFloat d) -> IR.VV4F $ IR.V4 (realToFrac a) (realToFrac b) (realToFrac c) (realToFrac d)
+  A2 "V2" (EInt   a) (EInt   b)                       -> IR.VV2I $ fromIntegral <$> IR.V2 a b
+  A3 "V3" (EInt   a) (EInt   b) (EInt   c)            -> IR.VV3I $ fromIntegral <$> IR.V3 a b c
+  A4 "V4" (EInt   a) (EInt   b) (EInt   c) (EInt   d) -> IR.VV4I $ fromIntegral <$> IR.V4 a b c d
   A2 "V2" (EBool a) (EBool b) -> IR.VV2B $ IR.V2 a b
   A3 "V3" (EBool a) (EBool b) (EBool c) -> IR.VV3B $ IR.V3 a b c
   A4 "V4" (EBool a) (EBool b) (EBool c) (EBool d) -> IR.VV4B $ IR.V4 a b c d
@@ -492,6 +588,14 @@ compPV x = case x of
 
 --------------------------------------------------------------- GLSL generation
 
+genGLSLs
+  :: Backend
+  -> Maybe ExpTV
+  -> ExpTV
+  -> (Maybe ExpTV, ExpTV)
+  -> (Maybe ExpTV, ExpTV)
+  -> Maybe ExpTV
+  -> ([[Char]], Uniforms, Doc, Doc)
 genGLSLs backend
     rp                  -- program point size
     (ETuple ints)       -- interpolations
diff --git a/testdata/Builtins.out b/testdata/Builtins.out
index 654876f7..13c62398 100644
--- a/testdata/Builtins.out
+++ b/testdata/Builtins.out
@@ -1291,6 +1291,8 @@ PrjImageColor
 
 data Output :: Type where
     ScreenOut :: forall (a :: _) (b :: _) . FrameBuffer a b -> Output
+    TextureOut
+      :: forall (c :: _) (d :: _) . Vec (fromInt 2) Int -> FrameBuffer c d -> Output
 
 renderFrame = _lhs renderFrame (_rhs ScreenOut)
 
@@ -1658,7 +1660,8 @@ accumulationContext = _lhs accumulationContext \(a :: _) -> _rhs a
 'Maybe = <<type constructor with 0 indices; constructors: Nothing, Just>>
 
 'Output :: Type
-'Output = <<type constructor with 0 indices; constructors: ScreenOut>>
+'Output
+  = <<type constructor with 0 indices; constructors: ScreenOut, TextureOut>>
 
 'PointSize :: Type -> Type
 'PointSize
@@ -2489,6 +2492,10 @@ Texture2D = <<1st constructor of 'Texture>>
 Texture2DSlot :: String -> Texture
 Texture2DSlot = <<0th constructor of 'Texture>>
 
+TextureOut
+  :: forall (a :: Nat) (b :: [ImageKind]) . Vec 2 Int -> FrameBuffer a b -> Output
+TextureOut = <<1st constructor of 'Output>>
+
 Triangle :: PrimitiveType
 Triangle = <<0th constructor of 'PrimitiveType>>
 
@@ -2726,8 +2733,10 @@ case'Output
   :: forall (a :: Output -> Type)
     -> (forall (b :: Nat) (c :: [ImageKind])
         . forall (d :: FrameBuffer b c) -> a ('ScreenOut b c d))
-      -> forall (e :: Output) -> a e
-case'Output = \a b c -> <<case function of a type with 0 parameters>>
+      -> (forall (e :: Nat) (f :: [ImageKind])
+          . forall (g :: Vec 2 Int) (h :: FrameBuffer e f) -> a ('TextureOut e f g h))
+        -> forall (i :: Output) -> a i
+case'Output = \a b c d -> <<case function of a type with 0 parameters>>
 
 case'PointSize
   :: forall a
@@ -8584,8 +8593,8 @@ zero
     Type
 540:6-540:12
     Type | Type | Type | Type
-540:6-541:12
-    Type
+540:6-542:13
+    Type | Type
 541:3-541:12
     forall (a :: Nat) (b :: [ImageKind])
       . FrameBuffer a b -> Output | Output | Type | Type | Type | Type
@@ -8603,120 +8612,150 @@ zero
     _b
 541:45-541:51
     Type | Type
-543:1-543:12
+542:3-542:13
+    forall (a :: Nat) (b :: [ImageKind])
+      . Vec 2 Int
+        -> FrameBuffer a b -> Output | Output | Type | Type | Type | Type | Type
+542:26-542:29
+    Nat -> Type -> Type
+542:26-542:31
+    Type -> Type
+542:26-542:35
+    Type
+542:26-542:64
+    Type | Type
+542:30-542:31
+    _b
+542:32-542:35
+    Type
+542:39-542:50
+    Nat -> [ImageKind] -> Type
+542:39-542:52
+    [ImageKind] -> Type
+542:39-542:54
+    Type
+542:39-542:64
+    Type
+542:51-542:52
+    _e
+542:53-542:54
+    _c
+542:58-542:64
+    Type | Type
+544:1-544:12
     forall (a :: Nat) (b :: [ImageKind]) . FrameBuffer a b -> Output
-543:15-543:24
+544:15-544:24
     forall (a :: Nat) (b :: [ImageKind]) . FrameBuffer a b -> Output
-549:6-549:13
+550:6-550:13
     Type | Type | Type | Type
-549:6-553:12
+550:6-554:12
     Type | Type
-550:3-550:16
+551:3-551:16
     String -> Texture | Texture | Type | Type
-550:20-550:26
+551:20-551:26
     Type
-551:20-551:27
+552:20-552:27
     Type | Type
-553:3-553:12
+554:3-554:12
     Vec 2 Int
       -> Image 1 ('Color (Vec 4 Float)) -> Texture | Texture | Type | Type | Type
-553:20-553:23
+554:20-554:23
     Nat -> Type -> Type
-553:20-553:25
+554:20-554:25
     Type -> Type
-553:20-553:29
+554:20-554:29
     Type
-553:24-553:25
+554:24-554:25
     _b
-553:26-553:29
+554:26-554:29
     Type
-554:20-554:25
+555:20-555:25
     Nat -> ImageKind -> Type
-554:20-554:27
+555:20-555:27
     ImageKind -> Type
-554:20-554:49
+555:20-555:49
     Type
-554:20-555:27
+555:20-556:27
     Type
-554:26-554:27
+555:26-555:27
     _b
-554:29-554:34
+555:29-555:34
     Type -> ImageKind
-554:29-554:48
+555:29-555:48
     ImageKind
-554:36-554:39
+555:36-555:39
     Nat -> Type -> Type
-554:36-554:41
+555:36-555:41
     Type -> Type
-554:36-554:47
+555:36-555:47
     Type
-554:40-554:41
+555:40-555:41
     _b
-554:42-554:47
+555:42-555:47
     Type
-555:20-555:27
+556:20-556:27
     Type | Type
-557:6-557:12
+558:6-558:12
     Type | Type | Type | Type | Type | Type
-557:6-559:17
+558:6-560:17
     Type | Type
-558:5-558:16
+559:5-559:16
     Filter
-559:5-559:17
+560:5-560:17
     Filter
-561:6-561:14
+562:6-562:14
     Type | Type | Type | Type | Type | Type | Type
-561:6-564:16
+562:6-565:16
     Type | Type | Type
-562:5-562:11
+563:5-563:11
     EdgeMode
-563:5-563:19
+564:5-564:19
     EdgeMode
-564:5-564:16
+565:5-565:16
     EdgeMode
-566:6-566:13
+567:6-567:13
     Type | Type | Type | Type | Type | Type
-566:6-566:23
+567:6-567:23
     Type
-566:6-566:47
+567:6-567:47
     Type | Type
-566:16-566:23
+567:16-567:23
     Filter -> EdgeMode -> Texture -> Sampler | Sampler | Type | Type | Type | Type
-566:24-566:30
+567:24-567:30
     Type
-566:31-566:39
+567:31-567:39
     Type
-566:40-566:47
+567:40-567:47
     Type
-569:1-569:10
+570:1-570:10
     Sampler -> Vec 2 Float -> Vec 4 Float
-569:14-569:21
+570:14-570:21
     Type
-569:25-569:28
+570:25-570:28
     Nat -> Type -> Type
-569:25-569:30
+570:25-570:30
     Type -> Type
-569:25-569:36
+570:25-570:36
     Type
-569:25-569:51
+570:25-570:51
     Type
-569:29-569:30
+570:29-570:30
     _b
-569:31-569:36
+570:31-570:36
     Type
-569:40-569:43
+570:40-570:43
     Nat -> Type -> Type
-569:40-569:45
+570:40-570:45
     Type -> Type
-569:40-569:51
+570:40-570:51
     Type | Type
-569:44-569:45
+570:44-570:45
     _b
-569:46-569:51
+570:46-570:51
     Type
-573:1-573:20
+574:1-574:20
     forall a . a -> a
-573:25-573:26
+574:25-574:26
     _b
 ------------ warnings
 Uncovered pattern(s) at testdata/Builtins.lc:201:1:
diff --git a/testdata/graphics-features/pickInt.lc b/testdata/graphics-features/pickInt.lc
new file mode 100644
index 00000000..3c2dba84
--- /dev/null
+++ b/testdata/graphics-features/pickInt.lc
@@ -0,0 +1,25 @@
+-- Tests:
+--  1. Pipeline targeting a render texture (TextureOut), instead of a Screenout.
+--  2. Integer color components for the output
+
+type FB = FrameBuffer 1 '[ 'Color (Vec 4 Int)]
+
+scene :: String -> FB -> FB
+scene name prevFB =
+  Accumulate    ((ColorOp NoBlending (one :: Vec 4 Bool)))
+  (mapFragments (\(uv, rgba) -> ((rgba)))
+   $ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
+   $ mapPrimitives
+    (\(pos, color, id)->
+      ( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
+      , V2 0.0 0.0
+      , V4 0 0 0 id))
+    $ fetch name ( Attribute "position"   :: Vec 3 Float
+                 , Attribute "color"      :: Vec 4 Float
+                 , Attribute "id"         :: Int))
+  prevFB
+
+main :: Output
+main = TextureOut (V2 800 600) $
+       scene "objects" $
+       FrameBuffer ((colorImage1 (V4 0 0 0 0)))
diff --git a/testdata/graphics-features/pickInt.out b/testdata/graphics-features/pickInt.out
new file mode 100644
index 00000000..8812744e
--- /dev/null
+++ b/testdata/graphics-features/pickInt.out
@@ -0,0 +1,111 @@
+Pipeline
+  { info = ""
+  , backend = OpenGL33
+  , textures =
+      [ TextureDescriptor
+          { textureType = Texture2D (IntT RGBA) 1
+          , textureSize = VV2U (V2 800 600)
+          , textureSemantic = Color
+          , textureSampler =
+              SamplerDescriptor
+                { samplerWrapS = Repeat
+                , samplerWrapT = Just Repeat
+                , samplerWrapR = Nothing
+                , samplerMinFilter = Nearest
+                , samplerMagFilter = Nearest
+                , samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0)
+                , samplerMinLod = Nothing
+                , samplerMaxLod = Nothing
+                , samplerLodBias = 0.0
+                , samplerCompareFunc = Nothing
+                }
+          , textureBaseLevel = 0
+          , textureMaxLevel = 0
+          }
+      ]
+  , samplers = []
+  , targets =
+      [ RenderTarget
+          { renderTargets =
+              [ TargetItem
+                  { targetSemantic = Color
+                  , targetRef = Just (TextureImage 0 0 Nothing)
+                  }
+              ]
+          }
+      ]
+  , programs =
+      [ Program
+          { programUniforms = fromList [ ( "viewProj" , M44F ) ]
+          , programStreams =
+              fromList
+                [ ( "vi1" , Parameter { name = "position" , ty = V3F } )
+                , ( "vi2" , Parameter { name = "color" , ty = V4F } )
+                , ( "vi3" , Parameter { name = "id" , ty = Int } )
+                ]
+          , programInTextures = fromList []
+          , programOutput = [ Parameter { name = "f0" , ty = V4I } ]
+          , vertexShader =
+              """
+              #version 330 core
+              vec4 texture2D(sampler2D s,vec2 uv) {
+                  return texture(s,uv);
+              }
+              uniform mat4 viewProj;
+              in vec3 vi1;
+              in vec4 vi2;
+              in int vi3;
+              flat out vec2 vo1;
+              flat out ivec4 vo2;
+              void main() {
+                  gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));
+                  vo1 = vec2 (0.0,0.0);
+                  vo2 = ivec4 (0,0,0,vi3);
+              }
+              """
+          , geometryShader = Nothing
+          , fragmentShader =
+              """
+              #version 330 core
+              vec4 texture2D(sampler2D s,vec2 uv) {
+                  return texture(s,uv);
+              }
+              flat in vec2 vo1;
+              flat in ivec4 vo2;
+              out ivec4 f0;
+              void main() {
+                  f0 = vo2;
+              }
+              """
+          }
+      ]
+  , slots =
+      [ Slot
+          { slotName = "objects"
+          , slotStreams =
+              fromList
+                [ ( "color" , V4F ) , ( "id" , Int ) , ( "position" , V3F ) ]
+          , slotUniforms = fromList [ ( "viewProj" , M44F ) ]
+          , slotPrimitive = Triangles
+          , slotPrograms = [ 0 ]
+          }
+      ]
+  , streams = []
+  , commands =
+      [ SetRenderTarget 0
+      , ClearRenderTarget
+          [ ClearImage
+              { imageSemantic = Color , clearValue = VV4I (V4 0 0 0 0) }
+          ]
+      , SetProgram 0
+      , SetRasterContext
+          (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex)
+      , SetAccumulationContext
+          AccumulationContext
+            { accViewportName = Nothing
+            , accOperations =
+                [ ColorOp NoBlending (VV4B (V4 True True True True)) ]
+            }
+      , RenderSlot 0
+      ]
+  }
\ No newline at end of file
diff --git a/testdata/graphics-features/pickInt.ppl b/testdata/graphics-features/pickInt.ppl
new file mode 100644
index 00000000..742549a3
--- /dev/null
+++ b/testdata/graphics-features/pickInt.ppl
@@ -0,0 +1,110 @@
+Pipeline
+  { info = "generated by lambdacube-compiler 0.6.1.0"
+  , backend = OpenGL33
+  , textures =
+      [ TextureDescriptor
+          { textureType = Texture2D (IntT RGBA) 1
+          , textureSize = VV2U (V2 800 600)
+          , textureSemantic = Color
+          , textureSampler =
+              SamplerDescriptor
+                { samplerWrapS = Repeat
+                , samplerWrapT = Just Repeat
+                , samplerWrapR = Nothing
+                , samplerMinFilter = Nearest
+                , samplerMagFilter = Nearest
+                , samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0)
+                , samplerMinLod = Nothing
+                , samplerMaxLod = Nothing
+                , samplerLodBias = 0.0
+                , samplerCompareFunc = Nothing
+                }
+          , textureBaseLevel = 0
+          , textureMaxLevel = 0
+          }
+      ]
+  , samplers = []
+  , targets =
+      [ RenderTarget
+          { renderTargets =
+              [ TargetItem
+                  { targetSemantic = Color
+                  , targetRef = Just (TextureImage 0 0 Nothing)
+                  }
+              ]
+          }
+      ]
+  , programs =
+      [ Program
+          { programUniforms = fromList [ ( "viewProj" , M44F ) ]
+          , programStreams =
+              fromList
+                [ ( "vi1" , Parameter { name = "position" , ty = V3F } )
+                , ( "vi2" , Parameter { name = "uv" , ty = V2F } )
+                , ( "vi3" , Parameter { name = "id" , ty = Int } )
+                ]
+          , programInTextures = fromList []
+          , programOutput = [ Parameter { name = "f0" , ty = V4I } ]
+          , vertexShader =
+              """
+              #version 330 core
+              vec4 texture2D(sampler2D s,vec2 uv) {
+                  return texture(s,uv);
+              }
+              uniform mat4 viewProj;
+              in vec3 vi1;
+              in vec2 vi2;
+              in int vi3;
+              flat out vec2 vo1;
+              flat out ivec4 vo2;
+              void main() {
+                  gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));
+                  vo1 = vi2;
+                  vo2 = ivec4 (0,0,0,vi3);
+              }
+              """
+          , geometryShader = Nothing
+          , fragmentShader =
+              """
+              #version 330 core
+              vec4 texture2D(sampler2D s,vec2 uv) {
+                  return texture(s,uv);
+              }
+              flat in vec2 vo1;
+              flat in ivec4 vo2;
+              out ivec4 f0;
+              void main() {
+                  f0 = vo2;
+              }
+              """
+          }
+      ]
+  , slots =
+      [ Slot
+          { slotName = "stream"
+          , slotStreams =
+              fromList [ ( "id" , Int ) , ( "position" , V3F ) , ( "uv" , V2F ) ]
+          , slotUniforms = fromList [ ( "viewProj" , M44F ) ]
+          , slotPrimitive = Triangles
+          , slotPrograms = [ 0 ]
+          }
+      ]
+  , streams = []
+  , commands =
+      [ SetRenderTarget 0
+      , ClearRenderTarget
+          [ ClearImage
+              { imageSemantic = Color , clearValue = VV4I (V4 0 0 0 0) }
+          ]
+      , SetProgram 0
+      , SetRasterContext
+          (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex)
+      , SetAccumulationContext
+          AccumulationContext
+            { accViewportName = Nothing
+            , accOperations =
+                [ ColorOp NoBlending (VV4B (V4 True True True True)) ]
+            }
+      , RenderSlot 0
+      ]
+  }
\ No newline at end of file