]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Trans/Bool/Const.hs
polish names
[haskell/symantic.git] / Language / Symantic / Trans / Bool / Const.hs
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4
5 -- | Transformer propagating boolean constants.
6 module Language.Symantic.Trans.Bool.Const where
7
8 import qualified Data.Bool as Bool
9 import Prelude hiding ((&&), not, (||))
10
11 import Language.Symantic.Trans.Common
12 import Language.Symantic.Expr.Bool
13
14 -- * Type 'Trans_Bool_Const'
15
16 -- | Annotation.
17 data Trans_Bool_Const repr h where
18 Trans_Bool_Const_Unknown :: repr h -> Trans_Bool_Const repr h
19 Trans_Bool_Const_Known :: 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_Unknown
25 trans_apply (Trans_Bool_Const_Unknown x) = x
26 trans_apply (Trans_Bool_Const_Known x) = bool x
27
28 instance
29 Sym_Bool repr =>
30 Sym_Bool (Trans_Bool_Const repr) where
31 bool = Trans_Bool_Const_Known
32
33 not (Trans_Bool_Const_Unknown e) = Trans_Bool_Const_Unknown $ not e
34 not (Trans_Bool_Const_Known x) = Trans_Bool_Const_Known $ Bool.not x
35
36 (&&) (Trans_Bool_Const_Known True) y = y
37 (&&) (Trans_Bool_Const_Known False) _y = Trans_Bool_Const_Known False
38 (&&) x (Trans_Bool_Const_Known True) = x
39 (&&) _x (Trans_Bool_Const_Known False) = Trans_Bool_Const_Known False
40 (&&) (Trans_Bool_Const_Unknown x)
41 (Trans_Bool_Const_Unknown y)
42 = Trans_Bool_Const_Unknown $ (&&) x y
43
44 (||) (Trans_Bool_Const_Known False) y = y
45 (||) (Trans_Bool_Const_Known True) _y = Trans_Bool_Const_Known True
46 (||) x (Trans_Bool_Const_Known False) = x
47 (||) _x (Trans_Bool_Const_Known True) = Trans_Bool_Const_Known True
48 (||) (Trans_Bool_Const_Unknown x)
49 (Trans_Bool_Const_Unknown y)
50 = Trans_Bool_Const_Unknown $ (||) 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