module Ivory.Language.IBool where
import Ivory.Language.Monad
import Ivory.Language.Proxy
import Ivory.Language.Sint
import Ivory.Language.Type
import Ivory.Language.Uint
import qualified Ivory.Language.Syntax as AST
newtype IBool = IBool { getIBool :: AST.Expr }
instance IvoryType IBool where
ivoryType _ = AST.TyBool
instance IvoryVar IBool where
wrapVar = wrapVarExpr
unwrapExpr = getIBool
instance IvoryExpr IBool where
wrapExpr = IBool
ifte_ :: IBool -> Ivory eff a -> Ivory eff b -> Ivory eff ()
ifte_ cmp t f = do
(_,tb) <- collect t
(_,fb) <- collect f
emit (AST.IfTE (unwrapExpr cmp) (blockStmts tb) (blockStmts fb))
(?) :: IvoryExpr a => IBool -> (a,a) -> a
cond ? (t,f) = wrapExpr
$ AST.ExpOp AST.ExpCond [unwrapExpr cond,unwrapExpr t,unwrapExpr f]
true :: IBool
true = wrapExpr (AST.ExpLit (AST.LitBool True))
false :: IBool
false = wrapExpr (AST.ExpLit (AST.LitBool False))
boolOp :: forall a. IvoryVar a => (AST.Type -> AST.ExpOp) -> a -> a -> IBool
boolOp op a b = wrapExpr (AST.ExpOp (op ty) [unwrapExpr a,unwrapExpr b])
where
ty = ivoryType (Proxy :: Proxy a)
class IvoryExpr a => IvoryEq a where
(==?) :: a -> a -> IBool
(==?) = boolOp AST.ExpEq
infix 4 ==?
(/=?) :: a -> a -> IBool
(/=?) = boolOp AST.ExpNeq
infix 4 /=?
class IvoryEq a => IvoryOrd a where
(>?) :: a -> a -> IBool
(>?) = boolOp (AST.ExpGt False)
infix 4 >?
(>=?) :: a -> a -> IBool
(>=?) = boolOp (AST.ExpGt True)
infix 4 >=?
(<?) :: a -> a -> IBool
(<?) = boolOp (AST.ExpLt False)
infix 4 <?
(<=?) :: a -> a -> IBool
(<=?) = boolOp (AST.ExpLt True)
infix 4 <=?
instance IvoryEq IBool
instance IvoryOrd IBool
instance IvoryEq Uint8
instance IvoryOrd Uint8
instance IvoryEq Uint16
instance IvoryOrd Uint16
instance IvoryEq Uint32
instance IvoryOrd Uint32
instance IvoryEq Uint64
instance IvoryOrd Uint64
instance IvoryEq Sint8
instance IvoryOrd Sint8
instance IvoryEq Sint16
instance IvoryOrd Sint16
instance IvoryEq Sint32
instance IvoryOrd Sint32
instance IvoryEq Sint64
instance IvoryOrd Sint64
iNot :: IBool -> IBool
iNot a = wrapExpr (AST.ExpOp AST.ExpNot [unwrapExpr a])
(.&&) :: IBool -> IBool -> IBool
l .&& r = wrapExpr (AST.ExpOp AST.ExpAnd [unwrapExpr l,unwrapExpr r])
infixr 3 .&&
(.||) :: IBool -> IBool -> IBool
l .|| r = wrapExpr (AST.ExpOp AST.ExpOr [unwrapExpr l,unwrapExpr r])
infixr 2 .||