diff --git a/Boolean.cabal b/Boolean.cabal --- a/Boolean.cabal +++ b/Boolean.cabal @@ -1,28 +1,37 @@ Name: Boolean -Version: 0.0.1 -Cabal-Version: >= 1.2 -Synopsis: Generalized booleans +Version: 0.2.4 +Synopsis: Generalized booleans and numbers Category: Data +Cabal-Version: >= 1.6 Description: Some classes for generalized boolean operations. + Starting with 0.1.0, this package uses type families. + Up to version 0.0.2, it used MPTCs with functional dependencies. + My thanks to Andy Gill for suggesting & helping with the change. + Thanks also to Alex Horsman for Data.Boolean.Overload and to + Jan Bracker for Data.Boolean.Numbers. . - Copyright 2009 Conal Elliott; BSD3 license. + Copyright 2009-2013 Conal Elliott; BSD3 license. Author: Conal Elliott Maintainer: conal@conal.net -Package-Url: http://code.haskell.org/~conal/code/Boolean -Copyright: (c) 2009 by Conal Elliott +Copyright: (c) 2009-2013 by Conal Elliott License: BSD3 License-File: COPYING Stability: experimental build-type: Simple +source-repository head + type: git + location: git://github.com/conal/Boolean.git + Library hs-Source-Dirs: src Extensions: Build-Depends: base<5 Exposed-Modules: Data.Boolean - + Data.Boolean.Overload + Data.Boolean.Numbers ghc-options: -Wall -- ghc-prof-options: -prof -auto-all diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -1,4 +1,4 @@ -Copyright (c) 2009 Conal Elliott +Copyright (c) 2009-2012 Conal Elliott All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/Makefile b/Makefile deleted file mode 100644 --- a/Makefile +++ /dev/null @@ -1,1 +0,0 @@ -include ../cho-home-cabal-make.inc diff --git a/src/Data/Boolean.hs b/src/Data/Boolean.hs --- a/src/Data/Boolean.hs +++ b/src/Data/Boolean.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies - , UndecidableInstances, ScopedTypeVariables - #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, + UndecidableInstances, ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies, FlexibleContexts, CPP #-} {-# OPTIONS_GHC -Wall #-} + +{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP +{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- TEMP + ---------------------------------------------------------------------- -- | -- Module : Data.Boolean --- Copyright : (c) Conal Elliott 2009 +-- Copyright : (c) Conal Elliott 2009-2012 -- License : BSD3 -- -- Maintainer : conal@conal.net @@ -14,27 +18,34 @@ -- Some classes for generalized boolean operations. -- -- In this design, for if-then-else, equality and inequality tests, the --- boolean type depends functionally on the value type. This dependency --- allows the boolean type to be inferred in a conditional expression. +-- boolean type depends on the value type. -- -- I also tried using a unary type constructor class. The class doesn't work -- for regular booleans, so generality is lost. Also, we'd probably have -- to wire class constraints in like: @(==*) :: Eq a => f Bool -> f a -> f -- a -> f a@, which disallows situations needing additional constraints, -- e.g., Show. --- +-- +-- Starting with 0.1.0, this package uses type families. +-- Up to version 0.0.2, it used MPTCs with functional dependencies. +-- My thanks to Andy Gill for suggesting & helping with the change. + ---------------------------------------------------------------------- module Data.Boolean - ( - Boolean(..),IfB(..), boolean, cond, crop - , EqB(..), OrdB(..), minB, maxB + ( Boolean(..), BooleanOf, IfB(..) + , boolean, cond, crop + , EqB(..), OrdB(..) + , minB, maxB, sort2B + , guardedB, caseB ) where +#if MIN_VERSION_base(4,8,0) +import Prelude hiding ((<*)) +#endif import Data.Monoid (Monoid,mempty) import Control.Applicative (Applicative(pure),liftA2,liftA3) - {-------------------------------------------------------------------- Classes --------------------------------------------------------------------} @@ -55,85 +66,133 @@ (&&*) = (&&) (||*) = (||) +-- | 'BooleanOf' computed the boolean analog of a specific type. +type family BooleanOf a + -- | Types with conditionals -class Boolean bool => IfB bool a | a -> bool where - ifB :: bool -> a -> a -> a +class Boolean (BooleanOf a) => IfB a where + ifB :: (bool ~ BooleanOf a) => bool -> a -> a -> a -- | Expression-lifted conditional with condition last -boolean :: IfB bool a => a -> a -> bool -> a +boolean :: (IfB a, bool ~ BooleanOf a) => a -> a -> bool -> a boolean t e bool = ifB bool t e -- | Point-wise conditional -cond :: (Applicative f, IfB bool a) => f bool -> f a -> f a -> f a +cond :: (Applicative f, IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a -> f a cond = liftA3 ifB --- | Crop a function, filling in 'mempty' where the test yeis false. -crop :: (Applicative f, Monoid (f a), IfB bool a) => f bool -> f a -> f a +-- | Generalized cropping, filling in 'mempty' where the test yields false. +crop :: (Applicative f, Monoid (f a), IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a crop r f = cond r f mempty +-- | A generalized replacement for guards and chained ifs. +guardedB :: (IfB b, bool ~ BooleanOf b) => bool -> [(bool,b)] -> b -> b +guardedB _ [] e = e +guardedB a ((c,b):l) e = ifB c b (guardedB a l e) +-- | A generalized version of a case like control structure. +caseB :: (IfB b, bool ~ BooleanOf b) => a -> [(a -> bool, b)] -> b -> b +caseB _ [] e = e +caseB x ((p,b):l) e = ifB (p x) b (caseB x l e) + infix 4 ==*, /=* -- | Types with equality. Minimum definition: '(==*)'. -class Boolean bool => EqB bool a | a -> bool where - (==*), (/=*) :: a -> a -> bool +class Boolean (BooleanOf a) => EqB a where + (==*), (/=*) :: (bool ~ BooleanOf a) => a -> a -> bool u /=* v = notB (u ==* v) infix 4 <*, <=*, >=*, >* -- | Types with inequality. Minimum definition: '(<*)'. -class Boolean bool => OrdB bool a | a -> bool where - (<*), (<=*), (>*), (>=*) :: a -> a -> bool +class Boolean (BooleanOf a) => OrdB a where + (<*), (<=*), (>*), (>=*) :: (bool ~ BooleanOf a) => a -> a -> bool u >* v = v <* u u >=* v = notB (u <* v) u <=* v = v >=* u -- | Variant of 'min' using 'ifB' and '(<=*)' -minB :: (IfB bool a, OrdB bool a) => a -> a -> a +minB :: (IfB a, OrdB a) => a -> a -> a u `minB` v = ifB (u <=* v) u v -- | Variant of 'max' using 'ifB' and '(>=*)' -maxB :: (IfB bool a, OrdB bool a) => a -> a -> a +maxB :: (IfB a, OrdB a) => a -> a -> a u `maxB` v = ifB (u >=* v) u v +-- | Variant of 'min' and 'max' using 'ifB' and '(<=*)' +sort2B :: (IfB a, OrdB a) => (a,a) -> (a,a) +sort2B (u,v) = ifB (u <=* v) (u,v) (v,u) + + + {-------------------------------------------------------------------- - Some instances + Instances for Prelude types --------------------------------------------------------------------} +-- Simple if-then-else as function. ife :: Bool -> a -> a -> a ife c t e = if c then t else e -- I'd give the following instances: -- --- instance IfB Bool a where ifB = ife --- instance EqB Bool a where { (==*) = (==) ; (/=*) = (/=) } --- instance OrdB Bool a where { (<*) = (<) ; (<=*) = (<=)} +-- instance IfB a where ifB = ife +-- instance Eq a => EqB a where { (==*) = (==) ; (/=*) = (/=) } +-- instance Ord a => Ord a where { (<*) = (<) ; (<=*) = (<=)} -- -- Sadly, doing so would break the a->bool fundep, which is needed elsewhere -- for disambiguation. So use the instances above as templates, filling -- in specific types for a. +#define SimpleInstances(Ty) \ +instance IfB (Ty) where { ifB = ife } ;\ +instance EqB (Ty) where { (==*) = (==) ; (/=*) = (/=) } ;\ +instance OrdB (Ty) where { (<*) = (<) ; (<=*) = (<=) } -instance IfB Bool Float where ifB = ife -instance EqB Bool Float where { (==*) = (==) ; (/=*) = (/=) } -instance OrdB Bool Float where { (<*) = (<) ; (<=*) = (<=) } +#define SimpleTy(Ty) \ +type instance BooleanOf (Ty) = Bool ;\ +SimpleInstances(Ty) --- Similarly for other types. +SimpleTy(Int) +SimpleTy(Integer) +SimpleTy(Float) +SimpleTy(Double) +SimpleTy(Bool) +SimpleTy(Char) +-- Similarly for other simple types. -instance (IfB bool p, IfB bool q) => IfB bool (p,q) where +-- TODO: Export these macros for external use. I guess I'd want a .h file as in +-- the applicative-numbers package. + +type instance BooleanOf [a] = BooleanOf a +type instance BooleanOf (a,b) = BooleanOf a +type instance BooleanOf (a,b,c) = BooleanOf a +type instance BooleanOf (a,b,c,d) = BooleanOf a +type instance BooleanOf (z -> a) = z -> BooleanOf a + +-- I'm uncomfortable with this list instance. It's unlike tuples and unlike +-- functions. It could be generalized from BooleanOf a ~ Bool to a general case +-- for applicatives, but then the list version would form cross products. +-- Consider strings and other list types under a variety of use scenarios. + +instance (Boolean (BooleanOf a),BooleanOf a ~ Bool) => IfB [a] where { ifB = ife } + +instance (bool ~ BooleanOf p, bool ~ BooleanOf q + ,IfB p, IfB q) => IfB (p,q) where ifB w (p,q) (p',q') = (ifB w p p', ifB w q q') -instance (IfB bool p, IfB bool q, IfB bool r) => IfB bool (p,q,r) where +instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r + ,IfB p, IfB q, IfB r) + => IfB (p,q,r) where ifB w (p,q,r) (p',q',r') = (ifB w p p', ifB w q q', ifB w r r') -instance (IfB bool p, IfB bool q, IfB bool r, IfB bool s) => IfB bool (p,q,r,s) where +instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r, bool ~ BooleanOf s + ,IfB p, IfB q, IfB r, IfB s) => IfB (p,q,r,s) where ifB w (p,q,r,s) (p',q',r',s') = (ifB w p p', ifB w q q', ifB w r r', ifB w s s') - - --- Standard pattern for applicative functors: +-- Instances for functions, using the standard pattern for applicative functions. +-- Note that the [] applicative does not use this instance. Fishy. instance Boolean bool => Boolean (z -> bool) where true = pure true @@ -142,14 +201,16 @@ (&&*) = liftA2 (&&*) (||*) = liftA2 (||*) -instance IfB bool a => IfB (z -> bool) (z -> a) where +instance IfB a => IfB (z -> a) where ifB = cond -instance EqB bool a => EqB (z -> bool) (z -> a) where +instance EqB a => EqB (z -> a) where { (==*) = liftA2 (==*) ; (/=*) = liftA2 (/=*) } -instance OrdB bool a => OrdB (z -> bool) (z -> a) where - { (<*) = liftA2(<*) ; (<=*) = liftA2(<=*) } +instance OrdB a => OrdB (z -> a) where + { (<*) = liftA2 (<*) ; (<=*) = liftA2 (<=*) } +-- TODO: Generalize the function instance into a macro for arbitrary +-- applicatives. Instantiate for functions. {- diff --git a/src/Data/Boolean/Numbers.hs b/src/Data/Boolean/Numbers.hs new file mode 100644 --- /dev/null +++ b/src/Data/Boolean/Numbers.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_GHC -Wall #-} + +------------------------------------------------------------------------- +-- | +-- Module : Data.Boolean.Numbers +-- Copyright : (c) Jan Bracker 2013 +-- License : BSD3 +-- +-- Maintainer : jbra@informatik.uni-kiel.de +-- Stability : experimental +-- +-- A generalized version of the class hirarchy for numbers. All +-- functions that would break a potential deep embedding are removed +-- or generalized to support deep embeddings. +-- +-- The class hierarchy for numeric types keeps as close as possible to the +-- 'Prelude' hierarchy. A great part of the default implementation and comments +-- are copied and adopted from 'Prelude'. +-- +------------------------------------------------------------------------- + +module Data.Boolean.Numbers + ( NumB(..) + , IntegralB(..) + , RealFracB(..) + , RealFloatB(..) + , evenB, oddB + , fromIntegralB + ) where + +import Prelude hiding + ( quotRem, divMod + , quot, rem + , div, mod + , properFraction + , fromInteger, toInteger ) +import qualified Prelude as P + +import Control.Arrow (first) + +import Data.Boolean + +{-------------------------------------------------------------------- + Misc +--------------------------------------------------------------------} + +infixr 9 .: + +-- Double composition. (Aka "result.result". See semantic editor combinators.) +(.:) :: (c -> c') -> (a -> b -> c) -> (a -> b -> c') +(.:) = (.).(.) + +(##) :: (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c,d) +(f ## g) x y = (f x y, g x y) + +-- ----------------------------------------------------------------------- +-- Generalized Number Class Hirarchy +-- ----------------------------------------------------------------------- + +-- | An extension of 'Num' that supplies the integer type of a +-- given number type and a way to create that number from the +-- integer. +class Num a => NumB a where + -- | The accociated integer type of the number. + type IntegerOf a + -- | Construct the number from the associated integer. + fromIntegerB :: IntegerOf a -> a + +-- | A deep embedded version of 'Integral'. +-- Integral numbers, supporting integer division. +-- +-- Minimal complete definition is either 'quotRem' and 'divMod' +-- or the other four functions. Besides that 'toIntegerB' always +-- has to be implemented. +class (NumB a, OrdB a) => IntegralB a where + -- | Integer division truncated towards zero. + quot :: a -> a -> a + quot = fst .: quotRem + -- | Integer reminder, satisfying: + -- @(x `quot` y) * y + (x `rem` y) == x@ + rem :: a -> a -> a + rem = snd .: quotRem + -- | Integer division truncated toward negative infinity. + div :: a -> a -> a + div = fst .: divMod + -- | Integer modulus, satisfying: + -- @(x `div` y) * y + (x `mod` y) == x@ + mod :: a -> a -> a + mod = snd .: divMod + -- | Simultaneous 'quot' and 'rem'. + quotRem :: a -> a -> (a,a) + quotRem = quot ## rem + -- | Simultaneous 'div' and 'mod'. + divMod :: a -> a -> (a,a) + divMod = div ## mod + -- | Create a integer from this integral. + toIntegerB :: a -> IntegerOf a + +-- | Deep embedded version of 'RealFloat'. +-- Extracting components of fractions. +-- +-- Minimal complete definition: 'properFraction', +-- 'round', 'floor' and 'ceiling'. +class (NumB a, OrdB a, Fractional a) => RealFracB a where + -- | The function 'properFraction' takes a real fractional number @x@ + -- and returns a pair @(n,f)@ such that @x = n+f@, and: + -- + -- * @n@ is an integral number with the same sign as @x@; and + -- + -- * @f@ is a fraction with the same type and sign as @x@, + -- and with absolute value less than @1@. + -- + -- The default definitions of the 'ceiling', 'floor', 'truncate' + -- and 'round' functions are in terms of 'properFraction'. + properFraction :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> (b, a) + -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@ + truncate :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b + truncate = fst . properFraction + -- | @'round' x@ returns the nearest integer to @x@; + -- the even integer if @x@ is equidistant between two integers + round :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b + -- | @'ceiling' x@ returns the least integer not less than @x@ + ceiling :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b + -- | @'floor' x@ returns the greatest integer not greater than @x@. + floor :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b + +-- | Deep embedded version of 'RealFloat'. +-- Efficient, machine-independent access to the components of a +-- floating-point number. +-- +-- A complete definition has to define all functions. +class (Boolean (BooleanOf a), RealFracB a, Floating a) => RealFloatB a where + -- | 'true' if the argument is an IEEE \"not-a-number\" (NaN) value. + isNaN :: a -> BooleanOf a + -- | 'true' if the argument is an IEEE infinity or negative infinity. + isInfinite :: a -> BooleanOf a + -- | 'true' if the argument is an IEEE negative zero. + isNegativeZero :: a -> BooleanOf a + -- | 'true' if the argument is an IEEE floating point number. + isIEEE :: a -> BooleanOf a + -- | a version of arctangent taking two real floating-point arguments. + -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle + -- (from the positive x-axis) of the vector from the origin to the + -- point @(x,y)@. @'atan2' y x@ returns a value in the range [@-pi@, + -- @pi@]. It follows the Common Lisp semantics for the origin when + -- signed zeroes are supported. @'atan2' y 1@, with @y@ in a type + -- that is 'RealFloatB', should return the same value as @'atan' y@. + atan2 :: a -> a -> a + +-- ----------------------------------------------------------------------- +-- Generalized Number Utility Functions +-- ----------------------------------------------------------------------- + +-- | Variant of 'even' for generalized booleans. +evenB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a +evenB n = n `rem` 2 ==* 0 + +-- | Variant of 'odd' for generalized booleans. +oddB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a +oddB = notB . evenB + +-- | Variant of 'fromIntegral' for generalized booleans. +fromIntegralB :: (IntegerOf a ~ IntegerOf b, IntegralB a, NumB b) => a -> b +fromIntegralB = fromIntegerB . toIntegerB + +-- ----------------------------------------------------------------------- +-- Default Class Instances for Basic Types +-- ----------------------------------------------------------------------- + +-- | Only for internal use. +fromInteger' :: (Integer ~ IntegerOf b, NumB b) => Integer -> b +fromInteger' = fromIntegralB + +#define DefaultNumBInstance(Ty) \ +instance NumB (Ty) where {\ + type IntegerOf (Ty) = Integer ;\ + fromIntegerB = P.fromInteger } + +#define DefaultIntegralBInstance(Ty) \ +instance IntegralB (Ty) where {\ + quotRem = P.quotRem ;\ + divMod = P.divMod ;\ + toIntegerB = P.toInteger } + +#define DefaultRealFracFloatBInstance(Ty) \ +instance RealFracB (Ty) where {\ + properFraction = first fromInteger' . P.properFraction ;\ + round = fromInteger' . P.round ;\ + floor = fromInteger' . P.floor ;\ + ceiling = fromInteger' . P.ceiling };\ +instance RealFloatB (Ty) where {\ + isNaN = P.isNaN ;\ + isInfinite = P.isInfinite ;\ + isNegativeZero = P.isNegativeZero ;\ + isIEEE = P.isIEEE ;\ + atan2 = P.atan2 } + +DefaultNumBInstance(Int) +DefaultNumBInstance(Integer) +DefaultNumBInstance(Float) +DefaultNumBInstance(Double) + +DefaultIntegralBInstance(Int) +DefaultIntegralBInstance(Integer) + +DefaultRealFracFloatBInstance(Float) +DefaultRealFracFloatBInstance(Double) diff --git a/src/Data/Boolean/Overload.hs b/src/Data/Boolean/Overload.hs new file mode 100644 --- /dev/null +++ b/src/Data/Boolean/Overload.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wall #-} + +---------------------------------------------------------------------- +-- | +-- Module : Data.Boolean.Overload +-- License : BSD3 +-- +-- Author : Alex Horsman (aninhumer) +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- +-- Definitions of Prelude function names in terms of their corresponding +-- Data.Boolean generalised implementation. This can then be used as part +-- of a partial or complete Prelude replacement. +-- +-- Also exports ifThenElse for use with RebindableSyntax. +---------------------------------------------------------------------- + +module Data.Boolean.Overload + ( module Data.Boolean, + (&&), (||), not, + ifThenElse, + (==), (/=), + (<), (>), (<=), (>=), + min, max + ) where + +import Data.Boolean +import Prelude hiding + ( (&&), (||), not, + (==), (/=), + (<), (>), (<=), (>=), + min, max +#if MIN_VERSION_base(4,8,0) + , (<*) +#endif + ) + +infix 4 ==, /=, <, <=, >=, > +infixr 3 && +infixr 2 || + +(&&) :: Boolean a => a -> a -> a +(&&) = (&&*) + +(||) :: Boolean a => a -> a -> a +(||) = (||*) + +not :: Boolean a => a -> a +not = notB + + +-- For use with RebindableSyntax +ifThenElse :: IfB a => BooleanOf a -> a -> a -> a +ifThenElse = ifB + + +(==) :: EqB a => a -> a -> BooleanOf a +(==) = (==*) +(/=) :: EqB a => a -> a -> BooleanOf a +(/=) = (/=*) + + +(<) :: OrdB a => a -> a -> BooleanOf a +(<) = (<*) +(>) :: OrdB a => a -> a -> BooleanOf a +(>) = (>*) +(<=) :: OrdB a => a -> a -> BooleanOf a +(<=) = (<=*) +(>=) :: OrdB a => a -> a -> BooleanOf a +(>=) = (>=*) + +min :: (IfB a, OrdB a) => a -> a -> a +min = minB +max :: (IfB a, OrdB a) => a -> a -> a +max = maxB + +