diff --git a/Setup b/Setup
deleted file mode 100644
# file too large to diff: Setup
diff --git a/haskell-src-meta.cabal b/haskell-src-meta.cabal
--- a/haskell-src-meta.cabal
+++ b/haskell-src-meta.cabal
@@ -1,5 +1,5 @@
 name:               haskell-src-meta
-version:            0.0.3.1
+version:            0.0.4
 cabal-version:      >= 1.6
 build-type:         Simple
 license:            BSD3
@@ -14,7 +14,7 @@
                     to template-haskell abstract syntax isn't 100% complete yet.
 
 library
-  build-Depends:      base == 4.*, containers, haskell-src-exts == 0.4.*,
+  build-Depends:      base == 4.*, containers, haskell-src-exts == 1.0.*,
                       packedstring, template-haskell, pretty, syb
   extensions:         TemplateHaskell, QuasiQuotes,
                       RankNTypes, StandaloneDeriving,
@@ -32,4 +32,7 @@
                       Language.Haskell.Meta.Utils,
                       Language.Haskell.Meta.QQ.Hs,
                       Language.Haskell.Meta.QQ.Here,
-                      Language.Haskell.Meta.QQ.Vixey
+                      Language.Haskell.Meta.QQ.HsHere,
+                      Language.Haskell.Meta.QQ.Vixey,
+                      Language.Haskell.Meta.QQ.BF,
+                      Language.Haskell.Meta.QQ.SKI
diff --git a/src/Language/Haskell/Meta/Parse.hs b/src/Language/Haskell/Meta/Parse.hs
--- a/src/Language/Haskell/Meta/Parse.hs
+++ b/src/Language/Haskell/Meta/Parse.hs
@@ -14,6 +14,8 @@
 import Language.Haskell.TH.Syntax
 import Language.Haskell.Meta.Syntax
 import qualified Language.Haskell.Exts.Syntax as Hs
+import Language.Haskell.Exts.Extension
+import Language.Haskell.Exts.Fixity
 import Language.Haskell.Exts.Parser
 import Language.Haskell.Exts.Pretty
 
@@ -34,77 +36,50 @@
 parseDecs :: String -> Either String [Dec]
 parseDecs  = either Left (Right . fmap toDec) . parseHsDecls
 
-
 -----------------------------------------------------------------------------
 
--- * haskell-src-exts
-
-parseFile :: FilePath -> IO (ParseResult Hs.Module)
-parseFile fp = readFile fp >>= (return . parseFileContentsWithMode (ParseMode fp))
-
-
-parseFileContents :: String -> ParseResult Hs.Module
-parseFileContents = parseFileContentsWithMode defaultParseMode
-
-
-parseFileContentsWithMode :: ParseMode -> String -> ParseResult Hs.Module
-parseFileContentsWithMode p rawStr = parseModuleWithMode p (unlines $ map f $ lines rawStr)
-  where f ('#':_) = ""
-        f x = x
-
+myDefaultParseMode :: ParseMode
+myDefaultParseMode = ParseMode
+  {parseFilename = []
+  ,extensions = myDefaultExtensions
+  ,ignoreLanguagePragmas = False
+  ,fixities = baseFixities}
 
------------------------------------------------------------------------------
+myDefaultExtensions :: [Extension]
+myDefaultExtensions = [PostfixOperators
+                      ,QuasiQuotes
+                      ,UnicodeSyntax
+                      ,PatternSignatures
+                      ,MagicHash
+                      ,ForeignFunctionInterface
+                      ,TemplateHaskell
+                      ,RankNTypes
+                      ,MultiParamTypeClasses
+                      ,RecursiveDo]
 
+parseResultToEither :: ParseResult a -> Either String a
+parseResultToEither (ParseOk a) = Right a
+parseResultToEither (ParseFailed loc e)
+  = let line = Hs.srcLine loc - 1
+    in Left (unlines [show line,show loc,e])
 
 parseHsModule :: String -> Either String Hs.Module
