diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,35 @@
+Copyright (c) 2009, David Himmelstrup
+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 David Himmelstrup 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/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/core.cabal b/core.cabal
new file mode 100644
--- /dev/null
+++ b/core.cabal
@@ -0,0 +1,17 @@
+name:                core
+version:             0.1
+synopsis:            External core parser and pretty printer.
+description:         External core parser and pretty printer.
+category:            Language
+license:             BSD3
+license-file:        LICENSE
+author:              David Himmelstrup
+maintainer:          lemmih@gmail.com
+build-Depends:       base, parsec, bytestring, pretty
+ghc-options:         
+build-type:          Simple
+hs-source-dirs:      src
+exposed-modules:     Language.Core
+                     Language.Core.Syntax
+                     Language.Core.Parser
+                     Language.Core.Pretty
diff --git a/src/Language/Core.hs b/src/Language/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Core.hs
@@ -0,0 +1,9 @@
+module Language.Core
+    ( module Language.Core.Parser
+    , module Language.Core.Syntax
+    , module Language.Core.Pretty
+    ) where
+
+import Language.Core.Parser
+import Language.Core.Syntax
+import Language.Core.Pretty
diff --git a/src/Language/Core/Parser.hs b/src/Language/Core/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Core/Parser.hs
@@ -0,0 +1,415 @@
+{-# LANGUAGE NoMonomorphismRestriction, PatternGuards #-}
+module Language.Core.Parser
+    ( parseModule
+    ) where
+
+import Data.Char
+import Data.Ratio
+import Text.ParserCombinators.Parsec
+import Control.Monad
+import Debug.Trace
+
+import Language.Core.Syntax
+import Language.Core.Pretty
+
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
+
+type LParser = GenParser (Pos Token) ()
+
+data Pos a = Pos !Int !Int a deriving Show
+
+getToken (Pos _ _ token) = token
+mkPos line col token = Pos (fromIntegral line) (fromIntegral col) token
+
+data Token
+    = Keyword String
+    | Colon
+    | DColon
+    | SColon
+    | Arrow
+    | LParen
+    | RParen
+    | LBrace
+    | RBrace
+    | Dot
+    | Equal
+    | At
+    | Star
+    | Hash
+    | Dash
+    | Percent
+    | QuestionMark
+    | Backslash
+    | Uname L.ByteString
+    | Lname L.ByteString
+    | String String
+    | Char Char
+    | Number Integer
+    deriving (Show, Eq)
+
+lexer :: L.ByteString -> [Pos Token]
+lexer = worker 1 0
+    where worker line col inp
+              = case L.uncons inp of
+                  Nothing -> []
+                  Just ('\n',cs) -> worker (line+1) 0 cs
+                  Just ('"',cs)  -> let (str,len,rest) = lex_string cs
+                                    in mkPos line col (String str) : worker line (col+len+2) rest
+                  Just ('\'',cs) -> let (char, len, rest) = lex_char cs
+                                    in mkPos line col (Char char) : worker line (col+len+2) (L.drop 1 rest)
+                  Just (c,cs)
+                      | isSpace c -> worker line (col+1) cs
+                      | Just (token,len,rest) <- findSymbol inp
+                        -> mkPos line col token : worker line (col+len) rest
+                      | isLetter c -> let (name, rest) = L.span isNameChar inp
+                                          token = if isUpper c then Uname name
+                                                               else Lname name
+                                      in mkPos line col token : worker line (col+L.length name) rest
+                      | isDigit c  -> let (digits, rest) = L.span isDigit inp
+                                          token = Number (read (L.unpack digits))
+                                      in mkPos line col token : worker line (col+L.length digits) rest
+                      | otherwise -> worker line (col+1) cs -- error $ "Unhandled: " ++ take 20 (L.unpack inp)
+
+lex_string = worker 0 ""
+    where worker len acc inp
+              = case L.uncons inp of
+                  Nothing -> error "lexer failure in string: eof"
+                  Just ('"',cs) -> (reverse acc, len, cs)
+                  _ -> let (c, l, cs) = lex_char inp
+                       in worker (len+l) (c:acc) cs
+
+lex_char inp = case L.uncons inp of
+                 Just ('\\',cs) -> case L.unpack (L.take 3 cs) of
+                                     ['x',ah,al] | all isHexDigit [ah,al]
+                                         -> (chr (digitToInt ah*16 + digitToInt al), 4, L.drop 3 cs)
+                                     _ -> error "lexer failure in string: bad hex"
+                 Just (c,cs) | c >= '\x20' && c <= '\x7E' && c `notElem` ['\x22', '\x27', '\x5C']
+                      -> (c, 1, cs)
+                 Just (c,cs) -> error $ "lexer failure in string: invalid char: " ++ show c
+
+
+isNameChar c = isUpper c || isLower c || isDigit c || c == '\''
+
+
+findSymbol inp = worker symbols
+    where worker [] = Nothing
+          worker ((str,token):xs) = if str `L.isPrefixOf` inp
+                                       then Just (token, L.length str, L.drop (L.length str) inp)
+                                       else worker xs
+
+symbols = [ (L.pack "::", DColon)
+          , (L.pack ":", Colon)
+          , (L.pack ";", SColon)
+          , (L.pack "(", LParen)
+          , (L.pack ")", RParen)
+          , (L.pack "{", LBrace)
+          , (L.pack "}", RBrace)
+          , (L.pack "->", Arrow)
+          , (L.pack ".", Dot)
+          , (L.pack "=", Equal)
+          , (L.pack "@", At)
+          , (L.pack "*", Star)
+          , (L.pack "?", QuestionMark)
+          , (L.pack "#", Hash)
+          , (L.pack "-", Dash)
+          , (L.pack "\\", Backslash)
+          , (L.pack "%module", Keyword "module")
+          , (L.pack "%data", Keyword "data")
+          , (L.pack "%newtype", Keyword "newtype")
+          , (L.pack "%rec", Keyword "rec")
+          , (L.pack "%case", Keyword "case")
+          , (L.pack "%forall", Keyword "forall")
+          , (L.pack "%let", Keyword "let")
+          , (L.pack "%note", Keyword "note")
+          , (L.pack "%external", Keyword "external")
+          , (L.pack "%dynexternal", Keyword "dynexternal")
+          , (L.pack "%label", Keyword "label")
+          , (L.pack "%_", Keyword "_")
+          , (L.pack "%cast", Keyword "cast")
+          , (L.pack "%left", Keyword "left")
+          , (L.pack "%right", Keyword "right")
+          , (L.pack "%sym", Keyword "sym")
+          , (L.pack "%unsafe", Keyword "unsafe")
+          , (L.pack "%inst", Keyword "inst")
+          , (L.pack "%trans", Keyword "trans")
+          , (L.pack "%unsafe", Keyword "unsafe")
+          , (L.pack "%of", Keyword "of")
+          , (L.pack "%in", Keyword "in")
+          , (L.pack "%", Percent)
+          ]
+
+main :: IO ()
+main = do inp <- L.readFile --"./hcr/Tuple.hcr"
+                          --"./src/ExternalCore.hcr"
+                          "../base.hcr"
+          --print (length (lexer inp))
+          --mapM_ print (lexer inp)
+          parseTest (many1 moduleP >>= \m -> notFollowedBy anyToken >> return (map ppModule m) >> return ()) (lexer inp)
+
+
+parseModule :: SourceName -> L.ByteString -> Either ParseError Module
+parseModule src inp = runParser moduleP () src (lexer inp)
+
+moduleP :: LParser Module
+moduleP = do keyword "module"
+             pkg <- pkgname
+             matchToken Colon
+             modName <- mident
+             trace (L.unpack modName) $ return ()
+             tdefs <- tdef `endBy` (matchToken SColon)
+             vdefgs <- vdefg `endBy` (matchToken SColon)
+             return $ Module (pkg,modName) tdefs vdefgs
+
+
+vdefg = choice
+        [ do keyword "rec"
+             braces $ liftM Rec (vdef `sepBy1` (matchToken SColon))
+        , do v <- vdef
+             return $ Nonrec v
+        ] <?> "vdefg"
+
+vdef = do name <- try qvar <|> do name <- lname; return (L.empty,L.empty,name)
+          matchToken DColon
+          t <- ty
+          matchToken Equal
+          e <- expP
+          return (False, name, t, e)
+       <?> "vdef"
+
+expP = choice
+       [ do fn <- aexp
+            args <- many arg
+            let app e (Left t)  = Appt e t
+                app e (Right a) = App e a
+            return $ foldl app fn args
+       , do matchToken Backslash
+            binds <- many1 binder
+            matchToken Arrow
+            e <- expP
+            return $ foldr Lam e binds
+       , do keyword "case"
+            t <- aty
+            e <- expP
+            keyword "of"
+            b <- vbind
+            alts <- braces $ alt `sepBy1` (matchToken SColon)
+            return $ Case e b t alts
+       , do keyword "cast"
+            e <- aexp
+            t <- aty
+            return $ Cast e t
+       , do keyword "let"
+            def <- vdefg
+            keyword "in"
+            e <- expP
+            return $ Let def e
+       , do keyword "note"
+            note <- stringP
+            e <- expP
+            return $ Note note e
+       , do keyword "external"
+            conv <- lname
+            target <- stringP
+            t <- aty
+            return $ External target (L.unpack conv) t
+       , do keyword "dynexternal"
+            conv <- lname
+            t <- aty
+            return $ DynExternal (L.unpack conv) t
+       , do keyword "label"
+            str <- stringP
+            return $ Label str
+       ]
+
+alt = choice [ do con <- qdcon
+                  tbinds <- many (matchToken At >> tbind)
+                  vbinds <- many vbind
+                  matchToken Arrow
+                  e <- expP
+                  return $ Acon con tbinds vbinds e
+             , do keyword "_"
+                  matchToken Arrow
+                  e <- expP
+                  return $ Adefault e
+             , do l <- lit
+                  matchToken Arrow
+                  e <- expP
+                  return $ Alit l e
+             ] <?> "alt"
+
+binder = choice
+         [ do matchToken At
+              liftM Tb tbind
+         , liftM Vb vbind
+         ] <?> "binder"
+
+arg = choice
+      [ do matchToken At
+           liftM Left aty
+      , liftM Right aexp
+      ] <?> "arg"
+
+aexp = choice
+       [ try $ liftM Dcon qdcon
+       , try $ liftM Var qvar
+       , try $ liftM Var (lname >>= \name -> return (L.empty,L.empty,name))
+       , try $ liftM Lit lit
+       , parens expP
+       ]
+
+lit = choice
+      [ try $ parens $
+        do cs <- stringP
+           matchToken DColon
+           t <- ty
+           return (Lstring cs t)
+      , try $ parens $
+        do c <- charP
+           matchToken DColon
+           t <- ty
+           return (Lchar c t)
+      , try $ parens $
+        do m <- optional (matchToken Dash)
+           ds <- number
+           matchToken DColon
+           t <- ty
+           return (Lint ds t)
+      , try $ parens $
+        do n <- number <|> parens (matchToken Dash >> number)
+           matchToken Percent
+           d <- number
+           matchToken DColon
+           t <- ty
+           return $ Lrational (n % d) t
+      ]
+
+
+
+tdef = choice [dataP, newtypeP]
+
+dataP = do keyword "data"
+           name <- qtycon
+           tbinds <- many tbind
+           matchToken Equal
+           cdefs <- braces $ cdef `sepBy` matchToken SColon
+           return $ Data name tbinds cdefs
+        <?> "dataP"
+
+newtypeP = do keyword "newtype"
+              name <- qtycon
+              coercion <- qtycon
+              tbinds <- many tbind
+              matchToken Equal
+              t <- ty
+              return $ Newtype name coercion tbinds t
+
+cdef = do name <- qdcon
+          tbinds <- many (matchToken At >> tbind)
+          tys <- many aty
+          return $ Constr name tbinds tys
+
+aty = choice
+      [ try $ liftM Tcon qtycon
+      , liftM Tvar tyvar
+      , parens ty
+      , do keyword "trans"
+           liftM2 TransCoercion aty aty
+      , do keyword "sym"
+           liftM SymCoercion aty
+      , do keyword "right"
+           liftM RightCoercion aty
+      , do keyword "left"
+           liftM LeftCoercion aty
+      , do keyword "unsafe"
+           liftM2 UnsafeCoercion aty aty
+      , do keyword "inst"
+           liftM2 InstCoercion aty aty
+      ]
+
+bty = do ts <- many1 aty
+         return $ foldl1 Tapp ts
+
+ty = choice
+     [ do keyword "forall"
+          binds <- many1 tbind
+          matchToken Dot
+          t <- ty
+          return $ foldr Tforall t binds
+     , try $ do a <- bty
+                matchToken Arrow
+                b <- ty
+                return (Tapp (Tapp (Tcon tcArrow) a) b)
+     , bty
+     ]
+
+
+tbind = choice
+        [ do var <-tyvar
+             return $ (var, Klifted)
+        , parens $
+          do var <- tyvar
+             matchToken DColon
+             k <- kind
+             return (var, k)
+        ]
+
+vbind = parens $ do v <- lname
+                    matchToken DColon
+                    t <- ty
+                    return (v,t)
+
+
+akind = choice [ matchToken Star >> return Klifted
+               , matchToken Hash >> return Kunlifted
+               , matchToken QuestionMark >> return Kopen
+               , parens $ kind ]
+
+kind = choice [ try $ do atomic <- akind
+                         matchToken Arrow
+                         k <- kind
+                         return (Karrow atomic k)
+              , akind ]
+
+tyvar = lname
+
+qdcon  = qual uname
+qtycon = qual uname
+qvar   = qual lname
+
+qual a = do pkg <- pkgname
+            matchToken Colon
+            mod <- uname
+            matchToken Dot
+            t <- a
+            return (pkg, mod, t)
+
+tycon = uname
+
+pkgname = uname <|> lname
+
+mident = uname
+
+--namechar = lower <|> upper <|> digit <|> char '\''
+
+
+movePos p (Pos l c _) _ = setSourceLine (setSourceColumn p c) l
+uname = tokenPrim (const "uname") movePos (\t -> case getToken t of Uname n -> Just n; _ -> Nothing)
+lname = tokenPrim (const "lname") movePos (\t -> case getToken t of Lname n -> Just n; _ -> Nothing)
+number = tokenPrim (const "number") movePos (\t -> case getToken t of Number n -> Just n; _ -> Nothing)
+stringP = tokenPrim (const "string") movePos (\t -> case getToken t of String n -> Just n; _ -> Nothing)
+charP = tokenPrim (const "char") movePos (\t -> case getToken t of Char n -> Just n; _ -> Nothing)
+
+matchToken token
+    = tokenPrim (const $ show token) movePos (\t -> if getToken t == token then Just () else Nothing)
+
+
+-- Utilities
+parens = between (matchToken LParen)
+                 (matchToken RParen)
+
+braces = between (matchToken LBrace)
+                 (matchToken RBrace)
+
+keyword txt = matchToken (Keyword txt)
+
diff --git a/src/Language/Core/Pretty.hs b/src/Language/Core/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Core/Pretty.hs
@@ -0,0 +1,181 @@
+module Language.Core.Pretty
+    ( ppModule
+    ) where
+
+import Language.Core.Syntax
+
+import Text.PrettyPrint
+import Data.Char
+import qualified Data.ByteString.Lazy.Char8 as L
+
+ppModule :: Module -> Doc
+ppModule (Module (pkg,mod) tdefs vdefgs)
+    = keyword "module" <+> text (L.unpack pkg) <> colon <> text (L.unpack mod) $+$
+      indent body
+    where body = types $$ definitions
+          types = endWith (char ';') $ map ppTdef tdefs
+          definitions = endWith (char ';') $ map ppVdefg vdefgs
+
+ppVdefg (Rec defs)
+    = keyword "rec" $$ braces (indent (vcat (punctuate (char ';') (map ppVdef defs))))
+ppVdefg (Nonrec def)
+    = ppVdef def
+
+ppVdef (_local, name, ty, expr)
+    = ppQual name <+> text "::" <+> ppTy ty <+> equals $$ indent (ppExp expr)
+
+ppAexp, pfexp, ppExp :: Exp -> Doc
+ppAexp (Var x) = ppQual x
+ppAexp (Dcon x) = ppQual x
+ppAexp (Lit l) = plit l
+ppAexp e = parens(ppExp e)
+
+plamexp :: [Bind] -> Exp -> Doc
+plamexp bs (Lam b e) = plamexp (bs ++ [b]) e
+plamexp bs e = sep [sep (map pbind bs) <+> text "->",
+                    indent (ppExp e)]
+
+pbind :: Bind -> Doc
+pbind (Tb tb) = char '@' <+> ppTbind tb
+pbind (Vb vb) = pvbind vb
+
+pfexp (App e1 e2) = pappexp e1 [Left e2]
+pfexp (Appt e t) = pappexp e [Right t]
+pfexp e = ppAexp e
+
+pappexp :: Exp -> [Either Exp Ty] -> Doc
+pappexp (App e1 e2) as = pappexp e1 (Left e2:as)
+pappexp (Appt e t) as = pappexp e (Right t:as)
+pappexp e as = fsep (ppAexp e : map pa as)
+           where pa (Left e) = ppAexp e
+                 pa (Right t) = char '@' <+> ppAty t
+
+ppExp (Lam b e) = char '\\' <+> plamexp [b] e
+ppExp (Let vd e) = (text "%let" <+> ppVdefg vd) $$ (text "%in" <+> ppExp e)
+ppExp (Case e vb ty alts) = sep [text "%case" <+> ppAty ty <+> ppAexp e,
+                             text "%of" <+> pvbind vb]
+                        $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
+ppExp (Cast e co) = (text "%cast" <+> parens (ppExp e)) $$ ppAty co
+ppExp (Note s e) = (text "%note" <+> pstring s) $$ ppExp e
+ppExp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ ppAty t
+ppExp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ ppAty t
+ppExp (Label n) = (text "%label" <+> pstring n)
+ppExp e = pfexp e
+
+pvbind :: Vbind -> Doc
+pvbind (x,t) = parens(text (L.unpack x) <> text "::" <> ppTy t)
+
+palt :: Alt -> Doc
+palt (Acon c tbs vbs e) =
+        sep [ppQual c, 
+             sep (map pattbind tbs),
+             sep (map pvbind vbs) <+> text "->"]
+        $$ indent (ppExp e)
+palt (Alit l e) = 
+        (plit l <+>  text "->")
+        $$ indent (ppExp e)
+palt (Adefault e) = 
+        (text "%_ ->")
+        $$ indent (ppExp e)
+
+plit :: Lit -> Doc
+plit (Lint i t) = parens (integer i <> text "::" <> ppTy t)
+-- we use (text (show r)) because "(rational r)" was printing out things
+-- like "2.0e-2" (which isn't External Core)
+plit (Lrational r t) = parens (text (show r) <>  text "::" <> ppTy t)
+plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> ppTy t)
+plit (Lstring s t) = parens (pstring s <> text "::" <> ppTy t)
+
+pstring :: String -> Doc
+pstring s = doubleQuotes(text (escape s))
+
+escape :: String -> String
+escape s = foldr f [] (map ord s)
+    where 
+     f cv rest
+        | cv > 0xFF = '\\':'x':hs ++ rest
+        | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
+         '\\':'x':h1:h0:rest
+           where (q1,r1) = quotRem cv 16
+                 h1 = intToDigit q1
+                 h0 = intToDigit r1
+                 hs = dropWhile (=='0') $ reverse $ mkHex cv
+                 mkHex 0 = ""
+                 mkHex cv = intToDigit r : mkHex q
+                    where (q,r) = quotRem cv 16
+     f cv rest = (chr cv):rest
+
+
+
+ppTdef (Data qual tbinds cdefs)
+    = (keyword "data" <+> ppQual qual <+> hsep (map ppTbind tbinds) <+> equals) $$
+      indent (braces (vcat $ punctuate (char ';') $ map ppCdef cdefs))
+ppTdef (Newtype name coercion tbinds ty)
+    = (keyword "newtype" <+> ppQual name <+> ppQual coercion <+> hsep (map ppTbind tbinds)) $$
+      indent (equals <+> ppTy ty)
+
+ppCdef (Constr qual tbinds ty)
+    = ppQual qual <+> sep (map (char '@' <+>) (map ppTbind tbinds)) <+> sep (map ppAty ty)
+
+ppTbind (var, Klifted) = text (L.unpack var)
+ppTbind (var, kind) = parens $ text (L.unpack var) <+> text "::" <+> ppKind kind
+
+pattbind (t,k) = char '@' <> ppTbind (t,k)
+
+ppKind' Klifted = char '*'
+ppKind' Kunlifted = char '#'
+ppKind' Kopen = char '?'
+ppKind' k = parens (ppKind k)
+
+ppKind (Karrow k1 k2) = parens (ppKind' k1 <> text "->" <> ppKind k2)
+--pkind (Keq t1 t2) = parens (parens (pty t1) <+> text ":=:" <+> 
+--                            parens (pty t2))
+ppKind k = ppKind' k
+
+ppAty, ppBty, ppTy :: Ty -> Doc
+ppAty (Tvar n) = text (L.unpack n)
+ppAty (Tcon c) = ppQual c
+ppAty t = parens (ppTy t)
+
+ppBty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [ppBty t1, text "->",ppTy t2])
+ppBty (Tapp t1 t2) = parens $ ppAppty t1 [t2] 
+ppBty t = ppAty t
+
+ppTy (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [ppBty t1, text "->",ppTy t2]
+ppTy (Tforall tb t) = text "%forall" <+> ppForall [tb] t
+ppTy (TransCoercion t1 t2) =
+  sep [text "%trans", ppAty t1, ppAty t2]
+ppTy (SymCoercion t) =
+  sep [text "%sym", ppAty t]
+ppTy (UnsafeCoercion t1 t2) =
+  sep [text "%unsafe", ppAty t1, ppAty t2]
+ppTy (LeftCoercion t) =
+  sep [text "%left", ppAty t]
+ppTy (RightCoercion t) =
+  sep [text "%right", ppAty t]
+ppTy (InstCoercion t1 t2) =
+  sep [text "%inst", ppAty t1, ppAty t2]
+ppTy t = ppBty t
+
+ppAppty :: Ty -> [Ty] -> Doc
+ppAppty (Tapp t1 t2) ts = ppAppty t1 (t2:ts)
+ppAppty t ts = sep (map ppAty (t:ts))
+
+ppForall :: [Tbind] -> Ty -> Doc
+ppForall tbs (Tforall tb t) = ppForall (tbs ++ [tb]) t
+ppForall tbs t = hsep (map ppTbind tbs) <+> char '.' <+> ppTy t
+
+
+
+ppQual (pkg,mod,ident)
+    | L.null pkg && L.null mod = text (L.unpack ident)
+    | otherwise = text (L.unpack pkg) <> colon <> text (L.unpack mod) <> char '.' <> text (L.unpack ident)
+
+
+-- Helpers
+
+endWith end docs = vcat (map (<> end) docs)
+
+keyword str = char '%' <> text str
+
+indent = nest 2
diff --git a/src/Language/Core/Syntax.lhs b/src/Language/Core/Syntax.lhs
new file mode 100644
--- /dev/null
+++ b/src/Language/Core/Syntax.lhs
@@ -0,0 +1,114 @@
+%
+% (c) The University of Glasgow 2001-2006
+%
+\begin{code}
+module Language.Core.Syntax where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+
+data Module
+ = Module (Pkgname, Mname) [Tdef] [Vdefg]
+   deriving (Show)
+
+data Tdef 
+  = Data (Qual Tcon) [Tbind] [Cdef]
+  | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty
+   deriving (Show)
+
+data Cdef 
+  = Constr (Qual Dcon) [Tbind] [Ty]
+  | GadtConstr (Qual Dcon) Ty
+   deriving (Show)
+
+data Vdefg 
+  = Rec [Vdef]
+  | Nonrec Vdef
+   deriving (Show)
+
+-- Top-level bindings are qualified, so that the printer doesn't have to pass
+-- around the module name.
+type Vdef = (Bool,Qual Var,Ty,Exp)
+
+data Exp 
+  = Var (Qual Var)
+  | Dcon (Qual Dcon)
+  | Lit Lit
+  | App Exp Exp
+  | Appt Exp Ty
+  | Lam Bind Exp 	  
+  | Let Vdefg Exp
+  | Case Exp Vbind Ty [Alt] {- non-empty list -}
+  | Cast Exp Ty
+  | Note String Exp
+  | External String String Ty {- target name, convention, and type -} 
+  | DynExternal String Ty {- convention and type (incl. Addr# of target as first arg) -} 
+  | Label String
+   deriving (Show)
+
+data Bind 
+  = Vb Vbind
+  | Tb Tbind
+   deriving (Show)
+
+data Alt 
+  = Acon (Qual Dcon) [Tbind] [Vbind] Exp
+  | Alit Lit Exp
+  | Adefault Exp
+   deriving (Show)
+
+type Vbind = (Var,Ty)
+type Tbind = (Tvar,Kind)
+
+data Ty 
+  = Tvar Tvar
+  | Tcon (Qual Tcon)
+  | Tapp Ty Ty
+  | Tforall Tbind Ty 
+-- We distinguish primitive coercions
+-- (represented in GHC by wired-in names), because
+-- External Core treats them specially, so we have
+-- to print them out with special syntax.
+  | TransCoercion Ty Ty
+  | SymCoercion Ty
+  | UnsafeCoercion Ty Ty
+  | InstCoercion Ty Ty
+  | LeftCoercion Ty
+  | RightCoercion Ty
+   deriving (Show)
+
+data Kind 
+  = Klifted
+  | Kunlifted
+  | Kunboxed
+  | Kopen
+  | Karrow Kind Kind
+  | Keq Ty Ty
+   deriving (Show)
+
+data Lit 
+  = Lint Integer Ty
+  | Lrational Rational Ty
+  | Lchar Char Ty
+  | Lstring String Ty
+   deriving (Show)
+  
+
+type Pkgname = Id
+type Mname = Id
+type Var = Id
+type Tvar = Id
+type Tcon = Id
+type Dcon = Id
+
+type Qual t = (Pkgname, Mname,t)
+
+type Id = L.ByteString
+
+tcArrow = (L.pack "lhc",L.pack "Lhc.Arrow",L.pack "(->)")
+
+
+\end{code}
+
+
+
+