mixed-types-num 0.1.0.1 → 0.2

raw patch · 26 files changed

+2183/−326 lines, 26 filesdep +template-haskelldep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: template-haskell

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• changelog.md +9/−0
• mixed-types-num.cabal +25/−8
• src/Control/CollectErrors.hs +315/−0
• src/MixedTypesNumPrelude.hs +187/−0
• src/Numeric/CollectErrors.hs +128/−0
• src/Numeric/MixedTypes.hs +0/−134
• src/Numeric/MixedTypes/AddSub.hs +96/−15
• src/Numeric/MixedTypes/Bool.hs +44/−4
• src/Numeric/MixedTypes/Complex.hs +349/−0
• src/Numeric/MixedTypes/Elementary.hs +89/−35
• src/Numeric/MixedTypes/Eq.hs +117/−26
• src/Numeric/MixedTypes/Field.hs +176/−59
• src/Numeric/MixedTypes/Literals.hs +49/−9
• src/Numeric/MixedTypes/MinMaxAbs.hs +59/−0
• src/Numeric/MixedTypes/Ord.hs +76/−0
• src/Numeric/MixedTypes/Ring.hs +158/−36
• src/Numeric/MixedTypes/Round.hs +4/−0
• src/Utils/TH/DeclForTypes.hs +50/−0
• test/Numeric/MixedTypes/AddSubSpec.hs +32/−0
• test/Numeric/MixedTypes/BoolSpec.hs +38/−0
• test/Numeric/MixedTypes/EqOrdSpec.hs +39/−0
• test/Numeric/MixedTypes/FieldSpec.hs +24/−0
• test/Numeric/MixedTypes/LiteralsSpec.hs +38/−0
• test/Numeric/MixedTypes/MinMaxAbsSpec.hs +30/−0
• test/Numeric/MixedTypes/RingSpec.hs +30/−0
• test/Numeric/MixedTypes/RoundSpec.hs +21/−0

@@ -0,0 +1,9 @@+* v 0.1+  * first release++* v 0.2+  * new CollectErrors wrapper+  * CN, specialisation of CollectErrors to NumErrors+  * numerical partial operators (eg division) return a CN type+  * instances for Data.Complex+  

@@ -1,5 +1,5 @@ name:           mixed-types-num-version:        0.1.0.1+version:        0.2 cabal-version:  >= 1.9.2 build-type:     Simple homepage:       https://github.com/michalkonecny/mixed-types-num@@ -8,6 +8,7 @@ copyright:      (c) 2015-2017 Michal Konecny license:        BSD3 license-file:   LICENSE+extra-source-files:  changelog.md stability:      experimental tested-with:    GHC==7.10.3, GHC==8.0.2 category:       Math@@ -17,21 +18,23 @@     unary and binary operations such as @not@, @+@, @==@     have their result type derived from the parameter type(s).     .-    See module "Numeric.MixedTypes" for further documentation.+    See module "MixedTypesNumPrelude" for further documentation.  source-repository head   type:     git   location: https://github.com/mikkonecny/mixed-types-num + library   hs-source-dirs:  src   build-depends:-    base == 4.*+    base >= 4.8 && < 4.10     , convertible >= 1.1.1.0 && < 1.2+    , template-haskell     , hspec >= 2.1 && < 2.5     , hspec-smallcheck >= 0.3 && < 0.5     , smallcheck == 1.1.*-    , QuickCheck >= 2.7 && < 2.10+    , QuickCheck >= 2.7 && < 2.11   ghc-options:     -Wall -fno-warn-orphans   extensions:     RebindableSyntax,@@ -46,7 +49,9 @@     FlexibleInstances,     UndecidableInstances   exposed-modules:-    Numeric.MixedTypes+    Utils.TH.DeclForTypes+    Control.CollectErrors+    Numeric.CollectErrors     Numeric.MixedTypes.PreludeHiding     Numeric.MixedTypes.Literals     Numeric.MixedTypes.Bool@@ -58,7 +63,10 @@     Numeric.MixedTypes.Ring     Numeric.MixedTypes.Field     Numeric.MixedTypes.Elementary+    Numeric.MixedTypes.Complex+    MixedTypesNumPrelude + test-suite spec   type:       exitcode-stdio-1.0@@ -72,10 +80,19 @@   hs-source-dirs:       test   main-is:-      Spec.hs+    Spec.hs+  other-modules:+    Numeric.MixedTypes.AddSubSpec+    Numeric.MixedTypes.BoolSpec+    Numeric.MixedTypes.EqOrdSpec+    Numeric.MixedTypes.FieldSpec+    Numeric.MixedTypes.LiteralsSpec+    Numeric.MixedTypes.MinMaxAbsSpec+    Numeric.MixedTypes.RingSpec+    Numeric.MixedTypes.RoundSpec   build-depends:-    base == 4.*+    base >= 4.8 && < 4.10     , mixed-types-num     , hspec >= 2.1 && < 2.5     , hspec-smallcheck >= 0.3 && < 0.5-    , QuickCheck >= 2.7 && < 2.10+    , QuickCheck >= 2.7 && < 2.11

