~jojo/Carth

efc2a0df5505f0f51f6071d02cb72fb8b5293c8b — JoJo a month ago bff74e2
lower: fix the rest of the stuff commented out in 8a0330. We back!
2 files changed, 254 insertions(+), 259 deletions(-)

M src/Back/Low.hs
M src/Back/Lower.hs
M src/Back/Low.hs => src/Back/Low.hs +4 -1
@@ 68,7 68,7 @@ data Branch term

data Statement'
    = Let Local Expr
    | Store Operand Operand
    | Store Operand Operand -- value -> destination
    | VoidCall Operand [Operand]
    -- | Do Expr
    | SLoop (Loop ())


@@ 242,3 242,6 @@ instance (TypeOf a, TypeOf b) => TypeOf (Either a b) where

instance Semigroup a => Semigroup (Block a) where
    (<>) (Block stms1 a) (Block stms2 b) = Block (stms1 ++ stms2) (a <> b)

instance Monoid a => Monoid (Block a) where
    mempty = Block [] mempty

M src/Back/Lower.hs => src/Back/Lower.hs +250 -258
@@ 1,4 1,4 @@
{-# LANGUAGE TemplateHaskell, DataKinds #-}
{-# LANGUAGE TemplateHaskell, DataKinds, InstanceSigs, ScopedTypeVariables #-}

module Back.Lower (lower) where



@@ 23,14 23,32 @@ import Lens.Micro.Platform (makeLenses, modifying, use, assign, view)
import Back.Low (typeof)
import qualified Back.Low as Low
import Front.Monomorphic
    ( TPrim(TF64, TNat, TNatSize, TInt, TIntSize, TF32),
      TConst,
      Expr(Fun, Lit, Var, App, Match, Sizeof),
      Fun,
      Inst,
      TypedVar(..),
      Type(..),
      Def(RecDefs, VarDef),
      Program(..),
      Const(..),
      DecisionTree(..),
      Access,
      Access'(ADeref, TopSel, As, Sel) )
import Misc ( ice, nyi, partitionWith, TopologicalOrder(Topo), locally, unsnoc )
import Sizeof

data Sized x = ZeroSized | Sized x

-- mapSized :: (a -> b) -> Sized a -> Sized b
-- mapSized f (Sized a) = Sized (f a)
-- mapSized _ ZeroSized = ZeroSized
mapSized :: (a -> b) -> Sized a -> Sized b
mapSized f (Sized a) = Sized (f a)
mapSized _ ZeroSized = ZeroSized

mapSizedM :: Monad m => (a -> m b) -> Sized a -> m (Sized b)
mapSizedM f = \case
    Sized a -> fmap Sized (f a)
    ZeroSized -> pure ZeroSized

data St = St
    { _strLits :: Map String Low.GlobalId


@@ 67,18 85,41 @@ type Lower = WriterT Out (StateT St (Reader Env))

class Destination d where
    type DestTerm d
    toDest :: d -> Sized Low.Expr -> Lower (Low.Block (DestTerm d))

newtype There = There Low.Operand
instance Destination There where
    type DestTerm There = ()

    toDest (There a) = \case
        ZeroSized -> ice "Lower.toDest: ZeroSized to There"
        Sized e -> do
            x <- newLName "tmp"
            let x' = Low.Local x (typeof e)
            let x'' = Low.OLocal x'
            pure $ Low.Block [Low.BLeaf (Low.Let x' e), Low.BLeaf (Low.Store x'' a)] ()

data Here = Here
instance Destination Here where
    type DestTerm Here = Low.Expr

newtype Address = Address Low.Operand
instance Destination Address where
    type DestTerm Address = ()
    toDest Here = \case
        ZeroSized -> ice "Lower.toDest: ZeroSized to Here"
        Sized e -> pure $ Low.Block [] e

data Register = Register
instance Destination Register where
    type DestTerm Register = Low.Expr
data HereSized = HereSized
instance Destination HereSized where
    type DestTerm HereSized = Sized Low.Expr

data VoidDest = VoidDest
instance Destination VoidDest where
    type DestTerm VoidDest = ()
    toDest HereSized = pure . Low.Block []

data Nowhere = Nowhere
instance Destination Nowhere where
    type DestTerm Nowhere = ()

    toDest Nowhere = \case
        ZeroSized -> pure $ Low.Block [] ()
        Sized _ -> ice "Lower.toDest: Sized to Nowhere"

lower :: Program -> Low.Program
lower (Program (Topo defs) datas externs) =


@@ 143,7 184,7 @@ lower (Program (Topo defs) datas externs) =
            let outerParams = zipWith Low.Local outerParamIds paramTs
            withVars binds $ case rt' of
                ZeroSized -> do
                    body' <- lowerExpr VoidDest body
                    body' <- lowerExpr Nowhere body
                    if isTailRec_RetVoid self body'
                        then fmap
                            (Nothing, outerParamIds, )


@@ 158,7 199,7 @@ lower (Program (Topo defs) datas externs) =
                        outParamId <- newLName "sret"
                        let outParamOp = Low.OLocal $ Low.Local outParamId (Low.TPtr t)
                        let outParam = Just $ Low.ByRef outParamId t
                        body' <- lowerExpr (Address outParamOp) body
                        body' <- lowerExpr (There outParamOp) body
                        if isTailRec_RetVoid self body'
                            then fmap
                                (outParam, outerParamIds, )


@@ 169,7 210,7 @@ lower (Program (Topo defs) datas externs) =
                                , mapTerm (\() -> Low.BLeaf Low.TRetVoid) body'
                                )
                    else do
                        body' <- lowerExpr Register body
                        body' <- lowerExpr Here body
                        if isTailRec_RetVal self body'
                            then fmap
                                (Nothing, outerParamIds, )


@@ 187,7 228,7 @@ lower (Program (Topo defs) datas externs) =
            $ Low.ByVal capturesName Low.VoidPtr
            : zipWith sizedToParam outerParamIds directParamTs
            )
            (undefined rt')
            (toRet rt')
            body''
            allocs
            localNames


@@ 253,20 294,6 @@ lower (Program (Topo defs) datas externs) =
        let name = names Vec.! fromIntegral x
        newLName name

-- I'm thinking about out parameters, tail calls, and branches. There's stuff to consider.
-- Work outwards in, and make sure that we handle tail calls and stuff correctly from the beginning.
-- I don't want to have to realize that the track we decide to start on, actually won't work.

-- Re: branches, consider LLVM. Nested branches can converge with a phi node, we want to use
-- this pattern, for the sake of efficiency. However, if the type is big and should be passed
-- via the stack, we instead want to assign to a common alloc in each leaf of the branches.

-- I'm thinking we can use the PassVia class to be able to write a single generic function
-- for lowering expression branches, that can support both of these cases.

-- In the stack case, maybe the returned value should be a function that accepts the name
-- of the alloc to assign to, and returns a block of unit afterwards.

    popLocalNames :: Lower Low.VarNames
    popLocalNames = do
        xs <- use localNames


@@ 276,233 303,186 @@ lower (Program (Topo defs) datas externs) =
    popAllocs :: Lower Low.Allocs
    popAllocs = undefined

    lowerExpr
        :: {- Destination d => -}
           d -> Expr -> Lower (Low.Block (DestTerm d))
    lowerExpr _dest = undefined

    -- It would be nice if we could keep lowerExpr fairly non-generic, and just have the
    -- returend value be of such a type that we can do all the stuff like converting tail
    -- calls to loop, and pass along output-parameter to function call in tail position,
    -- etc. My intuition is that it might be possibly, if we have lowerExpr return a
    -- (Block (Sized Expr)) and just analyze that properly.
    --
    -- Look at returned Expr branches to see if there's any call to self in tail
    -- position. Then we know there's tail recursion. Easy! We then need to wrap the thing
    -- in a loop. I'm thinking we could do this fairly easily, the only real issue is that
    -- the generated block refers to the function parameters, but in the wrapping we want
    -- to add some intermediary allocs that can be modified for each iteration. I'm
    -- thinking we can just create an alloc for each parameter, and add a load to register
    -- for each. Then we swap the LocalId:s of the outer parameters and the newly
    -- generated registers, and the generated block should work without internal
    -- modifications.
    --
    -- Regarding out parameters, I'm actually thinking that doing it afterwards would just
    -- get messy. Probably better to just call lowerExpr with some kind of `data TailPos =
    -- NoTail | Tail (Maybe OutParam)` or something, and generate it correctly from the
    -- beginning. Shouldn't be too bad, and it might come in handy at some point.

    -- lowerBody body = lowerExpr body >>= bindBlock
    --     (\case
    --         ZeroSized -> pure $ Low.Block [] Low.TRetVoid
    --         Sized e -> pure $ exprToTerm e
    --     )

    -- exprToTerm :: Low.Expr -> Low.Block Low.Terminator
    -- exprToTerm = undefined

    -- lowerExpr :: Expr -> Lower (Low.Block (Sized Low.Expr))
    -- lowerExpr = undefined
    -- lowerExpr = \case
    --     Lit c -> Low.Block [] . Sized <$> lowerConst c
    --     Var (TypedVar x _) -> Low.Block [] <$> lookupVar x
    --     -- TODO: Optimize tail calls
    --     App f as -> do
    --         Low.Block stms1 closure <- mapBlock unSized <$> lowerExpr f
    --         Low.Block stms2 as' <-
    --             mapBlock (mapMaybe sizedMaybe) . catBlocks <$> mapM lowerExpr as
    --         Low.Block stms3 captures <- bindBlock load =<< indexStruct 0 closure
    --         Low.Block stms4 f' <- bindBlock load =<< indexStruct 1 closure
    --         -- case returnee (typeof f') of
    --         --     Low.RetVal t -> _
    --         --     Low.RetVoid -> _
    --         --     Low.OutParam t -> _
    --         pure $ Low.Block (stms1 ++ stms2 ++ stms3 ++ stms4)
    --                          (Low.Call f' (captures : as'))
    lowerExpr :: Destination d => d -> Expr -> Lower (Low.Block (DestTerm d))
    lowerExpr dest = \case
        Lit c -> toDest dest . Sized . operandToExpr =<< lowerConst c
        Var (TypedVar x _) -> toDest dest . mapSized operandToExpr =<< lookupVar x
        App f as -> do
            Low.Block stms1 closure <- bindBlockM emit =<< lowerExpr Here f
            Low.Block stms2 as' <-
                bindBlockM (fmap catBlocks . mapM emit)
                . mconcat
                . map (mapTerm (sized (: []) []))
                =<< mapM (lowerExpr HereSized) as
            Low.Block stms3 captures <- bindBlockM load =<< indexStruct 0 closure
            Low.Block stms4 f' <- bindBlockM load =<< indexStruct 1 closure
            fmap (thenBlock (Low.Block (stms1 ++ stms2 ++ stms3 ++ stms4) ()))
                . toDest dest
                . mapSized (Low.Expr (Low.BLeaf (Low.Call f' (captures : as'))))
                $ returneeType (typeof f')
    --     -- If Expr Expr Expr
    --     -- Fun Fun
    --     -- Let Def Expr
    --     Match es dt -> lowerMatch es dt
        Match es dt -> lowerMatch dest es dt
    --     -- Ction Ction
    --     Sizeof t ->
    --         pure (Low.Block [] (mapSized (Right . litI64 . sizeof) (lowerType t)))
        Sizeof t -> toDest dest . Sized $ operandToExpr
            (sized (litI64 . sizeof) (litI64 0) (lowerType t))
    --     -- Absurd Type
    --     _ -> undefined

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

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

    -- lowerConst :: Const -> Lower Low.Operand
    -- lowerConst = \case
    --     Int n -> pure (Low.OConst (Low.CInt (Low.I64 n)))
    --     F64 x -> pure (Low.OConst (Low.F64 x))
    --     Str s -> internStr s <&> \s' -> Low.OGlobal s'

    -- internStr :: String -> Lower Low.Global
    -- internStr s = use strLits >>= \m ->
    --     fmap (flip Low.Global tStr) $ case Map.lookup s m of
    --         Just n -> pure n
    --         Nothing ->
    --             let n = fromIntegral (Map.size m)
    --             in  modifying strLits (Map.insert s n) $> n

    -- tStr = Low.TConst (tids Map.! ("Str", []))

    -- lowerMatch :: [Expr] -> DecisionTree -> Lower EBlock
    -- lowerMatch ms dt = do
    --     Low.Block msStms ms' <- undefined --eblocksToOperandsBlock =<< mapM lowerExpr ms
    --     Low.Block dtStms result <- lowerDecisionTree (topSelections ms') dt
    --     pure (Low.Block (msStms ++ dtStms) result)
    --   where
    --     topSelections :: [Sized Low.Operand] -> Map Low.Access Low.Operand
    --     topSelections xs = Map.fromList . catMaybes $ zipWith
    --         (\i x -> (TopSel i, ) <$> sizedMaybe x)
    --         [0 ..]
    --         xs

    --     lowerDecisionTree :: Map Low.Access Low.Operand -> DecisionTree -> Lower EBlock
    --     lowerDecisionTree selections = \case
    --         DLeaf (bs, e) -> do
    --             let bs' =
    --                     mapMaybe (\(x, a) -> fmap (x, ) (sizedMaybe (lowerAccess a))) bs
    --             vars <- selectVarBindings selections bs'
    --             bindrBlock vars $ \vars' -> withVars vars' (lowerExpr e)
    --         DSwitch _span _selector _cs _def -> undefined
    --         DSwitchStr _selector _cs _def -> undefined

    --     select
    --         :: Low.Access
    --         -> Map Low.Access Low.Operand
    --         -> Lower (Low.Block Low.Operand, Map Low.Access Low.Operand)
    --     select selector selections = case Map.lookup selector selections of
    --         Just a -> pure (Low.Block [] a, selections)
    --         Nothing -> do
    --             (ba, selections') <- case selector of
    --                 TopSel _ -> ice "select: TopSel not in selections"
    --                 As x span' i _ts -> do
    --                     (ba', s') <- select x selections
    --                     ba'' <- bindrBlock ba'
    --                         $ \a' -> asVariant a' span' (fromIntegral i)
    --                     pure (ba'', s')
    --                 Sel i _span x -> do
    --                     (a', s') <- select x selections
    --                     a'' <- bindrBlock a' $ indexStruct (fromIntegral i)
    --                     pure (a'', s')
    --                 ADeref x -> do
    --                     (a', s') <- select x selections
    --                     a'' <- bindrBlock 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 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
    --             bindrBlock union $ \union' ->
    --                 emit $ Low.Expr (Low.EAsVariant union' variantIx) tvariant

    --     -- typeOfDataVariant 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 -> Low.TConst (tid + 2 + variantIx)
    --     --     _ ->

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

    -- lowerAccess :: Access -> Sized Low.Access
    -- lowerAccess = \case
    --     TopSel i -> Sized $ TopSel i
    --     As a span vi vts ->
    --         mapSized (\a' -> As a' span vi (lowerSizedTypes vts)) (lowerAccess a)
    --     Sel i span a -> mapSized (Sel i span) (lowerAccess a)
    --     ADeref a -> mapSized ADeref (lowerAccess a)
    operandToExpr x = Low.Expr (Low.BLeaf (Low.EOperand x)) (typeof x)

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

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

    lowerConst :: Const -> Lower Low.Operand
    lowerConst = \case
        Int n -> pure (Low.OConst (Low.CInt (Low.I64 n)))
        F64 x -> pure (Low.OConst (Low.F64 x))
        Str s -> internStr s <&> \s' -> Low.OGlobal s'

    internStr :: String -> Lower Low.Global
    internStr s = use strLits >>= \m ->
        fmap (flip Low.Global tStr) $ case Map.lookup s m of
            Just n -> pure n
            Nothing ->
                let n = fromIntegral (Map.size m)
                in  modifying strLits (Map.insert s n) $> n

    tStr = Low.TConst (tids Map.! ("Str", []))

    lowerMatch
        :: forall d
         . Destination d
        => d
        -> [Expr]
        -> DecisionTree
        -> Lower (Low.Block (DestTerm d))
    lowerMatch dest matchees decisionTree = do
        Low.Block stms1 ms <- catBlocks <$> mapM lowerMatchee matchees
        Low.Block stms2 result <- lowerDecisionTree (topSelections ms) decisionTree
        pure (Low.Block (stms1 ++ stms2) result)
      where
        lowerMatchee m = lowerExpr HereSized m >>= bindBlockM
            (\case
                ZeroSized -> pure $ Low.Block [] ZeroSized
                Sized e -> mapTerm Sized <$> emit e
            )

    mapTerm f b = b { Low.blockTerm = f (Low.blockTerm b) }
        topSelections :: [Sized Low.Operand] -> Map Low.Access Low.Operand
        topSelections xs = Map.fromList . catMaybes $ zipWith
            (\i x -> (TopSel i, ) <$> sizedMaybe x)
            [0 ..]
            xs

        lowerDecisionTree
            :: Map Low.Access Low.Operand
            -> DecisionTree
            -> Lower (Low.Block (DestTerm d))
        lowerDecisionTree selections = \case
            DLeaf (bs, e) -> do
                let bs' =
                        mapMaybe (\(x, a) -> fmap (x, ) (sizedMaybe (lowerAccess a))) bs
                vars <- selectVarBindings selections bs'
                vars `bindrBlockM` \vars' -> withVars vars' (lowerExpr dest e)
            DSwitch _span _selector _cs _def -> undefined
            DSwitchStr _selector _cs _def -> undefined

        select
            :: Low.Access
            -> Map Low.Access Low.Operand
            -> Lower (Low.Block Low.Operand, Map Low.Access Low.Operand)
        select selector selections = case Map.lookup selector selections of
            Just a -> pure (Low.Block [] a, selections)
            Nothing -> do
                (ba, selections') <- case selector of
                    TopSel _ -> ice "select: TopSel not in selections"
                    As x span' i _ts -> do
                        (ba', s') <- select x selections
                        ba'' <- bindrBlockM ba'
                            $ \a' -> asVariant a' span' (fromIntegral i)
                        pure (ba'', s')
                    Sel i _span x -> do
                        (a', s') <- select x selections
                        a'' <- bindrBlockM a' $ indexStruct (fromIntegral i)
                        pure (a'', s')
                    ADeref x -> do
                        (a', s') <- select x selections
                        a'' <- bindrBlockM 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 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
                bindrBlockM union $ \union' -> emit
                    $ Low.Expr (Low.BLeaf (Low.EAsVariant union' variantIx)) tvariant

        -- typeOfDataVariant 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 -> Low.TConst (tid + 2 + variantIx)
        --     _ ->

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

    -- bindPartialBlock
    --     :: Low.Block PartialOperand
    --     -> (Low.Operand -> Lower (Low.Block a))
    --     -> Lower (Low.Block a)
    -- bindPartialBlock (Low.Block stms1 e) f = do
    --     Low.Block stms2 operand <- partialToOperand e
    --     Low.Block stms3 a <- f operand
    --     pure $ Low.Block (stms1 ++ stms2 ++ stms3) a
    lowerAccess :: Access -> Sized Low.Access
    lowerAccess = \case
        TopSel i -> Sized $ TopSel i
        As a span vi vts ->
            mapSized (\a' -> As a' span vi (lowerSizedTypes vts)) (lowerAccess a)
        Sel i span a -> mapSized (Sel i span) (lowerAccess a)
        ADeref a -> mapSized ADeref (lowerAccess a)

    mapTerm f b = b { Low.blockTerm = f (Low.blockTerm b) }

    thenBlock :: Low.Block () -> Low.Block a -> Low.Block a
    thenBlock (Low.Block stms1 ()) (Low.Block stms2 a) = Low.Block (stms1 ++ stms2) a

    -- bindBlock :: (a -> Lower (Low.Block b)) -> Low.Block a -> Lower (Low.Block b)
    -- bindBlock f b = bindrBlock b f
    bindBlockM :: Monad m => (a -> m (Low.Block b)) -> Low.Block a -> m (Low.Block b)
    bindBlockM f (Low.Block stms1 a) =
        f a <&> \(Low.Block stms2 b) -> Low.Block (stms1 ++ stms2) b

    -- bindrBlock :: Low.Block a -> (a -> Lower (Low.Block b)) -> Lower (Low.Block b)
    -- bindrBlock (Low.Block stms1 operand) f = do
    --     Low.Block stms2 a <- f operand
    --     pure $ Low.Block (stms1 ++ stms2) a
    bindrBlockM = flip bindBlockM

    -- partialToOperand :: PartialOperand -> Lower (Low.Block Low.Operand)
    -- partialToOperand = either emit (pure . Low.Block [])
    emit :: Low.Expr -> Lower (Low.Block Low.Operand)
    emit e = do
        name <- newLName "tmp"
        let l = Low.Local name (typeof e)
        pure (Low.Block [Low.BLeaf (Low.Let l e)] (Low.OLocal l))

    -- emit :: Low.Expr -> Lower (Low.Block Low.Operand)
    -- emit e = do
    --     name <- newLName "tmp"
    --     let l = Low.Local name (typeof e)
    --     pure (Low.Block [Low.Let l e] (Low.OLocal l))
    -- Assumes that struct is kept on stack. Returns pointer to member.
    indexStruct :: Word -> Low.Operand -> Lower (Low.Block Low.Operand)
    indexStruct i x =
        let t = Low.TPtr
                (Low.structMembers (getTypeStruct (pointee (typeof x))) !! fromIntegral i)
        in  emit (Low.Expr (Low.BLeaf (Low.EGetMember i x)) t)

    -- operandBlock o = Low.Block [] (Sized (Right o))
    load :: Low.Operand -> Lower (Low.Block Low.Operand)
    load addr = emit $ Low.Expr (Low.BLeaf (Low.Load addr)) (pointee (typeof addr))

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

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

    -- catBlocks :: [Low.Block a] -> Low.Block [a]
    -- catBlocks = mconcat . map (mapBlock pure)

    -- eblocksToOperandsBlock :: [EBlock] -> Lower (Low.Block [Sized Low.Operand])
    -- eblocksToOperandsBlock bs = do
    --     bs' <- forM bs $ \(Low.Block stms e) -> case e of
    --         ZeroSized -> pure (stms, ZeroSized)
    --         Sized (Right o) -> pure (stms, Sized o)
    --         Sized (Left e') -> do
    --             name <- newLName "tmp"
    --             let l = Low.Local name (typeof e')
    --             pure (stms ++ [Low.Let l e'], Sized (Low.OLocal l))
    --     let (stmss, os) = unzip bs'
    --     pure (Low.Block (concat stmss) os)
    catBlocks :: [Low.Block a] -> Low.Block [a]
    catBlocks = mconcat . map (mapTerm pure)

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


@@ 510,12 490,6 @@ lower (Program (Topo defs) datas externs) =
    withVar :: String -> Low.Operand -> Lower a -> Lower a
    withVar lhs rhs = locally localEnv (Map.insert lhs rhs)

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

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



@@ 614,11 588,15 @@ lower (Program (Topo defs) datas externs) =
                (name', seen') = uq (Map.findWithDefault 0 name seen)
            in  (set name' d : ds, seen')

    sized f b = \case
        ZeroSized -> b
        Sized a -> f a

    sizedMaybe = \case
        ZeroSized -> Nothing
        Sized t -> Just t

    -- unSized = \case
    -- fromSized = \case
    --     ZeroSized -> ice "Lower.unSized: was ZeroSized"
    --     Sized x -> x



@@ 628,9 606,9 @@ lower (Program (Topo defs) datas externs) =

    sizedToParam name t = if passByRef t then Low.ByRef name t else Low.ByVal name t

    -- toRet = \case
    --     ZeroSized -> Low.RetVoid
    --     Sized t -> if passByRef t then Low.OutParam t else Low.RetVal t
    toRet = \case
        ZeroSized -> Low.RetVoid
        Sized t -> if passByRef t then Low.RetVoid else Low.RetVal t

    lowerSizedTypes :: [Type] -> [Low.Type]
    lowerSizedTypes = mapMaybe (sizedMaybe . lowerType)


@@ 664,15 642,23 @@ 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"
    pointee = \case
        Low.TPtr t -> t
        _ -> ice "Lower.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"
    returnee = \case
        Low.TFun _ ret -> ret
        _ -> ice "Lower.returnee of non function type"

    returneeType = returnee >>> \case
        Low.RetVal t -> Sized t
        Low.RetVoid -> ZeroSized

    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"

    -- TODO: Maybe we could get rid of all ad-hoc logic using this function, by wrapping
    --       the type returned from lowerType in not just a Sized vs. ZeroSized, but also a


@@ 749,3 735,9 @@ lower (Program (Topo defs) datas externs) =
--     DSwitch _ _ cs def -> fvDSwitch (Map.elems cs) def
--     DSwitchStr _ cs def -> fvDSwitch (Map.elems cs) def
--     where fvDSwitch es def = Set.unions $ fvDecisionTree def : map fvDecisionTree es

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