ADPfusion-0.6.0.0: Efficient, high-level dynamic programming.

Safe HaskellNone
LanguageHaskell2010

ADP.Fusion.Core.SynVar.FillTyLvl

Description

TODO Need to add additional type family instances as required.

TODO Need to have little order nats as well.

Synopsis

Documentation

fillTables Source #

Arguments

:: (bigOrder ~ BigOrderNats ts, EachBigOrder bigOrder ts, CountNumberOfCells 0 ts) 
=> ts

The tables

-> ST s (Mutated ts) 
 

class EachBigOrder (boNats :: [Nat]) ts where Source #

This type class instanciates to the specialized machinery for each BigOrder Natural number.

Methods

eachBigOrder :: Proxy boNats -> ts -> ST s [PerfCounter] Source #

Instances
EachBigOrder ([] :: [Nat]) ts Source #

No more big orders to handle.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

eachBigOrder :: Proxy [] -> ts -> ST s [PerfCounter] Source #

(EachBigOrder ns ts, ThisBigOrder n (IsThisBigOrder n ts) ts, CountNumberOfCells n ts) => EachBigOrder (n ': ns) ts Source #

handle this big order.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

eachBigOrder :: Proxy (n ': ns) -> ts -> ST s [PerfCounter] Source #

class ThisBigOrder (boNat :: Nat) (thisOrder :: Bool) ts where Source #

 

Methods

thisBigOrder :: Proxy boNat -> Proxy thisOrder -> ts -> ST s () Source #

getAllBounds :: Proxy boNat -> Proxy thisOrder -> ts -> [()] Source #

Instances
ThisBigOrder boNat anyOrder Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisBigOrder :: Proxy boNat -> Proxy anyOrder -> Z -> ST s () Source #

getAllBounds :: Proxy boNat -> Proxy anyOrder -> Z -> [()] Source #

ThisBigOrder n (IsThisBigOrder n ts) ts => ThisBigOrder n False (ts :. t) Source #

Go down the tables until we find the first table for our big order.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisBigOrder :: Proxy n -> Proxy False -> (ts :. t) -> ST s () Source #

getAllBounds :: Proxy n -> Proxy False -> (ts :. t) -> [()] Source #

(smallOrder ~ SmallOrderNats (ts :. TwITbl bo so m arr c i x), EachSmallOrder boNat smallOrder (ts :. TwITbl bo so m arr c i x) i, PrimArrayOps arr i x, IndexStream i) => ThisBigOrder boNat True (ts :. TwITbl bo so m arr c i x) Source #

We have found the first table for our big order. Extract the bounds and hand over to small order. We do not need to check for another big order with this nat, since all tables are now being filled by the small order.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisBigOrder :: Proxy boNat -> Proxy True -> (ts :. TwITbl bo so m arr c i x) -> ST s () Source #

getAllBounds :: Proxy boNat -> Proxy True -> (ts :. TwITbl bo so m arr c i x) -> [()] Source #

class EachSmallOrder (bigOrder :: Nat) (smallOrders :: [Nat]) ts i where Source #

 

Methods

eachSmallOrder Source #

Arguments

:: Proxy bigOrder

Only fill exactly this big order

-> Proxy smallOrders

These are all the small order to go through.

-> ts

set of tables.

-> i

index to update.

-> ST s () 
Instances
EachSmallOrder bigOrder ([] :: [Nat]) ts i Source #

Went through all tables, nothing more to do.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

eachSmallOrder :: Proxy bigOrder -> Proxy [] -> ts -> i -> ST s () Source #

(EachSmallOrder bigOrder so ts i, isThisBigOrder ~ IsThisBigOrder bigOrder ts, isThisSmallOrder ~ IsThisSmallOrder s ts, isThisOrder ~ (isThisBigOrder && isThisSmallOrder), ThisSmallOrder bigOrder s isThisOrder ts i) => EachSmallOrder bigOrder (s ': so) ts i Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

eachSmallOrder :: Proxy bigOrder -> Proxy (s ': so) -> ts -> i -> ST s0 () Source #

class ThisSmallOrder (bigNat :: Nat) (smallNat :: Nat) (thisOrder :: Bool) ts i where Source #

 

Methods

thisSmallOrder :: Proxy bigNat -> Proxy smallNat -> Proxy thisOrder -> ts -> i -> ST s () Source #

Instances
ThisSmallOrder b s any Z i Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisSmallOrder :: Proxy b -> Proxy s -> Proxy any -> Z -> i -> ST s0 () Source #

(PrimArrayOps arr i x, MPrimArrayOps arr i x, isThisBigOrder ~ IsThisBigOrder bigOrder ts, isThisSmallOrder ~ IsThisSmallOrder smallOrder ts, isThisOrder ~ (isThisBigOrder && isThisSmallOrder), ThisSmallOrder bigOrder smallOrder isThisOrder ts i) => ThisSmallOrder bigOrder smallOrder True (ts :. TwITbl bo so Id arr c i x) i Source #

TODO generalize from Id to any monad in a stack with a primitive base

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisSmallOrder :: Proxy bigOrder -> Proxy smallOrder -> Proxy True -> (ts :. TwITbl bo so Id arr c i x) -> i -> ST s () Source #

(isThisBigOrder ~ IsThisBigOrder bigOrder ts, isThisSmallOrder ~ IsThisSmallOrder smallOrder ts, isThisOrder ~ (isThisBigOrder && isThisSmallOrder), ThisSmallOrder bigOrder smallOrder isThisOrder ts i) => ThisSmallOrder bigOrder smallOrder False (ts :. t) i Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

thisSmallOrder :: Proxy bigOrder -> Proxy smallOrder -> Proxy False -> (ts :. t) -> i -> ST s () Source #

type BigOrderNats arr = Nub (Sort (BigOrderNats' arr)) Source #

The set of arrays to fill is a tuple of the form (Z:.a:.b:.c). Here, we extract the big order Nats. The set of Nats being returned is already ordered with the smallest Nat up front.

type family BigOrderNats' arr :: [Nat] Source #

Instances
type BigOrderNats' Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type BigOrderNats' Z = ([] :: [Nat])
type BigOrderNats' (ts :. TwITbl bo so m arr c i x) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type BigOrderNats' (ts :. TwITbl bo so m arr c i x) = bo ': BigOrderNats' ts

type family IsThisBigOrder (n :: Nat) arr :: Bool Source #

Instances
type IsThisBigOrder n Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type IsThisBigOrder n (ts :. TwITbl bo so m arr c i x) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type IsThisBigOrder n (ts :. TwITbl bo so m arr c i x) = n == bo

type family SmallOrderNats' arr :: [Nat] Source #

Instances
type SmallOrderNats' Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type SmallOrderNats' Z = ([] :: [Nat])
type SmallOrderNats' (ts :. TwITbl bo so m arr c i x) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type SmallOrderNats' (ts :. TwITbl bo so m arr c i x) = so ': SmallOrderNats' ts

type family IsThisSmallOrder (n :: Nat) arr :: Bool Source #

Instances
type IsThisSmallOrder n Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type IsThisSmallOrder n (ts :. TwITbl bo so m arr c i x) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type IsThisSmallOrder n (ts :. TwITbl bo so m arr c i x) = n == so

data Mutated ts Source #

Instances
Eq ts => Eq (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

(==) :: Mutated ts -> Mutated ts -> Bool #

(/=) :: Mutated ts -> Mutated ts -> Bool #

Ord ts => Ord (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

compare :: Mutated ts -> Mutated ts -> Ordering #

(<) :: Mutated ts -> Mutated ts -> Bool #

(<=) :: Mutated ts -> Mutated ts -> Bool #

(>) :: Mutated ts -> Mutated ts -> Bool #

(>=) :: Mutated ts -> Mutated ts -> Bool #

max :: Mutated ts -> Mutated ts -> Mutated ts #

min :: Mutated ts -> Mutated ts -> Mutated ts #

Show ts => Show (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

showsPrec :: Int -> Mutated ts -> ShowS #

show :: Mutated ts -> String #

showList :: [Mutated ts] -> ShowS #

Generic (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Associated Types

type Rep (Mutated ts) :: Type -> Type #

Methods

from :: Mutated ts -> Rep (Mutated ts) x #

to :: Rep (Mutated ts) x -> Mutated ts #

NFData ts => NFData (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

rnf :: Mutated ts -> () #

type Rep (Mutated ts) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type Rep (Mutated ts) = D1 (MetaData "Mutated" "ADP.Fusion.Core.SynVar.FillTyLvl" "ADPfusion-0.6.0.0-4IFRXlyJait74rLMOZ899H" False) (C1 (MetaCons "Mutated" PrefixI True) (S1 (MetaSel (Just "mutatedTables") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ts) :*: (S1 (MetaSel (Just "perfCounter") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 PerfCounter) :*: S1 (MetaSel (Just "eachBigPerfCounter") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [PerfCounter]))))

data PerfCounter Source #

Instances
Eq PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Num PerfCounter Source #

Adding two PerfCounters yields the time they take together.

Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Ord PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Show PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Generic PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Associated Types

type Rep PerfCounter :: Type -> Type #

NFData PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

rnf :: PerfCounter -> () #

type Rep PerfCounter Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

type Rep PerfCounter = D1 (MetaData "PerfCounter" "ADP.Fusion.Core.SynVar.FillTyLvl" "ADPfusion-0.6.0.0-4IFRXlyJait74rLMOZ899H" False) (C1 (MetaCons "PerfCounter" PrefixI True) (S1 (MetaSel (Just "picoSeconds") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer) :*: (S1 (MetaSel (Just "seconds") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Double) :*: S1 (MetaSel (Just "numberOfCells") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer))))

class CountNumberOfCells (n :: Nat) t where Source #

Instances
CountNumberOfCells n Z Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

(CountNumberOfCells n ts, Index i, PrimArrayOps arr i x, KnownNat n, KnownNat bo) => CountNumberOfCells n (ts :. TwITbl bo so Id arr c i x) Source # 
Instance details

Defined in ADP.Fusion.Core.SynVar.FillTyLvl

Methods

countNumberOfCells :: Maybe (Proxy n) -> (ts :. TwITbl bo so Id arr c i x) -> Integer Source #