columbia 0.1.2 → 0.1.3

raw patch · 29 files changed

+1538/−1216 lines, 29 filesdep −pointeddep ~arraydep ~containersdep ~contravariantPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: pointed

Dependency ranges changed: array, containers, contravariant, directory, invariant, syb-with-class

API changes (from Hackage documentation)

Files

• columbia.cabal +13/−11
• src/Data/Columbia.hs +2/−3
• src/Data/Columbia/Coercion.hs +0/−19
• src/Data/Columbia/CompoundData.hs +37/−24
• src/Data/Columbia/CycleDetection.hs +24/−23
• src/Data/Columbia/Dictionaries.hs +183/−0
• src/Data/Columbia/DualLock.hs +0/−58
• src/Data/Columbia/Gc.hs +121/−96
• src/Data/Columbia/Headers.hs +0/−124
• src/Data/Columbia/Integral.hs +0/−51
• src/Data/Columbia/Internal/Coercion.hs +19/−0
• src/Data/Columbia/Internal/DualLock.hs +58/−0
• src/Data/Columbia/Internal/Headers.hs +134/−0
• src/Data/Columbia/Internal/IntegralTypes.hs +52/−0
• src/Data/Columbia/Internal/Mapper.hs +136/−0
• src/Data/Columbia/Internal/Orphans.hs +135/−0
• src/Data/Columbia/Internal/RWInstances.hs +127/−0
• src/Data/Columbia/Internal/SeekableStream.hs +175/−0
• src/Data/Columbia/Internal/SeekableWriter.hs +132/−0
• src/Data/Columbia/Mapper.hs +0/−132
• src/Data/Columbia/MyEndianness.hs +0/−75
• src/Data/Columbia/Orphans.hs +0/−100
• src/Data/Columbia/RWInstances.hs +0/−138
• src/Data/Columbia/SeekableStream.hs +0/−177
• src/Data/Columbia/SeekableWriter.hs +0/−125
• src/Data/Columbia/Theory.hs +45/−0
• src/Data/Columbia/Types.hs +101/−0
• src/Data/Columbia/Utils.hs +32/−39
• src/Data/Columbia/WithAddress.hs +12/−21

@@ -2,17 +2,13 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                columbia
-version:             0.1.2
+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.
-	.
-	This library by default enforces a strong concept of immutability; 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. This work was inspired by Haskell's focus on immutability, and by the programming langauge Clojure's very disciplined management of mutable state.
-	.
-	In addition to a bare bones locking strategy, an optional transactional locking strategy over tree data structures is implemented. This gets this close to an object-oriented DBMS; there is a strong affinity between persisted objects and tree data structures. The transaction strategy prevents multiple processes from reading and writing on data that is mutually descendant in a tree structure. I argue that this is the appropriate generalization of transactions on traditional relational database records.
+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.
 	.
-	The database's store has been implemented over memory maps for speed, and is portable between Windows and Linux platforms.
+	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.
 	.
-	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 ;).
+	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 ;).
 	.
 	Release notes for version 0.1.1:
 	.
@@ -23,6 +19,12 @@ 	Release notes for version 0.1.2:
 	.
 	* Minor bug fixes.
+	.
+	Release notes for version 0.1.3:
+	.
+	* implemented additional functions specifically for handling dictionaries ('Map's).
+	.
+	* Added basic theory.
 license:             BSD3
 license-file:        LICENSE
 author:              James Candy
@@ -34,10 +36,10 @@ cabal-version:       >=1.10
 
 library
-  exposed-modules:     Data.Columbia, Data.Columbia.CompoundData, Data.Columbia.SeekableStream, Data.Columbia.SeekableWriter, Data.Columbia.Utils, Data.Columbia.Gc, Data.Columbia.Integral, Data.Columbia.CycleDetection, Data.Columbia.FRecord, Data.Columbia.WithAddress, Data.Columbia.Orphans, Data.Columbia.DualLock
-  other-modules:       Data.Columbia.Headers, Data.Columbia.Coercion, Data.Columbia.RWInstances, Data.Columbia.Mapper, Data.Columbia.MyEndianness, Data.Columbia.DynamicWithCtx
+  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
   -- 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 && <=1.3.0.0, syb-with-class ==0.6.1.7, array >=0.5.1 && <0.5.2, invariant ==0.4.2, containers ==0.5.8.1, 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, pointed ==5
