{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -- | Expression for 'Bool'. module Language.Symantic.Expr.Bool where import Prelude hiding ((&&), not, (||)) import Language.Symantic.Type import Language.Symantic.Expr.Common import Language.Symantic.Repr.Dup import Language.Symantic.Trans.Common -- * Class 'Sym_Bool' -- | Symantic. class Sym_Bool repr where bool :: Bool -> repr Bool not :: repr Bool -> repr Bool (&&) :: repr Bool -> repr Bool -> repr Bool (||) :: repr Bool -> repr Bool -> repr Bool xor :: repr Bool -> repr Bool -> repr Bool xor x y = (x || y) && not (x && y) default bool :: Trans t repr => Bool -> t repr Bool default not :: Trans t repr => t repr Bool -> t repr Bool default (&&) :: Trans t repr => t repr Bool -> t repr Bool -> t repr Bool default (||) :: Trans t repr => t repr Bool -> t repr Bool -> t repr Bool bool = trans_lift . bool not = trans_map1 not (&&) = trans_map2 (&&) (||) = trans_map2 (||) infixr 2 || infixr 2 `xor` infixr 3 && instance -- Sym_Bool Dup ( Sym_Bool r1 , Sym_Bool r2 ) => Sym_Bool (Dup r1 r2) where bool x = bool x `Dup` bool x not (x1 `Dup` x2) = not x1 `Dup` not x2 (&&) (x1 `Dup` x2) (y1 `Dup` y2) = (&&) x1 y1 `Dup` (&&) x2 y2 (||) (x1 `Dup` x2) (y1 `Dup` y2) = (||) x1 y1 `Dup` (||) x2 y2 xor (x1 `Dup` x2) (y1 `Dup` y2) = xor x1 y1 `Dup` xor x2 y2 -- * Type 'Expr_Bool' -- | Expression. data Expr_Bool (root:: *) type instance Root_of_Expr (Expr_Bool root) = root type instance Type_of_Expr (Expr_Bool root) = Type_Bool type instance Sym_of_Expr (Expr_Bool root) repr = Sym_Bool repr type instance Error_of_Expr ast (Expr_Bool root) = No_Error_Expr