fix the built-in typeclasses mess
This commit is contained in:
parent
12af0730eb
commit
0d5d0f0885
@ -16,12 +16,10 @@ module Data.Nat where
|
|||||||
|
|
||||||
import Relation.Equality
|
import Relation.Equality
|
||||||
import Data.Bool
|
import Data.Bool
|
||||||
import Data.Integer (Integer)
|
import Data.Integer
|
||||||
import Data.Function (id, const, (∘))
|
import Data.Function
|
||||||
import Data.TypeClass (Eq, Show, Num, Enum, Bounded)
|
|
||||||
import Data.Singletons.TH hiding ((:<), (:>), (%:<), Refl, Min, sMin, Max, sMax)
|
import Data.Singletons.TH hiding ((:<), (:>), (%:<), Refl, Min, sMin, Max, sMax)
|
||||||
|
import Data.TypeClass as T
|
||||||
import qualified Data.TypeClass as T
|
|
||||||
|
|
||||||
singletons [d|
|
singletons [d|
|
||||||
|
|
||||||
@ -29,7 +27,6 @@ singletons [d|
|
|||||||
data ℕ ∷ ★ where
|
data ℕ ∷ ★ where
|
||||||
Z ∷ ℕ -- ^ Zero
|
Z ∷ ℕ -- ^ Zero
|
||||||
S ∷ ℕ → ℕ -- ^ Successor
|
S ∷ ℕ → ℕ -- ^ Successor
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
infixl 6 +
|
infixl 6 +
|
||||||
infixl 7 ×
|
infixl 7 ×
|
||||||
@ -86,37 +83,40 @@ singletons [d|
|
|||||||
fact (S n) = (S n) × (fact n)
|
fact (S n) = (S n) × (fact n)
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
deriving instance Eq ℕ
|
||||||
|
|
||||||
|
deriving instance Show ℕ
|
||||||
|
|
||||||
instance Num ℕ where
|
instance Num ℕ where
|
||||||
(+) = (+)
|
(+) = (Data.Nat.+)
|
||||||
(-) = (-)
|
(-) = (Data.Nat.-)
|
||||||
(*) = (×)
|
(*) = (Data.Nat.×)
|
||||||
abs = id
|
abs = id
|
||||||
signum = const 1
|
signum = const 1
|
||||||
negate = id
|
negate = id
|
||||||
fromInteger = fromInteger
|
fromInteger = _ℤtoℕ
|
||||||
|
|
||||||
instance Enum ℕ where
|
instance Enum ℕ where
|
||||||
toEnum = fromInteger ∘ T.toInteger
|
toEnum = _ℤtoℕ ∘ T.toInteger
|
||||||
fromEnum = T.fromInteger ∘ toInteger
|
fromEnum = T.fromInteger ∘ _ℕtoℤ
|
||||||
|
|
||||||
instance Bounded ℕ where
|
instance Bounded ℕ where
|
||||||
minBound = Z
|
minBound = Z
|
||||||
maxBound = (∞)
|
maxBound = (∞)
|
||||||
|
|
||||||
|
|
||||||
-- | Convert a natural into an 'Integer'
|
-- | Convert a natural into an integer
|
||||||
toInteger ∷ ℕ → Integer
|
_ℕtoℤ ∷ ℕ → ℤ
|
||||||
toInteger Z = 0
|
_ℕtoℤ Z = 0
|
||||||
toInteger (S n) = 1 T.+ toInteger n
|
_ℕtoℤ (S n) = 1 T.+ _ℕtoℤ n
|
||||||
|
|
||||||
|
|
||||||
-- | Convert an 'Integer' into a natural
|
-- | Convert an integer into a natural
|
||||||
fromInteger ∷ Integer → ℕ
|
_ℤtoℕ ∷ ℤ → ℕ
|
||||||
fromInteger 0 = Z
|
_ℤtoℕ 0 = Z
|
||||||
fromInteger n
|
_ℤtoℕ n
|
||||||
| n T.<= 0 = 0
|
| n T.<= 0 = Z
|
||||||
| n T.> 0 = S (fromInteger (T.pred n))
|
| n T.> 0 = S (_ℤtoℕ (T.pred n))
|
||||||
|
|
||||||
|
|
||||||
-- | Infinity
|
-- | Infinity
|
||||||
|
@ -1,10 +1,13 @@
|
|||||||
|
{-# LANGUAGE UnicodeSyntax #-}
|
||||||
|
{-# LANGUAGE RebindableSyntax #-}
|
||||||
|
|
||||||
-- | Exports haskell built-in typeclasses
|
-- | Exports haskell built-in typeclasses
|
||||||
module Data.TypeClass
|
module Data.TypeClass
|
||||||
( Eq(..)
|
( Eq(..)
|
||||||
, Ord(..)
|
, Ord(..)
|
||||||
, Enum(..)
|
, Enum(..)
|
||||||
, Bounded(..)
|
, Bounded(..)
|
||||||
, Num(..)
|
, Num(..), (×)
|
||||||
, Integral(..)
|
, Integral(..)
|
||||||
, Show(..)
|
, Show(..)
|
||||||
, Read(..)
|
, Read(..)
|
||||||
@ -17,3 +20,10 @@ import GHC.Show
|
|||||||
import GHC.Read
|
import GHC.Read
|
||||||
import GHC.Num
|
import GHC.Num
|
||||||
import GHC.Exts
|
import GHC.Exts
|
||||||
|
import Prelude (Eq(..), Ord(..), Integral(..))
|
||||||
|
|
||||||
|
-- * Aliases
|
||||||
|
|
||||||
|
-- | Multiplication
|
||||||
|
(×) ∷ Num a ⇒ a → a → a
|
||||||
|
(×) = (*)
|
||||||
|
@ -8,10 +8,9 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE UnicodeSyntax #-}
|
{-# LANGUAGE UnicodeSyntax #-}
|
||||||
|
{-# LANGUAGE RebindableSyntax #-}
|
||||||
|
|
||||||
-- | Defines a vector type, analogous to a list, that achieves
|
-- | Defines a vector type, analogous to a list, that achieves
|
||||||
-- type-safe operation like resizing and concatenation by using
|
-- type-safe operation like resizing and concatenation by using
|
||||||
@ -20,14 +19,14 @@ module Data.Vec where
|
|||||||
|
|
||||||
import Relation.Equality (gcastWith)
|
import Relation.Equality (gcastWith)
|
||||||
import Data.Kind (Type)
|
import Data.Kind (Type)
|
||||||
import Data.Nat
|
import Data.Nat hiding ((+), (-), (×), min, max)
|
||||||
import Data.Bool
|
import Data.Bool
|
||||||
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.Char (Char)
|
import Data.Char (Char)
|
||||||
import Data.Function ((∘))
|
import Data.Function ((∘))
|
||||||
import Data.TypeClass (Show, Eq, Ord, Num, IsList, IsString)
|
|
||||||
import Data.Singletons (SingI, sing)
|
import Data.Singletons (SingI, sing)
|
||||||
|
|
||||||
import qualified Data.TypeClass as T
|
import Data.TypeClass
|
||||||
|
|
||||||
|
|
||||||
infixr 5 :-
|
infixr 5 :-
|
||||||
@ -45,12 +44,12 @@ type String n = Vec Char n
|
|||||||
deriving instance Eq a ⇒ Eq (Vec a n)
|
deriving instance Eq a ⇒ Eq (Vec a n)
|
||||||
|
|
||||||
instance Show a ⇒ Show (Vec a n) where
|
instance Show a ⇒ Show (Vec a n) where
|
||||||
showsPrec d = T.showsPrec d ∘ toList
|
showsPrec d = showsPrec d ∘ vecToList
|
||||||
|
|
||||||
instance SingI n ⇒ IsList (Vec a n) where
|
instance SingI n ⇒ IsList (Vec a n) where
|
||||||
type Item (Vec a n) = a
|
type Item (Vec a n) = a
|
||||||
fromList = fromList
|
fromList = listToVec
|
||||||
toList = toList
|
toList = vecToList
|
||||||
|
|
||||||
instance SingI n ⇒ IsString (String n) where
|
instance SingI n ⇒ IsString (String n) where
|
||||||
fromString = fromList
|
fromString = fromList
|
||||||
@ -60,9 +59,9 @@ instance SingI n ⇒ IsString (String n) where
|
|||||||
-- * Conversions
|
-- * Conversions
|
||||||
|
|
||||||
-- | Convert a 'Vec' into a List
|
-- | Convert a 'Vec' into a List
|
||||||
toList ∷ Vec a n → [a]
|
vecToList ∷ Vec a n → [a]
|
||||||
toList Nil = []
|
vecToList Nil = []
|
||||||
toList (x :- xs) = x : toList xs
|
vecToList (x :- xs) = x : vecToList xs
|
||||||
|
|
||||||
|
|
||||||
-- | Convert a List into a 'Vec'
|
-- | Convert a List into a 'Vec'
|
||||||
@ -70,8 +69,8 @@ toList (x :- xs) = x : toList xs
|
|||||||
-- It's not possible to convert an infinite list to a vector
|
-- It's not possible to convert an infinite list to a vector
|
||||||
-- as haskell does not permit constructing infinite type,
|
-- as haskell does not permit constructing infinite type,
|
||||||
-- which the resulting vector length would be.
|
-- which the resulting vector length would be.
|
||||||
fromList ∷ SingI n ⇒ [a] → Vec a n
|
listToVec ∷ SingI n ⇒ [a] → Vec a n
|
||||||
fromList = f sing
|
listToVec = f sing
|
||||||
where f ∷ Sℕ n → [a] → Vec a n
|
where f ∷ Sℕ n → [a] → Vec a n
|
||||||
f SZ _ = Nil
|
f SZ _ = Nil
|
||||||
f (SS n) (x:xs) = x :- f n xs
|
f (SS n) (x:xs) = x :- f n xs
|
||||||
@ -278,24 +277,27 @@ all p (x :- xs) = and (map p (x :- xs))
|
|||||||
|
|
||||||
-- | The least element of a vector.
|
-- | The least element of a vector.
|
||||||
minimum ∷ Ord a ⇒ Vec a (S n) → a
|
minimum ∷ Ord a ⇒ Vec a (S n) → a
|
||||||
minimum = foldr₁ T.min
|
minimum = foldr₁ min
|
||||||
|
|
||||||
|
|
||||||
-- | The largest element of a vector.
|
-- | The largest element of a vector.
|
||||||
maximum ∷ Ord a ⇒ Vec a (S n) → a
|
maximum ∷ Ord a ⇒ Vec a (S n) → a
|
||||||
maximum = foldr₁ T.max
|
maximum = foldr₁ max
|
||||||
|
|
||||||
|
|
||||||
-- | The 'sum' function computes the sum of the numbers of a vector.
|
-- | The 'sum' function computes the sum of the numbers of a vector.
|
||||||
sum ∷ Num a ⇒ Vec a n → a
|
sum ∷ Num a ⇒ Vec a n → a
|
||||||
sum = foldr (T.+) 0
|
sum = foldr (+) 0
|
||||||
|
|
||||||
|
|
||||||
-- | The 'product' function computes the product of the numbers of a vector.
|
-- | The 'product' function computes the product of the numbers of a vector.
|
||||||
product ∷ Num a ⇒ Vec a n → a
|
product ∷ Num a ⇒ Vec a n → a
|
||||||
product = foldr (T.*) 0
|
product = foldr (×) 1
|
||||||
|
|
||||||
|
|
||||||
|
-- * Subvectors
|
||||||
|
-- Extracting subvectors
|
||||||
|
|
||||||
-- | 'take' returns the first @n@ element of the vector
|
-- | 'take' returns the first @n@ element of the vector
|
||||||
take ∷ ∀ a n m. SingI n ⇒ Vec a m → Vec a n
|
take ∷ ∀ a n m. SingI n ⇒ Vec a m → Vec a n
|
||||||
take = take' (sing ∷ Sℕ n)
|
take = take' (sing ∷ Sℕ n)
|
||||||
|
Loading…
Reference in New Issue
Block a user