~jojo/Carth

336f558b46bbab6dad59fc8f3911a613d563aafe — JoJo a month ago 96de857
lower: Data to Struct w tag + Union, add type to Expr, localEnv
6 files changed, 181 insertions(+), 100 deletions(-)

M src/Back/Codegen.hs
M src/Back/Low.hs
M src/Back/Lower.hs
M stack.yaml
M stack.yaml.lock
M test/LowPgms.hs
M src/Back/Codegen.hs => src/Back/Codegen.hs +39 -36
@@ 19,7 19,7 @@ import qualified LLVM.AST.Linkage as LL
import qualified LLVM.AST.ParameterAttribute as LL
import qualified LLVM.AST.Type as LL
import qualified LLVM.AST.Visibility as LLVis
import qualified LLVM.AST.Constant as LL hiding (Add, Sub, Mul)
import qualified LLVM.AST.Constant as LL hiding (Add, Sub, Mul, GetElementPtr, BitCast)
import Data.Either
import Data.List
import Data.String


@@ 28,7 28,7 @@ import qualified Data.Vector as Vec

import Misc
import Sizeof (variantsTagBits, toBits)
import Back.Low
import Back.Low as Low

data St = St
    { currentLabel :: Name


@@ 98,11 98,13 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
            DStruct s -> pure $ TypeDefinition
                (mkName name)
                (Just (structType (map genType (structMembers s))))
            DData Data { dataVariants = vs, dataGreatestSize = sMax, dataGreatestAlignment = aMax }
                -> let tag = IntegerType (variantsTagBits vs)
                       fill = ArrayType (fromIntegral (div (sMax + aMax - 1) aMax))
                                        (IntegerType (fromIntegral (toBits aMax)))
                   in  [TypeDefinition (mkName name) (Just (structType [tag, fill]))]
            DUnion Union { unionGreatestSize = sMax, unionGreatestAlignment = aMax } ->
                let fill = ArrayType (fromIntegral (div (sMax + aMax - 1) aMax))
                                     (IntegerType (fromIntegral (toBits aMax)))
                -- In LLVM, only structs can be identified type definitions, so wrap
                -- the array in a singleton struct, since we want to see the type name
                -- in generated code.
                in  [TypeDefinition (mkName name) (Just (structType [fill]))]

    declareExterns :: [Definition]
    declareExterns = map declare exts


@@ 309,40 311,42 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
        -- TODO: More elegant code for nested branches. Collapse in a single, flat step,
        --       instead of level-wise.
        genExpr :: Expr -> Gen (LL.Type, LL.Instruction)
        genExpr = \case
        genExpr (Expr e t) = (genType t, ) <$> case e of
            Add a b ->
                let (a', b') = (genOperand a, genOperand b)
                in  pure (LL.typeOf a', LL.Add False False a' b' [])
                in  pure (LL.Add False False a' b' [])
            Sub a b ->
                let (a', b') = (genOperand a, genOperand b)
                in  pure (LL.typeOf a', LL.Sub False False a' b' [])
                in  pure (LL.Sub False False a' b' [])
            Mul a b ->
                let (a', b') = (genOperand a, genOperand b)
                in  pure (LL.typeOf a', LL.Mul False False a' b' [])
                in  pure (LL.Mul False False a' b' [])
            Load src ->
                let src' = genOperand src
                in  pure
                        ( getPointee (LL.typeOf src')
                        , LL.Load { volatile = False
                                  , address = src'
                                  , maybeAtomicity = Nothing
                                  , alignment = 0
                                  , metadata = []
                                  }
                        )
                in  pure LL.Load { volatile = False
                                 , address = src'
                                 , maybeAtomicity = Nothing
                                 , alignment = 0
                                 , metadata = []
                                 }
            Call f as ->
                -- FIXME: This doesn't handle sret, does it? Should it be handled here
                --        then, or in Lower? For cleaner C codegen, we should probably
                --        handle it here.
                let f' = genOperand f
                    rt = getReturn (getPointee (LL.typeOf f'))
                in  pure (rt, call f' (map genOperand as))
            Loop params rt blk -> genLoop params rt blk
            EBranch br -> genEBranch br
                let f' = genOperand f in pure (call f' (map genOperand as))
            Loop params rt blk -> snd <$> genLoop params rt blk
            EBranch br -> snd <$> genEBranch br
            EGetMember i x -> pure LL.GetElementPtr
                { inBounds = False
                , address = genOperand x
                , indices = [litI64 (0 :: Integer), litI32 i]
                , metadata = []
                }
            EAsVariant x _ -> pure (LL.BitCast (genOperand x) (genType t) [])

        genLoop
            :: [(Local, Operand)]
            -> Type
            :: [(Local, Low.Operand)]
            -> Low.Type
            -> Block LoopTerminator
            -> Gen (LL.Type, LL.Instruction)
        genLoop params t (Block stms term) = do


@@ 395,15 399,9 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
            let t' = genType t
            pure (t', LL.Phi t' breaks [])

        getPointee = \case
            LL.PointerType t _ -> t
            t -> ice $ "Tried to get pointee of non-pointer type " ++ show t

        getReturn = \case
            LL.FunctionType rt _ _ -> rt
            t -> ice $ "Tried to get return of non-function type " ++ show t

        genOperand :: Operand -> LL.Operand
        genOperand :: Low.Operand -> LL.Operand
        genOperand = \case
            OLocal x -> genLocal x
            OGlobal x -> LL.ConstantOperand (genGlobal x)


@@ 413,7 411,7 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
        genLocal (Local ident t) =
            LocalReference (genType t) (mkName (getName lnames ident))

        genGlobal :: Global -> LL.Constant
        genGlobal :: Low.Global -> LL.Constant
        genGlobal (Global ident t) =
            LL.GlobalReference (genType t) (mkName (getGName ident))



@@ 443,7 441,7 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
            modify (\st -> st { labelCount = n + 1 })
            pure $ mkName ("L" ++ show n ++ s)

    genType :: Type -> LL.Type
    genType :: Low.Type -> LL.Type
    genType = \case
        TI8 -> LL.IntegerType 8
        TI16 -> LL.IntegerType 16


@@ 474,6 472,11 @@ codegen layout triple noGC' moduleFilePath (Program funs exts gvars tdefs gnames
            s -> s
        else gnames

    litI64 :: Integral a => a -> LL.Operand
    litI64 = LL.ConstantOperand . LL.Int 64 . toInteger

    litI32 :: Integral a => a -> LL.Operand
    litI32 = LL.ConstantOperand . LL.Int 32 . toInteger

commitThen :: LL.Terminator -> Name -> Gen ()
commitThen term next = do

M src/Back/Low.hs => src/Back/Low.hs +26 -7
@@ 7,8 7,8 @@ import Data.Int
import Sizeof hiding (sizeof)
import Front.Monomorphic (Access')

data Param name = ByVal name Type | ByRef name Type deriving (Eq, Ord)
data Ret = RetVal Type | RetVoid | OutParam Type deriving (Eq, Ord)
data Param name = ByVal name Type | ByRef name Type deriving (Eq, Ord, Show)
data Ret = RetVal Type | RetVoid | OutParam Type deriving (Eq, Ord, Show)

-- | There is no unit or void type. Instead, Lower has purged datatypes of ZSTs, and
--   void-returns and void-calls are their own variants. This isn't very elegant from a


@@ 28,7 28,7 @@ data Type
    | TFun [Param ()] Ret
    | TConst TypeId
    | TArray Type Word
  deriving (Eq, Ord)
  deriving (Eq, Ord, Show)

type Access = Access' Type



@@ 37,6 37,7 @@ data LowInt
    | I16 Int16
    | I32 Int32
    | I64 Prelude.Int
    deriving Show

data Const
    = Undef Type


@@ 46,19 47,23 @@ data Const
    | EnumVal TypeId LowInt
    | Array Type [Const]
    | Zero Type
    deriving Show

type LocalId = Word
type GlobalId = Word
type TypeId = Word

data Local = Local LocalId Type
    deriving Show
data Global = Global GlobalId Type -- Type excluding the pointer
    deriving Show

data Operand = OLocal Local | OGlobal Global | OConst Const
data Operand = OLocal Local | OGlobal Global | OConst Const deriving Show

data Branch term
    = If Local (Block term) (Block term)
    | Switch Local [(Const, Block term)] (Block term)
    deriving Show

data Statement
    = Let Local Expr


@@ 66,6 71,7 @@ data Statement
    | SBranch (Branch ())
    | VoidCall Operand [Operand]
    | Do Expr
    deriving Show

data Terminator
    = TRetVal Operand


@@ 75,11 81,13 @@ data Terminator
                        -- param, instead of allocating an extra stack variable to store
                        -- the call output in, before writing it to our own output param.
    | TBranch (Branch Terminator)
    deriving Show

data LoopTerminator
    = Continue [Operand]
    | Break Operand
    | LBranch (Branch LoopTerminator)
    deriving Show

data Expr'
    = Add Operand Operand


@@ 91,52 99,63 @@ data Expr'
           Type -- loop return
           (Block LoopTerminator)
    | EBranch (Branch Expr)
    | EGetMember Word Operand -- Get the Nth member of a struct
    -- Given a tagged union, a Data, get the untagged union as a specific variant
    | EAsVariant Word Operand
    -- Given a pointer to a struct, get a pointer to the Nth member of that struct
    | EGetMember Word Operand
    -- Given a pointer to an untagged union, get it as a specific variant
    | EAsVariant Operand Word
    deriving Show

data Expr = Expr
    { eInner :: Expr'
    , eType :: Type
    }
    deriving Show

data Block term = Block
    { blockStms :: [Statement]
    , blockTerm :: term
    }
    deriving Show

type VarNames = Vector String

type Allocs = [(LocalId, Type)]

data FunDef = FunDef GlobalId [Param LocalId] Ret (Block Terminator) Allocs VarNames
    deriving Show
data ExternDecl = ExternDecl String [Param ()] Ret
    deriving Show
data GlobDef
    = GVarDef Global (Block Expr) VarNames
    | GConstDef Global Const
    deriving Show

data Struct = Struct
    { structMembers :: [Type]
    , structAlignment :: Word
    , structSize :: Word
    }
    deriving Show

data Union = Union
    { unionVariants :: Vector (String, TypeId)
    , unionGreatestSize :: Word
    , unionGreatestAlignment :: Word
    }
    deriving Show

data TypeDef'
    = DEnum (Vector String)
    | DStruct Struct
    | DUnion Union
    deriving Show

type TypeDef = (String, TypeDef')

type TypeDefs = Vector TypeDef

data Program = Program [FunDef] [ExternDecl] [GlobDef] TypeDefs VarNames
    deriving Show

typeName :: TypeDefs -> Word -> String
typeName ds i = fst (ds Vec.! fromIntegral i)

M src/Back/Lower.hs => src/Back/Lower.hs +68 -30
@@ 4,6 4,7 @@ module Back.Lower (lower) where

import Control.Arrow
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Bifunctor (bimap)


@@ 17,12 18,12 @@ import Data.Maybe
import Data.Vector (Vector)
import qualified Data.Vector as Vec
import Data.Word
import Lens.Micro.Platform (makeLenses, modifying, use)
import Lens.Micro.Platform (makeLenses, modifying, use, assign, view)

import Back.Low (typeof)
import qualified Back.Low as Low
import Front.Monomorphic
import Misc
import Misc ( ice, nyi, partitionWith, TopologicalOrder(Topo), locally )
import Sizeof

data Sized x = ZeroSized | Sized x


@@ 31,19 32,35 @@ mapSized :: (a -> b) -> Sized a -> Sized b
mapSized f (Sized a) = Sized (f a)
mapSized _ ZeroSized = ZeroSized

newtype St = St
data St = St
    { _strLits :: Map String Low.GlobalId
    , _localNames :: Vector String
    }
makeLenses ''St

newtype Env = Env
    { _localEnv :: Map String Low.Operand }
makeLenses ''Env

type Out = ([Low.FunDef], [Low.GlobDef])

type Lower = WriterT Out (State St)
type Lower = WriterT Out (StateT St (Reader Env))

-- | A potentially not yet emitted&named operand
type PartialOperand = Either Low.Expr Low.Operand
type EBlock = Low.Block (Sized PartialOperand)

-- Regarding the stack and registers.
--
-- I'm thinking we could generate Low IR such that all structs & unions are on the stack,
-- which means they would require an Alloc and the type would be behind a TPtr. All
-- primitive types would be in registers. This would simplify Lower. We would for example
-- not need both an ExtractElement and GetElementPointer, like in LLVM. Only a GEP would
-- do, since we keep all structs on the stack.
--
-- We assume then that the next codegen step in the pipe will do register allocation, and
-- optimize such that small structs are kept in register instead of on the stack etc.

lower :: Program -> Low.Program
lower (Program (Topo defs) datas externs) =
    let _externNames = map fst externs


@@ 90,7 107,7 @@ lower (Program (Topo defs) datas externs) =
                ZeroSized -> pure Nothing
                Sized pt -> do
                    pid <- newLName (tvName p)
                    let bind = (p, Low.OLocal (Low.Local pid pt))
                    let bind = (tvName p, Low.OLocal (Low.Local pid pt))
                    pure (Just (bind, pid, pt))
        capturesName <- newLName "captures"
        body <- withVars binds (lowerBody body)


@@ 105,7 122,10 @@ lower (Program (Topo defs) datas externs) =
            localNames

    popLocalNames :: Lower Low.VarNames
    popLocalNames = undefined
    popLocalNames = do
        xs <- use localNames
        assign localNames Vec.empty
        pure xs

    popAllocs :: Lower Low.Allocs
    popAllocs = undefined


@@ 128,7 148,7 @@ lower (Program (Topo defs) datas externs) =
    lowerExpr :: Expr -> Lower EBlock
    lowerExpr = \case
        Lit c -> lowerConst c <&> \c' -> operandBlock c'
        Var x -> Low.Block [] . mapSized Right <$> lookupVar x
        Var (TypedVar x _) -> Low.Block [] . mapSized Right <$> lookupVar x
        -- App Expr [Expr]
        -- If Expr Expr Expr
        -- Fun Fun


@@ 142,8 162,8 @@ lower (Program (Topo defs) datas externs) =

    litI64 = Low.OConst . Low.CInt . Low.I64 . fromIntegral

    lookupVar :: TypedVar -> Lower (Sized Low.Operand)
    lookupVar = undefined
    lookupVar :: String -> Lower (Sized Low.Operand)
    lookupVar x = maybe ZeroSized Sized . Map.lookup x <$> view localEnv

    lowerConst :: Const -> Lower Low.Operand
    lowerConst = \case


@@ 202,31 222,32 @@ lower (Program (Topo defs) datas externs) =
                        pure (a'', s')
                    ADeref x -> do
                        (a', s') <- select x selections
                        a'' <- bindBlock a' deref
                        a'' <- bindBlock a' load
                        pure (a'', s')
                pure (ba, Map.insert selector (Low.blockTerm ba) selections')

        -- Assumes matchee is of type pointer to tagged union
        asVariant matchee span variantIx = if span == 1
            then pure $ Low.Block [] matchee
            else
                let t = Low.TConst (typeIdOfDataVariant variantIx (typeof matchee))
                in  emit (Low.Expr (Low.EAsVariant variantIx matchee) t)

        typeIdOfDataVariant variantIx = \case
            -- For a sum type / tagged union, the TConst ID maps to the outer struct, the
            -- succeding ID maps to the inner union type, and following that is a struct
            -- for each variant.
            Low.TConst tid -> tid + 2 + variantIx
            _ -> ice "Lower.typeIdOfDataVariant: type is not TConst"
            else do
                let
                    tidData = case typeof matchee of
                        Low.TPtr (Low.TConst tid) -> tid
                        _ -> ice "Lower.asVariant: type of mathee is not TPtr to TConst"
                    -- t = Low.TPtr $ typeOfDataVariant variantIx (pointee (typeof matchee))
                let tvariant = Low.TPtr (Low.TConst (tidData + 2 + variantIx))
                union <- indexStruct 1 matchee -- Skip tag to get inner union
                bindBlock union $ \union' ->
                    emit $ Low.Expr (Low.EAsVariant union' variantIx) tvariant

        selectVarBindings
            :: Map Low.Access Low.Operand
            -> [(TypedVar, Low.Access)]
            -> Lower (Low.Block [(TypedVar, Low.Operand)])
            -> Lower (Low.Block [(String, Low.Operand)])
        selectVarBindings selections = fmap fst . foldlM
            (\(block1, selections) (x, access) -> do
                (block2, ss') <- select access selections
                pure (mapTerm (pure . (x, )) block2 <> block1, ss')
                pure (mapTerm (pure . (tvName x, )) block2 <> block1, ss')
            )
            (Low.Block [] [], selections)



@@ 248,11 269,15 @@ lower (Program (Topo defs) datas externs) =

    operandBlock o = Low.Block [] (Sized (Right o))

    -- Assumes that struct is kept on stack. Returns pointer to member.
    indexStruct :: Word -> Low.Operand -> Lower (Low.Block Low.Operand)
    indexStruct = undefined
    indexStruct i x =
        let t = Low.TPtr
                (Low.structMembers (getTypeStruct (pointee (typeof x))) !! fromIntegral i)
        in  emit (Low.Expr (Low.EGetMember i x) t)

    deref :: Low.Operand -> Lower (Low.Block Low.Operand)
    deref = undefined
    load :: Low.Operand -> Lower (Low.Block Low.Operand)
    load addr = emit $ Low.Expr (Low.Load addr) (pointee (typeof addr))

    eblocksToOperandsBlock :: [EBlock] -> Lower (Low.Block [Sized Low.Operand])
    eblocksToOperandsBlock bs = do


@@ 266,14 291,17 @@ lower (Program (Topo defs) datas externs) =
        let (stmss, os) = unzip bs'
        pure (Low.Block (concat stmss) os)

    withVars :: [(TypedVar, Low.Operand)] -> Lower a -> Lower a
    withVars = undefined withVar
    withVars :: [(String, Low.Operand)] -> Lower a -> Lower a
    withVars vs ma = foldl (flip (uncurry withVar)) ma vs

    withVar :: TypedVar -> Low.Operand -> Lower a -> Lower a
    withVar = undefined
    withVar :: String -> Low.Operand -> Lower a -> Lower a
    withVar lhs rhs = locally localEnv (Map.insert lhs rhs)

    newLName :: String -> Lower Low.LocalId
    newLName = undefined
    newLName x = do
        localId <- Vec.length <$> use localNames
        modifying localNames (`Vec.snoc` x)
        pure (fromIntegral localId)

    lowerGVarDecl :: (TypedVar, (Inst, Expr)) -> Low.GlobDef
    lowerGVarDecl = undefined


@@ 419,6 447,16 @@ lower (Program (Topo defs) datas externs) =
            | w <= 64 -> Sized Low.TI64
            | otherwise -> ice "Lower.lowerType: integral type larger than 64-bit"

    pointee = \case
        Low.TPtr t -> t
        _ -> ice "Low.pointee of non pointer type"

    getTypeStruct = \case
        Low.TConst i -> case tenv Vec.! fromIntegral i of
            (_, Low.DStruct struct) -> struct
            _ -> ice "Low.getTypeStruct: TypeDef in tenv is not DStruct"
        _ -> ice "Low.getTypeStruct: type is not a TConst"

    -- NOTE: This post is helpful:
    --       https://stackoverflow.com/questions/42411819/c-on-x86-64-when-are-structs-classes-passed-and-returned-in-registers
    --       Also, official docs:

M stack.yaml => stack.yaml +2 -1
@@ 1,7 1,7 @@
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies.
resolver: lts-18.17
resolver: lts-18.28

# User packages to be built.
packages:


@@ 10,6 10,7 @@ packages:
# Dependency packages to be pulled from upstream that are not in the resolver
extra-deps:
- llvm-hs-pretty-0.9.0.0@sha256:b7a5de5f3dd97893d19d2b47af1e4dd8d075a5cf57062180a912d1f3ef1def60,1671
- llvm-hs-9.0.1@sha256:ee6ec2eb8cba4daf2a43586388a87dbfd6a2ec6d81d1f9965896ac187acad286,8700

# Override default flag values for local packages and extra-deps
# flags: {}

M stack.yaml.lock => stack.yaml.lock +11 -4
@@ 11,9 11,16 @@ packages:
      sha256: 8cf6d628bb4f962575ad0993bb1010e9989cea00b325b8a45ac35ac201061386
  original:
    hackage: llvm-hs-pretty-0.9.0.0@sha256:b7a5de5f3dd97893d19d2b47af1e4dd8d075a5cf57062180a912d1f3ef1def60,1671
- completed:
    hackage: llvm-hs-9.0.1@sha256:ee6ec2eb8cba4daf2a43586388a87dbfd6a2ec6d81d1f9965896ac187acad286,8700
    pantry-tree:
      size: 13599
      sha256: 537616dec1351bd9f7905182f82f132359cf3058ebbb059c03b4edcef04b2689
  original:
    hackage: llvm-hs-9.0.1@sha256:ee6ec2eb8cba4daf2a43586388a87dbfd6a2ec6d81d1f9965896ac187acad286,8700
snapshots:
- completed:
    size: 586292
    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/17.yaml
    sha256: e66e70a7f998036025e8f40abc89b8eeb79c88f57727020cba1b54f375aa7ca0
  original: lts-18.17
    size: 590100
    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
  original: lts-18.28

M test/LowPgms.hs => test/LowPgms.hs +35 -22
@@ 22,7 22,7 @@ printPgm = Program [empty_carth_init, carth_main]
        mainIx
        []
        RetVoid
        (Block [Do (Call printIntOperand [OConst (CInt (I64 1337))])] TRetVoid)
        (Block [VoidCall printIntOperand [OConst (CInt (I64 1337))]] TRetVoid)
        []
        (Vec.fromList [])



@@ 39,8 39,8 @@ factPgm = Program [empty_carth_init, carth_main, factDef]
        []
        RetVoid
        (Block
            [ Let result (Call fact [OConst (CInt (I64 5))])
            , Do (Call printIntOperand [OLocal result])
            [ Let result (Expr (Call fact [OConst (CInt (I64 5))]) TI64)
            , VoidCall printIntOperand [OLocal result]
            ]
            TRetVoid
        )


@@ 57,10 57,20 @@ factPgm = Program [empty_carth_init, carth_main, factDef]
                    (Local 1 TI64)
                    [(CInt (I64 0), Block [] (TRetVal (OConst (CInt (I64 1)))))]
                    (Block
                        [ Let (Local 2 TI64)
                              (Sub (OLocal (Local 1 TI64)) (OConst (CInt (I64 1))))
                        , Let (Local 3 TI64) (Call fact [OLocal (Local 2 TI64)])
                        , Let result (Mul (OLocal (Local 1 TI64)) (OLocal (Local 3 TI64)))
                        [ Let
                            (Local 2 TI64)
                            (Expr
                                (Sub (OLocal (Local 1 TI64)) (OConst (CInt (I64 1))))
                                TI64
                            )
                        , Let (Local 3 TI64)
                              (Expr (Call fact [OLocal (Local 2 TI64)]) TI64)
                        , Let
                            result
                            (Expr
                                (Mul (OLocal (Local 1 TI64)) (OLocal (Local 3 TI64)))
                                TI64
                            )
                        ]
                        (TRetVal (OLocal result))
                    )


@@ 84,21 94,24 @@ factLoopPgm = Program [empty_carth_init, carth_main]
        []
        RetVoid
        (Block
            [ Let result $ Loop [(n, ci64 5), (prod, ci64 1)] TI64 $ Block
                []
                (LBranch
                    (Switch
                        n
                        [(CInt (I64 0), Block [] (Break (OLocal prod)))]
                        (Block
                            [ Let prod' (Mul (OLocal n) (OLocal prod))
                            , Let n' (Sub (OLocal n) (ci64 1))
                            ]
                            (Continue [OLocal n', OLocal prod'])
                        )
                    )
                )
            , Do (Call printIntOperand [OLocal result])
            [ Let result
            $ flip Expr TI64
            $ Loop [(n, ci64 5), (prod, ci64 1)] TI64
            $ Block
                  []
                  (LBranch
                      (Switch
                          n
                          [(CInt (I64 0), Block [] (Break (OLocal prod)))]
                          (Block
                              [ Let prod' (Expr (Mul (OLocal n) (OLocal prod)) TI64)
                              , Let n' (Expr (Sub (OLocal n) (ci64 1)) TI64)
                              ]
                              (Continue [OLocal n', OLocal prod'])
                          )
                      )
                  )
            , VoidCall printIntOperand [OLocal result]
            ]
            TRetVoid
        )