@@ -0,0 +1,315 @@+{-# LANGUAGE TemplateHaskell #-}+module Control.CollectErrors+(+-- * Monad for collecting errors in expressions+  CollectErrors(..), SuitableForCE+, noValueCE, prependErrorsCE+, filterValuesWithoutErrorCE, getValueIfNoErrorCE+, ce2ConvertResult+-- * Tools for avoiding @CollectErrors(CollectErrors t)@ and putting CE inside containers+, CanEnsureCE(..)+, getValueOrThrowErrorsNCE+, lift1CE, lift2CE, lift2TCE, lift2TLCE+)+where++import Prelude+  (Functor(..), Applicative(..), Monad(..), (<$>), ($)+  , id, error, const, flip+  , Int, Integer, Rational, Double, Bool, Char+  , Maybe(..), Either(..)+  , Show(..), Eq(..))+import Text.Printf+import Data.Monoid+import Data.Maybe (fromJust)++import Data.Convertible+import Data.Typeable++-- import Language.Haskell.TH++import Test.QuickCheck++{-|+  A wrapper around values which can accommodate a list of+  (potential) errors that have (maybe) occurred during the computation+  of a value.  A value may be missing, leaving only the error(s).++  Such error collection allows one to write expressions with partial+  functions (ie functions that fail for some inputs) instead of+  branching after each application of such function.+  Dealing with the errors can be moved outside the expression.+  If the error data contain enough information, their list can be used+  to trace the source of the errors.+-}+data CollectErrors es v =+  CollectErrors+    { getMaybeValueCE :: Maybe v+    , getErrorsCE :: es }++type SuitableForCE es = (Monoid es, Eq es, Show es)++instance (Show v, SuitableForCE es) => (Show (CollectErrors es v)) where+  show (CollectErrors mv es) =+    case mv of+      Just v | es == mempty -> show v+      _ -> printf "{%s}" (show es)++noValueCE :: es -> CollectErrors es v+noValueCE es = CollectErrors Nothing es++prependErrorsCE :: (Monoid es) => es -> CollectErrors es v -> CollectErrors es v+prependErrorsCE es1 (CollectErrors mv es2) = CollectErrors mv (es1 <> es2)++ce2ConvertResult ::+  (Typeable t, Show t, SuitableForCE es)+  =>+  CollectErrors es t -> Either ConvertError t+ce2ConvertResult (CollectErrors mv es) =+  case mv of+    Just v | es == mempty -> Right v+    _ -> convError (show es) mv++{-| A safe way to get a value out of the CollectErrors wrapper. -}+getValueIfNoErrorCE ::+  (SuitableForCE es)+  =>+  CollectErrors es v -> (v -> t) -> (es -> t) -> t+getValueIfNoErrorCE (CollectErrors mv es) withValue withErrors =+  case mv of+    Just v | es == mempty -> withValue v+    _ -> withErrors es++filterValuesWithoutErrorCE ::+  (SuitableForCE es)+  =>+  [CollectErrors es v] -> [v]+filterValuesWithoutErrorCE [] = []+filterValuesWithoutErrorCE (vCE : rest) =+  getValueIfNoErrorCE vCE (: restDone) (const restDone)+  where+  restDone = filterValuesWithoutErrorCE rest++-- functor instances:++instance Functor (CollectErrors es) where+  fmap f (CollectErrors mv es) =+    CollectErrors (fmap f mv) es++instance (Monoid es) => Applicative (CollectErrors es) where+  pure v = CollectErrors (Just v) mempty+  (CollectErrors (Just a) ae) <*> (CollectErrors (Just b) be) =+    CollectErrors (Just (a b)) (ae <> be)+  (CollectErrors _ ae) <*> (CollectErrors _ be) =+    CollectErrors Nothing (ae <> be)++instance (Monoid es) => Monad (CollectErrors es) where+  ae >>= f =+    case ae of+      CollectErrors (Just a) es1 ->+        let (CollectErrors mv es2) = f a in+          CollectErrors mv (es1 <> es2)+      CollectErrors _ es ->+        CollectErrors Nothing es++instance (Arbitrary t, Monoid es) => Arbitrary (CollectErrors es t) where+  arbitrary = (\v -> CollectErrors (Just v) mempty) <$> arbitrary++{-|+  A mechanism for adding and removing CollectErrors+  to a type in a manner that depends on+  the shape of the type, especially whether+  it already has CollectErrors.+-}+class (Monoid es) => CanEnsureCE es a where+  {-|+    Add CollectErrors to a type except when the type already+    has CollectErrors in it.+  -}+  type EnsureCE es a+  type EnsureCE es a = CollectErrors es a -- default+  type EnsureNoCE es a+  type EnsureNoCE es a = a -- default++  {-|+    Translate a value of a type @a@+    to a value of a type @EnsureCE es a@.+  -}+  ensureCE ::+    Maybe es {-^ sample only -} ->+    a -> EnsureCE es a++  default ensureCE ::+    (EnsureCE es a ~ CollectErrors es a)+    =>+    Maybe es {-^ sample only -} ->+    a -> EnsureCE es a+  ensureCE _ = pure++  deEnsureCE ::+    Maybe es {-^ sample only -} ->+    EnsureCE es a -> Either es a++  default deEnsureCE ::+    (EnsureCE es a ~ CollectErrors es a, Eq es) =>+    Maybe es {-^ sample only -} ->+    EnsureCE es a -> Either es a+  deEnsureCE _ (CollectErrors mv es) =+    case mv of+      Just v | es == mempty -> Right v+      _ -> Left es++  ensureNoCE ::+    Maybe es {-^ sample only -} ->+    a -> Either es (EnsureNoCE es a)++  default ensureNoCE ::+    (EnsureNoCE es a ~ a, Eq es) =>+    Maybe es {-^ sample only -} ->+    a -> Either es (EnsureNoCE es a)+  ensureNoCE _ = Right++  {-|  Make CollectErrors record with no value, only errors. -}+  noValueECE ::+    Maybe a {-^ sample only -} ->+    es -> EnsureCE es a++  default noValueECE ::+    (EnsureCE es a ~ CollectErrors es a)+    =>+    Maybe a ->+    es -> CollectErrors es a+  noValueECE _ = noValueCE++-- instance for CollectErrors a:++instance+  (SuitableForCE es)+  =>+  CanEnsureCE es (CollectErrors es a)+  where+  type EnsureCE es (CollectErrors es a) = CollectErrors es a+  type EnsureNoCE es (CollectErrors es a) = a++  ensureCE _sample_es = id+  deEnsureCE _sample_es = Right+  ensureNoCE _sample_es (CollectErrors mv es) =+    case mv of+    Just v | es == mempty -> Right v+    _ -> Left es++  noValueECE _sample_vCE es = CollectErrors Nothing es++-- instances for ground types, using the default implementations:++instance (SuitableForCE es) => CanEnsureCE es Int+instance (SuitableForCE es) => CanEnsureCE es Integer+instance (SuitableForCE es) => CanEnsureCE es Rational+instance (SuitableForCE es) => CanEnsureCE es Double+instance (SuitableForCE es) => CanEnsureCE es Bool+instance (SuitableForCE es) => CanEnsureCE es Char+instance (SuitableForCE es) => CanEnsureCE es ()++-- instance for Maybe a:++instance+  (SuitableForCE es, CanEnsureCE es a)+  =>+  CanEnsureCE es (Maybe a)+  where+  type EnsureCE es (Maybe a) = Maybe (EnsureCE es a)+  type EnsureNoCE es (Maybe a) = Maybe (EnsureNoCE es a)++  ensureCE sample_es = fmap (ensureCE sample_es)+  deEnsureCE sample_es (Just vCE) = fmap Just (deEnsureCE sample_es vCE)+  deEnsureCE _sample_es Nothing = Right Nothing+  ensureNoCE sample_es (Just vCE) = fmap Just (ensureNoCE sample_es vCE)+  ensureNoCE _sample_es Nothing = Right Nothing++  noValueECE sample_vCE es = Just (noValueECE (fromJust sample_vCE) es)++-- instance (Monoid es) => CanEnsureCE es [a] where+-- instance (Monoid es) => CanEnsureCE es (Either e a) where++{-| An unsafe way to get a value out of an CollectErrors wrapper. -}+getValueOrThrowErrorsNCE ::+  (SuitableForCE es, CanEnsureCE es v, Show v)+  =>+  Maybe es {-^ sample only -} ->+  v -> (EnsureNoCE es v)+getValueOrThrowErrorsNCE sample_es v =+  case ensureNoCE sample_es v of+    Right vNCE -> vNCE+    Left es -> error (show es)++{-|+  Add error collection support to an unary function whose+  result may already have collected errors.+-}+lift1CE ::+  (SuitableForCE es+  , CanEnsureCE es c)+  =>+  (a -> c) ->+  (CollectErrors es a) -> (EnsureCE es c)+lift1CE (fn :: a -> c) aCE =+  case (ensureNoCE sample_es aCE) of+    Right a -> ensureCE sample_es $ fn a+    _ -> noValueECE sample_c a_es+  where+  sample_es = Just a_es+  CollectErrors ma a_es = aCE+  sample_c = fn <$> ma++{-|+  Add error collection support to a binary function whose+  result may already have collected errors.+-}+lift2CE ::+  (SuitableForCE es+  , CanEnsureCE es c)+  =>+  (a -> b -> c) ->+  (CollectErrors es a) -> (CollectErrors es b) -> (EnsureCE es c)+lift2CE (fn :: a -> b -> c) aCE bCE =+  case (ensureNoCE sample_es aCE, ensureNoCE sample_es bCE) of+    (Right a, Right b) -> ensureCE sample_es $ fn a b+    _ -> noValueECE sample_c (a_es <> b_es)+  where+  sample_es = Just a_es+  CollectErrors ma a_es = aCE+  CollectErrors mb b_es = bCE+  sample_c = fn <$> ma <*> mb++{-|+  Add error collection support to a binary function whose+  result may already have collected errors.+  A version where the second operand is not lifted, only the first one.+-}+lift2TCE ::+  (SuitableForCE es+  , CanEnsureCE es c)+  =>+  (a -> b -> c) ->+  (CollectErrors es a) -> b -> (EnsureCE es c)+lift2TCE (fn :: a -> b -> c) aCE b =+  case (ensureNoCE sample_es aCE) of+    (Right a) -> ensureCE sample_es $ fn a b+    _ -> noValueECE sample_c a_es+  where+  sample_es = Just a_es+  CollectErrors ma a_es = aCE+  sample_c = fn <$> ma <*> (Just b)++{-|+  Add error collection support to a binary function whose+  result may already have collected errors.+  A version where the first operand is not lifted, only the second one.+-}+lift2TLCE ::+  (SuitableForCE es+  , CanEnsureCE es c)+  =>+  (a -> b -> c) ->+  a -> (CollectErrors es b) -> (EnsureCE es c)+lift2TLCE f = flip $ lift2TCE (flip f)

@@ -0,0 +1,187 @@+{-|+    Module      :  MixedTypesNumPrelude+    Description :  Bottom-up typed numeric expressions+    Copyright   :  (c) Michal Konecny, Pieter Collins+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    = Main purpose++    This package provides a version of Prelude where+    unary and binary operations such as @not@, @+@, @==@+    have their result type derived from the parameter type(s),+    allowing, /e.g./:++      * Dividing an integer by an integer, giving a rational, wrapped in the CN (ie Collecting NumErrors) monad:++      >>> :t let n = 1 :: Integer in n/(n+1)+      CN Rational++      >>> :t 1/2+      CN Rational++      (Integer literals are always of type @Integer@, not @Num t => t@.)++      * Adding an integer and a rational, giving a rational:++      >>> :t (length [x])+1/3+      CN Rational++      The @CN@ monad is required because integer division can, in general, fail as it is a partial operation:++      >>> 1/0+      {[(ERROR,division by 0)]}++      Note that when evaluating @1/0@, it evaluates to the error value printed above.+      This is not an exception, but a special value.++      When one is certain the division is well defined, one can remove @CN@ in several ways:++      >>> :t (1%2)  -- using Data.Ratio.(%), works only for integers+      Rational++      >>> :t (1/!2)  -- this works for non-integer division too+      Rational++      >>> :t (~!) (1/2) -- ~! removes CN from any type+      Rational++      The operator (/!) stands for division which throws an exception is the+      denominator is 0.  It "propagates" any potential errors+      from the sub-expressions:++      >>> :t 1/!(1 - 1/n)+      CN Rational++      The last example will throw an error exception when evaluated with @n=1@+      but it will not thrown any excetion when @n=0@++      * taking natural, integer and fractional power using the same operator:++      >>> :t 2^2+      CN Integer++      >>> :t 2.0^(-2)+      CN Rational++      >>> :t (double 2)^(1/!2)+      Double++      The following examples require package <https://github.com/michalkonecny/aern2/aern2-real aern2-real>:++      >>> :t 2^(1/2)+      CauchyRealCN++      >>> :t pi+      CauchyReal++      >>> :t sqrt 2+      CauchyRealCN++      * comparing an integer with an (exact) real number, giving a seqeunce of @Maybe Bool@:++      @+      if x < 0 then -x else x+      @++      In the last example, @if@ is overloaded so that it works for conditions+      of other types than @Bool@.  Here the condition has the type @Sequence (Maybe Bool)@.+      The whole expression is the sequence of balls in which those balls for which the condition+      is inconclusive are the union of the balls computed by both branches.++    = Type classes++    Arithmetic operations are provided via multi-parameter type classes+    and the result type is given by associated+    type families. For example:++    @+    (+) :: (CanAddAsymmetric t1 t2) => t1 -> t2 -> AddType t1 t2+    @++    The type constraint @CanAdd t1 t2@ implies both+    @CanAddAsymmetric t1 t2@ and @CanAddAsymmetric t2 t1@.++    For convenience there are other aggregate type constraints such as+    @CanAddThis t1 t2@, which implies that the result is of type @t1@,+    and @CanAddSameType t@, which is a shortcut for @CanAddThis t t@.++    == Testable specification++    The arithmetic type classes are accompanied by generic hspec test suites,+    which are specialised to concrete instance types for their testing.+    These test suites include the expected algebraic properties of operations,+    such as commutativity and associativity of addition.++    = Limitations++    * Not all numerical operations are supported yet.+      Eg @tan@, @atan@ are missing at the moment.++    * Inferred types can be very large. Eg for @f a b c = sqrt (a + b * c + 1)@ the inferred type is:++      @+      f: (CanMulAsymmetric t1 t2, CanAddAsymmetric t4 (MulType t1 t2),+          CanAddAsymmetric (AddType t4 (MulType t1 t2)) Integer,+          CanSqrt (AddType (AddType t4 (MulType t1 t2)) Integer)) =>+         t4+         -> t1+         -> t2+         -> SqrtType (AddType (AddType t4 (MulType t1 t2)) Integer)+      @++    * Due to limitations of some versions of ghc, type inferrence sometimes fails.+      Eg @add1 = (+ 1)@ fails (eg with ghc 8.0.2) unless we explicitly declare the type+      @add1 :: (CanAdd Integer t) => t -> AddType t Integer@+      or use an explicit parameter, eg @add1 x = x + 1@.++    = Origin++    The idea of having numeric expressions in Haskell with types+    derived bottom-up was initially suggested and implemented by Pieter Collins.+    This version is a fresh rewrite by Michal Konečný.++    = More details++    This module facilitates a single-line import for the package+    mixed-types-num.  See the re-exported modules for further details.+-}+module MixedTypesNumPrelude+(+  -- * Re-exporting Prelude, hiding the operators we are changing+  module Numeric.MixedTypes.PreludeHiding,+  -- * Modules with Prelude alternatives+  module Numeric.MixedTypes.Literals,+  module Numeric.MixedTypes.Bool,+  module Numeric.MixedTypes.Eq,+  module Numeric.MixedTypes.Ord,+  module Numeric.MixedTypes.MinMaxAbs,+  module Numeric.MixedTypes.AddSub,+  module Numeric.MixedTypes.Round,+  module Numeric.MixedTypes.Ring,+  module Numeric.MixedTypes.Field,+  (%),+  module Numeric.MixedTypes.Elementary,+  module Numeric.CollectErrors,+  module Utils.TH.DeclForTypes+)+where++import Data.Ratio ((%))+import Utils.TH.DeclForTypes+import Numeric.CollectErrors+import Numeric.MixedTypes.PreludeHiding+import Numeric.MixedTypes.Literals+import Numeric.MixedTypes.Bool+import Numeric.MixedTypes.Eq+import Numeric.MixedTypes.Ord+import Numeric.MixedTypes.MinMaxAbs+import Numeric.MixedTypes.AddSub+import Numeric.MixedTypes.Round+import Numeric.MixedTypes.Ring+import Numeric.MixedTypes.Field+import Numeric.MixedTypes.Elementary+import Numeric.MixedTypes.Complex ()

@@ -0,0 +1,128 @@+{-|+    Module      :  Numeric.CollectErrors+    Description :  A type of numeric errors to be collected+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    A type of numeric errors to be collected.+-}+module Numeric.CollectErrors+(+  -- * Describing numeric errors+  ErrorCertaintyLevel(..), NumError(..), NumErrors, sample_NumErrors+  -- * Specialisation to numeric errors+, CN, CanEnsureCN, EnsureCN, EnsureNoCN+, ensureCN, deEnsureCN, ensureNoCN+, noValueCN+, noValueNumErrorCertainCN, noValueNumErrorPotentialCN+, getMaybeValueCN, getErrorsCN, prependErrorsCN+, noValueECN+, noValueNumErrorCertainECN, noValueNumErrorPotentialECN+  -- ** More compact synonyms+, cn, deCN, (~!)+)+where++import Prelude (Show(..), Eq(..), String, Maybe(..), Either(..), (++))++import Control.CollectErrors++data NumError =+    DivByZero | OutOfRange String | NumError String+    deriving (Eq)++instance Show NumError where+  show DivByZero = "division by 0"+  show (OutOfRange s) = "out of range: " ++ s+  show (NumError s) = "numeric error: " ++ s++data ErrorCertaintyLevel =+  ErrorCertain | ErrorPotential+  deriving (Eq)++instance Show ErrorCertaintyLevel where+  show ErrorCertain = "ERROR"+  show ErrorPotential = "POTENTIAL ERROR"++type NumErrors = [(ErrorCertaintyLevel, NumError)]++sample_NumErrors :: Maybe [(ErrorCertaintyLevel, NumError)]+sample_NumErrors = Nothing++type CN = CollectErrors NumErrors+type CanEnsureCN = CanEnsureCE NumErrors+type EnsureCN a = EnsureCE NumErrors a+type EnsureNoCN a = EnsureNoCE NumErrors a++{-|+  Translate a value of a type @a@+  to a value of a type @CollectNumErrors a@ except when @a@+  already is a @CollectNumErrors@ type, in which case the value is left as is.+-}+ensureCN :: (CanEnsureCN v) => v -> EnsureCN v+ensureCN = ensureCE sample_NumErrors++{-|+  Translate a value of a type @EnsureCN es a@ to @a@,+  throwing an exception if there was an error.+  If @a@ is a @CollectNumErrors@ type, then this is just an identity.+-}+deEnsureCN :: (CanEnsureCN v) => EnsureCN v -> Either NumErrors v+deEnsureCN = deEnsureCE sample_NumErrors++{-|+  Translate a value of a type @a@+  to a value of a type @CollectNumErrors a@ except when @a@+  already is a @CollectNumErrors@ type, in which case the value is left as is.+-}+ensureNoCN :: (CanEnsureCN v) => v -> Either NumErrors (EnsureNoCN v)+ensureNoCN = ensureNoCE sample_NumErrors++noValueECN :: (CanEnsureCN v) => Maybe v -> NumErrors -> EnsureCN v+noValueECN = noValueECE++{-| Construct an empty wrapper indicating that given error has certainly occurred. -}+noValueNumErrorCertainECN :: (CanEnsureCN v) => Maybe v -> NumError -> EnsureCN v+noValueNumErrorCertainECN sample_v e = noValueECE sample_v [(ErrorCertain, e)]++{-| Construct an empty wrapper indicating that given error may have occurred. -}+noValueNumErrorPotentialECN :: (CanEnsureCN v) => Maybe v -> NumError -> EnsureCN v+noValueNumErrorPotentialECN sample_v e = noValueECE sample_v [(ErrorPotential, e)]++getErrorsCN :: CN v -> NumErrors+getErrorsCN = getErrorsCE++getMaybeValueCN :: CN v -> Maybe v+getMaybeValueCN = getMaybeValueCE++noValueCN :: NumErrors -> CN v+noValueCN = noValueCE++{-| Construct an empty wrapper indicating that given error has certainly occurred. -}+noValueNumErrorCertainCN :: NumError -> CN v+noValueNumErrorCertainCN e = noValueCN [(ErrorCertain, e)]++{-| Construct an empty wrapper indicating that given error may have occurred. -}+noValueNumErrorPotentialCN :: NumError -> CN v+noValueNumErrorPotentialCN e = noValueCN [(ErrorPotential, e)]++prependErrorsCN :: NumErrors -> CN v -> CN v+prependErrorsCN = prependErrorsCE++-- more compact synonyms:++{-| Wrap a value in the 'CollectNumErrors' wrapper. -}+cn :: (CanEnsureCN v) => v -> EnsureCN v+cn = ensureCN++{-| An unsafe way to get a value out of the CollectNumErrors wrapper. -}+deCN :: (CanEnsureCN v) => EnsureCN v -> Either NumErrors v+deCN = deEnsureCN++{-| An unsafe way to get a value out of the CollectNumErrors wrapper. -}+(~!) :: (CanEnsureCN v, Show v) => v -> EnsureNoCN v+(~!) = getValueOrThrowErrorsNCE sample_NumErrors

@@ -1,134 +0,0 @@-{-|-    Module      :  Numeric.MixedType-    Description :  Bottom-up typed numeric expressions-    Copyright   :  (c) Michal Konecny, Pieter Collins-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    = Main purpose--    This package provides a version of Prelude where-    unary and binary operations such as @not@, @+@, @==@-    have their result type derived from the parameter type(s),-    allowing, /e.g./:--      * dividing an integer by an integer, giving a rational:--      @let n = 1 :: Integer in n/(n+1) :: Rational@--      @1/2 :: Rational@--      (The type Rational would be derived automatically because-      integer literals are always of type @Integer@, not @Num t => t@.)--      * adding an integer and a rational, giving a rational:--      @(length [x])+1/3 :: Rational@--      * taking natural, integer and fractional power using the same operator:--      @2^2 :: Integer@--      @2.0^(-2) :: Rational@--      @(double 2)^(1/2) :: Double@--      The following examples require package <https://github.com/michalkonecny/aern2/aern2-real aern2-real>:--      @2^(1/2) :: CauchyReal@--      @pi :: CauchyReal@--      @sqrt 2 :: CauchyReal@--      * comparing an integer with an (exact) real number, giving a @Maybe Bool@:--      @... x :: CauchyReal ... if (isCertainlyTrue (x > 1)) then ...@--    = Type classes--    Arithmetic operations are provided via multi-parameter type classes-    and the result type is given by associated-    type families. For example:--    @(+) :: (CanAddAsymmetric t1 t2) => t1 -> t2 -> AddType t1 t2@--    The type constraint @CanAdd t1 t2@ implies both-    @CanAddAsymmetric t1 t2@ and @CanAddAsymmetric t2 t1@.--    For convenience there are other aggregate type constraints such as-    @CanAddThis t1 t2@, which implies that the result is of type @t1@,-    and @CanAddSameType t@, which is a shortcut for @CanAddThis t t@.--    == Testable specification--    The arithmetic type classes are accompanied by generic hspec test suites,-    which are specialised to concrete instance types for their testing.-    These test suites include the expected algebraic properties of operations,-    such as commutativity and associativity of addition.--    = Limitations--    * Not all numerical operations are supported yet.-      Eg @tan@, @atan@ are missing at the moment.--    * Inferred types can be very large. Eg for @f a b c = sqrt (a + b * c + 1)@ the inferred type is:--      @-      f: (CanMulAsymmetric t1 t2, CanAddAsymmetric t4 (MulType t1 t2),-          CanAddAsymmetric (AddType t4 (MulType t1 t2)) Integer,-          CanSqrt (AddType (AddType t4 (MulType t1 t2)) Integer)) =>-         t4-         -> t1-         -> t2-         -> SqrtType (AddType (AddType t4 (MulType t1 t2)) Integer)-      @--    * Due to limitations of some versions of ghc, type inferrence sometimes fails.-      Eg @add1 = (+ 1)@ fails (eg with ghc 8.0.2) unless we explicitly declare the type-      @add1 :: (CanAdd Integer t) => t -> AddType t Integer@-      or use an explicit parameter, eg @add1 x = x + 1@.--    = Origin--    The idea of having numeric expressions in Haskell with types-    derived bottom-up was initially suggested and implemented by Pieter Collins.-    This version is a fresh rewrite by Michal Konečný.--    = More details--    This module facilitates a single-line import for the package-    mixed-types-num.  See the re-exported modules for further details.--}-module Numeric.MixedTypes-(-  -- ** Re-exporting Prelude, hiding the operators we are changing-  module Numeric.MixedTypes.PreludeHiding,-  -- ** Modules with Prelude alternatives-  module Numeric.MixedTypes.Literals,-  module Numeric.MixedTypes.Bool,-  module Numeric.MixedTypes.Eq,-  module Numeric.MixedTypes.Ord,-  module Numeric.MixedTypes.MinMaxAbs,-  module Numeric.MixedTypes.AddSub,-  module Numeric.MixedTypes.Round,-  module Numeric.MixedTypes.Ring,-  module Numeric.MixedTypes.Field,-  module Numeric.MixedTypes.Elementary-)-where--import Numeric.MixedTypes.PreludeHiding-import Numeric.MixedTypes.Literals-import Numeric.MixedTypes.Bool-import Numeric.MixedTypes.Eq-import Numeric.MixedTypes.Ord-import Numeric.MixedTypes.MinMaxAbs-import Numeric.MixedTypes.AddSub-import Numeric.MixedTypes.Round-import Numeric.MixedTypes.Ring-import Numeric.MixedTypes.Field-import Numeric.MixedTypes.Elementary

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.AddSub     Description :  Bottom-up typed addition and subtraction@@ -25,6 +26,8 @@ ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -34,6 +37,9 @@ import Test.Hspec import Test.QuickCheck +-- import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool (CanNeg(..)) import Numeric.MixedTypes.Eq@@ -62,6 +68,9 @@ (+) :: (CanAddAsymmetric t1 t2) => t1 -> t2 -> AddType t1 t2 (+) = add +(-) :: (CanSub t1 t2) => t1 -> t2 -> SubType t1 t2+(-) = sub+ type CanAddThis t1 t2 =   (CanAdd t1 t2, AddType t1 t2 ~ t1) type CanAddSameType t =@@ -188,24 +197,24 @@  instance CanAddAsymmetric Int Double where   type AddType Int Double = Double-  add = convertFirst add+  add n d = add (double n) d instance CanAddAsymmetric Double Int where   type AddType Double Int = Double-  add = convertSecond add+  add d n = add d (double n)  instance CanAddAsymmetric Integer Double where   type AddType Integer Double = Double-  add = convertFirst add+  add n d = add (double n) d instance CanAddAsymmetric Double Integer where   type AddType Double Integer = Double-  add = convertSecond add+  add d n = add d (double n)  instance CanAddAsymmetric Rational Double where   type AddType Rational Double = Double-  add = convertFirst add+  add n d = add (double n) d instance CanAddAsymmetric Double Rational where   type AddType Double Rational = Double-  add = convertSecond add+  add d n = add d (double n)  instance (CanAddAsymmetric a b) => CanAddAsymmetric [a] [b] where   type AddType [a] [b] = [AddType a b]@@ -217,6 +226,19 @@   add (Just x) (Just y) = Just (add x y)   add _ _ = Nothing +instance+  (CanAddAsymmetric a b+  , CanEnsureCE es   (AddType a b)+  , SuitableForCE es)+  =>+  CanAddAsymmetric (CollectErrors es a) (CollectErrors es  b)+  where+  type AddType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (AddType a b)+  add = lift2CE add++-- TH for ground type instances at is the end of the file due to a bug in TH+ {---- Subtraction -----}  {-|@@ -237,9 +259,6 @@     t1 -> t2 -> SubType t1 t2   a `sub` b = a + (negate b) -(-) :: (CanSub t1 t2) => t1 -> t2 -> SubType t1 t2-(-) = sub- type CanSubThis t1 t2 =   (CanSub t1 t2, SubType t1 t2 ~ t1) type CanSubSameType t =@@ -325,24 +344,24 @@  instance CanSub Int Double where   type SubType Int Double = Double-  sub = convertFirst sub+  sub n d = sub (double n) d instance CanSub Double Int where   type SubType Double Int = Double-  sub = convertSecond sub+  sub d n = sub d (double n)  instance CanSub Integer Double where   type SubType Integer Double = Double-  sub = convertFirst sub+  sub n d = sub (double n) d instance CanSub Double Integer where   type SubType Double Integer = Double-  sub = convertSecond sub+  sub d n = sub d (double n)  instance CanSub Rational Double where   type SubType Rational Double = Double-  sub = convertFirst sub+  sub n d = sub (double n) d instance CanSub Double Rational where   type SubType Double Rational = Double-  sub = convertSecond sub+  sub d n = sub d (double n)  instance (CanSub a b) => CanSub [a] [b] where   type SubType [a] [b] = [SubType a b]@@ -353,3 +372,65 @@   type SubType (Maybe a) (Maybe b) = Maybe (SubType a b)   sub (Just x) (Just y) = Just (sub x y)   sub _ _ = Nothing+++instance+  (CanSub a b+  , CanEnsureCE es (SubType a b)+  , SuitableForCE es)+  =>+  CanSub (CollectErrors es a) (CollectErrors es  b)+  where+  type SubType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (SubType a b)+  sub = lift2CE sub+++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (CanSub $t b+      , CanEnsureCE es (SubType $t b)+      , SuitableForCE es)+      =>+      CanSub $t (CollectErrors es  b)+      where+      type SubType $t (CollectErrors es  b) =+        EnsureCE es (SubType $t b)+      sub = lift2TLCE sub++    instance+      (CanSub a $t+      , CanEnsureCE es (SubType a $t)+      , SuitableForCE es)+      =>+      CanSub (CollectErrors es a) $t+      where+      type SubType (CollectErrors es  a) $t =+        EnsureCE es (SubType a $t)+      sub = lift2TCE sub++    instance+      (CanAddAsymmetric $t b+      , CanEnsureCE es (AddType $t b)+      , SuitableForCE es)+      =>+      CanAddAsymmetric $t (CollectErrors es  b)+      where+      type AddType $t (CollectErrors es  b) =+        EnsureCE es (AddType $t b)+      add = lift2TLCE add++    instance+      (CanAddAsymmetric a $t+      , CanEnsureCE es (AddType a $t)+      , SuitableForCE es)+      =>+      CanAddAsymmetric (CollectErrors es a) $t+      where+      type AddType (CollectErrors es  a) $t =+        EnsureCE es (AddType a $t)+      add = lift2TCE add+  |]))

@@ -35,6 +35,9 @@  import qualified Data.List as List +-- import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals  import Test.Hspec@@ -44,7 +47,7 @@ import qualified Test.SmallCheck.Series as SCS -- import Control.Exception (evaluate) -type HasBools t = ConvertibleExactly Bool t+type HasBools t = (ConvertibleExactly Bool t)  {-|   Tests for truth or falsity.  Beware, when @isCertainlyTrue@ returns @False@,@@ -118,6 +121,13 @@   isCertainlyFalse (Just b) = isCertainlyFalse b   isCertainlyFalse _ = False +instance (CanTestCertainly t, SuitableForCE es) => CanTestCertainly (CollectErrors es t) where+  isCertainlyTrue vCE =+    getValueIfNoErrorCE vCE isCertainlyTrue (const False)+  isCertainlyFalse vCE =+    getValueIfNoErrorCE vCE isCertainlyFalse (const False)++ {---- Negation ----}  {-|@@ -137,7 +147,8 @@ not :: (CanNeg t) => t -> NegType t not = negate -type CanNegSameType t = (CanNeg t, NegType t ~ t)+type CanNegSameType t =+  (CanNeg t, NegType t ~ t)  {-| Compound type constraint useful for test definition. -} type CanTestCertainlyX t = (CanTestCertainly t, Show t, SCS.Serial IO t)@@ -174,6 +185,13 @@ _testNeg1 :: Maybe Bool _testNeg1 = not (Just True) +instance+  (CanNeg t, SuitableForCE es, CanEnsureCE es (NegType t))+  =>+  CanNeg (CollectErrors es t) where+  type NegType (CollectErrors es t) = EnsureCE es (NegType t)+  negate = lift1CE negate+ {---- And/Or ----}  type CanAndOr t1 t2 =@@ -331,14 +349,36 @@ _testAndOr3 :: Maybe Bool _testAndOr3 = and [Just True, Nothing, Just False] +instance (CanAndOrAsymmetric t1 t2, SuitableForCE es, CanEnsureCE es (AndOrType t1 t2)) =>+  CanAndOrAsymmetric (CollectErrors es t1) (CollectErrors es t2)+  where+  type AndOrType (CollectErrors es t1) (CollectErrors es t2) = EnsureCE es (AndOrType t1 t2)+  and2 = lift2CE and2+  or2 = lift2CE or2++instance (CanAndOrAsymmetric t1 Bool, SuitableForCE es, CanEnsureCE es (AndOrType t1 Bool)) =>+  CanAndOrAsymmetric (CollectErrors es t1) Bool+  where+  type AndOrType (CollectErrors es t1) Bool = EnsureCE es (AndOrType t1 Bool)+  and2 = lift2TCE and2+  or2 = lift2TCE or2++instance (CanAndOrAsymmetric Bool t2, SuitableForCE es, CanEnsureCE es (AndOrType Bool t2)) =>+  CanAndOrAsymmetric Bool (CollectErrors es t2)+  where+  type AndOrType Bool (CollectErrors es t2) = EnsureCE es (AndOrType Bool t2)+  and2 = lift2TLCE and2+  or2 = lift2TLCE or2+ {-|   A type constraint synonym that stipulates that the type behaves very   much like Bool, except it does not necessarily satisfy the law of excluded middle,   which means that the type can contain a "do-not-know" value. -  Examples: @Bool@, @Maybe Bool@, @Maybe (Maybe Bool)@+  Examples: @Bool@, @Maybe Bool@, @Maybe (Maybe Bool)@, @CollectErrors Bool@ -}-type IsBool t = (HasBools t, CanNegSameType t, CanAndOrSameType t)+type IsBool t =+  (HasBools t, CanNegSameType t, CanAndOrSameType t)  {-|   HSpec properties that each implementation of IsBool should satisfy.

@@ -0,0 +1,349 @@+{-|+    Module      :  Numeric.MixedType.Complex+    Description :  Instances for Data.Complex+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Instances for "Data.Complex".+-}++module Numeric.MixedTypes.Complex+(+)+where++import Numeric.MixedTypes.PreludeHiding+-- import qualified Prelude as P+-- import Text.Printf++import Data.Complex++import Numeric.MixedTypes.Literals+import Numeric.MixedTypes.Bool+import Numeric.MixedTypes.Eq+import Numeric.MixedTypes.MinMaxAbs+import Numeric.MixedTypes.AddSub+import Numeric.MixedTypes.Ring+import Numeric.MixedTypes.Field+import Numeric.MixedTypes.Elementary++instance (ConvertibleExactly Integer t) => (ConvertibleExactly Integer (Complex t))+  where+  safeConvertExactly n =+    do+    nT <- safeConvertExactly n+    zT <- safeConvertExactly 0+    return $ nT :+ zT++instance (ConvertibleExactly Int t) => (ConvertibleExactly Int (Complex t))+  where+  safeConvertExactly n =+    do+    nT <- safeConvertExactly n+    zT <- safeConvertExactly (int 0)+    return $ nT :+ zT++instance (ConvertibleExactly Rational t) => (ConvertibleExactly Rational (Complex t))+  where+  safeConvertExactly r =+    do+    rT <- safeConvertExactly r+    zT <- safeConvertExactly 0.0+    return $ rT :+ zT++instance (ConvertibleExactly t1 t2) => (ConvertibleExactly (Complex t1) (Complex t2))+  where+  safeConvertExactly (a1 :+ i1) =+    do+    a2 <- safeConvertExactly a1+    i2 <- safeConvertExactly i1+    return $ a2 :+ i2++instance (HasEqAsymmetric a b) => HasEqAsymmetric (Complex a) (Complex b) where+  type EqCompareType (Complex a) (Complex b) = EqCompareType a b+  equalTo (a1 :+ i1) (a2 :+ i2) = (a1 == a2) && (i1 == i2)++instance (HasEqAsymmetric Integer b) => HasEqAsymmetric Integer (Complex b) where+  type EqCompareType Integer (Complex b) = EqCompareType Integer b+  equalTo n (a2 :+ i2) = (n == a2) && (0 == i2)++instance (HasEqAsymmetric a Integer) => HasEqAsymmetric (Complex a) Integer where+  type EqCompareType (Complex a) Integer = EqCompareType a Integer+  equalTo (a1 :+ i1) n = (a1 == n) && (i1 == 0)++instance (HasEqAsymmetric Rational b) => HasEqAsymmetric Rational (Complex b) where+  type EqCompareType Rational (Complex b) = EqCompareType Rational b+  equalTo n (a2 :+ i2) = (n == a2) && (0.0 == i2)++instance (HasEqAsymmetric a Rational) => HasEqAsymmetric (Complex a) Rational where+  type EqCompareType (Complex a) Rational = EqCompareType a Rational+  equalTo (a1 :+ i1) n = (a1 == n) && (i1 == 0.0)++instance (HasEqAsymmetric Int b) => HasEqAsymmetric Int (Complex b) where+  type EqCompareType Int (Complex b) = EqCompareType Int b+  equalTo n (a2 :+ i2) = (n == a2) && ((int 0) == i2)++instance (HasEqAsymmetric a Int) => HasEqAsymmetric (Complex a) Int where+  type EqCompareType (Complex a) Int = EqCompareType a Int+  equalTo (a1 :+ i1) n = (a1 == n) && (i1 == (int 0))++instance (HasEqAsymmetric Double b) => HasEqAsymmetric Double (Complex b) where+  type EqCompareType Double (Complex b) = EqCompareType Double b+  equalTo n (a2 :+ i2) = (n == a2) && ((double 0) == i2)++instance (HasEqAsymmetric a Double) => HasEqAsymmetric (Complex a) Double where+  type EqCompareType (Complex a) Double = EqCompareType a Double+  equalTo (a1 :+ i1) n = (a1 == n) && (i1 == (double 0))++instance (CanTestInteger t, CanTestZero t) => CanTestInteger (Complex t) where+  certainlyNotInteger (a :+ i) =+    certainlyNotInteger a || isCertainlyNonZero i+  certainlyIntegerGetIt (a :+ i) =+    case (certainlyIntegerGetIt a, certainlyIntegerGetIt i) of+      (Just aN, Just iN) | iN == 0 -> Just aN+      _ -> Nothing++instance CanNeg t => CanNeg (Complex t) where+  type NegType (Complex t) = Complex (NegType t)+  negate (a :+ i) = (negate a) :+ (negate i)++instance (CanAddAsymmetric a b) => CanAddAsymmetric (Complex a) (Complex b) where+  type AddType (Complex a) (Complex b) = Complex (AddType a b)+  add (a1 :+ i1) (a2 :+ i2) = (a1 + a2) :+ (i1 + i2)++instance (CanAddAsymmetric Integer b) => CanAddAsymmetric Integer (Complex b) where+  type AddType Integer (Complex b) = Complex (AddType Integer b)+  add n (a2 :+ i2) = (n + a2) :+ (0 + i2)++instance (CanAddAsymmetric a Integer) => CanAddAsymmetric (Complex a) Integer where+  type AddType (Complex a) Integer = Complex (AddType a Integer)+  add (a1 :+ i1) n = (a1 + n) :+ (i1 + 0)++instance (CanAddAsymmetric Rational b) => CanAddAsymmetric Rational (Complex b) where+  type AddType Rational (Complex b) = Complex (AddType Rational b)+  add n (a2 :+ i2) = (n + a2) :+ (0.0 + i2)++instance (CanAddAsymmetric a Rational) => CanAddAsymmetric (Complex a) Rational where+  type AddType (Complex a) Rational = Complex (AddType a Rational)+  add (a1 :+ i1) n = (a1 + n) :+ (i1 + 0.0)++instance (CanAddAsymmetric Int b) => CanAddAsymmetric Int (Complex b) where+  type AddType Int (Complex b) = Complex (AddType Int b)+  add n (a2 :+ i2) = (n + a2) :+ ((int 0) + i2)++instance (CanAddAsymmetric a Int) => CanAddAsymmetric (Complex a) Int where+  type AddType (Complex a) Int = Complex (AddType a Int)+  add (a1 :+ i1) n = (a1 + n) :+ (i1 + (int 0))++instance (CanAddAsymmetric Double b) => CanAddAsymmetric Double (Complex b) where+  type AddType Double (Complex b) = Complex (AddType Double b)+  add n (a2 :+ i2) = (n + a2) :+ ((double 0) + i2)++instance (CanAddAsymmetric a Double) => CanAddAsymmetric (Complex a) Double where+  type AddType (Complex a) Double = Complex (AddType a Double)+  add (a1 :+ i1) n = (a1 + n) :+ (i1 + (double 0))++instance (CanSub a b) => CanSub (Complex a) (Complex b) where+  type SubType (Complex a) (Complex b) = Complex (SubType a b)+  sub (a1 :+ i1) (a2 :+ i2) = (a1 - a2) :+ (i1 - i2)++instance (CanSub Integer b) => CanSub Integer (Complex b) where+  type SubType Integer (Complex b) = Complex (SubType Integer b)+  sub n (a2 :+ i2) = (n - a2) :+ (0 - i2)++instance (CanSub a Integer) => CanSub (Complex a) Integer where+  type SubType (Complex a) Integer = Complex (SubType a Integer)+  sub (a1 :+ i1) n = (a1 - n) :+ (i1 - 0)++instance (CanSub Rational b) => CanSub Rational (Complex b) where+  type SubType Rational (Complex b) = Complex (SubType Rational b)+  sub n (a2 :+ i2) = (n - a2) :+ (0.0 - i2)++instance (CanSub a Rational) => CanSub (Complex a) Rational where+  type SubType (Complex a) Rational = Complex (SubType a Rational)+  sub (a1 :+ i1) n = (a1 - n) :+ (i1 - 0.0)++instance (CanSub Int b) => CanSub Int (Complex b) where+  type SubType Int (Complex b) = Complex (SubType Int b)+  sub n (a2 :+ i2) = (n - a2) :+ ((int 0) - i2)++instance (CanSub a Int) => CanSub (Complex a) Int where+  type SubType (Complex a) Int = Complex (SubType a Int)+  sub (a1 :+ i1) n = (a1 - n) :+ (i1 - (int 0))++instance (CanSub Double b) => CanSub Double (Complex b) where+  type SubType Double (Complex b) = Complex (SubType Double b)+  sub n (a2 :+ i2) = (n - a2) :+ ((double 0) - i2)++instance (CanSub a Double) => CanSub (Complex a) Double where+  type SubType (Complex a) Double = Complex (SubType a Double)+  sub (a1 :+ i1) n = (a1 - n) :+ (i1 - (double 0))++instance+  (CanMulAsymmetric a b+  , CanAddSameType (MulType a b), CanSubSameType (MulType a b))+  =>+  CanMulAsymmetric (Complex a) (Complex b)+  where+  type MulType (Complex a) (Complex b) = Complex (MulType a b)+  mul (a1 :+ i1) (a2 :+ i2) =+    (a1*a2 - i1*i2) :+ (a1*i2 + i1*a2)++instance+  (CanMulAsymmetric Integer b) => CanMulAsymmetric Integer (Complex b)+  where+  type MulType Integer (Complex b) = Complex (MulType Integer b)+  mul n (a2 :+ i2) = (n*a2) :+ (n*i2)++instance+  (CanMulAsymmetric a Integer) => CanMulAsymmetric (Complex a) Integer+  where+  type MulType (Complex a) Integer = Complex (MulType a Integer)+  mul (a1 :+ i1) n = (a1*n) :+ (i1*n)++instance+  (CanMulAsymmetric Int b) => CanMulAsymmetric Int (Complex b)+  where+  type MulType Int (Complex b) = Complex (MulType Int b)+  mul n (a2 :+ i2) = (n*a2) :+ (n*i2)++instance+  (CanMulAsymmetric a Int) => CanMulAsymmetric (Complex a) Int+  where+  type MulType (Complex a) Int = Complex (MulType a Int)+  mul (a1 :+ i1) n = (a1*n) :+ (i1*n)++instance+  (CanMulAsymmetric Rational b) => CanMulAsymmetric Rational (Complex b)+  where+  type MulType Rational (Complex b) = Complex (MulType Rational b)+  mul n (a2 :+ i2) = (n*a2) :+ (n*i2)++instance+  (CanMulAsymmetric a Rational) => CanMulAsymmetric (Complex a) Rational+  where+  type MulType (Complex a) Rational = Complex (MulType a Rational)+  mul (a1 :+ i1) n = (a1*n) :+ (i1*n)++instance+  (CanMulAsymmetric Double b) => CanMulAsymmetric Double (Complex b)+  where+  type MulType Double (Complex b) = Complex (MulType Double b)+  mul n (a2 :+ i2) = (n*a2) :+ (n*i2)++instance+  (CanMulAsymmetric a Double) => CanMulAsymmetric (Complex a) Double+  where+  type MulType (Complex a) Double = Complex (MulType a Double)+  mul (a1 :+ i1) n = (a1*n) :+ (i1*n)++instance+  (CanMulAsymmetric a b+  , CanAddSameType (MulType a b), CanSubSameType (MulType a b)+  , CanMulAsymmetric b b, CanAddSameType (MulType b b)+  , CanDiv (MulType a b) (MulType b b))+  =>+  CanDiv (Complex a) (Complex b)+  where+  type DivType (Complex a) (Complex b) = Complex (DivType (MulType a b) (MulType b b))+  divide (a1 :+ i1) (a2 :+ i2) =+    let d = a2*a2 + i2*i2 in+    ((a1*a2 + i1*i2)/d) :+ ((i1*a2-a1*i2)/d)++instance+  (CanMulAsymmetric Integer b+  , CanMulAsymmetric b b, CanAddSameType (MulType b b)+  , CanDiv (MulType Integer b) (MulType b b))+  =>+  CanDiv Integer (Complex b)+  where+  type DivType Integer (Complex b) = Complex (DivType (MulType Integer b) (MulType b b))+  divide n (a2 :+ i2) =+    let d = a2*a2 + i2*i2 in+    ((n*a2)/d) :+ (((-n)*i2)/d)++instance+  (CanMulAsymmetric Rational b+  , CanMulAsymmetric b b, CanAddSameType (MulType b b)+  , CanDiv (MulType Rational b) (MulType b b))+  =>+  CanDiv Rational (Complex b)+  where+  type DivType Rational (Complex b) = Complex (DivType (MulType Rational b) (MulType b b))+  divide n (a2 :+ i2) =+    let d = a2*a2 + i2*i2 in+    ((n*a2)/d) :+ (((-n)*i2)/d)++instance+  (CanMulAsymmetric Int b+  , CanMulAsymmetric b b, CanAddSameType (MulType b b)+  , CanDiv (MulType Int b) (MulType b b))+  =>+  CanDiv Int (Complex b)+  where+  type DivType Int (Complex b) = Complex (DivType (MulType Int b) (MulType b b))+  divide n (a2 :+ i2) =+    let d = a2*a2 + i2*i2 in+    ((n*a2)/d) :+ (((-n)*i2)/d)++instance+  (CanMulAsymmetric Double b+  , CanMulAsymmetric b b, CanAddSameType (MulType b b)+  , CanDiv (MulType Double b) (MulType b b))+  =>+  CanDiv Double (Complex b)+  where+  type DivType Double (Complex b) = Complex (DivType (MulType Double b) (MulType b b))+  divide n (a2 :+ i2) =+    let d = a2*a2 + i2*i2 in+    ((n*a2)/d) :+ (((-n)*i2)/d)++instance+  (CanDiv a Integer) => CanDiv (Complex a) Integer+  where+  type DivType (Complex a) Integer = Complex (DivType a Integer)+  divide (a1 :+ i1) n = (a1/n) :+ (i1/n)++instance+  (CanDiv a Int) => CanDiv (Complex a) Int+  where+  type DivType (Complex a) Int = Complex (DivType a Int)+  divide (a1 :+ i1) n = (a1/n) :+ (i1/n)++instance+  (CanDiv a Rational) => CanDiv (Complex a) Rational+  where+  type DivType (Complex a) Rational = Complex (DivType a Rational)+  divide (a1 :+ i1) n = (a1/n) :+ (i1/n)++instance+  (CanDiv a Double) => CanDiv (Complex a) Double+  where+  type DivType (Complex a) Double = Complex (DivType a Double)+  divide (a1 :+ i1) n = (a1/n) :+ (i1/n)++instance+  (CanMulAsymmetric t t+  , CanAddSameType (MulType t t)+  , CanSqrt (MulType t t))+  =>+  CanAbs (Complex t)+  where+  type AbsType (Complex t) = SqrtType (MulType t t)+  abs (a :+ i) = sqrt (a*a + i*i)++instance+  (CanExp t+  , CanSinCos t+  , CanMulAsymmetric (ExpType t) (SinCosType t))+  =>+  CanExp (Complex t)+  where+  type ExpType (Complex t) = Complex (MulType (ExpType t) (SinCosType t))+  exp (a :+ i) =+    let ea = exp a in+    (ea * cos i) :+ (ea * sin i)

@@ -13,11 +13,11 @@ module Numeric.MixedTypes.Elementary (   -- * Square root-  CanSqrt(..), CanSqrtSameType, specCanSqrtReal+  CanSqrt(..), CanSqrtSameType, CanSqrtCNSameType, specCanSqrtReal   -- * Exp   , CanExp(..), CanExpSameType, specCanExpReal   -- * Log-  , CanLog(..), CanLogSameType, specCanLogReal+  , CanLog(..), CanLogSameType, CanLogCNSameType, specCanLogReal   , powUsingExpLog   -- * Sine and cosine   , CanSinCos(..), CanSinCosSameType, specCanSinCosReal@@ -34,6 +34,9 @@ import Test.Hspec import Test.QuickCheck +import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq@@ -57,6 +60,7 @@   sqrt = P.sqrt  type CanSqrtSameType t = (CanSqrt t, SqrtType t ~ t)+type CanSqrtCNSameType t = (CanSqrt t, SqrtType t ~ EnsureCN t)  type CanSqrtX t =   (CanSqrt t,@@ -99,6 +103,17 @@  instance CanSqrt Double -- not exact, will not pass the tests +instance+  (CanSqrt a+  , CanEnsureCE es (SqrtType a)+  , SuitableForCE es)+  =>+  CanSqrt (CollectErrors es a)+  where+  type SqrtType (CollectErrors es a) = EnsureCE es (SqrtType a)+  sqrt = lift1CE sqrt++ {----  exp -----}  {-|@@ -120,10 +135,11 @@    Field (ExpType t),    CanTestPosNeg t,    CanTestPosNeg (ExpType t),-   HasEqCertainly (ExpType t) (ExpType t),+   HasEqCertainlyCN (ExpType t) (ExpType t),    HasOrderCertainly Integer t,    HasOrderCertainly Integer (ExpType t),-   Show t, Arbitrary t, Show (ExpType t))+   Show t, Arbitrary t, Show (ExpType t),+   Show (EnsureCN t), Show (EnsureCN (ExpType t)))  {-|   HSpec properties that each implementation of CanExp should satisfy.@@ -142,7 +158,7 @@       property $ \ (x :: t) ->         ((-100000) !<! x && x !<! 100000) ==>           (exp x !>! 0) ==>-            exp (-x) ?==?$ 1/(exp x)+            (ensureCN $ exp (-x)) ?==?$ 1/(exp x)     it "exp(x+y) = exp(x)*exp(y)" $ do       property $ \ (x :: t)  (y :: t) ->         ((-100000) !<! x && x !<! 100000 && (-100000) !<! y && y !<! 100000) ==>@@ -162,6 +178,16 @@  instance CanExp Double -- not exact, will not pass the tests +instance+  (CanExp a+  , CanEnsureCE es (ExpType a)+  , SuitableForCE es)+  =>+  CanExp (CollectErrors es a)+  where+  type ExpType (CollectErrors es a) = EnsureCE es (ExpType a)+  exp = lift1CE exp+ {----  log -----}  {-|@@ -176,12 +202,14 @@   log = P.log  type CanLogSameType t = (CanLog t, LogType t ~ t)+type CanLogCNSameType t = (CanLog t, LogType t ~ EnsureCN t)  type CanLogX t =   (CanLog t,    Field t,    Ring (LogType t),    HasOrderCertainly t Integer,+   HasOrderCertainlyCN t Integer,    HasEqCertainly (LogType t) (LogType t),    Show t, Arbitrary t, Show (LogType t)) @@ -192,7 +220,8 @@   (CanLogX t,    CanLogX (DivType Integer t),    CanExp t, CanLogX (ExpType t),-   HasEqCertainly t (LogType (ExpType t)))+   HasEqCertainly (LogType t) (LogType (EnsureCN t)),+   HasEqCertainlyCN t (LogType (ExpType t)))   =>   T t -> Spec specCanLogReal (T typeName :: T t) =@@ -221,46 +250,59 @@  instance CanLog Double -- not exact, will not pass the tests +instance+  (CanLog a+  , CanEnsureCE es (LogType a)+  , SuitableForCE es)+  =>+  CanLog (CollectErrors es a)+  where+  type LogType (CollectErrors es a) = EnsureCE es (LogType a)+  log = lift1CE log+ instance CanPow Double Double where   pow = (P.**)   -- pow = powUsingExpLog instance CanPow Double Rational where   type PowType Double Rational = Double-  pow x y = x ^ (double y)+  pow b e = b ^ (double e) instance CanPow Rational Double where   type PowType Rational Double = Double-  pow x y = (double x) ^ y+  pow b e = (double b) ^ e instance CanPow Integer Double where   type PowType Integer Double = Double-  pow x y = (double x) ^ y+  pow b e = (double b) ^ e instance CanPow Int Double where   type PowType Int Double = Double-  pow x y = (double x) ^ y+  pow b e = (double b) ^ e  powUsingExpLog ::-  (CanTestPosNeg t1,-   CanMulSameType t1,-   HasIntegers t1,-   CanTestZero t1,-   CanRecipSameType t1,-   CanTestInteger t2,-   CanTestPosNeg t2,-   CanMulAsymmetric (LogType t1) t2,-   CanLog t1,-   CanExp (MulType (LogType t1) t2),-   ExpType (MulType (LogType t1) t2) ~ t1)+  (CanTestPosNeg t,+   CanEnsureCN t,+   CanEnsureCN (EnsureCN t),+   EnsureCN t ~ EnsureCN (EnsureCN t),+   CanLogCNSameType t,+   CanMulSameType t,+   CanMulSameType (EnsureCN t),+   CanExpSameType (EnsureCN t),+   CanTestInteger t,+   HasIntegers t,+   CanTestZero t,+   CanRecipCNSameType t,+   HasIntegers (EnsureCN t))   =>-  t1 -> t2 -> ExpType (MulType (LogType t1) t2)-powUsingExpLog x y-  | isCertainlyPositive x = exp ((log x) * y)-  | otherwise =-    case certainlyIntegerGetIt y of-      Just n ->-        powUsingMulRecip x n-      Nothing ->-        if isCertainlyZero x && isCertainlyPositive y then convertExactly 0-          else-            error $ "powUsingExpLog: potential illegal power a^b with negative a and non-integer b"+  t -> t -> EnsureCN t+powUsingExpLog b e =+  case certainlyIntegerGetIt e of+    Just n ->+      powUsingMulRecip b n+    Nothing+      | isCertainlyZero b && isCertainlyPositive e -> convertExactly 0+      | isCertainlyNonNegative b -> exp ((log b) * (ensureCN e))+      | isCertainlyNegative b && certainlyNotInteger e -> noValueNumErrorCertainECN (Just b) err+      | otherwise -> noValueNumErrorPotentialECN (Just b) err+  where+  err = NumError "powUsingExpLog: illegal power a^b with negative a and non-integer b"  {----  sine and cosine -----} @@ -284,8 +326,9 @@   (CanSinCos t,    OrderedCertainlyField t,    OrderedCertainlyField (SinCosType t),-   HasOrderCertainly (SinCosType t) t,-   Show t, Arbitrary t, Show (SinCosType t))+   HasOrderCertainlyCN (SinCosType t) t,+   Show t, Arbitrary t, Show (SinCosType t),+   Show (EnsureCN t), Arbitrary t, Show (EnsureCN (SinCosType t)))  {-|   HSpec properties that each implementation of CanSinCos should satisfy.@@ -317,7 +360,7 @@     it "sin(x) < x < tan(x) for x in [0,pi/2]" $ do       property $ \ (x :: t) ->         x !>=! 0 && x !<=! 1.57 && (cos x) !>! 0 ==>-          (sin x) ?<=?$ x .&&. x ?<=?$ (sin x)/(cos x)+          (sin x) ?<=?$ x .&&. (ensureCN x) ?<=?$ (sin x)/(cos x)   where   infix 4 ?==?$   (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property@@ -332,6 +375,17 @@ -}  instance CanSinCos Double -- not exact, will not pass the tests++instance+  (CanSinCos a+  , CanEnsureCE es (SinCosType a)+  , SuitableForCE es)+  =>+  CanSinCos (CollectErrors es a)+  where+  type SinCosType (CollectErrors es a) = EnsureCE es (SinCosType a)+  sin = lift1CE sin+  cos = lift1CE cos  {-|   Approximate pi, synonym for Prelude's `P.pi`.

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.Eq     Description :  Bottom-up typed equality comparisons@@ -7,7 +8,6 @@     Maintainer  :  mikkonecny@gmail.com     Stability   :  experimental     Portability :  portable- -}  module Numeric.MixedTypes.Eq@@ -15,12 +15,14 @@   -- * Equality checks   HasEq,  HasEqAsymmetric(..), (==), (/=)   , HasEqCertainly, HasEqCertainlyAsymmetric+  , HasEqCertainlyCE, HasEqCertainlyCN   , notCertainlyDifferentFrom, certainlyEqualTo, certainlyNotEqualTo   , (?==?), (!==!), (!/=!)   -- ** Tests   , specHasEq, specHasEqNotMixed, HasEqX   , specConversion   -- ** Specific comparisons+  , CanTestNaN(..)   , CanTestFinite(..)   , CanTestInteger(..)   , CanTestZero(..), specCanTestZero@@ -28,6 +30,8 @@ ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -35,8 +39,10 @@  import Test.Hspec import Test.QuickCheck as QC-import Control.Exception (evaluate) +import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool @@ -56,6 +62,19 @@ type HasEqCertainly t1 t2 =   (HasEq t1 t2, CanTestCertainly (EqCompareType t1 t2)) +type HasEqCertainlyCE es t1 t2 =+  (HasEqCertainly t1 t2,+   HasEqCertainly (EnsureCE es t1) (EnsureCE es t2))+  --  HasEqCertainly (WithoutCE es t1) (WithoutCE es t2),+  --  CanTestCertainly (WithoutCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  IsBool (WithoutCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  CanEnsureCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2)),+  --  CanEnsureCE es (WithoutCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  WithoutCE es (WithoutCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2)))+  --    ~ (WithoutCE es (EqCompareType (WithoutCE es t1) (WithoutCE es t2))))++type HasEqCertainlyCN t1 t2 = HasEqCertainlyCE NumErrors t1 t2+ class (IsBool (EqCompareType a b)) => HasEqAsymmetric a b where     type EqCompareType a b     type EqCompareType a b = Bool -- default@@ -225,23 +244,80 @@   equalTo (Just x) (Just y) = (x == y)   equalTo _ _ = convertExactly False +instance+  (HasEqAsymmetric a b+  , CanEnsureCE es (EqCompareType a b)+  , IsBool (EnsureCE es (EqCompareType a b))+  , SuitableForCE es)+  =>+  HasEqAsymmetric (CollectErrors es a) (CollectErrors es  b)+  where+  type EqCompareType (CollectErrors es  a) (CollectErrors es  b) =+    EnsureCE es (EqCompareType a b)+  equalTo = lift2CE equalTo++$(declForTypes+  [[t| Bool |], [t| Maybe Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (HasEqAsymmetric $t b+      , CanEnsureCE es (EqCompareType $t b)+      , IsBool (EnsureCE es (EqCompareType $t b))+      , SuitableForCE es)+      =>+      HasEqAsymmetric $t (CollectErrors es  b)+      where+      type EqCompareType $t (CollectErrors es  b) =+        EnsureCE es (EqCompareType $t b)+      equalTo = lift2TLCE equalTo++    instance+      (HasEqAsymmetric a $t+      , CanEnsureCE es (EqCompareType a $t)+      , IsBool (EnsureCE es (EqCompareType a $t))+      , SuitableForCE es)+      =>+      HasEqAsymmetric (CollectErrors es a) $t+      where+      type EqCompareType (CollectErrors es  a) $t =+        EnsureCE es (EqCompareType a $t)+      equalTo = lift2TCE equalTo++  |]))++ {---- Checking whether it is finite -----} -class CanTestFinite t where+class CanTestNaN t where   isNaN :: t -> Bool   default isNaN :: (P.RealFloat t) => t -> Bool   isNaN = P.isNaN++class CanTestFinite t where   isInfinite :: t -> Bool   default isInfinite :: (P.RealFloat t) => t -> Bool   isInfinite = P.isInfinite   isFinite :: t -> Bool-  isFinite x = (not $ isNaN x) && (not $ isInfinite x)+  default isFinite :: (P.RealFloat t) => t -> Bool+  isFinite x = (not $ P.isNaN x) && (not $ P.isInfinite x) +instance CanTestNaN Double instance CanTestFinite Double-instance CanTestFinite Rational where++instance CanTestNaN Rational where   isNaN = const False+instance CanTestFinite Rational where   isInfinite = const False+  isFinite = const True +instance (CanTestNaN t, SuitableForCE es) => (CanTestNaN (CollectErrors es t)) where+  isNaN ce = getValueIfNoErrorCE ce isNaN (const False)++instance (CanTestFinite t, SuitableForCE es) => (CanTestFinite (CollectErrors es t)) where+  isInfinite ce = getValueIfNoErrorCE ce isInfinite (const False)+  isFinite ce = getValueIfNoErrorCE ce isFinite (const False)+ {---- Checking whether it is an integer -----}  class CanTestInteger t where@@ -278,15 +354,19 @@       dF = P.floor d       dC = P.ceiling d +instance (CanTestInteger t, SuitableForCE es) => (CanTestInteger (CollectErrors es t)) where+  certainlyNotInteger ce = getValueIfNoErrorCE ce certainlyNotInteger (const False)+  certainlyIntegerGetIt ce = getValueIfNoErrorCE ce certainlyIntegerGetIt (const Nothing)+ {---- Checking whether it is zero -----}  class CanTestZero t where   isCertainlyZero :: t -> Bool-  isNonZero :: t -> Bool+  isCertainlyNonZero :: t -> Bool   default isCertainlyZero :: (HasEqCertainly t Integer) => t -> Bool   isCertainlyZero a = isCertainlyTrue (a == 0)-  default isNonZero :: (HasEqCertainly t Integer) => t -> Bool-  isNonZero a = isCertainlyTrue (a /= 0)+  default isCertainlyNonZero :: (HasEqCertainly t Integer) => t -> Bool+  isCertainlyNonZero a = isCertainlyTrue (a /= 0)  {-|   HSpec properties that each implementation of CanTestZero should satisfy.@@ -300,17 +380,22 @@     it "converted non-zero Integer is not isCertainlyZero" $ do       property $ \ (x :: Integer) ->         x /= 0 ==> (not $ isCertainlyZero (convertExactly x :: t))-    it "converted non-zero Integer is isNonZero" $ do+    it "converted non-zero Integer is isCertainlyNonZero" $ do       property $ \ (x :: Integer) ->-        x /= 0 ==> (isNonZero (convertExactly x :: t))-    it "converted 0.0 is not isNonZero" $ do-      (isNonZero (convertExactly 0 :: t)) `shouldBe` False+        x /= 0 ==> (isCertainlyNonZero (convertExactly x :: t))+    it "converted 0.0 is not isCertainlyNonZero" $ do+      (isCertainlyNonZero (convertExactly 0 :: t)) `shouldBe` False  instance CanTestZero Int instance CanTestZero Integer instance CanTestZero Rational instance CanTestZero Double +instance (CanTestZero t, SuitableForCE es) => (CanTestZero (CollectErrors es t)) where+  isCertainlyZero ce = getValueIfNoErrorCE ce isCertainlyZero (const False)+  isCertainlyNonZero ce = getValueIfNoErrorCE ce isCertainlyNonZero (const False)++ class CanPickNonZero t where   {-|     Given a list @[(a1,b1),(a2,b2),...]@ and assuming that@@ -323,17 +408,12 @@     The default implementation is based on a `CanTestZero` instance     and is not parallel.    -}-  pickNonZero :: [(t,s)] -> (t,s)-  default pickNonZero :: (CanTestZero t, Show t) => [(t,s)] -> (t,s)-  pickNonZero list =-    case aux list of-      Just result -> result-      Nothing ->-        error $ "pickNonZero: failed to find a non-zero element in "-                  ++ show (map fst list)+  pickNonZero :: [(t,s)] -> Maybe (t,s)+  default pickNonZero :: (CanTestZero t, Show t) => [(t,s)] -> Maybe (t,s)+  pickNonZero list = aux list     where       aux ((a,b):rest)-        | isNonZero a = Just (a,b)+        | isCertainlyNonZero a = Just (a,b)         | otherwise = aux rest       aux [] = Nothing @@ -348,12 +428,23 @@   describe (printf "CanPickNonZero %s" typeName) $ do     it "picks a non-zero element if there is one" $ do       property $ \ (xs :: [(t, ())]) ->-        or (map (isNonZero . fst) xs) -- if at least one is non-zero-          ==> (isNonZero $ fst $ pickNonZero xs)-    it "throws exception when all the elements are 0" $ do-      (evaluate $ pickNonZero [(convertExactly i :: t, ()) | i <- [0,0,0]])-        `shouldThrow` anyException+        or (map (isCertainlyNonZero . fst) xs) -- if at least one is non-zero+        ==>+        (case pickNonZero xs of+          Just (v, _) -> isCertainlyNonZero v+          _ -> False)+    it "returns Nothing when all the elements are 0" $ do+      case pickNonZero [(convertExactly i :: t, ()) | i <- [0,0,0]] of+        Nothing -> True+        _ -> False  instance CanPickNonZero Int instance CanPickNonZero Integer instance CanPickNonZero Rational++instance (CanPickNonZero a, SuitableForCE es) => (CanPickNonZero (CollectErrors es a)) where+  pickNonZero =+    fmap (\(v,s) -> (pure v,s))+    . pickNonZero+    . filterValuesWithoutErrorCE+    . (map (\(vCN,s) -> fmap (\v -> (v,s)) vCN))

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.Field     Description :  Bottom-up typed division@@ -13,16 +14,19 @@ module Numeric.MixedTypes.Field (   -- * Field-  CanAddSubMulDivBy, Field, CertainlyEqField, OrderedField, OrderedCertainlyField+  CanAddSubMulDivCNBy, Field, CertainlyEqField, OrderedField, OrderedCertainlyField   -- * Division-  , CanDiv(..), CanDivBy, CanDivSameType, CanRecip, CanRecipSameType-  , (/), recip+  , CanDiv(..), CanDivBy, CanDivCNBy, CanDivSameType, CanDivCNSameType+  , CanRecip, CanRecipSameType, CanRecipCNSameType+  , (/), (/!), recip   , powUsingMulRecip   -- ** Tests   , specCanDiv, specCanDivNotMixed, CanDivX ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -32,6 +36,9 @@ import Test.Hspec import Test.QuickCheck +import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq@@ -42,23 +49,45 @@  {----- Field -----} -type CanAddSubMulDivBy t s =-  (CanAddSubMulBy t s, CanDivBy t s)+type CanAddSubMulDivCNBy t s =+  (CanAddSubMulBy t s, CanDivCNBy t s) -type Field t =-    (Ring t, CanDivSameType t, CanRecipSameType t,-     CanAddSubMulDivBy t Rational,-     CanAddSubMulDivBy t Integer,-     CanAddSubMulDivBy t Int+type FieldPre t =+    (Ring t,+     CanDivCNSameType t, CanRecipCNSameType t,+     CanAddSubMulDivCNBy t Rational,+     CanAddSubMulDivCNBy t Integer,+     CanAddSubMulDivCNBy t Int     ) -type CertainlyEqField t = (Field t, CertainlyEqRing t)+type Field t =+  (FieldPre t,+   CanEnsureCN t,+   FieldPre (EnsureCN t)) +type CertainlyEqFieldPre t =+  (FieldPre t, CertainlyEqRing t)++type CertainlyEqField t =+  (CertainlyEqFieldPre t,+   CanEnsureCN t,+   CertainlyEqFieldPre (EnsureCN t))++type OrderedFieldPre t =+  (FieldPre t, OrderedRing t, HasOrder t Rational)+ type OrderedField t =-  (Field t, OrderedRing t, HasOrder t Rational)+  (OrderedFieldPre t,+   CanEnsureCN t,+   OrderedFieldPre (EnsureCN t)) +type OrderedCertainlyFieldPre t =+  (CertainlyEqFieldPre t, OrderedCertainlyRing t, HasOrderCertainly t Rational)+ type OrderedCertainlyField t =-  (CertainlyEqField t, OrderedCertainlyRing t, HasOrderCertainly t Rational)+  (OrderedCertainlyFieldPre t,+   CanEnsureCN t,+   OrderedCertainlyFieldPre (EnsureCN t))  {---- Division -----} @@ -67,21 +96,46 @@   then one can use the default implementation to mirror Prelude's @/@. -} class CanDiv t1 t2 where+  type DivTypeNoCN t1 t2+  divideNoCN :: t1 -> t2 -> DivTypeNoCN t1 t2   type DivType t1 t2-  type DivType t1 t2 = t1 -- default+  type DivType t1 t2 = EnsureCN (DivTypeNoCN t1 t2)   divide :: t1 -> t2 -> DivType t1 t2-  default divide :: (DivType t1 t2 ~ t1, t1~t2, P.Fractional t1) => t1 -> t1 -> t1-  divide = (P./)+  default divide ::+    (CanTestZero t2, CanEnsureCN (DivTypeNoCN t1 t2))+    =>+    t1 -> t2 -> EnsureCN (DivTypeNoCN t1 t2)+  divide = divideCN divideNoCN +divideCN ::+  (CanTestZero t2, CanEnsureCN t3)+  =>+  (t1 -> t2 -> t3) ->+  t1 -> t2 -> EnsureCN t3+divideCN unsafeDivide a b+  | isCertainlyZero b = noValueNumErrorCertainECN sample_v DivByZero+  | isCertainlyNonZero b = ensureCN $ a `unsafeDivide` b+  | otherwise = noValueNumErrorPotentialECN sample_v DivByZero+  where+  sample_v = Just $ unsafeDivide a b++infixl 7  /,/!+ (/) :: (CanDiv t1 t2) => t1 -> t2 -> DivType t1 t2 (/) = divide +(/!) :: (CanDiv t1 t2) => t1 -> t2 -> DivTypeNoCN t1 t2+(/!) = divideNoCN+ type CanRecip t =   (CanDiv Integer t)  type CanRecipSameType t =   (CanDiv Integer t, DivType Integer t ~ t) +type CanRecipCNSameType t =+  (CanDiv Integer t, DivType Integer t ~ EnsureCN t)+ recip :: (CanRecip t) => t -> DivType Integer t recip = divide 1 @@ -90,6 +144,11 @@ type CanDivSameType t =   CanDivBy t t +type CanDivCNBy t1 t2 =+  (CanDiv t1 t2, DivType t1 t2 ~ EnsureCN t1)+type CanDivCNSameType t =+  CanDivCNBy t t+ {-| Compound type constraint useful for test definition. -} type CanDivX t1 t2 =   (CanDiv t1 t2,@@ -118,17 +177,17 @@   describe (printf "CanDiv %s %s" typeName1 typeName2) $ do     it "recip(recip x) = x" $ do       property $ \ (x :: t1) ->-        (isNonZero x && isNonZero (recip x)) ==>+        (isCertainlyNonZero x && isCertainlyNonZero (recip x)) ==>           recip (recip x) ?==?$ x     it "x/1 = x" $ do       property $ \ (x :: t1) -> let one = (convertExactly 1 :: t2) in (x / one) ?==?$ x     it "x/x = 1" $ do       property $ \ (x :: t1) ->-        (isNonZero x) ==>+        (isCertainlyNonZero x) ==>           let one = (convertExactly 1 :: t1) in (x / x) ?==?$ one     it "x/y = x*(1/y)" $ do       property $ \ (x :: t1) (y :: t2) ->-        (isNonZero y) ==>+        (isCertainlyNonZero y) ==>           let one = (convertExactly 1 :: t1) in (x / y) ?==?$ x * (one/y)   where   infix 4 ?==?$@@ -152,58 +211,63 @@ specCanDivNotMixed t = specCanDiv t t  instance CanDiv Int Int where-  type DivType Int Int = Rational-  divide a b = (rational a) P./ (rational b)+  type DivTypeNoCN Int Int = Rational+  divideNoCN a b = (P./) (rational a) (rational b)  instance CanDiv Integer Integer where-  type DivType Integer Integer = Rational-  divide a b = (rational a) P./ (rational b)-instance CanDiv Rational Rational-instance CanDiv Double Double+  type DivTypeNoCN Integer Integer = Rational+  divideNoCN a b = (P./) (rational a) (rational b)+instance CanDiv Rational Rational where+  type DivTypeNoCN Rational Rational = Rational+  divideNoCN = (P./)  instance CanDiv Int Integer where-  type DivType Int Integer = Rational-  divide a b = (rational a) P./ (rational b)+  type DivTypeNoCN Int Integer = Rational+  divideNoCN a b = (P./) (rational a) (rational b) instance CanDiv Integer Int where-  type DivType Integer Int = Rational-  divide a b = (rational a) P./ (rational b)+  type DivTypeNoCN Integer Int = Rational+  divideNoCN a b = (P./) (rational a) (rational b)  instance CanDiv Int Rational where-  type DivType Int Rational = Rational-  divide = convertFirst divide+  type DivTypeNoCN Int Rational = Rational+  divideNoCN = convertFirst divideNoCN instance CanDiv Rational Int where-  type DivType Rational Int = Rational-  divide = convertSecond divide+  type DivTypeNoCN Rational Int = Rational+  divideNoCN = convertSecond divideNoCN  instance CanDiv Integer Rational where-  type DivType Integer Rational = Rational-  divide = convertFirst divide+  type DivTypeNoCN Integer Rational = Rational+  divideNoCN = convertFirst divideNoCN instance CanDiv Rational Integer where-  type DivType Rational Integer = Rational-  divide = convertSecond divide+  type DivTypeNoCN Rational Integer = Rational+  divideNoCN = convertSecond divideNoCN -instance CanDiv Int Double where-  type DivType Int Double = Double-  divide = convertFirst divide-instance CanDiv Double Int where-  type DivType Double Int = Double-  divide = convertSecond divide+instance CanDiv Double Double where+  type DivTypeNoCN Double Double = Double+  divideNoCN = (P./)+  type DivType Double Double = Double+  divide = (P./) -instance CanDiv Integer Double where-  type DivType Integer Double = Double-  divide = convertFirst divide-instance CanDiv Double Integer where-  type DivType Double Integer = Double-  divide = convertSecond divide+$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |]]+  (\ t -> [d| -instance CanDiv Rational Double where-  type DivType Rational Double = Double-  divide = convertFirst divide-instance CanDiv Double Rational where-  type DivType Double Rational = Double-  divide = convertSecond divide+    instance CanDiv $t Double where+      type DivType $t Double = Double+      divide n d = divide (double n) d+      type DivTypeNoCN $t Double = Double+      divideNoCN n d = divide (double n) d+    instance CanDiv Double $t where+      type DivType Double $t = Double+      divide d n = divide d (double n)+      type DivTypeNoCN Double $t = Double+      divideNoCN d n = divide d (double n)+  |]))  instance (CanDiv a b) => CanDiv [a] [b] where+  type DivTypeNoCN [a] [b] = [DivTypeNoCN a b]+  divideNoCN (x:xs) (y:ys) = (divideNoCN x y) : (divideNoCN xs ys)+  divideNoCN _ _ = []   type DivType [a] [b] = [DivType a b]   divide (x:xs) (y:ys) = (divide x y) : (divide xs ys)   divide _ _ = []@@ -212,14 +276,67 @@   type DivType (Maybe a) (Maybe b) = Maybe (DivType a b)   divide (Just x) (Just y) = Just (divide x y)   divide _ _ = Nothing+  type DivTypeNoCN (Maybe a) (Maybe b) = Maybe (DivTypeNoCN a b)+  divideNoCN (Just x) (Just y) = Just (divideNoCN x y)+  divideNoCN _ _ = Nothing +instance+  (CanDiv a b+  , CanEnsureCE es (DivType a b)+  , CanEnsureCE es (DivTypeNoCN a b)+  , SuitableForCE es)+  =>+  CanDiv (CollectErrors es a) (CollectErrors es  b)+  where+  type DivType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (DivType a b)+  divide = lift2CE divide+  type DivTypeNoCN (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (DivTypeNoCN a b)+  divideNoCN = lift2CE divideNoCN+ powUsingMulRecip ::-  (CanBeInteger e,-   CanRecipSameType t, CanMulSameType t, ConvertibleExactly Integer t)+  (CanBeInteger e, HasIntegers t,+   CanRecipCNSameType t, CanMulSameType t, CanEnsureCN t)    =>-   t -> e -> t+   t -> e -> EnsureCN t powUsingMulRecip x nPre   | n < 0 = recip $ powUsingMul x (negate n)-  | otherwise = powUsingMul x n+  | otherwise = ensureCN $ powUsingMul x n   where     n = integer nPre++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (CanDiv $t b+      , CanEnsureCE es (DivType $t b)+      , CanEnsureCE es (DivTypeNoCN $t b)+      , SuitableForCE es)+      =>+      CanDiv $t (CollectErrors es  b)+      where+      type DivType $t (CollectErrors es  b) =+        EnsureCE es (DivType $t b)+      divide = lift2TLCE divide+      type DivTypeNoCN $t (CollectErrors es  b) =+        EnsureCE es (DivTypeNoCN $t b)+      divideNoCN = lift2TLCE divideNoCN++    instance+      (CanDiv a $t+      , CanEnsureCE es (DivType a $t)+      , CanEnsureCE es (DivTypeNoCN a $t)+      , SuitableForCE es)+      =>+      CanDiv (CollectErrors es a) $t+      where+      type DivType (CollectErrors es  a) $t =+        EnsureCE es (DivType a $t)+      divide = lift2TCE divide+      type DivTypeNoCN (CollectErrors es  a) $t =+        EnsureCE es (DivTypeNoCN a $t)+      divideNoCN = lift2TCE divideNoCN+  |]))

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.Literals     Description :  Fixed-type numeric literals, conversions@@ -36,13 +37,15 @@ (   -- * Fixed-type literals   fromInteger, fromRational-  , ifThenElse+  -- * Generalised if-then-else+  , HasIfThenElse(..)   -- * Convenient conversions   , CanBeInteger, integer, integers, HasIntegers, fromInteger_   , CanBeInt, int, ints   , CanBeRational, rational, rationals, HasRationals, fromRational_   , CanBeDouble, double, doubles-  , ConvertibleExactly(..), convertExactly, ConvertResult, ConvertError, convError+  , ConvertibleExactly(..), convertExactly+  , ConvertResult, ConvertError, convError   -- * Generic list index   , (!!), specCanBeInteger, printArgsIfFails2   -- * Testing support functions@@ -54,6 +57,8 @@ ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -66,6 +71,9 @@ import Test.QuickCheck -- import Control.Exception (evaluate) +-- import Numeric.CollectErrors+import Control.CollectErrors+ {-| Replacement for 'Prelude.fromInteger' using the RebindableSyntax extension.     This version of fromInteger arranges that integer literals     are always of type 'Integer'.@@ -82,11 +90,14 @@ {-|   Restore if-then-else with RebindableSyntax -}-ifThenElse :: Bool -> t -> t -> t-ifThenElse b e1 e2-  | b = e1-  | otherwise = e2+class HasIfThenElse b t where+  ifThenElse :: b -> t -> t -> t +instance HasIfThenElse Bool t where+  ifThenElse b e1 e2+    | b = e1+    | otherwise = e2+ _testIf1 :: String _testIf1 = if True then "yes" else "no" @@ -178,9 +189,22 @@ instance ConvertibleExactly Int Rational instance ConvertibleExactly Integer Rational -instance ConvertibleExactly Int Double-instance ConvertibleExactly Integer Double-instance ConvertibleExactly Rational Double+instance ConvertibleExactly Integer Double where+  safeConvertExactly n =+    do+    d <- safeConvert n+    case P.properFraction d of+      (m, fr) | m P.== n P.&& fr P.== (double 0) -> return d+      _ -> convError "Integer could not be exactly converted to Double" n++instance ConvertibleExactly Int Double where+  safeConvertExactly n =+    do+    d <- safeConvert n+    case P.properFraction d of+      (m, fr) | m P.== n P.&& fr P.== (double 0) -> return d+      _ -> convError "Int could not be exactly converted to Double" n+ instance ConvertibleExactly Double Double where   safeConvertExactly d = Right d @@ -240,3 +264,19 @@   (a -> a -> c) {-^ same-type operation -} ->   (a -> b -> c) {-^ mixed-type operation -} convertSecond = convertSecondUsing (\ _ b -> convertExactly b)++-- instance+--   (ConvertibleExactly t1 t2, SuitableForCE es)+--   =>+--   ConvertibleExactly t1 (CollectErrors es t2)+--   where+--   safeConvertExactly = fmap pure . safeConvertExactly+--++$(declForTypes+  [[t| Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance (ConvertibleExactly $t t, Monoid es) => ConvertibleExactly $t (CollectErrors es t) where+      safeConvertExactly = fmap (\v -> CollectErrors (Just v) mempty) . safeConvertExactly+  |]))

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.MinMaxAbs     Description :  Bottom-up typed min, max and abs@@ -24,6 +25,8 @@ ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -33,6 +36,9 @@ import Test.Hspec import Test.QuickCheck +-- import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq@@ -202,6 +208,49 @@   max (Just x) (Just y) = Just (max x y)   max _ _ = Nothing +instance+  (CanMinMaxAsymmetric a b+  , CanEnsureCE es (MinMaxType a b)+  , SuitableForCE es)+  =>+  CanMinMaxAsymmetric (CollectErrors es a) (CollectErrors es  b)+  where+  type MinMaxType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (MinMaxType a b)+  min = lift2CE min+  max = lift2CE max++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (CanMinMaxAsymmetric $t b+      , CanEnsureCE es (MinMaxType $t b)+      , SuitableForCE es)+      =>+      CanMinMaxAsymmetric $t (CollectErrors es  b)+      where+      type MinMaxType $t (CollectErrors es  b) =+        EnsureCE es (MinMaxType $t b)+      min = lift2TLCE min+      max = lift2TLCE max++    instance+      (CanMinMaxAsymmetric a $t+      , CanEnsureCE es (MinMaxType a $t)+      , SuitableForCE es)+      =>+      CanMinMaxAsymmetric (CollectErrors es a) $t+      where+      type MinMaxType (CollectErrors es  a) $t =+        EnsureCE es (MinMaxType a $t)+      min = lift2TCE min+      max = lift2TCE max++  |]))++ {-| Compound type constraint useful for test definition. -} type CanNegX t =   (CanNeg t, Show t, Arbitrary t, Show (NegType t))@@ -264,6 +313,16 @@ instance CanAbs Integer instance CanAbs Rational instance CanAbs Double++instance+  (CanAbs a+  , CanEnsureCE es (AbsType a)+  , SuitableForCE es)+  =>+  CanAbs (CollectErrors es a)+  where+  type AbsType (CollectErrors es a) = EnsureCE es (AbsType a)+  abs = lift1CE abs  type CanAbsX t =   (CanAbs t,

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.Ord     Description :  Bottom-up typed order comparisons@@ -15,6 +16,7 @@   -- * Comparisons in numeric order   HasOrder, HasOrderAsymmetric(..), (>), (<), (<=), (>=)   , HasOrderCertainlyAsymmetric, HasOrderCertainly+  , HasOrderCertainlyCE, HasOrderCertainlyCN   , (?<=?), (?<?), (?>=?), (?>?)   , (!<=!), (!<!), (!>=!), (!>!)   -- ** Tests@@ -24,6 +26,8 @@ ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -31,6 +35,9 @@ import Test.Hspec import qualified Test.QuickCheck as QC +import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool -- import Numeric.MixedTypes.Eq@@ -48,6 +55,19 @@ type HasOrderCertainly t1 t2 =   (HasOrder t1 t2, CanTestCertainly (OrderCompareType t1 t2)) +type HasOrderCertainlyCE es t1 t2 =+  (HasOrderCertainly t1 t2,+   HasOrderCertainly (EnsureCE es t1) (EnsureCE es t2))+  --  ,+  --  CanTestCertainly (WithoutCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  IsBool (WithoutCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  CanEnsureCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2)),+  --  CanEnsureCE es (WithoutCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2))),+  --  WithoutCE es (WithoutCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2)))+  --    ~ (WithoutCE es (OrderCompareType (WithoutCE es t1) (WithoutCE es t2))))++type HasOrderCertainlyCN t1 t2 = HasOrderCertainlyCE NumErrors t1 t2+ type HasOrderCertainlyAsymmetric t1 t2 =   (HasOrderAsymmetric t1 t2, CanTestCertainly (OrderCompareType t1 t2)) @@ -192,7 +212,57 @@   lessThan d n = lessThan d (integer n)   leq d n = leq d (integer n) +instance+  (HasOrderAsymmetric a b+  , CanEnsureCE es (OrderCompareType a b)+  , IsBool (EnsureCE es (OrderCompareType a b))+  , SuitableForCE es)+  =>+  HasOrderAsymmetric (CollectErrors es a) (CollectErrors es  b)+  where+  type OrderCompareType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (OrderCompareType a b)+  lessThan = lift2CE lessThan+  leq = lift2CE leq+  greaterThan = lift2CE greaterThan+  geq = lift2CE geq +$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (HasOrderAsymmetric $t b+      , CanEnsureCE es (OrderCompareType $t b)+      , IsBool (EnsureCE es (OrderCompareType $t b))+      , SuitableForCE es)+      =>+      HasOrderAsymmetric $t (CollectErrors es  b)+      where+      type OrderCompareType $t (CollectErrors es  b) =+        EnsureCE es (OrderCompareType $t b)+      lessThan = lift2TLCE lessThan+      leq = lift2TLCE leq+      greaterThan = lift2TLCE greaterThan+      geq = lift2TLCE geq++    instance+      (HasOrderAsymmetric a $t+      , CanEnsureCE es (OrderCompareType a $t)+      , IsBool (EnsureCE es (OrderCompareType a $t))+      , SuitableForCE es)+      =>+      HasOrderAsymmetric (CollectErrors es a) $t+      where+      type OrderCompareType (CollectErrors es  a) $t =+        EnsureCE es (OrderCompareType a $t)+      lessThan = lift2TCE lessThan+      leq = lift2TCE leq+      greaterThan = lift2TCE greaterThan+      geq = lift2TCE geq++  |]))+ class CanTestPosNeg t where     isCertainlyPositive :: t -> Bool     isCertainlyNonNegative :: t -> Bool@@ -211,3 +281,9 @@ instance CanTestPosNeg Integer instance CanTestPosNeg Rational instance CanTestPosNeg Double++instance (CanTestPosNeg t, SuitableForCE es) => (CanTestPosNeg (CollectErrors es t)) where+  isCertainlyPositive ce = getValueIfNoErrorCE ce isCertainlyPositive (const False)+  isCertainlyNonNegative ce = getValueIfNoErrorCE ce isCertainlyNonNegative (const False)+  isCertainlyNegative ce = getValueIfNoErrorCE ce isCertainlyNegative (const False)+  isCertainlyNonPositive ce = getValueIfNoErrorCE ce isCertainlyNonPositive (const False)

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-|     Module      :  Numeric.MixedType.Ring     Description :  Bottom-up typed multiplication and exponent@@ -20,14 +21,16 @@   -- ** Tests   , specCanMul, specCanMulNotMixed, specCanMulSameType, CanMulX   -- * Exponentiation-  , CanPow(..), CanPowBy-  , (^), (^^), (**)+  , CanPow(..), CanPowBy, CanPowCNBy+  , (^), (^!)   , powUsingMul   -- ** Tests   , specCanPow, CanPowX ) where +import Utils.TH.DeclForTypes+ import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf@@ -37,6 +40,9 @@ import Test.Hspec import Test.QuickCheck +import Numeric.CollectErrors+import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq@@ -51,13 +57,11 @@  type Ring t =   (CanNegSameType t, CanAddSameType t, CanSubSameType t, CanMulSameType t,-   CanPowBy t Integer, CanPowBy t Int,+   CanPowCNBy t Integer, CanPowCNBy t Int,    HasEq t t,    HasEq t Integer, CanAddSubMulBy t Integer,-   CanSub Integer t, SubType Integer t ~ t,    HasEq t Int, CanAddSubMulBy t Int,-   CanSub Int t, SubType Int t ~ t,-   ConvertibleExactly Integer t)+   HasIntegers t)  type CertainlyEqRing t =   (Ring t, HasEqCertainly t t, HasEqCertainly t Int, HasEqCertainly t Integer)@@ -86,12 +90,20 @@   default mul :: (MulType t1 t2 ~ t1, t1~t2, P.Num t1) => t1 -> t1 -> t1   mul = (P.*) -infixl 8  ^, ^^+infixl 8  ^, ^! infixl 7  *  (*) :: (CanMulAsymmetric t1 t2) => t1 -> t2 -> MulType t1 t2 (*) = mul +(^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2+(^) = pow++{-| Like `^` but throwing an exception if the power is undefined. -}+(^!) :: (CanPow t1 t2, Show (PowType t1 t2), CanEnsureCN (PowType t1 t2)) =>+  t1 -> t2 -> EnsureNoCN (PowType t1 t2)+a ^! b = (~!) (a ^ b)+ type CanMulBy t1 t2 =   (CanMul t1 t2, MulType t1 t2 ~ t1) type CanMulSameType t =@@ -213,24 +225,24 @@  instance CanMulAsymmetric Int Double where   type MulType Int Double = Double-  mul = convertFirst mul+  mul n d = mul (double n) d instance CanMulAsymmetric Double Int where   type MulType Double Int = Double-  mul = convertSecond mul+  mul d n = mul d (double n)  instance CanMulAsymmetric Integer Double where   type MulType Integer Double = Double-  mul = convertFirst mul+  mul n d = mul (double n) d instance CanMulAsymmetric Double Integer where   type MulType Double Integer = Double-  mul = convertSecond mul+  mul d n = mul d (double n)  instance CanMulAsymmetric Rational Double where   type MulType Rational Double = Double-  mul = convertFirst mul+  mul n d = mul (double n) d instance CanMulAsymmetric Double Rational where   type MulType Double Rational = Double-  mul = convertSecond mul+  mul d n = mul d (double n)  instance (CanMulAsymmetric a b) => CanMulAsymmetric [a] [b] where   type MulType [a] [b] = [MulType a b]@@ -242,6 +254,17 @@   mul (Just x) (Just y) = Just (mul x y)   mul _ _ = Nothing +instance+  (CanMulAsymmetric a b+  , CanEnsureCE es (MulType a b)+  , SuitableForCE es)+  =>+  CanMulAsymmetric (CollectErrors es a) (CollectErrors es  b)+  where+  type MulType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (MulType a b)+  mul = lift2CE mul+ {---- Exponentiation -----}  {-|@@ -252,12 +275,52 @@   type PowType t1 t2   type PowType t1 t2 = t1 -- default   pow :: t1 -> t2 -> PowType t1 t2-  default pow :: (PowType t1 t2 ~ t1, P.Num t1, P.Integral t2) => t1 -> t2 -> t1-  pow = (P.^)+  -- default pow :: (PowType t1 t2 ~ t1, P.Num t1, P.Integral t2) => t1 -> t2 -> t1+  -- pow = (P.^) +integerPowCN ::+  (HasOrderCertainly b Integer, HasOrderCertainly e Integer,+   HasEqCertainly b Integer, HasEqCertainly e Integer,+   CanEnsureCN r)+  =>+  (b -> e -> r) -> b -> e -> EnsureCN r+integerPowCN unsafeIntegerPow b n+  | n !<! 0 =+    noValueNumErrorCertainECN sample_v $ OutOfRange "illegal integer pow: negative exponent"+  | n !==! 0 && b !==! 0 =+    noValueNumErrorCertainECN sample_v $ OutOfRange "illegal integer pow: 0^0"+  | n ?<? 0 =+    noValueNumErrorPotentialECN sample_v $ OutOfRange "illegal integer pow: negative exponent"+  | n ?==? 0 && b ?==? 0 =+    noValueNumErrorPotentialECN sample_v $ OutOfRange "illegal integer pow: 0^0"+  | otherwise =+    ensureCN $ unsafeIntegerPow b n+  where+  sample_v = Just (unsafeIntegerPow b n)++powCN ::+  (HasOrderCertainly b Integer, HasOrderCertainly e Integer,+   HasEqCertainly b Integer, CanTestInteger e,+   CanEnsureCN r)+  =>+  (b -> e -> r) -> b -> e -> EnsureCN r+powCN unsafePow b e+  | b !==! 0 && e !<=! 0 =+    noValueNumErrorCertainECN sample_v $ OutOfRange "illegal pow: 0^e with e <= 0"+  | b !<! 0 && certainlyNotInteger e =+    noValueNumErrorCertainECN sample_v $ OutOfRange "illegal pow: b^e with b < 0 and e non-integer"+  | b ?==? 0 && e ?<=? 0 =+    noValueNumErrorPotentialECN sample_v $ OutOfRange "illegal pow: 0^e with e <= 0"+  | b ?<? 0 && not (certainlyInteger e) =+    noValueNumErrorPotentialECN sample_v $ OutOfRange "illegal pow: b^e with b < 0 and e non-integer"+  | otherwise =+    ensureCN $ unsafePow b e+  where+  sample_v = Just (unsafePow b e)+ powUsingMul ::   (CanBeInteger e,-   CanMulSameType t, ConvertibleExactly Integer t)+   CanMulSameType t, HasIntegers t)    =>    t -> e -> t powUsingMul x nPre@@ -273,20 +336,12 @@       | otherwise =         let s = aux ((m-1) `div` 2) in x * s * s -(^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2-(^) = pow--{-| A synonym of `^` -}-(^^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2-(^^) = (^)--{-| A synonym of `^` -}-(**) :: (CanPow t1 t2) => t1 -> t2 -> (PowType t1 t2)-(**) = (^)- type CanPowBy t1 t2 =   (CanPow t1 t2, PowType t1 t2 ~ t1) +type CanPowCNBy t1 t2 =+  (CanPow t1 t2, PowType t1 t2 ~ EnsureCN t1)+ {-| Compound type constraint useful for test definition. -} type CanPowX t1 t2 =   (CanPow t1 t2,@@ -329,19 +384,26 @@   (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property   (?==?$) = printArgsIfFails2 "?==?" (?==?) -instance CanPow Integer Integer-instance CanPow Integer Int+instance CanPow Integer Integer where+  type PowType Integer Integer = CN Integer+  pow = integerPowCN (P.^)+instance CanPow Integer Int where+  type PowType Integer Int = CN Integer+  pow = integerPowCN (P.^) instance CanPow Int Integer where-  type PowType Int Integer = Integer-  pow x n = (integer x) P.^ n+  type PowType Int Integer = CN Integer+  pow x n = pow (integer x) n instance CanPow Int Int where-  type PowType Int Int = Integer-  pow x n = (integer x) P.^ n-instance CanPow Rational Int where pow = (P.^^)-instance CanPow Rational Integer where pow = (P.^^)+  type PowType Int Int = CN Integer+  pow x n = pow (integer x) n+instance CanPow Rational Int where+  type PowType Rational Int = CN Rational+  pow = powCN (P.^^)+instance CanPow Rational Integer where+  type PowType Rational Integer = CN Rational+  pow = powCN (P.^^) instance CanPow Double Int where pow = (P.^^) instance CanPow Double Integer where pow = (P.^^)-{- No exponentiation of Int to avoid overflows. -}  -- instance (CanPow a b) => CanPow [a] [b] where --   type PowType [a] [b] = [PowType a b]@@ -352,3 +414,63 @@   type PowType (Maybe a) (Maybe b) = Maybe (PowType a b)   pow (Just x) (Just y) = Just (pow x y)   pow _ _ = Nothing++instance+  (CanPow a b+  , CanEnsureCE es (PowType a b)+  , SuitableForCE es)+  =>+  CanPow (CollectErrors es a) (CollectErrors es  b)+  where+  type PowType (CollectErrors es a) (CollectErrors es b) =+    EnsureCE es (PowType a b)+  pow = lift2CE pow++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]+  (\ t -> [d|++    instance+      (CanPow $t b+      , CanEnsureCE es (PowType $t b)+      , SuitableForCE es)+      =>+      CanPow $t (CollectErrors es  b)+      where+      type PowType $t (CollectErrors es  b) =+        EnsureCE es (PowType $t b)+      pow = lift2TLCE pow++    instance+      (CanPow a $t+      , CanEnsureCE es (PowType a $t)+      , SuitableForCE es)+      =>+      CanPow (CollectErrors es a) $t+      where+      type PowType (CollectErrors es  a) $t =+        EnsureCE es (PowType a $t)+      pow = lift2TCE pow++    instance+      (CanMulAsymmetric $t b+      , CanEnsureCE es (MulType $t b)+      , SuitableForCE es)+      =>+      CanMulAsymmetric $t (CollectErrors es  b)+      where+      type MulType $t (CollectErrors es  b) =+        EnsureCE es (MulType $t b)+      mul = lift2TLCE mul++    instance+      (CanMulAsymmetric a $t+      , CanEnsureCE es (MulType a $t)+      , SuitableForCE es)+      =>+      CanMulAsymmetric (CollectErrors es a) $t+      where+      type MulType (CollectErrors es  a) $t =+        EnsureCE es (MulType a $t)+      mul = lift2TCE mul+  |]))

@@ -135,6 +135,10 @@  instance HasIntegerBounds Rational instance HasIntegerBounds Double+instance HasIntegerBounds Integer where+  integerBounds n = (n,n)+instance HasIntegerBounds Int where+  integerBounds n = (n',n') where n' = integer n  type HasIntegerBoundsX t =   (HasIntegerBounds t,

@@ -0,0 +1,50 @@+-- {-# LANGUAGE TemplateHaskell #-}+{-|+    Module      :  Utils.TH.DeclForTypes+    Description :  Repeat declaration for multiple types+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Template Haskell utilities+-}++module Utils.TH.DeclForTypes+(+  declForTypes+)+where++import Prelude (concat, sequence, map, ($), Monad(..))++import Language.Haskell.TH++{- template haskell to generate repetitive instances -}++{-|++A toy example of use:++@+class HasTT t where+  type TT t+  getTT :: t -> TT t++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |]]+  (\ t -> [d|+    instance HasTT $t where+      type TT $t = ()+      getTT _ = ()+  |]))+@++-}+declForTypes :: [Q Type] -> (Q Type -> Q [Dec]) -> Q [Dec]+declForTypes types makeDecl =+  do+  decsList <- sequence $ map makeDecl types+  return $ concat decsList

@@ -0,0 +1,32 @@+{-|+    Module      :  Numeric.MixedType.AddSubSpec+    Description :  hspec tests for addition and subtraction+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.AddSubSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specCanAddNotMixed tInt+  specCanAddNotMixed tInteger+  specCanAddNotMixed tRational+  specCanAdd tInt tInteger tRational+  specCanAdd tInteger tRational tInt+  specCanAddSameType tInteger+  specCanAddSameType tRational+  specCanSubNotMixed tInt+  specCanSubNotMixed tInteger+  specCanSubNotMixed tRational+  specCanSub tInt tInteger+  specCanSub tInt tRational+  specCanSub tInteger tRational

@@ -0,0 +1,38 @@+{-|+    Module      :  Numeric.MixedType.BoolSpec+    Description :  hspec tests for Boolean operations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.BoolSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specIsBool tBool+  specIsBool tMaybeBool+  specIsBool tMaybeMaybeBool+  -- mixed-type tests:+  specCanAndOr tBool tMaybeBool tBool+  specCanAndOr tMaybeMaybeBool tMaybeBool tBool+  describe "mixed-type Boolean operation examples" $ do+    it "can do True || Just False" $ do+      True || Just False `shouldBe` Just True+    it "can do True || Nothing" $ do+      True || (Nothing :: Maybe Bool) `shouldBe` Just True+    it "can do Nothing || True" $ do+      (Nothing :: Maybe Bool) || True `shouldBe` Just True+    it "can do True || Just (Just False)" $ do+      True || Just (Just False) `shouldBe` Just (Just True)+    it "can do True || Just Nothing" $ do+      True || Just (Nothing :: Maybe Bool) `shouldBe` Just (Just True)+    it "can do Just Nothing || True" $ do+      Just (Nothing :: Maybe Bool) || True `shouldBe` Just (Just True)

@@ -0,0 +1,39 @@+{-|+    Module      :  Numeric.MixedType.EqOrdSpec+    Description :  hspec tests for comparison operations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.EqOrdSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specHasEqNotMixed tInt+  specHasEqNotMixed tInteger+  specHasEqNotMixed tRational+  specHasEqNotMixed tDouble+  specHasEq tInt tInteger tRational+  specHasEq tInteger tRational tInt+  specHasEq tInteger tDouble tInt+  specCanTestZero tInt+  specCanTestZero tInteger+  specCanTestZero tRational+  specCanPickNonZero tInt+  specCanPickNonZero tInteger+  specCanPickNonZero tRational+  specHasOrderNotMixed tInt+  specHasOrderNotMixed tInteger+  specHasOrderNotMixed tRational+  specHasOrderNotMixed tDouble+  specHasOrder tInt tInteger tRational+  specHasOrder tInteger tRational tInt+  specHasOrder tInteger tDouble tInt

@@ -0,0 +1,24 @@+{-|+    Module      :  Numeric.MixedType.FieldSpec+    Description :  hspec tests for multiplication and exponentiation+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.FieldSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specCanDivNotMixed tInt+  specCanDivNotMixed tInteger+  specCanDivNotMixed tRational+  specCanDiv tInt tInteger+  specCanDiv tRational tInteger

@@ -0,0 +1,38 @@+{-|+    Module      :  Numeric.MixedType.LiteralsSpec+    Description :  hspec tests for Literals+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.LiteralsSpec (spec) where++import Numeric.MixedTypes+import qualified Prelude as P++-- import Text.Printf+import Control.Exception (evaluate)++import Test.Hspec+-- import qualified Test.QuickCheck as QC+-- import qualified Test.Hspec.SmallCheck as SC++spec :: Spec+spec = do+  specCanBeInteger tInt+  specCanBeInteger tInteger+  specConversions++specConversions :: Spec+specConversions =+  do+  specConversion tInt tInteger integer int+  it "converting large integer to int throws exception" $ do+    (evaluate $ int (integer (maxBound :: Int) P.+ 1)) `shouldThrow` anyException+  specConversion tInt tRational rational (int . round)+  specConversion tInteger tRational rational round+  specConversion tDouble tRational toRational double

@@ -0,0 +1,30 @@+{-|+    Module      :  Numeric.MixedType.MinMaxAbsSpec+    Description :  hspec tests for min, max, negation and abs+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.MinMaxAbsSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specCanMinMaxNotMixed tInt+  specCanMinMaxNotMixed tInteger+  specCanMinMaxNotMixed tRational+  specCanMinMax tInt tInteger tRational+  specCanMinMax tInteger tRational tInt+  specCanNegNum tInt+  specCanNegNum tInteger+  specCanNegNum tRational+  specCanAbs tInt+  specCanAbs tInteger+  specCanAbs tRational

@@ -0,0 +1,30 @@+{-|+    Module      :  Numeric.MixedType.RingSpec+    Description :  hspec tests for multiplication and exponentiation+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.RingSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specCanMulNotMixed tInt+  specCanMulNotMixed tInteger+  specCanMulNotMixed tRational+  specCanMul tInt tInteger tRational+  specCanMul tInteger tRational tInt+  specCanMulSameType tInteger+  specCanMulSameType tRational+  specCanPow tInteger tInteger+  specCanPow tInteger tInt+  specCanPow tRational tInteger+  specCanPow tRational tInt

@@ -0,0 +1,21 @@+{-|+    Module      :  Numeric.MixedType.RoundSpec+    Description :  hspec tests for round, etc+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+-}++module Numeric.MixedTypes.RoundSpec (spec) where++import Numeric.MixedTypes++import Test.Hspec++spec :: Spec+spec = do+  specCanRound tRational+  -- specCanRound tDouble