connections 0.0.2 → 0.0.2.1

raw patch · 10 files changed

+192/−214 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +4/−4
• connections.cabal +7/−6
• src/Data/Connection.hs +78/−94
• src/Data/Connection/Float.hs +4/−4
• src/Data/Connection/Int.hs +2/−2
• src/Data/Connection/Word.hs +2/−2
• src/Data/Float.hs +1/−5
• src/Data/Prd.hs +60/−60
• src/Data/Prd/Lattice.hs +9/−12
• src/Data/Prd/Nan.hs +25/−25

@@ -1,14 +1,14 @@ BSD 3-Clause License -Copyconnr Christopher McKinlay (c) 2019+Copyright Christopher McKinlay (c) 2019  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -1. Redistributions of source code must retain the above copyconnr notice, this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyconnr notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. -3. Neither the name of the copyconnr holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 

@@ -1,5 +1,5 @@ name:                connections-version:             0.0.2+version:             0.0.2.1 synopsis:            Partial orders & Galois connections. description:         A library for precision rounding using Galois connections. homepage:            https://github.com/cmk/connections@@ -7,7 +7,8 @@ license-file:        LICENSE author:              Chris McKinlay maintainer:          chris.mckinlay@gmail.com-category:            Math+category:            Math, Numerical+stability:           Experimental build-type:          Simple extra-source-files:  ChangeLog.md cabal-version:       >=1.10@@ -27,10 +28,10 @@     , Data.Float    build-depends:       -      base           >= 4.10  && < 5.0-    , containers     >= 0.4.0 && < 0.7-    , semigroupoids  == 5.*-    , property       >= 0.0.1 && < 1.0+      base              >= 4.10  && < 5.0+    , containers        >= 0.4.0 && < 0.7+    , semigroupoids     == 5.*+    , property          >= 0.0.1 && < 1.0    default-extensions:       ScopedTypeVariables

