The 'while' function doesn’t generate correct GLSL code

[Chatanga]

See for yourself:

withNewline s = s ++ "\n"

test_while :: IO ()
test_while = do
    let
        total :: VInt
        total = snd $ while
            (\(i, _) -> i <* 3)
            (\(i, n) -> (i + 1, 10 * i + n))
            (0, 1)

        decls = tellGlobalLn "// hello"

        shaderExpr = unS total >> return ()

    -- The last two values aren’t meant to be evaluated (will trip over an
    -- undefined value otherwise) since there is no previous stage here.
    (source, unis, samps, inps, _, _) <- runExprM decls shaderExpr

    assertEqual
        (concatMap withNewline
            [ "#version 450"
            , "// hello;"
            , "void main() {"
            , "int t0;"
            , "int t1;"
            , "t0 = 0;" -- i <- 0
            , "t1 = 1;" -- n <- 1
            , "bool t2 = (0<3);"
            , "bool t3 = t2;"
            , "while(t3){"
            , "int t4 = (t0+1);" -- i = i + 1
            , "t0 = t4;" -- How to move this assignment THERE?
            , "int t5 = (10*t0);" -- Bug: variable 'i' (t0) has already been incremented.
            , "int t6 = (t5+t1);" -- n = 10 * i + n
            , "t1 = t6;" -- The last assignment is already THERE.
            -- THERE
            , "bool t7 = (t4<3);"
            , "t3 = t7;"
            , "}"
            , "}"
            ])
        source

Working around this issue is easy, but the resulting code obviously doesn’t look right from the Haskell side.

[Chatanga]

The culprit function with a "Bug" comment near the problematic part. If someone has any idea to fix this problem (which, by design, seems specific to this only place where GPipe creates a loop), I would be happy to hear it!

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
        x = undefined :: x
        while_
            :: (ShaderBase (ShaderBaseType a) x -> S x Bool)
            -> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x)
            ->  ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
        while_ bool loopF a =
            let whileM = memoizeM $ do
                    (lifted, decls) <- runWriterT $ shaderbaseDeclare (toBase x (errShaderType :: a))
                    void $ evalStateT (shaderbaseAssign a) decls
                    boolDecl <- tellAssignment STypeBool (unS $ bool a)
                    T.lift $ T.lift $ tell $ mconcat ["while(", boolDecl, "){\n" ]
                    let looped = loopF lifted

                    scopedM $ do
                        -- Bug: reassigning back to the same var (in decls) breaks the functional referential transparency.
                        void $ evalStateT (shaderbaseAssign looped) decls
                        loopedBoolStr <- unS $ bool looped
                        tellAssignment' boolDecl loopedBoolStr

                    T.lift $ T.lift $ tell "}\n"
                    return decls
            in  evalState (runReaderT (shaderbaseReturn (toBase x (errShaderType :: a))) whileM) 0

[Chatanga]

I've ended up with this solution to fix the issue:

• modified shaderbaseAssign and added shaderbaseAssignWithLateAssignment
• added shaderbaseAssignDef'