diff --git a/Generics/Instant/Derive.hs b/Generics/Instant/Derive.hs
new file mode 100644
--- /dev/null
+++ b/Generics/Instant/Derive.hs
@@ -0,0 +1,154 @@
+{-# OPTIONS_GHC -fwarn-unused-imports #-}
+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, ViewPatterns, FlexibleContexts #-}
+module Generics.Instant.Derive 
+    (derive, deriveCon, deriveConWith, deriveRep, deriveRepWith, deriveWith) where
+import Generics.Instant
+import Language.Haskell.TH 
+import Language.Haskell.TH.Syntax (lift)
+import Control.Monad
+import Data.Char (isLower)
+
+normalizeDec :: Dec -> Dec
+normalizeDec dec@(DataD _ _ _ _ _)         = dec
+normalizeDec (NewtypeD cxt nm vars con xs) = DataD cxt nm vars [con] xs
+
+normalizeCon :: Con -> Con
+normalizeCon con@(NormalC _ _)     = con
+normalizeCon (RecC name vsts)      = NormalC name $ map (\(n,s,t) -> (s,t)) vsts
+normalizeCon (InfixC st1 name st2) = NormalC name [st1, st2]
+
+derives :: [Name] -> Q [Dec]
+derives = liftM concat . mapM derive
+
+derive :: Name -> Q [Dec]
+derive typName = deriveWith typName []
+
+deriveWith :: Name -> [Maybe String] -> Q [Dec]
+deriveWith typName conNames = do
+  xs <- deriveConWith' typName conNames
+  let consts = concatMap fst xs
+      cNames = map (Just . show . snd) xs
+  reps <- deriveRepWith typName cNames
+  return $ consts ++ reps
+
+consWithNames :: Dec -> [Maybe String] -> [(Con, Name)]
+consWithNames (normalizeDec -> DataD _ dName _ cons _) conNames = map step (zip cons conNames)
+  where
+    step (cons, name) = 
+        let c@(NormalC cName _) = normalizeCon cons 
+            altName    = mkName $ replace '.' '_' (show name) ++ "_" ++ nameBase cName
+        in (c, maybe altName mkName name)
+
+deriveRep :: Name -> Q [Dec]
+deriveRep name = deriveRepWith name (repeat Nothing)
+
+deriveRepWith :: Name -> [Maybe String] -> Q [Dec]
+deriveRepWith name conNames = do
+  TyConI info <- reify name
+  let d@(DataD cxt dName vars cons xs) = normalizeDec info
+  inst <- appsT (conT dName) (map (return . bndlToType) vars)
+  reps <- forM (consWithNames d conNames) $ \(con, nm) -> do
+    let NormalC cName sts   = normalizeCon con
+        varOrRec n | n == inst = AppT (ConT ''Rec) n
+                   | otherwise = AppT (ConT ''Var) n
+        repType | null sts  = return $ ConT ''U
+                | otherwise = return $ foldr1 (op ''(:*:)) . map (varOrRec . snd) $ sts
+    appT (appT (conT ''C) (conT nm)) repType
+  tySyn <- tySynInstD ''Rep [return inst] $ return $ foldr1 (op ''(:+:)) reps
+  exps <- buildQ (foldr1 (op ''(:+:)) reps) :: Q [([Name], Exp)]
+  pats <- buildQ (foldr1 (op ''(:+:)) reps) :: Q [([Name], Pat)]
+  let from = funD (mkName "from") $ zipWith mkFrom cons exps
+      to   = funD (mkName "to") $ zipWith mkTo pats cons
+  dec <- instanceD (return cxt) (appT (conT ''Representable) (return inst)) [return tySyn, from, to]
+  return [dec]
+  
+
+deriveCon :: Name -> Q [Dec]
+deriveCon name = deriveConWith name (repeat Nothing)
+
+deriveConWith :: Name -> [Maybe String] -> Q [Dec]
+deriveConWith name' conNames = liftM (concatMap fst) $ deriveConWith' name' conNames
+
+deriveConWith' :: Name -> [Maybe String] -> Q [([Dec], Name)]
+deriveConWith' name' conNames = do
+  TyConI info <- reify name'
+  let DataD cxt name vars cons' xs = normalizeDec info
+  forM (zip cons' $ conNames ++ repeat Nothing) $ \(conData, aliasName) ->do
+    let (cName, args, fixity, isRec) =
+          case conData of
+            NormalC cName args   -> (cName, args, conE 'Prefix, False)
+            RecC cName vsts      -> (cName, map (\(n,s,t) -> (s,t)) vsts, conE 'Prefix, True)
+            InfixC st1 cName st2 -> (cName, [st1, st2], appsE [conE 'Infix, conE 'NotAssociative, litE $ integerL 0], False)
+        altName    = mkName $ replace '.' '_' (show name) ++ "_" ++ nameBase cName
+        conDataName  = maybe altName mkName aliasName
+    conDataDec <- dataD (return []) conDataName [] [] []
+    cnstrType  <- appT (conT ''C) (conT conDataName)
+    conInstDec <- instanceD (return []) (appT (conT ''Constructor) (conT conDataName)) 
+                        [ funD 'conName [clause [wildP] (normalB (litE $ stringL $ show cName)) []]
+                        , funD 'conFixity [clause [wildP] (normalB $  fixity) []]
+                        , funD 'conIsRecord [clause [wildP] (normalB $ lift isRec) []]
+                        ]
+    return ([conDataDec, conInstDec], conDataName)
+
+
+bndlToType :: TyVarBndr -> Type
+bndlToType (PlainTV nm)    = nameToType nm
+bndlToType (KindedTV nm _) = nameToType nm
+nameToType name | isLower $ head (nameBase name) = VarT name
+                | otherwise                      = ConT name
+
+appsT :: TypeQ -> [TypeQ] -> TypeQ
+appsT = foldl appT
+
+replace :: Eq a => a -> a -> [a] -> [a]
+replace from to = map step
+  where
+    step c | c == from = to
+           | otherwise = c
+
+op :: Name -> Type -> Type -> Type
+op name = AppT . AppT (ConT name)
+
+class Tree a where
+    con :: Name -> [a] -> a
+    var :: Name -> a
+
+instance Tree Exp where
+    con name xs = foldl1 AppE (ConE name:xs)
+    var         = VarE
+
+instance Tree Pat where
+    con = ConP
+    var = VarP
+
+buildQ :: Tree a => Type -> Q [([Name], a)]
+buildQ (AppT (AppT (ConT c) _) ty) | c == ''C = do {(nms,bs):_ <- buildQ ty; return [(nms, con 'C [bs])]}
+buildQ (AppT (AppT (ConT c) a) b)
+    | c == ''(:+:) = do
+       (lname,l):_  <- buildQ a
+       rs <- buildQ b
+       return ((lname, con 'L [l]):map (\(n, exp) -> (n, con 'R [exp])) rs)
+    | c == ''(:*:) = do
+       ls <- buildQ a
+       rs <- buildQ b
+       return [(concatMap fst ls ++ concatMap fst rs, con '(:*:) (map snd ls ++ map snd rs))]
+buildQ (AppT (ConT c) a)
+    | c == ''Var = do
+        ((nms, l):_) <- buildQ a
+        return [(nms, con 'Var [l])] 
+    | c == ''Rec = do
+        ((nms, r):_) <-buildQ a
+        return [(nms, con 'Rec [r])]
+buildQ (ConT name) | name == ''U = return [([], con 'U [])]
+buildQ v = do
+  name <- newName "_param"
+  return [([name], var name)]
+
+mkFrom :: Con -> ([Name], Exp) -> ClauseQ
+mkFrom (normalizeCon -> NormalC cName _) (names, exp) =
+    clause [conP cName (map varP names)] (normalB $ return exp) []
+
+mkTo :: ([Name], Pat) -> Con -> ClauseQ
+mkTo (names, pat) (normalizeCon -> NormalC cName _) = 
+    clause [return pat] (normalB $ appsE (conE cName:map varE names)) []
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Hiromi ISHII
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * 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.
+
+    * Neither the name of Hiromi ISHII nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"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 COPYRIGHT
+OWNER 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/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,9 @@
+* Installation
+> cabal configure && cabal build && cabal install
+
+* Usage
+> import Generics.Instant
+> import Generics.Instant.Derive
+> 
+> derive ''Either
+> deriveWith ''() [Just "Unit_Unit"]
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/derive-IG.cabal b/derive-IG.cabal
new file mode 100644
--- /dev/null
+++ b/derive-IG.cabal
@@ -0,0 +1,38 @@
+-- derive-IG.cabal auto-generated by cabal init. For additional
+-- options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                derive-IG
+
+Version:             0.1
+Synopsis: Macro to derive instances for Instant-Generics using Template Haskell
+Description: Macro to derive instances for Instant-Generics using Template Haskell
+
+Homepage:            http://github.com/konn/derive-IG
+
+License:             BSD3
+License-file:        LICENSE
+Author:              Hiromi ISHII
+Maintainer:          Hiromi ISHII <konn.jinro _at_ gmail.com>
+
+Copyright: (c) 2010 Hiromi ISHII
+
+Category:            Data, Generics
+
+Build-type:          Simple
+
+Cabal-version:       >=1.6
+
+extra-source-files: README example/abstract.hs example/BinEncode.hs example/count.hs
+Library
+  -- Modules exported by the library.
+  Exposed-modules:     Generics.Instant.Derive
+  
+  Build-depends:       base == 4.*, template-haskell == 2.4.*, instant-generics >= 0.1
+  
+  -- Modules not exported by this package.
+  -- Other-modules:       
+  
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+  
diff --git a/example/BinEncode.hs b/example/BinEncode.hs
new file mode 100644
--- /dev/null
+++ b/example/BinEncode.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, EmptyDataDecls, TemplateHaskell #-}
+module Main where
+import Generics.Instant
+import Data.List
+import DeriveIG
+
+deriveIG ''Either
+
+class Bin a where
+    toBin :: a -> [Int]
+    fromBin :: [Int] -> (a, [Int])
+
+instance Bin U where
+    toBin   U  = []
+    fromBin xs = (U, [])
+
+instance (Bin a, Bin b) => Bin (a :+: b) where
+    toBin (L a) = 0:toBin a
+    toBin (R b) = 1:toBin b
+    fromBin (0:bin) = let (a, bin') = fromBin bin in (L a, bin')
+    fromBin (1:bin) = let (b, bin') = fromBin bin in (R b, bin')
+
+instance (Bin a, Bin b) => Bin (a :*: b) where
+    toBin (a :*: b) = toBin a ++ toBin b
+    fromBin bin     =
+      let (a, bin')  = fromBin bin
+          (b, bin'') = fromBin bin'
+      in (a :*: b, bin'')
+
+instance Bin a => Bin (Rec a) where
+    toBin (Rec r) = toBin r
+    fromBin bin   = let (r, bin') = fromBin bin in (Rec r, bin')
+
+instance Bin a => Bin (C c a) where
+    toBin (C a)  = toBin a
+    fromBin bin  = let (a, bin') = fromBin bin in (C a, bin')
+
+instance Bin a => Bin (Var a) where
+    toBin (Var a) = toBin a
+    fromBin bin   = let (x, bin') = fromBin bin in (Var x, bin')
+
+def_toBin :: (Representable a, Bin (Rep a)) => a -> [Int]
+def_toBin = toBin . from
+
+def_fromBin :: (Representable a, Bin (Rep a)) => [Int] -> (a, [Int])
+def_fromBin bin = let (rep, bin') = fromBin bin in (to rep, bin')
+
+
+instance Bin Int where
+    toBin i   = let sign   = if i < 0 then 1 else 0
+                    i'     = abs i
+                    binary = toBits i'
+                in take (bitCount + 1) (sign:binary ++ replicate bitCount 0)
+    fromBin a = let (s:as, bs) = splitAt (1+bitCount) a
+                    sign = [1, -1] !! s
+                in (sign*fromBits as, bs)
+
+instance Bin Char where
+  toBin      = take 21 . (++replicate 21 0) . toBits . fromEnum
+  fromBin bs = let (ch, bs') = splitAt 21 bs in (toEnum $ fromBits ch, bs')
+
+instance Bin a => Bin [a] where { toBin = def_toBin; fromBin = def_fromBin }
+instance Bin Bool where { toBin = def_toBin; fromBin = def_fromBin }
+instance Bin a => Bin (Maybe a) where { toBin = def_toBin; fromBin = def_fromBin }
+instance (Bin a, Bin b) => Bin (Either a b) where { toBin = def_toBin; fromBin = def_fromBin }
+instance (Bin a, Bin b) => Bin (a, b) where { toBin = def_toBin; fromBin = def_fromBin }
+
+unfoldrStep :: (b -> Bool) -> (b -> a) -> (b -> b) -> b -> Maybe (a, b)
+unfoldrStep p f g x | p x       = Nothing
+                    | otherwise = Just (f x, g x)
+
+newtype Wrap a = Wrap {unWrap :: a} deriving (Show, Eq, Ord)
+
+bitCount = ceiling $ logBase 2 $ fromIntegral (maxBound::Int)
+toBits   = unfoldr (unfoldrStep (==0) (`mod`2) (`div`2))
+fromBits = foldr (\a b -> a+2*b) 0
+
+deriveIG ''Wrap
+instance Bin a => Bin (Wrap a) where toBin = def_toBin; fromBin = def_fromBin
diff --git a/example/abstract.hs b/example/abstract.hs
new file mode 100644
--- /dev/null
+++ b/example/abstract.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE TypeOperators, EmptyDataDecls, TypeFamilies, FlexibleContexts, TemplateHaskell #-}
+module Main where
+import Generics.Instant
+import DeriveIG
+
+-- 直に木を舐めるだけの実装
+-- everywhere の用に任意の構造体中の木を舐めたければ
+-- 各所のコメントを参考にに実装してください
+data Expr = Num Int
+          | Val String
+          | Plus Expr Expr
+          | Minus Expr Expr
+          | Multi Expr Expr
+          | Div   Expr Expr
+            deriving (Show, Eq)
+
+deriveIG ''Expr
+
+class Normalize a where
+    normalize :: a -> a
+    normalize = id
+
+dft_normalize :: (Representable a, Normalize (Rep a)) => a -> a
+dft_normalize = to . normalize . from
+
+instance Normalize U
+
+-- 任意の構造中の木を舐める様にするには，Var の中も再帰的に舐める必要がある．
+-- 今回は構文木木だけを考えているので，Varの中身は舐めない．
+instance Normalize (Var a)
+
+instance (Normalize a, Normalize b) => Normalize (a :+: b) where
+    normalize (L a) = L (normalize a)
+    normalize (R b) = R (normalize b)
+
+instance (Normalize a, Normalize b) => Normalize (a :*: b) where
+    normalize (a :*: b) = normalize a :*: normalize b
+
+instance Normalize a => Normalize (Rec a) where
+    normalize (Rec a) = Rec (normalize a)
+
+instance Normalize a => Normalize (C con a) where
+    normalize (C a) = C (normalize a)
+
+{- Varの中も舐めるのなら，次の宣言が必要
+-- normalize のデフォルト定義が id なので，instance と書くだけでいい
+-- instance Normalize Int
+-- instance Normalize Char
+-- 他のデータ中の木を舐めたければ，次の宣言も追加
+-- instance Normalzie a => Normalize (Maybe a) where normalize = dft_normalize
+-- instance Normalzie a => Normalize [a] where normalize = dft_normalize
+-- etc, etc...
+-}
+
+instance Normalize Expr where
+  normalize x = case dft_normalize x of
+                  Plus (Num n) (Num m)  -> Num (n + m)
+                  Multi (Num n) (Num m) -> Num (n * m)
+                  Minus (Num n) (Num m) -> Num(n - m)
+                  Div (Num n) (Num m)   -> Num(n `div` m)
+                  x                     -> x
+
+-- 2 * (3 + 2 * 5) = 26
+tree1 = Multi (Num 2) (Plus (Num 3) (Multi (Num 2) (Num 5)))
+
+-- a * (3 + 2 * 5) = a * 13
+tree2 = Multi (Val "a") (Plus (Num 3) (Multi (Num 2) (Num 5)))
+
+tree3 = Multi (Multi (Num 2) (Plus (Num 5) (Num 2))) tree2
diff --git a/example/count.hs b/example/count.hs
new file mode 100644
--- /dev/null
+++ b/example/count.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, FlexibleContexts, OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances ,TypeSynonymInstances, TypeFamilies, TypeOperators #-}
+module Main where
+import Generics.Instant
+import Language.Haskell.TH
+import Generics.Instant.Derive
+
+data Expr = N Int
+          | V String
+          | P Expr Expr
+            deriving (Show, Eq, Ord)
+
+derive ''Expr
+deriveWith ''(,,) [Just "Triple_Con"]
+deriveWith ''()   [Just "Unit_Unit"]
+
+
+class Count a where
+    count :: a -> Int
+    count _ = 1
+
+instance Count Int
+instance Count Char
+instance Count Bool
+instance Count String
+
+instance Count U
+instance Count (C con U)
+instance Count a => Count (Var a) where
+    count (Var a) = count a
+instance (Count a, Count b) => Count (a :*: b) where
+    count (a :*: b) = count a + count b
+instance (Count a) => Count (Rec a) where
+    count (Rec a) = count a
+instance Count a => Count (C con a) where
+    count (C a) = 1 + count a
+instance (Count a, Count b) => Count (a :+: b) where
+    count (L a) = count a
+    count (R b) = count b
+
+dft_count :: (Representable a, Count (Rep a)) => a -> Int
+dft_count = count . from
+
+instance Count () where count = dft_count
+instance Count a => Count (Maybe a) where count = dft_count
+instance Count a => Count [a] where count = dft_count
+instance (Count a, Count b) => Count (a, b) where count = dft_count
+instance (Count a, Count b, Count c) => Count (a, b, c) where count = dft_count
+instance Count Expr where count = dft_count
+