Agda-2.5.2: A dependently typed functional programming language and proof assistant

Safe HaskellNone
LanguageHaskell2010

Agda.TypeChecking.Serialise.Base

Synopsis

Documentation

type Node = [Int32] Source #

Constructor tag (maybe omitted) and argument indices.

type HashTable k v = BasicHashTable k v Source #

The type of hashtables used in this module.

A very limited amount of testing indicates that CuckooHashTable is somewhat slower than BasicHashTable, and that LinearHashTable and the hashtables from Data.Hashtable are much slower.

data FreshAndReuse Source #

Structure providing fresh identifiers for hash map and counting hash map hits (i.e. when no fresh identifier required).

Constructors

FreshAndReuse 

Fields

type QNameId = [NameId] Source #

Two QNames are equal if their QNameId is equal.

qnameId :: QName -> QNameId Source #

Computing a qualified names composed ID.

data Dict Source #

State of the the encoder.

Constructors

Dict 

Fields

emptyDict Source #

Arguments

:: Bool

Collect statistics for icode calls?

-> IO Dict 

Creates an empty dictionary.

data U Source #

Universal type, wraps everything.

Constructors

Typeable a => U !a 

type Memo = HashTable (Int32, TypeRep) U Source #

Univeral memo structure, to introduce sharing during decoding

data St Source #

State of the decoder.

Constructors

St 

Fields

type S a = ReaderT Dict IO a Source #

Monad used by the encoder.

type R a = ExceptT TypeError (StateT St IO) a Source #

Monad used by the decoder.

TCM is not used because the associated overheads would make decoding slower.

malformed :: R a Source #

Throws an error which is suitable when the data stream is malformed.

class Typeable a => EmbPrj a where Source #

Minimal complete definition

icod_, value

Methods

icode :: a -> S Int32 Source #

icod_ :: a -> S Int32 Source #

value :: Int32 -> R a Source #

tickICode :: forall a. Typeable a => a -> S () Source #

Increase entry for a in stats.

runGetState :: Get a -> ByteString -> ByteOffset -> (a, ByteString, ByteOffset) Source #

Data.Binary.runGetState is deprecated in favour of runGetIncremental. Reimplementing it in terms of the new function. The new Decoder type contains strict byte strings so we need to be careful not to feed the entire lazy byte string to the decoder at once.

icodeX :: (Eq k, Hashable k) => (Dict -> HashTable k Int32) -> (Dict -> IORef FreshAndReuse) -> k -> S Int32 Source #

icodeMemo Source #

Arguments

:: (Ord a, Hashable a) 
=> (Dict -> HashTable a Int32)

Memo structure for thing of key a.

-> (Dict -> IORef FreshAndReuse)

Statistics.

-> a

Key to the thing.

-> S Int32

Fallback computation to encode the thing.

-> S Int32

Encoded thing.

icode only if thing has not seen before.

vcase :: forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a Source #

vcase value ix decodes thing represented by ix :: Int32 via the valu function and stores it in nodeMemo. If ix is present in nodeMemo, valu is not used, but the thing is read from nodeMemo instead.

icode1 :: EmbPrj a => Int32 -> a -> S Int32 Source #

icode2 :: (EmbPrj a, EmbPrj b) => Int32 -> a -> b -> S Int32 Source #

icode3 :: (EmbPrj a, EmbPrj b, EmbPrj c) => Int32 -> a -> b -> c -> S Int32 Source #

icode4 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) => Int32 -> a -> b -> c -> d -> S Int32 Source #

icode5 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) => Int32 -> a -> b -> c -> d -> e -> S Int32 Source #

icode6 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) => Int32 -> a -> b -> c -> d -> e -> f -> S Int32 Source #

icode7 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g) => Int32 -> a -> b -> c -> d -> e -> f -> g -> S Int32 Source #

icode8 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> S Int32 Source #

icode9 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> S Int32 Source #

icode10 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> S Int32 Source #

icode11 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> S Int32 Source #

icode12 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> S Int32 Source #

icode13 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> S Int32 Source #

icode14 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m, EmbPrj n) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> S Int32 Source #

icode15 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m, EmbPrj n, EmbPrj o) => Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> S Int32 Source #

icode1' :: EmbPrj a => a -> S Int32 Source #

icode2' :: (EmbPrj a, EmbPrj b) => a -> b -> S Int32 Source #

icode3' :: (EmbPrj a, EmbPrj b, EmbPrj c) => a -> b -> c -> S Int32 Source #

icode4' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) => a -> b -> c -> d -> S Int32 Source #

icode5' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) => a -> b -> c -> d -> e -> S Int32 Source #

icode6' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) => a -> b -> c -> d -> e -> f -> S Int32 Source #

icode7' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g) => a -> b -> c -> d -> e -> f -> g -> S Int32 Source #

icode8' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h) => a -> b -> c -> d -> e -> f -> g -> h -> S Int32 Source #

icode9' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i) => a -> b -> c -> d -> e -> f -> g -> h -> i -> S Int32 Source #

icode10' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j) => a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> S Int32 Source #

icode11' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k) => a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> S Int32 Source #

icode12' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l) => a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> S Int32 Source #

icode13' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m) => a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> S Int32 Source #

icode14' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m, EmbPrj n) => a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> S Int32 Source #

valu0 :: a -> R a Source #

valu1 :: EmbPrj a => (a -> b) -> Int32 -> R b Source #

valu2 :: (EmbPrj a, EmbPrj b) => (a -> b -> c) -> Int32 -> Int32 -> R c Source #

valu3 :: (EmbPrj a, EmbPrj b, EmbPrj c) => (a -> b -> c -> d) -> Int32 -> Int32 -> Int32 -> R d Source #

valu4 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) => (a -> b -> c -> d -> e) -> Int32 -> Int32 -> Int32 -> Int32 -> R e Source #

valu5 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) => (a -> b -> c -> d -> e -> f) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R f Source #

valu6 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) => (a -> b -> c -> d -> e -> f -> g) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R g Source #

valu7 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g) => (a -> b -> c -> d -> e -> f -> g -> h) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R h Source #

valu8 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h) => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R i Source #

valu9 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R j Source #

valu10 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R k Source #

valu11 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R l Source #

valu12 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R m Source #

valu13 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R n Source #

valu14 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m, EmbPrj n) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R o Source #

valu15 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f, EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l, EmbPrj m, EmbPrj n, EmbPrj o) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p) -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> R p Source #