content: {-# LANGUAGE ScopedTypeVariables #-}
  
  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
  
  
  -- Booleans --------------------------------------------------------------------
  
  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 Support ----------------------------------------------------------------
  
  -- | If-then-else.
  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))
  
  -- | Conditional expressions.
  (?) :: IvoryExpr a => IBool -> (a,a) -> a
  cond ? (t,f) = wrapExpr
               $ AST.ExpOp AST.ExpCond [unwrapExpr cond,unwrapExpr t,unwrapExpr f]
  
  
  -- Constants -------------------------------------------------------------------
  
  true :: IBool
  true  = wrapExpr (AST.ExpLit (AST.LitBool True))
  
  false :: IBool
  false  = wrapExpr (AST.ExpLit (AST.LitBool False))
  
  
  -- Comparisons -----------------------------------------------------------------
  
  -- XXX do not export
  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
  
  -- Boolean logic ---------------------------------------------------------------
  
  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 .||
  