packages feed

columbia 0.1.3 → 0.2

raw patch · 21 files changed

+6/−2398 lines, 21 files

Files

columbia.cabal view
@@ -2,13 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                columbia
-version:             0.1.3
-synopsis:            Enhanced serialization for media that support seeking.
-description:         Libraries such as binary and cereal support sequential reading and writing but do not rely on any further operations. Many media support seeking in files as well. This library implements a file format that supports random access to data entities by seeking. It is an attempt to improve and extend the applicability of the object graph serialization concept.
-	.
-	This library enforces a strong concept of immutability in its interface; this has a number of benefits including sharing of substructure. Files in its format have a nominal mutable state that changes over discrete time steps, permitting strong reasoning. See Theory module for a basic equational theory. This work was inspired by Haskell's focus on immutability, and by the programming langauge Clojure's disciplined management of mutable state.
-	.
-	The database's store has been implemented over memory maps for speed, and is portable between Windows and Linux platforms. This library also uses the syb-with-class library to streamline implementation of serializers for various data entities, so that you don't have to write much boilerplate ;).
+version:             0.2
+synopsis:            Enhanced serialization using seeking.
+description:         Fundamental problems have been discovered with the architecture of this library. It is no longer supported and its use is not recommended. If it is really needed, it is available in one of the old versions.
 	.
 	Release notes for version 0.1.1:
 	.
@@ -22,7 +18,7 @@ 	.
 	Release notes for version 0.1.3:
 	.
-	* implemented additional functions specifically for handling dictionaries ('Map's).
+	* Implemented additional functions specifically for handling dictionaries ('Map's).
 	.
 	* Added basic theory.
 license:             BSD3
@@ -36,11 +32,10 @@ cabal-version:       >=1.10
 
 library
-  exposed-modules:     Data.Columbia, Data.Columbia.CompoundData, Data.Columbia.Utils, Data.Columbia.Gc, Data.Columbia.CycleDetection, Data.Columbia.FRecord, Data.Columbia.WithAddress, Data.Columbia.Dictionaries, Data.Columbia.DynamicWithCtx, Data.Columbia.Types, Data.Columbia.Theory
-  other-modules:       Data.Columbia.Internal.Coercion, Data.Columbia.Internal.RWInstances, Data.Columbia.Internal.Mapper, Data.Columbia.Internal.DualLock, Data.Columbia.Internal.IntegralTypes, Data.Columbia.Internal.Headers, Data.Columbia.Internal.Orphans, Data.Columbia.Internal.SeekableStream, Data.Columbia.Internal.SeekableWriter
+  exposed-modules:
+  other-modules:
   -- other-extensions:    
   build-depends:       base >=4.6 && <=5, filelock ==0.1.0.1, contravariant >=1.4, bytestring >=0.10 && <0.11, monad-loops ==0.4.3, mtl ==2.2.1, directory >=1.2.2.0, syb-with-class ==0.6.1.8, array >=0.5.1 && <0.5.3, invariant >=0.4.2, containers ==0.5.10.2, pointless-haskell ==0.0.9, mmorph ==1.0.9, parallel ==3.2.1.1, transformers >=0.4.2.0 && <=0.5.0.0, mmap ==0.5.9, data-endian ==0.1
   if os(mingw32)
     cpp-options: -DWIN32
-  hs-source-dirs:      src
   default-language:    Haskell98