-parseHsModule s =
-  case parseModule s of
-    ParseOk m -> Right m
-    ParseFailed loc e ->
-      let line = Hs.srcLine loc - 1
-      in Left (unlines [show line,show loc,e])
-
+parseHsModule = parseResultToEither . parseModuleWithMode myDefaultParseMode
 
 parseHsDecls :: String -> Either String [Hs.Decl]
-parseHsDecls s =
-  let s' = unlines [pprHsModule (emptyHsModule "Main"), s]
-  in case parseModule s' of
-      ParseOk m -> Right (moduleDecls m)
-      ParseFailed loc e ->
-        let line = Hs.srcLine loc - 1
-        in Left (unlines [show line,show loc,e])
+parseHsDecls = either Left (Right . moduleDecls)
+  . parseResultToEither . parseModuleWithMode myDefaultParseMode
 
 
 parseHsType :: String -> Either String Hs.Type
-parseHsType s =
-  case parseHsDecls ("zomg::\n" ++ (unlines
-                      . fmap ("  "++) . lines $ s ++"\n  =()")) of
-    Left err -> Left err
-    Right xs ->
-      case [ t | Hs.PatBind _ _ (Just t) _ _ <- xs] of
-        []    -> Left "invalid type"
-        (t:_) -> Right t
+parseHsType = parseResultToEither . parseTypeWithMode myDefaultParseMode
 
 
 parseHsExp :: String -> Either String Hs.Exp
-parseHsExp s =
-  case parseHsDecls ("main =\n" ++ (unlines . fmap ("  "++) . lines $ s)) of
-    Left err -> Left err
-    Right xs ->
-      case [ e | Hs.PatBind _ _ _ (Hs.UnGuardedRhs e) _ <- xs] of
-        []    -> Left "invalid expression"
-        (e:_) -> Right e
-
+parseHsExp = parseResultToEither . parseExpWithMode myDefaultParseMode
 
 parseHsPat :: String -> Either String Hs.Pat
-parseHsPat s =
-  case parseHsDecls ("("++(filter (/='\n') s)++")=()") of
-    Left err -> Left err
-    Right xs ->
-      case [ p | Hs.PatBind _ p _ _ _ <- xs] of
-        []    -> Left "invalid pattern"
-        (p:_) -> Right p
-
+parseHsPat = parseResultToEither . parsePatWithMode myDefaultParseMode
 
 pprHsModule :: Hs.Module -> String
 pprHsModule = prettyPrint
@@ -113,14 +88,11 @@
 moduleDecls :: Hs.Module -> [Hs.Decl]
 moduleDecls (Hs.Module _ _ _ _ _ _ x) = x
 
-
 -- mkModule :: String -> Hs.Module
 -- mkModule s = Hs.Module undefined (Hs.ModuleName s) Nothing [] []
 
-
 emptySrcLoc :: Hs.SrcLoc
 emptySrcLoc = (Hs.SrcLoc [] 0 0)
-
 
 emptyHsModule :: String -> Hs.Module
 emptyHsModule n =
