msakai / sign / 29

Committed 09 Nov 2024 02:07AM UTC coverage: 89.796% (-5.9%) from 95.652%

Build # 29

Build Type

push

github

Committed by

web-flow

Commit Message

Merge 22a99a0d1 into 447ceb3f3

Run Details

44 of 49 relevant lines covered (89.8%)

0.9 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

89.8

/src/Data/Sign.hs

{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sign
-- Copyright   :  (c) Masahiro Sakai 2013
-- License     :  BSD-style
-- 
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (FlexibleInstances, DeriveDataTypeable, CPP)
--
-- This module provides arithmetic over signs (i.e. {-, 0, +}) and set of signs.
-- 
-- For the purpose of abstract interpretation, it might be convenient to use
-- 'L.Lattice' instance. See also lattices package
-- (<http://hackage.haskell.org/package/lattices>).
-- 
-----------------------------------------------------------------------------
module Data.Sign
  (
  -- * The Sign data type
    Sign (..)
  -- * Operations over signs
  , negate
  , abs
  , mult
  , recip
  , div
  , pow
  , signOf
  , symbol
  -- * Operations over sets of signs
  -- $SET
  ) where

import qualified Prelude as P
import Prelude hiding (negate, abs, recip, div)
#if MIN_VERSION_lattices(1,4,0)
import qualified Data.Universe.Class as U -- from universe-base package
import qualified Data.Universe.Helpers as U -- from universe-base package
#endif
#if !MIN_VERSION_lattices(2,0,0)
import Algebra.Enumerable (Enumerable (..), universeBounded) -- from lattices package
#endif
import qualified Algebra.Lattice as L -- from lattices package
import Control.DeepSeq
import Data.Hashable
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import Data.Data

-- | Signs of real numbers.
data Sign
  = Neg   -- ^ negative
  | Zero  -- ^ zero
  | Pos   -- ^ positive
  deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data)

instance NFData Sign where rnf x = seq x ()

instance Hashable Sign where hashWithSalt = hashUsing fromEnum

#if MIN_VERSION_lattices(1,4,0)

instance U.Universe Sign where
  universe = U.universeDef
  
instance U.Finite Sign
  
#endif

#if !MIN_VERSION_lattices(2,0,0)

instance Enumerable Sign where
  universe = universeBounded

#endif

-- | Unary negation.
negate :: Sign -> Sign
negate Neg  = Pos
negate Zero = Zero
negate Pos  = Neg

-- | Absolute value.
abs :: Sign -> Sign
abs Neg  = Pos
abs Zero = Zero
abs Pos  = Pos

-- | Multiplication.
mult :: Sign -> Sign -> Sign
mult Pos s  = s
mult s Pos  = s
mult Neg s  = negate s
mult s Neg  = negate s
mult _ _    = Zero

-- | Reciprocal fraction.
recip :: Sign -> Sign
recip Pos  = Pos
recip Zero = error "Data.Sign.recip: division by Zero"
recip Neg  = Neg

-- | Fractional division.
div :: Sign -> Sign -> Sign
div s Pos  = s
div _ Zero = error "Data.Sign.div: division by Zero"
div s Neg  = negate s

-- | Exponentiation s^x.
--
-- Note that we define @'pow' 'Zero' 0 = 'Pos'@ assuming @0^0 = 1@.
pow :: Integral x => Sign -> x -> Sign
pow _ 0    = Pos
pow Pos _  = Pos
pow Zero _ = Zero
pow Neg n  = if even n then Pos else Neg

-- | Sign of a number. 
signOf :: Real a => a -> Sign
signOf r =
  case r `compare` 0 of
    LT -> Neg
    EQ -> Zero
    GT -> Pos

-- | Mnemonic symbol of a number.
--
-- This function returns @\"-\"@, @\"0\"@, @\"+\"@ respectively for 'Neg', 'Zero', 'Pos'.
symbol :: Sign -> String
symbol Pos  = "+"
symbol Neg  = "-"
symbol Zero = "0"

-- $SET
-- @'Set' 'Sign'@ is equipped with instances of 'Num' and 'Fractional'.
-- Therefore arithmetic operations can be applied to @'Set' 'Sign'@.
-- 
-- Instances of 'L.Lattice' and 'L.BoundedLattice' are also provided for
-- the purpose of abstract interpretation.

#if !MIN_VERSION_lattices(1,4,0)
    
instance L.MeetSemiLattice (Set Sign) where
  meet = Set.intersection

instance L.Lattice (Set Sign)

instance L.BoundedMeetSemiLattice (Set Sign) where
  top = Set.fromList universe

instance L.BoundedLattice (Set Sign)

#endif

instance Num (Set Sign) where
  ss1 + ss2 = Set.unions [f s1 s2 | s1 <- Set.toList ss1, s2 <- Set.toList ss2]
    where
      f Zero s  = Set.singleton s
      f s Zero  = Set.singleton s
      f Pos Pos = Set.singleton Pos
      f Neg Neg = Set.singleton Neg
      f _ _     = Set.fromList [Neg,Zero,Pos]
  ss1 * ss2   = Set.fromList [mult s1 s2 | s1 <- Set.toList ss1, s2 <- Set.toList ss2]
  negate      = Set.map negate
  abs         = Set.map abs
  signum      = id
  fromInteger = Set.singleton . signOf

instance Fractional (Set Sign) where
  recip        = Set.map recip
  fromRational = Set.singleton . signOf

#if !MIN_VERSION_hashable(1,2,0)
-- Copied from hashable-1.2.0.7:
-- Copyright   :  (c) Milan Straka 2010
--                (c) Johan Tibell 2011
--                (c) Bryan O'Sullivan 2011, 2012

-- | Transform a value into a 'Hashable' value, then hash the
-- transformed value using the given salt.
--
-- This is a useful shorthand in cases where a type can easily be
-- mapped to another type that is already an instance of 'Hashable'.
-- Example:
--
-- > data Foo = Foo | Bar
-- >          deriving (Enum)
-- >
-- > instance Hashable Foo where
-- >     hashWithSalt = hashUsing fromEnum
hashUsing :: (Hashable b) =>
             (a -> b)           -- ^ Transformation function.
          -> Int                -- ^ Salt.
          -> a                  -- ^ Value to transform.
          -> Int
hashUsing f salt x = hashWithSalt salt (f x)
{-# INLINE hashUsing #-}
#endif


1	{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-}
2	-----------------------------------------------------------------------------
3	-- \|
4	-- Module : Data.Sign
5	-- Copyright : (c) Masahiro Sakai 2013
6	-- License : BSD-style
7	--
8	-- Maintainer : masahiro.sakai@gmail.com
9	-- Stability : provisional
10	-- Portability : non-portable (FlexibleInstances, DeriveDataTypeable, CPP)
11	--
12	-- This module provides arithmetic over signs (i.e. {-, 0, +}) and set of signs.
13	--
14	-- For the purpose of abstract interpretation, it might be convenient to use
15	-- 'L.Lattice' instance. See also lattices package
16	-- (<http://hackage.haskell.org/package/lattices>).
17	--
18	-----------------------------------------------------------------------------
19	module Data.Sign
20	(
21	-- * The Sign data type
22	Sign (..)
23	-- * Operations over signs
24	, negate
25	, abs
26	, mult
27	, recip
28	, div
29	, pow
30	, signOf
31	, symbol
32	-- * Operations over sets of signs
33	-- $SET
34	) where
35
36	import qualified Prelude as P
37	import Prelude hiding (negate, abs, recip, div)
38	#if MIN_VERSION_lattices(1,4,0)
39	import qualified Data.Universe.Class as U -- from universe-base package
40	import qualified Data.Universe.Helpers as U -- from universe-base package
41	#endif
42	#if !MIN_VERSION_lattices(2,0,0)
43	import Algebra.Enumerable (Enumerable (..), universeBounded) -- from lattices package
44	#endif
45	import qualified Algebra.Lattice as L -- from lattices package
46	import Control.DeepSeq
47	import Data.Hashable
48	import Data.Set (Set)
49	import qualified Data.Set as Set
50	import Data.Typeable
51	import Data.Data
52
53	-- \| Signs of real numbers.
54	data Sign
55	= Neg -- ^ negative
56	\| Zero -- ^ zero
57	\| Pos -- ^ positive
58	deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data)	×
59
60	instance NFData Sign where rnf x = seq x ()	1✔
61
62	instance Hashable Sign where hashWithSalt = hashUsing fromEnum	×
63
64	#if MIN_VERSION_lattices(1,4,0)
65
66	instance U.Universe Sign where
67	universe = U.universeDef	1✔
68
69	instance U.Finite Sign	×
70
71	#endif
72
73	#if !MIN_VERSION_lattices(2,0,0)
74
75	instance Enumerable Sign where
76	universe = universeBounded
77
78	#endif
79
80	-- \| Unary negation.
81	negate :: Sign -> Sign
82	negate Neg = Pos	1✔
83	negate Zero = Zero	1✔
84	negate Pos = Neg	1✔
85
86	-- \| Absolute value.
87	abs :: Sign -> Sign
88	abs Neg = Pos	1✔
89	abs Zero = Zero	1✔
90	abs Pos = Pos	1✔
91
92	-- \| Multiplication.
93	mult :: Sign -> Sign -> Sign
94	mult Pos s = s	1✔
95	mult s Pos = s	1✔
96	mult Neg s = negate s	1✔
97	mult s Neg = negate s	1✔
98	mult _ _ = Zero	1✔
99
100	-- \| Reciprocal fraction.
101	recip :: Sign -> Sign
102	recip Pos = Pos	1✔
103	recip Zero = error "Data.Sign.recip: division by Zero"	1✔
104	recip Neg = Neg	1✔
105
106	-- \| Fractional division.
107	div :: Sign -> Sign -> Sign
108	div s Pos = s	1✔
109	div _ Zero = error "Data.Sign.div: division by Zero"	1✔
110	div s Neg = negate s	1✔
111
112	-- \| Exponentiation s^x.
113	--
114	-- Note that we define @'pow' 'Zero' 0 = 'Pos'@ assuming @0^0 = 1@.
115	pow :: Integral x => Sign -> x -> Sign
116	pow _ 0 = Pos	1✔
117	pow Pos _ = Pos	1✔
118	pow Zero _ = Zero	1✔
119	pow Neg n = if even n then Pos else Neg	1✔
120
121	-- \| Sign of a number.
122	signOf :: Real a => a -> Sign
123	signOf r =	1✔
124	case r `compare` 0 of	1✔
125	LT -> Neg	1✔
126	EQ -> Zero	1✔
127	GT -> Pos	1✔
128
129	-- \| Mnemonic symbol of a number.
130	--
131	-- This function returns @\"-\"@, @\"0\"@, @\"+\"@ respectively for 'Neg', 'Zero', 'Pos'.
132	symbol :: Sign -> String
133	symbol Pos = "+"	1✔
134	symbol Neg = "-"	1✔
135	symbol Zero = "0"	1✔
136
137	-- $SET
138	-- @'Set' 'Sign'@ is equipped with instances of 'Num' and 'Fractional'.
139	-- Therefore arithmetic operations can be applied to @'Set' 'Sign'@.
140	--
141	-- Instances of 'L.Lattice' and 'L.BoundedLattice' are also provided for
142	-- the purpose of abstract interpretation.
143
144	#if !MIN_VERSION_lattices(1,4,0)
145
146	instance L.MeetSemiLattice (Set Sign) where
147	meet = Set.intersection
148
149	instance L.Lattice (Set Sign)
150
151	instance L.BoundedMeetSemiLattice (Set Sign) where
152	top = Set.fromList universe
153
154	instance L.BoundedLattice (Set Sign)
155
156	#endif
157
158	instance Num (Set Sign) where	×
159	ss1 + ss2 = Set.unions [f s1 s2 \| s1 <- Set.toList ss1, s2 <- Set.toList ss2]	1✔
160	where
161	f Zero s = Set.singleton s	1✔
162	f s Zero = Set.singleton s	1✔
163	f Pos Pos = Set.singleton Pos	1✔
164	f Neg Neg = Set.singleton Neg	1✔
165	f _ _ = Set.fromList [Neg,Zero,Pos]	1✔
166	ss1 * ss2 = Set.fromList [mult s1 s2 \| s1 <- Set.toList ss1, s2 <- Set.toList ss2]	1✔
167	negate = Set.map negate	1✔
168	abs = Set.map abs	1✔
169	signum = id	1✔
170	fromInteger = Set.singleton . signOf	1✔
171
172	instance Fractional (Set Sign) where	×
173	recip = Set.map recip	1✔
174	fromRational = Set.singleton . signOf	1✔
175
176	#if !MIN_VERSION_hashable(1,2,0)
177	-- Copied from hashable-1.2.0.7:
178	-- Copyright : (c) Milan Straka 2010
179	-- (c) Johan Tibell 2011
180	-- (c) Bryan O'Sullivan 2011, 2012
181
182	-- \| Transform a value into a 'Hashable' value, then hash the
183	-- transformed value using the given salt.
184	--
185	-- This is a useful shorthand in cases where a type can easily be
186	-- mapped to another type that is already an instance of 'Hashable'.
187	-- Example:
188	--
189	-- > data Foo = Foo \| Bar
190	-- > deriving (Enum)
191	-- >
192	-- > instance Hashable Foo where
193	-- > hashWithSalt = hashUsing fromEnum
194	hashUsing :: (Hashable b) =>
195	(a -> b) -- ^ Transformation function.
196	-> Int -- ^ Salt.
197	-> a -- ^ Value to transform.
198	-> Int
199	hashUsing f salt x = hashWithSalt salt (f x)
200	{-# INLINE hashUsing #-}
201	#endif
202

msakai / sign / 29

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous