Language/Symantic/Expr/Bool.hs

   1 {-# LANGUAGE DefaultSignatures #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE TypeOperators #-}
   6 -- | Expression for 'Bool'.
   7 module Language.Symantic.Expr.Bool where
   8
   9 import Prelude hiding ((&&), not, (||))
  10
  11 import Language.Symantic.Type
  12 import Language.Symantic.Expr.Root
  13 import Language.Symantic.Expr.Error
  14 import Language.Symantic.Expr.From
  15 import Language.Symantic.Trans.Common
  16
  17 -- * Class 'Sym_Bool'
  18 -- | Symantic.
  19 class Sym_Bool repr where
  20         bool ::      Bool -> repr Bool
  21         not  :: repr Bool -> repr Bool
  22         (&&) :: repr Bool -> repr Bool -> repr Bool
  23         (||) :: repr Bool -> repr Bool -> repr Bool
  24         xor  :: repr Bool -> repr Bool -> repr Bool
  25         xor x y = (x || y) && not (x && y)
  26
  27         default bool :: Trans t repr =>        Bool -> t repr Bool
  28         default not  :: Trans t repr => t repr Bool -> t repr Bool
  29         default (&&) :: Trans t repr => t repr Bool -> t repr Bool -> t repr Bool
  30         default (||) :: Trans t repr => t repr Bool -> t repr Bool -> t repr Bool
  31         bool = trans_lift . bool
  32         not  = trans_map1 not
  33         (&&) = trans_map2 (&&)
  34         (||) = trans_map2 (||)
  35 infixr 2 ||
  36 infixr 2 `xor`
  37 infixr 3 &&
  38
  39 -- * Type 'Expr_Bool'
  40 -- | Expression.
  41 data Expr_Bool (root:: *)
  42 type instance Root_of_Expr      (Expr_Bool root)      = root
  43 type instance Type_of_Expr      (Expr_Bool root)      = Type_Bool
  44 type instance Sym_of_Expr       (Expr_Bool root) repr = Sym_Bool repr
  45 type instance Error_of_Expr ast (Expr_Bool root)      = No_Error_Expr