natural-arithmetic-0.2.3.0: Arithmetic of natural numbers
Safe HaskellNone
LanguageHaskell2010

Arithmetic.Fin

Synopsis

Modification

incrementL :: forall (n :: Nat) (m :: Nat). Nat m -> Fin n -> Fin (m + n) Source #

Raise the index by m and weaken the bound by m, adding m to the left-hand side of n.

incrementL# :: forall (n :: Nat) (m :: Nat). Nat# m -> Fin# n -> Fin# (m + n) Source #

incrementR :: forall (n :: Nat) (m :: Nat). Nat m -> Fin n -> Fin (n + m) Source #

Raise the index by m and weaken the bound by m, adding m to the right-hand side of n.

incrementR# :: forall (n :: Nat) (m :: Nat). Nat# m -> Fin# n -> Fin# (n + m) Source #

weaken :: forall (n :: Nat) (m :: Nat). (n <= m) -> Fin n -> Fin m Source #

Weaken the bound, replacing it by another number greater than or equal to itself. This does not change the index.

weaken# :: forall (n :: Nat) (m :: Nat). (n <=# m) -> Fin# n -> Fin# m Source #

weakenL :: forall (n :: Nat) (m :: Natural). Fin n -> Fin (m + n) Source #

Weaken the bound by m, adding it to the left-hand side of the existing bound. This does not change the index.

weakenL# :: forall (n :: Nat) (m :: Natural). Fin# n -> Fin# (m + n) Source #

Unboxed variant of weakenL.

weakenR :: forall (n :: Nat) (m :: Natural). Fin n -> Fin (n + m) Source #

Weaken the bound by m, adding it to the right-hand side of the existing bound. This does not change the index.

weakenR# :: forall (n :: Nat) (m :: Natural). Fin# n -> Fin# (n + m) Source #

Unboxed variant of weakenR.

succ :: forall (n :: Nat). Nat n -> Fin n -> Maybe (Fin n) Source #

Return the successor of the Fin or return nothing if the argument is the greatest inhabitant.

succ# :: forall (n :: Nat). Nat# n -> Fin# n -> MaybeFin# n Source #

Variant of succ for unlifted finite numbers.

Traverse

These use the terms ascend and descend rather than the more popular l (left) and r (right) that pervade the Haskell ecosystem. The general rule is that ascending functions pair the initial accumulator with zero with descending functions pair the initial accumulator with the last index.

ascend :: forall a (n :: Nat). Nat n -> a -> (Fin n -> a -> a) -> a Source #

Fold over the numbers bounded by n in ascending order. This is lazy in the accumulator.

ascend 4 z f = f 3 (f 2 (f 1 (f 0 z)))

ascend' Source #

Arguments

:: forall a (n :: Nat). Nat n

Upper bound

-> a

Initial accumulator

-> (Fin n -> a -> a)

Update accumulator

-> a 

Strict fold over the numbers bounded by n in ascending order. For convenince, this differs from foldl' in the order of the parameters.

ascend' 4 z f = f 3 (f 2 (f 1 (f 0 z)))

ascendFrom' Source #

Arguments

:: forall a (m :: Nat) (n :: Nat). Nat m

Index to start at

-> Nat n

Number of steps to take

-> a

Initial accumulator

-> (Fin (m + n) -> a -> a)

Update accumulator

-> a 

Generalization of ascend' that lets the caller pick the starting index:

ascend' === ascendFrom' 0

ascendFrom'# Source #

Arguments

:: forall a (m :: Nat) (n :: Nat). Nat# m

Index to start at

-> Nat# n

Number of steps to take

-> a

Initial accumulator

