llvm-dsl-0.2: src/LLVM/DSL/Expression/Maybe.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module LLVM.DSL.Expression.Maybe (
   T(Cons),
   select,
   ) where

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Nice.Value as NiceValue
import qualified LLVM.Extra.Maybe as Maybe

import qualified LLVM.Core as LLVM

import qualified Control.Monad.HT as Monad


data T a = Cons (Exp Bool) a


{- |
counterpart to 'Data.Maybe.fromMaybe' with swapped arguments
-}
select :: (NiceValue.Select a) => T (Exp a) -> Exp a -> Exp a
select (Cons b a) d = Expr.select b a d


instance (Expr.Aggregate exp nv) => Expr.Aggregate (T exp) (Maybe.T nv) where
   type NiceValuesOf (T exp) = Maybe.T (Expr.NiceValuesOf exp)
   type ExpressionsOf (Maybe.T nv) = T (Expr.ExpressionsOf nv)
   bundle (Cons b a) =
      Monad.lift2 Maybe.Cons (fmap unbool $ Expr.bundle b) (Expr.bundle a)
   dissect (Maybe.Cons b a) =
      Cons (Expr.dissect (NiceValue.Cons b)) (Expr.dissect a)

unbool :: NiceValue.T Bool -> LLVM.Value Bool
unbool (NiceValue.Cons b) = b