From fbb307078eb95cada21ba8dc2475c67220c4f636 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 11 May 2019 19:48:56 -0400 Subject: WIP: count built-in. --- src/LambdaCube/Compiler/CoreToIR.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs index 7f4f9561..1cfa77e0 100644 --- a/src/LambdaCube/Compiler/CoreToIR.hs +++ b/src/LambdaCube/Compiler/CoreToIR.hs @@ -176,7 +176,7 @@ getCommands backend e = case e of (smpBindings, txtCmds) <- mconcat <$> traverse (uncurry getRenderTextureCommands) (Map.toList $ fst <$> pUniforms) - let grokFetch slotName attrs = do + let grokFetch slotName input = do i <- IR.RenderSlot <$> addL' slotLens slotName (flip mergeSlot) IR.Slot { IR.slotName = slotName , IR.slotUniforms = IR.programUniforms prg @@ -186,7 +186,6 @@ getCommands backend e = case e of } return (i, input) where - input = compInputType'' attrs mergeSlot a b = a { IR.slotUniforms = IR.slotUniforms a <> IR.slotUniforms b , IR.slotStreams = IR.slotStreams a <> IR.slotStreams b @@ -194,9 +193,12 @@ getCommands backend e = case e of } (renderCommand,input) <- case input_ of - A2 "fetch" (EString slotName) attrs -> grokFetch slotName attrs + A2 "fetch" (EString slotName) attrs -> grokFetch slotName (compInputType'' attrs) A1 "zipCount" (A2 "fetch" (EString slotName) attrs) -> do - (rc,inp) <- grokFetch slotName attrs + (rc,inp) <- grokFetch slotName (compInputType'' attrs) + return (rc,inp) + A1 "count" _ -> do + (rc,inp) <- grokFetch "(internal)count" [] return (rc,inp) A1 "fetchArrays" (unzip . compAttributeValue -> (tys, values)) -> do i <- IR.RenderStream <$> addL streamLens IR.StreamData @@ -311,6 +313,7 @@ getVertexShader :: ExpTV -> ((Maybe ExpTV, Ty), ExpTV, Bool) getVertexShader xx@(A2 "map" (EtaPrim2 "mapPrimitive" f@(etaReds -> Just (_, o))) x) = let hasCount = case x of A1 "zipCount" _ -> True + A1 "count" _ -> True _ -> False in ((Just f, tyOf o), x, hasCount) --getVertexShader (A2 "map" (EtaPrim2 "mapPrimitive" f) x) = error $ "gff: " ++ show (case f of ExpTV x _ _ -> x) --ppShow (mapVal unFunc' f) -- cgit v1.2.3