+  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

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy, Rank2Types, TypeFamilies, FlexibleContexts #-}
 
-module Data.Columbia (module Data.Columbia.CompoundData, module Data.Columbia.CycleDetection, module Data.Columbia.Utils, module Data.Columbia.Integral, 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,
+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
 
@@ -9,7 +9,6 @@ import Data.Columbia.CompoundData
 import Data.Columbia.CycleDetection
 import Data.Columbia.Utils
-import Data.Columbia.Integral
 import Data.Columbia.Gc
 import Data.Columbia.FRecord
 import Data.Columbia.WithAddress
@@ -31,7 +30,7 @@ writeCompoundData = fixTW rwProxy(writeBackAddresses ##. writeOneLayer)
 
 rwKeyProxy :: Proxy(PairCtx RWCtx(PairCtx KeyCtx NoCtx))
-rwKeyProxy = undefined
+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)

@@ -1,19 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-
-module Data.Columbia.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

@@ -5,18 +5,22 @@ --   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 an inductive data type instance is
---   implemented in 'readOneLayer'. A bare-bones reader function is then /let r = readOneLayer proxy r in r/.
---   A poly-traversal is a function that is inserted into this recursive call chain. For instance,
+--   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'.
+--   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'.
 --
---   Technically, the type of poly-traversals encompasses all co-recursive definitions at that type.
---   Well-founded recursion cannot be guaranteed owing to the cyclical nature of data structures.
---   If one needs recursion to be well-founded, one can use 'cycReadCompoundData' -- the well-foundedness
---   then follows from the finitude of the addresses.
-module Data.Columbia.CompoundData (module Data.Columbia.SeekableStream, module Data.Columbia.SeekableWriter, module Data.Columbia.RWInstances,
+--   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
@@ -36,11 +40,13 @@ import Control.Monad.Trans
 import Control.Monad.Morph
 import Control.Monad
-import Data.Columbia.SeekableStream
-import Data.Columbia.SeekableWriter
-import Data.Columbia.Integral
-import Data.Columbia.Headers
-import Data.Columbia.RWInstances
+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
 
@@ -77,8 +83,8 @@ -- | Try to cast from the first traversal; if that fails, use the second traversal.
 typeCoerce :: (Typeable t, Data ctx t2)
 	=> PolyTraversal ctx m t
-	-> (forall t3. (Data ctx t3) => PolyTraversal ctx m t3)
 	-> PolyTraversal ctx m t2
+	-> PolyTraversal ctx m t2
 typeCoerce traversal traversal2 proxy m = 
 	maybe
 	(traversal2 proxy m)
@@ -87,8 +93,8 @@ 
 typeCoerceW :: (Typeable t, Data ctx t2)
 	=> PolyTraversalW ctx m t
-	-> (forall t3. (Data ctx t3) => PolyTraversalW ctx m t3)
 	-> PolyTraversalW ctx m t2
+	-> PolyTraversalW ctx m t2
 typeCoerceW traversal traversal2 proxy f x = 
 	maybe
 	(traversal2 proxy f x)
@@ -108,18 +114,13 @@ 		seek x
 		rec
 
--- | A 'PolyTraversal' is a reader method over a data type, parameterized over a method to read components.
---   Think: the targets have /wide appeal/, making it /easy to find a buyer/.
-type PolyTraversal ctx m d = Proxy ctx
-	-> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
-	-> ReaderT(SeekableStream m Word8) m d
-
 -- | 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.
@@ -129,7 +130,7 @@ 	when(hdr/=hdr2)$fail$"readCompoundData: header check failed "++
 		"(header from file is "++showsPrec 11 hdr
 		("; header from program is "++showsPrec 11 hdr2 ")")
-	if isHeaderAlgtype hdr || isHeaderArraytype hdr then do
+	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
@@ -148,6 +149,8 @@ 		-- 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.
@@ -193,9 +196,12 @@ 			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
@@ -204,9 +210,15 @@ 	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
@@ -223,6 +235,7 @@ _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

@@ -1,19 +1,31 @@ {-# LANGUAGE ConstraintKinds, ExistentialQuantification, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, DeriveDataTypeable, TypeFamilies, StandaloneDeriving, Trustworthy #-}
 
--- | PolyTraversals that add cycle detection and fixed point construction to any R/W strategy.
+-- | 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.Set (Set)
 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.CompoundData
+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.Orphans
-import Data.Columbia.Integral
 import Data.Columbia.DynamicWithCtx
 import Generics.Pointless.Functors
 import Generics.Pointless.Combinators
@@ -40,18 +52,6 @@ get' = mfy'(\s -> (s, s))
 put' s = mfy'(\_ -> (s, ()))
 
--- | '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
-
 instance (KeyComparable t) => Sat(KeyCtx t) where dict = KeyCtx
 
 instance Eq(DynamicWithCtx Eq) where
@@ -70,7 +70,7 @@ 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 Word32 Dynamic, HasField ctx RWCtx, Data ctx t)
+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->
@@ -86,7 +86,7 @@ 			.fromDynamic)
 		.lookup n
 
-cycleDetectW :: forall ctx m t. (StateM m, StateOf m ~ Map(DynamicWithCtx KeyComparable) Word32, HasField ctx RWCtx, HasField ctx KeyCtx, Data ctx t)
+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
@@ -101,7 +101,9 @@ 				seekWriter n
 				when(isKeyed d)$lift$put'$insert d addr mp
 				f x)
