diff --git a/Data/Comp/Derive/Generic.hs b/Data/Comp/Derive/Generic.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Derive/Generic.hs
@@ -0,0 +1,188 @@
+-- |
+-- Allows you to derive instances of GHC.Generics for compositional data types.
+-- Warning: May slaughter your compile times.
+
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- TH runs at compile time, so you get compile-time errors anyway
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-} -- It warns for the instance declarations in TH which are never directly compiled -- GAH
+
+module Data.Comp.Derive.Generic
+  (
+    makeGeneric
+  , makeInstancesLike
+  , GenericExample
+  ) where
+
+import Control.Lens ( (%~), (&), traversed )
+import Control.Monad ( liftM, filterM, mplus, msum )
+
+import qualified Data.Comp.Multi as M
+import qualified Data.Comp.Multi.Ops as M
+
+import GHC.Generics ( Generic(..), (:*:)(..), (:+:)(..), K1(..), V1, Rec0, U1(..) )
+
+import Language.Haskell.TH
+
+import Data.Comp.Trans.Names
+
+--------------------------------------------------------------------------------
+-- Generic instances for general CDTs
+--------------------------------------------------------------------------------
+
+instance (Generic (f e l), Generic (g e l)) => Generic ((f M.:+: g) e l) where
+  type Rep ((f M.:+: g) e l) = (Rep (f e l)) :+: (Rep (g e l))
+  from = M.caseH (L1 . from) (R1 . from)
+  to (L1 x) = M.Inl $ to x
+  to (R1 x) = M.Inr $ to x
+
+instance (Generic (f (M.Term f) l)) => Generic (M.Term f l) where
+  type Rep (M.Term f l) = Rep (f (M.Term f) l)
+  from (M.Term x) = from x
+  to x = M.Term $ to x
+
+instance (Generic (f e l)) => Generic ((f M.:&: p) e l) where
+  type Rep ((f M.:&: p) e l) = (Rep (f e l)) :*: Rec0 p
+  from (t M.:&: x) = from t :*: K1 x
+  to (t :*: K1 x) = to t M.:&: x
+
+--------------------------------------------------------------------------------
+-- Creating users of Generic
+--------------------------------------------------------------------------------
+
+data GenericExample
+
+makeInstancesLike :: [Name] -> [Type] -> Q [Dec] -> Q [Dec]
+makeInstancesLike cons labs example = do
+  [InstanceD [] (AppT (ConT tc) _) b] <- example
+  return [makeInstanceLike tc c l b | c <- cons, l <- labs]
+
+makeInstanceLike :: Name -> Name -> Type -> [Dec] -> Dec
+makeInstanceLike tc c l b = InstanceD [] (AppT (ConT tc) (AppT (ConT c) l)) b 
+
+
+--------------------------------------------------------------------------------
+-- Deriving Generic
+--------------------------------------------------------------------------------
+
+makeGeneric :: [Name] -> [Type] -> Q [Dec]
+makeGeneric nms tps = liftM concat $ sequence [makeGenericInstance n t | n <- nms, t <- tps]
+
+makeGenericInstance :: Name -> Type -> Q [Dec]
+makeGenericInstance typNm lab = do
+    cons <- liftM simplifyDataInf $ reify typNm
+    relCons <- filterM (matchingCon lab . fst) cons
+    let mTyp = conT typNm
+    let mLab = return lab
+
+    case relCons of
+      [] -> [d| instance Generic ($mTyp e $mLab) where
+                  type Rep ($mTyp e $mLab) = V1
+                  from = undefined
+                  to = undefined
+              |]
+
+      xs -> do let xts = map snd xs
+
+
+               vars1 <- mapM (mapM (const $ newName "x")) xts
+               vars2 <- mapM (mapM (const $ newName "x")) xts
+               eNm   <- case msum $ map (msum.map getEVar) $ map snd xs of
+                          Just n  -> return n
+                          Nothing -> newName "e"
+               
+               let e   = return (VarT eNm)
+               let rep = return $ genericTp xts
+
+
+               let gPat = addSumPat $ map makeGPat $ vars1
+               let gExp = addSumExp $ map makeGExp $ vars2
+               let ePat = map makeEPat $ zip xs vars2 & traversed %~ (\((n,_),ns) -> (n, ns))
+               let eExp = map makeEExp $ zip xs vars1 & traversed %~ (\((n,_),ns) -> (n, ns))
+
+               inst' <- one [d| instance Generic ($mTyp $e $mLab) where
+                                  type Rep ($mTyp $e $mLab) = $rep
+                              |]
+
+               addDecs inst' $
+                   [ FunD 'from (map mkClause $ zip ePat gExp)
+                   , FunD 'to   (map mkClause $ zip gPat eExp)
+                   ]
+             where
+               one = liftM head
+               addDecs (InstanceD c t ds) ds' = return $ [InstanceD c t (ds++ds')]
+
+               mkClause (pat, expr) = Clause [pat] (NormalB expr) []
+
+               getEVar (AppT (VarT n) _) = Just n
+               getEVar (AppT x y )       = getEVar x `mplus` getEVar y
+               getEVar _                 = Nothing
+           
+
+genericTp :: [[Type]] -> Type
+genericTp ts = combine ''(:+:) $ map (combine ''(:*:)) $ map (map (AppT (ConT ''Rec0))) ts
+  where
+    combine _ []     = ConT ''U1
+    combine _ [x]    = x
+    combine c (x:xs) = AppT (AppT (ConT c) x) (combine c xs)
+
+makeGPat :: [Name] -> Pat
+makeGPat []     = ConP 'U1 []
+makeGPat [n]    = ConP 'K1 [VarP n]
+makeGPat (n:ns) = ConP '(:*:) [ ConP 'K1 [VarP n]
+                              , makeGPat ns 
+                              ]
+
+makeGExp :: [Name] -> Exp
+makeGExp []     = ConE 'U1
+makeGExp [n]    = AppE (ConE 'K1) (VarE n)
+makeGExp (n:ns) = AppE (AppE (ConE '(:*:)) (AppE (ConE 'K1) (VarE n))) (makeGExp ns) 
+
+makeEPat :: (Name, [Name]) -> Pat
+makeEPat (c, ns) = ConP c (map VarP ns)
+
+makeEExp :: (Name, [Name]) -> Exp
+makeEExp (c, ns) = foldl AppE (ConE c) (map VarE ns)
+
+addSumPat :: [Pat] -> [Pat]
+addSumPat [p]    = [p]
+addSumPat (p:ps) = [ConP 'L1 [p]] ++ map (\r -> ConP 'R1 [r]) (addSumPat ps)
+
+addSumExp :: [Exp] -> [Exp]
+addSumExp [e]    = [e]
+addSumExp (e:es) = [AppE (ConE 'L1) e] ++ map (\f -> AppE (ConE 'R1) f) (addSumExp es)
+
+matchingCon :: Type -> Name -> Q Bool
+matchingCon t nm = do
+  (DataConI _ tp parentNm _) <- reify nm
+  return $ cxtlessUnifiable (extractLab tp parentNm) t
+
+
+extractLab :: Type -> Name -> Type
+extractLab tp par = go tp
+  where
+    go (ForallT _ ctx t)      = go $ substCxt ctx t
+    go (AppT (AppT (ConT n) _) t)
+                 | par == n = t
+    go (AppT _ t)           = go t
+
+    -- My very ghetto way of handling contexts. Found a few
+    -- examples where GHC substituted away equality constraints
+    -- when getting the type of a data con; assumed it always did,
+    -- and now paying the price.
+    substCxt [] t                         = t
+    substCxt (EqualP (VarT n) t' : ctx) t = substCxt ctx (tsubst t' n t)
+    substCxt (EqualP t' (VarT n) : ctx) t = substCxt ctx (tsubst t' n t)
+    substCxt (_ : ctx) t                  = substCxt ctx t
+    
+    tsubst t n (AppT l r) = AppT (tsubst t n l) (tsubst t n r)
+    tsubst t n (VarT n')
+                | n == n' = t
+    tsubst _ _ x          = x
+      
+cxtlessUnifiable :: Type -> Type -> Bool
+cxtlessUnifiable t u | t == u = True
+cxtlessUnifiable (VarT _) _   = True
+cxtlessUnifiable _ (VarT _)   = True
+cxtlessUnifiable (AppT t1 u1)
+                 (AppT t2 u2) = (cxtlessUnifiable t1 t2) && (cxtlessUnifiable u1 u2)
+cxtlessUnifiable _ _          = False
diff --git a/Data/Comp/Trans.hs b/Data/Comp/Trans.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans.hs
@@ -0,0 +1,133 @@
+-- |
+-- 
+-- GHC has a phase restriction which prevents code generated by Template Haskell
+-- being referred to by Template Haskell in the same file. Thus, when using this
+-- library, you will need to spread invocations out over several files.
+-- 
+-- We will refer to the following example in the documentation:
+-- 
+-- @
+-- module Foo where
+-- data Arith = Add Atom Atom
+-- data Atom = Var String | Const Lit
+-- data Lit = Lit Int
+-- @
+module Data.Comp.Trans (
+    deriveMultiComp
+  , generateNameLists
+  , makeSumType
+
+  , getLabels
+
+  , T.deriveTrans
+  , U.deriveUntrans
+  ) where
+
+import Control.Monad ( liftM, mapM )
+
+import Data.Comp.Multi ( (:+:) )
+import Data.Data ( Data )
+
+import Language.Haskell.TH.Quote ( dataToExpQ )
+import Language.Haskell.TH
+
+import qualified Data.Comp.Trans.DeriveTrans as T
+import qualified Data.Comp.Trans.DeriveUntrans as U
+import Data.Comp.Trans.DeriveMulti
+import Data.Comp.Trans.Collect
+import Data.Comp.Trans.Names
+
+
+-- |
+-- Declares a multi-sorted compositional datatype isomorphic to the
+-- given ADT.
+-- 
+-- /e.g./
+-- 
+-- @
+-- import qualified Foo as F
+-- deriveMultiComp ''F.Arith
+-- @
+-- 
+-- will create
+-- 
+-- @
+-- data ArithL
+-- data AtomL
+-- data LitL
+-- 
+-- data Arith e l where
+--   Add :: e AtomL -> e AtomL -> Arith e ArithL
+-- 
+-- data Atom e l where
+--   Var :: String -> Atom e AtomL
+--   Const :: e LitL -> Atom e AtomL
+-- 
+-- data Lit (e :: * -> *) l where
+--   Lit :: Int -> Lit e LitL
+-- @
+deriveMultiComp :: Name -> Q [Dec]
+deriveMultiComp root = do descs <- collectTypes root
+                          liftM concat $ mapM deriveMulti descs
+
+-- |
+-- 
+-- /e.g./
+-- 
+-- @
+-- generateNameLists ''Arith
+-- @
+-- 
+-- will create
+-- 
+-- @
+-- origASTTypes = [mkName "Foo.Arith", mkName "Foo.Atom", mkName "Foo.Lit"]
+-- newASTTypes  = [mkName "Arith", mkName "Atom", mkName "Lit"]
+-- newASTLabels = map ConT [mkName "ArithL", mkName "AtomL', mkName "LitL"]
+-- @
+generateNameLists :: Name -> Q [Dec]
+generateNameLists root = do
+    descs <- collectTypes root
+    nameList1 <- mkList ''Name (mkName "origASTTypes") descs
+    nameList2 <- mkList ''Name (mkName "newASTTypes") (map transName descs)
+
+    return $ nameList1 ++ nameList2
+  where
+
+    mkList :: Data t => Name -> Name -> [t] -> Q [Dec]
+    mkList tNm name contents = sequence [ sigD name (appT listT (conT tNm))
+                                        , valD (varP name) (normalB namesExp) []
+                                        ]
+      where
+        namesExp = dataToExpQ (const Nothing) contents
+
+getLabels :: [Name] -> Q [Type]
+getLabels nms = mapM toLabel nms
+  where
+    toLabel n = do TyConI (DataD _ n' _ _ _) <- reify $ nameLab n
+                   return $ ConT n'
+
+-- |
+-- Folds together names with @(`:+:`)@.
+-- 
+-- /e.g./
+-- 
+-- @
+-- import qualified Foo as F
+-- deriveMult ''F.Arith
+-- makeSumType \"ArithSig\" [''Arith, ''Atom, ''Lit]
+-- @
+-- 
+-- will create
+-- 
+-- @
+-- type ArithSig = Arith :+: Atom :+: Lit
+-- @
+-- 
+-- You can use `generateNameLists` to avoid spelling out the names manually
+makeSumType :: String -> [Name] -> Q [Dec]
+makeSumType nm types = sequence $ [tySynD (mkName nm) [] $ sumType types]
+  where
+    sumType []     = fail "Attempting to make empty sum type"
+    sumType [t]    = conT t
+    sumType (t:ts) = appT (appT (conT ''(:+:)) (conT t)) (sumType ts)
diff --git a/Data/Comp/Trans/Collect.hs b/Data/Comp/Trans/Collect.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans/Collect.hs
@@ -0,0 +1,69 @@
+module Data.Comp.Trans.Collect (
+    collectTypes
+  ) where
+
+import Control.Monad ( liftM, liftM2 )
+
+import Data.Foldable ( fold )
+import Data.Monoid ( Monoid(..) )
+
+import Data.Set as Set ( Set, singleton, union, difference, toList, member, empty )
+
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.ExpandSyns ( expandSyns )
+
+import Data.Comp.Trans.Names ( standardNameSet )
+
+-- | Finds all type names transitively referred to by a given type,
+-- removing standard types
+collectTypes :: Name -> Q [Name]
+collectTypes n = do names <- fixpoint collectTypes' n
+                    return $ toList $ difference names standardNameSet
+
+-- |
+-- Finds the fixpoint of a monotone monadic function using chaotic iteration
+fixpoint :: (Ord a, Monad m) => (a -> m (Set a)) -> a -> m (Set a)
+fixpoint f x = run $ singleton x
+  where
+    run s = do s' <- liftM fold $ mapSetM f s
+               if s' == s then
+                 return s'
+                else
+                 run s'
+
+-- | mapM for Data.Set
+mapSetM :: (Monad m, Ord b) => (a -> m b) -> Set a -> m (Set b)
+mapSetM f x = liftM (mconcat . map singleton) $ mapM f (toList x)
+
+collectTypes' :: Name -> Q (Set Name)
+collectTypes' n | member n standardNameSet = return empty
+collectTypes' n = do inf <- reify n
+                     let cons = case inf of
+                                      TyConI (DataD _ _ _ cns _)    -> cns
+                                      TyConI (NewtypeD _ _ _ con _) -> [con]
+                                      _ -> []
+                     childNames <- liftM concat $ mapM extractNames cons
+                     return $ (singleton n) `union` (mconcat $ map singleton childNames)
+                    
+
+class ExtractNames a where
+  extractNames :: a -> Q [Name]
+
+instance ExtractNames Con where
+  extractNames (NormalC _ xs) = liftM concat $ mapM extractNames xs
+  extractNames (RecC _ xs) = liftM concat $ mapM extractNames xs
+  extractNames (InfixC a _ b) = liftM2 (++) (extractNames a) (extractNames b)
+  extractNames (ForallC _ _ x) = extractNames x
+
+instance ExtractNames StrictType where
+  extractNames (_, t) = extractNames t
+
+instance ExtractNames VarStrictType where
+  extractNames (_, _, t) = extractNames t
+
+instance ExtractNames Type where
+  extractNames tSyn = do t <- expandSyns tSyn
+                         case t of 
+                           AppT a b -> liftM2 (++) (extractNames a) (extractNames b)
+                           ConT n   -> return [n]
+                           _        -> return []
diff --git a/Data/Comp/Trans/DeriveMulti.hs b/Data/Comp/Trans/DeriveMulti.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans/DeriveMulti.hs
@@ -0,0 +1,52 @@
+module Data.Comp.Trans.DeriveMulti (
+    deriveMulti
+  ) where
+
+import Control.Lens ( traverse, _1, _2, _3, (&), (%~), (%%~) )
+import Control.Monad ( liftM )
+
+import Data.Functor ( (<$>) )
+
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.ExpandSyns ( expandSyns )
+
+import Data.Comp.Trans.Names ( baseTypes, transName, nameLab, getLab )
+
+deriveMulti :: Name -> Q [Dec]
+deriveMulti n = do inf <- reify n
+                   case inf of
+                     TyConI (DataD _ nm [] cons _)   -> mkGADT nm cons
+                     TyConI (NewtypeD _ nm [] con _) -> mkGADT nm [con]
+                     _                         -> do reportError $ "Attempted to derive multi-sorted compositional data type for "
+                                                                    ++ show n ++ ", which is not a nullary datatype"
+                                                     return []
+
+mkGADT :: Name -> [Con] -> Q [Dec]
+mkGADT n cons = do e <- newName "e"
+                   i <- newName "i"
+                   let n' = transName n
+                   cons' <- mapM (mkCon n' e i) cons
+                   return $ [DataD [] n' [KindedTV e (AppT (AppT ArrowT StarT) StarT), PlainTV i] cons' []
+                            ,DataD [] (nameLab n) [] [] []
+                            ]
+
+mkCon :: Name -> Name -> Name -> Con -> Q Con
+mkCon l e i (NormalC n sts) = ForallC [] ctx <$> inner
+  where
+    ctx = [EqualP (VarT i) (ConT $ nameLab l)]
+
+    sts'  = sts & (traverse._2) %%~ unfixType e
+    inner = liftM (NormalC (transName n)) sts'
+mkCon l e i (RecC n vsts) = ForallC [] ctx <$> inner
+  where
+    ctx = [EqualP (VarT i) (ConT $ nameLab l)]
+
+    vsts'  = vsts & (traverse._1) %~ transName
+    vsts'' = vsts' & (traverse._3) %%~ unfixType e
+    inner  = liftM (RecC (transName n)) vsts''
+mkCon _ _ _ c = fail $ "Attempted to derive multi-sorted compositional datatype for something with non-normal constructors: " ++ show c
+
+unfixType :: Name -> Type -> Q Type
+unfixType _ t | elem t baseTypes = return t
+unfixType e t = do t' <- expandSyns t >>= getLab
+                   return $ AppT (VarT e) t'
diff --git a/Data/Comp/Trans/DeriveTrans.hs b/Data/Comp/Trans/DeriveTrans.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans/DeriveTrans.hs
@@ -0,0 +1,106 @@
+module Data.Comp.Trans.DeriveTrans
+  (
+    deriveTrans
+  ) where
+
+import Language.Haskell.TH
+
+import Data.Comp.Trans.Names ( baseTypes, smartConstrName, nameLab, simplifyDataInf )
+
+-- |
+-- Creates a functions translating from an ADT
+-- to its isomorphic multi-sorted compositional data type
+-- 
+-- @
+-- import qualified Foo as F
+-- ...
+-- type ArithTerm = Term Arith
+-- deriveTrans ''Arith [''Arith, ''Atom, ''Lit] ArithTerm
+-- @
+-- 
+-- will create
+-- 
+-- @
+-- translate :: F.Arith -> ArithTerm ArithL
+-- translate = trans
+-- 
+-- 
+-- class Trans a l where
+--   trans a -> ArithTerm l
+-- 
+-- instance Trans F.Arith ArithL where
+--   trans (F.Add x y) = iAdd (trans x) (trans y)
+-- 
+-- instance Trans F.Atom AtomL where
+--   trans (F.Var s)   = iVar s
+--   trans (F.Const x) = iConst (trans x)
+-- 
+-- instance Trans F.Lit LitL where
+--   trans (F.Lit n) = iLit n
+-- @
+deriveTrans :: Name -> [Name] -> Type -> Q [Dec]
+deriveTrans root names term = do let classNm = mkName "Trans"
+                                 funNm <- newName "trans"
+
+                                 classDec <- mkClass classNm funNm term
+                                 funDec <- mkFunc root funNm term
+                                 instances <- mapM (mkInstance classNm funNm) names
+
+                                 return $ [classDec] ++ funDec ++ instances
+
+-- |
+-- Example:
+-- 
+-- @
+-- translate :: J.CompilationUnit -> JavaTerm CompilationUnitL
+-- translate = trans
+-- @
+mkFunc :: Name -> Name -> Type -> Q [Dec]
+mkFunc typ funNm term = return [ SigD translate (AppT (AppT ArrowT (ConT typ)) (AppT term lab))
+                               , ValD (VarP translate) (NormalB funNm') []
+                               ]
+  where
+    translate = mkName "translate"
+    lab = ConT $ nameLab typ
+    funNm' = VarE funNm
+
+-- |
+-- Example:
+-- 
+-- @
+-- class Trans a l where
+--   trans a -> JavaTerm l
+-- @
+mkClass :: Name -> Name -> Type -> Q Dec
+mkClass classNm funNm term = do a <- newName "a"
+                                i <- newName "i"
+                                let transDec = SigD funNm (foldl AppT ArrowT [VarT a, AppT term (VarT i)])
+                                return $ ClassD [] classNm [PlainTV a, PlainTV i] [] [transDec]
+
+-- |
+-- Example:
+-- 
+-- @
+-- instance Trans J.CompilationUnit CompilationUnitL where
+--   trans (J.CompilationUnit x y z) = iCompilationUnit (trans x) (trans y) (trans z)
+-- @
+mkInstance :: Name -> Name -> Name -> Q Dec
+mkInstance classNm funNm typNm = do inf <- reify typNm
+                                    let nmTyps = simplifyDataInf inf
+                                    clauses <- mapM (uncurry $ mkClause funNm) nmTyps
+                                    let targNm = nameLab typNm
+                                    return (InstanceD []
+                                                      (AppT (AppT (ConT classNm) (ConT typNm)) (ConT targNm))
+                                                      [FunD funNm clauses])
+
+mkClause :: Name -> Name -> [Type] -> Q Clause
+mkClause funNm con tps = do nms <- mapM (const $ newName "x") tps
+                            return $ Clause [pat nms] (body nms) []
+  where
+    pat nms = ConP con (map VarP nms)
+
+    body nms = NormalB $ foldl AppE (VarE (smartConstrName con)) (map atom $ zip nms tps)
+
+    atom :: (Name, Type) -> Exp
+    atom (x, t) | elem t baseTypes = VarE x
+    atom (x, _)                    = AppE (VarE funNm) (VarE x)
diff --git a/Data/Comp/Trans/DeriveUntrans.hs b/Data/Comp/Trans/DeriveUntrans.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans/DeriveUntrans.hs
@@ -0,0 +1,148 @@
+module Data.Comp.Trans.DeriveUntrans (
+    deriveUntrans
+  ) where
+
+import Control.Monad ( liftM )
+
+import Data.Comp.Multi ( Alg, cata )
+
+import Language.Haskell.TH
+
+import Data.Comp.Trans.Names ( baseTypes, transName, nameLab, simplifyDataInf )
+
+--------------------------------------------------------------------------------
+
+
+-- |
+-- Creates an @untranslate@ function inverting the @translate@ function
+-- created by @deriveTrans@.
+-- 
+-- @
+-- import qualified Foo as F
+-- type ArithTerm = Term (Arith :+: Atom :+: Lit)
+-- deriveUntrans [''F.Arith, ''F.Atom, ''F.Lit] (TH.ConT ''ArithTerm)
+-- @
+-- 
+-- will create
+-- 
+-- @
+-- type family Targ l
+-- newtype T l = T {t :: Targ l}
+-- 
+-- class Untrans f where
+--   untrans :: Alg f t
+-- 
+-- untranslate :: ArithTerm l -> Targ l
+-- untranslate = t . cata untrans
+-- 
+-- type instance Targ ArithL = F.Arith
+-- instance Untrans Arith where
+--   untrans (Add x y) = T $ F.Add (t x) (t y)
+-- 
+-- type instance Targ AtomL = F.Atom
+-- instance Untrans Atom where
+--   untrans (Var s)   = T $ F.Var s
+--   untrans (Const x) = T $ F.Const (t x)
+-- 
+-- type instance Targ LitL = F.Lit
+-- instance Untrans Lit where
+--   untrans (Lit n) = T $ F.Lit n
+-- @
+-- 
+-- Note that you will need to manually provide an instance @(Untrans f, Untrans g) => Untrans (f :+: g)@
+-- due to phase issues.
+deriveUntrans :: [Name] -> Type -> Q [Dec]
+deriveUntrans names term = do targDec <- mkTarg targNm
+                              wrapperDec <- mkWrapper wrapNm unwrapNm targNm
+                              fnDec <- mkFn untranslateNm term targNm unwrapNm fnNm
+                              classDec <- mkClass classNm fnNm wrapNm
+                              instances <- liftM concat $ mapM (mkInstance classNm fnNm wrapNm unwrapNm targNm) names
+                              return $ concat [ targDec
+                                              , wrapperDec
+                                              , fnDec
+                                              , classDec
+                                              , instances
+                                              ]
+  where
+    targNm = mkName "Targ"
+    wrapNm = mkName "T"
+    unwrapNm = mkName "t"
+    untranslateNm = mkName "untranslate"
+    classNm = mkName "Untrans"
+    fnNm = mkName "untrans"
+
+{- type family Targ l -}
+mkTarg :: Name -> Q [Dec]
+mkTarg targNm = do i <- newName "i"
+                   return [FamilyD TypeFam targNm [PlainTV i] Nothing]
+
+{- newtype T l = T { t :: Targ l } -}
+mkWrapper :: Name -> Name -> Name -> Q [Dec]
+mkWrapper tpNm fNm targNm = do i <- newName "i"
+                               let con = RecC tpNm [(fNm, NotStrict, AppT (ConT targNm) (VarT i))]
+                               return [NewtypeD [] tpNm [PlainTV i] con []]
+{-
+  untranslate :: JavaTerm l -> Targ l
+  untranslate = t . cata untrans
+-}
+mkFn :: Name -> Type -> Name -> Name -> Name -> Q [Dec]
+mkFn fnNm term targNm fldNm untransNm = sequence [sig, def]
+  where
+    sig = do i <- newName "i"
+             sigD fnNm (forallT [PlainTV i] (return []) (typ $ varT i))
+
+    typ :: Q Type -> Q Type
+    typ i = [t| $term' $i -> $targ $i |]
+
+    term' = return term
+    targ = conT targNm
+
+    def = valD (varP fnNm) (normalB body) []
+
+    body = [| $fld . cata $untrans |]
+
+    fld = varE fldNm
+    untrans = varE untransNm
+
+{-
+  class Untrans f where
+    untrans :: Alg f T
+-}
+mkClass :: Name -> Name -> Name -> Q [Dec]
+mkClass classNm funNm newtpNm = do f <- newName "f"
+                                   let funDec = SigD funNm (AppT (AppT (ConT ''Alg) (VarT f)) (ConT newtpNm))
+                                   return [ClassD [] classNm [PlainTV f] [] [funDec]]
+                      
+{-
+  type instance Targ CompilationUnitL = J.CompilationUnit
+  instance Untrans CompilationUnit where
+    untrans (CompilationUnit x y z) = T $ J.CompilationUnit (t x) (t y) (t z)
+-}
+mkInstance :: Name -> Name -> Name -> Name -> Name -> Name -> Q [Dec]
+mkInstance classNm funNm wrap unwrap targNm typNm = do inf <- reify typNm
+                                                       let nmTyps = simplifyDataInf inf
+                                                       clauses <- mapM (uncurry $ mkClause wrap unwrap) nmTyps
+                                                       return [ famInst
+                                                              , inst clauses
+                                                              ]
+  where
+    famInst = TySynInstD targNm (TySynEqn [ConT $ nameLab typNm] (ConT typNm))
+
+    inst clauses =  InstanceD []
+                              (AppT (ConT classNm) (ConT (transName typNm)))
+                              [FunD funNm clauses]
+
+  
+
+mkClause :: Name -> Name -> Name -> [Type] -> Q Clause
+mkClause wrap unwrap con tps = do nms <- mapM (const $ newName "x") tps
+                                  return $ Clause [pat nms] (body nms) []
+  where
+    pat nms = ConP (transName con) (map VarP nms)
+
+    body nms = NormalB $ AppE (ConE wrap)
+                         $ foldl AppE (ConE con) (map atom $ zip nms tps)
+
+    atom :: (Name, Type) -> Exp
+    atom (x, t) | elem t baseTypes = VarE x
+    atom (x, _)                    = AppE (VarE unwrap) (VarE x)
diff --git a/Data/Comp/Trans/Names.hs b/Data/Comp/Trans/Names.hs
new file mode 100644
--- /dev/null
+++ b/Data/Comp/Trans/Names.hs
@@ -0,0 +1,77 @@
+module Data.Comp.Trans.Names
+  (
+    standardNameSet
+  , baseTypes
+  , getLab
+  , transName
+  , nameLab
+  , smartConstrName
+  , modNameBase
+  , simplifyDataInf
+  ) where
+
+import Control.Lens ( (^.), _3 )
+import Control.Monad ( liftM2 )
+
+import Data.Functor ( (<$>) )
+import Data.Set ( Set, fromList )
+
+import Language.Haskell.TH.Syntax
+
+{-
+   Names that should be excluded from an AST hierarchy.
+
+   Type synonyms need not be present.
+-}
+standardNameSet :: Set Name
+standardNameSet = fromList [''Maybe, ''Int, ''Integer, ''Bool, ''Char, ''Double]
+
+
+{-
+   Types which should be translated into functorial form.
+  
+   Both String and its expansion are present because
+   expandSyn threw errors
+ -}
+baseTypes :: [Type]
+baseTypes = [ ConT ''Int
+            , ConT ''Bool
+            , ConT ''Char
+            , ConT ''Double
+            , ConT ''Integer
+            , ConT ''String
+            , AppT ListT (ConT ''Char)
+            ]
+
+
+getLab :: Type -> Q Type
+getLab (AppT f@(AppT _ _) t) = liftM2 AppT (getLab f) (getLab t)
+getLab (AppT f t) = AppT f <$> getLab t
+getLab ListT      = return ListT
+getLab (TupleT n) = return $ TupleT n
+getLab (ConT n)   = return $ ConT $ nameLab n
+getLab _          = fail "When deriving multi-sorted compositional data type, found unsupported type in AST."
+
+
+transName :: Name -> Name
+transName = modNameBase id
+
+nameLab :: Name -> Name
+nameLab = modNameBase (++"L")
+
+smartConstrName :: Name -> Name
+smartConstrName = modNameBase ('i':)
+
+modNameBase :: (String -> String) -> Name -> Name
+modNameBase f = mkName . f . nameBase
+
+simplifyDataInf :: Info -> [(Name, [Type])]
+simplifyDataInf (TyConI (DataD _ _ _ cons _))   = map extractCon cons
+simplifyDataInf (TyConI (NewtypeD _ _ _ con _)) = [extractCon con]
+simplifyDataInf _                                = error "Attempted to derive multi-sorted compositional data type for non-nullary datatype"
+
+extractCon :: Con -> (Name, [Type])
+extractCon (NormalC nm sts) = (nm, map snd sts)
+extractCon (RecC nm vsts)   = (nm, map (^. _3) vsts)
+extractCon (ForallC _ _ c)  = extractCon c
+extractCon _                = error "Unsupported constructor type encountered"
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012-2015 James Koppel
+
+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/comptrans.cabal b/comptrans.cabal
new file mode 100644
--- /dev/null
+++ b/comptrans.cabal
@@ -0,0 +1,69 @@
+Name:                comptrans
+Version:             0.1.0.1
+Synopsis:            
+Description:         
+License:             BSD3
+License-File:        LICENSE
+Author:              James Koppel
+Maintainer:          James Koppel
+Synopsis:            Automatically converting ASTs into compositional data types
+Description:        
+    Template Haskell for converting an AST for a language written using normal
+    algebraic data types into ones written using multi-sorted compositional data types
+    (Data.Comp.Multi from the compdata library) so that you can use generic and modular operators
+    on it. You might need to add additional constructors that can e.g.: convert a (Term e Foo) into a
+    (Term e [Foo]).
+     The source files have comments showing example output for a simple language. See the examples directory
+    for an extended example of generating a compositional data type for the entire Java language, with labelled variants
+    as well as variants where an entire project of source files can be treated as a single AST -- and you can use the same operations
+    on all of them!
+Homepage:            https://github.com/jkoppel/comptrans
+Category:            Data,Generics
+Build-type:          Simple
+Cabal-version:       >=1.9.2
+
+Source-Repository head
+  Type:      git
+  Location:  https://github.com/jkoppel/comptrans
+
+Library
+
+  Extensions:
+    DeriveGeneric
+    EmptyDataDecls
+    FlexibleContexts
+    FlexibleInstances
+    FunctionalDependencies
+    GADTs
+    KindSignatures
+    MultiParamTypeClasses
+    OverlappingInstances
+    TemplateHaskell
+    TypeFamilies
+    TypeOperators
+    TypeSynonymInstances
+    UndecidableInstances
+
+  Ghc-Options:
+    -Wall
+
+  Exposed-Modules:     
+                       Data.Comp.Derive.Generic
+                       Data.Comp.Trans
+
+  Other-Modules:       
+                       Data.Comp.Trans.Collect
+                       Data.Comp.Trans.DeriveMulti
+                       Data.Comp.Trans.DeriveTrans
+                       Data.Comp.Trans.DeriveUntrans
+                       Data.Comp.Trans.Names
+
+  Build-Depends:       base >= 4.7, base < 5
+                     , compdata < 1
+                     , containers <= 0.6
+                     , lens < 5
+                     , template-haskell
+                     , th-expand-syns <= 0.4
+                     , ghc-prim >= 0.2
+                     , deepseq < 1.4
+                     , deepseq-generics < 0.1.2