@@ -3,7 +3,6 @@ {-# Language AllowAmbiguousTypes #-}  module Data.Connection (-   -- * Connection     Conn(..)   , connl@@ -12,16 +11,16 @@   , counit   , pcomparing   , dual-  , (***)-  , (+++)   , (&&&)   , (|||)-  , _1-  , _2-  , _L-  , _R   , just   , list+  , first+  , second+  , left+  , right+  , strong+  , choice   , binord   , ordbin @@ -33,21 +32,19 @@   , unitr   , counitl   , counitr-  , ceiling'-  , floor'-  , (****)-  , (++++)-  , (&&&&)-  , (||||)-  , _1'-  , _2'-  , _L'-  , _R'-  , diag-  , codiag+  , forked+  , joined   , bound   , maybel   , mayber+  , first'+  , second'+  , left'+  , right'+  , strong'+  , choice'+  , ceiling'+  , floor' ) where  import Control.Category (Category, (>>>))@@ -63,9 +60,6 @@ import qualified Control.Category as C  -infixr 3 ***, ****, &&&, &&&&-infixr 2 +++, ++++, |||, ||||- -- | A Galois connection between two monotone functions: \(connl \dashv connr \) -- -- Each side of the adjunction may be defined in terms of the other:@@ -130,47 +124,27 @@ dual :: Prd a => Prd b => Conn a b -> Conn (Down b) (Down a) dual (Conn f g) = Conn (\(Down b) -> Down $ g b) (\(Down a) -> Down $ f a) -(***) :: Prd a => Prd b => Prd c => Prd d => Conn a b -> Conn c d -> Conn (a, c) (b, d)-(***) (Conn ab ba) (Conn cd dc) = Conn f g where-  f = bimap ab cd -  g = bimap ba dc--(+++) :: Prd a => Prd b => Prd c => Prd d => Conn a b -> Conn c d -> Conn (Either a c) (Either b d)-(+++) (Conn ab ba) (Conn cd dc) = Conn f g where-  f = either (Left . ab) (Right . cd)-  g = either (Left . ba) (Right . dc)--(&&&) :: Prd a => Prd b => Lattice c => Conn c a -> Conn c b -> Conn c (a, b)-f &&& g = tripr diag >>> f *** g+just :: Prd a => Prd b => Conn a b -> Conn (Maybe a) (Maybe b)+just (Conn f g) = Conn (fmap f) (fmap g) -(|||) :: Prd a => Prd b => Prd c => Conn a c -> Conn b c -> Conn (Either a b) c-f ||| g = f +++ g >>> tripr codiag+list :: Prd a => Prd b => Conn a b -> Conn [a] [b]+list (Conn f g) = Conn (fmap f) (fmap g) --- | Lens into first part of a product.------ @'_1' (ab >>> cd) = '_1' ab >>> '_1' cd@+-- @'first' (ab >>> cd) = 'first' ab >>> 'first' cd@ ---_1 :: Prd a => Prd b => Prd c => Conn a b -> Conn (a, c) (b, c)-_1 = (*** C.id)+first :: Prd a => Prd b => Prd c => Conn a b -> Conn (a, c) (b, c)+first = flip strong C.id -_2 :: Prd a => Prd b => Prd c => Conn a b -> Conn (c, a) (c, b)-_2 = (C.id ***)+second :: Prd a => Prd b => Prd c => Conn a b -> Conn (c, a) (c, b)+second = strong C.id --- | Prism into left part of a sum.------ @'_L' (ab >>> cd) = '_L' ab >>> '_L' cd@+-- @'left' (ab >>> cd) = 'left' ab >>> 'left' cd@ ---_L :: Prd a => Prd b => Prd c => Conn a b -> Conn (Either a c) (Either b c)-_L = (+++ C.id)--_R :: Prd a => Prd b => Prd c => Conn a b -> Conn (Either c a) (Either c b)-_R = (C.id +++)--just :: Prd a => Prd b => Conn a b -> Conn (Maybe a) (Maybe b)-just (Conn f g) = Conn (fmap f) (fmap g)+left :: Prd a => Prd b => Prd c => Conn a b -> Conn (Either a c) (Either b c)+left = flip choice C.id -list :: Prd a => Prd b => Conn a b -> Conn [a] [b]-list (Conn f g) = Conn (fmap f) (fmap g)+right :: Prd a => Prd b => Prd c => Conn a b -> Conn (Either c a) (Either c b)+right = choice C.id   ordbin :: Conn Ordering Bool ordbin = Conn f g where@@ -188,11 +162,27 @@   g LT = False   g _  = True +(&&&) :: Prd a => Prd b => Lattice c => Conn c a -> Conn c b -> Conn c (a, b)+f &&& g = tripr forked >>> f `strong` g++(|||) :: Prd a => Prd b => Prd c => Conn a c -> Conn b c -> Conn (Either a b) c+f ||| g = f `choice` g >>> tripr joined++strong :: Prd a => Prd b => Prd c => Prd d => Conn a b -> Conn c d -> Conn (a, c) (b, d)+strong (Conn ab ba) (Conn cd dc) = Conn f g where+  f = bimap ab cd +  g = bimap ba dc++choice :: Prd a => Prd b => Prd c => Prd d => Conn a b -> Conn c d -> Conn (Either a c) (Either b d)+choice (Conn ab ba) (Conn cd dc) = Conn f g where+  f = either (Left . ab) (Right . cd)+  g = either (Left . ba) (Right . dc)+ --------------------------------------------------------------------- --  'Trip' --------------------------------------------------------------------- --- | An adjoint triple.+-- | An adforkedt triple. -- -- @'Trip' f g h@ satisfies: --@@ -200,7 +190,7 @@ -- ⊥   ⊥ -- g ⊣ h ----- See <https://ncatlab.org/nlab/show/adjoint+triple>+-- See <https://ncatlab.org/nlab/show/adforkedt+triple> -- data Trip a b = Trip (a -> b) (b -> a) (a -> b) @@ -236,45 +226,15 @@ --  Instances --------------------------------------------------------------------- -(****) :: Prd a => Prd b => Prd c => Prd d => Trip a b -> Trip c d -> Trip (a, c) (b, d)-(****) (Trip ab ba ab') (Trip cd dc cd') = Trip f g h where-  f = bimap ab cd -  g = bimap ba dc-  h = bimap ab' cd'--(++++) :: Prd a => Prd b => Prd c => Prd d => Trip a b -> Trip c d -> Trip (Either a c) (Either b d)-(++++) (Trip ab ba ab') (Trip cd dc cd') = Trip f g h where-  f = either (Left . ab) (Right . cd)-  g = either (Left . ba) (Right . dc)-  h = either (Left . ab') (Right . cd')--(&&&&) :: Prd a => Prd b => Lattice c => Trip a c -> Trip b c -> Trip (a, b) c-f &&&& g = f **** g >>> diag--(||||) :: Prd a => Prd b => Prd c => Trip c a -> Trip c b -> Trip c (Either a b)-(||||) f g = codiag >>> f ++++ g--_1' :: Prd a => Prd b => Prd c => Trip a b -> Trip (a, c) (b, c)-_1' = (**** C.id)--_2' :: Prd a => Prd b => Prd c => Trip a b -> Trip (c, a) (c, b)-_2' = (C.id ****)--_L' :: Prd a => Prd b => Prd c => Trip a b -> Trip (Either a c) (Either b c)-_L' = (++++ C.id)--_R' :: Prd a => Prd b => Prd c => Trip a b -> Trip (Either c a) (Either c b)-_R' = (C.id ++++)--diag :: Lattice a => Trip (a, a) a-diag = Trip (uncurry (\/)) (\x -> (x,x)) (uncurry (/\))--codiag :: Prd a => Trip a (Either a a)-codiag = Trip Left (either id id) Right- bound :: Prd a => Bound a => Trip () a bound = Trip (const minimal) (const ()) (const maximal) +forked :: Lattice a => Trip (a, a) a+forked = Trip (uncurry (\/)) (\x -> (x,x)) (uncurry (/\))++joined :: Prd a => Trip a (Either a a)+joined = Trip Left (either id id) Right+ maybel :: Prd a => Bound b => Trip (Maybe a) (Either a b) maybel = Trip f g h where   f = maybe (Right minimal) Left@@ -286,3 +246,27 @@   f = maybe (Left minimal) Right   g = either (const Nothing) Just   h = maybe (Left maximal) Right++first' :: Prd a => Prd b => Prd c => Trip a b -> Trip (a, c) (b, c)+first' = flip strong' C.id++second' :: Prd a => Prd b => Prd c => Trip a b -> Trip (c, a) (c, b)+second' = strong' C.id++left' :: Prd a => Prd b => Prd c => Trip a b -> Trip (Either a c) (Either b c)+left' = flip choice' C.id++right' :: Prd a => Prd b => Prd c => Trip a b -> Trip (Either c a) (Either c b)+right' = choice' C.id++strong' :: Prd a => Prd b => Prd c => Prd d => Trip a b -> Trip c d -> Trip (a, c) (b, d)+strong' (Trip ab ba ab') (Trip cd dc cd') = Trip f g h where+  f = bimap ab cd +  g = bimap ba dc+  h = bimap ab' cd'++choice' :: Prd a => Prd b => Prd c => Prd d => Trip a b -> Trip c d -> Trip (Either a c) (Either b d)+choice' (Trip ab ba ab') (Trip cd dc cd') = Trip f g h where+  f = either (Left . ab) (Right . cd)+  g = either (Left . ba) (Right . dc)+  h = either (Left . ab') (Right . cd')

@@ -31,10 +31,10 @@            | ulp32Nan x || ulp32Nan y = False            | otherwise                = on (<~) unUlp32 x y -instance Min Ulp32 where+instance Minimal Ulp32 where     minimal = Ulp32 $ -2139095041 -instance Max Ulp32 where+instance Maximal Ulp32 where     maximal = Ulp32 $ 2139095040  instance Bounded Ulp32 where@@ -56,13 +56,13 @@   offset  = 2139095041 :: Word64   offset' = 2139095041 :: Int32 -  f x@(Ulp32 y) | ulp32Nan x = NaN+  f x@(Ulp32 y) | ulp32Nan x = Nan                 | negative y = Def $ fromIntegral (y + offset')                 | otherwise = Def $ (fromIntegral y) + offset                where fromIntegral = connl conn    g x = case x of-          NaN -> Ulp32 offset'+          Nan -> Ulp32 offset'           Def y | y < offset -> Ulp32 $ (fromIntegral y) - offset'                 | otherwise  -> Ulp32 $ fromIntegral ((min 4278190081 y) - offset)                where fromIntegral = connr conn