-				writeIntegral
+				(\n->do
+				writeIntegral n
+				relSeekWriter(-4))
 				$lookup d mp
 
 runCycleDetectionR :: (Monad m)
@@ -154,10 +156,10 @@ instance KeyComparable(Either t t2)
 instance KeyComparable(Maybe t)
 instance KeyComparable[t]
-instance KeyComparable(Map t u)
-instance KeyComparable(Set 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
@@ -177,6 +179,5 @@ instance KeyComparable ((:*:) f g x)
 instance KeyComparable ((:@:) f g x)
 instance KeyComparable (Fix f)
-instance KeyComparable (LazyFix f)
 instance KeyComparable (Const x x2)
 instance KeyComparable (Id x)

@@ -0,0 +1,183 @@+{-# 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

@@ -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.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

@@ -12,8 +12,7 @@ --   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 freely while using the collector; writes to the
---   file will be held up until the collector finishes.
+--   operation you are doing; you can read and write freely while using the collector.
 module Data.Columbia.Gc (markAndSweepGc) where
 
 import Control.Monad.Reader
@@ -28,13 +27,14 @@ import Data.Word
 import Data.Bits
 import Data.IORef
-import Data.Columbia.RWInstances
-import Data.Columbia.Integral
-import Data.Columbia.Headers
-import Data.Columbia.DualLock
-import Data.Columbia.SeekableStream
-import Data.Columbia.SeekableWriter
-import Data.Columbia.Mapper
+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)
@@ -42,7 +42,7 @@ 				return 0
 			else throwError ex)-}
 