diff --git a/src/Language/Haskell/Meta/QQ/BF.hs b/src/Language/Haskell/Meta/QQ/BF.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/BF.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE BangPatterns, TemplateHaskell #-}
+
+module Language.Haskell.Meta.QQ.BF (
+   bf,bf2,bfHelloWorld
+) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+
+import Data.Char
+import Data.IntMap(IntMap,(!))
+import qualified Data.IntMap as IM
+
+
+bf :: QuasiQuoter
+bf = QuasiQuoter bfExpQ bfPatQ
+
+bf2 :: QuasiQuoter
+bf2 = QuasiQuoter bf2ExpQ bfPatQ
+
+bf2ExpQ :: String -> ExpQ
+bf2ExpQ s = [|eval (parse s)|]
+
+bfExpQ :: String -> ExpQ
+bfExpQ s = [|eval_ (parse s)|]
+
+bfPatQ :: String -> PatQ
+bfPatQ s = do
+  let p = (parsePat
+            . show
+              . parse) s
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+instance Lift Bf where
+  lift Inp = [|Inp|]
+  lift Out = [|Out|]
+  lift Inc = [|Inc|]
+  lift Dec = [|Dec|]
+  lift MovL = [|MovL|]
+  lift MovR = [|MovR|]
+  lift (While xs) = [|While $(lift xs)|]
+
+type Ptr = Int
+newtype Mem = Mem (IntMap Int) deriving (Show)
+
+data Bf = Inp
+        | Out
+        | Inc
+        | Dec
+        | MovL
+        | MovR
+        | While [Bf]
+  deriving (Eq,Ord,Read,Show)
+
+data Status = D Ptr Mem
+            | W Int Status
+            | R (Int -> Status)
+
+-- ghci> exec (parse helloWorld)
+-- Hello World!
+-- (4,Mem (fromList [(0,0),(1,87),(2,100),(3,33),(4,10)]))
+bfHelloWorld :: String
+bfHelloWorld = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
+
+eval_ :: [Bf] -> (String -> String)
+eval_ is = go (run 0 initMem is)
+  where go (D p m)    _    = []
+        go (W n s)    cs   = chr n : go s cs
+        go (R cont)   []   = "*** Exception: bf blocked on input"
+        go (R cont) (c:cs) = go ((cont . ord) c) cs
+
+eval :: [Bf] -> String -> (String, (Ptr, Mem))
+eval is = go [] (run 0 initMem is)
+  where go acc (D p m)    _    = (reverse acc, (p, m))
+        go acc (W n s)    cs   = go (chr n:acc) s cs
+        go _   (R cont)   []   = ("*** Exception: bf blocked on input",(-1, Mem IM.empty))
+        go acc (R cont) (c:cs) = go acc ((cont . ord) c) cs
+
+exec :: [Bf] -> IO (Ptr, Mem)
+exec is = go (run 0 initMem is)
+  where go (D p m)  = return (p, m)
+        go (W n s)  = putChar (chr n) >> go s
+        go (R cont) = go . cont . ord =<< getChar
+
+run :: Ptr -> Mem -> [Bf] -> Status
+run dp m is = step dp m is (\dp m -> D dp m)
+
+step :: Ptr -> Mem -> [Bf] -> (Ptr -> Mem -> Status) -> Status
+step dp m   []          k = k dp m
+step dp m (Inc:is)      k = step dp (inc dp m) is k
+step dp m (Dec:is)      k = step dp (dec dp m) is k
+step dp m (MovL:is)     k = step (dp-1) m is k
+step dp m (MovR:is)     k = step (dp+1) m is k
+step dp m (Inp:is)      k = R (\c -> step dp (wr m dp c) is k)
+step dp m (Out:is)      k = W (rd m dp) (step dp m is k)
+step dp m (While xs:is) k = let go dp m = if rd m dp == 0
+                                            then step dp m is k
+                                            else step dp m xs go
+                            in go dp m
+
+initMem :: Mem
+initMem = Mem IM.empty
+
+inc :: Ptr -> (Mem -> Mem)
+dec :: Ptr -> (Mem -> Mem)
+rd :: Mem -> Ptr -> Int
+wr :: Mem -> Ptr -> Int -> Mem
+upd :: Mem -> Ptr -> (Int -> Int) -> Mem
+inc p m = upd m p (+1)
+dec p m = upd m p (subtract 1)
+rd (Mem m) p = maybe 0 id (IM.lookup p m)
+wr (Mem m) p n = Mem (IM.insert p n m)
+upd m p f = wr m p (f (rd m p))
+
+parse :: String -> [Bf]
+parse s = go 0 [] s (\_ xs _ -> xs)
+  where go :: Int -> [Bf] -> String
+          -> (Int -> [Bf] -> String -> o) -> o
+        go !n acc   []     k = k n (reverse acc) []
+        go !n acc (',':cs) k = go (n+1) (Inp:acc) cs k
+        go !n acc ('.':cs) k = go (n+1) (Out:acc) cs k
+        go !n acc ('+':cs) k = go (n+1) (Inc:acc) cs k
+        go !n acc ('-':cs) k = go (n+1) (Dec:acc) cs k
+        go !n acc ('<':cs) k = go (n+1) (MovL:acc) cs k
+        go !n acc ('>':cs) k = go (n+1) (MovR:acc) cs k
+        go !n acc ('[':cs) k = go (n+1) [] cs (\n xs cs ->
+                                go n (While xs:acc) cs k)
+        go !n acc (']':cs) k = k (n+1) (reverse acc) cs
+        go !n acc (c  :cs) k = go n acc cs k
+
+
+
+test0 = do
+  a <- readFile "prime.bf"
+  return (parse a)
+
+
+
+
+
+
+
+{-
+data Bf = Inp
+        | Out
+        | Inc
+        | Dec
+        | MovL
+        | MovR
+        | While [Bf]
+        | Error String
+  deriving (Eq,Ord,Read,Show)
+
+parse :: String -> [Bf]
+parse s = let p n s = case go n [] s of
+                        (_,xs,[]) -> xs
+                        (n,xs, s) -> xs ++ p n s
+          in p 0 s
+  where go :: Int -> [Bf] -> [Char] -> (Int, [Bf], String)
+        go !n acc   []     = (n, reverse acc, [])
+        go !n acc (',':cs) = go (n+1) (Inp:acc) cs
+        go !n acc ('.':cs) = go (n+1) (Out:acc) cs
+        go !n acc ('+':cs) = go (n+1) (Inc:acc) cs
+        go !n acc ('-':cs) = go (n+1) (Dec:acc) cs
+        go !n acc ('<':cs) = go (n+1) (MovL:acc) cs
+        go !n acc ('>':cs) = go (n+1) (MovR:acc) cs
+        go !n acc ('[':cs) = case go (n+1) [] cs of
+                                (n,xs,cs) -> go n (While xs:acc) cs
+        go !n acc (']':cs) = (n+1, reverse acc, cs)
+        go !n acc (c  :cs) = (n+1, [Error ("go error: char "++show n
+                                    ++" illegal character: "++show c)], [])
+-}
+
+
+
+
+
+
diff --git a/src/Language/Haskell/Meta/QQ/HsHere.hs b/src/Language/Haskell/Meta/QQ/HsHere.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/HsHere.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+
+module Language.Haskell.Meta.QQ.HsHere (here) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Utils
+import Text.ParserCombinators.ReadP
+import Data.Typeable(Typeable)
+import Data.Generics(Data)
+
+data Here
+  = CodeH Exp
+  | TextH String
+  | ManyH [Here]
+  deriving (Eq,Show,Data,Typeable)
+
+here :: QuasiQuoter
+here = QuasiQuoter
+        {quoteExp = hereExpQ
+        ,quotePat = herePatQ}
+
+instance Lift Here
+  where lift = liftHere
+
+liftHere :: Here -> ExpQ
+liftHere (TextH s)  = (litE . stringL) s
+liftHere (CodeH e)  = [|show $(return e)|]
+liftHere (ManyH hs) = [|concat $(listE (fmap liftHere hs))|]
+
+
+hereExpQ :: String -> ExpQ
+hereExpQ s = case run s of
+              [] -> fail "here: parse error"
+              e:_ -> lift (cleanNames e)
+
+herePatQ :: String -> PatQ
+herePatQ s = do
+  e <- hereExpQ s
+  let p = (parsePat
+            . pprint
+              . cleanNames) e
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+run :: String -> [Here]
+run = fst . parse
+
+parse :: String -> ([Here], String)
+parse = runP hereP
+
+hereP :: ReadP Here
+hereP = (ManyH . mergeTexts)
+  `fmap` many (oneP =<< look)
+
+mergeTexts :: [Here] -> [Here]
+mergeTexts [] = []
+mergeTexts (TextH s:TextH t:hs)
+  = mergeTexts (TextH (s++t):hs)
+mergeTexts (h:hs) = h : mergeTexts hs
+
+oneP :: String -> ReadP Here
+oneP s
+  | [] <- s         = pfail
+  | '\\':'$':s <- s = do skip 2
+                         (TextH . ("\\$"++))
+                          `fmap` munch (/='\\')
+  | '$':'(':s <- s  = skip 2 >> go 1 [] s
+  | c:s <- s        = do skip 1
+                         (TextH . (c:))
+                          `fmap` munch (not.(`elem`"\\$"))
+  where go _ acc  []         = return (TextH (reverse acc))
+        go 1 []  (')':_) = skip 1 >> return (TextH "$()")
+        go 1 acc (')':_) = do skip (1 + length acc)
+                              let s = reverse acc
+                              either (const (return
+                                              (TextH s)))
+                                     (return . CodeH)
+                                     (parseExp s)
+        go n acc ('(':s)     = go (n+1) ('[':acc) s
+        go n acc (')':s)     = go (n-1) (']':acc) s
+        go n acc (c:s)       = go n (c:acc) s
+
+
+runP :: ReadP a -> String -> ([a], String)
+runP p s = case readP_to_S p s of
+              [] -> ([],[])
+              xs -> mapfst (:[]) (last xs)
+  where mapfst f (a,b) = (f a,b)
+skip :: Int -> ReadP ()
+skip n = count n get >> return ()
+lexemeP :: ReadP a -> ReadP a
+lexemeP p = p >>= \x -> skipSpaces >> return x
+nestedP :: (ReadP a -> ReadP a) -> (ReadP a -> ReadP a)
+nestedP nest p = p <++ nest (skipSpaces >> nestedP nest p)
+parensP  = between oparenP cparenP
+bracksP  = between oparenP cparenP
+oparenP  = char '('
+cparenP  = char ')'
+obrackP  = char '['
+cbrackP  = char ']'
+
diff --git a/src/Language/Haskell/Meta/QQ/SKI.hs b/src/Language/Haskell/Meta/QQ/SKI.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/SKI.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+
+module Language.Haskell.Meta.QQ.SKI (SKI(..),ski) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Utils
+import Text.ParserCombinators.ReadP
+import Data.Typeable(Typeable)
+import Data.Generics(Data)
+import Text.PrettyPrint(render)
+
+data SKI = S | K | I | E Exp | SKI :$ SKI
+  deriving (Eq,Data,Typeable)
+
+run :: String -> [SKI]
+run = fmap eval . fst . parse
+
+-- I x = x
+-- K x y = x
+-- S x y z = (x z) (y z)
+eval :: SKI -> SKI
+eval (I :$ x)               = eval x
+eval ((K :$ x) :$ y)        = eval x
+eval (((S :$ x) :$ y :$ z)) = eval (eval (x :$ z) :$ eval (y :$ z))
+eval (E e :$ E e')          = E (unQ[|$(return e) $(return e')|])
+eval (x :$ y)               = eval0 ((eval x) :$ (eval y))
+eval  x                     = x
+eval0 (I :$ x)               = eval x
+eval0 ((K :$ x) :$ y)        = eval x
+eval0 (((S :$ x) :$ y :$ z)) = eval (eval (x :$ z) :$ eval (y :$ z))
+eval0 (E e :$ E e')          = E (unQ[|$(return e) $(return e')|])
+eval0  x                     = x
+
+ski :: QuasiQuoter
+ski = QuasiQuoter
+        {quoteExp = skiExpQ
+        ,quotePat = skiPatQ}
+
+instance Lift SKI where
+  lift = liftSKI
+
+liftSKI (E e) = return e
+liftSKI a     = go a
+  where go S = [|S|]
+        go K = [|K|]
+        go I = [|I|]
+        go (E e) = [|E e|]
+        go (x:$y) = [|$(go x) :$ $(go y)|]
+
+instance Show SKI where
+        showsPrec p (S) = showString "S"
+        showsPrec p (K) = showString "K"
+        showsPrec p (I) = showString "I"
+        showsPrec p (E x1)
+          = showParen (p > 10)
+              (showString (render (ppDoc x1)))
+        showsPrec p ((:$) x1 x2)
+          = showParen (p > 10)
+              (showsPrec 11 x1 . (showString " :$ " . showsPrec 10 x2))
+
+skiExpQ :: String -> ExpQ
+skiExpQ s = case run s of
+              [] -> fail "ski: parse error"
+              e:_ -> lift (cleanNames e)
+
+skiPatQ :: String -> PatQ
+skiPatQ s = do
+  e <- skiExpQ s
+  let p = (parsePat
+            . pprint
+              . cleanNames) e
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+-- ghci> parse "S(SS)IK(SK)"
+-- ([(((S :$ (S :$ S)) :$ I) :$ K) :$ (S :$ K)],"")
+parse :: String -> ([SKI], String)
+parse = runP skiP
+
+skiP :: ReadP SKI
+skiP = nestedP parensP
+  (let go a = (do b <- lexemeP (oneP <++ skiP)
+                  go (a:$b)) <++ return a
+    in lexemeP (go =<< lexemeP oneP))
+
+oneP :: ReadP SKI
+oneP = nestedP parensP
+  (lexemeP (choice [sP
+                   ,kP
+                   ,iP
+                   ,spliceP =<< look
+                   ]))
+
+spliceP :: String -> ReadP SKI
+spliceP s
+  | '[':s <- s = skip 1 >> go 1 [] s
+  | otherwise  = pfail
+  where go _ _   []         = pfail
+        go 1 acc (']':_) = do skip (1 + length acc)
+                              either (const pfail)
+                                     (return . E)
+                                     (parseExp (reverse acc))
+        go n acc ('[':s)     = go (n+1) ('[':acc) s
+        go n acc (']':s)     = go (n-1) (']':acc) s
+        go n acc (c:s)       = go n (c:acc) s
+
+
+
+sP = (char 's' +++ char 'S') >> return S
+kP = (char 'k' +++ char 'K') >> return K
+iP = (char 'i' +++ char 'I') >> return I
+
+runP :: ReadP a -> String -> ([a], String)
+runP p s = case readP_to_S p s of
+              [] -> ([],[])
+              xs -> mapfst (:[]) (last xs)
+  where mapfst f (a,b) = (f a,b)
+skip :: Int -> ReadP ()
+skip n = count n get >> return ()
+lexemeP :: ReadP a -> ReadP a
+lexemeP p = p >>= \x -> skipSpaces >> return x
+nestedP :: (ReadP a -> ReadP a) -> (ReadP a -> ReadP a)
+nestedP nest p = p <++ nest (skipSpaces >> nestedP nest p)
+parensP  = between oparenP cparenP
+bracksP  = between oparenP cparenP
+oparenP  = char '('
+cparenP  = char ')'
+obrackP  = char '['
+cbrackP  = char ']'
+
+
+
+
+{-
+import Prelude hiding (($))
+data Komb = S (Maybe (Komb, Maybe Komb)) | K (Maybe Komb) deriving Show
+S Nothing $ x = S (Just (x, Nothing))
+S (Just (x, Nothing)) $ y = S (Just (x, Just y))
+S (Just (x, Just y)) $ z = x $ z $ (y $ z)
+K Nothing $ x = K (Just x)
+K (Just x) $ y = y
+q x = x $ (c $ k) $ k $ k $ s
+ where s = S Nothing
+       k = K Nothing
+       c = s $ (b $ b $ s) $ k $ k
+       b = s $ (k $ s) $ k
+-}
+
+
+
diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs
--- a/src/Language/Haskell/Meta/Syntax/Translate.hs
+++ b/src/Language/Haskell/Meta/Syntax/Translate.hs
@@ -102,7 +102,7 @@
   toName Hs.UnitCon = '()
   toName Hs.ListCon = '[]
   toName Hs.FunCon  = ''(->)
