diff --git a/Data/Pass.hs b/Data/Pass.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass.hs
@@ -0,0 +1,83 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Pass
+-- Copyright   :  (C) 2012 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable (GADTs, Rank2Types)
+--
+----------------------------------------------------------------------------
+module Data.Pass
+  (
+  -- * Evaluation
+    Eval(..), (@@)
+  , Naive(..), (@@@)
+
+  -- * Single pass calculations
+  , Pass(..)
+  , Passable(..)
+
+  -- ** Embedding single pass calculations
+  , Step(..)
+
+  -- * Multipass calculations
+  , Calc(..)
+  , Calculation(..)
+
+  -- * Input conditioning
+  , Prep(..)
+
+  -- * L-Estimators
+  , L(..)
+  , (@#)
+  , breakdown
+  , iqm -- interquantile mean
+  , idm -- interdecile mean
+
+  -- ** Quantile estimators
+  , Estimator(..)
+  , By(..)
+
+  -- ** Robust statistics based on L-estimators
+  , Robust(..)
+  , median
+  , tercile, t1, t2
+  , quartile, q1, q2, q3
+  , quintile, qu1, qu2, qu3, qu4
+  , percentile
+  , permille
+
+  -- ** Acceleration for non-robust L-estimators
+  , Accelerated(..)
+
+  -- * Implementation Details
+  , Thrist(..)
+  , thrist
+  , Trans(..)
+
+  -- ** Classes required for user-defined calculation types
+  , Call(..)
+  , Named(..)
+  , Accelerant(..)
+  ) where
+
+import Data.Pass.Calc
+import Data.Pass.Accelerant
+import Data.Pass.Accelerated
+import Data.Pass.Calculation
+import Data.Pass.Call
+import Data.Pass.Class
+import Data.Pass.Eval
+import Data.Pass.Eval.Naive
+import Data.Pass.Named
+import Data.Pass.Prep
+import Data.Pass.Thrist
+import Data.Pass.Trans
+import Data.Pass.Type
+import Data.Pass.Step
+import Data.Pass.L
+import Data.Pass.L.By
+import Data.Pass.L.Estimator
+import Data.Pass.Robust
diff --git a/Data/Pass/Accelerant.hs b/Data/Pass/Accelerant.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Accelerant.hs
@@ -0,0 +1,24 @@
+module Data.Pass.Accelerant
+  ( Accelerant(..)
+  ) where
+
+import Data.Pass.Type
+import Data.Pass.L
+import Data.Pass.Robust
+
+-- provide hooks to allow the user to accelerate non-robust L-estimators
+class Accelerant k where
+  meanPass :: Pass k Double Double
+  meanPass = robust LMean
+
+  totalPass :: Pass k Double Double
+  totalPass = robust LTotal
+
+  largestPass :: Pass k Double Double
+  largestPass = robust $ NthLargest 0
+
+  smallestPass :: Pass k Double Double
+  smallestPass = robust $ NthSmallest 0
+
+  midrangePass :: Pass k Double Double
+  midrangePass = largestPass - smallestPass
diff --git a/Data/Pass/Accelerated.hs b/Data/Pass/Accelerated.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Accelerated.hs
@@ -0,0 +1,53 @@
+module Data.Pass.Accelerated
+  ( Accelerated(..)
+  ) where
+
+import Data.Pass.Type
+import Data.Pass.Calc
+import Data.Pass.L
+import Data.Pass.Fun
+import Data.Pass.Thrist
+import Data.Pass.Robust
+import Data.Pass.Accelerant
+
+class Accelerated k where
+  mean :: k Double Double
+  total :: k Double Double
+  largest :: k Double Double
+  smallest :: k Double Double
+  midrange :: k Double Double
+
+instance Accelerated L where
+  mean = robust LMean
+  total = robust LTotal
+  largest = robust (NthLargest 0)
+  smallest = robust (NthSmallest 0)
+  midrange = robust ((-1) :* NthSmallest 0 :+ NthLargest 0)
+
+instance Accelerated k => Accelerated (Fun k) where
+  mean = Fun mean
+  total = Fun total
+  largest = Fun largest
+  smallest = Fun smallest
+  midrange = Fun midrange
+
+instance Accelerated k => Accelerated (Thrist k) where
+  mean = mean :- Nil
+  total = total :- Nil
+  largest = largest :- Nil
+  smallest = smallest :- Nil
+  midrange = midrange :- Nil
+
+instance Accelerant k => Accelerated (Calc k) where
+  mean  = meanPass :& Stop
+  total = totalPass :& Stop
+  largest = largestPass :& Stop
+  smallest = smallestPass :& Stop
+  midrange = midrangePass :& Stop
+
+instance Accelerant k => Accelerated (Pass k) where
+  mean = meanPass
+  total = totalPass
+  largest = largestPass
+  smallest = smallestPass
+  midrange = midrangePass
diff --git a/Data/Pass/Calc.hs b/Data/Pass/Calc.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Calc.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+module Data.Pass.Calc
+  ( Calc(..)
+  ) where
+
+import Control.Category
+import Control.Applicative
+import Prelude hiding (id,(.))
+import Data.Pass.Call
+import Data.Pass.Eval
+import Data.Pass.Eval.Naive
+import Data.Pass.L.By
+import Data.Pass.Prep
+import Data.Pass.Thrist
+import Data.Pass.Type
+import Data.Pass.Trans
+import Data.List (sortBy)
+import Data.Function (on)
+
+data Calc k a b where
+  Stop :: b -> Calc k a b
+  (:&) :: Pass k a b -> (b -> Calc k a c) -> Calc k a c
+  Rank :: Ord b => Thrist k a b -> ([Int] -> Calc k a c) -> Calc k a c
+
+infixl 1 :&
+
+instance By (Calc k) where
+  by (x :& f) r = by x r :& \b -> f b `by` r
+  by (Rank m f) r = Rank m $ \b -> f b `by` r
+  by x _ = x
+
+instance Functor (Calc k a) where
+  fmap f (Stop b) = Stop (f b)
+  fmap f (Rank m k) = Rank m (fmap f . k)
+  fmap f (fb :& kba) = fb :& fmap f . kba
+
+instance Applicative (Calc k a) where
+  pure = Stop
+  Stop f      <*> Stop a      = Stop (f a)
+  Stop f      <*> (fb :& kba) = fb :& fmap f . kba
+  Stop f      <*> Rank fb kba = Rank fb $ fmap f . kba
+  (fg :& kgf) <*> Rank fb kba = fg :& \g -> Rank fb $ \b -> kgf g <*> kba b
+  (fg :& kgf) <*> Stop a      = fg :& fmap ($a) . kgf
+  (fg :& kgf) <*> (fb :& kba) = liftA2 (,) fg fb :& \(g,b) -> kgf g <*> kba b
+  Rank fg kgf <*> (fb :& kba) = fb :& \b -> Rank fg $ \g -> kgf g <*> kba b
+  Rank fg kgf <*> Stop a      = Rank fg $ fmap ($a) . kgf
+  Rank fg kgf <*> Rank fb kba = Rank fg $ \g -> Rank fb $ \b -> kgf g <*> kba b
+  _ *> b = b
+  a <* _ = a
+
+instance Monad (Calc k a) where
+  return = Stop
+  Stop a      >>= f = f a
+  (fb :& kba) >>= f = fb :& (>>= f) . kba
+  Rank fb kba >>= f = Rank fb $ (>>= f) . kba
+  (>>) = (*>)
+
+instance Prep Calc where
+  prep _ (Stop b)   = Stop b
+  prep t (c :& k)   = prep t c :& prep t . k
+  prep t (Rank c k) = Rank (prep t c) (prep t . k)
+
+#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ < 704
+instance Show (Calc k a b) where
+  showsPrec _ _ = showString "<calc>"
+instance Eq (Calc k a b) where
+  _ == _ = False
+#endif
+#endif
+
+instance Num b => Num (Calc k a b) where
+  (+) = liftA2 (+)
+  (-) = liftA2 (-)
+  (*) = liftA2 (*)
+  abs = fmap abs
+  signum = fmap signum
+  fromInteger = pure . fromInteger
+
+instance Fractional b => Fractional (Calc k a b) where
+  (/) = liftA2 (/)
+  recip = fmap recip
+  fromRational = pure . fromRational
+
+instance Floating b => Floating (Calc k a b) where
+  pi = pure pi
+  exp = fmap exp
+  sqrt = fmap sqrt
+  log = fmap log
+  (**) = liftA2 (**)
+  logBase = liftA2 logBase
+  sin = fmap sin
+  tan = fmap tan
+  cos = fmap cos
+  asin = fmap asin
+  atan = fmap atan
+  acos = fmap acos
+  sinh = fmap sinh
+  tanh = fmap tanh
+  cosh = fmap cosh
+  asinh = fmap asinh
+  acosh = fmap acosh
+  atanh = fmap atanh
+
+instance Trans Calc where
+  trans t = trans t :& Stop
+
+instance Call k => Naive (Calc k) where
+  naive (Stop b) _ _    = b
+  naive (i :& k) n xs   = naive (k $ naive i n xs) n xs
+  naive (Rank m k) n xs = naive (k $ map fst $ sortBy (on compare (call m . snd)) $ zip [0..] xs) n xs
+
+instance Call k => Eval (Calc k) where
+  eval (Stop b) _ _    = b
+  eval (i :& k) n xs   = eval (k (eval i n xs)) n xs
+  eval (Rank m k) n xs = eval (k $ map fst $ sortBy (on compare $ call m . snd) $ zip [0..] xs) n xs
diff --git a/Data/Pass/Calculation.hs b/Data/Pass/Calculation.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Calculation.hs
@@ -0,0 +1,28 @@
+module Data.Pass.Calculation
+  ( Calculation(..)
+  ) where
+
+import Data.Binary
+import Data.Monoid
+import Data.Typeable
+import Data.Pass.Calc
+import Data.Pass.Class
+import Data.Pass.Eval
+import Data.Pass.Fun
+import Data.Pass.Thrist
+import Data.Pass.Type
+
+class Calculation t where
+  calc :: (Eval k, Typeable b, Binary b, Monoid b) => t k a b -> Calc k a b
+
+instance Calculation Fun where
+  calc = calc . pass
+
+instance Calculation Thrist where
+  calc = calc . pass
+
+instance Calculation Pass where
+  calc p = p :& Stop
+
+instance Calculation Calc where
+  calc = id
diff --git a/Data/Pass/Call.hs b/Data/Pass/Call.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Call.hs
@@ -0,0 +1,8 @@
+module Data.Pass.Call
+  ( Call(..)
+  ) where
+
+import Data.Pass.Named
+
+class Named k => Call k where
+  call :: k a b -> a -> b
diff --git a/Data/Pass/Class.hs b/Data/Pass/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Class.hs
@@ -0,0 +1,24 @@
+module Data.Pass.Class
+  ( Passable(..)
+  ) where
+
+import Data.Binary
+import Data.Monoid
+import Data.Typeable
+import Data.Pass.Type
+import Data.Pass.Eval
+import Data.Pass.Fun
+import Data.Pass.Thrist
+import Data.Pass.Trans
+
+class Passable t where
+  pass :: (Eval k, Typeable b, Binary b, Monoid b) => t k a b -> Pass k a b
+
+instance Passable Fun where
+  pass (Fun k) = trans k
+
+instance Passable Thrist where
+  pass = Pass id
+
+instance Passable Pass where
+  pass = id
diff --git a/Data/Pass/Env.hs b/Data/Pass/Env.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Env.hs
@@ -0,0 +1,53 @@
+module Data.Pass.Env
+  ( Env
+  , empty
+  , lookup
+  , insert
+  , cons
+  ) where
+
+import Control.Applicative hiding (empty)
+import Data.Binary
+import qualified Data.HashMap.Strict as HashMap
+import Data.HashMap.Strict (HashMap)
+import Data.Monoid (Monoid(..))
+import Data.Typeable
+import GHC.Prim (Any)
+import Prelude hiding (lookup)
+import Unsafe.Coerce
+import Data.Pass.Call
+import Data.Pass.Key
+import Data.Pass.Named
+import Data.Pass.Thrist
+
+newtype Id a = Id { getId :: a }
+
+instance Functor Id where
+  fmap f (Id a) = Id (f a)
+
+instance Applicative Id where
+  pure = Id
+  Id a <*> Id b = Id (a b)
+
+mapWithKey :: (k -> a -> b) -> HashMap k a -> HashMap k b
+mapWithKey f m = getId (HashMap.traverseWithKey (\k a -> Id (f k a)) m)
+
+newtype Env k a = Env (HashMap (Key k a) Any)
+
+data Fake = Any deriving Show
+
+instance Named k => Show (Env k a) where
+  showsPrec d (Env m) = showParen (d > 10) $
+    showString "Env " . showsPrec 10 (Any <$ m)
+
+empty :: Env k a
+empty = Env HashMap.empty
+
+lookup :: (Call k, Typeable b, Binary b, Monoid b) => Thrist k a b -> Env k a -> Maybe b
+lookup k (Env m) = unsafeCoerce <$> HashMap.lookup (Key k) m
+
+insert :: (Call k, Typeable b, Binary b, Monoid b) => Thrist k a b -> b -> Env k a -> Env k a
+insert k v (Env m) = Env $ HashMap.insert (Key k) (unsafeCoerce v) m
+
+cons :: Call k => a -> Env k a -> Env k a
+cons a (Env m) = Env $ mapWithKey (\(Key k) old -> unsafeCoerce $ call k a `mappend` unsafeCoerce old) m
diff --git a/Data/Pass/Eval.hs b/Data/Pass/Eval.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Eval.hs
@@ -0,0 +1,15 @@
+module Data.Pass.Eval
+  ( Eval(..)
+  , (@@)
+  ) where
+
+import Data.Foldable
+
+infixl 0 @@
+
+class Eval k where
+  -- | Run a calculation
+  eval :: k a b -> Int -> [a] -> b
+
+(@@) :: (Eval k, Foldable f) => k a b -> f a -> b
+k @@ as = eval k (length xs) xs where xs = toList as
diff --git a/Data/Pass/Eval/Naive.hs b/Data/Pass/Eval/Naive.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Eval/Naive.hs
@@ -0,0 +1,14 @@
+module Data.Pass.Eval.Naive
+  ( Naive(..)
+  , (@@@)
+  ) where
+
+import Data.Foldable
+
+infixl 0 @@@
+
+class Naive k where
+  naive :: k a b -> Int -> [a] -> b
+
+(@@@) :: (Naive k, Foldable f) => k a b -> f a -> b
+k @@@ as = naive k (length xs) xs where xs = toList as
diff --git a/Data/Pass/Fun.hs b/Data/Pass/Fun.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Fun.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+module Data.Pass.Fun
+  ( Fun(..)
+  ) where
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
+import Data.Hashable
+import Data.Typeable
+import Data.Pass.Named
+import Data.Pass.Call
+import Data.Pass.Trans
+import Data.Pass.L.By
+import Data.Pass.Eval
+import Data.Pass.Eval.Naive
+
+newtype Fun k a b = Fun { unFun :: k a b }
+
+instance Trans Fun where
+  trans = Fun
+
+instance Named k => Show (Fun k a b) where
+  showsPrec = showsFun
+
+instance Typeable2 k => Typeable2 (Fun k) where
+  typeOf2 (_ :: Fun k a b) = mkTyConApp funTyCon [typeOf2 (undefined :: k a b)]
+
+funTyCon :: TyCon
+#if MIN_VERSION_base(4,4,0)
+funTyCon = mkTyCon3 "pass" "Data.Pass.Fun" "Fun"
+#else
+funTyCon = mkTyCon "Data.Pass.Fun.Fun"
+#endif
+{-# NOINLINE funTyCon #-}
+
+instance Named k => Named (Fun k) where
+  showsFun d (Fun f) = showParen (d > 10) $ showString "Fun " . showsFun 10 f
+  hashFunWithSalt i (Fun k) = hashFunWithSalt i k
+  equalFun (Fun f) (Fun g) = equalFun f g
+  putFun (Fun f) = putFun f
+
+instance Call k => Call (Fun k) where
+  call (Fun k) = call k
+
+instance Named k => Eq (Fun k a b) where
+  (==) = equalFun
+
+instance Named k => Hashable (Fun k a b) where
+  hashWithSalt = hashFunWithSalt
+
+instance Naive k => Naive (Fun k) where
+  naive (Fun k) = naive k
+
+instance Eval k => Eval (Fun k) where
+  eval (Fun k) = eval k
+
+instance By k => By (Fun k) where
+  by (Fun k) r = Fun (by k r)
diff --git a/Data/Pass/Key.hs b/Data/Pass/Key.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Key.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE ScopedTypeVariables, GADTs #-}
+module Data.Pass.Key
+  ( Key(..)
+  ) where
+
+import Prelude hiding (lookup)
+import Data.Binary
+import Data.Typeable
+import Data.Hashable
+import Data.Monoid
+import Data.Pass.Thrist
+import Data.Pass.Named
+
+data Key k a where
+  Key :: (Typeable b, Binary b, Monoid b) => Thrist k a b -> Key k a
+
+instance Named k => Eq (Key k a) where
+  Key (x :: Thrist k a b) == Key (y :: Thrist k a c) = equalFun x y && typeOf (undefined :: b) == typeOf (undefined :: c)
+
+instance Named k => Hashable (Key k a) where
+  hashWithSalt s (Key (tkab :: Thrist k a b)) = s `hashFunWithSalt` tkab `hashWithSalt` typeOf (undefined :: b)
+
+instance Named k => Show (Key k a) where
+  showsPrec d (Key t) = showParen (d > 10) $ showString "Key " . showsFun 10 t
diff --git a/Data/Pass/L.hs b/Data/Pass/L.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/L.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE GADTs, DeriveDataTypeable, PatternGuards, Rank2Types, BangPatterns #-}
+
+module Data.Pass.L
+  ( L(..)
+  , getL
+  , callL
+  , ordL
+  , eqL
+  , selectM
+  , breakdown
+  , (@#)
+  ) where
+
+import Control.Monad (liftM, liftM2)
+import Data.Typeable
+import Data.Hashable
+import Data.Pass.Named
+import Data.IntMap (IntMap)
+import Data.Key (foldrWithKey)
+import Data.List (sort)
+import qualified Data.IntMap as IM
+import Data.Pass.L.Estimator
+import Data.Pass.Eval
+import Data.Pass.Eval.Naive
+import Data.Pass.L.By
+import Data.Pass.Util (clamp)
+import Data.Binary
+
+-- | An L-Estimator represents a linear combination of order statistics
+data L a b where
+  LTotal       :: (Num a, Ord a) => L a a
+  LMean        :: (Fractional a, Ord a) => L a a
+  LScale       :: (Fractional a, Ord a) => L a a
+  NthLargest   :: (Num a, Ord a) => Int -> L a a
+  NthSmallest  :: (Num a, Ord a) => Int -> L a a
+  QuantileBy   :: (Fractional a, Ord a) => Estimator -> Rational -> L a a
+  Winsorized   :: (Fractional b, Ord b) => Rational -> L a b -> L a b
+  Trimmed      :: (Fractional b, Ord b) => Rational -> L a b -> L a b
+  Jackknifed   :: (Fractional b, Ord b) => L a b -> L a b
+  (:*)         :: Fractional b => Rational -> L a b -> L a b
+  (:+)         :: Num b => L a b -> L a b -> L a b
+  deriving Typeable
+
+instance By L where
+  QuantileBy _ q `by` r = QuantileBy r q
+  Trimmed p f    `by` r = Trimmed p (by f r)
+  Winsorized p f `by` r = Winsorized p (by f r)
+  Jackknifed f   `by` r = Jackknifed (by f r)
+  (n :* f)       `by` r = n :* by f r
+  (f :+ g)       `by` r = by f r :+ by g r
+  f              `by` _ = f
+
+infixl 7 :*
+infixl 6 :+
+
+instance Named L where
+  showsFun _ LTotal           = showString "LTotal"
+  showsFun _ LMean            = showString "LMean"
+  showsFun _ LScale           = showString "LScale"
+  showsFun d (QuantileBy e q) = showParen (d > 10) $ showString "QuantileBy " . showsPrec 10 e . showChar ' ' . showsPrec 10 q
+  showsFun d (Winsorized p f) = showParen (d > 10) $ showString "Winsorized " . showsPrec 10 p . showChar ' ' . showsFun 10 f
+  showsFun d (Trimmed p f)    = showParen (d > 10) $ showString "Trimmed "    . showsPrec 10 p . showChar ' ' . showsFun 10 f
+  showsFun d (Jackknifed f)   = showParen (d > 10) $ showString "Jackknifed "                                 . showsFun 10 f
+  showsFun d (NthLargest n)   = showParen (d > 10) $ showString "NthLargest "  . showsPrec 10 n
+  showsFun d (NthSmallest n)  = showParen (d > 10) $ showString "NthSmallest " . showsPrec 10 n
+  showsFun d (x :* y)         = showParen (d > 7) $ showsPrec 8 x . showString " :* " . showsPrec 7 y
+  showsFun d (x :+ y)         = showParen (d > 6) $ showsPrec 7 x . showString " :+ " . showsPrec 6 y
+
+  hashFunWithSalt n LTotal           = 0 `hashWithSalt` n
+  hashFunWithSalt n LMean            = 1 `hashWithSalt` n
+  hashFunWithSalt n LScale           = 2 `hashWithSalt` n
+  hashFunWithSalt n (QuantileBy e q) = 4 `hashWithSalt` n  `hashWithSalt` e `hashWithSalt` q
+  hashFunWithSalt n (Winsorized p f) = 5 `hashWithSalt` n  `hashWithSalt` p `hashFunWithSalt` f
+  hashFunWithSalt n (Trimmed p f)    = 6 `hashWithSalt` n  `hashWithSalt` p `hashFunWithSalt` f
+  hashFunWithSalt n (Jackknifed f)   = 7 `hashWithSalt` n                  `hashFunWithSalt` f
+  hashFunWithSalt n (NthLargest m)   = 8 `hashWithSalt` n  `hashWithSalt` m
+  hashFunWithSalt n (NthSmallest m)  = 9 `hashWithSalt` n  `hashWithSalt` m
+  hashFunWithSalt n (x :* y)         = 10 `hashWithSalt` n `hashWithSalt` x `hashFunWithSalt` y
+  hashFunWithSalt n (x :+ y)         = 11 `hashWithSalt` n `hashFunWithSalt` x `hashFunWithSalt` y
+
+  equalFun LTotal LTotal = True
+  equalFun LMean  LMean  = True
+  equalFun LScale LScale = True
+  equalFun (QuantileBy e p) (QuantileBy f q) = e == f && p == q
+  equalFun (Winsorized p f) (Winsorized q g) = p == q && equalFun f g
+  equalFun (Trimmed p f) (Trimmed q g)       = p == q && equalFun f g
+  equalFun (Jackknifed f) (Jackknifed g)     = equalFun f g
+  equalFun (NthLargest n)  (NthLargest m)    = n == m
+  equalFun (NthSmallest n) (NthSmallest m)   = n == m
+  equalFun (a :+ b) (c :+ d)                 = equalFun a c && equalFun b d
+  equalFun (a :* b) (c :* d)                 = typeOf a == typeOf c && cast a == Just c && equalFun b d
+  equalFun _ _ = False
+
+  putFun LTotal           = put (0 :: Word8)
+  putFun LMean            = put (1 :: Word8)
+  putFun LScale           = put (2 :: Word8)
+  putFun (QuantileBy e r) = put (4 :: Word8) >> put e >> put r
+  putFun (Winsorized p f) = put (5 :: Word8) >> put p >> putFun f
+  putFun (Trimmed p f)    = put (6 :: Word8) >> put p >> putFun f
+  putFun (Jackknifed f)   = put (7 :: Word8) >> putFun f
+  putFun (NthLargest n)   = put (8 :: Word8) >> put n
+  putFun (NthSmallest n)  = put (9 :: Word8) >> put n
+  putFun (x :* y)         = put (10 :: Word8) >> put x >> putFun y
+  putFun (x :+ y)         = put (11 :: Word8) >> putFun x >> putFun y
+
+getL :: (Fractional a, Ord a) => Get (L a a)
+getL = do
+  i <- get :: Get Word8
+  case i of
+    0 -> return LTotal
+    1 -> return LMean
+    2 -> return LScale
+    4 -> liftM2 QuantileBy get get
+    5 -> liftM2 Winsorized get getL
+    6 -> liftM2 Trimmed get getL
+    7 -> liftM Jackknifed getL
+    8 -> liftM NthLargest get
+    9 -> liftM NthSmallest get
+    10 -> liftM2 (:*) get getL
+    11 -> liftM2 (:+) getL getL
+    _  -> error "getL: Unknown L-estimator"
+
+instance Show (L a b) where
+  showsPrec = showsFun
+
+instance Hashable (L a b) where
+  hashWithSalt = hashFunWithSalt
+
+instance Eq (L a b) where
+  (==) = equalFun
+
+-- | A common measure of how robust an L estimator is in the presence of outliers.
+breakdown :: (Num b, Eq b) => L a b -> Int
+breakdown f
+  | IM.null m = 50
+  | otherwise = fst (IM.findMin m) `min` (100 - fst (IM.findMax m))
+  where m = IM.filter (/= 0) $ callL f 101
+
+infixl 0 @#
+
+-- | @f \@# n@ Return a list of the coefficients that would be used by an L-Estimator for an input of length @n@
+(@#) :: Num a => L a a -> Int -> [a]
+f @# n = [ IM.findWithDefault 0 k fn | k <- [0..n-1] ]
+  where fn = callL f n
+
+callL :: L a b -> Int -> IntMap b
+callL LTotal n = IM.fromList [ (i,1) | i <- [0..n-1]]
+callL LMean n = IM.fromList [ (i, oon) | i <- [0..n-1]]
+  where oon = recip (fromIntegral n)
+callL LScale n = IM.fromList [ (i - 1, scale * (2 * fromIntegral i - 1 - r)) | i <- [1..n]]
+  where r = fromIntegral n
+        scale = 1 / (r *(r-1))
+callL (QuantileBy f p) n = case estimateBy f p n of
+  Estimate h qp -> case properFraction h of
+    (w, 0) -> IM.singleton (clamp n (w - 1)) 1
+    _      -> qp
+callL (Winsorized p g) n = case properFraction (fromIntegral n * p) of
+  (w, 0) -> IM.fromAscListWith (+) [ (w `max` min (n - 1 - w) k, v) | (k,v) <- IM.toAscList (callL g n) ]
+  (w, f) | w' <- w + 1 -> IM.fromListWith (+) $ do
+     (k,v) <- IM.toList (callL g n)
+     [ (w  `max` min (n - 1 - w ) k, v * fromRational (1 - f)),
+       (w' `max` min (n - 1 - w') k, v * fromRational f)]
+callL (Trimmed p g) n = case properFraction (fromIntegral n * p) of
+  (w, 0)               -> IM.fromDistinctAscList [ (k + w, v) | (k, v) <- IM.toAscList $ callL g (n - w*2)]
+  (w, f) | w' <- w + 1 -> IM.fromListWith (+) $ [ (k + w, fromRational (1 - f) * v) | (k,v) <- IM.toList $ callL g (n - w*2)] ++
+                                                [ (k + w', fromRational f  * v)     | (k,v) <- IM.toList $ callL g (n - w'*2)]
+callL (Jackknifed g) n = IM.fromAscListWith (+) $ do
+  let n' = fromIntegral n
+  (k, v) <- IM.toAscList $ callL g (n - 1)
+  let k' = fromIntegral k + 1
+  [(k, (n' - k') * v / n'), (k + 1, k' * v / n')]
+callL (NthLargest m) n  = IM.singleton (clamp n (n - m - 1)) 1
+callL (NthSmallest m) n = IM.singleton (clamp n m) 1
+callL (x :+ y) n = IM.unionWith (+) (callL x n) (callL y n)
+callL (s :* y) n = fmap (r *) (callL y n) where r = fromRational s
+
+instance Naive L where
+  naive m n xs = ordL m $ foldrWithKey step 0 $ sort $ eqL m xs where
+    coefs = callL m n
+    step = ordL m $ \g v x -> IM.findWithDefault 0 g coefs * v + x
+
+instance Eval L where
+  -- eval m n xs = ordL m $ callL m n `selectM` eqL m xs
+  eval = naive -- faster for now
+
+-- perform a hedged quickselect using the keys for the sparse
+selectM :: (Num a, Ord a) => IntMap a -> [a] -> a
+selectM = go 0 where
+  go !_ !_ [] = 0
+  go !b !m (x:xs) = i + j + k
+    where (lo,n, hi) = partitionAndCount (<x) xs
+          (lm,mm,hm) = IM.splitLookup (b+n) m
+          i = if IM.null lm then 0 else go b lm lo
+          j = maybe 0 (x*) mm
+          k = if IM.null hm then 0 else go (b+n+1) hm hi
+
+-- NB: unstable, reverses the sub-lists each time
+partitionAndCount :: (a -> Bool) -> [a] -> ([a],Int,[a])
+partitionAndCount f = go [] 0 [] where
+  go !ts !n !fs [] = (ts,n,fs)
+  go !ts !n !fs (x:xs)
+   | f x = go (x:ts) (n + 1) fs xs
+   | otherwise = go ts n (x:fs) xs
+
+eqL :: L a b -> p a -> p b
+eqL LTotal a = a
+eqL LMean a = a
+eqL LScale a = a
+eqL (NthLargest _) a = a
+eqL (NthSmallest _) a = a
+eqL (QuantileBy _ _) a = a
+eqL (Winsorized _ x) a = eqL x a
+eqL (Jackknifed x) a = eqL x a
+eqL (Trimmed _ x) a = eqL x a
+eqL (x :+ _) a = eqL x a
+eqL (_ :* x) a = eqL x a
+
+ordL :: L a b -> ((Ord b, Num b) => r) -> r
+ordL LTotal a = a
+ordL LMean a = a
+ordL LScale a = a
+ordL (NthLargest _) a = a
+ordL (NthSmallest _) a = a
+ordL (QuantileBy _ _) a = a
+ordL (Winsorized _ x) a = ordL x a
+ordL (Trimmed _ x) a = ordL x a
+ordL (Jackknifed x) a = ordL x a
+ordL (x :+ _) a = ordL x a
+ordL (_ :* x) a = ordL x a
diff --git a/Data/Pass/L/By.hs b/Data/Pass/L/By.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/L/By.hs
@@ -0,0 +1,7 @@
+module Data.Pass.L.By
+  (By(..)) where
+
+import Data.Pass.L.Estimator
+
+class By k where
+  by :: k a b -> Estimator -> k a b
diff --git a/Data/Pass/L/Estimator.hs b/Data/Pass/L/Estimator.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/L/Estimator.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}
+module Data.Pass.L.Estimator
+  ( Estimator(..)
+  , Estimate(..)
+  , estimateBy
+  ) where
+
+import Data.Ratio
+import Data.Binary
+import Data.Data
+import qualified Data.IntMap as IM
+import Data.IntMap (IntMap)
+import Data.Pass.Util (clamp)
+import Data.Hashable
+import Data.Pass.Util.Beta (Beta(Beta))
+import qualified Data.Pass.Util.Beta as Beta
+
+-- | Techniques used to smooth the nearest values when calculating quantile functions. R2 is used by default, and the numbering convention follows the 
+-- use in the R programming language, as far as it goes.
+data Estimator
+  = R1  -- ^ Inverse of the empirical distribution function
+  | R2  -- ^ .. with averaging at discontinuities (default)
+  | R3  -- ^ The observation numbered closest to Np. NB: does not yield a proper median
+  | R4  -- ^ Linear interpolation of the empirical distribution function. NB: does not yield a proper median.
+  | R5  -- ^ .. with knots midway through the steps as used in hydrology. This is the simplest continuous estimator that yields a correct median
+  | R6  -- ^ Linear interpolation of the expectations of the order statistics for the uniform distribution on [0,1]
+  | R7  -- ^ Linear interpolation of the modes for the order statistics for the uniform distribution on [0,1]
+  | R8  -- ^ Linear interpolation of the approximate medans for order statistics.
+  | R9  -- ^ The resulting quantile estimates are approximately unbiased for the expected order statistics if x is normally distributed.
+  | R10 -- ^ When rounding h, this yields the order statistic with the least expected square deviation relative to p.
+  | HD  -- ^ The Harrell-Davis quantile estimator based on bootstrapped order statistics
+  deriving (Eq,Ord,Enum,Bounded,Data,Typeable,Show,Read)
+
+instance Binary Estimator where
+  put e = put (fromIntegral (fromEnum e) :: Word8)
+  get = do
+    i <- get :: Get Word8
+    return $ toEnum (fromIntegral i)
+
+instance Hashable Estimator where
+  hashWithSalt n e = n `hashWithSalt` fromEnum e
+
+data Estimate r = Estimate {-# UNPACK #-} !Rational (IntMap r)
+  deriving Show
+
+continuousEstimator ::
+  Fractional r =>
+  (Rational -> (Rational, Rational)) ->
+  (Rational -> Rational -> Rational) ->
+  Rational -> Int -> Estimate r
+continuousEstimator bds f p n = Estimate h $
+  if p < lo then IM.singleton 0 1
+  else if p >= hi then IM.singleton (n - 1) 1
+  else case properFraction h of
+    (w,frac) | frac' <- fromRational frac -> IM.fromList [(w - 1, frac'), (w, 1 - frac')]
+  where
+    r = fromIntegral n
+    h = f p r
+    (lo, hi) = bds r
+
+estimateBy :: Fractional r => Estimator -> Rational -> Int -> Estimate r
+estimateBy HD = \q n -> Estimate (1%2) $ let
+    n' = fromIntegral n
+    np1 = n' + 1
+    q' = fromRational q
+    d = Beta (q'*np1) (np1*(1-q'))
+  in if q == 0 then IM.singleton 0 1
+  else if q == 1 then IM.singleton (n - 1) 1
+  else IM.fromListWith (+)
+    [ (i, realToFrac $ Beta.cumulative d ((fromIntegral i + 1) / n') - Beta.cumulative d (fromIntegral i / n'))
+    | i <- [0 .. n-1]
+    ]
+estimateBy R1  = \p n -> let np = fromIntegral n * p in Estimate (np + 1%2) $ IM.singleton (clamp n (ceiling np - 1)) 1
+estimateBy R2  = \p n -> let np = fromIntegral n * p in Estimate (np + 1%2) $
+  if p == 0      then IM.singleton 0       1
+  else if p == 1 then IM.singleton (n - 1) 1
+  else IM.fromListWith (+) [(clamp n (ceiling np - 1), 0.5), (clamp n (floor np), 0.5)]
+estimateBy R3  = \p n -> let np = fromIntegral n * p in Estimate np $ IM.singleton (clamp n (round np - 1)) 1
+estimateBy R4  = continuousEstimator (\n -> (recip n, 1)) (*)
+estimateBy R5  = continuousEstimator (\n -> let tn = 2 * n in (recip tn, (tn - 1) / tn)) $ \p n -> p*n + 0.5
+estimateBy R6  = continuousEstimator (\n -> (recip (n + 1), n / (n + 1))) $ \p n -> p*(n+1)
+estimateBy R7  = continuousEstimator (\_ -> (0, 1)) $ \p n -> p*(n-1) + 1
+estimateBy R8  = continuousEstimator (\n -> (2/3 / (n + 1/3), (n - 1/3)/(n + 1/3))) $ \p n -> p*(n + 1/3) + 1/3
+estimateBy R9  = continuousEstimator (\n -> (0.625 / (n + 0.25), (n - 0.375)/(n + 0.25))) $ \p n -> p*(n + 0.25) + 0.375
+estimateBy R10 = continuousEstimator (\n -> (1.5 / (n + 2), (n + 0.5)/(n + 2))) $ \p n -> p*(n + 2) - 0.5
diff --git a/Data/Pass/Monoid/Ord.hs b/Data/Pass/Monoid/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Monoid/Ord.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Data.Pass.Monoid.Ord
+  ( Min(..), getMin
+  , Max(..), getMax
+  ) where
+
+import Control.Monad (liftM)
+import Data.Monoid
+import Data.Typeable
+import Data.Binary
+
+data Min a = Min a | NoMin deriving Typeable
+
+getMin :: Num a => Min a -> a
+getMin (Min a) = a
+getMin NoMin = 0
+
+instance Ord a => Monoid (Min a) where
+  mempty = NoMin
+  NoMin `mappend` y = y
+  x `mappend` NoMin = x
+  Min x `mappend` Min y = Min (min x y)
+
+instance Binary a => Binary (Min a) where
+  put NoMin = put (0 :: Word8)
+  put (Min a) = put (1 :: Word8) >> put a
+  get = do
+    i <- get :: Get Word8
+    case i of
+      0 -> return NoMin
+      1 -> liftM Min get
+      _ -> error "get: unknown constructor"
+
+getMax :: Num a => Max a -> a
+getMax (Max a) = a
+getMax NoMax = 0
+
+data Max a = Max a | NoMax deriving Typeable
+
+instance Binary a => Binary (Max a) where
+  put NoMax = put (0 :: Word8)
+  put (Max a) = put (1 :: Word8) >> put a
+  get = do
+    i <- get :: Get Word8
+    case i of
+      0 -> return NoMax
+      1 -> liftM Max get
+      _ -> error "get: unknown constructor"
+
+instance Ord a => Monoid (Max a) where
+  mempty = NoMax
+  NoMax `mappend` y = y
+  x `mappend` NoMax = x
+  Max x `mappend` Max y = Max (max x y)
diff --git a/Data/Pass/Named.hs b/Data/Pass/Named.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Named.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TypeFamilies #-}
+module Data.Pass.Named
+  ( Named(..)
+  ) where
+
+import Data.Binary
+import Data.Binary.Put
+import Data.Typeable
+import Data.Hashable
+
+infixl 0 `hashFunWithSalt`
+
+class Typeable2 k => Named k where
+  showsFun :: Int -> k a b -> String -> String
+
+  putFun :: k a b -> Put
+  putFun xs = put $ showsFun 0 xs ""
+
+  hashFunWithSalt :: Int -> k a b -> Int
+  hashFunWithSalt n xs = n `hashWithSalt` runPut (putFun xs)
+
+  equalFun :: k a b -> k c d -> Bool
+  equalFun xs ys = runPut (putFun xs) == runPut (putFun ys)
diff --git a/Data/Pass/Prep.hs b/Data/Pass/Prep.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Prep.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE GADTs #-}
+module Data.Pass.Prep
+  ( Prep(..)
+  ) where
+
+import Data.Pass.Thrist
+
+infixr 5 `prep`
+
+class Prep t where
+  prep :: k a b -> t k b c -> t k a c
+
+instance Prep Thrist where
+  prep x Nil       = x :- Nil
+  prep x (y :- ys) = y :- prep x ys
diff --git a/Data/Pass/Robust.hs b/Data/Pass/Robust.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Robust.hs
@@ -0,0 +1,114 @@
+module Data.Pass.Robust
+  ( Robust(..)
+  , median
+  , iqm
+  , idm
+  , tercile, t1, t2
+  , quartile, q1, q2, q3
+  , quintile, qu1, qu2, qu3, qu4
+  , percentile
+  , permille
+  ) where
+
+import Data.Pass.Type
+import Data.Pass.Calc
+import Data.Pass.Fun
+import Data.Pass.Thrist
+import Data.Pass.L
+import Data.Pass.L.Estimator
+
+-- | embedding for L-estimators
+class Robust l where
+  robust :: L a b -> l a b
+
+  winsorized :: (Fractional b, Ord b) => Rational -> L a b -> l a b
+  winsorized p f = robust $ Winsorized p f
+
+  trimmed :: (Fractional b, Ord b) => Rational -> L a b -> l a b
+  trimmed p f = robust $ Trimmed p f
+
+  jackknifed :: (Fractional b, Ord b) => L a b -> l a b
+  jackknifed f = robust $ Jackknifed f
+
+  lscale :: (Fractional a, Ord a) => l a a
+  lscale = robust LScale
+
+  quantile :: (Fractional a, Ord a) => Rational -> l a a
+  quantile p = robust $ QuantileBy R2 p
+
+  midhinge :: (Fractional a, Ord a) => l a a
+  midhinge = robust $ 0.5 :* (q1 :+ q3)
+
+  -- | Tukey's trimean
+  trimean :: (Fractional a, Ord a) => l a a
+  trimean = robust $ 0.25 :* (q1 :+ 2 :* q2 :+ q3)
+
+  -- | interquartile range
+  iqr :: (Fractional a, Ord a) => l a a
+  iqr = robust $ ((-1) :* q1) :+ q3
+
+  idr :: (Fractional a, Ord a) => l a a
+  idr = robust $ ((-1) :* quantile 0.1) :+ quantile 0.9
+
+-- | interquartile mean
+iqm :: (Robust l, Fractional a, Ord a) => l a a
+iqm = trimmed 0.25 LMean
+
+idm :: (Robust l, Fractional a, Ord a) => l a a
+idm = trimmed 0.1 LMean
+
+median :: (Robust l, Fractional a, Ord a) => l a a
+median = quantile 0.5
+
+tercile :: (Robust l, Fractional a, Ord a) => Rational -> l a a
+tercile n = quantile (n/3)
+
+-- | terciles 1 and 2
+t1, t2 :: (Robust l, Fractional a, Ord a) => l a a
+t1 = tercile 1
+t2 = tercile 2
+
+quartile :: (Robust l, Fractional a, Ord a) => Rational -> l a a
+quartile n = quantile (n/4)
+
+-- | quantiles, with breakdown points 25%, 50%, and 25% respectively
+q1, q2, q3 :: (Robust l, Fractional a, Ord a) => l a a
+q1 = quantile 0.25
+q2 = median
+q3 = quantile 0.75
+
+quintile :: (Robust l, Fractional a, Ord a) => Rational -> l a a
+quintile n = quantile (n/5)
+
+-- | quintiles 1 through 4
+qu1, qu2, qu3, qu4 :: (Robust l, Fractional a, Ord a) => l a a
+qu1 = quintile 1
+qu2 = quintile 2
+qu3 = quintile 3
+qu4 = quintile 4
+
+percentile :: (Robust l, Fractional a, Ord a) => Rational -> l a a
+percentile n = quantile (n/100)
+
+permille :: (Robust l, Fractional a, Ord a) => Rational -> l a a
+permille n = quantile (n/1000)
+
+instance Robust L where
+  robust = id
+
+instance Robust l => Robust (Fun l) where
+  robust = Fun . robust
+
+newtype Flip f a b = Flip { flop :: f b a }
+
+instance Robust (Pass k) where
+  robust l = L id (flop (eqL l (Flip l))) (eqL l Nil)
+  midhinge = (q1 + q3) / 2
+  trimean  = (q1 + 2 * q2 + q3) / 4
+  iqr      = q3 - q1
+
+instance Robust (Calc k) where
+  robust l = robust l :& Stop
+  midhinge = midhinge :& Stop
+  trimean  = trimean :& Stop
+  iqr      = iqr :& Stop
diff --git a/Data/Pass/Step.hs b/Data/Pass/Step.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Step.hs
@@ -0,0 +1,16 @@
+module Data.Pass.Step
+  ( Step(..)
+  ) where
+
+import Data.Pass.Type
+import Data.Pass.Calc
+import Data.Pass.Prep
+
+class Prep t => Step t where
+  step :: Pass k a b -> t k a b
+
+instance Step Pass where
+  step = id
+
+instance Step Calc where
+  step k = k :& Stop
diff --git a/Data/Pass/Thrist.hs b/Data/Pass/Thrist.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Thrist.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE CPP, GADTs, Rank2Types, ScopedTypeVariables #-}
+module Data.Pass.Thrist
+  ( Thrist(..)
+  , thrist
+  , fromThrist
+  ) where
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
+import Control.Category
+import Data.Hashable
+import Data.Typeable
+import Data.Binary
+import Prelude hiding (id,(.))
+import Data.Pass.Call
+import Data.Pass.Named
+import Data.Pass.Trans
+import Data.Pass.L.By
+
+infixr 5 :-
+
+data Thrist k a b where
+  Nil :: Thrist k a a
+  (:-) :: k b c -> Thrist k a b -> Thrist k a c
+
+instance Named k => Show (Thrist k a b) where
+  showsPrec d xs = showsFun d xs
+
+instance Trans Thrist where
+  trans k = k :- Nil
+
+instance Category (Thrist k) where
+  id = Nil
+  Nil . x = x
+  (f :- xs) . ys = f :- (xs . ys)
+
+thrist :: k a b -> Thrist k a b
+thrist k = k :- Nil
+{-# INLINE thrist #-}
+
+instance Named k => Named (Thrist k) where
+  showsFun d (x :- xs) = showParen (d > 5) $ showsFun 6 x . showString " :- " . showsFun 5 xs
+  showsFun _ Nil = showString "Nil"
+
+  hashFunWithSalt k Nil = k
+  hashFunWithSalt k (f :- xs) = k `hashFunWithSalt` f `hashWithSalt` xs
+
+  equalFun Nil Nil = True
+  equalFun (a :- as) (b :- bs) = equalFun a b && equalFun as bs
+  equalFun _ _ = False
+
+  putFun Nil = put (0 :: Word8)
+  putFun (x :- xs) = do
+    put (1 :: Word8)
+    putFun x
+    putFun xs
+
+instance Call k => Call (Thrist k) where
+  call Nil = id
+  call (f :- xs) = call f . call xs
+
+instance By k => By (Thrist k) where
+  by Nil _ = Nil
+  by (x :- xs) r = by x r :- by xs r
+
+fromThrist :: forall k a b c. Call k => (forall d e. k d e -> c) -> Thrist k a b -> [c]
+fromThrist f = go where
+  go :: Thrist k f g -> [c]
+  go Nil = []
+  go (x :- xs) = f x : go xs
+{-# INLINE fromThrist #-}
+
+instance Named k => Eq (Thrist k a b) where
+  (==) = equalFun
+
+instance Named k => Hashable (Thrist k a b) where
+  hashWithSalt = hashFunWithSalt
+
+instance Typeable2 k => Typeable2 (Thrist k) where
+  typeOf2 (_ :: Thrist k a b) = mkTyConApp thristTyCon [typeOf2 (undefined :: k a b)]
+
+thristTyCon :: TyCon
+#if MIN_VERSION_base(4,4,0)
+thristTyCon = mkTyCon3 "pass" "Data.Pass.Thrist" "Thrist"
+#else
+thristTyCon = mkTyCon "Data.Pass.Thrist.Thrist"
+#endif
+{-# NOINLINE thristTyCon #-}
diff --git a/Data/Pass/Trans.hs b/Data/Pass/Trans.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Trans.hs
@@ -0,0 +1,11 @@
+module Data.Pass.Trans
+  ( Trans(..)
+  ) where
+
+import Data.Typeable
+import Data.Monoid
+import Data.Binary
+-- import Data.Pass.Eval
+
+class Trans t where
+  trans :: (Binary b, Monoid b, Typeable b) => k a b -> t k a b
diff --git a/Data/Pass/Type.hs b/Data/Pass/Type.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Type.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE CPP, GADTs, ScopedTypeVariables #-}
+module Data.Pass.Type
+  ( Pass(..)
+  , env
+  ) where
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
+import Control.Category
+import Control.Applicative hiding (empty)
+import Data.Binary
+import Data.Monoid
+import Data.Foldable
+import Data.Typeable
+import Data.List (sort)
+import Data.Key (foldrWithKey)
+import qualified Data.IntMap as IntMap
+import Prelude hiding (id,(.),foldr,lookup)
+
+import Data.Pass.Call
+import Data.Pass.Eval
+import Data.Pass.Eval.Naive
+import qualified Data.Pass.Env as Env
+import Data.Pass.Env (Env)
+import Data.Pass.Prep
+import Data.Pass.Thrist
+import Data.Pass.Trans
+import Data.Pass.L
+import Data.Pass.L.By
+
+data Pass k a b where
+  Pass :: (Typeable m, Binary m, Monoid m) => (m -> o) -> Thrist k i m -> Pass k i o
+  L    :: (n -> o) -> L n n -> Thrist k i n -> Pass k i o
+  Ap   :: (b -> c) -> Pass k i (a -> b) -> Pass k i a -> Pass k i c
+  Pure :: a -> Pass k i a
+
+instance By (Pass k) where
+  by (Ap k mf ma) r = Ap k (by mf r) (by ma r)
+  by (L k m i) r = L k (by m r) i
+  by x _ = x
+
+instance Trans Pass where
+  trans t = Pass id (trans t)
+
+instance Functor (Pass k a) where
+  fmap f (L k m i)    = L (f . k) m i
+  fmap f (Pass k v)   = Pass (f . k) v
+  fmap f (Pure a)     = Pure (f a)
+  fmap f (Ap k mf ma) = Ap   (f . k) mf ma
+
+instance Applicative (Pass k a) where
+  pure          = Pure
+  Pure f <*> xs = fmap f xs
+  fs <*> Pure x = fmap ($x) fs
+  fs <*> xs     = Ap id fs xs
+
+instance Typeable2 k => Typeable2 (Pass k) where
+  typeOf2 (_ :: Pass k a b) = mkTyConApp calcTyCon [typeOf2 (undefined :: k a b)]
+
+calcTyCon :: TyCon
+#if MIN_VERSION_base(4,4,0)
+calcTyCon = mkTyCon3 "pass" "Data.Pass.Type" "Pass"
+#else
+calcTyCon = mkTyCon "Data.Pass.Type.Pass"
+#endif
+{-# NOINLINE calcTyCon #-}
+
+instance Prep Pass where
+  prep f (Pass k g)   = Pass k (prep f g)
+  prep f (L k m i)  = L k m (prep f i)
+  prep f (Ap k mf ma) = Ap k (prep f mf) (prep f ma)
+  prep _ (Pure a)     = Pure a
+
+#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ < 704
+instance Show (Pass k a b) where
+  showsPrec _ _ = showString "<pass>"
+instance Eq (Pass k a b) where
+  _ == _ = False
+#endif
+#endif
+
+instance Num b => Num (Pass k a b) where
+  (+) = liftA2 (+)
+  (-) = liftA2 (-)
+  negate = fmap negate
+  (*) = liftA2 (*)
+  abs = fmap abs
+  signum = fmap signum
+  fromInteger = pure . fromInteger
+
+instance Fractional b => Fractional (Pass k a b) where
+  (/) = liftA2 (/)
+  recip = fmap recip
+  fromRational = pure . fromRational
+
+instance Floating b => Floating (Pass k a b) where
+  pi = pure pi
+  exp = fmap exp
+  sqrt = fmap sqrt
+  log = fmap log
+  (**) = liftA2 (**)
+  logBase = liftA2 logBase
+  sin = fmap sin
+  tan = fmap tan
+  cos = fmap cos
+  asin = fmap asin
+  atan = fmap atan
+  acos = fmap acos
+  sinh = fmap sinh
+  tanh = fmap tanh
+  cosh = fmap cosh
+  asinh = fmap asinh
+  acosh = fmap acosh
+  atanh = fmap atanh
+
+instance Call k => Naive (Pass k) where
+  naive (Pure b)     _ _  = b
+  naive (Ap k mf mx) n xs = k $ naive mf n xs $ naive mx n xs
+  naive (Pass k t)   _ xs = k $ foldMap (call t) xs
+  naive (L k m i)    n xs = k $ ordL m $ foldrWithKey step 0 stats
+    where
+      step g v x = ordL m $ IntMap.findWithDefault 0 g coefs * v + x
+      stats = ordL m $ sort $ call i <$> xs
+      coefs = callL m n
+
+env :: Call k => Pass k a b -> Env k a
+env = envWith Env.empty
+
+envWith :: Call k => Env k a -> Pass k a c -> Env k a
+envWith acc (Ap _ l r) = envWith (envWith acc l) r
+envWith acc (Pass _ t) = Env.insert t mempty acc
+envWith acc _ = acc
+
+instance Call k => Eval (Pass k) where
+  eval f n xs = evalWith (foldr Env.cons (env f) xs) f n xs
+
+evalWith :: Call k => Env k a -> Pass k a c -> Int -> [a] -> c
+evalWith _ (Pure a)   _ _  = a
+evalWith g (Ap k l r) n xs = k $ evalWith g l n xs $ evalWith g r n xs
+evalWith _ (L k m i)  n xs = k $ eval m n $ map (call i) xs
+evalWith g (Pass k t) _ _  = k $ case Env.lookup t g of
+  Nothing -> error "evalWith: missing thrist"
+  Just v  -> v
diff --git a/Data/Pass/Util.hs b/Data/Pass/Util.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Util.hs
@@ -0,0 +1,10 @@
+module Data.Pass.Util
+  ( clamp
+  ) where
+
+clamp :: Int -> Int -> Int
+clamp n k
+  | k <= 0    = 0
+  | k >= n    = n - 1
+  | otherwise = k
+{-# INLINE clamp #-}
diff --git a/Data/Pass/Util/Beta.hs b/Data/Pass/Util/Beta.hs
new file mode 100644
--- /dev/null
+++ b/Data/Pass/Util/Beta.hs
@@ -0,0 +1,46 @@
+module Data.Pass.Util.Beta
+  ( Beta(..)
+  , cumulative
+  , density
+  , quantile
+  ) where
+
+import Numeric.SpecFunctions
+import Numeric.MathFunctions.Constants (m_NaN)
+
+data Beta = Beta {-# UNPACK #-} !Double {-# UNPACK #-} !Double
+  deriving (Eq,Read,Show)
+
+cumulative :: Beta -> Double -> Double
+cumulative (Beta a b) x
+  | x <= 0 = 0
+  | otherwise = incompleteBeta a b x
+{-# INLINE cumulative #-}
+
+-- invert a monotone function
+invertMono :: (Double -> Double) -> Double -> Double -> Double -> Double
+invertMono f l0 h0 b = go l0 h0 where
+  go l h
+    | h - l < epsilon = m
+    | otherwise = case compare (f m) b of
+      LT -> go m h
+      EQ -> m
+      GT -> go l m
+    where m = l + (h-l)/2
+          epsilon = 1e-12
+{-# INLINE invertMono #-}
+
+density :: Beta -> Double -> Double
+density (Beta a b) x
+  | a <= 0 || b <= 0 = m_NaN
+  | x <= 0 = 0
+  | x >= 1 = 0
+  | otherwise = exp $ (a-1)*log x + (b-1)*log (1-x) - logBeta a b
+{-# INLINE density #-}
+
+quantile :: Beta -> Double -> Double
+quantile d p
+  | p < 0 = error $ "probability must be positive. Got " ++ show p
+  | p > 1 = error $ "probability must be less than 1. Got " ++ show p
+  | otherwise = invertMono (cumulative d) 0 1 p
+{-# INLINE quantile #-}
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright 2012 Edward Kmett
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/Pass.hs b/examples/Pass.hs
new file mode 100644
--- /dev/null
+++ b/examples/Pass.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE GADTs, DeriveDataTypeable, StandaloneDeriving, ExtendedDefaultRules, GeneralizedNewtypeDeriving #-}
+
+import Control.Applicative
+import Control.Category
+import Control.Newtype
+import Control.Monad (liftM)
+import Data.Binary
+import Data.Foldable
+import Data.Hashable
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Monoid
+import Data.Typeable
+import Data.Pass
+import Data.Pass.Monoid.Ord
+import Prelude hiding (id,(.))
+
+-- example calculation type
+data Test a b where
+  Total    :: Num a => Test a (Sum a)
+  Count    :: Test a (Sum Int)
+  Square   :: Num a => Test a a
+  Minus    :: Double -> Test Double Double
+  Abs      :: Num a => Test a a
+  Smallest :: Num a => Test a (Min a)
+  Largest  :: Num a => Test a (Max a)
+  deriving Typeable
+
+deriving instance Typeable1 Sum -- :(
+deriving instance Binary a => Binary (Sum a)
+
+count :: (Step t, Num b) => t Test a b
+count = step $ fromIntegral . getSum <$> trans Count
+
+sumSq :: Step t => t Test Double Double
+sumSq = step $ Square `prep` total
+
+-- | @E[X^2] - E[X]^2@
+var :: Step t => t Test Double Double
+var = step $ sumSq / count - mean ^ 2
+
+stddev :: Step t => t Test Double Double
+stddev = step $ sqrt var
+
+-- > absDev median -- median absolute deviation
+-- > absDev mean   -- mean absolute deviation
+absdev :: Pass Test Double Double -> Calc Test Double Double
+absdev mu = mu :& \m -> Minus m `prep` Abs `prep` step mu
+
+-- median absolute deviation
+mad :: Calc Test Double Double
+mad = absdev median
+
+instance Named Test where
+  showsFun _ Total     = showString "Total"
+  showsFun _ Count     = showString "Count"
+  showsFun _ Square    = showString "Square"
+  showsFun d (Minus n) = showParen (d > 10) $ showString "Minus " . showsPrec 10 n
+  showsFun _ Abs       = showString "Abs"
+  showsFun _ Largest   = showString "Largest"
+  showsFun _ Smallest  = showString "Smallest"
+
+instance Call Test where
+  call Total a = Sum a
+  call Count _ = Sum 1
+  call Square a = a * a
+  call (Minus n) a = a - n
+  call Abs a = abs a
+  call Largest a = Max a
+  call Smallest a = Min a
+
+instance Accelerant Test where
+  meanPass  = total / count
+  totalPass = getSum <$> trans Total
+  largestPass = getMax <$> trans Largest
+  smallestPass = getMin <$> trans Smallest
+
+infixl 0 @!
+
+(@!) :: Calc Test a b -> [a] -> b
+(@!) = (@@)
diff --git a/multipass.cabal b/multipass.cabal
new file mode 100644
--- /dev/null
+++ b/multipass.cabal
@@ -0,0 +1,71 @@
+name:          multipass
+category:      Control
+version:       0.1
+license:       BSD3
+cabal-version: >= 1.6
+license-file:  LICENSE
+author:        Edward A. Kmett
+maintainer:    Edward A. Kmett <ekmett@gmail.com>
+stability:     experimental
+homepage:      http://github.com/ekmett/multipass/
+copyright:     Copyright (C) 2012 Edward A. Kmett
+synopsis:      Folding data with multiple named passes
+description:   Folding data with multiple named passes
+build-type:    Simple
+
+extra-source-files: examples/Pass.hs
+
+source-repository head
+  type: git
+  location: git://github.com/ekmett/multipass.git
+
+library
+  other-extensions:
+    CPP
+    GADTs
+    Rank2Types
+    BangPatterns
+    PatternGuards
+    ScopedTypeVariables
+
+  build-depends:
+    ghc-prim,
+    base                 == 4.*,
+    binary               == 0.5.*,
+    containers           >= 0.4 && < 0.6,
+    hashable             == 1.1.*,
+    keys                 == 3.0.*,
+    math-functions       == 0.1.*,
+    newtype              == 0.2.*,
+    unordered-containers >= 0.2.1 && < 0.3
+
+  exposed-modules:
+    Data.Pass
+    Data.Pass.Accelerant
+    Data.Pass.Accelerated
+    Data.Pass.Calc
+    Data.Pass.Calculation
+    Data.Pass.Call
+    Data.Pass.Class
+    Data.Pass.Env
+    Data.Pass.Eval
+    Data.Pass.Eval.Naive
+    Data.Pass.Fun
+    Data.Pass.Key
+    Data.Pass.L
+    Data.Pass.L.By
+    Data.Pass.L.Estimator
+    Data.Pass.Named
+    Data.Pass.Prep
+    Data.Pass.Robust
+    Data.Pass.Step
+    Data.Pass.Thrist
+    Data.Pass.Trans
+    Data.Pass.Type
+    Data.Pass.Monoid.Ord
+
+  other-modules:
+    Data.Pass.Util
+    Data.Pass.Util.Beta
+
+  ghc-options: -Wall