-setBitAt :: (Monad m) => SeekableWriter m Word8 -> Word32 -> m()
+setBitAt :: (Monad m) => SeekableWriter m Word8 -> Pointer -> m()
 setBitAt writer n = runReaderT(do
 	let (dv, md) = divMod n 8
 	seekWriter dv
@@ -51,16 +51,16 @@ 	let m' = setBit m(fromIntegral md)
 	putToken m')
 	writer
-getBitAt :: (Monad m) => SeekableWriter m Word8 -> Word32 -> m(Maybe Bool)
+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 -> Word32 -> m Bool
+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 -> Word32 -> ReaderT(SeekableStream m Word8) m ()
+_mark :: (Monad m) => SeekableWriter m Word8 -> Pointer -> ReaderT(SeekableStream m Word8) m ()
 _mark tmpwriter addr = do
 	bool <- lift$getBitAt' tmpwriter addr
 	unless bool$do
@@ -75,14 +75,12 @@ 		addrs <- sequence(replicate nFields readIntegral)
 		mapM_(_mark tmpwriter) addrs
 
-mark :: FilePath -> SeekableStream IO Word8 -> IO(FilePath,SeekableWriter IO Word8,IORef(Word32,Word32),Table)
+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
-	ref <- newIORef$!(0,0)
-	table <- newTable tmppath
-	let tmpwriter = makeIoWriter ref table undefined
+	(tmpwriter,tmpconclude,tmpref) <- makeIoWriter' tmppath undefined False
 	-- Mark root node.
 	mapM_(setBitAt tmpwriter) [0..3]
 	runReaderT(do
@@ -91,7 +89,7 @@ 		-- ...and proceed to recurse on the structure of the data.
 		_mark tmpwriter addr)
 		stream
-	return$!(tmppath,tmpwriter,ref,table)
+	return$!(tmpwriter,tmpconclude,tmpref,tmppath)
 
 {-# INLINE forLoop #-}
 forLoop :: (MonadIO m) => IORef Word32 -> (Word32 -> m Bool) -> m Word32
@@ -131,16 +129,14 @@ 		m
 
 -- Run-length compression of the bit field defined in the mark.tmp file.
-compress :: SeekableWriter IO Word8 -> IO((FilePath,SeekableWriter IO Word8),Word32)	
+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
-	ref <- newIORef$!(0,0)
-	table <- newTable tmppath2
-	let tmpwriter2 = makeIoWriter ref table undefined
+	(tmpwriter2,tmpconclude2,_) <- makeIoWriter' tmppath2 undefined False
 	m <- runReaderT(do
 		-- Save writer position; determine file size.
 		lift$_seekAtEnd$stream tmpwriter
@@ -168,7 +164,7 @@ 		return m)
 		tmpwriter2
 
-	return$!((tmppath2,tmpwriter2),m)
+	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()
@@ -182,8 +178,8 @@ 	[fromStart..fromEnd-1])
 	writer
 
-sweep :: SeekableWriter IO Word8 -> IORef(Word32,Word32) -> Table -> SeekableStream IO Word8 -> IO()
-sweep writer newref newtable@(Table newpath _) tmpstream2 = do
+sweep :: FilePath -> SeekableWriter IO Word8 -> IORef(Pointer,Pointer) -> SeekableStream IO Word8 -> IO()
+sweep newpath writer ref tmpstream2 = do
 	newSize <- newIORef 0
 	runReaderT(do
 		seekAtEnd
@@ -197,12 +193,12 @@ 			sz <- readIntegral
 			lift$copyRange writer sz st end
 			lift$writeIORef newSize$!sz+end-st)
-			)
-		tmpstream2
+		)
+		tmpstream2	
 	-- Once the file is all sweeped have to find the end of the file
-	-- and truncate it. (The actual truncation is postponed until the end.)
+	-- and truncate it.
 	n <- readIORef newSize
-	writeIORef newref$!(0,n)
+	writeIORef ref$!(0,n)
 
 _fixUpPointers :: (Monad m) => Word32 -> Word32 -> Word32 -> ReaderT(SeekableStream m Word8) m Word32
 _fixUpPointers start end addr2 = do