-  toName (Hs.TupleCon n)
+  toName (Hs.TupleCon _ n)
     | n<2 = '()
     | otherwise =
       let x = maybe [] (++".") (nameModule '())
@@ -184,6 +184,7 @@
 
 
 
+
 instance ToExp Hs.Exp where
 {-
 data HsExp
@@ -303,16 +304,19 @@
 instance ToType Hs.Type where
   toType (Hs.TyForall tvbM cxt t) = ForallT (maybe [] (fmap toName) tvbM) (fmap toType cxt) (toType t)
   toType (Hs.TyFun a b) = toType a .->. toType b
+  toType (Hs.TyList t) = ListT `AppT` toType t
   toType (Hs.TyTuple _ ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)
   toType (Hs.TyApp a b) = AppT (toType a) (toType b)
   toType (Hs.TyVar n) = VarT (toName n)
   toType (Hs.TyCon qn) = ConT (toName qn)
-  toType a@(Hs.TyPred _) = error $ errorMsg "toType" a
-
+  toType (Hs.TyParen t) = toType t
   -- XXX: need to wrap the name in parens!
-  toType (Hs.TyInfix a qn b) = foldAppT (ConT . toName $ qn) (fmap toType [a,b])
+  toType (Hs.TyInfix a o b) = AppT (AppT (ConT (toName o)) (toType a)) (toType b)
   toType (Hs.TyKind t _) = toType t
 
+
+
+
 (.->.) :: Type -> Type -> Type
 a .->. b = AppT (AppT ArrowT a) b
 
@@ -370,22 +374,48 @@
 -}
 
 instance ToDec Hs.Decl where
-  toDec (Hs.TypeDecl _ n ns t) = TySynD (toName n) (fmap toName ns) (toType t)
-  toDec a@(Hs.DataDecl  _ dOrN cxt n ns qcds qns) = error $ errorMsg "toDec" a
-{-
-data HsQualConDecl
-    = HsQualConDecl SrcLoc 
-        [HsTyVarBind] HsContext
-         HsConDecl
--}
-{-
-    case dOrN of
-      DataType -> DataD
-                    (fmap toType cxt)
-                    (toName n)
-                    (fmap toName ns)
-      NewType  ->
--}
+  toDec (Hs.TypeDecl _ n ns t)
+    = TySynD (toName n) (fmap toName ns) (toType t)
+
+
+  toDec a@(Hs.DataDecl  _ dOrN cxt n ns qcds qns)
+    = case dOrN of
+        Hs.DataType -> DataD (fmap toType cxt)
+                              (toName n)
+                              (fmap toName ns)
+                              (fmap qualConDeclToCon qcds)
+                              (fmap (toName . fst) qns)
+        Hs.NewType  -> let qcd = case qcds of
+                                  x:_ -> x
+                                  _   -> error "toDec: Newtype has no constructors!"
+                        in NewtypeD (fmap toType cxt)
+                                    (toName n)
+                                    (fmap toName ns)
+                                    (qualConDeclToCon qcd)
+                                    (fmap (toName . fst) qns)
+
+-- data Hs.BangType
+--   = Hs.BangedTy Hs.Type
+--   | Hs.UnBangedTy Hs.Type
+--   | Hs.UnpackedTy Hs.Type
+-- data Hs.TyVarBind
+--   = Hs.KindedVar Hs.Name Hs.Kind | Hs.UnkindedVar Hs.Name
+-- data Hs.DataOrNew = Hs.DataType | Hs.NewType
+-- data Hs.QualConDecl
+--   = Hs.QualConDecl Hs.SrcLoc [Hs.TyVarBind] Hs.Context Hs.ConDecl
+-- data Hs.ConDecl
+--   = Hs.ConDecl Hs.Name [Hs.BangType]
+--   | Hs.RecDecl Hs.Name [([Hs.Name], Hs.BangType)]
+
+-- data Con
+--   = NormalC Name [StrictType]
+--   | RecC Name [VarStrictType]
+--   | InfixC StrictType Name StrictType
+--   | ForallC [Name] Cxt Con
+-- type StrictType = (Strict, Type)
+-- type VarStrictType = (Name, Strict, Type)
+
+
   toDec a@(Hs.GDataDecl _ dOrN cxt n ns kM gadtDecs _) = error $ errorMsg "toDec" a
   toDec a@(Hs.TypeFamDecl _ n ns kM)                   = error $ errorMsg "toDec" a
   toDec a@(Hs.DataFamDecl _ cxt n ns kM)               = error $ errorMsg "toDec" a
@@ -399,7 +429,12 @@
   toDec a@(Hs.DerivDecl _ cxt qn ts)                   = error $ errorMsg "toDec" a  
   toDec a@(Hs.DefaultDecl _ ts)                        = error $ errorMsg "toDec" a
   toDec a@(Hs.SpliceDecl _ s)                          = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeSig _ ns t)                          = error $ errorMsg "toDec" a