− src/Data/Columbia.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE Trustworthy, Rank2Types, TypeFamilies, FlexibleContexts #-}
-
-module Data.Columbia (module Data.Columbia.CompoundData, module Data.Columbia.CycleDetection, module Data.Columbia.Utils, module Data.Columbia.Gc, module Data.Columbia.FRecord, module Data.Columbia.WithAddress, module Data.Generics.SYB.WithClass.Basics, module Data.Generics.SYB.WithClass.Context, module Generics.Pointless.Functors, module Control.Monad.IO.Class, module Control.Monad.Reader,
--- ** Idioms
-rwProxy, readCompoundData, writeCompoundData, rwKeyProxy, readDataWithCycles, writeDataWithCycles) where
-
-import Data.Map
-import Data.Dynamic (Dynamic)
-import Data.Columbia.CompoundData
-import Data.Columbia.CycleDetection
-import Data.Columbia.Utils
-import Data.Columbia.Gc
-import Data.Columbia.FRecord
-import Data.Columbia.WithAddress
-import Data.Columbia.DynamicWithCtx
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Context
-import Data.Word
-import Control.Monad.IO.Class
-import Control.Monad.Reader
-import Generics.Pointless.Functors hiding (Functor,fmap)
-
--- | Most common idiom of using 'readOneLayer'; reads an entire data structure.
-readCompoundData :: forall m d. (Monad m, Data(PairCtx RWCtx NoCtx) d) => ReaderT(SeekableStream m Word8) m d
-readCompoundData = fixT rwProxy(withAddresses #. readOneLayer)
-
--- | Convenient idiom; sells targets repeatedly until the entire data structure has been written.
-writeCompoundData :: forall m d. (Monad m, Data(PairCtx RWCtx NoCtx) d)
-	=> d -> ReaderT(SeekableWriter m Word8) m ()
-writeCompoundData = fixTW rwProxy(writeBackAddresses ##. writeOneLayer)
-
-rwKeyProxy :: Proxy(PairCtx RWCtx(PairCtx KeyCtx NoCtx))
-rwKeyProxy = error"proxy"
-
-readDataWithCycles :: forall m d. (MonadFix m, StateM m, StateOf m ~ Map Word32 Dynamic, Data(PairCtx RWCtx(PairCtx KeyCtx NoCtx)) d) => ReaderT(SeekableStream m Word8) m d
-readDataWithCycles = fixT rwKeyProxy(withAddresses #. cycleDetect #. readOneLayer)
-
-writeDataWithCycles :: forall m d. (StateM m, StateOf m ~ Map(DynamicWithCtx KeyComparable) Word32, Data(PairCtx RWCtx(PairCtx KeyCtx NoCtx)) d)
-	=> d -> ReaderT(SeekableWriter m Word8) m ()
-writeDataWithCycles = fixTW rwKeyProxy(writeBackAddresses ##. cycleDetectW ##. writeOneLayer)
− src/Data/Columbia/CompoundData.hs 
@@ -1,241 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, ScopedTypeVariables, TypeOperators, Rank2Types, ImpredicativeTypes, Trustworthy #-}
-
--- | Serialization of compound data types (with class!). Also read and write methods' type class contexts
---   are implemented with heterogeneous list constraints, making them sufficiently abstract. For every
---   context FooCtx that a program uses, one has a constraint /HasField ctx FooCtx/, that allows
---   one to find the context evidence in the concrete context.
---
---   The recursive function that is generally needed to traverse some data is implemented in 'readOneLayer'.
---   A poly-traversal (aka strategy) is a function that is inserted into this recursive call chain. For instance,
---   'cycReadCompoundData' is a poly-traversal implementing cycle detection for circular data dependencies,
---   but it leaves the programmer free to determine exactly how the layers are to be read. The types of
---   poly-traversals are found in 'PolyTraversal' and 'PolyTraversalW'.
---
---   The library uses a concept of strategy/poly-traversal to coordinate reading. Poly-traversals have as a
---   precondition that they must be seeked at a data entity at address 'n', an invariant that they must seek
---   to some other data entity before calling each of their parameter operations, and a postcondition that
---   they must leave the stream seeked at 'n'. The operations in Integral, Headers, SeekableStream, and
---   SeekableWriter do not obey these properties; they are low-level implementation functions.
---
---   The functions 'readOneLayer' and 'writeOneLayer' do appropriate checking that the data being read is
---   of the correct shape for the type at which they are called. See 'Headers' module for documentation
---   of the data format.
-module Data.Columbia.CompoundData (module Data.Columbia.Types, module Data.Columbia.Internal.RWInstances, module Data.Columbia.Internal.Orphans, readHeader',
--- ** Strategy/traversal combinators
-(#.), (##.), fixT, fixTW, typeCoerce, typeCoerceW,
--- ** Compound data read/write strategies
-RW(..), RWCtx(..), PolyTraversal, readOneLayer, PolyTraversalW, writeOneLayer,
--- ** Seeking and updating
-seekByTrack, seekToField, updateField, updateByTrack) where
-
-import Data.Generics.SYB.WithClass.Basics
-import Data.Word
-import Data.Int
-import Data.Maybe
-import Data.Array
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Writer
-import Control.Monad.Identity
-import Control.Monad.Trans
-import Control.Monad.Morph
-import Control.Monad
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.Headers
-import Data.Columbia.Internal.RWInstances
-import Data.Columbia.Internal.Orphans
-import Data.Columbia.Types
-import Data.Columbia.FRecord
-import Data.Columbia.DynamicWithCtx
-
-infixl 9 #.
-infixl 9 ##.
-
-{-# INLINE (#.) #-}
-(#.) :: (Data ctx t)
-	=> PolyTraversal ctx m t
-	-> (forall t2. (Data ctx t2) => PolyTraversal ctx m t2)
-	-> PolyTraversal ctx m t
-(traversal #. traversal2) proxy f = traversal proxy(traversal2 proxy f)
-
-{-# INLINE (##.) #-}
-(##.) :: (Data ctx t)
-	=> PolyTraversalW ctx m t
-	-> (forall t2. (Data ctx t2) => PolyTraversalW ctx m t2)
-	-> PolyTraversalW ctx m t
-(traversal ##. traversal2) proxy f = traversal proxy(traversal2 proxy f)
-
-fixT :: (Data ctx t)
-	=> Proxy ctx
-	-> (forall t2. (Data ctx t2) => PolyTraversal ctx m t2)
-	-> ReaderT(SeekableStream m Word8) m t
-fixT proxy traversal = traversal proxy(fixT proxy traversal)
-
-fixTW :: (Data ctx t)
-	=> Proxy ctx
-	-> (forall t2. (Data ctx t2) => PolyTraversalW ctx m t2)
-	-> t
-	-> ReaderT(SeekableWriter m Word8) m ()
-fixTW proxy traversal = traversal proxy(fixTW proxy traversal)
-
--- | Try to cast from the first traversal; if that fails, use the second traversal.
-typeCoerce :: (Typeable t, Data ctx t2)
-	=> PolyTraversal ctx m t
-	-> PolyTraversal ctx m t2
-	-> PolyTraversal ctx m t2
-typeCoerce traversal traversal2 proxy m = 
-	maybe
-	(traversal2 proxy m)
-	id
-	(gcast(traversal proxy m))
-
-typeCoerceW :: (Typeable t, Data ctx t2)
-	=> PolyTraversalW ctx m t
-	-> PolyTraversalW ctx m t2
-	-> PolyTraversalW ctx m t2
-typeCoerceW traversal traversal2 proxy f x = 
-	maybe
-	(traversal2 proxy f x)
-	(traversal proxy f)
-	(cast x)
-
-------------------------------------
-
-{-# INLINE recursor #-}
-recursor :: forall ctx m a. (Monad m, HasField ctx RWCtx, Data ctx a)
-	=> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
-	-> Proxy ctx -> StateT Word32(ReaderT(SeekableStream m Word8) m) a
-recursor rec proxy = do
-	x <- get
-	put$!x+4
-	lift$do
-		seek x
-		rec
-
--- | Function returns something 'PolyTraversal'. We can use this to examine the top layer
---   of a data structure, then seek to and read some of its components.
-readOneLayer :: forall ctx m d. (Monad m, HasField ctx RWCtx, Data ctx d)
-	=> PolyTraversal ctx m d
-readOneLayer proxy0 m = do
-	seekByPointer
-	addr <- getPosition
-	let specimen :: d = error"readOneLayer: specimen"
-	let ty = dataTypeOf proxy0 specimen
-	-- First examine the header on disk and compare to the header deriving from the data type.
-	-- If they don't match, reading cannot continue.
-	hdr@(_, ix, _) <- readHeader
-	let hdr2 = headerFromConstr proxy0 specimen(indexConstr ty ix)
-	when(hdr/=hdr2)$fail$"readCompoundData: header check failed "++
-		"(header from file is "++showsPrec 11 hdr
-		("; header from program is "++showsPrec 11 hdr2 ")")
-	d <- if isHeaderAlgtype hdr || isHeaderArraytype hdr then do
-			-- Construct a term skeleton; transforming this skeleton will load the data.
-			specimen2 <- if isHeaderArraytype hdr then do
-					l <- readIntegral
-					return$!enhancedFromConstr proxy0 ty hdr l
-				else
-					return$!enhancedFromConstr proxy0 ty hdr 0
-			addr <- getPosition
-			-- Construct a 'PolyTraversal' that reads the sub-components.
-			evalStateT
-				(gmapM
-				proxy0
-				(\_ -> recursor m proxy0)
-				specimen2)
-				addr
-		else
-		-- Fall back on a primitive reader method if one is defined.
-		case hasField(dict :: ctx d) of
-			RWCtx -> readData
-	seek addr
-	return d
-
--- | This is a slightly more tail-recursive implementation of 'mapM_' for lists.
---   That helps deal with serialization of lists, a common case.
-mapM_' :: (Monad m) => (t->m())->[t]->m()
-mapM_' f (x:xs@(_:_)) = do { f x;mapM_' f xs }
-mapM_' f [x] = f x
-mapM_' _ [] = return()
-
-{-# INLINE recursorW #-}
-recursorW :: forall ctx m. (Monad m, HasField ctx RWCtx)
-	=> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m ())
-	-> DynamicWithCtx(Data ctx)
-	-> StateT Word32(ReaderT(SeekableWriter m Word8) m) ()
-recursorW rec (DynamicWithCtx d) = do
-	n <- get
-	put$!n+4
-	lift$do
-		seekWriter n
-		rec d -- Tail recursive
-
-{-# INLINE collectSubterms #-}
-collectSubterms :: (Data ctx d) => Proxy ctx->d->[DynamicWithCtx(Data ctx)]
-collectSubterms proxy = snd.runWriter.gmapM proxy(\d->do { tell.return.dynamicWithCtx$d; return$error"unused result" })
-
--- | Writes the top layer of a data structure, and sells each of the sub-targets in turn.
-writeOneLayer :: forall ctx m d. (Monad m, HasField ctx RWCtx, Data ctx d) => PolyTraversalW ctx m d
-writeOneLayer proxy0 f d = do
-	let ty = dataTypeOf proxy0 d
-	n <- getWriterPosition
-	seekWriterAtEnd
-	m <- getWriterPosition
-	seekWriter n
-	writeIntegral m
-	seekWriterAtEnd
-	if isAlgType ty || dataTypeName ty == "Data.Array.Array" then do
-			writeHeader proxy0 d
-			n <- getWriterPosition
-			sequence_(replicate(nConstructorParameters proxy0 d) (writeIntegral(0::Word32)))
-			let subterms = collectSubterms proxy0 d
-			evalStateT(mapM_'(recursorW f) subterms)
-				n
-		else case hasField(dict :: ctx d) of
-			RWCtx -> do
-				writeHeader proxy0 d
-				writeData d
-	seekWriter n
-
-------------------------------------
-
--- | 'seekToField' is going to be used to seek at a field by its constructor index, or if it happens
---   to be an array, by its array index.
-seekToField :: forall m. (Monad m) => Int -> ReaderT(SeekableStream m Word8) m ()
-seekToField ix = do
-	seekByPointer
-	hdr <- readHeader
-	(nf, _) <- nFieldsBytes hdr
-	when(ix<1||ix>nf)$fail$"seekToField: index out of range (1,"++showsPrec 11 nf")"
-	relSeek$fromIntegral$4*ix-4
-
--- | This is for traversing several fields in succession. It relies on the notion of track from the 'zipper'
---   package. These tracks are monomorphic; people who want to can define polymorphic tracks in the privacy
---   of their own homes.
-{-# INLINE seekByTrack #-}
-seekByTrack track = mapM_ seekToField track
-
--- | 'updateField' reads and reconstructs the whole constructor (or array) with the specified field
---   as the target of the writer-poly-traversal. It then writes the modified constructor back onto
---   the stream.
-updateField :: (Monad m, Data ctx d, HasField ctx RWCtx) => Int -> PolyTraversalW ctx(StateT Int m) d
-updateField n proxy f =
-	writeOneLayer proxy
-	$ \d->
-	do
-	m <- get
-	put$!succ m
-	if n==m then
-		hoist(lift.(`evalStateT`1))$f d
-		else
-		fixTW proxy writeOneLayer d
-
-_updateByTrack :: (Monad m, Data ctx d, HasField ctx RWCtx) => [Int] -> PolyTraversalW ctx(StateT Int m) d
-_updateByTrack (i:is) proxy f = (updateField i ##. _updateByTrack is) proxy f
-_updateByTrack [] _ f = f
-
--- | 'updateByTrack' is going to modify and reconstruct several constructors in succession.
-{-# INLINE updateByTrack #-}
-updateByTrack :: (Monad m, Data ctx d, HasField ctx RWCtx) => [Int]-> PolyTraversalW ctx m d
-updateByTrack = hoistPolyTraversalW(`evalStateT`1) lift._updateByTrack
− src/Data/Columbia/CycleDetection.hs 
@@ -1,183 +0,0 @@-{-# LANGUAGE ConstraintKinds, ExistentialQuantification, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, DeriveDataTypeable, TypeFamilies, StandaloneDeriving, Trustworthy #-}
-
--- | These strategies are for cycle detection and construction of fixed points. Cycle detection is used wherever there are
---   cycles in the reference graph implied by a Columbia file, or equivalently, if the file contains indefinitely
---   large data. It ensures that reading and writing operations terminate in the presence of such data. The reconstruction
---   of such data in a reading operation, implies that fixed points will be constructed. That way, while the reading operation
---   terminates, it does construct indefinitely large (non-terminating) data, i.e. it reconstructs the indefinitely large
---   data that was written.
---
---   The construction of cycles in the stream representation, is coordinated with the help of types that have non-trivial
---   'KeyComparable' instances. These types furnish a comparison function, that can be used to compare data structure nodes,
---   and thus detect cycles. These cycles are reflected as reference cycles in a Columbia file. Data at such types, where
---   found in a cycle can be called "loop-breakers." If the data have cycles without loop breakers, the writing process
---   will in fact not terminate, as there is no referentially transparent way (within Haskell) to detect the cycle.
-module Data.Columbia.CycleDetection where
-
-import Data.Map
-import Data.Int
-import Data.Word
-import Data.IORef
-import Data.Tree
-import Data.Dynamic hiding (Proxy)
-import Data.Generics.SYB.WithClass.Basics
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Types
-import Data.Columbia.FRecord
-import Data.Columbia.DynamicWithCtx
-import Generics.Pointless.Functors
-import Generics.Pointless.Combinators
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Fix
-import Prelude hiding (lookup)
-
-import Data.Array
-import qualified Data.Array.Unboxed as U
-
-class (Monad m) => StateM m where
-	type StateOf m :: *
-	mfy' :: (StateOf m -> (StateOf m, a)) -> m a
-
-instance (Monad m) => StateM(StateT s m) where
-	type StateOf(StateT s m) = s
-	mfy' f = get>>= \s -> let(s', x) = f s in (put$!s')>>return x
-instance StateM(ReaderT(IORef s) IO) where
-	type StateOf(ReaderT(IORef s) IO) = s
-	mfy' f = ask>>=lift.(`atomicModifyIORef'` f)
-
-get' :: (StateM m) => m(StateOf m)
-get' = mfy'(\s -> (s, s))
-put' s = mfy'(\_ -> (s, ()))
-
-instance (KeyComparable t) => Sat(KeyCtx t) where dict = KeyCtx
-
-instance Eq(DynamicWithCtx Eq) where
-	DynamicWithCtx x == DynamicWithCtx x2 = maybe False(==x2) (cast x)
-instance KeyComparable(DynamicWithCtx KeyComparable) where
-	isKeyed(DynamicWithCtx x) = isKeyed x
-	keyCompare(DynamicWithCtx x) (DynamicWithCtx x2) = maybe(compare(typeOf x) (typeOf x2)) (`keyCompare` x2) (cast x)
-instance Ord(DynamicWithCtx KeyComparable) where
-	-- Here I'm going to assume that all data being compared have keys.
-	compare = keyCompare
-instance Eq(DynamicWithCtx KeyComparable) where
-	(==) d = (==EQ).keyCompare d
-
-type CycleDetectionR m = StateT(Map Word32 Dynamic) m
-type CycleDetectionW m = StateT(Map(DynamicWithCtx KeyComparable) Word32) m
-type CycleDetectionRIO = ReaderT(IORef(Map Word32 Dynamic)) IO
-type CycleDetectionWIO = ReaderT(IORef(Map(DynamicWithCtx KeyComparable) Word32)) IO
-
-cycleDetect :: forall ctx m t. (MonadFix m, StateM m, StateOf m ~ Map Pointer Dynamic, HasField ctx RWCtx, Data ctx t)
-	=> PolyTraversal ctx m t
-cycleDetect proxy m =
-	readIntegral>>= \n->
-	relSeek(-4)>>
-	lift get'>>=
-	maybe
-		(mfix(\x -> do
-			lift$mfy'(\mp -> (insert n(toDyn x) mp, ()))
-			m))
-		(maybe
-			(fail$"cycleDetect: type mismatch")
-			return
-			.fromDynamic)
-		.lookup n
-
-cycleDetectW :: forall ctx m t. (StateM m, StateOf m ~ Map(DynamicWithCtx KeyComparable) Pointer, HasField ctx RWCtx, HasField ctx KeyCtx, Data ctx t)
-	=> PolyTraversalW ctx m t
-cycleDetectW proxy f x =
-	case hasField(dict :: ctx t) :: KeyCtx t of
-		KeyCtx ->
-			let d = dynamicWithCtx x in
-			lift get'>>= \mp->
-			maybe
-				(do
-				n <- getWriterPosition
-				seekWriterAtEnd
-				addr <- getWriterPosition
-				seekWriter n
-				when(isKeyed d)$lift$put'$insert d addr mp
-				f x)
-				(\n->do
-				writeIntegral n
-				relSeekWriter(-4))
-				$lookup d mp
-
-runCycleDetectionR :: (Monad m)
-	=> ReaderT(SeekableStream(CycleDetectionR m) Word8) (CycleDetectionR m) t
-	-> ReaderT(SeekableStream m Word8) m t
-runCycleDetectionR m = do
-	s <- ask
-	lift$evalStateT(runReaderT m(hoistStream lift s)) empty
-
-runCycleDetectionW :: (Monad m)
-	=> ReaderT(SeekableWriter(CycleDetectionW m) Word8) (CycleDetectionW m) t
-	-> ReaderT(SeekableWriter m Word8) m t
-runCycleDetectionW m = do
-	sw <- ask
-	lift$evalStateT(runReaderT m(hoistWriter lift sw)) empty
-
------------------------------------
-
--- | A 'Pair' is a good data structures for associating a key and a value.
-data Pair k v = Pair k v deriving (Read, Show, Typeable, Eq, Ord)
-
-instance (Ord k) => KeyComparable(Pair k v) where
-	isKeyed _ = True
-	keyCompare(Pair k _) (Pair k2 _) = compare k k2
-
-pairCtor = Constr(AlgConstr 1) "Pair" [] Prefix pairDataType
-pairDataType = DataType "Data.Columbia.CycleDetection"(AlgRep[pairCtor])
-instance (Sat(ctx(Pair k v)), Data ctx k, Data ctx v) => Data ctx(Pair k v) where
-	gfoldl _ o f (Pair k v) = f Pair `o` k `o` v
-	gunfold _ k f _ = k(k(f Pair))
-	dataTypeOf _ _ = pairDataType
-	toConstr _ _ = pairCtor
-	dataCast2 _ f = gcast2 f
-
-instance (Typeable k, Typeable v) => RW(Pair k v)
-
-type instance Rep(Pair k) v = Pair k v
-
-instance ToRep(Pair k) where
-	rep = id
-	unrep _ _ = id
-	val _ = ann
-	fun _ = ann
-
--- Some boilerplate instances
-instance KeyComparable(t1,t2)
-instance KeyComparable(t1,t2,t3)
-instance KeyComparable(t1,t2,t3,t4)
-instance KeyComparable(t1,t2,t3,t4,t5)
-instance KeyComparable(Either t t2)
-instance KeyComparable(Maybe t)
-instance KeyComparable[t]
-instance KeyComparable(Array i e)
-instance KeyComparable(U.UArray i e)
-instance KeyComparable(Tree t)
-instance KeyComparable(Map k v)
-instance KeyComparable Int
-instance KeyComparable Word
-instance KeyComparable Int8
-instance KeyComparable Word8
-instance KeyComparable Int16
-instance KeyComparable Word16
-instance KeyComparable Int32
-instance KeyComparable Word32
-instance KeyComparable Int64
-instance KeyComparable Word64
-instance KeyComparable Float
-instance KeyComparable Char
-instance KeyComparable Ordering
-instance KeyComparable Bool
-instance KeyComparable ()
-instance KeyComparable ((:+:) f g x)
-instance KeyComparable ((:*:) f g x)
-instance KeyComparable ((:@:) f g x)
-instance KeyComparable (Fix f)
-instance KeyComparable (Const x x2)
-instance KeyComparable (Id x)
− src/Data/Columbia/Dictionaries.hs 
@@ -1,183 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, Unsafe #-}
-
-module Data.Columbia.Dictionaries (
--- | ** Conversions to and from 'LazyMap's
-lazyMapToMap, mapToLazyMap,
--- | ** Rudimentary manipulation operations
-lazyMapToAscList, lazyMapSize, lazyMapRange, lazyMapOpenRange, lazyMapMinKey, lazyMapMaxKey, lazyMapMerge,
--- | ** Seeking to and reading a sub-range
-seekInRange) where
-
-import Data.Word
-import Data.Typeable hiding (Proxy)
-import qualified Data.Map as M
-import Data.Map (Map)
-import Data.List
-import Control.Monad.Reader
-import Data.Generics.SYB.WithClass.Basics
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.Headers
-import Data.Columbia.Internal.Orphans
-import Data.Columbia.CompoundData
-import Data.Columbia.WithAddress
-import Data.Columbia.FRecord
-
-import Unsafe.Coerce
-
--- | A data type that is representation-equivalent to the 'Map' data type.
-data StrictMap k v = BinPrimePrime !Int !k v !(StrictMap k v) !(StrictMap k v) | TipPrimePrime
-
-unsafeStrictMapToMap :: StrictMap k v -> Map k v
-unsafeStrictMapToMap = unsafeCoerce
-
-lazyMapToStrictMap :: LazyMap k v -> StrictMap k v
-lazyMapToStrictMap (BinPrime sz k v bin bin2) = BinPrimePrime sz k v(lazyMapToStrictMap(copoint bin)) (lazyMapToStrictMap(copoint bin2))
-lazyMapToStrictMap TipPrime = TipPrimePrime
-
--- | It forces a lazy dictionary into a dictionary. This takes O(n) time as opposed to the
---   O(n log n) that it would take to build the 'Map' via its interface. It is
---   still very wrong and this conversion should only be used as a step in reading
---   dictionaries from a stream representation.
-lazyMapToMap :: LazyMap k v -> Map k v
-lazyMapToMap = unsafeStrictMapToMap. lazyMapToStrictMap
-
-unsafeMapToStrictMap :: Map k v -> StrictMap k v
-unsafeMapToStrictMap = unsafeCoerce
-
-strictMapToLazyMap :: StrictMap k v -> LazyMap k v
-strictMapToLazyMap (BinPrimePrime sz k v bin bin2) = BinPrime sz k v(point(strictMapToLazyMap bin)) (point(strictMapToLazyMap bin2))
-strictMapToLazyMap TipPrimePrime = TipPrime
-
-mapToLazyMap :: Map k v -> LazyMap k v
-mapToLazyMap = strictMapToLazyMap. unsafeMapToStrictMap
-
-lazyMapToAscList :: LazyMap k v -> [(k,v)]
-lazyMapToAscList (BinPrime _ k v bin bin2) = lazyMapToAscList(copoint bin) ++ (k,v) : lazyMapToAscList(copoint bin2)
-lazyMapToAscList TipPrime = []
-
-lazyMapSize :: LazyMap k v -> Int
-lazyMapSize (BinPrime sz _ _ _ _) = sz
-lazyMapSize TipPrime = 0
-
--- | 'lazyMapRange' is for computing a specific range in a 'LazyMap' -- no balancing is done.
-lazyMapRange :: (Ord k) => k -> k -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
-lazyMapRange k k2 bin = case copoint bin of
-	BinPrime _ k3 v bin' bin2' -> let
-		bin'' = lazyMapRange k k2 bin'
-		bin2'' = lazyMapRange k k2 bin2' in
-		if k3 < k then
-		bin2''
-		else if k3 > k2 then
-		bin''
-		else 
-		point$BinPrime(succ(lazyMapSize(copoint bin'')+lazyMapSize(copoint bin2''))) k3 v bin'' bin2''
-	TipPrime -> bin
-
-lazyMapOpenRange :: (Ord k) => k -> k -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
-lazyMapOpenRange k k2 bin = case copoint bin of
-	BinPrime _ k3 v bin' bin2' -> let
-		bin'' = lazyMapOpenRange k k2 bin'
-		bin2'' = lazyMapOpenRange k k2 bin2' in
-		if k3 <= k then
-		bin2''
-		else if k3 >= k2 then
-		bin''
-		else 
-		point$BinPrime(succ(lazyMapSize(copoint bin'')+lazyMapSize(copoint bin2''))) k3 v bin'' bin2''
-	TipPrime -> bin
-
--- | These find the minimum and maximum keys resp. of 'LazyMap's provided the keys
---   are ordered.
-lazyMapMinKey :: LazyMap k v -> Maybe k
-lazyMapMinKey (BinPrime _ k _ bin _) = lazyMapMinKey(copoint bin) `mplus` return k
-lazyMapMinKey TipPrime = mzero
-
-lazyMapMaxKey :: LazyMap k v -> Maybe k
-lazyMapMaxKey (BinPrime _ k _ _ bin2) = lazyMapMaxKey(copoint bin2) `mplus` return k
-lazyMapMaxKey TipPrime = mzero
-
--- | It merges two 'LazyMap's in O(n) time, provided the /lazyMapMaxKey lm <= lazyMapMinKey lm2/.
---   No attempt is made to balance the resulting tree structure.
-lazyMapMerge :: WithAddress(LazyMap k v) -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
-lazyMapMerge bin bin2 = case copoint bin of
-	BinPrime sz k v bin' bin2' -> point$BinPrime(sz+lazyMapSize(copoint bin2)) k v bin'(lazyMapMerge bin2' bin2)
-	TipPrime -> bin2
-
-----------------------------------------------
-
-_findSplitAddresses :: (Ord k, Data ctx k, Sat(ctx Int), HasField ctx RWCtx, Monad m)
-	=> Proxy ctx
-	-> k
-	-> k
-	-> ReaderT(SeekableStream m Word8) m [(k,Either Word32 Word32)]
-_findSplitAddresses proxy k k2 = do
-	n <- getPosition
-	seekByPointer
-	hdr@(_, ctor, _) <- readHeader
-	seek n
-	if ctor == 1 then do
-		seekToField 1
-		sz :: Int <- fixT proxy readOneLayer
-		seek n
-		seekToField 2
-		k3 <- fixT proxy readOneLayer
-		if k3 < k then do
-				seek n
-				seekToField 5
-				_findSplitAddresses proxy k k2
-			else if k3 > k2 then do
-				seek n
-				seekToField 4
-				_findSplitAddresses proxy k k2
-			else if sz == 1 then
-				return$![(k3,Right n)]
-			else do
-				seek n
-				seekToField 4
-				n1 <- getPosition
-				ls <- _findSplitAddresses proxy k k2
-				seek n
-				seekToField 5
-				n2 <- getPosition
-				ls2 <- _findSplitAddresses proxy k k2
-				let ls' = snd <$> ls
-				let ls2' = snd <$> ls2
-				return$!if ls' == [Right n1] && ls2' == [Right n2] then
-					-- It coalesces two included subtrees as a single subtree.
-					[(k3,Right n)]
-					else
-					-- If only part of the subtrees are included, it returns the root key
-					-- as a singleton map.
-					ls ++ (k3,Left n) : ls2
-		else
-			return$![]
-
--- | 'seekInRange' is a seeking operation. It is applicable to 'LazyMap's in a stream representation;
---   it requires a stream to be seeked at a 'LazyMap'. Its function is to locate the entries of a
---   dictionary that are bounded above and below by certain key values. The key values located
---   are partitioned into subtrees, in such a way as to maximize the number of subtrees that can
---   be directly referenced in the file (and minimize the number of new nodes constructed
---   to structure the resulting tree).
-seekInRange :: forall ctx k v m. (Ord k,
-	Data ctx k,
-	Data ctx v,
-	Sat(ctx Int),
-	Sat(ctx(LazyMap k v)),
-	Sat(ctx Word32),
-	Sat(ctx(WithAddress(LazyMap k v))),
-	HasField ctx RWCtx,
-	Monad m)
-	=> k
-	-> k
-	-> PolyTraversal ctx m(WithAddress(LazyMap k v))
-seekInRange k k2 proxy m = do
-	ls <- _findSplitAddresses proxy k k2
-	-- 'lazyMapMerge' is a right-biased merge; by doing left-biased merging at this line it
-	-- achieves rough (not perfect) balance.
-	liftM(foldl' lazyMapMerge(point TipPrime))$
-		mapM(\(k,ei)->either
-		(\n->do { seek n; seekToField 3; liftM(point.mapToLazyMap. M.singleton k) m })
-		(\n->do { seek n; m })
-		ei)
-		ls
− src/Data/Columbia/DynamicWithCtx.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE ExistentialQuantification, ConstraintKinds, Safe #-}
-
-module Data.Columbia.DynamicWithCtx where
-
-import Data.Typeable
-
-data DynamicWithCtx ctx = forall t. (ctx t, Typeable t) => DynamicWithCtx !t
-
-dynamicWithCtx :: (ctx t, Typeable t) => t -> DynamicWithCtx ctx
-dynamicWithCtx = DynamicWithCtx
− src/Data/Columbia/FRecord.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, OverlappingInstances, Trustworthy #-}
-
-module Data.Columbia.FRecord where
-
-import Data.Generics.SYB.WithClass.Context
-
-class HasField scheme f where
-	hasField :: scheme t -> f t
-
-instance HasField(PairCtx f f2) f where
-	hasField(PairCtx fn _) = fn
-instance (HasField scheme f2) => HasField(PairCtx f scheme) f2 where
-	hasField(PairCtx _ fn2) = hasField fn2
− src/Data/Columbia/Gc.hs 
@@ -1,400 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, Safe #-}
-
--- | A brief note on the locking strategy:
---
---   A Columbia data file is covered by three locks: a dual lock (comprising two locks) and a writer lock;
---   the lock hierarchy goes in that order. The dual lock is taken in a shared mode during
---   all reading. The only circumstance in which the dual lock is taken
---   in exclusive mode is to execute the write phase of a garbage collection.
---
---   The writer lock protects the action of writing to the end of the file and also
---   to the root node offset; readers take the writer lock only during reading the root node
---   offset; the writer lock is always taken in exclusive mode.
---
---   The high level view is: you can always run the collector in parallel with any other
---   operation you are doing; you can read and write freely while using the collector.
-module Data.Columbia.Gc (markAndSweepGc) where
-
-import Control.Monad.Reader
-import Control.Monad
-import Control.Monad.Loops
-import Control.Exception
-import System.IO
-import System.IO.Error	
-import System.Directory
-import System.FileLock
-import Data.Char
-import Data.Word
-import Data.Bits
-import Data.IORef
-import Data.Columbia.Types
-import Data.Columbia.Internal.RWInstances
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.Headers
-import Data.Columbia.Internal.DualLock
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-import Data.Columbia.Internal.Mapper
-
-{-guardedGetChar handle =
-	catchError(getWord8 handle)
-		(\ex -> if isEOFError ex then
-				return 0
-			else throwError ex)-}
-
-setBitAt :: (Monad m) => SeekableWriter m Word8 -> Pointer -> m()
-setBitAt writer n = runReaderT(do
-	let (dv, md) = divMod n 8
-	seekWriter dv
-	m <- liftM(maybe 0 id)$consumeTokenW
-	seekWriter dv
-	let m' = setBit m(fromIntegral md)
-	putToken m')
-	writer
-getBitAt :: (Monad m) => SeekableWriter m Word8 -> Pointer -> m(Maybe Bool)
-getBitAt writer n = runReaderT(do
-	let (dv, md) = divMod n 8
-	seekWriter dv
-	liftM(liftM(`testBit` fromIntegral md)) consumeTokenW)
-	writer
-getBitAt' :: (Monad m) => SeekableWriter m Word8 -> Pointer -> m Bool
-getBitAt' writer n = liftM(maybe False id)$getBitAt writer n
-
-_mark :: (Monad m) => SeekableWriter m Word8 -> Pointer -> ReaderT(SeekableStream m Word8) m ()
-_mark tmpwriter addr = do
-	bool <- lift$getBitAt' tmpwriter addr
-	unless bool$do
-		seek addr
-		hdr <- readHeader
-		-- Have to determine how many bytes to mark and how many fields to recurse on.
-		-- In the case of primitive types it is zero fields.
-		(nFields, nBytes) <- nFieldsBytes hdr
-		-- Mark fields
-		lift$mapM_(setBitAt tmpwriter) [fromIntegral addr..fromIntegral addr+fromIntegral nBytes-1]
-		-- Read addresses and recurse on them.
-		addrs <- sequence(replicate nFields readIntegral)
-		mapM_(_mark tmpwriter) addrs
-
-mark :: FilePath -> SeekableStream IO Word8 -> IO(SeekableWriter IO Word8,IO(),IORef(Pointer,Pointer),FilePath)
-mark path stream = do
-	dir <- getTemporaryDirectory
-	(tmppath, tmphandle) <- openBinaryTempFile dir "mark"
-	hClose tmphandle
-	(tmpwriter,tmpconclude,tmpref) <- makeIoWriter' tmppath undefined False
-	-- Mark root node.
-	mapM_(setBitAt tmpwriter) [0..3]
-	runReaderT(do
-		-- Read root node.
-		addr <- readIntegral
-		-- ...and proceed to recurse on the structure of the data.
-		_mark tmpwriter addr)
-		stream
-	return$!(tmpwriter,tmpconclude,tmpref,tmppath)
-
-{-# INLINE forLoop #-}
-forLoop :: (MonadIO m) => IORef Word32 -> (Word32 -> m Bool) -> m Word32
-forLoop ref f = do
-	whileM_(liftIO(readIORef ref)>>=f)$liftIO$modifyIORef' ref succ
-	liftIO$readIORef ref
-
-untilEOF :: (Monad m)
-	=> ReaderT(SeekableWriter m Word8) m t
-	-> ReaderT(SeekableWriter m Word8) m Bool
-untilEOF m = do
-	-- Save writer position; determine file size.
-	x <- getWriterPosition
-	seekWriterAtEnd
-	n <- getWriterPosition
-	seekWriter x
-	whileM_
-		(do
-		x2 <- getWriterPosition
-		return$!x2<n)
-		m
-	x2 <- getWriterPosition
-	return$!n==x2
-
-untilEOF' :: (MonadIO m)
-	=> ReaderT(SeekableStream m Word8) m t
-	-> ReaderT(SeekableStream m Word8) m ()
-untilEOF' m = do
-	x <- getPosition
-	seekAtEnd
-	n <- getPosition
-	seek x
-	whileM_
-		(do
-		x2 <- getPosition
-		return$!x2<n)
-		m
-
--- Run-length compression of the bit field defined in the mark.tmp file.
-compress :: SeekableWriter IO Word8 -> IO(SeekableWriter IO Word8,IO(),Pointer)
-compress tmpwriter = do
-	dir <- getTemporaryDirectory
-	(tmppath2, tmphandle2) <- openBinaryTempFile dir "compressed"
-	hClose tmphandle2
-	counter <- newIORef 0
-	newSize <- newIORef 0
-	(tmpwriter2,tmpconclude2,_) <- makeIoWriter' tmppath2 undefined False
-	m <- runReaderT(do
-		-- Save writer position; determine file size.
-		lift$_seekAtEnd$stream tmpwriter
-		newFileSize <- lift$_getPosition$stream tmpwriter
-		lift$_seek(stream tmpwriter) 0
-		whileM_
-			(lift$liftM(/=newFileSize) (_getPosition$stream tmpwriter))
-			(do
-				m <- lift$readIORef counter
-				sz <- lift$readIORef newSize
-				lift$forLoop counter(liftM(maybe False id).getBitAt tmpwriter)
-				n <- lift$readIORef counter
-				writeIntegral m
-				writeIntegral n
-				writeIntegral sz
-				lift$writeIORef newSize$!sz+n-m
-				lift$forLoop counter(liftM(maybe False not).getBitAt tmpwriter)
-			)
-		-- Stick on an extra piece that lets pointer fixups reconcile extra stuff.
-		m <- lift$readIORef counter
-		sz <- lift$readIORef newSize
-		writeIntegral m
-		writeIntegral(maxBound :: Word32)
-		writeIntegral sz
-		return m)
-		tmpwriter2
-
-	return$!(tmpwriter2,tmpconclude2,m)
-
--- N.B. That this only works if 1) ranges are disjoint, or 2) to <= fromStart.
-copyRange :: (Monad m) => SeekableWriter m Word8 -> Word32 -> Word32 -> Word32 -> m()
-copyRange writer to fromStart fromEnd = runReaderT(
-	mapM_
-	(\ii -> do
-	seekWriter ii
-	ch <- liftM(maybe(error"end of file") id) consumeTokenW
-	seekWriter$!ii-fromStart+to
-	putToken ch)
-	[fromStart..fromEnd-1])
-	writer
-
-sweep :: FilePath -> SeekableWriter IO Word8 -> IORef(Pointer,Pointer) -> SeekableStream IO Word8 -> IO()
-sweep newpath writer ref tmpstream2 = do
-	newSize <- newIORef 0
-	runReaderT(do
-		seekAtEnd
-		compressSz <- getPosition
-		seek 0
-		whileM_
-			(liftM(/=compressSz-12) getPosition)
-			(do
-			st <- readIntegral
-			end <- readIntegral
-			sz <- readIntegral
-			lift$copyRange writer sz st end
-			lift$writeIORef newSize$!sz+end-st)
-		)
-		tmpstream2	
-	-- Once the file is all sweeped have to find the end of the file
-	-- and truncate it.
-	n <- readIORef newSize
-	writeIORef ref$!(0,n)
-
-_fixUpPointers :: (Monad m) => Word32 -> Word32 -> Word32 -> ReaderT(SeekableStream m Word8) m Word32
-_fixUpPointers start end addr2 = do
-	let half = (end-start)`quot`2+start
-	seek$12*half
-	st <- readIntegral
-	en <- readIntegral
-	if addr2 < st then
-			_fixUpPointers start half addr2
-		else if addr2 >= en then
-			_fixUpPointers half end addr2
-		else
-			liftM(\m -> m+addr2-st) readIntegral
-
--- Read the address at 'n' and use the information in compressed.tmp to find
--- the corresponding fixed up address. Return the old address to be traversed
--- further.
-_fixUpPointers2 :: (Monad m) => SeekableStream m Word8 -> Word32 -> Word32 -> ReaderT(SeekableWriter m Word8) m Word32
-_fixUpPointers2 tmpstream2 len addr = do
-	seekWriter addr
-	addr2 <- local' stream$readIntegral
-	n <- lift$runReaderT(_fixUpPointers 0 len addr2) tmpstream2
-	seekWriter addr
-	writeIntegral n
-	return addr2
-
-_fixUpPointers3 tmpwriter tmpstream2 len addr = do
-	b <- lift$getBitAt' tmpwriter addr
-	unless(b||addr==0)$do --Account for possible zero addresses.
-		seekWriter addr
-		hdr <- local' stream readHeader
-		(nFields, nBytes) <- local' stream(nFieldsBytes hdr)
-		n <- getWriterPosition
-		-- Mark fields to prevent following addresses twice
-		lift$mapM_(setBitAt tmpwriter) [addr..addr+fromIntegral nBytes-1]
-		-- Adjust record's pointers
-		addrs <- mapM(_fixUpPointers2 tmpstream2 len) [n,n+4..n+4*fromIntegral nFields-4]
-		-- Recurse on the structure of the data.
-		mapM_(_fixUpPointers3 tmpwriter tmpstream2 len) addrs
-
-_fixUpPointers4 :: (MonadIO m) => SeekableStream m Word8 -> Word32 -> [IORef Word32] -> m()
-_fixUpPointers4 tmpstream2 len moreAddresses =
-	mapM_(\addrRef -> do
-		addr2 <- liftIO$readIORef addrRef
-		n <- runReaderT(_fixUpPointers 0 len addr2) tmpstream2
-		liftIO$writeIORef addrRef n
-		) moreAddresses
-
-void' m = liftM(const()) m
-_fixUpPointers5 :: (Monad m) => SeekableWriter m Word8 -> SeekableStream m Word8 -> Word32 -> Word32->ReaderT(SeekableWriter m Word8) m ()
-_fixUpPointers5 tmpwriter tmpstream2 len addr = do
-	seekWriterAtEnd
-	x <- getWriterPosition
-	seekWriter addr
-	-- Going to scan the differential segment and mop up its addresses.
-	void'$untilEOF(do
-		-- Scan over zeroes.
-		whileM_
-			(liftM(maybe False(==0)) consumeTokenW)
-			(return())
-		n <- getWriterPosition
-		unless(x==n)$do
-			relSeekWriter(-1)
-			n <- getWriterPosition
-			hdr <- local' stream readHeader
-			m <- getWriterPosition
-			(nFields, nBytes) <- local' stream$nFieldsBytes hdr
-			mapM_(_fixUpPointers2 tmpstream2 len) [m,m+4..m+4*fromIntegral nFields-4]
-			seekWriter$n+fromIntegral nBytes
-		)
-
-fixUpPointers writer tmpwriter tmpstream2 moreAddresses = do
-	len <- liftM(`quot`12)$runReaderT
-		(seekAtEnd>>getPosition)
-		tmpstream2
-	runReaderT
-		(do
-		seekWriter 0
-		addr <- local' stream$readIntegral
-		_fixUpPointers3 tmpwriter tmpstream2 len addr
-		)
-		writer
-	_fixUpPointers4 tmpstream2 len moreAddresses
-	return len
-
-{-# INLINE copyDifferentialRange #-}
-copyDifferentialRange :: Pointer -> SeekableWriter IO Word8 -> SeekableStream IO Word8 -> IO Word32
-copyDifferentialRange newFileSize writer oldstream =
-	runReaderT
-		(do
-		n <- lift$runReaderT(seekWriterAtEnd>>getWriterPosition) writer
-		seek newFileSize
-		untilEOF'
-			(lift$_consumeToken oldstream>>=maybe(return()) (_putToken writer))
-		return n)
-		oldstream
-
-gcSection1 :: FilePath
-	-> [IORef Pointer]
-	-> IO((SeekableWriter IO Word8,IO(),FilePath),
-		(SeekableWriter IO Word8,IO(),Pointer),
-		Word32,
-		SeekableWriter IO Word8,
-		IO())
-gcSection1 newpath moreAddresses = do
-	-- Mark
-	newhandle <- openBinaryFile newpath ReadWriteMode
-	hClose newhandle
-	(writer,conclude,ref) <- makeIoWriter' newpath undefined False
-	(tmpwriter,tmpconclude,tmpref,tmppath) <- mark newpath(stream writer)
-	mapM_(\ref -> readIORef ref>>=(`runReaderT` stream writer)._mark tmpwriter) moreAddresses
-
-	-- Compress
-	tmp2@(tmpwriter2,tmpconclude2,_) <- compress tmpwriter
-	tmpconclude
-	bracket
-		(openFile tmppath ReadWriteMode)
-		hClose
-		(`hSetFileSize` 0)
-
-	-- Fix
-	-- Identifier 'tmpconclude' is rebound here.
-	(tmpwriter,tmpconclude,_) <- makeIoWriter' tmppath undefined False
-	len <- fixUpPointers writer tmpwriter(stream tmpwriter2) moreAddresses
-
-	-- Sweep
-	sweep newpath writer ref(stream tmpwriter2)
-	return$!((tmpwriter,tmpconclude,tmppath), tmp2, len, writer, conclude)
-
-gcSection2 :: FilePath
-	-> FilePath
-	-> ((SeekableWriter IO Word8,IO(),FilePath),
-		(SeekableWriter IO Word8,IO(),Pointer),
-		Word32,
-		SeekableWriter IO Word8,
-		IO())
-	-> IO()
-gcSection2 path newpath ((tmpwriter,tmpconclude,tmppath),(tmpwriter2,tmpconclude2,newFileSize),len,writer,conclude)
-	= do
-	-- Reconcile the differential segment.
-	(oldwriter,oldconclude,_) <- makeIoWriter' path undefined True
-	let oldstream = stream oldwriter
-	n <- copyDifferentialRange newFileSize writer oldstream
-	putStrLn$"newFileSize: "++show newFileSize++"; n: "++show n
-	runReaderT(_fixUpPointers5 tmpwriter(stream tmpwriter2) len n) writer
-	-- Update root block pointer.
-	addr :: Word32 <- runReaderT(seek 0>>readIntegral) oldstream
-	runReaderT(do
-		seekWriter 0
-		writeIntegral addr
-		_fixUpPointers2(stream tmpwriter2) len 0) writer
-	-- Close files using the thunks constructed by the respective calls to 'makeIoWriter''.
-	oldconclude
-	conclude
-	tmpconclude
-	tmpconclude2
-	-- Atomically swap the newly swept file in place of the old one.
-	renameFile newpath path
-
--- | Garbage collection for files. It is a good idea when using garbage collection, never
---   to be holding addresses into a file when releasing that file's lock, as at that point the
---   garbage collector may move the data referenced. There is also a pattern, where only
---   one thread runs the garbage collector; in that case, the collector thread may hold addresses
---   and have these updated when the garbage collector moves data.
-markAndSweepGc :: FilePath -> [IORef Pointer] -> IO()
-markAndSweepGc path moreAddresses = do
-	dir <- getAppUserDataDirectory "tmp"
-	createDirectoryIfMissing True dir
-	(newpath,newhandle) <- openBinaryTempFile dir "new"
-	hClose newhandle
-	l <- dualLockShared path
-
-	-- Copy file into a temporary.
-	withFileLock(path++".lock.writer") Exclusive$ \_->catch
-		(
-		-- A copy is made for robustness.
-		copyFile path newpath)
-		(\(ex::SomeException)->throwIO ex)
-
-	-- Carry out mark/compress/fix/sweep cycle on everything in the copy.
-	-- Writers can write while this is going on (but can't change the root node address)>
-	tuple <- catch(gcSection1 newpath moreAddresses)
-		(\(ex::SomeException)->unlockShared l>>throwIO ex)
-
-	l2 <- switchLocks l
-
-	-- Carry out reconcile phase. This requires readers and writers to stop for a short time.
-	withFileLock(path++".lock.writer") Exclusive$ \_->finally
-		(gcSection2 path newpath tuple)
-		(unlock l2)
--- This garbage collector includes a concept of /reconcile phase/. The idea here is to allow other processes
--- to continue writing data to a file while mark-and-sweep is continuing. It is called reconciling because
--- the contents of the live file have to be reconciled with the contents of the copy. This has to be done
--- without undue delay.
---
--- Reconciliation is accomplished by appending the data that changes differentially while the
--- garbage collector is running. This uses the fact that data is always appended to the end of the file.
--- Efficient operation is ensured by skipping over the mark-and-sweep phase for this data, and using the
--- old, out-of-date liveness graph information to adjust the pointers of the new data.
− src/Data/Columbia/Internal/Coercion.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-
-module Data.Columbia.Internal.Coercion (floatToInt32, int32ToFloat) where
-
-import Foreign.Marshal.Utils
-import Foreign.Storable
-import Foreign.Ptr
-import System.IO.Unsafe
-import Data.Int
-
-{-# INLINE unsafeCoerceBits #-}
-unsafeCoerceBits :: (Storable t, Storable u) => t -> u
-unsafeCoerceBits n = unsafePerformIO$with n(peek.castPtr)
-
-floatToInt32 :: Float -> Int32
-floatToInt32 = unsafeCoerceBits
-
-int32ToFloat :: Int32 -> Float
-int32ToFloat = unsafeCoerceBits
− src/Data/Columbia/Internal/DualLock.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE Safe #-}
-
--- | A dual lock can be taken in either exclusive or shared mode, and also supports
---   switching (atomically) from one mode to the other.
-module Data.Columbia.Internal.DualLock where
-
-import System.IO
-import System.FileLock
-import Control.Monad
-
-data DualLockShared = DualLockShared!FilePath !FileLock !FileLock
-data DualLock = DualLock!FilePath !FileLock !FileLock
-
-dualLockShared :: FilePath -> IO DualLockShared
-dualLockShared path = liftM2(DualLockShared path)
-	(lockFile(path++".lock") Shared)
-	(lockFile(path++".lock2") Shared)
-
-dualLock :: FilePath -> IO DualLock
-dualLock path = do
-	l1 <- lockFile(path++".lock") Exclusive
-	tryLockFile(path++".lock2") Exclusive>>=maybe
-		(do
-		unlockFile l1
-		dualLock path)
-		((return$!).DualLock path l1)
-
-unlockShared :: DualLockShared -> IO()
-unlockShared(DualLockShared _ l1 l2) = unlockFile l1>>unlockFile l2
-
-unlock :: DualLock -> IO()
-unlock(DualLock _ l1 l2) = unlockFile l1>>unlockFile l2
-
--- | N.B. That two simultaneous attempts to switch locks will deadlock. Please protect a critical
---   section that switches locks with some other lock, to ensure this doesn't happen. For instance,
---   the garbage collector protects its use of 'switchLocks' on a dual lock, with an exclusive
---   writer lock.
-switchLocks :: DualLockShared->IO DualLock
-switchLocks(DualLockShared path l1 l2) = do
-	unlockFile l1
-	l3 <- lockFile(path++".lock") Exclusive
-	unlockFile l2
-	tryLockFile(path++".lock2") Exclusive>>=maybe
-		(do
-		l2' <- lockFile(path++".lock2") Shared
-		unlockFile l3
-		l1' <- lockFile(path++".lock") Shared
-		switchLocks$!DualLockShared path l1' l2')
-		((return$!).DualLock path l3)
-
--- | Switching from an exclusive to a shared lock may be done at any time.
-switchLocks2 :: DualLock->IO DualLockShared
-switchLocks2(DualLock path l1 l2) = do
-	unlockFile l2
-	l4 <- lockFile(path++".lock2") Shared
-	unlockFile l1
-	l3 <- lockFile(path++".lock") Shared
-	return$!DualLockShared path l3 l4
− src/Data/Columbia/Internal/Headers.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, Trustworthy #-}
-
-{-
-| Here I document the header layout. Every entity in a file has a header attached.
-The header has enough information to traverse the graph structure of data.
-It is laid out as follows:
-
-* The first bit determines whether the entity is an algebraic type. If it is
-zero, the next seven bits specify the index of the constructor represented,
-minus one. The next bit is a parity check bit. The seven bits following
-that specify how many parameters the constructor takes, and therefore the
-number of four-byte addresses in the body of the entity.
-
-* If the first bit is one, the second bit specifies whether the entity
-is a primitive type (0) or an array (1). In this case the remaining six bits
-in the first byte are reserved and must be zero, and the entity follows.
-
-* The body of a primitive type is always four bytes long.
-
-* The body of an array consists of a four-byte length entry, followed
-by that many four-byte addresses.-}
-module Data.Columbia.Internal.Headers where
-
-import Data.Bits
-import Data.Word
-import Data.Int
-import Data.Array
-import Data.Maybe
-import Data.Generics.SYB.WithClass.Basics
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Trans
-import Control.Monad.Identity
-import Control.Monad
-import Control.Parallel.Strategies
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-import Data.Columbia.Internal.RWInstances
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Types
-import Data.Columbia.FRecord
-
-evalTriple = evalTuple3 rseq rseq rseq
-
-parity x1 fields = (popCount x1 + popCount fields) .&. 1
-
-readHeader :: (Monad m) => ReaderT(SeekableStream m Word8) m (Word8, ConIndex, Int)
-readHeader = do
-	x1 <- consumeToken
-	if testBit x1 7 then
-			let x = (case x1 of
-				160 -> 3
-				192 -> 2
-				128 -> 1
-				_ -> error$"readHeader: header code "++show x1++" is invalid") in
-			return$!using(x, 0, 0) evalTriple
-		else do
-		x2 <- consumeToken
-		let fields = fromIntegral x2 .&. 127
-		when(testBit x2 7 /= (parity x1 fields == 1))$
-			fail"readHeader: parity check error"
-		return$!using(0, fromIntegral x1, fields) evalTriple
-
-{-# INLINE enhancedFromConstr #-}
-enhancedFromConstr :: forall ctx a. (Data ctx a) => Proxy ctx -> DataType -> (Word8, ConIndex, Int) -> Int -> a
-enhancedFromConstr proxy0 ty hdr@(_, ix, _) l = maybe
-	(runIdentity$fromConstrM proxy0(return$error"enhancedFromConstr: constr is too strict")$indexConstr ty ix)
-	runIdentity
-	(dataCast1 proxy0(return$listArray(1,l)$repeat$error"enhancedFromConstr: uninitialized array"))
-
-nConstructorParameters :: forall ctx d. (Data ctx d) => Proxy ctx -> d -> Int
-nConstructorParameters proxy d =
-	execState(gmapM
-		proxy
-		(\_ -> do { modify succ; return$error"nConstructorParameters: unused" })
-		d)
-		0
-
-headerFromConstr :: forall ctx d. (Data ctx d) => Proxy ctx -> d -> Constr -> (Word8, ConIndex, Int)
-headerFromConstr proxy d constr = hdr where
-	ty = dataTypeOf proxy d
-	specimen :: d = fromConstr proxy constr
-	hdr = if dataTypeName ty == "Data.Array.Unboxed.UArray" then
-			(3, 0, 0)
-		else if dataTypeName ty == "Data.Array.Array" then
-			(2, 0, 0)
-		else if not(isAlgType ty) then
-			(1, 0, 0)
-		else
-			(0, constrIndex constr, nConstructorParameters proxy specimen) where
-
-writeHeader :: (Monad m, Data cxt d) => Proxy cxt -> d -> ReaderT(SeekableWriter m Word8) m ()
-writeHeader proxy d = do
-	let (n, conIndex, nFields) = headerFromConstr proxy d(toConstr proxy d)
-	case n of
-		3 -> putToken 160
-		2 -> putToken 192
-		1 -> putToken 128
-		0 -> do
-			when(conIndex>127)$fail"writeCompoundData: constructor index not in range 1-127"
-			putToken(fromIntegral conIndex)
-			when(nFields>127)$fail"writeCompoundData: number of fields not in range 0-127"
-			putToken(fromIntegral$nFields .|. shiftL(parity conIndex nFields) 7)
-
-nFieldsBytes hdr@(_, _, nFields) = if isHeaderPrimtype hdr then
-		return(0, 5)
-	else if isHeaderUArraytype hdr then do
-		len <- readIntegral
-		return(0, 5+len)
-	else if isHeaderArraytype hdr then do
-		len <- readIntegral
-		return(len, 5+4*len)
-	else
-		return(nFields, 2+4*nFields)
-
-isHeaderUArraytype :: (Word8, ConIndex, Int) -> Bool
-isHeaderUArraytype (n, _, _) = n == 3
-
-isHeaderArraytype :: (Word8, ConIndex, Int) -> Bool
-isHeaderArraytype (n, _, _) = n == 2
-
-isHeaderPrimtype :: (Word8, ConIndex, Int) -> Bool
-isHeaderPrimtype (n, _, _) = n == 1
-
-isHeaderAlgtype :: (Word8, ConIndex, Int) -> Bool
-isHeaderAlgtype (n, _, _) = n == 0
-
--- | A public form of the 'readHeader' function that maintains the pre/postconditions.
-readHeader' :: (Monad m) => ReaderT(SeekableStream m Word8) m Header
-readHeader' = do
-	n <- getPosition
-	(x,x2,x3) <- readHeader
-	seek n
-	return$!Header x x2 x3
− src/Data/Columbia/Internal/IntegralTypes.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-
-module Data.Columbia.Internal.IntegralTypes where
-
-import Data.Generics.SYB.WithClass.Basics
-import Data.Bits
-import Data.Word
-import Control.Monad
-import Control.Monad.Reader
-import Control.Monad.Trans
-import Data.Columbia.Types
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-
-{-readIntegral :: (Monad m, Integral i) => ReaderT(SeekableStream m Word8) m i
-readIntegral = liftM fromIntegral consumeIntegralToken
-
-writeIntegral :: (Monad m, Integral i) => i -> ReaderT(SeekableWriter m Word8) m ()
-writeIntegral = putIntegralToken.fromIntegral-}
-
-readIntegral :: (Monad m, Bits i, Integral i) => ReaderT(SeekableStream m Word8) m i
-readIntegral = liftM4(\x1 x2 x3 x4 -> shiftL(fromIntegral x1) 24 .|.
-	shiftL(fromIntegral x2) 16 .|.
-	shiftL(fromIntegral x3) 8 .|.
-	fromIntegral x4)
-	consumeToken
-	consumeToken
-	consumeToken
-	consumeToken
-
-writeIntegral :: (Monad m, Bits i, Integral i) => i -> ReaderT(SeekableWriter m Word8) m ()
-writeIntegral x = do
-	putToken$!fromIntegral$shiftR x 24
-	putToken$!fromIntegral$shiftR x 16
-	putToken$!fromIntegral$shiftR x 8
-	putToken$!fromIntegral x
-
-readIntegral16 :: (Monad m, Bits i, Integral i) => ReaderT(SeekableStream m Word8) m i
-readIntegral16 = liftM2(\x1 x2 -> shiftL(fromIntegral x1) 8 .|.
-	fromIntegral x2)
-	consumeToken
-	consumeToken
-
-writeIntegral16 :: (Monad m, Bits i, Integral i) => i -> ReaderT(SeekableWriter m Word8) m ()
-writeIntegral16 x = do
-	putToken$!fromIntegral$shiftR x 8
-	putToken$!fromIntegral x
-
-seekByPointer :: (Monad m) => ReaderT(SeekableStream m Word8) m ()
-seekByPointer = do
-	n <- readIntegral
-	seek n
− src/Data/Columbia/Internal/Mapper.hs 
@@ -1,136 +0,0 @@-{-# LANGUAGE Trustworthy, ForeignFunctionInterface, CPP #-}
-
--- | Allows a block to be requested an unlimited number of times without using up the address space. N.B. Usage of memory cannot cross multiples of 64 kilobytes.
-module Data.Columbia.Internal.Mapper (Pointer, Table(..), newTable, fileSize, fileSizeShim, mapBlock, unmapAll) where
-
-import Data.Map
-import Data.Word
-import Data.Int
-import Data.Traversable (mapM)
-import Data.IORef
-import Foreign.Ptr
-import Foreign.ForeignPtr
-import Foreign.Storable
-import Foreign.C.String
-import Foreign.C.Types
-import Foreign.C.Error
-import Control.Concurrent.MVar
-import Control.Monad hiding (mapM)
-import Control.Exception
-import System.IO.MMap
-import System.IO
-import Data.Columbia.Types
-import Prelude hiding (lookup, catch, mapM)
-
-foreign import ccall "HsMmap.h system_io_mmap_file_open"
-    c_system_io_mmap_file_open :: CString
-                               -> CInt
-                               -> IO (Ptr ())
-
-foreign import ccall "HsMmap.h system_io_mmap_file_close"
-    c_system_io_mmap_file_close :: Ptr () -> IO ()
-
-foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap"
-    c_system_io_mmap_mmap :: Ptr ()
-                          -> CInt
-                          -> CLLong
-                          -> CSize
-                          -> IO (Ptr a)
-
-#ifdef WIN32
-foreign import stdcall "FileAPI.h FlushViewOfFile"
-    c_win32_flush_view_of_file :: Ptr () -> CSize -> IO Word32
-
-foreign import stdcall "FileAPI.h FlushFileBuffers"
-    c_win32_flush_file_buffers :: Ptr () -> IO Word32
-flush_file_buffers ptr = do
-	n <- c_win32_flush_file_buffers ptr
-	when(n==0)$fail"FlushFileBuffers: failed"
-#else
-foreign import ccall "sys/mman.h msync"
-    c_msync :: Ptr () -> CSize -> CInt -> IO Word32
-#endif
-
-data Table = Table !FilePath !(MVar (Map Pointer (Ptr ())), ForeignPtr (){-file handle-})
-
-newTable path = do
-	mv <- newMVar empty
-	handle <- withCString path$ \p->c_system_io_mmap_file_open p 3{-ReadWriteEx-}
-	handle' <- newForeignPtr_ handle
-	return$!Table path$!(mv,handle')
-
-fileSize :: FilePath -> Map Pointer (Ptr ()) -> IO Word32
-fileSize path mp =
-	liftM2
-		(max.fromInteger)
-		(bracket
-		(openBinaryFile path ReadWriteMode)
-		hClose
-		hFileSize)
-		(return$!maybe 0((+65536).fst.fst) (maxViewWithKey mp))
-
-fileSizeShim :: Table -> IO Word32
-fileSizeShim (Table path(mv,_)) = modifyMVar mv(\mp->liftM((,) mp) (fileSize path mp))
-
--- | Management wrapper that maps segments of a file into memory. A note on eager unmapping. Eager unmapping
---   is a device to help ensure that sequential-type reading and writing is fast, by always unmapping
---   all but the most recently mapped page.
-mapBlock :: Table -> Pointer -> Bool -> IO (Ptr a)
-mapBlock table@(Table path(mp,handle)) ptr eagerUnmapping  = modifyMVar mp $ \mp -> case lookup aligned mp of
-	Just p -> return (mp, castPtr (plusPtr p (fromIntegral r)))
-	Nothing -> withForeignPtr handle$ \handle'->do
-		-- putStrLn$"mmap at "++show ptr
-		mp' <- if eagerUnmapping then
-			_unmapAll False handle mp
-			else
-			return mp
-		sz <- fileSize path mp'
-		when(aligned>=sz)$
-			bracket
-				(openBinaryFile path ReadWriteMode)
-				hClose
-				(`hSetFileSize` (toInteger aligned+65536))
-		(mp'',p) <- liftM (\p -> (insert aligned p mp', plusPtr p (fromIntegral r))) $
-			c_system_io_mmap_mmap handle' 3{-ReadWriteEx-} (fromIntegral aligned) 65536
-		-- putStrLn$"mmap complete"
-		return$!(mp'',p)
-	where
-	(d, r) = ptr `divMod` 65536
-	aligned = 65536 * d
-
-{-newBlock :: Table -> IO (Ptr a, Int)
-newBlock (Table path mp) = do
-	-- Get the file size.
-	hdl <- openBinaryFile path ReadWriteMode
-	fileSz <- finally (hFileSize hdl) (hClose hdl)
-
-	-- Add a new block at the end.
-	(p, _, _, _) <- mmapFilePtr path ReadWriteEx (Just (fromInteger fileSz, 65536))
-
-	-- Store it.
-	modifyMVar_ mp (return . insert (fromInteger fileSz) (castPtr p))
-
-	return (p, fromInteger fileSz)-}
-
-_unmapAll isFinal handle mp = withForeignPtr handle$ \handle'->do
-		errref <- newIORef False
-#ifdef WIN32
-		mapM(\ptr->do
-			n<-c_win32_flush_view_of_file ptr 65536
-			when(n==0)$writeIORef errref True) mp
-		-- When unmap operation is not final it is possible to skip this operation
-		-- that does not dispose of individual pages.
-		when isFinal$flush_file_buffers handle' -- To be *strictly correct*, must cause writeback manually.
-#else
-		mapM(\ptr->do
-			n<-c_msync ptr 65536 2
-			when(n/=0)$writeIORef errref True) mp
-#endif
-		mapM(\ptr -> munmapFilePtr ptr 65536) mp
-		when isFinal$c_system_io_mmap_file_close handle'
-		bool <- readIORef errref
-		when bool$fail"unmapAll: FlushViewOfFile or msync failed"
-		return empty
-
--- N.B. That this will crash if attempt is made to call twice on the same table object.
-unmapAll (Table _ (mvar,handle)) = modifyMVar_ mvar$_unmapAll True handle
− src/Data/Columbia/Internal/Orphans.hs 
@@ -1,135 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, StandaloneDeriving, DeriveDataTypeable, ImpredicativeTypes, ScopedTypeVariables, Trustworthy #-}
-
-module Data.Columbia.Internal.Orphans (LazyFix(LazyFix), LazyMap(..)) where
-
-import Data.Word
-import Data.Typeable hiding (Proxy)
-import qualified Data.Map as M
-import Generics.Pointless.Functors
-import Data.Generics.SYB.WithClass.Basics
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.Headers
-import Data.Columbia.Types
-import Data.Columbia.FRecord
-import Data.Columbia.WithAddress
-import Data.Array.Unboxed
-import Data.Tree
-
-idConstr = Constr(AlgConstr 1) "IdF" [] Prefix idDataType
-idDataType = DataType "Generics.Pointless.Functors" (AlgRep[idConstr])
-instance (Sat(ctx(Id x)), Data ctx x) => Data ctx(Id x) where
-	gfoldl _ o f (IdF x) = f IdF `o` x
-	gunfold _ k f _ = k(f IdF)
-	dataTypeOf _ _ = idDataType
-	toConstr _ _ = idConstr
-	dataCast1 _ = gcast1
-
-constConstr = Constr(AlgConstr 1) "ConsF" [] Prefix idDataType
-constDataType = DataType "Generics.Pointless.Functors" (AlgRep[constConstr])
-instance (Sat(ctx(Const t x)), Data ctx t, Data ctx x) => Data ctx(Const t x) where
-	gfoldl _ o f (ConsF x) = f ConsF `o` x
-	gunfold _ k f _ = k(f ConsF)
-	dataTypeOf _ _ = constDataType
-	toConstr _ _ = constConstr
-	dataCast1 _ = gcast1
-
-sumConstr1 = Constr(AlgConstr 1) "InlF" [] Prefix sumDataType
-sumConstr2 = Constr(AlgConstr 2) "InrF" [] Prefix sumDataType
-sumDataType = DataType "Generics.Pointless.Functors" (AlgRep[sumConstr1,sumConstr2])
-instance (Sat(ctx((:+:) g h x)), Typeable1 g, Typeable1 h, Data ctx x, Data ctx(g x), Data ctx(h x)) => Data ctx((:+:) g h x) where
-	gfoldl _ o f (InlF x) = f InlF `o` x
-	gfoldl _ o f (InrF x) = f InrF `o` x
-	gunfold _ k f constr = case constrIndex constr of
-		1 -> k(f InlF)
-		2 -> k(f InrF)
-		_ -> error"Sum.gunfold: unrecognized constructor index"
-	dataTypeOf _ _ = sumDataType
-	toConstr _ (InlF _) = sumConstr1
-	toConstr _ (InrF _) = sumConstr2
-	dataCast1 _ = gcast1
-
-prodConstr = Constr(AlgConstr 1) "ProdF" [] Prefix prodDataType
-prodDataType = DataType "Generics.Pointless.Functors" (AlgRep[prodConstr])
-instance (Sat(ctx((:*:) g h x)), Typeable1 g, Typeable1 h, Data ctx x, Data ctx(g x), Data ctx(h x)) => Data ctx((:*:) g h x) where
-	gfoldl _ o f (ProdF x x2) = f ProdF `o` x `o` x2
-	gunfold _ k f _ = k(k(f ProdF))
-	dataTypeOf _ _ = prodDataType
-	toConstr _ _ = prodConstr
-	dataCast1 _ = gcast1
-
-compConstr = Constr(AlgConstr 1) "CompF" [] Prefix compDataType
-compDataType = DataType "Generics.Pointless.Functors" (AlgRep[compConstr])
-instance (Sat(ctx((:@:) g h x)), Typeable1 g, Typeable1 h, Data ctx x, Data ctx(g(h x))) => Data ctx((:@:) g h x) where
-	gfoldl _ o f (CompF x) = f CompF `o` x
-	gunfold _ k f _ = k(f CompF)
-	toConstr _ _ = compConstr
-	dataTypeOf _ _ = compDataType
-	dataCast1 _ = gcast1
-
-----------------------------------------------
-
-deriving instance (Eq(Rep f(Fix f))) => Eq(Fix f)
-
-deriving instance (Ord(Rep f(Fix f))) => Ord(Fix f)
-
-deriving instance (Typeable1 f) => Typeable(LazyFix f)
-
-deriving instance (Eq(Rep f(LazyFix f))) => Eq(LazyFix f)
-
-deriving instance (Ord(Rep f(LazyFix f))) => Ord(LazyFix f)
-
-deriving instance (Show(Rep f(LazyFix f))) => Show(LazyFix f)
-
-deriving instance (Read(Rep f(LazyFix f))) => Read(LazyFix f)
-
-lazyFixConstr = Constr(AlgConstr 1) "LazyFix" [] Prefix lazyFixDataType
-lazyFixDataType = DataType "Generics.Pointless.Functors" (AlgRep[lazyFixConstr])
-instance (Sat(ctx(LazyFix f)), Typeable1 f, Data ctx(Rep f(LazyFix f))) => Data ctx(LazyFix f) where
-	gfoldl _ o f (LazyFix x) = f LazyFix `o` x
-	gunfold _ k f _ = k(f LazyFix)
-	dataTypeOf _ _ = lazyFixDataType
-	toConstr _ _ = lazyFixConstr
-
-instance (Typeable1 f) => RW(LazyFix f)
-instance KeyComparable(LazyFix f)
-
-----------------------------------------------
-
-instance (Ix i, IArray UArray e, Sat(ctx(UArray i e)), Typeable i, Data ctx e, Sat(ctx[e])) => Data ctx(UArray i e) where
-	gfoldl _ o f ua = f(listArray(bounds ua)) `o` elems ua
-	gunfold = error"no gunfold"
-	toConstr = error"no toConstr"
-	dataTypeOf _ _ = mkNorepType"Data.Array.Unboxed.UArray"
-	dataCast1 _ = gcast1
-
-----------------------------------------------
-
-treeConstr = Constr(AlgConstr 1) "Node" [] Prefix treeDataType
-treeDataType = DataType "Data.Tree.Tree" (AlgRep[treeConstr])
-instance (Data ctx t,Data ctx[Tree t],Sat(ctx(Tree t))) => Data ctx(Tree t) where
-	gfoldl _ o k (Node x ls) = k Node `o` x `o` ls
-	gunfold _ f k _ = f(f(k Node))
-	toConstr _ _ = treeConstr
-	dataTypeOf _ _ = treeDataType
-	dataCast1 _ = gcast1
-
-----------------------------------------------
-
-binConstr = Constr(AlgConstr 1) "Bin" [] Prefix mapDataType
-tipConstr = Constr(AlgConstr 2) "Tip" [] Prefix mapDataType
-mapDataType = DataType "Data.Columbia.Orphans.LazyMap" (AlgRep[binConstr,tipConstr])
-instance (Sat(ctx Int), Sat(ctx Word32), Data ctx k, Data ctx v, Sat(ctx(LazyMap k v)), Sat(ctx(WithAddress(LazyMap k v)))) => Data ctx(LazyMap k v) where
-	gfoldl _ o f (BinPrime sz k v bin bin2) = f BinPrime `o` sz `o` k `o` v `o` bin `o` bin2
-	gfoldl _ _ f TipPrime = f TipPrime
-	gunfold _ f k constr = case constrIndex constr of
-		1 -> f(f(f(f(f(k BinPrime)))))
-		2 -> k TipPrime
-		_ -> error"LazyMap.gunfold: invalid constructor index"
-	toConstr _ (BinPrime _ _ _ _ _) = binConstr
-	toConstr _ TipPrime = tipConstr
-	dataTypeOf _ _ = mapDataType
-	dataCast1 _ = gcast1
-	dataCast2 _ = gcast2
-
-instance (Typeable k, Typeable v) => RW(LazyMap k v)
-instance KeyComparable(LazyMap k v)
− src/Data/Columbia/Internal/RWInstances.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, FlexibleContexts, Trustworthy #-}
-
-module Data.Columbia.Internal.RWInstances (module Data.Generics.SYB.WithClass.Instances, RW(..), RWCtx(..)) where
-
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances
-import Data.Word
-import Data.Int
-import Data.Array
-import qualified Data.Array.Unboxed as UA
-import Data.Char
-import Data.Tree
-import Data.Typeable hiding (Proxy)
-import Data.Map
-import Data.Columbia.Types
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.Coercion
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.SeekableWriter
-import Control.Monad
-import Control.Monad.Reader
-
-instance (RW t) => Sat(RWCtx t) where dict = RWCtx
-
-instance RW Int where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Word where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Int32 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Word32 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Int16 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Word16 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Int8 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Word8 where
-	readData = readIntegral
-	writeData = writeIntegral
-instance RW Float where
-	readData = liftM int32ToFloat readIntegral
-	writeData = writeIntegral.floatToInt32
-instance RW Char where
-	readData = liftM chr readIntegral
-	writeData = writeIntegral.ord
-instance RW Bool
-instance RW Ordering
-instance RW()
-instance (Typeable t, Typeable u) => RW(t, u)
-instance (Typeable t, Typeable u, Typeable v) => RW(t, u, v)
-instance (Typeable t, Typeable u, Typeable v, Typeable w) => RW(t, u, v, w)
-instance (Typeable t, Typeable u, Typeable v, Typeable w, Typeable x) => RW(t, u, v, w, x)
-instance (Typeable t, Typeable u) => RW(Either t u)
-instance (Typeable t) => RW(Maybe t)
-instance (Typeable i, Typeable t) => RW(Array i t)
-instance (Typeable t) => RW[t]
-instance (Typeable t) => RW(Tree t)
-instance (Typeable k, Typeable v) => RW(Map k v)
-instance RW(UA.UArray Int32 Word8) where
-	readData = do
-		len :: Int32 <- readIntegral
-		liftM(UA.listArray(0, len-1))$mapM(const consumeToken) [0..len-1]
-	writeData ua = do
-		let len = succ$uncurry subtract$UA.bounds ua
-		writeIntegral len
-		mapM_ putToken(UA.elems ua)
-instance RW(UA.UArray Int32 Int8) where
-	readData = do
-		len :: Int32 <- readIntegral
-		liftM(UA.listArray(0, len-1))$mapM(const$liftM fromIntegral consumeToken) [0..len-1]
-	writeData ua = do
-		let len = succ$uncurry subtract$UA.bounds ua
-		writeIntegral len
-		mapM_(putToken.fromIntegral) (UA.elems ua)
-instance RW(UA.UArray Int32 Word16) where
-	readData = do
-		len :: Int32 <- readIntegral
-		let endIdx = len`quot`2 - 1
-		liftM(UA.listArray(0, endIdx))$mapM(const readIntegral16) [0..endIdx]
-	writeData ua = do
-		let nElems = succ(uncurry subtract$UA.bounds ua)
-		when(nElems>=maxBound`quot`2)$fail"RW.writeData: UArray is too large to index"
-		let len = 2*nElems
-		writeIntegral len
-		mapM_ writeIntegral16(UA.elems ua)
-instance RW(UA.UArray Int32 Int16) where
-	readData = do
-		len :: Int32 <- readIntegral
-		let endIdx = len`quot`2 - 1
-		liftM(UA.listArray(0, endIdx))$mapM(const readIntegral16) [0..endIdx]
-	writeData ua = do
-		let nElems = succ(uncurry subtract$UA.bounds ua)
-		when(nElems>=maxBound`quot`2)$fail"RW.writeData: UArray is too large to index"
-		let len = 2*nElems
-		writeIntegral len
-		mapM_ writeIntegral16(UA.elems ua)
-instance RW(UA.UArray Int32 Word32) where
-	readData = do
-		len :: Int32 <- readIntegral
-		let endIdx = len`quot`4 - 1
-		liftM(UA.listArray(0, endIdx))$mapM(const readIntegral) [0..endIdx]
-	writeData ua = do
-		let nElems = succ(uncurry subtract$UA.bounds ua)
-		when(nElems>=maxBound`quot`4)$fail"RW.writeData: UArray is too large to index"
-		let len = 4*nElems
-		writeIntegral len
-		mapM_ writeIntegral(UA.elems ua)
-instance RW(UA.UArray Int32 Int32) where
-	readData = do
-		len :: Int32 <- readIntegral
-		let endIdx = len`quot`4 - 1
-		liftM(UA.listArray(0, endIdx))$mapM(const readIntegral) [0..endIdx]
-	writeData ua = do
-		let nElems = succ(uncurry subtract$UA.bounds ua)
-		when(nElems>=maxBound`quot`4)$fail"RW.writeData: UArray is too large to index"
-		let len = 4*nElems
-		writeIntegral len
-		mapM_ writeIntegral(UA.elems ua)
− src/Data/Columbia/Internal/SeekableStream.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE Rank2Types, NoMonomorphismRestriction, Trustworthy #-}
-
-module Data.Columbia.Internal.SeekableStream (newTable, SeekableStream, seekableStream, hoistStream, getWord8,
--- ** Stream forming functions
-makeIoStream, makeIoStreamChar, unshimmedIOStream, makeByteStringStream, makeGenericStream,
--- ** Stream management functions
-_getPosition, _seek, _consumeToken, _consumeIntegralToken, _seekAtEnd, _isLockLive, getPosition, seek, consumeToken, consumeIntegralToken, seekAtEnd, isLockLive, relSeek, peekStream, streamToList) where
-
-import Foreign.Marshal.Utils
-import Foreign.Storable
-import Data.Word
-import Data.Maybe
-import Data.Char
-import Data.Bits
-import Data.IORef
-import System.IO
-import System.IO.Error
-import System.FileLock
-import Control.Monad.State
-import Control.Monad.Reader
-import Control.Monad.Loops
-import Control.Monad
-import Control.Exception
-import Control.Parallel.Strategies
-import qualified Data.ByteString as B
-import System.IO.Unsafe
-import Unsafe.Coerce
-import Data.Columbia.Types
-import Data.Columbia.Internal.Mapper
--- import Data.Columbia.MyEndianness
-
-seekableStream :: m(Maybe c) -> m(Maybe Word32) -> (Word32 -> m()) -> m Word32 -> m() -> m Bool -> SeekableStream m c
-seekableStream = SeekableStream
-
-hoistStream :: (forall t. m t -> m2 t) -> SeekableStream m c -> SeekableStream m2 c
-hoistStream f s = SeekableStream(f(_consumeToken s)) (f(_consumeIntegralToken s)) (\n -> f(_seek s n)) (f(_getPosition s)) (f(_seekAtEnd s)) (f(_isLockLive s))
-
-{-# INLINE getWord8 #-}
-getWord8 :: Handle -> IO Word8
-getWord8 h = with 0$ \p -> do
-	n <- hGetBuf h p 1
-	when(n==0)$void$hGetChar h -- Cause EOF exception
-	peek p
-
-data LockLike = LockLike !() !(IORef Bool)
-
-getLiveReference :: FileLock -> IORef Bool
-getLiveReference lock = let LockLike _ r = unsafeCoerce lock in r
-
-makeIoStream :: IORef(Pointer,Pointer) -> Table -> FileLock -> Bool -> SeekableStream IO Word8
-makeIoStream ref table lock eagerUnmapping = SeekableStream
-	(readIORef ref>>= \(n,sz)->if n>=sz then
-			return mzero
-		else
-			mapBlock table n eagerUnmapping>>=peek>>= \x->(writeIORef ref$!(succ n,sz))>>(return$!return x))
-	{-- TODO: not complete yet:
-	(readIORef ref>>= \(n,sz)->if n+3>=sz then
-			return mzero
-		else
-			mapBlock table n eagerUnmapping>>=peek>>= \x->(writeIORef ref$!(n+4,sz))>>(return$!return$!swapEndian' x))-}
-	(return$error"makeIoStream: unimplemented")
-	(\n->modifyIORef' ref(\(_,sz)->(n,sz)))
-	(liftM fst$readIORef ref)
-	(modifyIORef' ref(\(_,sz)->(sz,sz)))
-	(atomicModifyIORef'(getLiveReference lock)$ \b -> (b, b))
-makeIoStreamChar :: IORef(Pointer,Pointer) -> Table -> FileLock -> Bool -> SeekableStream IO Char
-makeIoStreamChar ref t l = fmap(chr.fromIntegral).makeIoStream ref t l
-
-bytesToIntegral x1 x2 x3 x4 = return$!shiftL(fromIntegral x1) 24 .|.
-	shiftL(fromIntegral x2) 16 .|.
-	shiftL(fromIntegral x3) 8 .|.
-	fromIntegral x4
-
-unshimmedIOStream :: Handle -> FileLock -> SeekableStream IO Word8
-unshimmedIOStream handle lock = SeekableStream
-	(liftM(return$!) (getWord8 handle))
-	(liftM4 bytesToIntegral(getWord8 handle) (getWord8 handle) (getWord8 handle) (getWord8 handle))
-	(hSeek handle AbsoluteSeek. toInteger)
-	(liftM fromInteger(hTell handle))
-	(hSeek handle SeekFromEnd 0)
-	(atomicModifyIORef'(getLiveReference lock)$ \b -> (b, b))
-
-makeByteStringStream :: B.ByteString -> SeekableStream(State Word32) Word8
-makeByteStringStream b = SeekableStream
-	(do
-	n <- get
-	let n' = fromIntegral n
-	if n' == B.length b then
-			return mzero
-		else do
-			put$!succ n
-			return$!return$!B.index b n')
-	(return$error"makeByteStringStream: unimplemented")
-	put
-	get
-	(put$!fromIntegral$B.length b)
-	(return True)
-
-_fst3 (x, _, _) = x
-
-makeGenericStream :: SeekableStream(State(Word32, [t], [t])) t
-makeGenericStream = SeekableStream
-	(do
-	(m, ls, ls2) <- get
-	case ls2 of
-		x:xs -> do
-			put$!(succ m, x:ls, xs)
-			return$!return x
-		[] -> return mzero)
-	(return$error"makeGenericStream: unimplemented")
-	(\n -> do
-	(m, ls, ls2) <- get
-	let n' = fromIntegral n-fromIntegral m
-	if n' < 0 then
-		let (lsa, lsb) = splitAt(-n') ls in
-			put$!using(n, lsb, reverse lsa ++ ls2) (evalTuple3 rseq rseq rseq)
-		else let (ls2a, ls2b) = splitAt n' ls2 in
-			put$!using(n, reverse ls2a ++ ls, ls2b) (evalTuple3 rseq rseq rseq))
-	(liftM _fst3 get)
-	(modify(\(n, ls, ls2) -> using(n+fromIntegral(length ls2), reverse ls2++ls, []) (evalTuple3 rseq rseq rseq)))
-	(return True)
-
-{-# INLINE _consumeToken #-}
-_consumeToken = __consumeToken
-{-# INLINE _consumeIntegralToken #-}
-_consumeIntegralToken = __consumeIntegralToken
-{-# INLINE _seek #-}
-_seek = __seek
-{-# INLINE _getPosition #-}
-_getPosition = __getPosition
-{-# INLINE _seekAtEnd #-}
-_seekAtEnd = __seekAtEnd
-{-# INLINE _isLockLive #-}
-_isLockLive = __isLockLive
-
-{-# INLINE getPosition #-}
-getPosition :: (Monad m) => ReaderT(SeekableStream m c) m Pointer
-getPosition = ask>>=lift._getPosition
-
-{-# INLINE seek #-}
-seek :: (Monad m) => Pointer -> ReaderT(SeekableStream m c) m ()
-seek n = ask>>=lift.(`_seek` n)
-
-{-# INLINE consumeToken #-}
-consumeToken :: (Monad m) => ReaderT(SeekableStream m c) m c
-consumeToken = do
-	s <- ask
-	liftM(maybe(error"consumeToken: end of stream") id)$lift$_consumeToken s
-
-{-# INLINE consumeIntegralToken #-}
-consumeIntegralToken :: (Monad m) => ReaderT(SeekableStream m c) m Word32
-consumeIntegralToken = do
-	s <- ask
-	liftM(maybe(error"consumeIntegralToken: end of stream") id)$lift$_consumeIntegralToken s
-
-{-# INLINE seekAtEnd #-}
-seekAtEnd :: (Monad m) => ReaderT(SeekableStream m c) m ()
-seekAtEnd = ask>>=lift._seekAtEnd
-
-isLockLive :: (Monad m) => ReaderT(SeekableStream m c) m Bool
-isLockLive = ask>>=lift._isLockLive 
-
-{-# INLINE relSeek #-}
-relSeek n = do
-	m <- getPosition
-	seek$!m+n
-
-peekStream :: (Monad m) => ReaderT(SeekableStream m c) m c
-peekStream = do
-	x <- consumeToken
-	relSeek(-1)
-	return x
-
-streamToList :: (Monad m) => SeekableStream m c -> m[c]
-streamToList = unfoldM._consumeToken
− src/Data/Columbia/Internal/SeekableWriter.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE Rank2Types, Trustworthy #-}
-
-module Data.Columbia.Internal.SeekableWriter where
-
-import Foreign.Marshal.Utils
-import Foreign.Storable
-import Data.Functor.Invariant
-import Data.List
-import Data.Word
-import Data.Char
-import Data.Bits
-import Data.IORef
-import Data.Generics.SYB.WithClass.Basics
-import System.IO
-import System.FileLock
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Morph
-import Control.Monad
-import Control.Arrow
-import Control.Parallel.Strategies
-import Control.Exception
-import Data.Columbia.Types
-import Data.Columbia.Internal.SeekableStream
--- import Data.Columbia.MyEndianness
-import Data.Columbia.Internal.Mapper
-
-instance (Functor m) => Invariant(SeekableWriter m) where
-	invmap f g sw = SeekableWriter(_putToken sw.g) (_putIntegralToken sw) (fmap f(stream sw))
-
-hoistWriter :: (forall t. m t -> m2 t) -> SeekableWriter m c -> SeekableWriter m2 c
-hoistWriter f sw = SeekableWriter(\x -> f(_putToken sw x)) (\x->f(_putIntegralToken sw x)) (hoistStream f(stream sw))
-
-{-# INLINE putWord8 #-}
-putWord8 :: Handle -> Word8 -> IO()
-putWord8 h x = with x(\p -> hPutBuf h p 1)
-
-makeIoWriter :: IORef(Pointer,Pointer) -> Table -> FileLock -> Bool -> SeekableWriter IO Word8
-makeIoWriter ref table lock eagerUnmapping = SeekableWriter
-	(\x->readIORef ref>>= \(n,sz)->mapBlock table n eagerUnmapping>>=(`poke` x)>>(writeIORef ref$!(succ n,max(succ n) sz)))
-	{- TODO: not complete yet
-	(\x->readIORef ref>>= \(n,sz)->mapBlock table n eagerUnmapping>>=(`poke` swapEndian' x)>>(writeIORef ref$!(n+4,max(n+4) sz)))-}
-	(\_->fail"makeIoWriter: unimplemented")
-	(makeIoStream ref table lock eagerUnmapping)
-
-{-# INLINE makeIoWriter' #-}
-makeIoWriter' :: FilePath -> FileLock -> Bool -> IO(SeekableWriter IO Word8,IO(),IORef(Pointer,Pointer))
-makeIoWriter' path l eagerUnmapping = do
-	table <- newTable path
-	sz <- fileSizeShim table
-	ref <- newIORef$!(0,sz)
-
-	-- Delegate used for closing file.
-	let conclude = do
-		(_,sz) <- readIORef ref
-		unmapAll table
-		bracket
-			(openBinaryFile path ReadWriteMode)
-			hClose
-			(`hSetFileSize` toInteger sz)
-
-	return$!(makeIoWriter ref table l eagerUnmapping,
-		conclude,	
-		ref)
-
-makeIoWriterChar :: IORef(Pointer,Pointer) -> Table -> FileLock -> Bool -> SeekableWriter IO Char
-makeIoWriterChar ref t l = invmap(chr.fromIntegral) (fromIntegral.ord).makeIoWriter ref t l
-
-unshimmedIOWriter :: Handle -> FileLock -> SeekableWriter IO Word8
-unshimmedIOWriter handle lock = SeekableWriter(putWord8 handle)
-	(\n->putWord8 handle(fromIntegral$shiftR n 24)>>
-		putWord8 handle(fromIntegral$shiftR n 16)>>
-		putWord8 handle(fromIntegral$shiftR n 8)>>
-		putWord8 handle(fromIntegral n))
-	(unshimmedIOStream handle lock)
-
-makeGenericWriter :: SeekableWriter(State(Word32, [t], [t])) t
-makeGenericWriter = SeekableWriter
-	(\x -> modify(\(n, ls, ls2) -> using(succ n, x:ls, drop 1 ls2) (evalTuple3 rseq rseq rseq)))
-	(\_->fail"makeGenericWriter: unimplemented")
-	makeGenericStream
-
-{-# INLINE putToken #-}
-putToken :: (Monad m) => c -> ReaderT(SeekableWriter m c) m ()
-putToken c = ask>>=lift.(`_putToken` c)
-
-{-# INLINE putIntegralToken #-}
-putIntegralToken :: (Monad m) => Word32 -> ReaderT(SeekableWriter m c) m ()
-putIntegralToken n = ask>>=lift.(`_putIntegralToken` n)
-
-{-# INLINE consumeTokenW #-}
-consumeTokenW :: (Monad m) => ReaderT(SeekableWriter m c) m (Maybe c)
-consumeTokenW = ask>>=lift._consumeToken.stream
-
-{-# INLINE consumeIntegralTokenW #-}
-consumeIntegralTokenW :: (Monad m) => ReaderT(SeekableWriter m c) m (Maybe Word32)
-consumeIntegralTokenW = ask>>=lift._consumeIntegralToken.stream
-
-{-# INLINE getWriterPosition #-}
-getWriterPosition :: (Monad m) => ReaderT(SeekableWriter m c) m Word32
-getWriterPosition = ask>>=lift._getPosition.stream
-
-{-# INLINE seekWriter #-}
-seekWriter :: (Monad m) => Pointer -> ReaderT(SeekableWriter m c) m ()
-seekWriter n = ask>>=lift.(`_seek` n).stream
-
-{-# INLINE seekWriterAtEnd #-}
-seekWriterAtEnd :: (Monad m) => ReaderT(SeekableWriter m c) m ()
-seekWriterAtEnd = ask>>=lift._seekAtEnd.stream
-
-{-# INLINE relSeekWriter #-}
-relSeekWriter :: (Monad m) => Word32 -> ReaderT(SeekableWriter m c) m ()
-relSeekWriter n = ask>>=lift.runReaderT(relSeek n).stream
-
-{-# INLINE local' #-}
-local' f x = ask>>=lift.runReaderT x.f
-
-{-# INLINE hoistReaderM #-}
-hoistReaderM :: (Monad m, Monad n)
-	=> (forall t. m t->n t)
-	-> (forall t. n t->m t)
-	-> ReaderT(SeekableWriter m c) m u
-	-> ReaderT(SeekableWriter n c) n u
-hoistReaderM f f2 = hoist f.local'(hoistWriter f2)
-
-hoistPolyTraversalW :: (Monad m, Monad n)
-	=> (forall t. m t->n t)
-	-> (forall t. n t->m t)
-	-> PolyTraversalW ctx m u
-	-> PolyTraversalW ctx n u
-hoistPolyTraversalW f f2 traversal proxy g = hoistReaderM f f2.traversal proxy(\x->hoistReaderM f2 f.g$x)
-
− src/Data/Columbia/Theory.hs 
@@ -1,45 +0,0 @@-
-{- | Here are some equivalences that explain how Columbia operations work. The ~== equivalence operator means equivalence under the object graph relation, and does not pay attention to addresses of data. These are moral equivalences and do not hold in the presence of interference with lock files or failure to lock. The object graph relation defines two Columbia files as equivalent iff the co-recursively structures built by traversing them are co-inductively equal.
-
-* Assuming do { f d; m } ~== do { f d; return d }
-
-do { writeOneLayer proxy f d; readOneLayer proxy m }
-  ~== do { writeOneLayer proxy f d; return d }
-
-* Assuming do { d <- m; f d } ~== return()
-
-do { d <- readOneLayer proxy m; writeOneLayer proxy f d }
-  ~== return()
-
-* Assuming do { f d; f d } ~== f d
-
-do { writeOneLayer proxy f d; writeOneLayer proxy f d }
-  ~== writeOneLayer proxy f d
-
-that is 'writeOneLayer' is idempotent with regard to the object graph/term structure.
-
-* Assuming effect 'm' is non-observable, /readOneLayer proxy m/ is also non-observable.
-
-* For a strategy 's' that reads or writes,
-
-do { n <- getWriterPosition; s; seekWriter n } == s,
-
-That is well-behaved read/write strategies leave the stream seeked the way they found it.
-
-Through co-inductive equality reasoning, it can be deduced that:
-
-do { writeCompoundData d; readCompoundData }
-  ~== do { writeCompoundData d; return d }
-
-and
-
-do { d <- readCompoundData; writeCompoundData d }
-  ~== return()
-
-because 'readCompoundData' is just /fixT rwProxy readOneLayer/ (similarly 'writeCompoundData').
-
-------------------------------------------
-
-'withAddresses' and 'writeBackAddresses' are each equivalent to the identity where the type they work at is not an application of 'WithAddress' type constructor.-}
-
-module Data.Columbia.Theory where
− src/Data/Columbia/Types.hs 
@@ -1,101 +0,0 @@-{-# LANGUAGE Trustworthy, Rank2Types, ExistentialQuantification, ScopedTypeVariables, DeriveFunctor #-}
-
-module Data.Columbia.Types where
-
-import Data.Typeable hiding (Proxy)
-import Data.Word
-import Control.Monad.Reader hiding (Functor)
-import Data.Generics.SYB.WithClass.Basics
-import Generics.Pointless.Functors hiding (Functor)
-
-type Pointer = Word32
-
-data SeekableStream m c = SeekableStream
-	{ __consumeToken :: !(m(Maybe c)), __consumeIntegralToken :: !(m(Maybe Word32)), __seek :: !(Pointer -> m()), __getPosition :: !(m Pointer), __seekAtEnd :: !(m()), __isLockLive :: !(m Bool) } deriving Functor
-
-data SeekableWriter m c = SeekableWriter
-	{ _putToken :: !(c -> m()), _putIntegralToken :: !(Word32 -> m()), stream :: !(SeekableStream m c) }
-
---------------------------------------
-
--- | The 'RW' class describes operations that can locate entities in a stream by seeking,
---   and also read and write primitive types.
-class (Typeable t) => RW t where
-	readData :: (Monad m) => ReaderT(SeekableStream m Word8) m t
-	readData = fail$"RW.readData: unimplemented for " ++ show(typeOf(undefined :: t))
-	writeData :: (Monad m) => t -> ReaderT(SeekableWriter m Word8) m ()
-	writeData = fail$"RW.writeData: unimplemented for " ++ show(typeOf(undefined :: t))
-
-data RWCtx a = (RW a) => RWCtx
-
--- | A 'PolyTraversal' is a reader method over a data type, parameterized over a method to read components.
---   It can be seen as a curried form of the 'gmapM' operator from Data.Data, in like manner as the
---   'Traversal' is a curried form of 'traverse'.
-type PolyTraversal ctx m d = Proxy ctx
-	-> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
-	-> ReaderT(SeekableStream m Word8) m d
-
--- | This is a variant of 'PolyTraversal' purposed for writing. By convention, strategies with this type
---   require the stream to be seeked at an *address*, which the strategy will then dereference to access the
---   corresponding data.
-type PolyTraversalW ctx m d = Proxy ctx
-	-> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m ())
-	-> d -> ReaderT(SeekableWriter m Word8) m ()
-
------------------------------------
-
--- | The standard 'Fix' constructor is too strict for some things this library has to do, hence the alias.
-data LazyFix f = LazyFix(Rep f(LazyFix f))
-
--- | This type alias exposes an alternate view of the data constructors of a dictionary type.
---   Why break abstraction????because I need the structure sharing.
-data LazyMap k v = BinPrime { lazy_map_size :: Int,
-	lazy_map_key :: k,
-	lazy_map_value :: v,
-	lazy_map_bin1 :: WithAddress(LazyMap k v),
-	lazy_map_bin2 :: WithAddress(LazyMap k v) } | TipPrime
-	deriving (Eq, Ord, Show, Typeable)
-
-------------------------------------
-
--- | 'isKeyed' may always return false, but if it returns true ever, 'keyCompare'
---   must be well-defined and a valid equivalence relation on values for which
---   'isKeyed' returns true (i.e. where all values concerned have /isKeyed x=true/).
---The default is to have 'isKeyed' return false on all values.
-class KeyComparable t where
-	isKeyed :: t->Bool
-	isKeyed _ = False
-	keyCompare :: t -> t->Ordering
-	keyCompare _ _ = error"KeyComparable.keyCompare: is not a keyed data type"
-
-data KeyCtx t = (KeyComparable t) => KeyCtx
-
-------------------------------------
-
--- | Data type for a piece of data that may or may not have an explicit address associated with it.
---   This is nice because I can play with these in pure code to manipulate data, while still
---   remembering all of the explicit term structure.
-data WithAddress t = WithAddress Pointer t
-	deriving (Eq, Ord, Show, Typeable)
-
-------------------------------------
-
-data Header = Header !Word8 !ConIndex !Int
-
-isUArray :: Header -> Bool
-isUArray (Header n _ _) = n == 3
-
-isArray :: Header -> Bool
-isArray (Header n _ _) = n == 2
-
-isPrimtype :: Header -> Bool
-isPrimtype (Header n _ _) = n == 1
-
-isAlgtype :: Header -> Bool
-isAlgtype (Header n _ _) = n == 0
-
-getConIndex :: Header -> ConIndex
-getConIndex (Header _ i _) = i
-
-getNFields :: Header -> Int
-getNFields (Header _ _ n) = n
− src/Data/Columbia/Utils.hs 
@@ -1,133 +0,0 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, Trustworthy #-}
-
--- | Some utility functions. The reader strategies maintain the invariant that the stream is seeked
---   to the beginning of a data entity, so that it is safe to use 'readData'/'writeData'/'seekTo'
---   etc. The writer strategies maintain the invariant that the writer is seeked at the word
---   that should receive the address of the data entity that is written. This allows the writer
---   to write eagerly the address and so be tail recursive in some cases.
---
---   Think of a columbia file as just a transactional log that is continually being
---   written to; transactions are able to reference other transactions by address, thus
---   constructing data structures; a single address, called the root node address, at the
---   beginning of the file determines the file's nominal mutable state. To keep the file from getting
---   too large, it is garbage collected periodically; calls to the
---   collector have to be programmed to happen manually at a time convenient for your
---   application.
---
---   Please be aware that while you *can* write new addresses over old in the file,
---   this is not compatible with the locking scheme, which is predicated on
---   the assumption that all writing happens to the root block address and appending to
---   the end of the file.
-module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper) where
-
-import Data.Word
-import Data.IORef
-import System.IO
-import System.FileLock
-import Control.Monad.Reader
-import Control.Monad.Trans
-import Control.Monad.Error
-import Control.Monad.IO.Class
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Context
-import Data.Columbia.Types
-import Data.Columbia.Internal.SeekableWriter
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.Headers
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.Internal.DualLock
-import Data.Columbia.Internal.Mapper
-
-bracket m f f2 = do
-	x <-m
-	x2 <-catchError(f2 x) (\e->do { f x; throwError e })
-	f x
-	return x2
-
-withFileLock' path mode = bracket
-	(liftIO$lockFile path mode)
-	(liftIO.unlockFile)
-
------------------------------------
-
-{-# INLINE seekToStart #-}
-seekToStart :: (Monad m) => ReaderT(SeekableStream m Word8) m ()
-seekToStart = seek 0
-
-rwProxy :: Proxy(PairCtx RWCtx NoCtx)
-rwProxy = error"proxy"
-
-{-# INLINE snd3 #-}
-snd3(_,x,_) = x
-
--- | A wrapper for reading Columbia files; the 'proc' parameter is a reading operation.
---   Use 'fixT' to make the conversion between 'PolyTraveral's and recursive reading
---   operations. Typically set 'm' parameter to 'IO'.
-readFileWrapper :: (MonadError e m, MonadIO m)
-	=> FilePath
-	-> ReaderT(SeekableStream m Word8) m t
-	-> m t
-readFileWrapper path proc = liftIO(newIORef undefined)>>= \cursor->
-	bracket
-	(liftIO$dualLockShared path)
-	(liftIO.unlockShared)
-	$ \l@(DualLockShared _ _ l2) ->
-	bracket
-	(liftIO$makeIoWriter' path l2 True)
-	(liftIO.snd3) -- Call delegate.
-	$ \(writer,_,_) ->
-	do
-	let s = stream$hoistWriter liftIO writer
-	-- Unlock the writer lock once having retrieved the root block address.
-	withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart s
-	runReaderT proc s
-
--- | A wrapper for writing Columbia files; 'fixTW' converts between 'PolyTraversalW's
---   and recursive writing operations.
-writeFileWrapper :: (MonadError e m, MonadIO m)
-	=> FilePath
-	-> ReaderT(SeekableWriter m Word8) m t
-	-> m t
-writeFileWrapper path proc = liftIO(newIORef undefined)>>= \cursor->
-	bracket
-	(liftIO$dualLockShared path)
-	(liftIO.unlockShared)
-	$ \_->
-	withFileLock'(path++".lock.writer") Exclusive
-	$ \l ->
-	bracket
-	(liftIO$makeIoWriter' path l True)
-	(liftIO.snd3)
-	$ \(writer,_,_) ->
-	let writer' = hoistWriter liftIO writer in
-	runReaderT
-	(do
-		sw <- ask
-		seekWriterAtEnd
-		len <- getWriterPosition
-		addr::Pointer <- if len==0 then do
-			writeIntegral(0 :: Pointer)
-			return$!0
-			else do
-		-- For robustness in case of power failures etc. I will special case the root block pointer
-		-- so it writes into a slop field. Once writing is complete, the slop field is copied into
-		-- the actual root block pointer field. That way an interruption to the writing procedure
-		-- does no harm to the file and leaves it in its previous nominal state.
-			seekWriter 0
-			local' stream readIntegral
-		seekWriterAtEnd
-		-- Create slop field.
-		writeHeader rwProxy(0::Pointer)
-		len2 <- getWriterPosition
-		writeIntegral addr
-		seekWriter len2
-		x <- proc
-		-- Copy address into root block address field.
-		seekWriter len2
-		n::Pointer <- local' stream readIntegral
-		seekWriter 0
-		writeIntegral n
-		return x
-	)
-	writer'
-
− src/Data/Columbia/WithAddress.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, DeriveDataTypeable, ScopedTypeVariables, Trustworthy #-}
-
-module Data.Columbia.WithAddress (WithAddress, copoint, point, addressOf, dataOf, withAddresses, writeBackAddresses) where
-
-import Data.Word
-import Data.Function
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances
-import Generics.Pointless.Functors hiding (Functor)
-import Control.Monad
-import Control.Monad.Reader
-import Data.Columbia.Types
-import Data.Columbia.Internal.SeekableStream
-import Data.Columbia.Internal.IntegralTypes
-import Data.Columbia.FRecord
-
-{-# INLINE copoint #-}
-copoint(WithAddress _ x) = x
-
-{-# INLINE point #-}
-point = WithAddress 0 -- Null address indicates that no address is known.
-
-{-# INLINE addressOf #-}
-addressOf :: WithAddress t -> Word32
-addressOf(WithAddress n _) = n
-
-{-# INLINE dataOf #-}
-dataOf :: WithAddress t -> t
-dataOf = copoint
-
-instance (Sat(ctx Word32), Sat(ctx(WithAddress t)), Data ctx t) => Data ctx(WithAddress t) where
-	gfoldl _ o k (WithAddress n x) = k WithAddress `o` n `o` x
-	gunfold _ f k _ = f(f(k WithAddress))
-	dataTypeOf proxy _ =
-		let ty = DataType "Data.Columbia.WithAddresses.WithAddress" (AlgRep[
-			Constr(AlgConstr 1) "WithAddress" [] Prefix ty]) in
-			ty
-	toConstr proxy x = case dataTypeOf proxy x of
-		DataType _(AlgRep ls) -> head ls
-	dataCast1 _ f = gcast1 f
-
-instance (Typeable t) => RW(WithAddress t)
-
--- Addresses (file offsets) can serve as keys for purposes of cycle detection.
-instance KeyComparable(WithAddress t) where
-	isKeyed (WithAddress 0 _) = False
-	isKeyed _ = True
-	keyCompare = compare `on` addressOf
-
--- | The strategy reads term structure from a file and associates file addresses with it.
---   Bear in mind that the addresses become no good at the moment your reader lock is
---   relinquished, due to GC'ing.
-withAddresses :: forall ctx m d. (Data ctx d, Monad m) => PolyTraversal ctx m d
-withAddresses proxy m = case dataCast1 proxy(do
-	addr <- readIntegral
-	relSeek(-4)
-	liftM(WithAddress addr) m) of
-	Just m2 -> m2
-	Nothing -> m
-
-newtype Fl m t = Fl { unFl :: t -> ReaderT(SeekableWriter m Word8) m () }
-
--- | A strategy to intelligently reconstruct shared structure on disk. It intercepts any subterm with
---   type 'WithAddress' and that associates an address to the data, and writes that address
---   in lieu of writing all of the data, thereby achieving structural sharing. Note that the term
---   structure of 'WithAddress' constructor is skipped and does not get written.
-writeBackAddresses ::  forall ctx m d. (Data ctx d, Monad m) => PolyTraversalW ctx m d
-writeBackAddresses proxy f d = case dataCast1 proxy(Fl$ \d2 -> if addressOf d2==0 then f$dataOf d2 else writeIntegral$addressOf d2) of
-	Just fl -> unFl fl d
-	Nothing -> f d