@@ -288,88 +284,117 @@ 	_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. These are currently the only
---   safe patterns for using addresses with the collector:
---
---   * Multi-thread GC with use of addresses protected by locks.
---
---   * Single-thread GC with use of addresses unprotected by locks /solely in the GC thread/
---     and protected use of addresses in other threads.
---
---  Also note that appropriate locks are applied automatically when you use the wrappers in
---  Data.Columbia.Utils, but must be applied manually in the same manner when not using those
---  patterns.
-markAndSweepGc :: FilePath -> [IORef Word32] -> IO()
+--   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)
-	(newhandle,(tmppath,tmpwriter,_,_),((tmppath2,tmpwriter2),newFileSize),len,ref,table,writer) <- catch
-		(do
-		putStrLn"Mark phase"
-		newhandle <- openBinaryFile newpath ReadWriteMode
-		hClose newhandle
-		table <- newTable newpath
-		sz <- fileSizeShim table
-		ref <- newIORef$!(0,sz)
-		let writer = makeIoWriter ref table undefined
-		tmp@(tmppath,tmpwriter,tmpref,tmptable) <- mark newpath(stream writer)
-		mapM_(\ref -> readIORef ref>>=(`runReaderT` stream writer)._mark tmpwriter) moreAddresses
-		putStrLn"Compress phase"
-		tmp2@((tmppath2,tmpwriter2),_) <- compress tmpwriter
-		unmapAll tmptable
-		bracket
-			(openFile tmppath ReadWriteMode)
-			hClose
-			(`hSetFileSize` 0)
-		writeIORef tmpref$!(0,0)
-		tmptable <- newTable tmppath
-		let tmpwriter = makeIoWriter tmpref tmptable undefined
-		putStrLn"Fixup phase"
-		len <- fixUpPointers writer tmpwriter(stream tmpwriter2) moreAddresses
-		putStrLn"Sweep phase"
-		sweep writer ref table(stream tmpwriter2)
-		return$!(newhandle, tmp, tmp2, len, ref, table, writer))
+
+	-- 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
-		(do
-		-- Reconcile the differential segment (the part that got written while the
-		-- lion's share of the GC [in terms of time] was going on).
-		putStrLn"Reconcile phase"
-		oldtable <- newTable path
-		oldsz <- fileSizeShim oldtable
-		oldref <- newIORef$!(0,oldsz)
-		let oldstream = makeIoStream oldref oldtable undefined
-		n <- runReaderT
-			(do
-			n <- lift$runReaderT(seekWriterAtEnd>>getWriterPosition) writer
-			seek newFileSize
-			untilEOF'
-				(lift$_consumeToken oldstream>>=maybe(return()) (_putToken writer))
-			return n)
-			oldstream
-		putStrLn$"newFileSize: "++show newFileSize++"; n: "++show n
-		runReaderT(_fixUpPointers5 tmpwriter(stream tmpwriter2) len n) writer
-		-- Don't forget the root block pointer in case it changed.
-		addr :: Word32 <- runReaderT(seek 0>>readIntegral) oldstream
-		runReaderT(do
-			seekWriter 0
-			writeIntegral addr
-			_fixUpPointers2(stream tmpwriter2) len 0) writer
-		unmapAll oldtable
-		concludeFileWrite ref table
-		-- Atomically swap the newly swept file in place of the old one.
-		renameFile newpath path)
-		(unlock l2)+		(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.

@@ -1,124 +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.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.RWInstances
-import Data.Columbia.Integral
-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
-

@@ -1,51 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-
-module Data.Columbia.Integral 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.SeekableStream
-import Data.Columbia.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

@@ -0,0 +1,19 @@+{-# 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

@@ -0,0 +1,58 @@+{-# 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

@@ -0,0 +1,134 @@+{-# 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

@@ -0,0 +1,52 @@+{-# 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

@@ -0,0 +1,136 @@+{-# 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

@@ -0,0 +1,135 @@+{-# 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)

@@ -0,0 +1,127 @@+{-# 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)

@@ -0,0 +1,175 @@+{-# 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

@@ -0,0 +1,132 @@+{-# 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)
+

@@ -1,132 +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.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 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
-
-type Pointer = Word32
-
-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))
-
-mapBlock :: Table -> Pointer -> IO (Ptr a)
-mapBlock table@(Table path(mp,handle)) ptr = 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' <- _unmapAll False handle mp
-		mp' <-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
-		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

@@ -1,75 +0,0 @@-{-# LANGUAGE Trustworthy, ScopedTypeVariables #-}
-
--- | Read and write data in little-endian format.
-module Data.Columbia.MyEndianness (bigEndian, swapEndian') where
-
-import System.IO.Unsafe
-import Foreign.Marshal.Alloc
-import qualified Foreign.Storable as S
-import Data.Endian
-import Control.Exception
-import Foreign.Ptr
-import Data.Bits
-import Data.Word
-import Data.Int
-
-----------------------------------------------
--- Endianness
-
--- | Determine whether running on a big-endian system.
-bigEndian :: IO Bool
-bigEndian = do
-	p <- malloc
-	finally
-		(do
-		S.poke p (bit 24 :: Word32)
-		n :: Word8 <- S.peek (castPtr p)
-		return (n == 1))
-		(free p)
-
-{-# NOINLINE _bigEndian #-}
-_bigEndian :: Bool
-_bigEndian = unsafePerformIO bigEndian
-
-instance (EndianSensitive t, EndianSensitive u, EndianSensitive v, EndianSensitive w) => EndianSensitive (t, u, v, w) where
-	swapEndian (a, b, c, d) = (swapEndian a, swapEndian b, swapEndian c, swapEndian d)
-
-instance EndianSensitive Int8 where
-	swapEndian = id
-
-instance EndianSensitive Word8 where
-	swapEndian = id
-
-byteSwapped x = unsafePerformIO $ do
-	p <- malloc
-	finally
-		(do
-		S.poke p x
-		b1 :: Word8 <- S.peekByteOff p 0
-		b2 :: Word8 <- S.peekByteOff p 1
-		b3 :: Word8 <- S.peekByteOff p 2
-		b4 :: Word8 <- S.peekByteOff p 3
-		S.pokeByteOff p 3 b1
-		S.pokeByteOff p 2 b2
-		S.pokeByteOff p 1 b3
-		S.pokeByteOff p 0 b4
-		S.peek p)
-		(free p)
-
-instance EndianSensitive Float where
-	swapEndian = byteSwapped
-
-instance EndianSensitive Char where
-	swapEndian = byteSwapped
-
-instance (EndianSensitive t, EndianSensitive u) => EndianSensitive (t, u) where
-	swapEndian (x, y) = (swapEndian x, swapEndian y)
-
-instance (EndianSensitive t, EndianSensitive u) => EndianSensitive (Either t u) where
-	swapEndian = either (Left . swapEndian) (Right . swapEndian)
-
-instance EndianSensitive () where
-	swapEndian () = ()
-
-swapEndian' :: (EndianSensitive e) => e->e
-swapEndian' = if _bigEndian then swapEndian else id

@@ -1,100 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, StandaloneDeriving, DeriveDataTypeable, ImpredicativeTypes, Trustworthy #-}
-
-module Data.Columbia.Orphans (LazyFix(LazyFix)) where
-
-import Data.Typeable
-import Generics.Pointless.Functors
-import Data.Generics.SYB.WithClass.Basics
-import Data.Columbia.RWInstances
-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
-
-constConstr = Constr(AlgConstr 1) "ConsF" [] Prefix idDataType
-constDataType = DataType "Generics.Pointless.Functors" (AlgRep[constConstr])
-instance (Sat(ctx(Const t x)), Data ctx t, Typeable 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
-
-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, Typeable 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"Data: unrecognized constructor index"
-
-prodConstr = Constr(AlgConstr 1) "ProdF" [] Prefix prodDataType
-prodDataType = DataType "Generics.Pointless.Functors" (AlgRep[prodConstr])
-instance (Sat(ctx((:*:) g h x)), Typeable1 g, Typeable1 h, Typeable 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
-
-instance (Sat(ctx((:@:) g h x)), Typeable1 g, Typeable1 h, Typeable x, Data ctx(g(h x))) => Data ctx((:@:) g h x) where
-	gfoldl _ o f (CompF x) = f CompF `o` x
-
-fixConstr = Constr(AlgConstr 1) "Inn" [] Prefix fixDataType
-fixDataType = DataType "Generics.Pointless.Functors" (AlgRep[fixConstr])
-instance (Sat(ctx(Fix f)), Typeable1 f, Data ctx(Rep f(Fix f))) => Data ctx(Fix f) where
-	gfoldl _ o f (Inn x) = f Inn `o` x
-	gunfold _ k f _ = k(f Inn)
-	dataTypeOf _ _ = fixDataType
-	toConstr _ _ = fixConstr
-
-instance (Typeable1 f) => RW(Fix f)
-
-deriving instance (Eq(Rep f(Fix f))) => Eq(Fix f)
-
-deriving instance (Ord(Rep f(Fix f))) => Ord(Fix f)
-
-data LazyFix f = LazyFix(Rep f(LazyFix 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 (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

@@ -1,138 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, FlexibleContexts, Trustworthy #-}
-
-module Data.Columbia.RWInstances (module Data.Generics.SYB.WithClass.Instances, module Data.Columbia.SeekableStream, module Data.Columbia.SeekableWriter, 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 Data.Map (Map)
-import Data.Set (Set)
-import qualified Data.Array.Unboxed as UA
-import Data.Char
-import Data.Tree
-import Data.Typeable hiding (Proxy)
-import Data.Columbia.Integral
-import Data.Columbia.Coercion
-import Data.Columbia.SeekableStream
-import Data.Columbia.SeekableWriter
-import Control.Monad
-import Control.Monad.Reader
-
--- | 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
-
-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, Typeable u) => RW(Map t u)
-instance (Typeable t) => RW(Set t)
-instance (Typeable t) => RW(Tree t)
-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)

@@ -1,177 +0,0 @@-{-# LANGUAGE DeriveFunctor, Rank2Types, NoMonomorphismRestriction, Trustworthy #-}
-
-module Data.Columbia.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.Mapper
-import Data.Columbia.MyEndianness
-
-data SeekableStream m c = SeekableStream
-	{ __consumeToken :: !(m(Maybe c)), __consumeIntegralToken :: !(m(Maybe Word32)), __seek :: !(Word32 -> m()), __getPosition :: !(m Word32), __seekAtEnd :: !(m()), __isLockLive :: !(m Bool) } deriving Functor
-
-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 -> SeekableStream IO Word8
-makeIoStream ref table lock = SeekableStream
-	(readIORef ref>>= \(n,sz)->if n>=sz then
-			return mzero
-		else
-			mapBlock table n>>=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>>=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 -> SeekableStream IO Char
-makeIoStreamChar ref t = fmap(chr.fromIntegral).makeIoStream ref t
-
-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 Word32
-getPosition = ask>>=lift._getPosition
-
-{-# INLINE seek #-}
-seek :: (Monad m) => Word32 -> 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

@@ -1,125 +0,0 @@-{-# LANGUAGE Rank2Types, Trustworthy #-}
-
-module Data.Columbia.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.SeekableStream
-import Data.Columbia.MyEndianness
-import Data.Columbia.Mapper
-
-data SeekableWriter m c = SeekableWriter
-	{ _putToken :: !(c -> m()), _putIntegralToken :: !(Word32 -> m()), stream :: !(SeekableStream m c) }
-
-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 -> SeekableWriter IO Word8
-makeIoWriter ref table lock = SeekableWriter
-	(\x->readIORef ref>>= \(n,sz)->mapBlock table n>>=(`poke` x)>>(writeIORef ref$!(succ n,max(succ n) sz)))
-	{- TODO: not complete yet
-	(\x->readIORef ref>>= \(n,sz)->mapBlock table n>>=(`poke` swapEndian' x)>>(writeIORef ref$!(n+4,max(n+4) sz)))-}
-	(\_->fail"makeIoWriter: unimplemented")
-	(makeIoStream ref table lock)
-
-makeIoWriterChar :: IORef(Pointer,Pointer) -> Table -> FileLock -> SeekableWriter IO Char
-makeIoWriterChar ref t = invmap(chr.fromIntegral) (fromIntegral.ord).makeIoWriter ref t
-
-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) => Word32 -> 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)
-
-type PolyTraversalW ctx m d = Proxy ctx
-	-> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m ())
-	-> d -> ReaderT(SeekableWriter m Word8) m ()
-
-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)
-
-concludeFileWrite ref table@(Table path _) = do
-	(_,sz) <- readIORef ref
-	unmapAll table
-	bracket
-		(openBinaryFile path ReadWriteMode)
-		hClose
-		(`hSetFileSize` toInteger sz)

@@ -0,0 +1,45 @@+
+{- | 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

@@ -0,0 +1,101 @@+{-# 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

@@ -17,10 +17,8 @@ --   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; in other words it is predicated on all data being immutable
---   except the root block address. In order to do that, you will have to use your own
---   locking scheme to make that work.
-module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper, nFields) where
+--   the end of the file.
+module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper) where
 
 import Data.Word
 import Data.IORef
@@ -32,11 +30,13 @@ import Control.Monad.IO.Class
 import Data.Generics.SYB.WithClass.Basics
 import Data.Generics.SYB.WithClass.Context
-import Data.Columbia.Headers
-import Data.Columbia.Integral
-import Data.Columbia.CompoundData
-import Data.Columbia.DualLock
-import Data.Columbia.Mapper
+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
@@ -55,10 +55,14 @@ seekToStart = seek 0
 
 rwProxy :: Proxy(PairCtx RWCtx NoCtx)
-rwProxy = undefined
+rwProxy = error"proxy"
 
--- | Opens a file for reading, under appropriate locks; seeks to the beginning of the data;
---   runs the procedure. For common use, set m := IO.
+{-# 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
@@ -69,21 +73,17 @@ 	(liftIO.unlockShared)
 	$ \l@(DualLockShared _ _ l2) ->
 	bracket
-	(liftIO$newTable path)
-	(liftIO.concludeFileWrite cursor)
-	$ \table ->
+	(liftIO$makeIoWriter' path l2 True)
+	(liftIO.snd3) -- Call delegate.
+	$ \(writer,_,_) ->
 	do
-	liftIO$do
-		sz <-fileSizeShim table
-		writeIORef cursor$!(0,sz)
-	let stream = hoistStream liftIO$makeIoStream cursor table l2
+	let s = stream$hoistWriter liftIO writer
 	-- Unlock the writer lock once having retrieved the root block address.
-	withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart stream
-	runReaderT proc stream
+	withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart s
+	runReaderT proc s
 
--- | Opens a file for /writing/, under appropriate locks; seeks to the beginning of the data;
---   runs the procedure; accepts from the procedure an address to write as the new
---   root node address.
+-- | 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
@@ -96,20 +96,17 @@ 	withFileLock'(path++".lock.writer") Exclusive
 	$ \l ->
 	bracket
-	(liftIO$newTable path)
-	(liftIO.concludeFileWrite cursor)
-	$ \table ->
-	let writer = hoistWriter liftIO$makeIoWriter cursor table l in
+	(liftIO$makeIoWriter' path l True)
+	(liftIO.snd3)
+	$ \(writer,_,_) ->
+	let writer' = hoistWriter liftIO writer in
 	runReaderT
 	(do
-		liftIO$do
-			sz <-fileSizeShim table
-			writeIORef cursor$!(0,sz)
 		sw <- ask
 		seekWriterAtEnd
 		len <- getWriterPosition
-		addr::Word32 <- if len==0 then do
-			writeIntegral(0 :: Word32)
+		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
@@ -127,14 +124,10 @@ 		x <- proc
 		-- Copy address into root block address field.
 		seekWriter len2
-		n::Word32 <- local' stream readIntegral
+		n::Pointer <- local' stream readIntegral
 		seekWriter 0
 		writeIntegral n
 		return x
 	)
-	writer
+	writer'
 
-nFields hdr@(_, _, nFields) = if isHeaderArraytype hdr then do
-		readIntegral
-	else
-		return nFields

@@ -1,33 +1,24 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, DeriveDataTypeable, ScopedTypeVariables, Trustworthy #-}
 
-module Data.Columbia.WithAddress (WithAddress, addressOf, dataOf, withAddresses, writeBackAddresses) where
+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.Copointed
-import Data.Pointed
+import Data.Generics.SYB.WithClass.Instances
 import Generics.Pointless.Functors hiding (Functor)
 import Control.Monad
 import Control.Monad.Reader
-import Data.Columbia.CompoundData
-import Data.Columbia.CycleDetection
+import Data.Columbia.Types
+import Data.Columbia.Internal.SeekableStream
+import Data.Columbia.Internal.IntegralTypes
 import Data.Columbia.FRecord
-import Data.Columbia.Integral
 
--- | 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 Word32 t
-	deriving (Eq, Ord, Show, Typeable)
-
-instance Copointed WithAddress where
-	{-# INLINE copoint #-}
-	copoint(WithAddress _ x) = x
+{-# INLINE copoint #-}
+copoint(WithAddress _ x) = x
 
-instance Pointed WithAddress where
-	{-# INLINE point #-}
-	point = WithAddress 0 -- Null address indicates that no address is known.
+{-# INLINE point #-}
+point = WithAddress 0 -- Null address indicates that no address is known.
 
 {-# INLINE addressOf #-}
 addressOf :: WithAddress t -> Word32
@@ -58,7 +49,7 @@ 
 -- | 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 (unless you do something heroic with your own locking pattern).
+--   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
@@ -71,8 +62,8 @@ 
 -- | 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. The term structure of
---   'WithAddress' constructor itself is never written to the file.
+--   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