+  toDec a@(Hs.TypeSig _ ns t)
+    -- XXXXXXXXXXXXXX: oh crap, we can't return a [Dec] from this class!
+    = let xs = fmap (flip SigD (toType t) . toName) ns
+      in case xs of x:_ -> x; [] -> error "toDec: malformed TypeSig!"
+
+
 {- data HsDecl = ... | HsFunBind [HsMatch] | ...
 data HsMatch = HsMatch SrcLoc HsName [HsPat] HsRhs HsBinds
 data Dec = FunD Name [Clause] | ...
@@ -417,6 +452,43 @@
   toDec a@(Hs.ForImp _ cconv safe str n t)             = error $ errorMsg "toDec" a
   toDec a@(Hs.ForExp _ cconv      str n t)             = error $ errorMsg "toDec" a
 
+
+
+
+-- data Hs.Decl = ... | Hs.SpliceDecl Hs.SrcLoc Hs.Splice | ...
+-- data Hs.Splice = Hs.IdSplice String | Hs.ParenSplice Hs.Exp
+
+
+
+
+
+
+
+
+
+
+qualConDeclToCon :: Hs.QualConDecl -> Con
+qualConDeclToCon (Hs.QualConDecl _ [] [] cdecl) = conDeclToCon cdecl
+qualConDeclToCon (Hs.QualConDecl _ ns cxt cdecl) = ForallC (fmap toName ns)
+                                                    (fmap toType cxt)
+                                                    (conDeclToCon cdecl)
+
+conDeclToCon :: Hs.ConDecl -> Con
+conDeclToCon (Hs.ConDecl n tys)
+  = NormalC (toName n) (fmap bangToStrictType tys)
+conDeclToCon (Hs.RecDecl n lbls)
+  = RecC (toName n) (concatMap (uncurry bangToVarStrictTypes) lbls)
+
+
+
+bangToVarStrictTypes :: [Hs.Name] -> Hs.BangType -> [VarStrictType]
+bangToVarStrictTypes ns t = let (a,b) = bangToStrictType t
+                            in fmap (\n->(toName n,a,b)) ns
+
+bangToStrictType :: Hs.BangType -> StrictType
+bangToStrictType (Hs.BangedTy   t) = (IsStrict, toType t)
+bangToStrictType (Hs.UnBangedTy t) = (NotStrict, toType t)
+bangToStrictType (Hs.UnpackedTy t) = (IsStrict, toType t)
 
 
 hsMatchesToFunD :: [Hs.Match] -> Dec