-> (Fin# (m + n) -> a -> a)

Update accumulator

-> a 

Variant of ascendFrom' with unboxed arguments.

ascendM Source #

Arguments

:: forall m a (n :: Nat). Monad m 
=> Nat n

Upper bound

-> a

Initial accumulator

-> (Fin n -> a -> m a)

Update accumulator

-> m a 

Strict monadic left fold over the numbers bounded by n in ascending order. Roughly:

ascendM 4 z0 f =
  f 0 z0 >>= \z1 ->
  f 1 z1 >>= \z2 ->
  f 2 z2 >>= \z3 ->
  f 3 z3

ascendM# Source #

Arguments

:: forall m a (n :: Nat). Monad m 
=> Nat# n

Upper bound

-> a

Initial accumulator

-> (Fin# n -> a -> m a)

Update accumulator

-> m a 

Variant of ascendM that takes an unboxed Nat and provides an unboxed Fin to the callback.

ascendM_ Source #

Arguments

:: forall m a (n :: Nat). Applicative m 
=> Nat n

Upper bound

-> (Fin n -> m a)

Effectful interpretion

-> m () 

Monadic traversal of the numbers bounded by n in ascending order.

ascendM_ 4 f = f 0 *> f 1 *> f 2 *> f 3

ascendM_# Source #

Arguments

:: forall m a (n :: Nat). Monad m 
=> Nat# n

Upper bound

-> (Fin# n -> m a)

Update accumulator

-> m () 

Variant of ascendM_ that takes an unboxed Nat and provides an unboxed Fin to the callback.

ascendFromToM_# Source #

Arguments

:: forall m a (i :: Nat) (n :: Nat). Monad m 
=> Nat# i

Index to start at (inclusive)

-> Nat# n

Upper bound (exclusive)

-> (Fin# n -> m a)

Update accumulator

-> m () 

descend Source #

Arguments

:: forall a (n :: Nat). Nat n

Upper bound

-> a

Initial accumulator

-> (Fin n -> a -> a)

Update accumulator

-> a 

Fold over the numbers bounded by n in descending order. This is lazy in the accumulator. For convenince, this differs from foldr in the order of the parameters.

descend 4 z f = f 0 (f 1 (f 2 (f 3 z)))

descend# Source #

Arguments

:: forall a (n :: Nat). Nat# n

Upper bound

-> a

Initial accumulator

-> (Fin# n -> a -> a)

Update accumulator

-> a 

descend' Source #

Arguments

:: forall a (n :: Nat). Nat n

Upper bound

-> a

Initial accumulator

-> (Fin n -> a -> a)

Update accumulator

-> a 

Fold over the numbers bounded by n in descending order. This is strict in the accumulator. For convenince, this differs from foldr' in the order of the parameters.

descend 4 z f = f 0 (f 1 (f 2 (f 3 z)))

descendM :: forall m a (n :: Nat). Monad m => Nat n -> a -> (Fin n -> a -> m a) -> m a Source #

Strict monadic left fold over the numbers bounded by n in descending order. Roughly:

descendM 4 z f =
  f 3 z0 >>= \z1 ->
  f 2 z1 >>= \z2 ->
  f 1 z2 >>= \z3 ->
  f 0 z3

descendM_ Source #

Arguments

:: forall m a (n :: Nat). Applicative m 
=> Nat n

Upper bound

-> (Fin n -> m a)

Effectful interpretion

-> m () 

Monadic traversal of the numbers bounded by n in descending order.

descendM_ 4 f = f 3 *> f 2 *> f 1 *> f 0

ascending :: forall (n :: Nat). Nat n -> [Fin n] Source #

Generate all values of a finite set in ascending order.

>>> ascending (Nat.constant @3)
[Fin 0,Fin 1,Fin 2]

descending :: forall (n :: Nat). Nat n -> [Fin n] Source #

Generate all values of a finite set in descending order.

>>> descending (Nat.constant @3)
[Fin 2,Fin 1,Fin 0]

ascendingSlice :: forall (n :: Nat) (off :: Nat) (len :: Nat). Nat off -> Nat len -> ((off + len) <= n) -> [Fin n] Source #

Generate len values starting from off in ascending order.

>>> ascendingSlice (Nat.constant @2) (Nat.constant @3) (Lte.constant @_ @6)
[Fin 2,Fin 3,Fin 4]

descendingSlice :: forall (n :: Nat) (off :: Nat) (len :: Nat). Nat off -> Nat len -> ((off + len) <= n) -> [Fin n] Source #

Generate len values starting from 'off + len - 1' in descending order.

>>> descendingSlice (Nat.constant @2) (Nat.constant @3) (Lt.constant @6)
[Fin 4,Fin 3,Fin 2]

Absurdities

absurd :: Fin 0 -> void Source #

A finite set of no values is impossible.

Demote

demote :: forall (n :: Nat). Fin n -> Int Source #

Extract the Int from a 'Fin n'. This is intended to be used at a boundary where a safe interface meets the unsafe primitives on top of which it is built.

demote# :: forall (n :: Nat). Fin# n -> Int# Source #

demote32# :: forall (n :: Nat). Fin32# n -> Int32# Source #

Deconstruct

with :: forall (n :: Nat) a. Fin n -> (forall (i :: Nat). (i < n) -> Nat i -> a) -> a Source #

Consume the natural number and the proof in the Fin.

with# :: forall (n :: Nat) a. Fin# n -> (forall (i :: Nat). (i <# n) -> Nat# i -> a) -> a Source #

Variant of with for unboxed argument and result types.

Construct

construct# :: forall (i :: Nat) (n :: Nat). (i <# n) -> Nat# i -> Fin# n Source #

nativeTo32# :: forall (n :: Nat). (n <=# 2147483648) -> Fin# n -> Fin32# n Source #

nativeFrom32# :: forall (n :: Nat). Fin32# n -> Fin# n Source #

remInt# :: forall (n :: Nat). Int# -> Nat# n -> Fin# n Source #

This crashes if n = 0. Divides i by n and takes the remainder.

remWord# :: forall (n :: Nat). Word# -> Nat# n -> Fin# n Source #

This crashes if n = 0. Divides i by n and takes the remainder.

fromInt Source #

Arguments

:: forall (n :: Nat). Nat n

exclusive upper bound

-> Int 
-> Maybe (Fin n) 

Convert an Int to a finite number, testing that it is less than the upper bound. This crashes with an uncatchable exception when given a negative number.

fromInt# Source #

Arguments

:: forall (n :: Nat). Nat# n

exclusive upper bound

-> Int# 
-> MaybeFin# n 

Unboxed variant of fromInt.

constant# :: forall (b :: Nat) (a :: Nat). CmpNat a b ~ 'LT => Nat# a -> Fin# b Source #

Create an unlifted finite number from an unlifted natural number. The upper bound is the first type argument so that user can use type applications to clarify when it is helpful. For example:

>>> Fin.constant# @10 N4#

greatest# :: forall (n :: Nat). Nat# n -> Fin# (n + 1) Source #

Compare

equals# :: forall (n :: Nat). Fin# n -> Fin# n -> Bool Source #

Substitute Bound

substitute# :: forall (m :: Nat) (n :: Nat). (m :=:# n) -> Fin# m -> Fin# n Source #

Lift and Unlift

lift :: forall (n :: Nat). Fin# n -> Fin n Source #

unlift :: forall (n :: Nat). Fin n -> Fin# n Source #