{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Hcompta.Trans.Bool.Const where

import Data.Bool
import Data.Function (($))
import Data.Text.Buildable (Buildable(..))
import Text.Show (Show)

import Hcompta.Expr.Trans
import Hcompta.Expr.Lit
import Hcompta.Expr.Bool

-- * Type 'Trans_Bool_Const'

-- * Annotation to propagate constants.
data Trans_Bool_Const repr h
 =   Trans_Bool_Const_Unk (repr h)
 |   (Buildable h, Show h)
  => Trans_Bool_Const_Lit h

instance Expr_Lit repr => Trans Trans_Bool_Const repr where
	trans_lift = Trans_Bool_Const_Unk
	trans_apply (Trans_Bool_Const_Unk x) = x
	trans_apply (Trans_Bool_Const_Lit x) = lit x

trans_bool_const
 :: (Expr_Bool repr, Expr_Lit repr)
 => Trans_Bool_Const repr h
 ->                  repr h
trans_bool_const = trans_apply

instance Expr_Lit repr => Expr_Lit (Trans_Bool_Const repr) where
	lit = Trans_Bool_Const_Lit
instance Expr_Bool repr => Expr_Bool (Trans_Bool_Const repr) where
	and (Trans_Bool_Const_Lit True) y   = y
	and (Trans_Bool_Const_Lit False) _y = Trans_Bool_Const_Lit False
	and x (Trans_Bool_Const_Lit True)   = x
	and _x (Trans_Bool_Const_Lit False) = Trans_Bool_Const_Lit False
	and (Trans_Bool_Const_Unk x)
	    (Trans_Bool_Const_Unk y)
	 =   Trans_Bool_Const_Unk $ and x y
	
	or (Trans_Bool_Const_Lit False) y = y
	or (Trans_Bool_Const_Lit True) _y = Trans_Bool_Const_Lit True
	or x (Trans_Bool_Const_Lit False) = x
	or _x (Trans_Bool_Const_Lit True) = Trans_Bool_Const_Lit True
	or (Trans_Bool_Const_Unk x)
	   (Trans_Bool_Const_Unk y)
	 =  Trans_Bool_Const_Unk $ or x y
	
	neg (Trans_Bool_Const_Unk e) = Trans_Bool_Const_Unk $ neg e
	neg (Trans_Bool_Const_Lit x) = Trans_Bool_Const_Lit $ not x