]> Git — Sourcephile - haskell/symantic.git/blob - Language/LOL/Symantic/Trans/Bool/Const.hs
init
[haskell/symantic.git] / Language / LOL / Symantic / Trans / Bool / Const.hs
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4
5 -- | Transformer propagating boolean constants.
6 module Language.LOL.Symantic.Trans.Bool.Const where
7
8 import qualified Data.Bool as Bool
9 import Prelude hiding (and, not, or)
10
11 import Language.LOL.Symantic.Trans.Common
12 import Language.LOL.Symantic.Expr.Bool
13
14 -- * Type 'Trans_Bool_Const'
15
16 -- | Annotation.
17 data Trans_Bool_Const repr h where
18 Trans_Bool_Const_Unk :: repr h -> Trans_Bool_Const repr h
19 Trans_Bool_Const_Lit :: Bool -> Trans_Bool_Const repr Bool
20
21 instance
22 Sym_Bool repr =>
23 Trans Trans_Bool_Const repr where
24 trans_lift = Trans_Bool_Const_Unk
25 trans_apply (Trans_Bool_Const_Unk x) = x
26 trans_apply (Trans_Bool_Const_Lit x) = bool x
27
28 instance
29 Sym_Bool repr =>
30 Sym_Bool (Trans_Bool_Const repr) where
31 bool = Trans_Bool_Const_Lit
32
33 not (Trans_Bool_Const_Unk e) = Trans_Bool_Const_Unk $ not e
34 not (Trans_Bool_Const_Lit x) = Trans_Bool_Const_Lit $ Bool.not x
35
36 and (Trans_Bool_Const_Lit True) y = y
37 and (Trans_Bool_Const_Lit False) _y = Trans_Bool_Const_Lit False
38 and x (Trans_Bool_Const_Lit True) = x
39 and _x (Trans_Bool_Const_Lit False) = Trans_Bool_Const_Lit False
40 and (Trans_Bool_Const_Unk x)
41 (Trans_Bool_Const_Unk y)
42 = Trans_Bool_Const_Unk $ and x y
43
44 or (Trans_Bool_Const_Lit False) y = y
45 or (Trans_Bool_Const_Lit True) _y = Trans_Bool_Const_Lit True
46 or x (Trans_Bool_Const_Lit False) = x
47 or _x (Trans_Bool_Const_Lit True) = Trans_Bool_Const_Lit True
48 or (Trans_Bool_Const_Unk x)
49 (Trans_Bool_Const_Unk y)
50 = Trans_Bool_Const_Unk $ or x y
51
52 -- | Transformer.
53 trans_bool_const
54 :: Sym_Bool repr
55 => (Trans_Bool_Const repr) h -> repr h
56 trans_bool_const = trans_apply