@@ -38,8 +38,8 @@ import Numeric.Natural  unsigned :: (Bounded a, Integral a, Integral b) => Conn a b-unsigned = -  Conn (\y -> fromIntegral (y + maxBound + 1)) (\x -> fromIntegral x - minBound) +unsigned = Conn (\y -> fromIntegral (y + maxBound + 1))+                (\x -> fromIntegral x - minBound)   i08w08 :: Conn Int8 Word8 i08w08 = unsigned

@@ -28,8 +28,8 @@ import Numeric.Natural  signed :: (Bounded b, Integral a, Integral b) => Conn a b-signed = -  Conn (\x -> fromIntegral x - minBound) (\y -> fromIntegral (y + maxBound + 1))+signed = Conn (\x -> fromIntegral x - minBound)+              (\y -> fromIntegral (y + maxBound + 1))  w08i08 :: Conn Word8 Int8 w08i08 = signed

@@ -170,7 +170,7 @@   | otherwise        = abs (a - b) / fmax (abs a) (abs b) -- TODO need /  -- | Check that relative error between two numbers @a@ and @b@. If--- 'relativeError' returns NaN it returns @False@.+-- 'relativeError' returns Nan it returns @False@. eqRelErr :: Float -- ^ /eps/ relative error should be in [0,1) range          -> Float -- ^ /a/          -> Float -- ^ /b/@@ -183,8 +183,6 @@ -- Ulps-based comparison ---------------------------------------------------------------- -- ulps :: Float -> Float -> (Bool, Word32) ulps x y = o   where  x' = floatInt32 x@@ -407,8 +405,6 @@ -- acosh :: Float -> Float acosh = liftFloat F.acosh--  liftFloat :: (F.Float -> F.Float) -> Float -> Float liftFloat f x = Float $ f x

