]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/Trans/Bool/Const.hs
Refactor hcompta-lib.
[comptalang.git] / cli / Hcompta / Trans / Bool / Const.hs
1 {-# LANGUAGE ExistentialQuantification #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# LANGUAGE NoImplicitPrelude #-}
5 {-# OPTIONS_GHC -fno-warn-tabs #-}
6
7 module Hcompta.Trans.Bool.Const where
8
9 import Data.Bool
10 import Data.Function (($))
11 import Data.Text.Buildable (Buildable(..))
12 import Text.Show (Show)
13
14 import Hcompta.Expr.Trans
15 import Hcompta.Expr.Lit
16 import Hcompta.Expr.Bool
17
18 -- * Type 'Trans_Bool_Const'
19
20 -- * Annotation to propagate constants.
21 data Trans_Bool_Const repr h
22 = Trans_Bool_Const_Unk (repr h)
23 | (Buildable h, Show h)
24 => Trans_Bool_Const_Lit h
25
26 instance Expr_Lit repr => Trans Trans_Bool_Const repr where
27 trans_lift = Trans_Bool_Const_Unk
28 trans_apply (Trans_Bool_Const_Unk x) = x
29 trans_apply (Trans_Bool_Const_Lit x) = lit x
30
31 trans_bool_const
32 :: (Expr_Bool repr, Expr_Lit repr)
33 => Trans_Bool_Const repr h
34 -> repr h
35 trans_bool_const = trans_apply
36
37 instance Expr_Lit repr => Expr_Lit (Trans_Bool_Const repr) where
38 lit = Trans_Bool_Const_Lit
39 instance Expr_Bool repr => Expr_Bool (Trans_Bool_Const repr) where
40 and (Trans_Bool_Const_Lit True) y = y
41 and (Trans_Bool_Const_Lit False) _y = Trans_Bool_Const_Lit False
42 and x (Trans_Bool_Const_Lit True) = x
43 and _x (Trans_Bool_Const_Lit False) = Trans_Bool_Const_Lit False
44 and (Trans_Bool_Const_Unk x)
45 (Trans_Bool_Const_Unk y)
46 = Trans_Bool_Const_Unk $ and x y
47
48 or (Trans_Bool_Const_Lit False) y = y
49 or (Trans_Bool_Const_Lit True) _y = Trans_Bool_Const_Lit True
50 or x (Trans_Bool_Const_Lit False) = x
51 or _x (Trans_Bool_Const_Lit True) = Trans_Bool_Const_Lit True
52 or (Trans_Bool_Const_Unk x)
53 (Trans_Bool_Const_Unk y)
54 = Trans_Bool_Const_Unk $ or x y
55
56 neg (Trans_Bool_Const_Unk e) = Trans_Bool_Const_Unk $ neg e
57 neg (Trans_Bool_Const_Lit x) = Trans_Bool_Const_Lit $ not x