@@ -281,7 +281,7 @@     EQ -> Just y     LT -> Just y -pjoin :: Eq a => Min a => Foldable f => f a -> Maybe a+pjoin :: Eq a => Minimal a => Foldable f => f a -> Maybe a pjoin = foldM pmax minimal  -- | A partial version of 'Data.Ord.min'. @@ -296,7 +296,7 @@     EQ -> Just x     LT -> Just x -pmeet :: Eq a => Max a => Foldable f => f a -> Maybe a+pmeet :: Eq a => Maximal a => Foldable f => f a -> Maybe a pmeet = foldM pmin maximal  sign :: Eq a => Num a => Prd a => a -> Maybe Ordering@@ -416,11 +416,11 @@ instance (Eq a, Semigroup a) => Prd (S.First a) where      (<~) = (==) -instance Ord a => Prd (S.Max a) where -    pcompare (S.Max x) (S.Max y) = Just $ compare x y+instance Ord a => Prd (S.Maximal a) where +    pcompare (S.Maximal x) (S.Maximal y) = Just $ compare x y -instance Ord a => Prd (S.Min a) where -    pcompare (S.Min x) (S.Min y) = Just $ compare y x+instance Ord a => Prd (S.Minimal a) where +    pcompare (S.Minimal x) (S.Minimal y) = Just $ compare y x  -} @@ -496,7 +496,6 @@ instance Prd IntSet.IntSet where     (<~) = IntSet.isSubsetOf - -- Helper type for 'DerivingVia' newtype Ordered a = Ordered { getOrdered :: a }   deriving ( Eq, Ord, Show, Data, Typeable, Generic, Generic1, Functor, Foldable, Traversable)@@ -504,123 +503,124 @@ instance Ord a => Prd (Ordered a) where     (<~) = (<=) -type Bound a = (Min a, Max a) +-------------------------------------------------------------------------------+-- Minimal+------------------------------------------------------------------------------- --- | Min element of a partially ordered set.+type Bound a = (Minimal a, Maximal a) ++-- | Minimal element of a partially ordered set. --  -- \( \forall x: x \ge minimal \) -- -- This means that 'minimal' must be comparable to all values in /a/. ---class Prd a => Min a where+class Prd a => Minimal a where     minimal :: a -instance Min () where minimal = ()+instance Minimal () where minimal = () -instance Min Natural where minimal = 0+instance Minimal Natural where minimal = 0 -instance Min Bool where minimal = minBound+instance Minimal Bool where minimal = minBound -instance Min Ordering where minimal = minBound+instance Minimal Ordering where minimal = minBound -instance Min Int where minimal = minBound+instance Minimal Int where minimal = minBound -instance Min Int8 where minimal = minBound+instance Minimal Int8 where minimal = minBound -instance Min Int16 where minimal = minBound+instance Minimal Int16 where minimal = minBound -instance Min Int32 where minimal = minBound+instance Minimal Int32 where minimal = minBound -instance Min Int64 where minimal = minBound+instance Minimal Int64 where minimal = minBound -instance Min Word where minimal = minBound+instance Minimal Word where minimal = minBound -instance Min Word8 where minimal = minBound+instance Minimal Word8 where minimal = minBound -instance Min Word16 where minimal = minBound+instance Minimal Word16 where minimal = minBound -instance Min Word32 where minimal = minBound+instance Minimal Word32 where minimal = minBound -instance Min Word64 where minimal = minBound +instance Minimal Word64 where minimal = minBound  -instance Prd a => Min (IntMap.IntMap a) where+instance Prd a => Minimal (IntMap.IntMap a) where     minimal = IntMap.empty -instance Ord a => Min (Set.Set a) where+instance Ord a => Minimal (Set.Set a) where     minimal = Set.empty -instance (Ord k, Prd a) => Min (Map.Map k a) where+instance (Ord k, Prd a) => Minimal (Map.Map k a) where     minimal = Map.empty -instance (Min a, Min b) => Min (a, b) where+instance (Minimal a, Minimal b) => Minimal (a, b) where     minimal = (minimal, minimal) -instance (Min a, Prd b) => Min (Either a b) where+instance (Minimal a, Prd b) => Minimal (Either a b) where     minimal = Left minimal -instance Prd a => Min (Maybe a) where+instance Prd a => Minimal (Maybe a) where     minimal = Nothing  -instance Max a => Min (Down a) where+instance Maximal a => Minimal (Down a) where     minimal = Down maximal --- | Max element of a partially ordered set.+-------------------------------------------------------------------------------+-- Maximal+-------------------------------------------------------------------------------++-- | Maximal element of a partially ordered set. -- -- \( \forall x: x \le maximal \) -- -- This means that 'maximal' must be comparable to all values in /a/. ---class Prd a => Max a where+class Prd a => Maximal a where     maximal :: a -instance Max () where maximal = ()+instance Maximal () where maximal = () -instance Max Bool where maximal = maxBound+instance Maximal Bool where maximal = maxBound -instance Max Ordering where maximal = maxBound+instance Maximal Ordering where maximal = maxBound -instance Max Int where maximal = maxBound+instance Maximal Int where maximal = maxBound -instance Max Int8 where maximal = maxBound+instance Maximal Int8 where maximal = maxBound -instance Max Int16 where maximal = maxBound+instance Maximal Int16 where maximal = maxBound -instance Max Int32 where maximal = maxBound+instance Maximal Int32 where maximal = maxBound -instance Max Int64 where maximal = maxBound+instance Maximal Int64 where maximal = maxBound -instance Max Word where maximal = maxBound+instance Maximal Word where maximal = maxBound -instance Max Word8 where maximal = maxBound+instance Maximal Word8 where maximal = maxBound -instance Max Word16 where maximal = maxBound+instance Maximal Word16 where maximal = maxBound -instance Max Word32 where maximal = maxBound+instance Maximal Word32 where maximal = maxBound -instance Max Word64 where maximal = maxBound+instance Maximal Word64 where maximal = maxBound -instance (Max a, Max b) => Max (a, b) where+instance (Maximal a, Maximal b) => Maximal (a, b) where     maximal = (maximal, maximal) -instance (Prd a, Max b) => Max (Either a b) where+instance (Prd a, Maximal b) => Maximal (Either a b) where     maximal = Right maximal -instance Max a => Max (Maybe a) where+instance Maximal a => Maximal (Maybe a) where     maximal = Just maximal -instance Min a => Max (Down a) where+instance Minimal a => Maximal (Down a) where     maximal = Down minimal -{--instance (Universe a, Prd a) => Prd (k -> a) where--instance Min a => Min (k -> a) where-    minimal = const minimal--instance Max a => Max (k -> a) where-    maximal = const maximal--}- +-------------------------------------------------------------------------------+-- Iterators+-------------------------------------------------------------------------------  {-# INLINE until #-} until :: (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a

@@ -143,7 +143,7 @@   (/\) :: a -> a -> a    -- | Lattice morphism.-  fromSubset :: Min a => Set a -> a+  fromSubset :: Minimal a => Set a -> a   fromSubset = join  -- | The partial ordering induced by the join-semilattice structure@@ -153,10 +153,10 @@ meetLeq :: Lattice a => a -> a -> Bool meetLeq x y = x /\ y =~ x -join :: (Min a, Lattice a, Foldable f) => f a -> a+join :: (Minimal a, Lattice a, Foldable f) => f a -> a join = foldr' (\/) minimal -meet :: (Max a, Lattice a, Foldable f) => f a -> a+meet :: (Maximal a, Lattice a, Foldable f) => f a -> a meet = foldr' (/\) maximal  -- | The join of at a list of join-semilattice elements (of length at least one)@@ -170,8 +170,6 @@  -- | Birkhoff's self-dual ternary median operation. ----- TODO: require a /Dioid/ instance.--- -- @ median x x y ≡ x @ -- -- @ median x y z ≡ median z x y @@@ -183,7 +181,6 @@ median :: Lattice a => a -> a -> a -> a median x y z = (x \/ y) /\ (y \/ z) /\ (z \/ x) - --------------------------------------------------------------------- --  Instances ---------------------------------------------------------------------@@ -225,20 +222,20 @@   All a \/ All b = All $ a \/ b   All a /\ All b = All $ a /\ b -instance Min All where+instance Minimal All where   minimal = All False -instance Max All where+instance Maximal All where   maximal = All True  instance Lattice Any where   Any a \/ Any b = Any $ a \/ b   Any a /\ Any b = Any $ a /\ b -instance Min Any where+instance Minimal Any where   minimal = Any False -instance Max Any where+instance Maximal Any where   maximal = Any True  instance Lattice a => Lattice (Down a) where@@ -275,7 +272,7 @@ instance Lattice a => Semigroup (Join a) where   Join a <> Join b = Join (a \/ b) -instance (Lattice a, Min a) => Monoid (Join a) where+instance (Lattice a, Minimal a) => Monoid (Join a) where   mempty = Join minimal   Join a `mappend` Join b = Join (a \/ b) @@ -288,6 +285,6 @@ instance Lattice a => Semigroup (Meet a) where   Meet a <> Meet b = Meet (a /\ b) -instance (Lattice a, Max a) => Monoid (Meet a) where+instance (Lattice a, Maximal a) => Monoid (Meet a) where   mempty = Meet maximal   Meet a `mappend` Meet b = Meet (a /\ b)

@@ -18,45 +18,45 @@  -- A type with an additional element allowing for the possibility of undefined values. -- Isomorphic to /Maybe a/ but with a different 'Prd' instance.-data Nan a = NaN | Def a+data Nan a = Nan | Def a   deriving ( Eq, Ord, Show, Data, Typeable, Generic, Generic1, Functor, Foldable, Traversable)  nan :: b -> (a -> b) -> Nan a -> b nan _ f (Def y) = f y-nan x _  NaN    = x +nan x _  Nan    = x   defined :: Nan a -> Bool-defined NaN = False+defined Nan = False defined _   = True  mapNan :: (a -> b) -> Nan a -> Nan b-mapNan f = nan NaN $ Def . f+mapNan f = nan Nan $ Def . f  maybeNan :: (forall a. a -> a) -> Maybe a -> Nan a-maybeNan _ Nothing = NaN+maybeNan _ Nothing = Nan maybeNan f (Just x) = Def $ f x  nanMaybe :: (forall a. a -> a) -> Nan a -> Maybe a-nanMaybe _ NaN = Nothing+nanMaybe _ Nan = Nothing nanMaybe f (Def x) = Just $ f x  eitherNan :: Either a b -> Nan b-eitherNan = either (const NaN) Def+eitherNan = either (const Nan) Def  nanEither :: a -> Nan b -> Either a b nanEither x = nan (Left x) Right  liftNan :: (Prd a, Fractional a) => (a -> b) -> a -> Nan b-liftNan f x | x =~ (0/0) = NaN+liftNan f x | x =~ (0/0) = Nan             | otherwise = Def (f x)  liftNan' :: RealFloat a => (a -> b) -> a -> Nan b-liftNan' f x | isNaN x = NaN+liftNan' f x | isNaN x = Nan              | otherwise = Def (f x)  -- Lift all exceptional values liftAll :: (RealFloat a, Prd a, Bound b) => (a -> b) -> a -> Nan b-liftAll f x | isNaN x = NaN+liftAll f x | isNaN x = Nan             | isInf x = Def maximal             | isInf (-x) = Def minimal             | otherwise = Def (f x)@@ -70,27 +70,27 @@   g (Def GT) = 1/0   g (Def LT) = - 1/0   g (Def EQ) = 0-  g NaN = 0/0+  g Nan = 0/0   -  f x | isNaN x    = NaN+  f x | isNaN x    = Nan   f x | isInf (-x) = Def LT   f x | x <~ 0     = Def EQ   f x | otherwise  = Def GT -  h x | isNaN x    = NaN+  h x | isNaN x    = Nan   h x | isInf x    = Def GT   h x | x >~ 0     = Def EQ   h x | otherwise  = Def LT  instance Prd a => Prd (Nan a) where-    NaN <~ NaN = True-    _   <~ NaN = False-    NaN <~ _   = False+    Nan <~ Nan = True+    _   <~ Nan = False+    Nan <~ _   = False     Def a <~ Def b = a <~ b  instance Applicative Nan where     pure = Def-    NaN <*> _ = NaN+    Nan <*> _ = Nan     Def f <*> x = f <$> x  instance Num a => Num (Nan a) where@@ -102,18 +102,18 @@     signum      = fmap signum  nanflt :: Prd a => Fractional a => Conn (Nan a) a-nanflt = Conn (nan (0/0) id) $ \y -> if y =~ (0/0) then NaN else Def y +nanflt = Conn (nan (0/0) id) $ \y -> if y =~ (0/0) then Nan else Def y   def :: Prd a => Prd b => Conn a b -> Conn (Nan a) (Nan b) def conn = Conn f g where -  Conn f' g' = _R conn+  Conn f' g' = right conn   f = eitherNan . f' . nanEither ()   g = eitherNan . g' . nanEither ()  {- floatOrdering :: Trip Float (Nan Ordering) floatOrdering = Trip f g h where-  h x | isNan x = NaN+  h x | isNaN x = Nan   h x | posinf x = Def GT   h x | finite x && x >~ 0 = Def EQ   h x | otherwise = Def LT@@ -121,9 +121,9 @@   g (Def GT) = maxBound   g (Def LT) = minBound   g (Def EQ) = 0-  g NaN = aNan+  g Nan = aNan   -  f x | isNan x = NaN+  f x | isNaN x = Nan   f x | neginf x = Def LT   f x | finite x && x <~ 0 = Def EQ   f x | otherwise = Def GT@@ -146,8 +146,8 @@  instance Field a => Field (Nan a) where -u + NaN = NaN + u = NaN − NaN = NaN-u · NaN = NaN · u = NaN NaN−1 = NaN-NaN  u ⇔ u = NaN u  NaN ⇔ u = NaN+u + Nan = Nan + u = Nan − Nan = Nan+u · Nan = Nan · u = Nan Nan−1 = Nan+Nan  u ⇔ u = Nan u  Nan ⇔ u = Nan -}