diff --git a/examples/failing/Eff.purs b/examples/failing/Eff.purs
new file mode 100644
--- /dev/null
+++ b/examples/failing/Eff.purs
@@ -0,0 +1,12 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+import Control.Monad.ST
+import Debug.Trace
+
+test = pureST (do
+         ref <- newSTRef 0
+         trace "ST"
+         modifySTRef ref $ \n -> n + 1
+         readSTRef ref)
diff --git a/examples/failing/UnderscoreModuleName.purs b/examples/failing/UnderscoreModuleName.purs
new file mode 100644
--- /dev/null
+++ b/examples/failing/UnderscoreModuleName.purs
@@ -0,0 +1,3 @@
+module Bad_Module where
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/CaseInDo.purs b/examples/passing/CaseInDo.purs
new file mode 100644
--- /dev/null
+++ b/examples/passing/CaseInDo.purs
@@ -0,0 +1,20 @@
+module Main where
+
+import Debug.Trace
+import Control.Monad.Eff
+
+foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit
+
+foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean
+
+set = do
+  trace "Testing..."
+  case 0 of
+    0 -> doIt
+    _ -> return unit
+
+main = do
+  set
+  b <- get
+  case b of
+    true -> trace "Done"
diff --git a/examples/passing/Eff.purs b/examples/passing/Eff.purs
--- a/examples/passing/Eff.purs
+++ b/examples/passing/Eff.purs
@@ -14,6 +14,12 @@
           modifySTRef ref $ \n -> n + 1
           readSTRef ref))
 
+test3 = pureST (do
+          ref <- newSTRef 0
+          modifySTRef ref $ \n -> n + 1
+          readSTRef ref)
+
 main = do
   test1
   Debug.Trace.print test2
+  Debug.Trace.print test3
diff --git a/examples/passing/ForeignInstance.purs b/examples/passing/ForeignInstance.purs
--- a/examples/passing/ForeignInstance.purs
+++ b/examples/passing/ForeignInstance.purs
@@ -9,6 +9,10 @@
 
 foreign import instance fooString :: Foo String
 
+foreign import fooString "var fooString = {};" :: Unit
+foreign import fooNumber "var fooNumber = {};" :: Unit
+foreign import fooArray "var fooArray = {};" :: Unit
+
 test1 _ = foo [1, 2, 3]
 
 test2 _ = foo "Test"
diff --git a/examples/passing/Objects.purs b/examples/passing/Objects.purs
--- a/examples/passing/Objects.purs
+++ b/examples/passing/Objects.purs
@@ -26,5 +26,10 @@
 
   test5 = case { "***": 1 } of
     { "***" = n } -> n
+
+  test6 = case { "***": 1 } of
+               { "***": n } -> n
+
+  test7 {a:    snoog , b     : blah } = blah
     
   main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TypeWildcardsRecordExtension.purs b/examples/passing/TypeWildcardsRecordExtension.purs
new file mode 100644
--- /dev/null
+++ b/examples/passing/TypeWildcardsRecordExtension.purs
@@ -0,0 +1,6 @@
+module Main where
+    
+foo :: forall a. {b :: Number | a} -> {b :: Number | _}
+foo f = f
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/UnderscoreIdent.purs b/examples/passing/UnderscoreIdent.purs
new file mode 100644
--- /dev/null
+++ b/examples/passing/UnderscoreIdent.purs
@@ -0,0 +1,9 @@
+module Main where
+
+data Data_type = Con_Structor | Con_2 String
+
+type Type_name = Data_type
+
+done (Con_2 s) = s
+
+main = Debug.Trace.trace (done (Con_2 "Done"))
diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs
--- a/hierarchy/Main.hs
+++ b/hierarchy/Main.hs
@@ -55,9 +55,9 @@
 runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
 
 readInput :: FilePath -> IO (Either Par.ParseError [P.Module])
-readInput p = do
-  text <- U.readFile p
-  return $ P.runIndentParser p P.parseModules text
+readInput filename = do
+  content <- U.readFile filename
+  return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]
 
 compile :: HierarchyOptions -> IO ()
 compile (HierarchyOptions input mOutput) = do
@@ -84,7 +84,7 @@
 superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
   fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
 superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
-superClasses (P.PositionedDeclaration _ decl) = superClasses decl
+superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
 superClasses _ = []
 
 inputFile :: Parser FilePath
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -915,3 +915,5 @@
                        \  return f;\
                        \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
 
+  pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
+  pureST st = runPure (runST st)
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
--- a/psc-docs/Main.hs
+++ b/psc-docs/Main.hs
@@ -75,8 +75,8 @@
   mapM_ (renderModule showHierarchy) ms
 
 renderModule :: Bool -> P.Module -> Docs
-renderModule showHierarchy (P.Module moduleName ds exps) =
-  let exported = filter (isExported exps) ds
+renderModule showHierarchy mdl@(P.Module moduleName _ exps) =
+  let ds = P.exportedDeclarations mdl
       hasTypes = any isTypeDeclaration ds
       hasTypeclasses = any isTypeClassDeclaration ds
       hasTypeclassInstances = any isTypeInstanceDeclaration ds
@@ -87,7 +87,7 @@
     when hasTypes $ do
       headerLevel 3 "Types"
       spacer
-      renderTopLevel exps (filter isTypeDeclaration exported)
+      renderTopLevel exps (filter isTypeDeclaration ds)
       spacer
     when hasTypeclasses $ do
       headerLevel 3 "Type Classes"
@@ -95,7 +95,7 @@
       when showHierarchy $ do
         renderTypeclassImage moduleName
         spacer
-      renderTopLevel exps (filter isTypeClassDeclaration exported)
+      renderTopLevel exps (filter isTypeClassDeclaration ds)
       spacer
     when hasTypeclassInstances $ do
       headerLevel 3 "Type Class Instances"
@@ -105,34 +105,9 @@
     when hasValues $ do
       headerLevel 3 "Values"
       spacer
-      renderTopLevel exps (filter isValueDeclaration exported)
+      renderTopLevel exps (filter isValueDeclaration ds)
       spacer
 
-isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
-isExported Nothing _ = True
-isExported _ P.TypeInstanceDeclaration{} = True
-isExported exps (P.PositionedDeclaration _ d) = isExported exps d
-isExported (Just exps) decl = any (matches decl) exps
-  where
-  matches (P.TypeDeclaration ident _) (P.ValueRef ident') = ident == ident'
-  matches (P.ExternDeclaration _ ident _ _) (P.ValueRef ident') = ident == ident'
-  matches (P.DataDeclaration _ ident _ _) (P.TypeRef ident' _) = ident == ident'
-  matches (P.ExternDataDeclaration ident _) (P.TypeRef ident' _) = ident == ident'
-  matches (P.TypeSynonymDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
-  matches (P.TypeClassDeclaration ident _ _ _) (P.TypeClassRef ident') = ident == ident'
-  matches (P.PositionedDeclaration _ d) r = d `matches` r
-  matches d (P.PositionedDeclarationRef _ r) = d `matches` r
-  matches _ _ = False
-
-isDctorExported :: P.ProperName -> Maybe [P.DeclarationRef] -> P.ProperName -> Bool
-isDctorExported _ Nothing _ = True
-isDctorExported ident (Just exps) ctor = test `any` exps
-  where
-  test (P.PositionedDeclarationRef _ d) = test d
-  test (P.TypeRef ident' Nothing) = ident == ident'
-  test (P.TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
-  test _ = False
-
 renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
 renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
   renderDeclaration 4 exps decl
@@ -152,7 +127,7 @@
   let
     typeApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
     typeName = prettyPrintType' typeApp
-    exported = filter (isDctorExported name exps . fst) ctors
+    exported = filter (P.isDctorExported name exps . fst) ctors
   atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
   forM_ exported $ \(ctor, tys) ->
     let ctorTy = foldr P.function typeApp tys
@@ -177,10 +152,20 @@
                           [] -> ""
                           cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
   atIndent n $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
-renderDeclaration n exps (P.PositionedDeclaration _ d) =
+renderDeclaration n exps (P.PositionedDeclaration _ com d) = do
+  renderComments n com
+  spacer
   renderDeclaration n exps d
 renderDeclaration _ _ _ = return ()
 
+renderComments :: Int -> [P.Comment] -> Docs
+renderComments n cs = mapM_ (atIndent n) ls
+  where
+  ls = concatMap toLines cs
+  
+  toLines (P.LineComment s) = [s]
+  toLines (P.BlockComment s) = lines s
+
 toTypeVar :: (String, Maybe P.Kind) -> P.Type
 toTypeVar (s, Nothing) = P.TypeVar s
 toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
@@ -201,30 +186,30 @@
 getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name
 getName (P.TypeClassDeclaration name _ _ _) = P.runProperName name
 getName (P.TypeInstanceDeclaration name _ _ _ _) = show name
-getName (P.PositionedDeclaration _ d) = getName d
+getName (P.PositionedDeclaration _ _ d) = getName d
 getName _ = error "Invalid argument to getName"
 
 isValueDeclaration :: P.Declaration -> Bool
 isValueDeclaration P.TypeDeclaration{} = True
 isValueDeclaration P.ExternDeclaration{} = True
-isValueDeclaration (P.PositionedDeclaration _ d) = isValueDeclaration d
+isValueDeclaration (P.PositionedDeclaration _ _ d) = isValueDeclaration d
 isValueDeclaration _ = False
 
 isTypeDeclaration :: P.Declaration -> Bool
 isTypeDeclaration P.DataDeclaration{} = True
 isTypeDeclaration P.ExternDataDeclaration{} = True
 isTypeDeclaration P.TypeSynonymDeclaration{} = True
-isTypeDeclaration (P.PositionedDeclaration _ d) = isTypeDeclaration d
+isTypeDeclaration (P.PositionedDeclaration _ _ d) = isTypeDeclaration d
 isTypeDeclaration _ = False
 
 isTypeClassDeclaration :: P.Declaration -> Bool
 isTypeClassDeclaration P.TypeClassDeclaration{} = True
-isTypeClassDeclaration (P.PositionedDeclaration _ d) = isTypeClassDeclaration d
+isTypeClassDeclaration (P.PositionedDeclaration _ _ d) = isTypeClassDeclaration d
 isTypeClassDeclaration _ = False
 
 isTypeInstanceDeclaration :: P.Declaration -> Bool
 isTypeInstanceDeclaration P.TypeInstanceDeclaration{} = True
-isTypeInstanceDeclaration (P.PositionedDeclaration _ d) = isTypeInstanceDeclaration d
+isTypeInstanceDeclaration (P.PositionedDeclaration _ _ d) = isTypeInstanceDeclaration d
 isTypeInstanceDeclaration _ = False
 
 inputFile :: Parser FilePath
@@ -244,8 +229,10 @@
 main :: IO ()
 main = execParser opts >>= docgen
   where
-  opts        = info (helper <*> pscDocsOptions) infoModList
+  opts        = info (version <*> helper <*> pscDocsOptions) infoModList
   infoModList = fullDesc <> headerInfo <> footerInfo
   headerInfo  = header   "psc-docs - Generate Markdown documentation from PureScript extern files"
   footerInfo  = footer $ "psc-docs " ++ showVersion Paths.version
-
+  
+  version :: Parser (a -> a)
+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
--- a/psc-make/Main.hs
+++ b/psc-make/Main.hs
@@ -162,8 +162,10 @@
 main :: IO ()
 main = execParser opts >>= compile
   where
-  opts        = info (helper <*> pscMakeOptions) infoModList
+  opts        = info (version <*> helper <*> pscMakeOptions) infoModList
   infoModList = fullDesc <> headerInfo <> footerInfo
   headerInfo  = header   "psc-make - Compiles PureScript to Javascript"
   footerInfo  = footer $ "psc-make " ++ showVersion Paths.version
-
+  
+  version :: Parser (a -> a)
+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
diff --git a/psc/Main.hs b/psc/Main.hs
--- a/psc/Main.hs
+++ b/psc/Main.hs
@@ -192,8 +192,11 @@
 main :: IO ()
 main = execParser opts >>= compile
   where
-  opts        = info (helper <*> pscOptions) infoModList
+  opts        = info (version <*> helper <*> pscOptions) infoModList
   infoModList = fullDesc <> headerInfo <> footerInfo
   headerInfo  = header   "psc - Compiles PureScript to Javascript"
   footerInfo  = footer $ "psc " ++ showVersion Paths.version
+  
+  version :: Parser (a -> a)
+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
 
diff --git a/psci/Commands.hs b/psci/Commands.hs
--- a/psci/Commands.hs
+++ b/psci/Commands.hs
@@ -69,16 +69,19 @@
 -- |
 -- The help menu.
 --
-help :: [[String]]
+help :: [(String, String, String)]
 help =
-  [ [":?          ", "Show this help menu"]
-  , [":i <module> ", "Import <module> for use in PSCI"]
-  , [":b <module> ", "Browse <module>"]
-  , [":m <file>   ", "Load <file> for importing"]
-  , [":q          ", "Quit PSCi"]
-  , [":r          ", "Reset"]
-  , [":s import   ", "Show imported modules"]
-  , [":s loaded   ", "Show loaded modules"]
-  , [":t <expr>   ", "Show the type of <expr>"]
-  , [":k <type>   ", "Show the kind of <type>"]
+  [ (":?", "",         "Show this help menu")
+  , (":i", "<module>", "Import <module> for use in PSCI")
+  , (":b", "<module>", "Browse <module>")
+  , (":m", "<file>",   "Load <file> for importing")
+  , (":q", "",         "Quit PSCi")
+  , (":r", "",         "Reset")
+  , (":s", "import",   "Show imported modules")
+  , (":s", "loaded",   "Show loaded modules")
+  , (":t", "<expr>",   "Show the type of <expr>")
+  , (":k", "<type>",   "Show the kind of <type>")
   ]
+
+commands :: [String]
+commands = map (\ (a, _, _) -> a) help
diff --git a/psci/Main.hs b/psci/Main.hs
--- a/psci/Main.hs
+++ b/psci/Main.hs
@@ -22,6 +22,7 @@
 import Data.Maybe (mapMaybe)
 import Data.Traversable (traverse)
 import Data.Version (showVersion)
+import Data.Char (isSpace)
 import qualified Data.Map as M
 
 import Control.Applicative
@@ -127,7 +128,9 @@
 -- Loads a file for use with imports.
 --
 loadModule :: FilePath -> IO (Either String [P.Module])
-loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename
+loadModule filename = do
+  content <- U.readFile filename
+  return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
 
 -- |
 -- Load all modules, including the Prelude
@@ -153,7 +156,9 @@
 --
 helpMessage :: String
 helpMessage = "The following commands are available:\n\n    " ++
-  intercalate "\n    " (map (intercalate "    ") C.help)
+  intercalate "\n    " (map line C.help)
+  where line :: (String, String, String) -> String
+        line (cmd, arg, desc) = intercalate " " [cmd, arg, replicate (11 - length arg) ' ', desc]
 
 -- |
 -- The welcome prologue.
@@ -180,37 +185,120 @@
 
 -- Haskeline completions
 
+data CompletionContext = Command String | FilePath String | Module | Identifier
+                       | Type | Fixed [String] | Multiple [CompletionContext]
+                         deriving (Show)
+
 -- |
+-- Decide what kind of completion we need based on input.
+completionContext :: String -> String -> Maybe CompletionContext
+completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]
+completionContext cmd@(':' : _ ) _
+  | cmd `elem` C.commands || cmd == ":" = Just $ Command cmd
+completionContext (':' : c : _) word = case c of
+  'i' -> Just Module
+  'b' -> Just Module
+  'm' -> Just $ FilePath word
+  'q' -> Nothing
+  'r' -> Nothing
+  '?' -> Nothing
+  's' -> Just $ Fixed ["import", "loaded"]
+  't' -> Just Identifier
+  'k' -> Just Type
+  _   -> Nothing
+completionContext _ _ = Just Identifier
+
+-- |
 -- Loads module, function, and file completions.
 --
 completion :: CompletionFunc (StateT PSCiState IO)
-completion = completeWord Nothing " \t\n\r" findCompletions
+completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
   where
-  findCompletions :: String -> StateT PSCiState IO [Completion]
-  findCompletions st = do
-    ms <- map snd . psciLoadedModules <$> get
-    files <- listFiles st
-    let matches = filter (isPrefixOf st) (names ms)
-    return $ sortBy sorter $ map simpleCompletion matches ++ files
-  getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
-  getDeclName Nothing (P.ValueDeclaration ident _ _ _) = Just ident
-  getDeclName (Just exts) (P.ValueDeclaration ident _ _ _) | isExported = Just ident
-    where
-    isExported = any exports exts
-    exports (P.ValueRef ident') = ident == ident'
-    exports (P.PositionedDeclarationRef _ r) = exports r
-    exports _ = False
-  getDeclName exts (P.PositionedDeclaration _ d) = getDeclName exts d
-  getDeclName _ _ = Nothing
-  names :: [P.Module] -> [String]
-  names ms = nub [ show qual
-              | P.Module moduleName ds exts <- ms
-              , ident <- mapMaybe (getDeclName exts) ds
-              , qual <- [ P.Qualified Nothing ident
-                        , P.Qualified (Just moduleName) ident]
-              ]
+  findCompletions :: String -> String -> StateT PSCiState IO [Completion]
+  findCompletions prev word = do
+    let ctx = completionContext ((dropWhile isSpace (reverse prev)) ++ word) word
+    completions <- case ctx of
+      Nothing -> return []
+      (Just c) -> (mapMaybe $ either (\cand -> if word `isPrefixOf` cand
+                                               then Just $ simpleCompletion cand
+                                               else Nothing) Just)
+                  <$> getCompletion c
+    return $ sortBy sorter completions
+
+  getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]
+  getCompletion (Command s) = return $ (map Left) $ nub $ filter (isPrefixOf s) C.commands
+  getCompletion (FilePath f) = (map Right) <$> listFiles f
+  getCompletion Module = (map Left) <$> getModuleNames
+  getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)
+  getCompletion Type = (map Left) <$> getTypeNames
+  getCompletion (Fixed list) = return $ (map Left) list
+  getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts
+
+  getLoadedModules :: StateT PSCiState IO [P.Module]
+  getLoadedModules = map snd . psciLoadedModules <$> get
+
+  getModuleNames :: StateT PSCiState IO [String]
+  getModuleNames = moduleNames <$> getLoadedModules
+
+  mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [a]) -> StateT PSCiState IO [String]
+  mapLoadedModulesAndQualify f = do
+    ms <- getLoadedModules
+    q <- sequence [qualifyIfNeeded m (f m) | m <- ms]
+    return $ concat q
+
+  getIdentNames :: StateT PSCiState IO [String]
+  getIdentNames = mapLoadedModulesAndQualify identNames
+
+  getDctorNames :: StateT PSCiState IO [String]
+  getDctorNames = mapLoadedModulesAndQualify dctorNames
+
+  getTypeNames :: StateT PSCiState IO [String]
+  getTypeNames = mapLoadedModulesAndQualify typeDecls
+
+  qualifyIfNeeded :: (Show a) => P.Module -> [a] -> StateT PSCiState IO [String]
+  qualifyIfNeeded m decls = do
+    let name = P.getModuleName m
+    imported <- psciImportedModuleNames <$> get
+    let qualified = map (P.Qualified $ Just name) decls
+    if name `elem` imported then
+        return $ map show $ qualified ++ (map (P.Qualified Nothing) decls)
+    else
+        return $ map show qualified
+
+  typeDecls :: P.Module -> [N.ProperName]
+  typeDecls m = mapMaybe getTypeName $ filter P.isDataDecl (P.exportedDeclarations m)
+      where getTypeName :: P.Declaration -> Maybe N.ProperName
+            getTypeName (P.TypeSynonymDeclaration name _ _) = Just name
+            getTypeName (P.DataDeclaration _ name _ _) = Just name
+            getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
+            getTypeName _ = Nothing
+
+  identNames :: P.Module -> [N.Ident]
+  identNames (P.Module _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]
+    where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
+          getDeclName exts decl@(P.ValueDeclaration ident _ _ _)  | P.isExported exts decl = Just ident
+          getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident
+          getDeclName exts (P.PositionedDeclaration _ _ d) = getDeclName exts d
+          getDeclName _ _ = Nothing
+
+  dctorNames :: P.Module -> [N.ProperName]
+  dctorNames m = nub $ concat $ map (P.exportedDctors m) dnames
+    where getDataDeclName :: P.Declaration -> Maybe N.ProperName
+          getDataDeclName (P.DataDeclaration _ name _ _) = Just name
+          getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d
+          getDataDeclName _ = Nothing
+
+          dnames :: [N.ProperName]
+          dnames = (mapMaybe getDataDeclName onlyDataDecls)
+
+          onlyDataDecls :: [P.Declaration]
+          onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
+
+  moduleNames :: [P.Module] -> [String]
+  moduleNames ms = nub [show moduleName | P.Module moduleName _ _ <- ms]
+
   sorter :: Completion -> Completion -> Ordering
-  sorter (Completion _ d1 _) (Completion _ d2 _) = compare d1 d2
+  sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2
 
 -- Compilation
 
@@ -441,7 +529,7 @@
 -- |
 -- Parses the input and returns either a Metacommand or an expression.
 --
-getCommand :: Bool -> InputT (StateT PSCiState IO) (Either Par.ParseError (Maybe Command))
+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
 getCommand singleLineMode = do
   firstLine <- getInputLine "> "
   case firstLine of
@@ -519,7 +607,7 @@
         go = do
           c <- getCommand singleLineMode
           case c of
-            Left err -> outputStrLn (show err) >> go
+            Left err -> outputStrLn err >> go
             Right Nothing -> go
             Right (Just Quit) -> outputStrLn quitMessage
             Right (Just c') -> runPSCI (handleCommand c') >> go
@@ -541,8 +629,10 @@
 main :: IO ()
 main = execParser opts >>= loop
   where
-  opts        = info (helper <*> psciOptions) infoModList
+  opts        = info (version <*> helper <*> psciOptions) infoModList
   infoModList = fullDesc <> headerInfo <> footerInfo
   headerInfo  = header   "psci - Interactive mode for PureScript"
   footerInfo  = footer $ "psci " ++ showVersion Paths.version
 
+  version :: Parser (a -> a)
+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
diff --git a/psci/Parser.hs b/psci/Parser.hs
--- a/psci/Parser.hs
+++ b/psci/Parser.hs
@@ -17,6 +17,8 @@
     parseCommand
   ) where
 
+import Prelude hiding (lex)
+
 import Commands
 
 import Data.Char (isSpace)
@@ -29,84 +31,52 @@
 import qualified Language.PureScript.Parser.Common as C (mark, same)
 
 -- |
--- PSCI version of @let@.
--- This is essentially let from do-notation.
--- However, since we don't support the @Eff@ monad,
--- we actually want the normal @let@.
---
-psciLet :: Parsec String P.ParseState Command
-psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C.same *> P.parseDeclaration))))
-
--- |
 -- Parses PSCI metacommands or expressions input from the user.
 --
-parseCommand :: String -> Either ParseError Command
-parseCommand = P.runIndentParser "" $ choice
-                    [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf <|> psciBrowse <|> psciShowModules)
-                    , try psciLet
-                    , psciExpression
-                    ] <* eof
-
--- |
--- Parses expressions entered at the PSCI repl.
---
-psciExpression :: Parsec String P.ParseState Command
-psciExpression = Expression <$> P.parseValue
-
--- |
--- Parses 'Commands.Help' command.
---
-psciHelp :: Parsec String P.ParseState Command
-psciHelp = Help <$ char '?'
-
--- |
--- Parses 'Commands.Import' command.
---
-psciImport :: Parsec String P.ParseState Command
-psciImport = Import <$> (char 'i' *> P.whiteSpace *> P.moduleName)
-
--- |
--- Parses 'Commands.LoadFile' command.
---
-psciLoadFile :: Parsec String P.ParseState Command
-psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> P.whiteSpace *> manyTill anyChar eof)
-
--- | Trim end of input string
-trimEnd :: String -> String
-trimEnd = reverse . dropWhile isSpace . reverse
-
--- |
--- Parses 'Commands.Quit' command.
---
-psciQuit :: Parsec String P.ParseState Command
-psciQuit = Quit <$ char 'q'
-
--- |
--- Parses 'Commands.Reload' command.
---
-psciReload :: Parsec String P.ParseState Command
-psciReload = Reset <$ char 'r'
-
--- |
--- Parses 'Commands.TypeOf' command.
---
-psciTypeOf :: Parsec String P.ParseState Command
-psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
-
-
--- |
--- Parses 'Commands.KindOf' command.
---
-psciKindOf :: Parsec String P.ParseState Command
-psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)
+parseCommand :: String -> Either String Command
+parseCommand cmdString = 
+  case splitCommand cmdString of 
+    Just ('?', _) -> return Help
+    Just ('q', _) -> return Quit
+    Just ('r', _) -> return Reset
+    Just ('i', moduleName) -> Import <$> parseRest P.moduleName moduleName
+    Just ('b', moduleName) -> Browse <$> parseRest P.moduleName moduleName
+    Just ('m', filename) -> return $ LoadFile (trimEnd filename)
+    Just ('s', command) -> return $ Show (trimEnd command)
+    Just ('t', expr) -> TypeOf <$> parseRest P.parseValue expr
+    Just ('k', ty) -> KindOf <$> parseRest P.parseType ty
+    Just _ -> Left $ "Unrecognized command. Type :? for help."
+    Nothing -> parseRest (psciLet <|> psciExpression) cmdString
+  where
+  parseRest :: P.TokenParser a -> String -> Either String a
+  parseRest p s = either (Left . show) Right $ do
+    ts <- P.lex "" s
+    P.runTokenParser "" (p <* eof) ts
+  
+  trimEnd :: String -> String
+  trimEnd = reverse . dropWhile isSpace . reverse
 
--- |
--- Parses 'Commands.Browse' command.
---
-psciBrowse :: Parsec String P.ParseState Command
-psciBrowse = Browse <$> (char 'b' *> P.whiteSpace *> P.moduleName)
+  -- |
+  -- Split a command into a command char and the trailing string
+  --
+  splitCommand :: String -> Maybe (Char, String)
+  splitCommand (':' : c : s) = Just (c, dropWhile isSpace s)
+  splitCommand _ = Nothing
 
--- |
--- Show Command
-psciShowModules :: Parsec String P.ParseState Command
-psciShowModules = Show . trimEnd <$> (char 's' *> P.whiteSpace *> manyTill anyChar eof)
+  -- |
+  -- Parses expressions entered at the PSCI repl.
+  --
+  psciExpression :: P.TokenParser Command
+  psciExpression = Expression <$> P.parseValue
+  
+  -- |
+  -- PSCI version of @let@.
+  -- This is essentially let from do-notation.
+  -- However, since we don't support the @Eff@ monad,
+  -- we actually want the normal @let@.
+  --
+  psciLet :: P.TokenParser Command
+  psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> manyDecls))
+    where
+    manyDecls :: P.TokenParser [P.Declaration]
+    manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))
diff --git a/purescript.cabal b/purescript.cabal
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.6.2
+version: 0.6.3
 cabal-version: >=1.8
 build-type: Simple
 license: MIT
@@ -45,26 +45,37 @@
                      Language.PureScript.AST.SourcePos
                      Language.PureScript.AST.Traversals
                      Language.PureScript.CodeGen
-                     Language.PureScript.CodeGen.Common
                      Language.PureScript.CodeGen.Externs
                      Language.PureScript.CodeGen.JS
                      Language.PureScript.CodeGen.JS.AST
+                     Language.PureScript.CodeGen.JS.Common
+                     Language.PureScript.CodeGen.JS.Optimizer
+                     Language.PureScript.CodeGen.JS.Optimizer.Blocks
+                     Language.PureScript.CodeGen.JS.Optimizer.Common
+                     Language.PureScript.CodeGen.JS.Optimizer.Inliner
+                     Language.PureScript.CodeGen.JS.Optimizer.MagicDo
+                     Language.PureScript.CodeGen.JS.Optimizer.TCO
+                     Language.PureScript.CodeGen.JS.Optimizer.Unused
                      Language.PureScript.Constants
+                     Language.PureScript.CoreFn
+                     Language.PureScript.CoreFn.Ann
+                     Language.PureScript.CoreFn.Binders
+                     Language.PureScript.CoreFn.Desugar
+                     Language.PureScript.CoreFn.Expr
+                     Language.PureScript.CoreFn.Literals
+                     Language.PureScript.CoreFn.Meta
+                     Language.PureScript.CoreFn.Module
+                     Language.PureScript.CoreFn.Traversals
+                     Language.PureScript.Comments
                      Language.PureScript.DeadCodeElimination
                      Language.PureScript.Environment
                      Language.PureScript.Errors
                      Language.PureScript.Kinds
                      Language.PureScript.ModuleDependencies
                      Language.PureScript.Names
-                     Language.PureScript.Optimizer
-                     Language.PureScript.Optimizer.Blocks
-                     Language.PureScript.Optimizer.Common
-                     Language.PureScript.Optimizer.Inliner
-                     Language.PureScript.Optimizer.MagicDo
-                     Language.PureScript.Optimizer.TCO
-                     Language.PureScript.Optimizer.Unused
                      Language.PureScript.Options
                      Language.PureScript.Parser
+                     Language.PureScript.Parser.Lexer
                      Language.PureScript.Parser.Common
                      Language.PureScript.Parser.Declarations
                      Language.PureScript.Parser.Kinds
@@ -103,58 +114,58 @@
     buildable: True
     hs-source-dirs: src
     other-modules: Paths_purescript
-    ghc-options: -Wall -O2
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
 
 executable psc
-    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, 
-                   mtl -any, optparse-applicative -any, parsec -any, purescript -any,
+    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
+                   mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
                    transformers -any, utf8-string -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc
     other-modules:
-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
 
 executable psc-make
-    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, 
-                   mtl -any, optparse-applicative -any, parsec -any, purescript -any, 
+    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
+                   mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
                    transformers -any, utf8-string -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc-make
     other-modules:
-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
 
 executable psci
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
-                   mtl -any, optparse-applicative -any, parsec -any, 
-                   haskeline >= 0.7.0.0, purescript -any, transformers -any, 
+                   mtl -any, optparse-applicative >= 0.10.0, parsec -any,
+                   haskeline >= 0.7.0.0, purescript -any, transformers -any,
                    utf8-string -any, process -any
-                   
+
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psci
     other-modules: Commands
                    Parser
-    ghc-options: -Wall -O2
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
 
 executable psc-docs
     build-depends: base >=4 && <5, purescript -any, utf8-string -any,
-                   optparse-applicative -any, process -any, mtl -any
+                   optparse-applicative >= 0.10.0, process -any, mtl -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc-docs
     other-modules:
-    ghc-options: -Wall -O2
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
 
 executable hierarchy
-    build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative -any,
+    build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0,
                    process -any, mtl -any, parsec -any, filepath -any, directory -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: hierarchy
     other-modules:
-    ghc-options: -Wall -O2
+    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
 
 test-suite tests
     build-depends: base >=4 && <5, containers -any, directory -any,
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 --
 -- Module      :  Language.PureScript
--- Copyright   :  (c) Phil Freeman 2013
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
 -- License     :  MIT
 --
 -- Maintainer  :  Phil Freeman <paf31@cantab.net>
@@ -17,42 +17,41 @@
 
 module Language.PureScript (module P, compile, compile', RebuildPolicy(..), MonadMake(..), make, prelude) where
 
-import Language.PureScript.Types as P
-import Language.PureScript.Kinds as P
+import Data.FileEmbed (embedFile)
+import Data.Function (on)
+import Data.List (sortBy, groupBy, intercalate)
+import Data.Maybe (fromMaybe)
+import Data.Time.Clock
+import qualified Data.ByteString.UTF8 as BU
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import Control.Applicative
+import Control.Arrow ((&&&))
+import Control.Monad.Error
+
+import System.FilePath ((</>))
+
 import Language.PureScript.AST as P
+import Language.PureScript.Comments as P
+import Language.PureScript.CodeGen as P
+import Language.PureScript.DeadCodeElimination as P
+import Language.PureScript.Environment as P
+import Language.PureScript.Errors as P
+import Language.PureScript.Kinds as P
+import Language.PureScript.ModuleDependencies as P
 import Language.PureScript.Names as P
+import Language.PureScript.Options as P
 import Language.PureScript.Parser as P
-import Language.PureScript.CodeGen as P
-import Language.PureScript.CodeGen.Common as P
-import Language.PureScript.TypeChecker as P
 import Language.PureScript.Pretty as P
+import Language.PureScript.Renamer as P
 import Language.PureScript.Sugar as P
-import Language.PureScript.Options as P
-import Language.PureScript.ModuleDependencies as P
-import Language.PureScript.Environment as P
-import Language.PureScript.Errors as P
-import Language.PureScript.DeadCodeElimination as P
 import Language.PureScript.Supply as P
-import Language.PureScript.Renamer as P
-
+import Language.PureScript.TypeChecker as P
+import Language.PureScript.Types as P
+import qualified Language.PureScript.CoreFn as CoreFn
 import qualified Language.PureScript.Constants as C
 
-import Data.List (sortBy, groupBy, intercalate)
-import Data.Time.Clock
-import Data.Function (on)
-import Data.Maybe (fromMaybe)
-import Data.FileEmbed (embedFile)
-
-import Control.Monad.Error
-import Control.Arrow ((&&&))
-import Control.Applicative
-
-import qualified Data.Map as M
-import qualified Data.Set as S
-import qualified Data.ByteString.UTF8 as BU
-
-import System.FilePath ((</>))
-
 -- |
 -- Compile a collection of modules
 --
@@ -77,17 +76,18 @@
 
 compile' :: Environment -> Options Compile -> [Module] -> [String] -> Either String (String, String, Environment)
 compile' env opts ms prefix = do
-  (sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else (map importPrelude ms)
+  (sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else map importPrelude ms
   (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted
   (elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent
   regrouped <- stringifyErrorStack True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
+  let corefn = map (CoreFn.moduleToCoreFn env') regrouped
   let entryPoints = moduleNameFromString `map` entryPointModules (optionsAdditional opts)
-  let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped
+  let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
   let renamed = renameInModules elim
   let codeGenModuleNames = moduleNameFromString `map` codeGenModules (optionsAdditional opts)
-  let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModuleNames) renamed
-  let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs opts m env') modulesToCodeGen
-  let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen
+  let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
+  let js = evalSupply nextVar $ concat <$> mapM (moduleToJs opts) modulesToCodeGen
+  let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
   js' <- generateMain env' opts js
   let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']
   return (pjs, exts, env')
@@ -156,7 +156,7 @@
 make outputDir opts ms prefix = do
   let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
 
-  (sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)
+  (sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else map (importPrelude . snd) ms
 
   toRebuild <- foldM (\s (Module moduleName' _ _) -> do
     let filePath = runModuleName moduleName'
@@ -199,11 +199,12 @@
     regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
 
     let mod' = Module moduleName' regrouped exps
-    let [renamed] = renameInModules [mod']
+    let corefn = CoreFn.moduleToCoreFn env' mod'
+    let [renamed] = renameInModules [corefn]
 
-    pjs <- prettyPrintJS <$> moduleToJs opts renamed env'
+    pjs <- prettyPrintJS <$> moduleToJs opts renamed
     let js = unlines $ map ("// " ++) prefix ++ [pjs]
-    let exts = unlines $ map ("-- " ++ ) prefix ++ [moduleToPs renamed env']
+    let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
 
     lift $ writeTextFile jsFile js
     lift $ writeTextFile externsFile exts
@@ -219,7 +220,7 @@
   rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
     let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
     externs <- readTextFile externsFile
-    externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
+    externsModules <- liftError . fmap (map snd) . either (Left . show) Right $ P.parseModulesFromFiles id [(externsFile, externs)]
     case externsModules of
       [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
       _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
@@ -239,7 +240,7 @@
   else Module mn (ImportDeclaration toImport Unqualified Nothing : decls) exps
   where
   isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
-  isExistingImport (PositionedDeclaration _ d) = isExistingImport d
+  isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
   isExistingImport _ = False
 
 importPrim :: Module -> Module
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
--- a/src/Language/PureScript/AST/Binders.hs
+++ b/src/Language/PureScript/AST/Binders.hs
@@ -20,6 +20,7 @@
 
 import Language.PureScript.AST.SourcePos
 import Language.PureScript.Names
+import Language.PureScript.Comments
 
 -- |
 -- Data type for binders
@@ -68,7 +69,7 @@
   -- |
   -- A binder with source position information
   --
-  | PositionedBinder SourceSpan Binder deriving (Show, D.Data, D.Typeable)
+  | PositionedBinder SourceSpan [Comment] Binder deriving (Show, D.Data, D.Typeable)
 
 -- |
 -- Collect all names introduced in binders in an expression
@@ -82,5 +83,5 @@
   go ns (ArrayBinder bs) = foldl go ns bs
   go ns (ConsBinder b1 b2) = go (go ns b1) b2
   go ns (NamedBinder name b) = go (name : ns) b
-  go ns (PositionedBinder _ b) = go ns b
+  go ns (PositionedBinder _ _ b) = go ns b
   go ns _ = ns
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -25,6 +25,7 @@
 import Language.PureScript.Names
 import Language.PureScript.Kinds
 import Language.PureScript.TypeClassDictionaries
+import Language.PureScript.Comments
 import Language.PureScript.CodeGen.JS.AST
 import Language.PureScript.Environment
 
@@ -34,7 +35,58 @@
 --
 data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
 
+-- | Return a module's name.
+getModuleName :: Module -> ModuleName
+getModuleName (Module name _ _) = name
+
 -- |
+-- Test if a declaration is exported, given a module's export list.
+--
+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
+isExported Nothing _ = True
+isExported _ TypeInstanceDeclaration{} = True
+isExported exps (PositionedDeclaration _ _ d) = isExported exps d
+isExported (Just exps) decl = any (matches decl) exps
+  where
+  matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
+  matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
+  matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
+  matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
+  matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
+  matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
+  matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
+  matches (PositionedDeclaration _ _ d) r = d `matches` r
+  matches d (PositionedDeclarationRef _ _ r) = d `matches` r
+  matches _ _ = False
+
+exportedDeclarations :: Module -> [Declaration]
+exportedDeclarations (Module _ decls exps) = filter (isExported exps) (flattenDecls decls)
+
+-- |
+-- Test if a data constructor for a given type is exported, given a module's export list.
+--
+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
+isDctorExported _ Nothing _ = True
+isDctorExported ident (Just exps) ctor = test `any` exps
+  where
+  test (PositionedDeclarationRef _ _ d) = test d
+  test (TypeRef ident' Nothing) = ident == ident'
+  test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
+  test _ = False
+
+-- |
+-- Return the exported data constructors for a given type.
+--
+exportedDctors :: Module -> ProperName -> [ProperName]
+exportedDctors (Module _ decls exps) ident =
+  filter (isDctorExported ident exps) dctors
+  where
+  dctors = concatMap getDctors (flattenDecls decls)
+  getDctors (DataDeclaration _ _ _ ctors) = map fst ctors
+  getDctors (PositionedDeclaration _ _ d) = getDctors d
+  getDctors _ = []
+
+-- |
 -- An item in a list of explicit imports or exports
 --
 data DeclarationRef
@@ -57,7 +109,7 @@
   -- |
   -- A declaration reference with source position information
   --
-  | PositionedDeclarationRef SourceSpan DeclarationRef
+  | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
   deriving (Show, D.Data, D.Typeable)
 
 instance Eq DeclarationRef where
@@ -65,8 +117,8 @@
   (ValueRef name)        == (ValueRef name')        = name == name'
   (TypeClassRef name)    == (TypeClassRef name')    = name == name'
   (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
-  (PositionedDeclarationRef _ r) == r' = r == r'
-  r == (PositionedDeclarationRef _ r') = r == r'
+  (PositionedDeclarationRef _ _ r) == r' = r == r'
+  r == (PositionedDeclarationRef _ _ r') = r == r'
   _ == _ = False
 
 -- |
@@ -126,7 +178,7 @@
   -- |
   -- A type class instance foreign import
   --
-  | ExternInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type]
+  | ExternInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type]
   -- |
   -- A fixity declaration (fixity data, operator name)
   --
@@ -138,16 +190,16 @@
   -- |
   -- A type class declaration (name, argument, implies, member declarations)
   --
-  | TypeClassDeclaration ProperName [(String, Maybe Kind)] [(Qualified ProperName, [Type])] [Declaration]
+  | TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
   -- |
   -- A type instance declaration (name, dependencies, class name, instance types, member
   -- declarations)
   --
-  | TypeInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type] [Declaration]
+  | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] [Declaration]
   -- |
   -- A declaration with source position information
   --
-  | PositionedDeclaration SourceSpan Declaration
+  | PositionedDeclaration SourceSpan [Comment] Declaration
   deriving (Show, D.Data, D.Typeable)
 
 -- |
@@ -155,7 +207,7 @@
 --
 isValueDecl :: Declaration -> Bool
 isValueDecl ValueDeclaration{} = True
-isValueDecl (PositionedDeclaration _ d) = isValueDecl d
+isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
 isValueDecl _ = False
 
 -- |
@@ -164,7 +216,7 @@
 isDataDecl :: Declaration -> Bool
 isDataDecl DataDeclaration{} = True
 isDataDecl TypeSynonymDeclaration{} = True
-isDataDecl (PositionedDeclaration _ d) = isDataDecl d
+isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
 isDataDecl _ = False
 
 -- |
@@ -172,7 +224,7 @@
 --
 isImportDecl :: Declaration -> Bool
 isImportDecl ImportDeclaration{} = True
-isImportDecl (PositionedDeclaration _ d) = isImportDecl d
+isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
 isImportDecl _ = False
 
 -- |
@@ -180,7 +232,7 @@
 --
 isExternDataDecl :: Declaration -> Bool
 isExternDataDecl ExternDataDeclaration{} = True
-isExternDataDecl (PositionedDeclaration _ d) = isExternDataDecl d
+isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
 isExternDataDecl _ = False
 
 -- |
@@ -188,7 +240,7 @@
 --
 isExternInstanceDecl :: Declaration -> Bool
 isExternInstanceDecl ExternInstanceDeclaration{} = True
-isExternInstanceDecl (PositionedDeclaration _ d) = isExternInstanceDecl d
+isExternInstanceDecl (PositionedDeclaration _ _ d) = isExternInstanceDecl d
 isExternInstanceDecl _ = False
 
 -- |
@@ -196,7 +248,7 @@
 --
 isFixityDecl :: Declaration -> Bool
 isFixityDecl FixityDeclaration{} = True
-isFixityDecl (PositionedDeclaration _ d) = isFixityDecl d
+isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
 isFixityDecl _ = False
 
 -- |
@@ -204,7 +256,7 @@
 --
 isExternDecl :: Declaration -> Bool
 isExternDecl ExternDeclaration{} = True
-isExternDecl (PositionedDeclaration _ d) = isExternDecl d
+isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
 isExternDecl _ = False
 
 -- |
@@ -213,10 +265,18 @@
 isTypeClassDeclaration :: Declaration -> Bool
 isTypeClassDeclaration TypeClassDeclaration{} = True
 isTypeClassDeclaration TypeInstanceDeclaration{} = True
-isTypeClassDeclaration (PositionedDeclaration _ d) = isTypeClassDeclaration d
+isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
 isTypeClassDeclaration _ = False
 
 -- |
+-- Recursively flatten data binding groups in the list of declarations
+flattenDecls :: [Declaration] -> [Declaration]
+flattenDecls = concatMap flattenOne
+    where flattenOne :: Declaration -> [Declaration]
+          flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
+          flattenOne d = [d]
+
+-- |
 -- A guard is just a boolean-valued expression that appears alongside a set of binders
 --
 type Guard = Expr
@@ -316,7 +376,7 @@
   -- at superclass implementations when searching for a dictionary, the type class name and
   -- instance type, and the type class dictionaries in scope.
   --
-  | TypeClassDictionary Bool (Qualified ProperName, [Type]) [TypeClassDictionaryInScope]
+  | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
   -- |
   -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
   --
@@ -324,7 +384,7 @@
   -- |
   -- A value with source position information
   --
-  | PositionedValue SourceSpan Expr deriving (Show, D.Data, D.Typeable)
+  | PositionedValue SourceSpan [Comment] Expr deriving (Show, D.Data, D.Typeable)
 
 -- |
 -- An alternative in a case statement
@@ -359,4 +419,4 @@
   -- |
   -- A do notation element with source position information
   --
-  | PositionedDoNotationElement SourceSpan DoNotationElement deriving (Show, D.Data, D.Typeable)
+  | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, D.Data, D.Typeable)
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -37,7 +37,7 @@
   f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
   f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
   f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))
-  f' (PositionedDeclaration pos d) = f (PositionedDeclaration pos (f' d))
+  f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))
   f' other = f other
 
   g' :: Expr -> Expr
@@ -56,7 +56,7 @@
   g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
   g' (Let ds v) = g (Let (map f' ds) (g' v))
   g' (Do es) = g (Do (map handleDoNotationElement es))
-  g' (PositionedValue pos v) = g (PositionedValue pos (g' v))
+  g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
   g' other = g other
 
   h' :: Binder -> Binder
@@ -65,7 +65,7 @@
   h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
   h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))
   h' (NamedBinder name b) = h (NamedBinder name (h' b))
-  h' (PositionedBinder pos b) = h (PositionedBinder pos (h' b))
+  h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
   h' other = h other
 
   handleCaseAlternative :: CaseAlternative -> CaseAlternative
@@ -78,7 +78,7 @@
   handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
   handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
   handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
-  handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos (handleDoNotationElement e)
+  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
 
 
 everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
@@ -93,7 +93,7 @@
   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
   f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds
   f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f' <=< f) ds
-  f' (PositionedDeclaration pos d) = PositionedDeclaration pos <$> (f d >>= f')
+  f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')
   f' other = f other
 
   g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
@@ -111,7 +111,7 @@
   g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
   g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')
   g' (Do es) = Do <$> mapM handleDoNotationElement es
-  g' (PositionedValue pos v) = PositionedValue pos <$> (g v >>= g')
+  g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
   g' other = g other
 
   h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
@@ -119,7 +119,7 @@
   h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
   h' (ConsBinder b1 b2) = ConsBinder <$> (h b1 >>= h') <*> (h b2 >>= h')
   h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
-  h' (PositionedBinder pos b) = PositionedBinder pos <$> (h b >>= h')
+  h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
   h' other = h other
 
   handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM (h' <=< h) bs
@@ -128,7 +128,7 @@
   handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
   handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
   handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds
-  handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos <$> handleDoNotationElement e
+  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
 
 everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
   (Declaration -> m Declaration) ->
@@ -142,7 +142,7 @@
   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
   f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f
   f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> mapM f' ds) >>= f
-  f' (PositionedDeclaration pos d) = (PositionedDeclaration pos <$> f' d) >>= f
+  f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f
   f' other = f other
 
   g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
@@ -160,7 +160,7 @@
   g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
   g' (Let ds v) = (Let <$> mapM f' ds <*> g' v) >>= g
   g' (Do es) = (Do <$> mapM handleDoNotationElement es) >>= g
-  g' (PositionedValue pos v) = (PositionedValue pos <$> g' v) >>= g
+  g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
   g' other = g other
 
   h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
@@ -168,7 +168,7 @@
   h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
   h' (ConsBinder b1 b2) = (ConsBinder <$> h' b1 <*> h' b2) >>= h
   h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
-  h' (PositionedBinder pos b) = (PositionedBinder pos <$> h' b) >>= h
+  h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
   h' other = h other
 
   handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM h' bs
@@ -177,7 +177,7 @@
   handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
   handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
   handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM f' ds
-  handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos <$> handleDoNotationElement e
+  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
 
 everythingOnValues :: (r -> r -> r) ->
                       (Declaration -> r) ->
@@ -194,7 +194,7 @@
   f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
   f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
   f' d@(TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)
-  f' d@(PositionedDeclaration _ d1) = f d <> f' d1
+  f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1
   f' d = f d
 
   g' v@(UnaryMinus v1) = g v <> g' v1
@@ -212,7 +212,7 @@
   g' v@(TypedValue _ v1 _) = g v <> g' v1
   g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1
   g' v@(Do es) = foldl (<>) (g v) (map j' es)
-  g' v@(PositionedValue _ v1) = g v <> g' v1
+  g' v@(PositionedValue _ _ v1) = g v <> g' v1
   g' v = g v
 
   h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
@@ -220,7 +220,7 @@
   h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
   h' b@(ConsBinder b1 b2) = h b <> h' b1 <> h' b2
   h' b@(NamedBinder _ b1) = h b <> h' b1
-  h' b@(PositionedBinder _ b1) = h b <> h' b1
+  h' b@(PositionedBinder _ _ b1) = h b <> h' b1
   h' b = h b
 
   i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
@@ -229,7 +229,7 @@
   j' e@(DoNotationValue v) = j e <> g' v
   j' e@(DoNotationBind b v) = j e <> h' b <> g' v
   j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
-  j' e@(PositionedDoNotationElement _ e1) = j e <> j' e1
+  j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
 
 everythingWithContextOnValues ::
   s ->
@@ -255,7 +255,7 @@
   f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)
   f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
   f' s (TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
-  f' s (PositionedDeclaration _ d1) = f'' s d1
+  f' s (PositionedDeclaration _ _ d1) = f'' s d1
   f' _ _ = r0
 
   g'' s v = let (s', r) = g s v in r <> g' s' v
@@ -275,7 +275,7 @@
   g' s (TypedValue _ v1 _) = g'' s v1
   g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1
   g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
-  g' s (PositionedValue _ v1) = g'' s v1
+  g' s (PositionedValue _ _ v1) = g'' s v1
   g' _ _ = r0
 
   h'' s b = let (s', r) = h s b in r <> h' s' b
@@ -285,7 +285,7 @@
   h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
   h' s (ConsBinder b1 b2) = h'' s b1 <> h'' s b2
   h' s (NamedBinder _ b1) = h'' s b1
-  h' s (PositionedBinder _ b1) = h'' s b1
+  h' s (PositionedBinder _ _ b1) = h'' s b1
   h' _ _ = r0
 
   i'' s ca = let (s', r) = i s ca in r <> i' s' ca
@@ -298,7 +298,7 @@
   j' s (DoNotationValue v) = g'' s v
   j' s (DoNotationBind b v) = h'' s b <> g'' s v
   j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
-  j' s (PositionedDoNotationElement _ e1) = j'' s e1
+  j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
 
 everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
   s ->
@@ -321,7 +321,7 @@
   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
   f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
   f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f'' s) ds
-  f' s (PositionedDeclaration pos d1) = PositionedDeclaration pos <$> f'' s d1
+  f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1
   f' _ other = return other
 
   g'' s = uncurry g' <=< g s
@@ -341,7 +341,7 @@
   g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
   g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
   g' s (Do es) = Do <$> mapM (j'' s) es
-  g' s (PositionedValue pos v) = PositionedValue pos <$> g'' s v
+  g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
   g' _ other = return other
 
   h'' s = uncurry h' <=< h s
@@ -351,7 +351,7 @@
   h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
   h' s (ConsBinder b1 b2) = ConsBinder <$> h'' s b1 <*> h'' s b2
   h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
-  h' s (PositionedBinder pos b) = PositionedBinder pos <$> h'' s b
+  h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
   h' _ other = return other
 
   i'' s = uncurry i' <=< i s
@@ -363,7 +363,7 @@
   j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
   j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
   j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
-  j' s (PositionedDoNotationElement pos e1) = PositionedDoNotationElement pos <$> j'' s e1
+  j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
 
 accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
 accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
diff --git a/src/Language/PureScript/CodeGen/Common.hs b/src/Language/PureScript/CodeGen/Common.hs
deleted file mode 100644
--- a/src/Language/PureScript/CodeGen/Common.hs
+++ /dev/null
@@ -1,193 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.CodeGen.Common
--- Copyright   :  (c) Phil Freeman 2013
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- Common code generation utility functions
---
------------------------------------------------------------------------------
-
-module Language.PureScript.CodeGen.Common where
-
-import Data.Char
-import Data.List (intercalate)
-import Data.Maybe (fromMaybe)
-import Data.Function (on)
-
-import qualified Data.Map as M
-
-import Language.PureScript.Names
-import Language.PureScript.Environment
-import Language.PureScript.Types
-
--- |
--- Convert an Ident into a valid Javascript identifier:
---
---  * Alphanumeric characters are kept unmodified.
---
---  * Reserved javascript identifiers are prefixed with '$$'.
---
---  * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
---
-identToJs :: Ident -> String
-identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
-identToJs (Ident name) = concatMap identCharToString name
-identToJs (Op op) = concatMap identCharToString op
-
--- |
--- Test if a string is a valid JS identifier without escaping.
---
-identNeedsEscaping :: String -> Bool
-identNeedsEscaping s = s /= identToJs (Ident s)
-
--- |
--- Attempts to find a human-readable name for a symbol, if none has been specified returns the
--- ordinal value.
---
-identCharToString :: Char -> String
-identCharToString c | isAlphaNum c = [c]
-identCharToString '_' = "_"
-identCharToString '.' = "$dot"
-identCharToString '$' = "$dollar"
-identCharToString '~' = "$tilde"
-identCharToString '=' = "$eq"
-identCharToString '<' = "$less"
-identCharToString '>' = "$greater"
-identCharToString '!' = "$bang"
-identCharToString '#' = "$hash"
-identCharToString '%' = "$percent"
-identCharToString '^' = "$up"
-identCharToString '&' = "$amp"
-identCharToString '|' = "$bar"
-identCharToString '*' = "$times"
-identCharToString '/' = "$div"
-identCharToString '+' = "$plus"
-identCharToString '-' = "$minus"
-identCharToString ':' = "$colon"
-identCharToString '\\' = "$bslash"
-identCharToString '?' = "$qmark"
-identCharToString '@' = "$at"
-identCharToString '\'' = "$prime"
-identCharToString c = '$' : show (ord c)
-
--- |
--- Checks whether an identifier name is reserved in Javascript.
---
-nameIsJsReserved :: String -> Bool
-nameIsJsReserved name =
-  name `elem` [ "abstract"
-              , "arguments"
-              , "boolean"
-              , "break"
-              , "byte"
-              , "case"
-              , "catch"
-              , "char"
-              , "class"
-              , "const"
-              , "continue"
-              , "debugger"
-              , "default"
-              , "delete"
-              , "do"
-              , "double"
-              , "else"
-              , "enum"
-              , "eval"
-              , "export"
-              , "extends"
-              , "final"
-              , "finally"
-              , "float"
-              , "for"
-              , "function"
-              , "goto"
-              , "if"
-              , "implements"
-              , "import"
-              , "in"
-              , "instanceof"
-              , "int"
-              , "interface"
-              , "let"
-              , "long"
-              , "native"
-              , "new"
-              , "null"
-              , "package"
-              , "private"
-              , "protected"
-              , "public"
-              , "return"
-              , "short"
-              , "static"
-              , "super"
-              , "switch"
-              , "synchronized"
-              , "this"
-              , "throw"
-              , "throws"
-              , "transient"
-              , "try"
-              , "typeof"
-              , "var"
-              , "void"
-              , "volatile"
-              , "while"
-              , "with"
-              , "yield" ]
-
-moduleNameToJs :: ModuleName -> String
-moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
-
--- |
--- Finds the value stored for a data constructor in the current environment.
--- This is a partial function, but if an invalid type has reached this far then
--- something has gone wrong in typechecking.
---
-lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
-lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
-
--- |
--- Checks whether a data constructor is the only constructor for that type, used
--- to simplify the check when generating code for binders.
---
-isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
-isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
-  where
-  numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
-  numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
-  typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
-  typeConstructor (Qualified (Just moduleName) _, (_, tyCtor, _)) = (moduleName, tyCtor)
-  typeConstructor _ = error "Invalid argument to isOnlyConstructor"
-
--- |
--- Checks whether a data constructor is for a newtype.
---
-isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
-isNewtypeConstructor e ctor = case lookupConstructor e ctor of
-  (Newtype, _, _) -> True
-  (Data, _, _) -> False
-
--- |
--- Checks the number of arguments a data constructor accepts.
---
-getConstructorArity :: Environment -> Qualified ProperName -> Int
-getConstructorArity e = go . (\(_, _, ctors) -> ctors) . lookupConstructor e
-  where
-  go :: Type -> Int
-  go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
-  go (ForAll _ ty _) = go ty
-  go _ = 0
-
--- |
--- Checks whether a data constructor has no arguments, for example, `Nothing`.
---
-isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
-isNullaryConstructor e = (== 0) . getConstructorArity e
diff --git a/src/Language/PureScript/CodeGen/Externs.hs b/src/Language/PureScript/CodeGen/Externs.hs
--- a/src/Language/PureScript/CodeGen/Externs.hs
+++ b/src/Language/PureScript/CodeGen/Externs.hs
@@ -17,21 +17,20 @@
     moduleToPs
 ) where
 
-import Data.Maybe (fromMaybe, mapMaybe)
 import Data.List (intercalate, find)
-
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Map as M
 
 import Control.Monad.Writer
 
-import Language.PureScript.CodeGen.Common
-import Language.PureScript.TypeClassDictionaries
 import Language.PureScript.AST
-import Language.PureScript.Pretty
-import Language.PureScript.Names
+import Language.PureScript.Environment
 import Language.PureScript.Kinds
+import Language.PureScript.Names
+import Language.PureScript.Pretty
+import Language.PureScript.TypeClassDictionaries
 import Language.PureScript.Types
-import Language.PureScript.Environment
+import Language.PureScript.Comments
 
 -- |
 -- Generate foreign imports for all declarations in a module
@@ -48,11 +47,15 @@
     declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]
     declToPs (FixityDeclaration (Fixity assoc prec) ident) =
       tell [ unwords [ show assoc, show prec, ident ] ]
-    declToPs (PositionedDeclaration _ d) = declToPs d
+    declToPs (PositionedDeclaration _ com d) = mapM commentToPs com >> declToPs d
     declToPs _ = return ()
+    
+    commentToPs :: Comment -> Writer [String] ()
+    commentToPs (LineComment s) = tell ["-- " ++ s]
+    commentToPs (BlockComment s) = tell ["{- " ++ s ++ " -}"]
 
     exportToPs :: DeclarationRef -> Writer [String] ()
-    exportToPs (PositionedDeclarationRef _ r) = exportToPs r
+    exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r
     exportToPs (TypeRef pn dctors) = do
       case Qualified (Just moduleName) pn `M.lookup` types env of
         Nothing -> error $ show pn ++ " has no kind in exportToPs"
@@ -109,4 +112,3 @@
 
     isValueExported :: Ident -> Bool
     isValueExported ident = ValueRef ident `elem` exts
-
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -13,32 +13,28 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE GADTs, DoAndIfThenElse #-}
+{-# LANGUAGE GADTs, ViewPatterns #-}
 
 module Language.PureScript.CodeGen.JS (
     module AST,
-    declToJs,
-    moduleToJs,
-    identNeedsEscaping
+    module Common,
+    bindToJs,
+    moduleToJs
 ) where
 
-import Data.Maybe (catMaybes)
-import Data.Function (on)
-import Data.List (nub, (\\), delete, sortBy)
-
-import qualified Data.Map as M
+import Data.List ((\\), delete)
+import Data.Maybe (mapMaybe)
 
-import Control.Monad (foldM, replicateM, forM)
 import Control.Applicative
-import Control.Arrow (second)
+import Control.Arrow ((&&&))
+import Control.Monad (foldM, replicateM, forM)
 
+import Language.PureScript.CodeGen.JS.AST as AST
+import Language.PureScript.CodeGen.JS.Common as Common
+import Language.PureScript.CoreFn
 import Language.PureScript.Names
-import Language.PureScript.AST
+import Language.PureScript.CodeGen.JS.Optimizer
 import Language.PureScript.Options
-import Language.PureScript.CodeGen.JS.AST as AST
-import Language.PureScript.Optimizer
-import Language.PureScript.CodeGen.Common
-import Language.PureScript.Environment
 import Language.PureScript.Supply
 import Language.PureScript.Traversals (sndM)
 import qualified Language.PureScript.Constants as C
@@ -47,25 +43,28 @@
 -- Generate code in the simplified Javascript intermediate representation for all declarations in a
 -- module.
 --
-moduleToJs :: (Functor m, Applicative m, Monad m) => Options mode -> Module -> Environment -> SupplyT m [JS]
-moduleToJs opts (Module name decls (Just exps)) env = do
-  let jsImports = map (importToJs opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls
-  jsDecls <- mapM (\decl -> declToJs opts name decl env) decls
-  let optimized = concat $ map (map $ optimize opts) $ catMaybes jsDecls
+moduleToJs :: (Functor m, Applicative m, Monad m) => Options mode -> Module Ann -> SupplyT m [JS]
+moduleToJs opts (Module name imps exps foreigns decls) = do
+  let jsImports = map (importToJs opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) $ imps
+  let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns
+  jsDecls <- mapM (bindToJs name) decls
+  let optimized = concatMap (map $ optimize opts) jsDecls
   let isModuleEmpty = null exps
-  let moduleBody = JSStringLiteral "use strict" : jsImports ++ optimized
-  let moduleExports = JSObjectLiteral . map (second var) . M.toList . M.unions $ map exportToJs exps
+  let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ optimized
+  let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps
   return $ case optionsAdditional opts of
-    MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]
+    MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
     CompileOptions ns _ _ | not isModuleEmpty ->
       [ JSVariableIntroduction ns
                                (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )
       , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar ns))
-                     (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) [])
+                     (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn exps']))) [])
       ]
     _ -> []
-moduleToJs _ _ _ = error "Exports should have been elaborated in name desugaring"
 
+-- |
+-- Generates Javascript code for a module import.
+--
 importToJs :: Options mode -> ModuleName -> JS
 importToJs opts mn =
   JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)
@@ -74,95 +73,26 @@
     MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]
     CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn) (JSVar ns)
 
-imports :: Declaration -> [ModuleName]
-imports (ImportDeclaration mn _ _) = [mn]
-imports other =
-  let (f, _, _, _, _) = everythingOnValues (++) (const []) collectV collectB (const []) (const [])
-  in f other
-  where
-  collectV :: Expr -> [ModuleName]
-  collectV (Var (Qualified (Just mn) _)) = [mn]
-  collectV (Constructor (Qualified (Just mn) _)) = [mn]
-  collectV (TypeClassDictionaryConstructorApp (Qualified (Just mn) _) _) = [mn]
-  collectV _ = []
-  collectB :: Binder -> [ModuleName]
-  collectB (ConstructorBinder (Qualified (Just mn) _) _) = [mn]
-  collectB _ = []
-
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a declaration
 --
-declToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Declaration -> Environment -> SupplyT m (Maybe [JS])
-declToJs opts mp (ValueDeclaration ident _ _ (Right val)) e = do
-  js <- valueToJs opts mp e val
-  return $ Just [JSVariableIntroduction (identToJs ident) (Just js)]
-declToJs opts mp (BindingGroupDeclaration vals) e = do
-  jss <- forM vals $ \(ident, _, val) -> do
-    js <- valueToJs opts mp e val
-    return $ JSVariableIntroduction (identToJs ident) (Just js)
-  return $ Just jss
-declToJs _ _ (DataDeclaration Newtype _ _ [((ProperName ctor), _)]) _ =
-  return $ Just $ [JSVariableIntroduction ctor (Just $
-                    JSObjectLiteral [("create",
-                      JSFunction Nothing ["value"]
-                        (JSBlock [JSReturn $ JSVar "value"]))])]
-declToJs _ _ (DataDeclaration Newtype _ _ _) _ =
-  error "newtype has multiple constructors"
-declToJs _ mp (DataDeclaration Data _ _ ctors) e = do
-  return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
-      let propName = if isNullaryConstructor e (Qualified (Just mp) pn) then "value" else "create"
-      in [ makeConstructor ctor (length tys)
-         , JSAssignment (JSAccessor propName (JSVar ctor)) (go pn 0 (length tys) [])
-         ]
-    where
-    makeConstructor :: String -> Int -> JS
-    makeConstructor ctorName n =
-      let
-        args = [ "value" ++ show index | index <- [0..n-1] ]
-        body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
-      in JSFunction (Just ctorName) args (JSBlock body)
-    go :: ProperName -> Int -> Int -> [JS] -> JS
-    go pn _ 0 values = JSUnary JSNew $ JSApp (JSVar $ runProperName pn) (reverse values)
-    go pn index n values =
-      JSFunction Nothing ["value" ++ show index]
-        (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
-declToJs opts mp (DataBindingGroupDeclaration ds) e = do
-  jss <- mapM (\decl -> declToJs opts mp decl e) ds
-  return $ Just $ concat $ catMaybes jss
-declToJs _ _ (TypeClassDeclaration name _ supers members) _ =
-  return $ Just $ [
-    JSFunction (Just $ runProperName name) (identToJs `map` args)
-      (JSBlock $ assn `map` args)]
-  where
-  assn :: Ident -> JS
-  assn arg = JSAssignment (accessor arg (JSVar "this")) (var arg)
-  args :: [Ident]
-  args = sortBy (compare `on` runIdent) $ memberNames ++ superNames
-  memberNames :: [Ident]
-  memberNames = memberToName `map` members
-  superNames :: [Ident]
-  superNames = [ toSuperName superclass index
-               | (index, (superclass, _)) <- zip [0..] supers
-               ]
-  toSuperName :: Qualified ProperName -> Integer -> Ident
-  toSuperName pn index = Ident $ C.__superclass_ ++ show pn ++ "_" ++ show index
-  memberToName :: Declaration -> Ident
-  memberToName (TypeDeclaration ident _) = ident
-  memberToName (PositionedDeclaration _ d) = memberToName d
-  memberToName _ = error "Invalid declaration in type class definition"
-declToJs _ _ (ExternDeclaration _ _ (Just js) _) _ = return $ Just [js]
-declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e
-declToJs _ _ _ _ = return Nothing
+bindToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Bind Ann -> SupplyT m [JS]
+bindToJs mp (NonRec ident val) = return <$> nonRecToJS mp ident val
+bindToJs mp (Rec vals) = forM vals (uncurry (nonRecToJS mp))
 
 -- |
--- Generate key//value pairs for an object literal exporting values from a module.
+-- Generate code in the simplified Javascript intermediate representation for a single non-recursive 
+-- declaration.
 --
-exportToJs :: DeclarationRef -> M.Map String Ident
-exportToJs (TypeRef _ (Just dctors)) = M.fromList [ (n, Ident n) | (ProperName n) <- dctors ]
-exportToJs (ValueRef name)           = M.singleton (runIdent name) name
-exportToJs (TypeInstanceRef name)    = M.singleton (runIdent name) name
-exportToJs (TypeClassRef name)       = M.singleton (runProperName name) (Ident $ runProperName name)
-exportToJs _                         = M.empty
+-- The main purpose of this function is to handle code generation for comments.
+--
+nonRecToJS :: (Functor m, Applicative m, Monad m) => ModuleName -> Ident -> Expr Ann -> SupplyT m JS
+nonRecToJS m i e@(extractAnn -> (_, com, _, _)) | not (null com) =
+  JSComment com <$> nonRecToJS m i (modifyAnn removeComments e)
+nonRecToJS mp ident val = do
+  js <- valueToJs mp val
+  return $ JSVariableIntroduction (identToJs ident) (Just js)
+  
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a variable based on a
@@ -187,55 +117,90 @@
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a value or expression.
 --
-valueToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Environment -> Expr -> SupplyT m JS
-valueToJs _ _ _ (NumericLiteral n) = return $ JSNumericLiteral n
-valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s
-valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b
-valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral <$> mapM (valueToJs opts m e) xs
-valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM (valueToJs opts m e)) ps
-valueToJs opts m e (TypeClassDictionaryConstructorApp name (TypedValue _ (ObjectLiteral ps) _)) =
-  JSUnary JSNew . JSApp (qualifiedToJS m (Ident . runProperName) name) <$> mapM (valueToJs opts m e . snd) (sortBy (compare `on` fst) ps)
-valueToJs _ _ _ TypeClassDictionaryConstructorApp{} =
-  error "TypeClassDictionaryConstructorApp did not contain object literal"
-valueToJs opts m e (ObjectUpdate o ps) = do
-  obj <- valueToJs opts m e o
-  sts <- mapM (sndM (valueToJs opts m e)) ps
+valueToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Expr Ann -> SupplyT m JS
+valueToJs m (Literal _ l) =
+  literalToValueJS m l
+valueToJs m (Var (_, _, _, Just (IsConstructor _ 0)) name) =
+  return $ JSAccessor "value" $ qualifiedToJS m id name
+valueToJs m (Var (_, _, _, Just (IsConstructor _ _)) name) =
+  return $ JSAccessor "create" $ qualifiedToJS m id name
+valueToJs m (Accessor _ prop val) =
+  accessorString prop <$> valueToJs m val
+valueToJs m (ObjectUpdate _ o ps) = do
+  obj <- valueToJs m o
+  sts <- mapM (sndM (valueToJs m)) ps
   extendObj obj sts
-valueToJs _ m e (Constructor name) =
-  let propName = if isNullaryConstructor e name then "value" else "create"
-  in return $ JSAccessor propName $ qualifiedToJS m (Ident . runProperName) name
-valueToJs opts m e (Case values binders) = do
-  vals <- mapM (valueToJs opts m e) values
-  bindersToJs opts m e binders vals
-valueToJs opts m e (IfThenElse cond th el) = JSConditional <$> valueToJs opts m e cond <*> valueToJs opts m e th <*> valueToJs opts m e el
-valueToJs opts m e (Accessor prop val) = accessorString prop <$> valueToJs opts m e val
-valueToJs opts m e v@App{} = do
-  let (f, args) = unApp v []
-  args' <- mapM (valueToJs opts m e) args
+valueToJs _ e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
+  let args = unAbs e
+  in return $ JSFunction Nothing (map identToJs args) (JSBlock $ map assign args)
+  where
+  unAbs :: Expr Ann -> [Ident]
+  unAbs (Abs _ arg val) = arg : unAbs val
+  unAbs _ = []
+  assign :: Ident -> JS
+  assign name = JSAssignment (accessorString (runIdent name) (JSVar "this"))
+                             (var name)
+valueToJs m (Abs _ arg val) = do
+  ret <- valueToJs m val
+  return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
+valueToJs m e@App{} = do
+  let (f, args) = unApp e []
+  args' <- mapM (valueToJs m) args
   case f of
-    Constructor name | isNewtypeConstructor e name && length args == 1 -> return (head args')
-    Constructor name | getConstructorArity e name == length args ->
-      return $ JSUnary JSNew $ JSApp (qualifiedToJS m (Ident . runProperName) name) args'
-    _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs opts m e f
+    Var (_, _, _, Just IsNewtype) _ -> return (head args')
+    Var (_, _, _, Just (IsConstructor _ arity)) name | arity == length args ->
+      return $ JSUnary JSNew $ JSApp (qualifiedToJS m id name) args'
+    Var (_, _, _, Just IsTypeClassConstructor) name ->
+      return $ JSUnary JSNew $ JSApp (qualifiedToJS m id name) args'
+    _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs m f
   where
-  unApp :: Expr -> [Expr] -> (Expr, [Expr])
-  unApp (App val arg) args = unApp val (arg : args)
-  unApp (PositionedValue _ val) args = unApp val args
-  unApp (TypedValue _ val _) args = unApp val args
+  unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
+  unApp (App _ val arg) args = unApp val (arg : args)
   unApp other args = (other, args)
-valueToJs opts m e (Let ds val) = do
-  decls <- concat . catMaybes <$> mapM (flip (declToJs opts m) e) ds
-  ret <- valueToJs opts m e val
+valueToJs m (Var _ ident) =
+  return $ varToJs m ident
+valueToJs m (Case _ values binders) = do
+  vals <- mapM (valueToJs m) values
+  bindersToJs m binders vals
+valueToJs m (Let _ ds val) = do
+  decls <- concat <$> mapM (bindToJs m) ds
+  ret <- valueToJs m val
   return $ JSApp (JSFunction Nothing [] (JSBlock (decls ++ [JSReturn ret]))) []
-valueToJs opts m e (Abs (Left arg) val) = do
-  ret <- valueToJs opts m e val
-  return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
-valueToJs _ m _ (Var ident) = return $ varToJs m ident
-valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
-valueToJs opts m e (PositionedValue _ val) = valueToJs opts m e val
-valueToJs _ _ _ (TypeClassDictionary _ _ _) = error "Type class dictionary was not replaced"
-valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
+valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
+  return $ JSVariableIntroduction ctor (Just $
+              JSObjectLiteral [("create",
+                JSFunction Nothing ["value"]
+                  (JSBlock [JSReturn $ JSVar "value"]))])
+valueToJs _ (Constructor _ _ (ProperName ctor) 0) =
+  return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
+         , JSAssignment (JSAccessor "value" (JSVar ctor))
+              (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
+valueToJs _ (Constructor _ _ (ProperName ctor) arity) =
+  return $ iife ctor [ makeConstructor ctor arity
+         , JSAssignment (JSAccessor "create" (JSVar ctor)) (go ctor 0 arity [])
+         ]
+    where
+    makeConstructor :: String -> Int -> JS
+    makeConstructor ctorName n =
+      let args = [ "value" ++ show index | index <- [0..n-1] ]
+          body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
+      in JSFunction (Just ctorName) args (JSBlock body)
+    go :: String -> Int -> Int -> [JS] -> JS
+    go pn _ 0 values = JSUnary JSNew $ JSApp (JSVar pn) (reverse values)
+    go pn index n values =
+      JSFunction Nothing ["value" ++ show index]
+        (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
 
+iife :: String -> [JS] -> JS
+iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
+
+literalToValueJS :: (Functor m, Applicative m, Monad m) => ModuleName -> Literal (Expr Ann) -> SupplyT m JS
+literalToValueJS _ (NumericLiteral n) = return $ JSNumericLiteral n
+literalToValueJS _ (StringLiteral s) = return $ JSStringLiteral s
+literalToValueJS _ (BooleanLiteral b) = return $ JSBooleanLiteral b
+literalToValueJS m (ArrayLiteral xs) = JSArrayLiteral <$> mapM (valueToJs m) xs
+literalToValueJS m (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM (valueToJs m)) ps
+
 -- |
 -- Shallow copy an object.
 --
@@ -276,109 +241,111 @@
 -- Generate code in the simplified Javascript intermediate representation for pattern match binders
 -- and guards.
 --
-bindersToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS
-bindersToJs opts m e binders vals = do
+bindersToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> [CaseAlternative Ann] -> [JS] -> SupplyT m JS
+bindersToJs m binders vals = do
   valNames <- replicateM (length vals) freshName
   let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
   jss <- forM binders $ \(CaseAlternative bs result) -> do
     ret <- guardsToJs result
     go valNames ret bs
-  return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [JSStringLiteral "Failed pattern match"]])))
+  return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") [JSStringLiteral "Failed pattern match"]])))
                  []
   where
-    go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> SupplyT m [JS]
+    go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder Ann] -> SupplyT m [JS]
     go _ done [] = return done
     go (v:vs) done' (b:bs) = do
       done'' <- go vs done' bs
-      binderToJs m e v done'' b
+      binderToJs m v done'' b
     go _ _ _ = error "Invalid arguments to bindersToJs"
 
-    guardsToJs :: (Functor m, Applicative m, Monad m) => Either [(Guard, Expr)] Expr -> SupplyT m [JS]
+    guardsToJs :: (Functor m, Applicative m, Monad m) => Either [(Guard Ann, Expr Ann)] (Expr Ann) -> SupplyT m [JS]
     guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
-      cond' <- valueToJs opts m e cond
-      done  <- valueToJs opts m e val
+      cond' <- valueToJs m cond
+      done  <- valueToJs m val
       return $ JSIfElse cond' (JSBlock [JSReturn done]) Nothing
-    guardsToJs (Right v) = return . JSReturn <$> valueToJs opts m e v
+    guardsToJs (Right v) = return . JSReturn <$> valueToJs m v
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a pattern match
 -- binder.
 --
-binderToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Environment -> String -> [JS] -> Binder -> SupplyT m [JS]
-binderToJs _ _ _ done NullBinder = return done
-binderToJs _ _ varName done (StringBinder str) =
-  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (NumberBinder num) =
-  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (BooleanBinder True) =
-  return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
-binderToJs _ _ varName done (BooleanBinder False) =
-  return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (VarBinder ident) =
+binderToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> String -> [JS] -> Binder Ann -> SupplyT m [JS]
+binderToJs _ _ done (NullBinder{}) = return done
+binderToJs m varName done (LiteralBinder _ l) =
+  literalToBinderJS m varName done l
+binderToJs _ varName done (VarBinder _ ident) =
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
-binderToJs m e varName done (ConstructorBinder ctor bs) | isNewtypeConstructor e ctor =
-  case bs of
-    [b] -> binderToJs m e varName done b
-    _ -> error "binder for newtype constructor should have a single argument"
-binderToJs m e varName done (ConstructorBinder ctor bs) = do
+binderToJs m varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
+  binderToJs m varName done b
+binderToJs m varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType _)) _ ctor bs) = do
   js <- go 0 done bs
-  if isOnlyConstructor e ctor
-  then
-    return js
-  else
-    return [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS m (Ident . runProperName) ctor))
-                     (JSBlock js)
-                     Nothing]
+  return $ case ctorType of
+    ProductType -> js
+    SumType ->
+      [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS m (Ident . runProperName) ctor))
+                (JSBlock js)
+                Nothing]
   where
-  go :: (Functor m, Applicative m, Monad m) => Integer -> [JS] -> [Binder] -> SupplyT m [JS]
+  go :: (Functor m, Applicative m, Monad m) => Integer -> [JS] -> [Binder Ann] -> SupplyT m [JS]
   go _ done' [] = return done'
   go index done' (binder:bs') = do
     argVar <- freshName
     done'' <- go (index + 1) done' bs'
-    js <- binderToJs m e argVar done'' binder
+    js <- binderToJs m argVar done'' binder
     return (JSVariableIntroduction argVar (Just (JSAccessor ("value" ++ show index) (JSVar varName))) : js)
-binderToJs m e varName done (ObjectBinder bs) = go done bs
-  where
-  go :: (Functor m, Applicative m, Monad m) => [JS] -> [(String, Binder)] -> SupplyT m [JS]
-  go done' [] = return done'
-  go done' ((prop, binder):bs') = do
-    propVar <- freshName
-    done'' <- go done' bs'
-    js <- binderToJs m e propVar done'' binder
-    return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
-binderToJs m e varName done (ArrayBinder bs) = do
-  js <- go done 0 bs
-  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
-  where
-  go :: (Functor m, Applicative m, Monad m) => [JS] -> Integer -> [Binder] -> SupplyT m [JS]
-  go done' _ [] = return done'
-  go done' index (binder:bs') = do
-    elVar <- freshName
-    done'' <- go done' (index + 1) bs'
-    js <- binderToJs m e elVar done'' binder
-    return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
-binderToJs m e varName done binder@(ConsBinder _ _) = do
+binderToJs m varName done binder@(ConstructorBinder _ _ ctor _) | isCons ctor = do
   let (headBinders, tailBinder) = uncons [] binder
       numberOfHeadBinders = fromIntegral $ length headBinders
   js1 <- foldM (\done' (headBinder, index) -> do
     headVar <- freshName
-    jss <- binderToJs m e headVar done' headBinder
+    jss <- binderToJs m headVar done' headBinder
     return (JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : jss)) done (zip headBinders [0..])
   tailVar <- freshName
-  js2 <- binderToJs m e tailVar js1 tailBinder
+  js2 <- binderToJs m tailVar js1 tailBinder
   return [JSIfElse (JSBinary GreaterThanOrEqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left numberOfHeadBinders))) (JSBlock
     ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :
       js2
     )) Nothing]
   where
-  uncons :: [Binder] -> Binder -> ([Binder], Binder)
-  uncons acc (ConsBinder h t) = uncons (h : acc) t
-  uncons acc (PositionedBinder _ b) = uncons acc b
+  uncons :: [Binder Ann] -> Binder Ann -> ([Binder Ann], Binder Ann)
+  uncons acc (ConstructorBinder _ _ ctor' [h, t]) | isCons ctor' = uncons (h : acc) t
   uncons acc tailBinder = (reverse acc, tailBinder)
-binderToJs m e varName done (NamedBinder ident binder) = do
-  js <- binderToJs m e varName done binder
+binderToJs _ _ _ b@(ConstructorBinder{}) =
+  error $ "Invalid ConstructorBinder in binderToJs: " ++ show b
+binderToJs m varName done (NamedBinder _ ident binder) = do
+  js <- binderToJs m varName done binder
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
-binderToJs m e varName done (PositionedBinder _ binder) =
-  binderToJs m e varName done binder
 
+literalToBinderJS :: (Functor m, Applicative m, Monad m) => ModuleName -> String -> [JS] -> Literal (Binder Ann) -> SupplyT m [JS]
+literalToBinderJS _ varName done (NumericLiteral num) =
+  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
+literalToBinderJS _ varName done (StringLiteral str) =
+  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
+literalToBinderJS _ varName done (BooleanLiteral True) =
+  return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
+literalToBinderJS _ varName done (BooleanLiteral False) =
+  return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
+literalToBinderJS m varName done (ObjectLiteral bs) = go done bs
+  where
+  go :: (Functor m, Applicative m, Monad m) => [JS] -> [(String, Binder Ann)] -> SupplyT m [JS]
+  go done' [] = return done'
+  go done' ((prop, binder):bs') = do
+    propVar <- freshName
+    done'' <- go done' bs'
+    js <- binderToJs m propVar done'' binder
+    return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
+literalToBinderJS m varName done (ArrayLiteral bs) = do
+  js <- go done 0 bs
+  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
+  where
+  go :: (Functor m, Applicative m, Monad m) => [JS] -> Integer -> [Binder Ann] -> SupplyT m [JS]
+  go done' _ [] = return done'
+  go done' index (binder:bs') = do
+    elVar <- freshName
+    done'' <- go done' (index + 1) bs'
+    js <- binderToJs m elVar done'' binder
+    return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
 
+isCons :: Qualified ProperName -> Bool
+isCons (Qualified (Just mn) ctor) = mn == ModuleName [ProperName C.prim] && ctor == ProperName "Array"
+isCons name = error $ "Unexpected argument in isCons: " ++ show name
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -19,6 +19,8 @@
 
 import Data.Data
 
+import Language.PureScript.Comments
+
 -- |
 -- Built-in unary operators
 --
@@ -240,7 +242,11 @@
   -- |
   -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
   --
-  | JSRaw String deriving (Show, Eq, Data, Typeable)
+  | JSRaw String
+  -- |
+  -- Commented Javascript
+  --
+  | JSComment [Comment] JS deriving (Show, Eq, Data, Typeable)
 
 --
 -- Traversals
@@ -271,6 +277,7 @@
   go (JSTypeOf js) = f (JSTypeOf (go js))
   go (JSLabel name js) = f (JSLabel name (go js))
   go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
+  go (JSComment com j) = f (JSComment com (go j))
   go other = f other
 
 everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
@@ -298,6 +305,7 @@
   go (JSTypeOf j) = JSTypeOf (go (f j))
   go (JSLabel name j) = JSLabel name (go (f j))
   go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))
+  go (JSComment com j) = JSComment com (go (f j))
   go other = f other
 
 everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
@@ -325,4 +333,5 @@
   go j@(JSTypeOf j1) = f j <> go j1
   go j@(JSLabel _ j1) = f j <> go j1
   go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
+  go j@(JSComment _ j1) = f j <> go j1
   go other = f other
diff --git a/src/Language/PureScript/CodeGen/JS/Common.hs b/src/Language/PureScript/CodeGen/JS/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Common.hs
@@ -0,0 +1,141 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.Common
+-- Copyright   :  (c) Phil Freeman 2013
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Common code generation utility functions
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Common where
+
+import Data.Char
+import Data.List (intercalate)
+
+import Language.PureScript.Names
+
+-- |
+-- Convert an Ident into a valid Javascript identifier:
+--
+--  * Alphanumeric characters are kept unmodified.
+--
+--  * Reserved javascript identifiers are prefixed with '$$'.
+--
+--  * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
+--
+identToJs :: Ident -> String
+identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
+identToJs (Ident name) = concatMap identCharToString name
+identToJs (Op op) = concatMap identCharToString op
+
+-- |
+-- Test if a string is a valid JS identifier without escaping.
+--
+identNeedsEscaping :: String -> Bool
+identNeedsEscaping s = s /= identToJs (Ident s)
+
+-- |
+-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
+-- ordinal value.
+--
+identCharToString :: Char -> String
+identCharToString c | isAlphaNum c = [c]
+identCharToString '_' = "_"
+identCharToString '.' = "$dot"
+identCharToString '$' = "$dollar"
+identCharToString '~' = "$tilde"
+identCharToString '=' = "$eq"
+identCharToString '<' = "$less"
+identCharToString '>' = "$greater"
+identCharToString '!' = "$bang"
+identCharToString '#' = "$hash"
+identCharToString '%' = "$percent"
+identCharToString '^' = "$up"
+identCharToString '&' = "$amp"
+identCharToString '|' = "$bar"
+identCharToString '*' = "$times"
+identCharToString '/' = "$div"
+identCharToString '+' = "$plus"
+identCharToString '-' = "$minus"
+identCharToString ':' = "$colon"
+identCharToString '\\' = "$bslash"
+identCharToString '?' = "$qmark"
+identCharToString '@' = "$at"
+identCharToString '\'' = "$prime"
+identCharToString c = '$' : show (ord c)
+
+-- |
+-- Checks whether an identifier name is reserved in Javascript.
+--
+nameIsJsReserved :: String -> Bool
+nameIsJsReserved name =
+  name `elem` [ "abstract"
+              , "arguments"
+              , "boolean"
+              , "break"
+              , "byte"
+              , "case"
+              , "catch"
+              , "char"
+              , "class"
+              , "const"
+              , "continue"
+              , "debugger"
+              , "default"
+              , "delete"
+              , "do"
+              , "double"
+              , "else"
+              , "enum"
+              , "eval"
+              , "export"
+              , "extends"
+              , "final"
+              , "finally"
+              , "float"
+              , "for"
+              , "function"
+              , "goto"
+              , "if"
+              , "implements"
+              , "import"
+              , "in"
+              , "instanceof"
+              , "int"
+              , "interface"
+              , "let"
+              , "long"
+              , "native"
+              , "new"
+              , "null"
+              , "package"
+              , "private"
+              , "protected"
+              , "public"
+              , "return"
+              , "short"
+              , "static"
+              , "super"
+              , "switch"
+              , "synchronized"
+              , "this"
+              , "throw"
+              , "throws"
+              , "transient"
+              , "try"
+              , "typeof"
+              , "var"
+              , "void"
+              , "volatile"
+              , "while"
+              , "with"
+              , "yield" ]
+
+moduleNameToJs :: ModuleName -> String
+moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -0,0 +1,76 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer
+-- Copyright   :  (c) Phil Freeman 2013
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- This module optimizes code in the simplified-Javascript intermediate representation.
+--
+-- The following optimizations are supported:
+--
+--  * Collapsing nested blocks
+--
+--  * Tail call elimination
+--
+--  * Inlining of (>>=) and ret for the Eff monad
+--
+--  * Removal of unnecessary thunks
+--
+--  * Eta conversion
+--
+--  * Inlining variables
+--
+--  * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
+--
+--  * Inlining primitive Javascript operators
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer (
+    optimize
+) where
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.Options
+import qualified Language.PureScript.Constants as C
+
+import Language.PureScript.CodeGen.JS.Optimizer.Common
+import Language.PureScript.CodeGen.JS.Optimizer.TCO
+import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
+import Language.PureScript.CodeGen.JS.Optimizer.Inliner
+import Language.PureScript.CodeGen.JS.Optimizer.Unused
+import Language.PureScript.CodeGen.JS.Optimizer.Blocks
+
+-- |
+-- Apply a series of optimizer passes to simplified Javascript code
+--
+optimize :: Options mode -> JS -> JS
+optimize opts | optionsNoOptimizations opts = id
+              | otherwise = untilFixedPoint (applyAll
+  [ collapseNestedBlocks
+  , collapseNestedIfs
+  , tco opts
+  , magicDo opts
+  , removeCodeAfterReturnStatements
+  , removeUnusedArg
+  , removeUndefinedApp
+  , unThunk
+  , etaConvert
+  , evaluateIifes
+  , inlineVariables
+  , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
+  , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
+  , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
+  , inlineCommonOperators ])
+
+untilFixedPoint :: (Eq a) => (a -> a) -> a -> a
+untilFixedPoint f = go
+  where
+  go a = let a' = f a in
+          if a' == a then a' else go a'
+
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs
@@ -0,0 +1,42 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.Blocks
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Optimizer steps for simplifying Javascript blocks
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.Blocks
+  ( collapseNestedBlocks
+  , collapseNestedIfs
+  ) where
+
+import Language.PureScript.CodeGen.JS.AST
+
+-- |
+-- Collapse blocks which appear nested directly below another block
+--
+collapseNestedBlocks :: JS -> JS
+collapseNestedBlocks = everywhereOnJS collapse
+  where
+  collapse :: JS -> JS
+  collapse (JSBlock sts) = JSBlock (concatMap go sts)
+  collapse js = js
+  go :: JS -> [JS]
+  go (JSBlock sts) = sts
+  go s = [s]
+
+collapseNestedIfs :: JS -> JS
+collapseNestedIfs = everywhereOnJS collapse
+  where
+  collapse :: JS -> JS
+  collapse (JSIfElse cond1 (JSBlock [JSIfElse cond2 body Nothing]) Nothing) =
+      JSIfElse (JSBinary And cond1 cond2) body Nothing
+  collapse js = js
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs
@@ -0,0 +1,77 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.Common
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Common functions used by the various optimizer phases
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.Common where
+
+import Data.Maybe (fromMaybe)
+
+import Language.PureScript.CodeGen.JS.AST
+
+applyAll :: [a -> a] -> a -> a
+applyAll = foldl1 (.)
+
+replaceIdent :: String -> JS -> JS -> JS
+replaceIdent var1 js = everywhereOnJS replace
+  where
+  replace (JSVar var2) | var1 == var2 = js
+  replace other = other
+
+replaceIdents :: [(String, JS)] -> JS -> JS
+replaceIdents vars = everywhereOnJS replace
+  where
+  replace v@(JSVar var) = fromMaybe v $ lookup var vars
+  replace other = other
+
+isReassigned :: String -> JS -> Bool
+isReassigned var1 = everythingOnJS (||) check
+  where
+  check :: JS -> Bool
+  check (JSFunction _ args _) | var1 `elem` args = True
+  check (JSVariableIntroduction arg _) | var1 == arg = True
+  check (JSAssignment (JSVar arg) _) | var1 == arg = True
+  check (JSFor arg _ _ _) | var1 == arg = True
+  check (JSForIn arg _ _) | var1 == arg = True
+  check _ = False
+
+isRebound :: JS -> JS -> Bool
+isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)
+  where
+  variablesOf (JSVar var) = [var]
+  variablesOf _ = []
+
+isUsed :: String -> JS -> Bool
+isUsed var1 = everythingOnJS (||) check
+  where
+  check :: JS -> Bool
+  check (JSVar var2) | var1 == var2 = True
+  check (JSAssignment target _) | var1 == targetVariable target = True
+  check _ = False
+
+targetVariable :: JS -> String
+targetVariable (JSVar var) = var
+targetVariable (JSAccessor _ tgt) = targetVariable tgt
+targetVariable (JSIndexer _ tgt) = targetVariable tgt
+targetVariable _ = error "Invalid argument to targetVariable"
+
+isUpdated :: String -> JS -> Bool
+isUpdated var1 = everythingOnJS (||) check
+  where
+  check :: JS -> Bool
+  check (JSAssignment target _) | var1 == targetVariable target = True
+  check _ = False
+
+removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
+removeFromBlock go (JSBlock sts) = JSBlock (go sts)
+removeFromBlock _  js = js
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
@@ -0,0 +1,191 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.Inliner
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- This module provides basic inlining capabilities
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
+  inlineVariables,
+  inlineOperator,
+  inlineCommonOperators,
+  etaConvert,
+  unThunk,
+  evaluateIifes
+) where
+
+import Data.Maybe (fromMaybe)
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.CodeGen.JS.Common
+import Language.PureScript.Names
+import Language.PureScript.CodeGen.JS.Optimizer.Common
+import qualified Language.PureScript.Constants as C
+
+shouldInline :: JS -> Bool
+shouldInline (JSVar _) = True
+shouldInline (JSNumericLiteral _) = True
+shouldInline (JSStringLiteral _) = True
+shouldInline (JSBooleanLiteral _) = True
+shouldInline (JSAccessor _ val) = shouldInline val
+shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
+shouldInline _ = False
+
+etaConvert :: JS -> JS
+etaConvert = everywhereOnJS convert
+  where
+  convert :: JS -> JS
+  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
+    | all shouldInline args &&
+      not (any (`isRebound` block) (map JSVar idents)) &&
+      not (any (`isRebound` block) args)
+      = JSBlock (map (replaceIdents (zip idents args)) body)
+  convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
+  convert js = js
+
+unThunk :: JS -> JS
+unThunk = everywhereOnJS convert
+  where
+  convert :: JS -> JS
+  convert (JSBlock []) = JSBlock []
+  convert (JSBlock jss) =
+    case last jss of
+      JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
+      _ -> JSBlock jss
+  convert js = js
+
+evaluateIifes :: JS -> JS
+evaluateIifes = everywhereOnJS convert
+  where
+  convert :: JS -> JS
+  convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
+  convert js = js
+
+inlineVariables :: JS -> JS
+inlineVariables = everywhereOnJS $ removeFromBlock go
+  where
+  go :: [JS] -> [JS]
+  go [] = []
+  go (JSVariableIntroduction var (Just js) : sts)
+    | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
+      go (map (replaceIdent var js) sts)
+  go (s:sts) = s : go sts
+
+inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
+inlineOperator (m, op) f = everywhereOnJS convert
+  where
+  convert :: JS -> JS
+  convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
+  convert other = other
+  isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)
+  isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'
+  isOp _ = False
+
+inlineCommonOperators :: JS -> JS
+inlineCommonOperators = applyAll $
+  [ binary C.numNumber (C.+) Add
+  , binary C.numNumber (C.-) Subtract
+  , binary C.numNumber (C.*) Multiply
+  , binary C.numNumber (C./) Divide
+  , binary C.numNumber (C.%) Modulus
+  , unary  C.numNumber C.negate Negate
+
+  , binary C.ordNumber (C.<) LessThan
+  , binary C.ordNumber (C.>) GreaterThan
+  , binary C.ordNumber (C.<=) LessThanOrEqualTo
+  , binary C.ordNumber (C.>=) GreaterThanOrEqualTo
+
+  , binary C.eqNumber (C.==) EqualTo
+  , binary C.eqNumber (C./=) NotEqualTo
+  , binary C.eqString (C.==) EqualTo
+  , binary C.eqString (C./=) NotEqualTo
+  , binary C.eqBoolean (C.==) EqualTo
+  , binary C.eqBoolean (C./=) NotEqualTo
+
+  , binary C.semigroupString (C.<>) Add
+  , binary C.semigroupString (C.++) Add
+
+  , binaryFunction C.bitsNumber C.shl ShiftLeft
+  , binaryFunction C.bitsNumber C.shr ShiftRight
+  , binaryFunction C.bitsNumber C.zshr ZeroFillShiftRight
+  , binary         C.bitsNumber (C..&.) BitwiseAnd
+  , binary         C.bitsNumber (C..|.) BitwiseOr
+  , binary         C.bitsNumber (C..^.) BitwiseXor
+  , unary          C.bitsNumber C.complement BitwiseNot
+
+  , binary C.boolLikeBoolean (C.&&) And
+  , binary C.boolLikeBoolean (C.||) Or
+  , unary  C.boolLikeBoolean C.not Not
+  ] ++
+  [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
+  where
+  binary :: String -> String -> BinaryOperator -> JS -> JS
+  binary dictName opString op = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
+    convert other = other
+    isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op opString)
+    isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'
+    isOp _ = False
+  binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
+  binaryFunction dictName fnName op = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
+    convert other = other
+    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'
+    isOp _ = False
+  unary :: String -> String -> UnaryOperator -> JS -> JS
+  unary dictName fnName op = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x
+    convert other = other
+    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
+    isOp _ = False
+  isOpDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
+  isOpDict _ _ = False
+  mkFn :: Int -> JS -> JS
+  mkFn 0 = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
+      JSFunction Nothing [] (JSBlock js)
+    convert other = other
+  mkFn n = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
+      case collectArgs n [] fn of
+        Just (args, js) -> JSFunction Nothing args (JSBlock js)
+        Nothing -> orig
+    convert other = other
+    collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
+    collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
+    collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
+    collectArgs _ _   _ = Nothing
+
+  isNFn :: String -> Int -> JS -> Bool
+  isNFn prefix n (JSVar name) = name == (prefix ++ show n)
+  isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
+  isNFn _ _ _ = False
+
+  runFn :: Int -> JS -> JS
+  runFn n = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert js = fromMaybe js $ go n [] js
+
+    go :: Int -> [JS] -> JS -> Maybe JS
+    go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
+    go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
+    go _ _   _ = Nothing
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
@@ -0,0 +1,165 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.MagicDo
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- This module implements the "Magic Do" optimization, which inlines calls to return
+-- and bind for the Eff monad, as well as some of its actions.
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (
+  magicDo
+) where
+
+import Data.List (nub)
+import Data.Maybe (fromJust, isJust)
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.CodeGen.JS.Common
+import Language.PureScript.Names
+import Language.PureScript.Options
+import qualified Language.PureScript.Constants as C
+
+magicDo :: Options mode -> JS -> JS
+magicDo opts | optionsNoMagicDo opts = id
+             | otherwise = inlineST . magicDo'
+
+-- |
+-- Inline type class dictionaries for >>= and return for the Eff monad
+--
+-- E.g.
+--
+--  Prelude[">>="](dict)(m1)(function(x) {
+--    return ...;
+--  })
+--
+-- becomes
+--
+--  function __do {
+--    var x = m1();
+--    ...
+--  }
+--
+magicDo' :: JS -> JS
+magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
+  where
+  -- The name of the function block which is added to denote a do block
+  fnName = "__do"
+  -- Desugar monomorphic calls to >>= and return for the Eff monad
+  convert :: JS -> JS
+  -- Desugar return
+  convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
+  -- Desugar pure
+  convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
+  -- Desugar >>
+  convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
+    JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : map applyReturns js )
+  -- Desugar >>=
+  convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind =
+    JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : map applyReturns js)
+  -- Desugar untilE
+  convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
+    JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
+  -- Desugar whileE
+  convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
+    JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
+  convert other = other
+  -- Check if an expression represents a monomorphic call to >>= for the Eff monad
+  isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
+  isBind _ = False
+  -- Check if an expression represents a monomorphic call to return for the Eff monad
+  isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
+  isReturn _ = False
+  -- Check if an expression represents a monomorphic call to pure for the Eff applicative
+  isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
+  isPure _ = False
+  -- Check if an expression represents the polymorphic >>= function
+  isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
+  isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
+  isBindPoly _ = False
+  -- Check if an expression represents the polymorphic return function
+  isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
+  isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return
+  isRetPoly _ = False
+  -- Check if an expression represents the polymorphic pure function
+  isPurePoly (JSAccessor pure' (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
+  isPurePoly (JSIndexer (JSStringLiteral pure') (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
+  isPurePoly _ = False
+  -- Check if an expression represents a function in the Ef module
+  isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
+  isEffFunc _ _ = False
+  -- Check if an expression represents the Monad Eff dictionary
+  isEffDict name (JSVar ident) | ident == name = True
+  isEffDict name (JSAccessor prop (JSVar eff)) = eff == C.eff && prop == name
+  isEffDict _ _ = False
+  -- Remove __do function applications which remain after desugaring
+  undo :: JS -> JS
+  undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
+  undo other = other
+
+  applyReturns :: JS -> JS
+  applyReturns (JSReturn ret) = JSReturn (JSApp ret [])
+  applyReturns (JSBlock jss) = JSBlock (map applyReturns jss)
+  applyReturns (JSWhile cond js) = JSWhile cond (applyReturns js)
+  applyReturns (JSFor v lo hi js) = JSFor v lo hi (applyReturns js)
+  applyReturns (JSForIn v xs js) = JSForIn v xs (applyReturns js)
+  applyReturns (JSIfElse cond t f) = JSIfElse cond (applyReturns t) (applyReturns `fmap` f)
+  applyReturns other = other
+
+-- |
+-- Inline functions in the ST module
+--
+inlineST :: JS -> JS
+inlineST = everywhereOnJS convertBlock
+  where
+  -- Look for runST blocks and inline the STRefs there.
+  -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
+  -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
+  convertBlock (JSApp f [arg]) | isSTFunc C.runST f =
+    let refs = nub . findSTRefsIn $ arg
+        usages = findAllSTUsagesIn arg
+        allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
+        localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
+    in everywhereOnJS (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg
+  convertBlock other = other
+  -- Convert a block in a safe way, preserving object wrappers of references,
+  -- or in a more aggressive way, turning wrappers into local variables depending on the
+  -- agg(ressive) parameter.
+  convert agg (JSApp f [arg]) | isSTFunc C.newSTRef f =
+   JSFunction Nothing [] (JSBlock [JSReturn $ if agg then arg else JSObjectLiteral [(C.stRefValue, arg)]])
+  convert agg (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f =
+    if agg then ref else JSAccessor C.stRefValue ref
+  convert agg (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
+    if agg then JSAssignment ref arg else JSAssignment (JSAccessor C.stRefValue ref) arg
+  convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
+    if agg then JSAssignment ref (JSApp func [ref]) else  JSAssignment (JSAccessor C.stRefValue ref) (JSApp func [JSAccessor C.stRefValue ref])
+  convert _ other = other
+  -- Check if an expression represents a function in the ST module
+  isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'
+  isSTFunc _ _ = False
+  -- Find all ST Refs initialized in this block
+  findSTRefsIn = everythingOnJS (++) isSTRef
+    where
+    isSTRef (JSVariableIntroduction ident (Just (JSApp (JSApp f [_]) []))) | isSTFunc C.newSTRef f = [ident]
+    isSTRef _ = []
+  -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef
+  findAllSTUsagesIn = everythingOnJS (++) isSTUsage
+    where
+    isSTUsage (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f = [ref]
+    isSTUsage (JSApp (JSApp (JSApp f [ref]) [_]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
+    isSTUsage _ = []
+  -- Find all uses of a variable
+  appearingIn ref = everythingOnJS (++) isVar
+    where
+    isVar e@(JSVar v) | v == ref = [e]
+    isVar _ = []
+  -- Convert a JS value to a String if it is a JSVar
+  toVar (JSVar v) = Just v
+  toVar _ = Nothing
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
@@ -0,0 +1,103 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.TCO
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- This module implements tail call elimination.
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
+
+import Language.PureScript.Options
+import Language.PureScript.CodeGen.JS.AST
+
+-- |
+-- Eliminate tail calls
+--
+tco :: Options mode -> JS -> JS
+tco opts | optionsNoTco opts = id
+         | otherwise = tco'
+
+tco' :: JS -> JS
+tco' = everywhereOnJS convert
+  where
+  tcoLabel :: String
+  tcoLabel = "tco"
+  tcoVar :: String -> String
+  tcoVar arg = "__tco_" ++ arg
+  copyVar :: String -> String
+  copyVar arg = "__copy_" ++ arg
+  convert :: JS -> JS
+  convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
+    let
+      (argss, body', replace) = collectAllFunctionArgs [] id fn
+    in case () of
+      _ | isTailCall name body' ->
+            let
+              allArgs = concat $ reverse argss
+            in
+              JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
+        | otherwise -> js
+  convert js = js
+  collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
+  collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
+    collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
+  collectAllFunctionArgs allArgs f (JSFunction ident args body@(JSBlock _)) =
+    (args : allArgs, body, f . JSFunction ident (map copyVar args))
+  collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args (JSBlock [body]))) =
+    collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction ident (map copyVar args) (JSBlock [b])))) body
+  collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
+    (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
+  collectAllFunctionArgs allArgs f body = (allArgs, body, f)
+  isTailCall :: String -> JS -> Bool
+  isTailCall ident js =
+    let
+      numSelfCalls = everythingOnJS (+) countSelfCalls js
+      numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
+      numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
+    in
+      numSelfCalls > 0
+      && numSelfCalls == numSelfCallsInTailPosition
+      && numSelfCallsUnderFunctions == 0
+    where
+    countSelfCalls :: JS -> Int
+    countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
+    countSelfCalls _ = 0
+    countSelfCallsInTailPosition :: JS -> Int
+    countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
+    countSelfCallsInTailPosition _ = 0
+    countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
+    countSelfCallsUnderFunctions _ = 0
+  toLoop :: String -> [String] -> JS -> JS
+  toLoop ident allArgs js = JSBlock $
+        map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
+        [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhereOnJS loopify js ]) ]
+    where
+    loopify :: JS -> JS
+    loopify (JSReturn ret) | isSelfCall ident ret =
+      let
+        allArgumentValues = concat $ collectSelfCallArgs [] ret
+      in
+        JSBlock $ zipWith (\val arg ->
+                    JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs
+                  ++ map (\arg ->
+                    JSAssignment (JSVar arg) (JSVar (tcoVar arg))) allArgs
+                  ++ [ JSContinue tcoLabel ]
+    loopify other = other
+    collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
+    collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
+    collectSelfCallArgs allArgumentValues _ = allArgumentValues
+  isSelfCall :: String -> JS -> Bool
+  isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True
+  isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn
+  isSelfCall _ _ = False
+  isFunction :: JS -> Bool
+  isFunction (JSFunction _ _ _) = True
+  isFunction _ = False
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs
@@ -0,0 +1,46 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CodeGen.JS.Optimizer.Unused
+-- Copyright   :  (c) Phil Freeman 2013-14
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Removes unused variables
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CodeGen.JS.Optimizer.Unused
+  ( removeCodeAfterReturnStatements
+  , removeUnusedArg
+  , removeUndefinedApp
+  ) where
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.CodeGen.JS.Optimizer.Common
+
+import qualified Language.PureScript.Constants as C
+
+removeCodeAfterReturnStatements :: JS -> JS
+removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
+  where
+  go :: [JS] -> [JS]
+  go jss | not (any isJSReturn jss) = jss
+         | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]
+  isJSReturn (JSReturn _) = True
+  isJSReturn _ = False
+
+removeUnusedArg :: JS -> JS
+removeUnusedArg = everywhereOnJS convert
+  where
+  convert (JSFunction name [arg] body) | arg == C.__unused = JSFunction name [] body
+  convert js = js
+
+removeUndefinedApp :: JS -> JS
+removeUndefinedApp = everywhereOnJS convert
+  where
+  convert (JSApp fn [JSVar arg]) | arg == C.undefined = JSApp fn []
+  convert js = js
diff --git a/src/Language/PureScript/Comments.hs b/src/Language/PureScript/Comments.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/Comments.hs
@@ -0,0 +1,25 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.Parser.Comments
+-- Copyright   :  (c) Phil Freeman 2015
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Defines the types of source code comments
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Language.PureScript.Comments where
+
+import qualified Data.Data as D
+    
+data Comment
+  = LineComment String
+  | BlockComment String
+  deriving (Show, Eq, Ord, D.Data, D.Typeable)
diff --git a/src/Language/PureScript/CoreFn.hs b/src/Language/PureScript/CoreFn.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn.hs
@@ -0,0 +1,26 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The core functional representation
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CoreFn (
+  module C
+) where
+
+import Language.PureScript.CoreFn.Ann as C
+import Language.PureScript.CoreFn.Binders as C
+import Language.PureScript.CoreFn.Desugar as C
+import Language.PureScript.CoreFn.Expr as C
+import Language.PureScript.CoreFn.Literals as C
+import Language.PureScript.CoreFn.Meta as C
+import Language.PureScript.CoreFn.Module as C
+import Language.PureScript.CoreFn.Traversals as C
diff --git a/src/Language/PureScript/CoreFn/Ann.hs b/src/Language/PureScript/CoreFn/Ann.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Ann.hs
@@ -0,0 +1,37 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Ann
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | Type alias for basic annotations
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CoreFn.Ann where
+
+import Language.PureScript.AST.SourcePos
+import Language.PureScript.CoreFn.Meta
+import Language.PureScript.Types
+import Language.PureScript.Comments
+
+-- |
+-- Type alias for basic annotations
+--
+type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
+
+-- |
+-- Initial annotation with no metadata
+--
+nullAnn :: Ann
+nullAnn = (Nothing, [], Nothing, Nothing)
+
+-- |
+-- Remove the comments from an annotation
+--
+removeComments :: Ann -> Ann
+removeComments (ss, _, ty, meta) = (ss, [], ty, meta)
diff --git a/src/Language/PureScript/CoreFn/Binders.hs b/src/Language/PureScript/CoreFn/Binders.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Binders.hs
@@ -0,0 +1,47 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Binders
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The core functional representation for binders
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Language.PureScript.CoreFn.Binders where
+
+import qualified Data.Data as D
+
+import Language.PureScript.CoreFn.Literals
+import Language.PureScript.Names
+
+-- |
+-- Data type for binders
+--
+data Binder a
+  -- |
+  -- Wildcard binder
+  --
+  = NullBinder a
+  -- |
+  -- A binder which matches a literal value
+  --
+  | LiteralBinder a (Literal (Binder a))
+  -- |
+  -- A binder which binds an identifier
+  --
+  | VarBinder a Ident
+  -- |
+  -- A binder which matches a data constructor (type name, constructor name, binders)
+  --
+  | ConstructorBinder a (Qualified ProperName) (Qualified ProperName) [Binder a]
+  -- |
+  -- A binder which binds its input to an identifier
+  --
+  | NamedBinder a Ident (Binder a) deriving (Show, D.Data, D.Typeable)
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -0,0 +1,242 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Desugar
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The AST -> CoreFn desugaring step
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
+
+import Data.Function (on)
+import Data.List (sort, sortBy, nub)
+import Data.Maybe (mapMaybe)
+import qualified Data.Map as M
+
+import Control.Arrow (second, (***))
+
+import Language.PureScript.AST.SourcePos
+import Language.PureScript.AST.Traversals
+import Language.PureScript.CoreFn.Ann
+import Language.PureScript.CoreFn.Binders
+import Language.PureScript.CoreFn.Expr
+import Language.PureScript.CoreFn.Literals
+import Language.PureScript.CoreFn.Meta
+import Language.PureScript.CoreFn.Module
+import Language.PureScript.Environment
+import Language.PureScript.Names
+import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
+import Language.PureScript.Types
+import Language.PureScript.Comments
+import qualified Language.PureScript.AST as A
+
+-- |
+-- Desugars a module from AST to CoreFn representation.
+--
+moduleToCoreFn :: Environment -> A.Module -> Module Ann
+moduleToCoreFn env (A.Module mn decls (Just exps)) =
+  let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
+      exps' = nub $ concatMap exportToCoreFn exps
+      externs = nub $ mapMaybe externToCoreFn decls
+      decls' = concatMap (declToCoreFn env Nothing []) decls
+  in Module mn imports exps' externs decls'
+moduleToCoreFn _ (A.Module{}) =
+  error "Module exports were not elaborated before moduleToCoreFn"
+
+findQualModules :: [A.Declaration] -> [ModuleName]
+findQualModules decls =
+  let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const [])
+  in f `concatMap` decls
+  where
+  fqValues :: A.Expr -> [ModuleName]
+  fqValues (A.Var (Qualified (Just mn) _)) = [mn]
+  fqValues _ = []
+
+-- |
+-- Desugars import declarations from AST to CoreFn representation.
+--
+importToCoreFn :: A.Declaration -> Maybe ModuleName
+importToCoreFn (A.ImportDeclaration name _ _) = Just name
+importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d
+importToCoreFn _ = Nothing
+
+-- |
+-- Desugars foreign declarations from AST to CoreFn representation.
+--
+externToCoreFn :: A.Declaration -> Maybe ForeignDecl
+externToCoreFn (A.ExternDeclaration _ name js ty) = Just (name, js, ty)
+externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, Nothing, tyObject)
+externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d
+externToCoreFn _ = Nothing
+
+-- |
+-- Desugars export declarations references from AST to CoreFn representation.
+-- CoreFn modules only export values, so all data constructors, class
+-- constructor, instances and values are flattened into one list.
+--
+exportToCoreFn :: A.DeclarationRef -> [Ident]
+exportToCoreFn (A.TypeRef _ (Just dctors)) = map properToIdent dctors
+exportToCoreFn (A.ValueRef name) = [name]
+exportToCoreFn (A.TypeClassRef name) = [properToIdent name]
+exportToCoreFn (A.TypeInstanceRef name) = [name]
+exportToCoreFn (A.PositionedDeclarationRef _ _ d) = exportToCoreFn d
+exportToCoreFn _ = []
+
+-- |
+-- Desugars member declarations from AST to CoreFn representation.
+--
+declToCoreFn :: Environment -> Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]
+declToCoreFn _ ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =
+  [NonRec (properToIdent ctor) $
+    Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]
+declToCoreFn _ _ _ d@(A.DataDeclaration Newtype _ _ _) =
+  error $ "Found newtype with multiple constructors: " ++ show d
+declToCoreFn _ ss com (A.DataDeclaration Data tyName _ ctors) =
+  flip map ctors $ \(ctor, tys) ->
+    NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor (length tys)
+declToCoreFn env ss _   (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn env ss []) ds
+declToCoreFn env ss com (A.ValueDeclaration name _ _ (Right e)) =
+  [NonRec name (exprToCoreFn env ss com Nothing e)]
+declToCoreFn env ss _   (A.BindingGroupDeclaration ds) =
+  [Rec $ map (\(name, _, e) -> (name, exprToCoreFn env ss [] Nothing e)) ds]
+declToCoreFn _   ss com (A.TypeClassDeclaration name _ supers members) =
+  [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
+declToCoreFn env _  com (A.PositionedDeclaration ss com1 d) =
+  declToCoreFn env (Just ss) (com ++ com1) d
+declToCoreFn _ _ _ _ = []
+
+-- |
+-- Makes a typeclass dictionary constructor function. The returned expression
+-- is a function that accepts the superclass instances and member
+-- implementations and returns a record for the instance dictionary.
+--
+mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.Declaration] -> Expr Ann
+mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])
+mkTypeClassConstructor ss com supers members =
+  let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers
+      props = [ (arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]
+      dict = Literal nullAnn (ObjectLiteral props)
+  in Abs (ss, com, Nothing, Just IsTypeClassConstructor)
+         (Ident a)
+         (foldr (Abs nullAnn . Ident) dict as)
+
+-- |
+-- Desugars expressions from AST to CoreFn representation.
+--
+exprToCoreFn :: Environment -> Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
+exprToCoreFn _ ss com ty (A.NumericLiteral v) =
+  Literal (ss, com, ty, Nothing) (NumericLiteral v)
+exprToCoreFn _ ss com ty (A.StringLiteral v) =
+  Literal (ss, com, ty, Nothing) (StringLiteral v)
+exprToCoreFn _ ss com ty (A.BooleanLiteral v) =
+  Literal (ss, com, ty, Nothing) (BooleanLiteral v)
+exprToCoreFn env ss com ty (A.ArrayLiteral vs) =
+  Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn env ss [] Nothing) vs)
+exprToCoreFn env ss com ty (A.ObjectLiteral vs) =
+  Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn env ss [] Nothing)) vs)
+exprToCoreFn env ss com ty (A.Accessor name v) =
+  Accessor (ss, com, ty, Nothing) name (exprToCoreFn env ss [] Nothing v)
+exprToCoreFn env ss com ty (A.ObjectUpdate obj vs) =
+  ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn env ss [] Nothing obj) $ map (second (exprToCoreFn env ss [] Nothing)) vs
+exprToCoreFn env ss com ty (A.Abs (Left name) v) =
+  Abs (ss, com, ty, Nothing) name (exprToCoreFn env ss [] Nothing v)
+exprToCoreFn _ _ _ _ (A.Abs _ _) =
+  error "Abs with Binder argument was not desugared before exprToCoreFn"
+exprToCoreFn env ss com ty (A.App v1 v2) =
+  App (ss, com, ty, Nothing) (exprToCoreFn env ss [] Nothing v1) (exprToCoreFn env ss [] Nothing v2)
+exprToCoreFn _ ss com ty (A.Var ident) =
+  Var (ss, com, ty, Nothing) ident
+exprToCoreFn env ss com ty (A.IfThenElse v1 v2 v3) =
+  Case (ss, com, ty, Nothing) [exprToCoreFn env ss [] Nothing v1]
+    [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
+                      (Right $ exprToCoreFn env Nothing [] Nothing v2)
+    , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
+                      (Right $ exprToCoreFn env Nothing [] Nothing v3) ]
+exprToCoreFn env ss com ty (A.Constructor name) =
+  Var (ss, com, ty, Just $ getConstructorMeta env name) $ fmap properToIdent name
+exprToCoreFn env ss com ty (A.Case vs alts) =
+  Case (ss, com, ty, Nothing) (map (exprToCoreFn env ss [] Nothing) vs) (map (altToCoreFn env ss) alts)
+exprToCoreFn env ss com _ (A.TypedValue _ v ty) =
+  exprToCoreFn env ss com (Just ty) v
+exprToCoreFn env ss com ty (A.Let ds v) =
+  Let (ss, com, ty, Nothing) (concatMap (declToCoreFn env ss []) ds) (exprToCoreFn env ss [] Nothing v)
+exprToCoreFn env ss com _  (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
+  let args = map (exprToCoreFn env ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
+      ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
+  in foldl (App (ss, com, Nothing, Nothing)) ctor args
+exprToCoreFn env _ com ty (A.PositionedValue ss com1 v) =
+  exprToCoreFn env (Just ss) (com ++ com1) ty v
+exprToCoreFn _ _ _ _ e =
+  error $ "Unexpected value in exprToCoreFn: " ++ show e
+
+-- |
+-- Desugars case alternatives from AST to CoreFn representation.
+--
+altToCoreFn :: Environment -> Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
+altToCoreFn env ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn env ss []) bs) (go vs)
+  where
+  go :: Either [(A.Guard, A.Expr)] A.Expr -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
+  go (Left ges) = Left $ map (exprToCoreFn env ss [] Nothing *** exprToCoreFn env ss [] Nothing) ges
+  go (Right e) = Right (exprToCoreFn env ss [] Nothing e)
+
+-- |
+-- Desugars case binders from AST to CoreFn representation.
+--
+binderToCoreFn :: Environment -> Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
+binderToCoreFn _ ss com (A.NullBinder) =
+  NullBinder (ss, com, Nothing, Nothing)
+binderToCoreFn _ ss com (A.BooleanBinder b) =
+  LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
+binderToCoreFn _ ss com (A.StringBinder s) =
+  LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
+binderToCoreFn _ ss com (A.NumberBinder n) =
+  LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
+binderToCoreFn _ ss com (A.VarBinder name) =
+  VarBinder (ss, com, Nothing, Nothing) name
+binderToCoreFn env ss com (A.ConstructorBinder dctor@(Qualified mn _) bs) =
+  let (_, tctor, _) = lookupConstructor env dctor
+  in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta env dctor) (Qualified mn tctor) dctor (map (binderToCoreFn env ss []) bs)
+binderToCoreFn env ss com (A.ObjectBinder bs) =
+  LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn env ss [])) bs)
+binderToCoreFn env ss com (A.ArrayBinder bs) =
+  LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn env ss []) bs)
+binderToCoreFn env ss com (A.ConsBinder b1 b2) =
+  let arrCtor = Qualified (Just $ ModuleName [ProperName "Prim"]) (ProperName "Array")
+  in ConstructorBinder (ss, com, Nothing, Nothing) arrCtor arrCtor $ map (binderToCoreFn env ss []) [b1, b2]
+binderToCoreFn env ss com (A.NamedBinder name b) =
+  NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn env ss [] b)
+binderToCoreFn env _ com (A.PositionedBinder ss com1 b) =
+  binderToCoreFn env (Just ss) (com ++ com1) b
+
+-- |
+-- Converts a ProperName to an Ident.
+--
+properToIdent :: ProperName -> Ident
+properToIdent = Ident . runProperName
+
+-- |
+-- Gets metadata for data constructors.
+--
+getConstructorMeta :: Environment -> Qualified ProperName -> Meta
+getConstructorMeta env ctor =
+  case lookupConstructor env ctor of
+    (Newtype, _, _) -> IsNewtype
+    dc@(Data, _, ty) ->
+      let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
+      in IsConstructor constructorType (getArity ty)
+  where
+  getArity :: Type -> Int
+  getArity (TypeApp (TypeApp f _) t) | f == tyFunction = getArity t + 1
+  getArity (ForAll _ ty _) = getArity ty
+  getArity _ = 0
+  numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
+  numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
+  typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
+  typeConstructor (Qualified (Just mn) _, (_, tyCtor, _)) = (mn, tyCtor)
+  typeConstructor _ = error "Invalid argument to typeConstructor"
diff --git a/src/Language/PureScript/CoreFn/Expr.hs b/src/Language/PureScript/CoreFn/Expr.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Expr.hs
@@ -0,0 +1,125 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Expr
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The core functional representation
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Language.PureScript.CoreFn.Expr where
+
+import qualified Data.Data as D
+
+import Language.PureScript.CoreFn.Binders
+import Language.PureScript.CoreFn.Literals
+import Language.PureScript.CoreFn.Meta
+import Language.PureScript.Names
+
+-- |
+-- Data type for expressions and terms
+--
+data Expr a
+  -- |
+  -- A literal value
+  --
+  = Literal a (Literal (Expr a))
+  -- |
+  -- A data constructor (type name, constructor name, arity)
+  --
+  | Constructor a ProperName ProperName Arity
+  -- |
+  -- A record property accessor
+  --
+  | Accessor a String (Expr a)
+  -- |
+  -- Partial record update
+  --
+  | ObjectUpdate a (Expr a) [(String, Expr a)]
+  -- |
+  -- Function introduction
+  --
+  | Abs a Ident (Expr a)
+  -- |
+  -- Function application
+  --
+  | App a (Expr a) (Expr a)
+  -- |
+  -- Variable
+  --
+  | Var a (Qualified Ident)
+  -- |
+  -- A case expression
+  --
+  | Case a [Expr a] [CaseAlternative a]
+  -- |
+  -- A let binding
+  --
+  | Let a [Bind a] (Expr a) deriving (Show, D.Data, D.Typeable)
+
+-- |
+-- A let or module binding.
+--
+data Bind a
+  -- |
+  -- Non-recursive binding for a single value
+  --
+  = NonRec Ident (Expr a)
+  -- |
+  -- Mutually recursive binding group for several values
+  --
+  | Rec [(Ident, Expr a)] deriving (Show, D.Data, D.Typeable)
+
+-- |
+-- A guard is just a boolean-valued expression that appears alongside a set of binders
+--
+type Guard a = Expr a
+
+-- |
+-- An alternative in a case statement
+--
+data CaseAlternative a = CaseAlternative
+  { -- |
+    -- A collection of binders with which to match the inputs
+    --
+    caseAlternativeBinders :: [Binder a]
+    -- |
+    -- The result expression or a collect of guarded expressions
+    --
+  , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
+  } deriving (Show, D.Data, D.Typeable)
+
+-- |
+-- Extract the annotation from a term
+--
+extractAnn :: Expr a -> a
+extractAnn (Literal a _) = a
+extractAnn (Constructor a _ _ _) = a
+extractAnn (Accessor a _ _) = a
+extractAnn (ObjectUpdate a _ _) = a
+extractAnn (Abs a _ _) = a
+extractAnn (App a _ _) = a
+extractAnn (Var a _) = a
+extractAnn (Case a _ _) = a
+extractAnn (Let a _ _) = a
+
+-- |
+-- Modify the annotation on a term
+--
+modifyAnn :: (a -> a) -> Expr a -> Expr a
+modifyAnn f (Literal a b)         = Literal (f a) b
+modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
+modifyAnn f (Accessor a b c)      = Accessor (f a) b c
+modifyAnn f (ObjectUpdate a b c)  = ObjectUpdate (f a) b c
+modifyAnn f (Abs a b c)           = Abs (f a) b c
+modifyAnn f (App a b c)           = App (f a) b c
+modifyAnn f (Var a b)             = Var (f a) b
+modifyAnn f (Case a b c)          = Case (f a) b c
+modifyAnn f (Let a b c)           = Let (f a) b c
diff --git a/src/Language/PureScript/CoreFn/Literals.hs b/src/Language/PureScript/CoreFn/Literals.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Literals.hs
@@ -0,0 +1,45 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Literals
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The core functional representation for literal values.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Language.PureScript.CoreFn.Literals where
+
+import qualified Data.Data as D
+
+-- |
+-- Data type for literal values. Parameterised so it can be used for Exprs and
+-- Binders.
+--
+data Literal a
+  -- |
+  -- A numeric literal
+  --
+  = NumericLiteral (Either Integer Double)
+  -- |
+  -- A string literal
+  --
+  | StringLiteral String
+  -- |
+  -- A boolean literal
+  --
+  | BooleanLiteral Bool
+  -- |
+  -- An array literal
+  --
+  | ArrayLiteral [a]
+  -- |
+  -- An object literal
+  --
+  | ObjectLiteral [(String, a)] deriving (Show, D.Data, D.Typeable)
diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Meta.hs
@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Meta
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | Metadata annotations for core functional representation
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Language.PureScript.CoreFn.Meta where
+
+import qualified Data.Data as D
+
+-- |
+-- Metadata annotations
+--
+data Meta
+  -- |
+  -- The contained value is a data constructor
+  --
+  = IsConstructor ConstructorType Arity
+  -- |
+  -- The contained value is a newtype
+  --
+  | IsNewtype
+  -- |
+  -- The contained value is a typeclass dictionary constructor
+  --
+  | IsTypeClassConstructor deriving (Show, D.Data, D.Typeable)
+
+-- |
+-- Type alias for constructor arity
+--
+type Arity = Int
+
+-- |
+-- Data constructor metadata
+--
+data ConstructorType
+  -- |
+  -- The constructor is for a type with a single construcor
+  --
+  = ProductType
+  -- |
+  -- The constructor is for a type with multiple construcors
+  --
+  | SumType deriving (Show, D.Data, D.Typeable)
diff --git a/src/Language/PureScript/CoreFn/Module.hs b/src/Language/PureScript/CoreFn/Module.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Module.hs
@@ -0,0 +1,30 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Module
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | The CoreFn module representation
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CoreFn.Module where
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.CoreFn.Expr
+import Language.PureScript.Names
+import Language.PureScript.Types
+
+data Module a = Module
+  { moduleName :: ModuleName
+  , moduleImports :: [ModuleName]
+  , moduleExports :: [Ident]
+  , moduleForeign :: [ForeignDecl]
+  , moduleDecls :: [Bind a]
+  } deriving (Show)
+
+type ForeignDecl = (Ident, Maybe JS, Type)
diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/CoreFn/Traversals.hs
@@ -0,0 +1,85 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.CoreFn.Traversals
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
+-- Stability   :  experimental
+-- Portability :
+--
+-- | CoreFn traversal helpers
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.CoreFn.Traversals where
+
+import Control.Arrow (second, (***), (+++))
+
+import Language.PureScript.CoreFn.Binders
+import Language.PureScript.CoreFn.Expr
+import Language.PureScript.CoreFn.Literals
+
+everywhereOnValues :: (Bind a -> Bind a) ->
+                      (Expr a -> Expr a) ->
+                      (Binder a -> Binder a) ->
+                      (Bind a -> Bind a, Expr a -> Expr a, Binder a -> Binder a)
+everywhereOnValues f g h = (f', g', h')
+  where
+  f' (NonRec name e) = f (NonRec name (g' e))
+  f' (Rec es) = f (Rec (map (second g') es))
+
+  g' (Literal ann e) = g (Literal ann (handleLiteral g' e))
+  g' (Accessor ann prop e) = g (Accessor ann prop (g' e))
+  g' (ObjectUpdate ann obj vs) = g (ObjectUpdate ann (g' obj) (map (fmap g') vs))
+  g' (Abs ann name e) = g (Abs ann name (g' e))
+  g' (App ann v1 v2) = g (App ann (g' v1) (g' v2))
+  g' (Case ann vs alts) = g (Case ann (map g' vs) (map handleCaseAlternative alts))
+  g' (Let ann ds e) = g (Let ann (map f' ds) (g' e))
+  g' e = g e
+
+  h' (LiteralBinder a b) = h (LiteralBinder a (handleLiteral h' b))
+  h' (NamedBinder a name b) = h (NamedBinder a name (h' b))
+  h' b = h b
+
+  handleCaseAlternative ca =
+    ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
+       , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
+       }
+
+  handleLiteral :: (a -> a) -> Literal a -> Literal a
+  handleLiteral i (ArrayLiteral ls) = ArrayLiteral (map i ls)
+  handleLiteral i (ObjectLiteral ls) = ObjectLiteral (map (fmap i) ls)
+  handleLiteral _ other = other
+
+everythingOnValues :: (r -> r -> r) ->
+                      (Bind a -> r) ->
+                      (Expr a -> r) ->
+                      (Binder a -> r) ->
+                      (CaseAlternative a -> r) ->
+                      (Bind a -> r, Expr a -> r, Binder a -> r, CaseAlternative a -> r)
+everythingOnValues (<>) f g h i = (f', g', h', i')
+  where
+  f' b@(NonRec _ e) = f b <> g' e
+  f' b@(Rec es) = foldl (<>) (f b) (map (g' . snd) es)
+
+  g' v@(Literal _ l) = foldl (<>) (g v) (map g' (extractLiteral l))
+  g' v@(Accessor _ _ e1) = g v <> g' e1
+  g' v@(ObjectUpdate _ obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
+  g' v@(Abs _ _ e1) = g v <> g' e1
+  g' v@(App _ e1 e2) = g v <> g' e1 <> g' e2
+  g' v@(Case _ vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
+  g' v@(Let _ ds e1) = foldl (<>) (g v) (map f' ds) <> g' e1
+  g' v = g v
+
+  h' b@(LiteralBinder _ l) = foldl (<>) (h b) (map h' (extractLiteral l))
+  h' b@(ConstructorBinder _ _ _ bs) = foldl (<>) (h b) (map h' bs)
+  h' b@(NamedBinder _ _ b1) = h b <> h' b1
+  h' b = h b
+
+  i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
+  i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
+
+  extractLiteral (ArrayLiteral xs) = xs
+  extractLiteral (ObjectLiteral xs) = map snd xs
+  extractLiteral _ = []
diff --git a/src/Language/PureScript/DeadCodeElimination.hs b/src/Language/PureScript/DeadCodeElimination.hs
--- a/src/Language/PureScript/DeadCodeElimination.hs
+++ b/src/Language/PureScript/DeadCodeElimination.hs
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :
 --
--- |
+-- | Dead code elimination.
 --
 -----------------------------------------------------------------------------
 
@@ -16,98 +16,87 @@
   eliminateDeadCode
 ) where
 
-import Data.List
 import Data.Graph
+import Data.List
 import Data.Maybe (mapMaybe)
 
+import Language.PureScript.CoreFn
 import Language.PureScript.Names
-import Language.PureScript.AST
 
 -- |
 -- Eliminate all declarations which are not a transitive dependency of the entry point module
 --
-eliminateDeadCode :: [ModuleName] -> [Module] -> [Module]
+eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
 eliminateDeadCode entryPoints ms = map go ms
   where
-  go (Module moduleName ds (Just exps)) = Module moduleName ds' (Just exps')
+  go (Module mn imps exps foreigns ds) = Module mn imps exps' foreigns' ds'
     where
-    ds' = filter (isUsed moduleName graph vertexFor entryPointVertices) ds
-    exps' = mapMaybe (filterExport ds') exps
-  go _ = error "Exports should have been elaborated in name desugaring"
+    ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
+    foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
+    names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
+    exps' = filter (`elem` names) exps
   declarations = concatMap declarationsByModule ms
   (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
   entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
 
-  filterExport :: [Declaration] -> DeclarationRef -> Maybe DeclarationRef
-  filterExport decls r@(TypeRef name _) | (any $ typeOrClassExists name) decls = Just r
-  filterExport decls r@(TypeClassRef name) | (any $ typeOrClassExists name) decls = Just r
-  filterExport decls r@(ValueRef name) | (any $ valueExists name) decls = Just r
-  filterExport decls r@(TypeInstanceRef name) | (any $ valueExists name) decls = Just r
-  filterExport _ _ = Nothing
-
-  valueExists :: Ident -> Declaration -> Bool
-  valueExists name (ValueDeclaration name' _ _ _) = name == name'
-  valueExists name (ExternDeclaration _ name' _ _) = name == name'
-  valueExists name (BindingGroupDeclaration decls) = any (\(name', _, _) -> name == name') decls
-  valueExists name (PositionedDeclaration _ d) = valueExists name d
-  valueExists _ _ = False
+-- |
+-- Extract declaration names for a binding group.
+--
+bindIdents :: Bind a -> [Ident]
+bindIdents (NonRec name _) = [name]
+bindIdents (Rec names) = map fst names
 
-  typeOrClassExists :: ProperName -> Declaration -> Bool
-  typeOrClassExists name (DataDeclaration _ name' _ _) = name == name'
-  typeOrClassExists name (TypeClassDeclaration name' _ _ _) = name == name'
-  typeOrClassExists name (DataBindingGroupDeclaration decls) = any (typeOrClassExists name) decls
-  typeOrClassExists name (PositionedDeclaration _ d) = typeOrClassExists name d
-  typeOrClassExists _ _ = False
+-- |
+-- Extract the ident for a foreign declaration.
+--
+foreignIdent :: ForeignDecl -> Ident
+foreignIdent (name, _, _) = name
 
-type Key = (ModuleName, Either Ident ProperName)
+-- |
+-- Key type to use in graph
+--
+type Key = (ModuleName, Ident)
 
-declarationsByModule :: Module -> [(Key, [Key])]
-declarationsByModule (Module moduleName ds _) = concatMap go ds
+-- |
+-- Find dependencies for each member in a module.
+--
+declarationsByModule :: Module a -> [(Key, [Key])]
+declarationsByModule (Module mn _ _ fs ds) =
+  let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
+  in fs' ++ concatMap go ds
   where
-  go :: Declaration -> [(Key, [Key])]
-  go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies moduleName d)]
-  go (DataDeclaration _ _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
-  go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
-  go d@(BindingGroupDeclaration names') = map (\(name, _, _) -> ((moduleName, Left name), dependencies moduleName d)) names'
-  go (DataBindingGroupDeclaration ds') = concatMap go ds'
-  go (TypeClassDeclaration name _ _ _) = [((moduleName, Right name), [])]
-  go (PositionedDeclaration _ d) = go d
-  go _ = []
+  go :: Bind a -> [(Key, [Key])]
+  go d@(NonRec name _) = [((mn, name), dependencies d)]
+  go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
 
-dependencies :: ModuleName -> Declaration -> [Key]
-dependencies moduleName =
-  let (f, _, _, _, _) = everythingOnValues (++) (const []) values (const []) (const []) (const [])
+-- |
+-- Find all referenced values within a binding group.
+--
+dependencies :: Bind a -> [Key]
+dependencies =
+  let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
   in nub . f
   where
-  values :: Expr -> [Key]
-  values (Var ident) = let (mn, name) = qualify moduleName ident in [(mn, Left name)]
-  values (Constructor (Qualified (Just mn) name)) = [(mn, Right name)]
-  values (Constructor (Qualified Nothing _)) = error "Found unqualified data constructor"
-  values (TypeClassDictionaryConstructorApp (Qualified (Just mn) name) _) = [(mn, Right name)]
-  values (TypeClassDictionaryConstructorApp (Qualified Nothing _) _) = error "Found unqualified class dictionary constructor"
+  values :: Expr a -> [Key]
+  values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
   values _ = []
+  binders :: Binder a -> [Key]
+  binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
+  binders _ = []
 
-isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Declaration -> Bool
-isUsed moduleName graph vertexFor entryPointVertices (ValueDeclaration name _ _ _) =
-  let Just v' = vertexFor (moduleName, Left name)
-  in any (\v -> path graph v v') entryPointVertices
-isUsed moduleName graph vertexFor entryPointVertices (FixityDeclaration _ name) =
-  let Just v' = vertexFor (moduleName, Left $ Op name)
-  in any (\v -> path graph v v') entryPointVertices
-isUsed moduleName graph vertexFor entryPointVertices (DataDeclaration _ _ _ dctors) =
-  any (\(pn, _) -> let Just v' = vertexFor (moduleName, Right pn)
-                   in any (\v -> path graph v v') entryPointVertices) dctors
-isUsed moduleName graph vertexFor entryPointVertices (ExternDeclaration _ name _ _) =
-  let Just v' = vertexFor (moduleName, Left name)
-  in any (\v -> path graph v v') entryPointVertices
-isUsed moduleName graph vertexFor entryPointVertices (BindingGroupDeclaration ds) =
-  any (\(name, _, _) -> let Just v' = vertexFor (moduleName, Left name)
-                        in any (\v -> path graph v v') entryPointVertices) ds
-isUsed moduleName graph vertexFor entryPointVertices (DataBindingGroupDeclaration ds) =
-  any (isUsed moduleName graph vertexFor entryPointVertices) ds
-isUsed moduleName graph vertexFor entryPointVertices (TypeClassDeclaration name _ _ _) =
-  let Just v' = vertexFor (moduleName, Right name)
+-- |
+-- Check whether a binding group is used.
+--
+isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
+isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
+  isUsed' mn graph vertexFor entryPointVertices name
+isUsed mn graph vertexFor entryPointVertices (Rec ds) =
+  any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
+
+-- |
+-- Check whether a named declaration is used.
+--
+isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
+isUsed' mn graph vertexFor entryPointVertices name =
+  let Just v' = vertexFor (mn, name)
   in any (\v -> path graph v v') entryPointVertices
-isUsed moduleName graph vertexFor entryPointVertices (PositionedDeclaration _ d) =
-  isUsed moduleName graph vertexFor entryPointVertices d
-isUsed _ _ _ _ _ = True
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -17,15 +17,15 @@
 module Language.PureScript.Environment where
 
 import Data.Data
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
 
-import Language.PureScript.Names
-import Language.PureScript.Types
 import Language.PureScript.Kinds
+import Language.PureScript.Names
 import Language.PureScript.TypeClassDictionaries
+import Language.PureScript.Types
 import qualified Language.PureScript.Constants as C
 
-import qualified Data.Map as M
-
 -- |
 -- The @Environment@ defines all values and types which are currently in scope:
 --
@@ -53,7 +53,7 @@
   -- |
   -- Type classes
   --
-  , typeClasses :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [(Qualified ProperName, [Type])])
+  , typeClasses :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
   } deriving (Show)
 
 -- |
@@ -219,3 +219,18 @@
                        , (primName "String"   , (Star, ExternData))
                        , (primName "Number"   , (Star, ExternData))
                        , (primName "Boolean"  , (Star, ExternData)) ]
+
+-- |
+-- Finds information about data constructors from the current environment.
+--
+lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
+lookupConstructor env ctor =
+  fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors env
+
+-- |
+-- Checks whether a data constructor is for a newtype.
+--
+isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
+isNewtypeConstructor e ctor = case lookupConstructor e ctor of
+  (Newtype, _, _) -> True
+  (Data, _, _) -> False
diff --git a/src/Language/PureScript/ModuleDependencies.hs b/src/Language/PureScript/ModuleDependencies.hs
--- a/src/Language/PureScript/ModuleDependencies.hs
+++ b/src/Language/PureScript/ModuleDependencies.hs
@@ -64,9 +64,6 @@
   forTypes (ConstrainedType cs _) = mapMaybe (\(Qualified mn _, _) -> mn) cs
   forTypes _ = []
 
-getModuleName :: Module -> ModuleName
-getModuleName (Module mn _ _) = mn
-
 -- |
 -- Convert a strongly connected component of the module graph to a module
 --
diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs
--- a/src/Language/PureScript/Names.hs
+++ b/src/Language/PureScript/Names.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
 
 module Language.PureScript.Names where
 
@@ -71,7 +71,7 @@
 -- |
 -- A qualified name, i.e. a name with an optional module name
 --
-data Qualified a = Qualified (Maybe ModuleName) a deriving (Eq, Ord, Data, Typeable)
+data Qualified a = Qualified (Maybe ModuleName) a deriving (Eq, Ord, Data, Typeable, Functor)
 
 instance (Show a) => Show (Qualified a) where
   show (Qualified Nothing a) = show a
diff --git a/src/Language/PureScript/Optimizer.hs b/src/Language/PureScript/Optimizer.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer.hs
+++ /dev/null
@@ -1,76 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer
--- Copyright   :  (c) Phil Freeman 2013
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- This module optimizes code in the simplified-Javascript intermediate representation.
---
--- The following optimizations are supported:
---
---  * Collapsing nested blocks
---
---  * Tail call elimination
---
---  * Inlining of (>>=) and ret for the Eff monad
---
---  * Removal of unnecessary thunks
---
---  * Eta conversion
---
---  * Inlining variables
---
---  * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
---
---  * Inlining primitive Javascript operators
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer (
-    optimize
-) where
-
-import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.Options
-import qualified Language.PureScript.Constants as C
-
-import Language.PureScript.Optimizer.Common
-import Language.PureScript.Optimizer.TCO
-import Language.PureScript.Optimizer.MagicDo
-import Language.PureScript.Optimizer.Inliner
-import Language.PureScript.Optimizer.Unused
-import Language.PureScript.Optimizer.Blocks
-
--- |
--- Apply a series of optimizer passes to simplified Javascript code
---
-optimize :: Options mode -> JS -> JS
-optimize opts | optionsNoOptimizations opts = id
-              | otherwise = untilFixedPoint (applyAll
-  [ collapseNestedBlocks
-  , collapseNestedIfs
-  , tco opts
-  , magicDo opts
-  , removeCodeAfterReturnStatements
-  , removeUnusedArg
-  , removeUndefinedApp
-  , unThunk
-  , etaConvert
-  , evaluateIifes
-  , inlineVariables
-  , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
-  , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
-  , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
-  , inlineCommonOperators ])
-
-untilFixedPoint :: (Eq a) => (a -> a) -> a -> a
-untilFixedPoint f = go
-  where
-  go a = let a' = f a in
-          if a' == a then a' else go a'
-
diff --git a/src/Language/PureScript/Optimizer/Blocks.hs b/src/Language/PureScript/Optimizer/Blocks.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/Blocks.hs
+++ /dev/null
@@ -1,42 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.Blocks
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- Optimizer steps for simplifying Javascript blocks
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.Blocks
-  ( collapseNestedBlocks
-  , collapseNestedIfs
-  ) where
-
-import Language.PureScript.CodeGen.JS.AST
-
--- |
--- Collapse blocks which appear nested directly below another block
---
-collapseNestedBlocks :: JS -> JS
-collapseNestedBlocks = everywhereOnJS collapse
-  where
-  collapse :: JS -> JS
-  collapse (JSBlock sts) = JSBlock (concatMap go sts)
-  collapse js = js
-  go :: JS -> [JS]
-  go (JSBlock sts) = sts
-  go s = [s]
-
-collapseNestedIfs :: JS -> JS
-collapseNestedIfs = everywhereOnJS collapse
-  where
-  collapse :: JS -> JS
-  collapse (JSIfElse cond1 (JSBlock [JSIfElse cond2 body Nothing]) Nothing) =
-      JSIfElse (JSBinary And cond1 cond2) body Nothing
-  collapse js = js
diff --git a/src/Language/PureScript/Optimizer/Common.hs b/src/Language/PureScript/Optimizer/Common.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/Common.hs
+++ /dev/null
@@ -1,77 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.Common
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- Common functions used by the various optimizer phases
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.Common where
-
-import Data.Maybe (fromMaybe)
-
-import Language.PureScript.CodeGen.JS.AST
-
-applyAll :: [a -> a] -> a -> a
-applyAll = foldl1 (.)
-
-replaceIdent :: String -> JS -> JS -> JS
-replaceIdent var1 js = everywhereOnJS replace
-  where
-  replace (JSVar var2) | var1 == var2 = js
-  replace other = other
-
-replaceIdents :: [(String, JS)] -> JS -> JS
-replaceIdents vars = everywhereOnJS replace
-  where
-  replace v@(JSVar var) = fromMaybe v $ lookup var vars
-  replace other = other
-
-isReassigned :: String -> JS -> Bool
-isReassigned var1 = everythingOnJS (||) check
-  where
-  check :: JS -> Bool
-  check (JSFunction _ args _) | var1 `elem` args = True
-  check (JSVariableIntroduction arg _) | var1 == arg = True
-  check (JSAssignment (JSVar arg) _) | var1 == arg = True
-  check (JSFor arg _ _ _) | var1 == arg = True
-  check (JSForIn arg _ _) | var1 == arg = True
-  check _ = False
-
-isRebound :: JS -> JS -> Bool
-isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)
-  where
-  variablesOf (JSVar var) = [var]
-  variablesOf _ = []
-
-isUsed :: String -> JS -> Bool
-isUsed var1 = everythingOnJS (||) check
-  where
-  check :: JS -> Bool
-  check (JSVar var2) | var1 == var2 = True
-  check (JSAssignment target _) | var1 == targetVariable target = True
-  check _ = False
-
-targetVariable :: JS -> String
-targetVariable (JSVar var) = var
-targetVariable (JSAccessor _ tgt) = targetVariable tgt
-targetVariable (JSIndexer _ tgt) = targetVariable tgt
-targetVariable _ = error "Invalid argument to targetVariable"
-
-isUpdated :: String -> JS -> Bool
-isUpdated var1 = everythingOnJS (||) check
-  where
-  check :: JS -> Bool
-  check (JSAssignment target _) | var1 == targetVariable target = True
-  check _ = False
-
-removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
-removeFromBlock go (JSBlock sts) = JSBlock (go sts)
-removeFromBlock _  js = js
diff --git a/src/Language/PureScript/Optimizer/Inliner.hs b/src/Language/PureScript/Optimizer/Inliner.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/Inliner.hs
+++ /dev/null
@@ -1,192 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.Inliner
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- This module provides basic inlining capabilities
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.Inliner (
-  inlineVariables,
-  inlineOperator,
-  inlineCommonOperators,
-  etaConvert,
-  unThunk,
-  evaluateIifes
-) where
-
-import Data.Maybe (fromMaybe)
-
-import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.CodeGen.Common (identToJs)
-import Language.PureScript.Optimizer.Common
-import Language.PureScript.Names
-
-import qualified Language.PureScript.Constants as C
-
-shouldInline :: JS -> Bool
-shouldInline (JSVar _) = True
-shouldInline (JSNumericLiteral _) = True
-shouldInline (JSStringLiteral _) = True
-shouldInline (JSBooleanLiteral _) = True
-shouldInline (JSAccessor _ val) = shouldInline val
-shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
-shouldInline _ = False
-
-etaConvert :: JS -> JS
-etaConvert = everywhereOnJS convert
-  where
-  convert :: JS -> JS
-  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
-    | all shouldInline args &&
-      not (any (`isRebound` block) (map JSVar idents)) &&
-      not (any (`isRebound` block) args)
-      = JSBlock (map (replaceIdents (zip idents args)) body)
-  convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
-  convert js = js
-
-unThunk :: JS -> JS
-unThunk = everywhereOnJS convert
-  where
-  convert :: JS -> JS
-  convert (JSBlock []) = JSBlock []
-  convert (JSBlock jss) =
-    case last jss of
-      JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
-      _ -> JSBlock jss
-  convert js = js
-
-evaluateIifes :: JS -> JS
-evaluateIifes = everywhereOnJS convert
-  where
-  convert :: JS -> JS
-  convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
-  convert js = js
-
-inlineVariables :: JS -> JS
-inlineVariables = everywhereOnJS $ removeFromBlock go
-  where
-  go :: [JS] -> [JS]
-  go [] = []
-  go (JSVariableIntroduction var (Just js) : sts)
-    | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
-      go (map (replaceIdent var js) sts)
-  go (s:sts) = s : go sts
-
-inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
-inlineOperator (m, op) f = everywhereOnJS convert
-  where
-  convert :: JS -> JS
-  convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
-  convert other = other
-  isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)
-  isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'
-  isOp _ = False
-
-inlineCommonOperators :: JS -> JS
-inlineCommonOperators = applyAll $
-  [ binary C.numNumber (C.+) Add
-  , binary C.numNumber (C.-) Subtract
-  , binary C.numNumber (C.*) Multiply
-  , binary C.numNumber (C./) Divide
-  , binary C.numNumber (C.%) Modulus
-  , unary  C.numNumber C.negate Negate
-
-  , binary C.ordNumber (C.<) LessThan
-  , binary C.ordNumber (C.>) GreaterThan
-  , binary C.ordNumber (C.<=) LessThanOrEqualTo
-  , binary C.ordNumber (C.>=) GreaterThanOrEqualTo
-
-  , binary C.eqNumber (C.==) EqualTo
-  , binary C.eqNumber (C./=) NotEqualTo
-  , binary C.eqString (C.==) EqualTo
-  , binary C.eqString (C./=) NotEqualTo
-  , binary C.eqBoolean (C.==) EqualTo
-  , binary C.eqBoolean (C./=) NotEqualTo
-
-  , binary C.semigroupString (C.<>) Add
-  , binary C.semigroupString (C.++) Add
-
-  , binaryFunction C.bitsNumber C.shl ShiftLeft
-  , binaryFunction C.bitsNumber C.shr ShiftRight
-  , binaryFunction C.bitsNumber C.zshr ZeroFillShiftRight
-  , binary         C.bitsNumber (C..&.) BitwiseAnd
-  , binary         C.bitsNumber (C..|.) BitwiseOr
-  , binary         C.bitsNumber (C..^.) BitwiseXor
-  , unary          C.bitsNumber C.complement BitwiseNot
-
-  , binary C.boolLikeBoolean (C.&&) And
-  , binary C.boolLikeBoolean (C.||) Or
-  , unary  C.boolLikeBoolean C.not Not
-  ] ++
-  [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
-  where
-  binary :: String -> String -> BinaryOperator -> JS -> JS
-  binary dictName opString op = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
-    convert other = other
-    isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op opString)
-    isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'
-    isOp _ = False
-  binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
-  binaryFunction dictName fnName op = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
-    convert other = other
-    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'
-    isOp _ = False
-  unary :: String -> String -> UnaryOperator -> JS -> JS
-  unary dictName fnName op = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x
-    convert other = other
-    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
-    isOp _ = False
-  isOpDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
-  isOpDict _ _ = False
-  mkFn :: Int -> JS -> JS
-  mkFn 0 = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
-      JSFunction Nothing [] (JSBlock js)
-    convert other = other
-  mkFn n = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
-      case collectArgs n [] fn of
-        Just (args, js) -> JSFunction Nothing args (JSBlock js)
-        Nothing -> orig
-    convert other = other
-    collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
-    collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
-    collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
-    collectArgs _ _   _ = Nothing
-
-  isNFn :: String -> Int -> JS -> Bool
-  isNFn prefix n (JSVar name) = name == (prefix ++ show n)
-  isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
-  isNFn _ _ _ = False
-
-  runFn :: Int -> JS -> JS
-  runFn n = everywhereOnJS convert
-    where
-    convert :: JS -> JS
-    convert js = fromMaybe js $ go n [] js
-
-    go :: Int -> [JS] -> JS -> Maybe JS
-    go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
-    go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
-    go _ _   _ = Nothing
diff --git a/src/Language/PureScript/Optimizer/MagicDo.hs b/src/Language/PureScript/Optimizer/MagicDo.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/MagicDo.hs
+++ /dev/null
@@ -1,162 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.MagicDo
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- This module implements the "Magic Do" optimization, which inlines calls to return
--- and bind for the Eff monad, as well as some of its actions.
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.MagicDo (
-  magicDo
-) where
-
-import Data.List (nub)
-import Data.Maybe (fromJust, isJust)
-
-import Language.PureScript.Options
-import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.CodeGen.Common (identToJs)
-import Language.PureScript.Names
-
-import qualified Language.PureScript.Constants as C
-
-magicDo :: Options mode -> JS -> JS
-magicDo opts | optionsNoMagicDo opts = id
-             | otherwise = inlineST . magicDo'
-
--- |
--- Inline type class dictionaries for >>= and return for the Eff monad
---
--- E.g.
---
---  Prelude[">>="](dict)(m1)(function(x) {
---    return ...;
---  })
---
--- becomes
---
---  function __do {
---    var x = m1();
---    ...
---  }
---
-magicDo' :: JS -> JS
-magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
-  where
-  -- The name of the function block which is added to denote a do block
-  fnName = "__do"
-  -- Desugar monomorphic calls to >>= and return for the Eff monad
-  convert :: JS -> JS
-  -- Desugar return
-  convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
-  -- Desugar pure
-  convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
-  -- Desugar >>
-  convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
-    let JSReturn ret = last js in
-    JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )
-  -- Desugar >>=
-  convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
-    let JSReturn ret = last js in
-    JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
-  -- Desugar untilE
-  convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
-    JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
-  -- Desugar whileE
-  convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
-    JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
-  convert other = other
-  -- Check if an expression represents a monomorphic call to >>= for the Eff monad
-  isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
-  isBind _ = False
-  -- Check if an expression represents a monomorphic call to return for the Eff monad
-  isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
-  isReturn _ = False
-  -- Check if an expression represents a monomorphic call to pure for the Eff applicative
-  isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
-  isPure _ = False
-  -- Check if an expression represents the polymorphic >>= function
-  isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
-  isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
-  isBindPoly _ = False
-  -- Check if an expression represents the polymorphic return function
-  isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
-  isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return
-  isRetPoly _ = False
-  -- Check if an expression represents the polymorphic pure function
-  isPurePoly (JSAccessor pure' (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
-  isPurePoly (JSIndexer (JSStringLiteral pure') (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
-  isPurePoly _ = False
-  -- Check if an expression represents a function in the Ef module
-  isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
-  isEffFunc _ _ = False
-  -- Check if an expression represents the Monad Eff dictionary
-  isEffDict name (JSVar ident) | ident == name = True
-  isEffDict name (JSAccessor prop (JSVar eff)) = eff == C.eff && prop == name
-  isEffDict _ _ = False
-  -- Remove __do function applications which remain after desugaring
-  undo :: JS -> JS
-  undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
-  undo other = other
-
-  isJSReturn (JSReturn _) = True
-  isJSReturn _ = False
-
--- |
--- Inline functions in the ST module
---
-inlineST :: JS -> JS
-inlineST = everywhereOnJS convertBlock
-  where
-  -- Look for runST blocks and inline the STRefs there.
-  -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
-  -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
-  convertBlock (JSApp f [arg]) | isSTFunc C.runST f =
-    let refs = nub . findSTRefsIn $ arg
-        usages = findAllSTUsagesIn arg
-        allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
-        localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
-    in everywhereOnJS (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg
-  convertBlock other = other
-  -- Convert a block in a safe way, preserving object wrappers of references,
-  -- or in a more aggressive way, turning wrappers into local variables depending on the
-  -- agg(ressive) parameter.
-  convert agg (JSApp f [arg]) | isSTFunc C.newSTRef f =
-   JSFunction Nothing [] (JSBlock [JSReturn $ if agg then arg else JSObjectLiteral [(C.stRefValue, arg)]])
-  convert agg (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f =
-    if agg then ref else JSAccessor C.stRefValue ref
-  convert agg (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
-    if agg then JSAssignment ref arg else JSAssignment (JSAccessor C.stRefValue ref) arg
-  convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
-    if agg then JSAssignment ref (JSApp func [ref]) else  JSAssignment (JSAccessor C.stRefValue ref) (JSApp func [JSAccessor C.stRefValue ref])
-  convert _ other = other
-  -- Check if an expression represents a function in the ST module
-  isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'
-  isSTFunc _ _ = False
-  -- Find all ST Refs initialized in this block
-  findSTRefsIn = everythingOnJS (++) isSTRef
-    where
-    isSTRef (JSVariableIntroduction ident (Just (JSApp (JSApp f [_]) []))) | isSTFunc C.newSTRef f = [ident]
-    isSTRef _ = []
-  -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef
-  findAllSTUsagesIn = everythingOnJS (++) isSTUsage
-    where
-    isSTUsage (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f = [ref]
-    isSTUsage (JSApp (JSApp (JSApp f [ref]) [_]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
-    isSTUsage _ = []
-  -- Find all uses of a variable
-  appearingIn ref = everythingOnJS (++) isVar
-    where
-    isVar e@(JSVar v) | v == ref = [e]
-    isVar _ = []
-  -- Convert a JS value to a String if it is a JSVar
-  toVar (JSVar v) = Just v
-  toVar _ = Nothing
diff --git a/src/Language/PureScript/Optimizer/TCO.hs b/src/Language/PureScript/Optimizer/TCO.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/TCO.hs
+++ /dev/null
@@ -1,103 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.TCO
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- This module implements tail call elimination.
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.TCO (tco) where
-
-import Language.PureScript.Options
-import Language.PureScript.CodeGen.JS.AST
-
--- |
--- Eliminate tail calls
---
-tco :: Options mode -> JS -> JS
-tco opts | optionsNoTco opts = id
-         | otherwise = tco'
-
-tco' :: JS -> JS
-tco' = everywhereOnJS convert
-  where
-  tcoLabel :: String
-  tcoLabel = "tco"
-  tcoVar :: String -> String
-  tcoVar arg = "__tco_" ++ arg
-  copyVar :: String -> String
-  copyVar arg = "__copy_" ++ arg
-  convert :: JS -> JS
-  convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
-    let
-      (argss, body', replace) = collectAllFunctionArgs [] id fn
-    in case () of
-      _ | isTailCall name body' ->
-            let
-              allArgs = concat $ reverse argss
-            in
-              JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
-        | otherwise -> js
-  convert js = js
-  collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
-  collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
-    collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
-  collectAllFunctionArgs allArgs f (JSFunction ident args body@(JSBlock _)) =
-    (args : allArgs, body, f . JSFunction ident (map copyVar args))
-  collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args (JSBlock [body]))) =
-    collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction ident (map copyVar args) (JSBlock [b])))) body
-  collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
-    (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
-  collectAllFunctionArgs allArgs f body = (allArgs, body, f)
-  isTailCall :: String -> JS -> Bool
-  isTailCall ident js =
-    let
-      numSelfCalls = everythingOnJS (+) countSelfCalls js
-      numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
-      numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
-    in
-      numSelfCalls > 0
-      && numSelfCalls == numSelfCallsInTailPosition
-      && numSelfCallsUnderFunctions == 0
-    where
-    countSelfCalls :: JS -> Int
-    countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
-    countSelfCalls _ = 0
-    countSelfCallsInTailPosition :: JS -> Int
-    countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
-    countSelfCallsInTailPosition _ = 0
-    countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
-    countSelfCallsUnderFunctions _ = 0
-  toLoop :: String -> [String] -> JS -> JS
-  toLoop ident allArgs js = JSBlock $
-        map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
-        [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhereOnJS loopify js ]) ]
-    where
-    loopify :: JS -> JS
-    loopify (JSReturn ret) | isSelfCall ident ret =
-      let
-        allArgumentValues = concat $ collectSelfCallArgs [] ret
-      in
-        JSBlock $ zipWith (\val arg ->
-                    JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs
-                  ++ map (\arg ->
-                    JSAssignment (JSVar arg) (JSVar (tcoVar arg))) allArgs
-                  ++ [ JSContinue tcoLabel ]
-    loopify other = other
-    collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
-    collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
-    collectSelfCallArgs allArgumentValues _ = allArgumentValues
-  isSelfCall :: String -> JS -> Bool
-  isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True
-  isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn
-  isSelfCall _ _ = False
-  isFunction :: JS -> Bool
-  isFunction (JSFunction _ _ _) = True
-  isFunction _ = False
diff --git a/src/Language/PureScript/Optimizer/Unused.hs b/src/Language/PureScript/Optimizer/Unused.hs
deleted file mode 100644
--- a/src/Language/PureScript/Optimizer/Unused.hs
+++ /dev/null
@@ -1,46 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Optimizer.Unused
--- Copyright   :  (c) Phil Freeman 2013-14
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
--- Removes unused variables
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Optimizer.Unused
-  ( removeCodeAfterReturnStatements
-  , removeUnusedArg
-  , removeUndefinedApp
-  ) where
-
-import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.Optimizer.Common
-
-import qualified Language.PureScript.Constants as C
-
-removeCodeAfterReturnStatements :: JS -> JS
-removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
-  where
-  go :: [JS] -> [JS]
-  go jss | not (any isJSReturn jss) = jss
-         | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]
-  isJSReturn (JSReturn _) = True
-  isJSReturn _ = False
-
-removeUnusedArg :: JS -> JS
-removeUnusedArg = everywhereOnJS convert
-  where
-  convert (JSFunction name [arg] body) | arg == C.__unused = JSFunction name [] body
-  convert js = js
-
-removeUndefinedApp :: JS -> JS
-removeUndefinedApp = everywhereOnJS convert
-  where
-  convert (JSApp fn [JSVar arg]) | arg == C.undefined = JSApp fn []
-  convert js = js
diff --git a/src/Language/PureScript/Parser.hs b/src/Language/PureScript/Parser.hs
--- a/src/Language/PureScript/Parser.hs
+++ b/src/Language/PureScript/Parser.hs
@@ -31,4 +31,5 @@
 import Language.PureScript.Parser.Types as P
 import Language.PureScript.Parser.State as P
 import Language.PureScript.Parser.Kinds as P
+import Language.PureScript.Parser.Lexer as P
 import Language.PureScript.Parser.Declarations as P
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -17,299 +17,47 @@
 
 module Language.PureScript.Parser.Common where
 
-import Data.Functor.Identity
 import Control.Applicative
-import Control.Monad
-import Language.PureScript.Parser.State
-import qualified Text.Parsec as P
-import qualified Text.Parsec.Token as PT
+import Control.Monad (guard)
 
+import Language.PureScript.Comments
+import Language.PureScript.Parser.Lexer
+import Language.PureScript.Parser.State
 import Language.PureScript.Names
 
--- |
--- A list of purescript reserved identifiers
---
-reservedPsNames :: [String]
-reservedPsNames = [ "data"
-                  , "newtype"
-                  , "type"
-                  , "foreign"
-                  , "import"
-                  , "infixl"
-                  , "infixr"
-                  , "infix"
-                  , "class"
-                  , "instance"
-                  , "module"
-                  , "case"
-                  , "of"
-                  , "if"
-                  , "then"
-                  , "else"
-                  , "do"
-                  , "let"
-                  , "true"
-                  , "false"
-                  , "in"
-                  , "where"
-                  ]
-
--- |
--- The characters allowed for use in operators
---
-opChars :: [Char]
-opChars = ":!#$%&*+./<=>?@\\^|-~"
-
--- |
--- A list of reserved identifiers for types
---
-reservedTypeNames :: [String]
-reservedTypeNames = [ "forall"
-                    , "where" ]
-
--- |
--- A list of reserved operators
---
-reservedOpNames :: [String]
-reservedOpNames = [ "=>", "->", "=", ".", "\\", "|" ]
-
--- |
--- Valid first characters for an identifier
---
-identStart :: P.Parsec String u Char
-identStart = P.lower <|> P.oneOf "_"
-
--- |
--- Valid identifier characters
---
-identLetter :: P.Parsec String u Char
-identLetter = P.alphaNum <|> P.oneOf "_'"
-
--- |
--- Valid first characters for an operator
---
-opStart :: P.Parsec String u Char
-opStart = P.oneOf opChars
-
--- |
--- Valid operators characters
---
-opLetter :: P.Parsec String u Char
-opLetter = P.oneOf opChars
-
--- |
--- The PureScript language definition
---
-langDef :: PT.GenLanguageDef String u Identity
-langDef = PT.LanguageDef
-  { PT.reservedNames   = reservedPsNames
-  , PT.reservedOpNames = reservedOpNames
-  , PT.commentStart    = "{-"
-  , PT.commentEnd      = "-}"
-  , PT.commentLine     = "--"
-  , PT.nestedComments  = True
-  , PT.identStart      = identStart
-  , PT.identLetter     = identLetter
-  , PT.opStart         = opStart
-  , PT.opLetter        = opLetter
-  , PT.caseSensitive   = True
-  }
-
--- |
--- A token parser based on the language definition
---
-tokenParser :: PT.GenTokenParser String u Identity
-tokenParser = PT.makeTokenParser langDef
-
--- |
--- Parse a token
---
-lexeme :: P.Parsec String u a -> P.Parsec String u a
-lexeme = PT.lexeme tokenParser
-
--- |
--- Parse an identifier
---
-identifier :: P.Parsec String u String
-identifier = PT.identifier tokenParser
-
--- |
--- Parse an identifier in a more permissive position
---
-identifierName :: P.Parsec String u String
-identifierName = lexeme $ (:) <$> identStart <*> many identLetter
-
--- |
--- Parse a reserved word
---
-reserved :: String -> P.Parsec String u ()
-reserved = PT.reserved tokenParser
-
--- |
--- Parse a reserved operator
---
-reservedOp :: String -> P.Parsec String u ()
-reservedOp = PT.reservedOp tokenParser
-
--- |
--- Parse an operator
---
-operator :: P.Parsec String u String
-operator = PT.operator tokenParser
-
--- |
--- Parse a string literal
---
-stringLiteral :: P.Parsec String u String
-stringLiteral = lexeme blockString <|> PT.stringLiteral tokenParser
-  where delimeter   = P.try (P.string "\"\"\"")
-        blockString = delimeter >> P.manyTill P.anyChar delimeter
-
--- |
--- Parse whitespace
---
-whiteSpace :: P.Parsec String u ()
-whiteSpace = PT.whiteSpace tokenParser
-
--- |
--- Semicolon
---
-semi :: P.Parsec String u String
-semi = PT.semi tokenParser
-
--- |
--- Colon
---
-colon :: P.Parsec String u String
-colon = PT.colon tokenParser
-
--- |
--- Period
---
-dot :: P.Parsec String u String
-dot = PT.dot tokenParser
-
--- |
--- Comma
---
-comma :: P.Parsec String u String
-comma = PT.comma tokenParser
-
--- |
--- Backtick
---
-tick :: P.Parsec String u Char
-tick = lexeme $ P.char '`'
-
--- |
--- Pipe character
---
-pipe :: P.Parsec String u Char
-pipe = lexeme $ P.char '|'
-
--- |
--- Natural number
---
-natural :: P.Parsec String u Integer
-natural = PT.natural tokenParser
+import qualified Text.Parsec as P
 
--- |
--- Parse a proper name
---
-properName :: P.Parsec String u ProperName
-properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum P.<?> "name")
+properName :: TokenParser ProperName
+properName = ProperName <$> uname
 
 -- |
 -- Parse a module name
 --
-moduleName :: P.Parsec String ParseState ModuleName
-moduleName = ModuleName <$> P.try (sepBy properName dot)
+moduleName :: TokenParser ModuleName
+moduleName = part []
+  where
+  part path = (do name <- ProperName <$> P.try qualifier
+                  part (path `snoc` name))
+              <|> (ModuleName . snoc path . ProperName <$> mname)
+  snoc path name = path ++ [name]
 
 -- |
 -- Parse a qualified name, i.e. M.name or just name
 --
-parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)
+parseQualified :: TokenParser a -> TokenParser (Qualified a)
 parseQualified parser = part []
   where
-  part path = (do name <- P.try (properName <* delimiter)
+  part path = (do name <- ProperName <$> P.try qualifier
                   part (updatePath path name))
               <|> (Qualified (qual path) <$> P.try parser)
-  delimiter = indented *> dot <* P.notFollowedBy dot
   updatePath path name = path ++ [name]
   qual path = if null path then Nothing else Just $ ModuleName path
 
 -- |
--- Parse an integer or floating point value
---
-integerOrFloat :: P.Parsec String u (Either Integer Double)
-integerOrFloat = (Right <$> P.try (PT.float tokenParser) <|>
-                  Left <$> P.try (PT.natural tokenParser)) P.<?> "number"
-
--- |
 -- Parse an identifier or parenthesized operator
 --
-parseIdent :: P.Parsec String ParseState Ident
-parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
-
--- |
--- Parse a token inside square brackets
---
-squares :: P.Parsec String ParseState a -> P.Parsec String ParseState a
-squares = P.between (lexeme $ P.char '[') (lexeme $ indented *> P.char ']') . (indented *>)
-
--- |
--- Parse a token inside parentheses
---
-parens :: P.Parsec String ParseState a -> P.Parsec String ParseState a
-parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)
-
--- |
--- Parse a token inside braces
---
-braces :: P.Parsec String ParseState a -> P.Parsec String ParseState a
-braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)
-
--- |
--- Parse a token inside angle brackets
---
-angles :: P.Parsec String ParseState a -> P.Parsec String ParseState a
-angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)
-
--- |
--- Parse zero or more values separated by a separator token
---
-sepBy :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
-sepBy p s = P.sepBy (indented *> p) (indented *> s)
-
--- |
--- Parse one or more values separated by a separator token
---
-sepBy1 :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
-sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)
-
--- |
--- Parse zero or more values separated by semicolons
---
-semiSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-semiSep = flip sepBy semi
-
--- |
--- Parse one or more values separated by semicolons
---
-semiSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-semiSep1 = flip sepBy1 semi
-
--- |
--- Parse zero or more values separated by commas
---
-commaSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-commaSep = flip sepBy comma
-
--- |
--- Parse one or more values separated by commas
---
-commaSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-commaSep1 = flip sepBy1 comma
+parseIdent :: TokenParser Ident
+parseIdent = (Ident <$> identifier) <|> (Op <$> parens symbol)
 
 -- |
 -- Run the first parser, then match the second if possible, applying the specified function on a successful match
@@ -343,13 +91,13 @@
 -- |
 -- Parse an identifier in backticks or an operator
 --
-parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
-parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> operator))
+parseIdentInfix :: TokenParser (Qualified Ident)
+parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> symbol))
 
 -- |
 -- Mark the current indentation level
 --
-mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a
+mark :: P.Parsec s ParseState a -> P.Parsec s ParseState a
 mark p = do
   current <- indentationLevel <$> P.getState
   pos <- P.sourceColumn <$> P.getPosition
@@ -361,7 +109,7 @@
 -- |
 -- Check that the current identation level matches a predicate
 --
-checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String ParseState ()
+checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec s ParseState ()
 checkIndentation rel = do
   col <- P.sourceColumn <$> P.getPosition
   current <- indentationLevel <$> P.getState
@@ -370,18 +118,23 @@
 -- |
 -- Check that the current indentation level is past the current mark
 --
-indented :: P.Parsec String ParseState ()
+indented :: P.Parsec s ParseState ()
 indented = checkIndentation (>) P.<?> "indentation"
 
 -- |
 -- Check that the current indentation level is at the same indentation as the current mark
 --
-same :: P.Parsec String ParseState ()
+same :: P.Parsec s ParseState ()
 same = checkIndentation (==) P.<?> "no indentation"
 
 -- |
--- Run a parser which supports indentation
+-- Read the comments from the the next token, without consuming it
 --
-runIndentParser :: FilePath -> P.Parsec String ParseState a -> String -> Either P.ParseError a
-runIndentParser filePath p = P.runParser p (ParseState 0) filePath
+readComments :: P.Parsec [PositionedToken] u [Comment]
+readComments = P.lookAhead $ ptComments <$> P.anyToken
 
+-- |
+-- Run a parser
+--
+runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a
+runTokenParser filePath p = P.runParser p (ParseState 0) filePath
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -26,6 +26,8 @@
     parseBinderNoParens,
 ) where
 
+import Prelude hiding (lex)
+
 import Data.Maybe (isJust, fromMaybe)
 import Data.Traversable (forM)
 
@@ -33,11 +35,12 @@
 import Control.Arrow ((+++))
 
 import Language.PureScript.Kinds
-import Language.PureScript.Parser.State
-import Language.PureScript.Parser.Common
 import Language.PureScript.AST
+import Language.PureScript.Comments
+import Language.PureScript.Parser.Common
 import Language.PureScript.Parser.Types
 import Language.PureScript.Parser.Kinds
+import Language.PureScript.Parser.Lexer
 import Language.PureScript.CodeGen.JS.AST
 import Language.PureScript.Environment
 
@@ -48,53 +51,54 @@
 -- |
 -- Read source position information
 --
-withSourceSpan :: (SourceSpan -> a -> a) -> P.Parsec s u a -> P.Parsec s u a
+withSourceSpan :: (SourceSpan -> [Comment] -> a -> a) -> P.Parsec [PositionedToken] u a -> P.Parsec [PositionedToken] u a
 withSourceSpan f p = do
   start <- P.getPosition
+  comments <- C.readComments
   x <- p
   end <- P.getPosition
   let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)
-  return $ f sp x
+  return $ f sp comments x
   where
   toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
 
-kindedIdent :: P.Parsec String ParseState (String, Maybe Kind)
+kindedIdent :: TokenParser (String, Maybe Kind)
 kindedIdent = (, Nothing) <$> identifier
-          <|> parens ((,) <$> identifier <*> (Just <$> (indented *> lexeme (P.string "::") *> indented *> parseKind)))
+          <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind)))
 
-parseDataDeclaration :: P.Parsec String ParseState Declaration
+parseDataDeclaration :: TokenParser Declaration
 parseDataDeclaration = do
   dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)
   name <- indented *> properName
   tyArgs <- many (indented *> kindedIdent)
   ctors <- P.option [] $ do
-    _ <- lexeme $ indented *> P.char '='
-    sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe
+    indented *> equals
+    P.sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe
   return $ DataDeclaration dtype name tyArgs ctors
 
-parseTypeDeclaration :: P.Parsec String ParseState Declaration
+parseTypeDeclaration :: TokenParser Declaration
 parseTypeDeclaration =
-  TypeDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.string "::"))
+  TypeDeclaration <$> P.try (parseIdent <* indented <* doubleColon)
                   <*> parsePolyType
 
-parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
+parseTypeSynonymDeclaration :: TokenParser Declaration
 parseTypeSynonymDeclaration =
   TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)
                          <*> many (indented *> kindedIdent)
-                         <*> (lexeme (indented *> P.char '=') *> noWildcards parsePolyType)
+                         <*> (indented *> equals *> noWildcards parsePolyType)
 
-parseValueDeclaration :: P.Parsec String ParseState Declaration
+parseValueDeclaration :: TokenParser Declaration
 parseValueDeclaration = do
   name <- parseIdent
   binders <- P.many parseBinderNoParens
   value <- Left <$> (C.indented *>
                        P.many1 ((,) <$> parseGuard
-                                    <*> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)
+                                    <*> (indented *> equals *> parseValueWithWhereClause)
                                ))
-       <|> Right <$> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)
+       <|> Right <$> (indented *> equals *> parseValueWithWhereClause)
   return $ ValueDeclaration name Value binders value
   where
-  parseValueWithWhereClause :: P.Parsec String ParseState Expr
+  parseValueWithWhereClause :: TokenParser Expr
   parseValueWithWhereClause = do
     value <- parseValue
     whereClause <- P.optionMaybe $ do
@@ -104,42 +108,42 @@
       C.mark $ P.many1 (C.same *> parseLocalDeclaration)
     return $ maybe value (`Let` value) whereClause
 
-parseExternDeclaration :: P.Parsec String ParseState Declaration
+parseExternDeclaration :: TokenParser Declaration
 parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>
    (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
-                          <*> (lexeme (indented *> P.string "::") *> parseKind)
+                          <*> (indented *> doubleColon *> parseKind)
    <|> (do reserved "instance"
-           name <- parseIdent <* lexeme (indented *> P.string "::")
+           name <- parseIdent <* indented <* doubleColon
            deps <- P.option [] $ do
              deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
              indented
-             reservedOp "=>"
+             rfatArrow
              return deps
            className <- indented *> parseQualified properName
            tys <- P.many (indented *> noWildcards parseTypeAtom)
            return $ ExternInstanceDeclaration name deps className tys)
    <|> (do ident <- parseIdent
            js <- P.optionMaybe (JSRaw <$> stringLiteral)
-           ty <- lexeme (indented *> P.string "::") *> noWildcards parsePolyType
+           ty <- indented *> doubleColon *> noWildcards parsePolyType
            return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))
 
-parseAssociativity :: P.Parsec String ParseState Associativity
+parseAssociativity :: TokenParser Associativity
 parseAssociativity =
   (P.try (reserved "infixl") >> return Infixl) <|>
   (P.try (reserved "infixr") >> return Infixr) <|>
   (P.try (reserved "infix") >>  return Infix)
 
-parseFixity :: P.Parsec String ParseState Fixity
+parseFixity :: TokenParser Fixity
 parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
 
-parseFixityDeclaration :: P.Parsec String ParseState Declaration
+parseFixityDeclaration :: TokenParser Declaration
 parseFixityDeclaration = do
   fixity <- parseFixity
   indented
-  name <- operator
+  name <- symbol
   return $ FixityDeclaration fixity name
 
-parseImportDeclaration :: P.Parsec String ParseState Declaration
+parseImportDeclaration :: TokenParser Declaration
 parseImportDeclaration = do
   reserved "import"
   indented
@@ -169,20 +173,20 @@
     return $ fromMaybe Unqualified (expectedType <$> idents)
 
 
-parseDeclarationRef :: P.Parsec String ParseState DeclarationRef
+parseDeclarationRef :: TokenParser DeclarationRef
 parseDeclarationRef = withSourceSpan PositionedDeclarationRef $
   ValueRef <$> parseIdent
     <|> do name <- properName
-           dctors <- P.optionMaybe $ parens (lexeme (P.string "..") *> pure Nothing <|> Just <$> commaSep properName)
+           dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)
            return $ maybe (TypeClassRef name) (TypeRef name) dctors
 
-parseTypeClassDeclaration :: P.Parsec String ParseState Declaration
+parseTypeClassDeclaration :: TokenParser Declaration
 parseTypeClassDeclaration = do
   reserved "class"
   implies <- P.option [] $ do
     indented
     implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
-    reservedOp "<="
+    lfatArrow
     return implies
   className <- indented *> properName
   idents <- P.many (indented *> kindedIdent)
@@ -191,14 +195,14 @@
     mark (P.many (same *> positioned parseTypeDeclaration))
   return $ TypeClassDeclaration className idents implies members
 
-parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
+parseTypeInstanceDeclaration :: TokenParser Declaration
 parseTypeInstanceDeclaration = do
   reserved "instance"
-  name <- parseIdent <* lexeme (indented *> P.string "::")
+  name <- parseIdent <* indented <* doubleColon
   deps <- P.optionMaybe $ do
     deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
     indented
-    reservedOp "=>"
+    rfatArrow
     return deps
   className <- indented *> parseQualified properName
   ty <- P.many (indented *> (noWildcards parseTypeAtom))
@@ -207,13 +211,13 @@
     mark (P.many (same *> positioned parseValueDeclaration))
   return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members
 
-positioned :: P.Parsec String ParseState Declaration -> P.Parsec String ParseState Declaration
+positioned :: TokenParser Declaration -> TokenParser Declaration
 positioned d = withSourceSpan PositionedDeclaration d
 
 -- |
 -- Parse a single declaration
 --
-parseDeclaration :: P.Parsec String ParseState Declaration
+parseDeclaration :: TokenParser Declaration
 parseDeclaration = positioned (P.choice
                    [ parseDataDeclaration
                    , parseTypeDeclaration
@@ -226,7 +230,7 @@
                    , parseTypeInstanceDeclaration
                    ]) P.<?> "declaration"
 
-parseLocalDeclaration :: P.Parsec String ParseState Declaration
+parseLocalDeclaration :: TokenParser Declaration
 parseLocalDeclaration = positioned (P.choice
                    [ parseTypeDeclaration
                    , parseValueDeclaration
@@ -235,13 +239,13 @@
 -- |
 -- Parse a module header and a collection of declarations
 --
-parseModule :: P.Parsec String ParseState Module
+parseModule :: TokenParser Module
 parseModule = do
   reserved "module"
   indented
   name <- moduleName
   exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef
-  _ <- lexeme $ P.string "where"
+  reserved "where"
   decls <- mark (P.many (same *> parseDeclaration))
   return $ Module name decls exports
 
@@ -250,9 +254,11 @@
 --
 parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]
 parseModulesFromFiles toFilePath input =
-  fmap collect . forM input $ \(filename, content) -> do
-    ms <- runIndentParser (toFilePath filename) parseModules content
-    return (filename, ms)
+  fmap collect . forM input $ \(k, content) -> do
+    let filename = toFilePath k
+    ts <- lex filename content
+    ms <- runTokenParser filename parseModules ts
+    return (k, ms)
   where
   collect :: [(k, [v])] -> [(k, v)]
   collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
@@ -260,77 +266,77 @@
 -- |
 -- Parse a collection of modules
 --
-parseModules :: P.Parsec String ParseState [Module]
-parseModules = whiteSpace *> mark (P.many (same *> parseModule)) <* P.eof
+parseModules :: TokenParser [Module]
+parseModules = mark (P.many (same *> parseModule)) <* P.eof
 
-booleanLiteral :: P.Parsec String ParseState Bool
-booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
+booleanLiteral :: TokenParser Bool
+booleanLiteral = (reserved "true" >> return True) P.<|> (reserved "false" >> return False)
 
-parseNumericLiteral :: P.Parsec String ParseState Expr
-parseNumericLiteral = NumericLiteral <$> C.integerOrFloat
+parseNumericLiteral :: TokenParser Expr
+parseNumericLiteral = NumericLiteral <$> number
 
-parseStringLiteral :: P.Parsec String ParseState Expr
-parseStringLiteral = StringLiteral <$> C.stringLiteral
+parseStringLiteral :: TokenParser Expr
+parseStringLiteral = StringLiteral <$> stringLiteral
 
-parseBooleanLiteral :: P.Parsec String ParseState Expr
+parseBooleanLiteral :: TokenParser Expr
 parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
 
-parseArrayLiteral :: P.Parsec String ParseState Expr
-parseArrayLiteral = ArrayLiteral <$> C.squares (C.commaSep parseValue)
+parseArrayLiteral :: TokenParser Expr
+parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
 
-parseObjectLiteral :: P.Parsec String ParseState Expr
-parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)
+parseObjectLiteral :: TokenParser Expr
+parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)
 
-parseIdentifierAndValue :: P.Parsec String ParseState (String, Expr)
-parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifierName <|> C.stringLiteral) <* C.indented <* C.colon)
+parseIdentifierAndValue :: TokenParser (String, Expr)
+parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
                               <*> (C.indented *> parseValue)
 
-parseAbs :: P.Parsec String ParseState Expr
+parseAbs :: TokenParser Expr
 parseAbs = do
-  C.reservedOp "\\"
+  symbol' "\\"
   args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))
-  C.indented *> C.reservedOp "->"
+  C.indented *> rarrow
   value <- parseValue
   return $ toFunction args value
   where
   toFunction :: [Expr -> Expr] -> Expr -> Expr
   toFunction args value = foldr ($) value args
 
-parseVar :: P.Parsec String ParseState Expr
+parseVar :: TokenParser Expr
 parseVar = Var <$> C.parseQualified C.parseIdent
 
-parseConstructor :: P.Parsec String ParseState Expr
+parseConstructor :: TokenParser Expr
 parseConstructor = Constructor <$> C.parseQualified C.properName
 
-parseCase :: P.Parsec String ParseState Expr
-parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") (return <$> parseValue)
+parseCase :: TokenParser Expr
+parseCase = Case <$> P.between (P.try (reserved "case")) (C.indented *> reserved "of") (return <$> parseValue)
                  <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
 
-parseCaseAlternative :: P.Parsec String ParseState CaseAlternative
+parseCaseAlternative :: TokenParser CaseAlternative
 parseCaseAlternative = CaseAlternative <$> (return <$> parseBinder)
                                        <*> (Left <$> (C.indented *>
                                                         P.many1 ((,) <$> parseGuard
-                                                                     <*> (lexeme (indented *> C.reservedOp "->") *> parseValue)
+                                                                     <*> (indented *> rarrow *> parseValue)
                                                                 ))
-                                            <|> Right <$> (lexeme (indented *> C.reservedOp "->") *> parseValue))
+                                            <|> Right <$> (indented *> rarrow *> parseValue))
                                        P.<?> "case alternative"
 
-parseIfThenElse :: P.Parsec String ParseState Expr
-parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue)
-                             <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)
-                             <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)
+parseIfThenElse :: TokenParser Expr
+parseIfThenElse = IfThenElse <$> (P.try (reserved "if") *> C.indented *> parseValue)
+                             <*> (C.indented *> reserved "then" *> C.indented *> parseValue)
+                             <*> (C.indented *> reserved "else" *> C.indented *> parseValue)
 
-parseLet :: P.Parsec String ParseState Expr
+parseLet :: TokenParser Expr
 parseLet = do
-  C.reserved "let"
+  reserved "let"
   C.indented
   ds <- C.mark $ P.many1 (C.same *> parseLocalDeclaration)
   C.indented
-  C.reserved "in"
+  reserved "in"
   result <- parseValue
   return $ Let ds result
 
-parseValueAtom :: P.Parsec String ParseState Expr
+parseValueAtom :: TokenParser Expr
 parseValueAtom = P.choice
             [ P.try parseNumericLiteral
             , P.try parseStringLiteral
@@ -344,32 +350,32 @@
             , parseIfThenElse
             , parseDo
             , parseLet
-            , Parens <$> C.parens parseValue ]
+            , Parens <$> parens parseValue ]
 
-parsePropertyUpdate :: P.Parsec String ParseState (String, Expr)
+parsePropertyUpdate :: TokenParser (String, Expr)
 parsePropertyUpdate = do
-  name <- C.lexeme (C.identifierName <|> C.stringLiteral)
-  _ <- C.lexeme $ C.indented *> P.char '='
+  name <- lname <|> stringLiteral
+  _ <- C.indented *> equals
   value <- C.indented *> parseValue
   return (name, value)
 
-parseAccessor :: Expr -> P.Parsec String ParseState Expr
+parseAccessor :: Expr -> TokenParser Expr
 parseAccessor (Constructor _) = P.unexpected "constructor"
-parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifierName <|> C.stringLiteral)) <*> pure obj
+parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> (lname <|> stringLiteral)) <*> pure obj
 
-parseDo :: P.Parsec String ParseState Expr
+parseDo :: TokenParser Expr
 parseDo = do
-  C.reserved "do"
+  reserved "do"
   C.indented
   Do <$> C.mark (P.many (C.same *> C.mark parseDoNotationElement))
 
-parseDoNotationLet :: P.Parsec String ParseState DoNotationElement
-parseDoNotationLet = DoNotationLet <$> (C.reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))
+parseDoNotationLet :: TokenParser DoNotationElement
+parseDoNotationLet = DoNotationLet <$> (reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))
 
-parseDoNotationBind :: P.Parsec String ParseState DoNotationElement
-parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> C.reservedOp "<-" *> parseValue)
+parseDoNotationBind :: TokenParser DoNotationElement
+parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> larrow *> parseValue)
 
-parseDoNotationElement :: P.Parsec String ParseState DoNotationElement
+parseDoNotationElement :: TokenParser DoNotationElement
 parseDoNotationElement = P.choice
             [ P.try parseDoNotationBind
             , parseDoNotationLet
@@ -378,7 +384,7 @@
 -- |
 -- Parse a value
 --
-parseValue :: P.Parsec String ParseState Expr
+parseValue :: TokenParser Expr
 parseValue = withSourceSpan PositionedValue
   (P.buildExpressionParser operators
     . C.buildPostfixParser postfixTable2
@@ -386,68 +392,68 @@
   where
   indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
   postfixTable1 = [ parseAccessor
-                  , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]
+                  , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]
   postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v
-                  , \v -> flip (TypedValue True) <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v
+                  , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v
                   ]
-  operators = [ [ P.Prefix (C.lexeme (P.try (C.indented *> P.char '-') >> return UnaryMinus))
+  operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)
                 ]
-              , [ P.Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
-                    return (BinaryNoParens ident))) P.AssocRight
+              , [ P.Infix (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
+                    return (BinaryNoParens ident)) P.AssocRight
                 ]
               ]
 
-parseStringBinder :: P.Parsec String ParseState Binder
-parseStringBinder = StringBinder <$> C.stringLiteral
+parseStringBinder :: TokenParser Binder
+parseStringBinder = StringBinder <$> stringLiteral
 
-parseBooleanBinder :: P.Parsec String ParseState Binder
+parseBooleanBinder :: TokenParser Binder
 parseBooleanBinder = BooleanBinder <$> booleanLiteral
 
-parseNumberBinder :: P.Parsec String ParseState Binder
-parseNumberBinder = NumberBinder <$> (C.lexeme sign <*> C.integerOrFloat)
+parseNumberBinder :: TokenParser Binder
+parseNumberBinder = NumberBinder <$> (sign <*> number)
   where
-  sign :: P.Parsec String ParseState (Either Integer Double -> Either Integer Double)
-  sign = (P.char '-' >> return (negate +++ negate))
-         <|> (P.char '+' >> return id)
+  sign :: TokenParser (Either Integer Double -> Either Integer Double)
+  sign = (symbol' "-" >> return (negate +++ negate))
+         <|> (symbol' "+" >> return id)
          <|> return id
 
-parseVarBinder :: P.Parsec String ParseState Binder
+parseVarBinder :: TokenParser Binder
 parseVarBinder = VarBinder <$> C.parseIdent
 
-parseNullaryConstructorBinder :: P.Parsec String ParseState Binder
-parseNullaryConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> pure []
+parseNullaryConstructorBinder :: TokenParser Binder
+parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> pure []
 
-parseConstructorBinder :: P.Parsec String ParseState Binder
-parseConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> many (C.indented *> parseBinderNoParens)
+parseConstructorBinder :: TokenParser Binder
+parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> many (C.indented *> parseBinderNoParens)
 
-parseObjectBinder :: P.Parsec String ParseState Binder
-parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseIdentifierAndBinder))
+parseObjectBinder :: TokenParser Binder
+parseObjectBinder = ObjectBinder <$> braces (commaSep (C.indented *> parseIdentifierAndBinder))
 
-parseArrayBinder :: P.Parsec String ParseState Binder
-parseArrayBinder = C.squares $ ArrayBinder <$> C.commaSep (C.indented *> parseBinder)
+parseArrayBinder :: TokenParser Binder
+parseArrayBinder = squares $ ArrayBinder <$> commaSep (C.indented *> parseBinder)
 
-parseNamedBinder :: P.Parsec String ParseState Binder
-parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))
+parseNamedBinder :: TokenParser Binder
+parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* at)
                                <*> (C.indented *> parseBinder)
 
-parseNullBinder :: P.Parsec String ParseState Binder
-parseNullBinder = C.lexeme (P.char '_' *> P.notFollowedBy C.identLetter) *> return NullBinder
+parseNullBinder :: TokenParser Binder
+parseNullBinder = reserved "_" *> return NullBinder
 
-parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)
+parseIdentifierAndBinder :: TokenParser (String, Binder)
 parseIdentifierAndBinder = do
-  name <- C.lexeme (C.identifierName <|> C.stringLiteral)
-  _ <- C.lexeme $ C.indented *> P.char '='
+  name <- lname <|> stringLiteral
+  C.indented *> (equals <|> colon)
   binder <- C.indented *> parseBinder
   return (name, binder)
 
 -- |
 -- Parse a binder
 --
-parseBinder :: P.Parsec String ParseState Binder
+parseBinder :: TokenParser Binder
 parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")
   where
-  operators = [ [ P.Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) P.AssocRight ] ]
-  parseBinderAtom :: P.Parsec String ParseState Binder
+  operators = [ [ P.Infix (P.try $ C.indented *> colon *> return ConsBinder) P.AssocRight ] ]
+  parseBinderAtom :: TokenParser Binder
   parseBinderAtom = P.choice (map P.try
                     [ parseNullBinder
                     , parseStringBinder
@@ -458,12 +464,12 @@
                     , parseConstructorBinder
                     , parseObjectBinder
                     , parseArrayBinder
-                    , C.parens parseBinder ]) P.<?> "binder"
+                    , parens parseBinder ]) P.<?> "binder"
 
 -- |
 -- Parse a binder as it would appear in a top level declaration
 --
-parseBinderNoParens :: P.Parsec String ParseState Binder
+parseBinderNoParens :: TokenParser Binder
 parseBinderNoParens = P.choice (map P.try
                   [ parseNullBinder
                   , parseStringBinder
@@ -474,11 +480,11 @@
                   , parseNullaryConstructorBinder
                   , parseObjectBinder
                   , parseArrayBinder
-                  , C.parens parseBinder ]) P.<?> "binder"
+                  , parens parseBinder ]) P.<?> "binder"
 -- |
 -- Parse a guard
 --
-parseGuard :: P.Parsec String ParseState Guard
-parseGuard = C.pipe *> C.indented *> parseValue
+parseGuard :: TokenParser Guard
+parseGuard = pipe *> C.indented *> parseValue
 
 
diff --git a/src/Language/PureScript/Parser/Kinds.hs b/src/Language/PureScript/Parser/Kinds.hs
--- a/src/Language/PureScript/Parser/Kinds.hs
+++ b/src/Language/PureScript/Parser/Kinds.hs
@@ -18,19 +18,19 @@
 ) where
 
 import Language.PureScript.Kinds
-import Language.PureScript.Parser.State
 import Language.PureScript.Parser.Common
+import Language.PureScript.Parser.Lexer
 import Control.Applicative
 import qualified Text.Parsec as P
 import qualified Text.Parsec.Expr as P
 
-parseStar :: P.Parsec String ParseState Kind
-parseStar = const Star <$> lexeme (P.char '*')
+parseStar :: TokenParser Kind
+parseStar = const Star <$> symbol' "*"
 
-parseBang :: P.Parsec String ParseState Kind
-parseBang = const Bang <$> lexeme (P.char '!')
+parseBang :: TokenParser Kind
+parseBang = const Bang <$> symbol' "!"
 
-parseTypeAtom :: P.Parsec String ParseState Kind
+parseTypeAtom :: TokenParser Kind
 parseTypeAtom = indented *> P.choice (map P.try
             [ parseStar
             , parseBang
@@ -38,8 +38,8 @@
 -- |
 -- Parse a kind
 --
-parseKind :: P.Parsec String ParseState Kind
+parseKind :: TokenParser Kind
 parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"
   where
-  operators = [ [ P.Prefix (lexeme (P.char '#') >> return Row) ]
-              , [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]
+  operators = [ [ P.Prefix (symbol' "#" >> return Row) ]
+              , [ P.Infix ((P.try rarrow) >> return FunKind) P.AssocRight ] ]
diff --git a/src/Language/PureScript/Parser/Lexer.hs b/src/Language/PureScript/Parser/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/PureScript/Parser/Lexer.hs
@@ -0,0 +1,491 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.Parser.Lexer
+-- Copyright   :  (c) Phil Freeman 2014
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- The first step in the parsing process - turns source code into a list of lexemes
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE TupleSections #-}
+
+module Language.PureScript.Parser.Lexer 
+  ( PositionedToken(..)
+  , Token()
+  , TokenParser()
+  , lex
+  , anyToken
+  , token
+  , match
+  , lparen
+  , rparen
+  , parens
+  , lbrace
+  , rbrace
+  , braces
+  , lsquare
+  , rsquare
+  , squares
+  , indent
+  , indentAt
+  , larrow 
+  , rarrow 
+  , lfatArrow
+  , rfatArrow
+  , colon
+  , doubleColon
+  , equals
+  , pipe
+  , tick
+  , dot
+  , comma
+  , semi
+  , at
+  , semiSep
+  , semiSep1
+  , commaSep
+  , commaSep1
+  , lname
+  , qualifier
+  , uname
+  , uname'
+  , mname
+  , reserved
+  , symbol
+  , symbol'
+  , identifier
+  , stringLiteral
+  , number
+  , natural
+  , reservedPsNames
+  , reservedTypeNames
+  , opChars
+  )
+  where
+
+import Prelude hiding (lex)
+
+import Data.Char (isSpace)
+
+import Control.Monad (void, guard)
+import Data.Functor.Identity
+
+import Control.Applicative
+
+import Language.PureScript.Parser.State
+import Language.PureScript.Comments
+
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Token as PT
+  
+data Token
+  = LParen
+  | RParen
+  | LBrace
+  | RBrace
+  | LSquare
+  | RSquare
+  | Indent Int
+  | LArrow
+  | RArrow
+  | LFatArrow
+  | RFatArrow
+  | Colon
+  | DoubleColon
+  | Equals
+  | Pipe
+  | Tick
+  | Dot
+  | Comma
+  | Semi
+  | At
+  | LName String
+  | UName String
+  | Qualifier String
+  | Symbol String
+  | StringLiteral String
+  | Number (Either Integer Double)
+  deriving (Show, Eq, Ord)
+  
+prettyPrintToken :: Token -> String
+prettyPrintToken LParen            = "("
+prettyPrintToken RParen            = ")"
+prettyPrintToken LBrace            = "{"
+prettyPrintToken RBrace            = "}"
+prettyPrintToken LSquare           = "["
+prettyPrintToken RSquare           = "]"
+prettyPrintToken LArrow            = "<-"
+prettyPrintToken RArrow            = "->"
+prettyPrintToken LFatArrow         = "<="
+prettyPrintToken RFatArrow         = "=>"
+prettyPrintToken Colon             = ":"
+prettyPrintToken DoubleColon       = "::"
+prettyPrintToken Equals            = "="
+prettyPrintToken Pipe              = "|"
+prettyPrintToken Tick              = "`"
+prettyPrintToken Dot               = "."
+prettyPrintToken Comma             = ","
+prettyPrintToken Semi              = ";"
+prettyPrintToken At                = "@"
+prettyPrintToken (Indent n)        = "indentation at level " ++ show n
+prettyPrintToken (LName s)         = show s
+prettyPrintToken (UName s)         = show s
+prettyPrintToken (Qualifier _)     = "qualifier"
+prettyPrintToken (Symbol s)        = s
+prettyPrintToken (StringLiteral s) = show s
+prettyPrintToken (Number n)        = either show show n
+
+data PositionedToken = PositionedToken
+  { ptSourcePos :: P.SourcePos
+  , ptToken     :: Token
+  , ptComments  :: [Comment]
+  } deriving (Eq)
+  
+instance Show PositionedToken where
+  show = show . ptToken
+
+lex :: FilePath -> String -> Either P.ParseError [PositionedToken]
+lex filePath input = P.parse parseTokens filePath input
+      
+parseTokens :: P.Parsec String u [PositionedToken]
+parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof
+
+whitespace :: P.Parsec String u ()
+whitespace = P.skipMany (P.satisfy isSpace)
+    
+parseComment :: P.Parsec String u Comment
+parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace
+  where
+  blockComment :: P.Parsec String u String
+  blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))
+
+  lineComment :: P.Parsec String u String
+  lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))
+
+parsePositionedToken :: P.Parsec String u PositionedToken
+parsePositionedToken = P.try $ do
+  comments <- P.many parseComment
+  pos <- P.getPosition
+  tok <- parseToken
+  return $ PositionedToken pos tok comments
+
+parseToken :: P.Parsec String u Token
+parseToken = P.choice
+  [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow    
+  , P.try $ P.string "<=" *> P.notFollowedBy symbolChar *> pure LFatArrow
+  , P.try $ P.string "->" *> P.notFollowedBy symbolChar *> pure RArrow    
+  , P.try $ P.string "=>" *> P.notFollowedBy symbolChar *> pure RFatArrow 
+  , P.try $ P.string "::" *> P.notFollowedBy symbolChar *> pure DoubleColon 
+  , P.try $ P.char '('    *> pure LParen
+  , P.try $ P.char ')'    *> pure RParen
+  , P.try $ P.char '{'    *> pure LBrace
+  , P.try $ P.char '}'    *> pure RBrace
+  , P.try $ P.char '['    *> pure LSquare
+  , P.try $ P.char ']'    *> pure RSquare
+  , P.try $ P.char '`'    *> pure Tick
+  , P.try $ P.char ','    *> pure Comma
+  , P.try $ P.char '='    *> P.notFollowedBy symbolChar *> pure Equals
+  , P.try $ P.char ':'    *> P.notFollowedBy symbolChar *> pure Colon
+  , P.try $ P.char '|'    *> P.notFollowedBy symbolChar *> pure Pipe
+  , P.try $ P.char '.'    *> P.notFollowedBy symbolChar *> pure Dot
+  , P.try $ P.char ';'    *> P.notFollowedBy symbolChar *> pure Semi
+  , P.try $ P.char '@'    *> P.notFollowedBy symbolChar *> pure At
+  , LName         <$> parseLName 
+  , do uName <- parseUName
+       (guard (validModuleName uName) >> Qualifier uName <$ P.char '.') <|> pure (UName uName)
+  , Symbol        <$> parseSymbol 
+  , StringLiteral <$> parseStringLiteral
+  , Number        <$> parseNumber
+  ] <* whitespace
+
+  where
+  parseLName :: P.Parsec String u String
+  parseLName = (:) <$> identStart <*> P.many identLetter
+  
+  parseUName :: P.Parsec String u String
+  parseUName = (:) <$> P.upper <*> P.many uidentLetter
+  
+  parseSymbol :: P.Parsec String u String
+  parseSymbol = P.many1 symbolChar
+  
+  identStart :: P.Parsec String u Char
+  identStart = P.lower <|> P.oneOf "_"
+  
+  identLetter :: P.Parsec String u Char
+  identLetter = P.alphaNum <|> P.oneOf "_'"
+
+  uidentLetter :: P.Parsec String u Char
+  uidentLetter = P.alphaNum <|> P.char '_'
+
+  symbolChar :: P.Parsec String u Char
+  symbolChar = P.oneOf opChars
+  
+  parseStringLiteral :: P.Parsec String u String
+  parseStringLiteral = blockString <|> PT.stringLiteral tokenParser
+    where 
+    delimeter   = P.try (P.string "\"\"\"")
+    blockString = delimeter >> P.manyTill P.anyChar delimeter
+  
+  parseNumber :: P.Parsec String u (Either Integer Double)
+  parseNumber = (Right <$> P.try (PT.float tokenParser) <|>
+                 Left <$> P.try (PT.natural tokenParser)) P.<?> "number"
+
+-- |
+-- We use Text.Parsec.Token to implement the string and number lexemes
+--
+langDef :: PT.GenLanguageDef String u Identity
+langDef = PT.LanguageDef
+  { PT.reservedNames   = []
+  , PT.reservedOpNames = []
+  , PT.commentStart    = ""
+  , PT.commentEnd      = ""
+  , PT.commentLine     = ""
+  , PT.nestedComments  = True
+  , PT.identStart      = fail "Identifiers not supported"
+  , PT.identLetter     = fail "Identifiers not supported"
+  , PT.opStart         = fail "Operators not supported"
+  , PT.opLetter        = fail "Operators not supported"
+  , PT.caseSensitive   = True
+  }
+
+-- |
+-- A token parser based on the language definition
+--
+tokenParser :: PT.GenTokenParser String u Identity
+tokenParser = PT.makeTokenParser langDef
+
+type TokenParser a = P.Parsec [PositionedToken] ParseState a
+ 
+anyToken :: TokenParser PositionedToken
+anyToken = P.token (prettyPrintToken . ptToken) ptSourcePos Just
+ 
+token :: (Token -> Maybe a) -> TokenParser a
+token f = P.token (prettyPrintToken . ptToken) ptSourcePos (f . ptToken)
+
+match :: Token -> TokenParser ()
+match tok = token (\tok' -> if tok == tok' then Just () else Nothing) P.<?> prettyPrintToken tok
+
+lparen :: TokenParser ()
+lparen = match LParen
+
+rparen :: TokenParser ()
+rparen = match RParen
+
+parens :: TokenParser a -> TokenParser a
+parens = P.between lparen rparen
+
+lbrace :: TokenParser ()
+lbrace = match LBrace
+
+rbrace :: TokenParser ()
+rbrace = match RBrace
+
+braces :: TokenParser a -> TokenParser a
+braces = P.between lbrace rbrace
+
+lsquare :: TokenParser ()
+lsquare = match LSquare
+
+rsquare :: TokenParser ()
+rsquare = match RSquare
+
+squares :: TokenParser a -> TokenParser a
+squares = P.between lsquare rsquare
+
+indent :: TokenParser Int
+indent = token go P.<?> "indentation"
+  where
+  go (Indent n) = Just n
+  go _ = Nothing
+
+indentAt :: P.Column -> TokenParser ()
+indentAt n = token go P.<?> "indentation at level " ++ show n
+  where
+  go (Indent n') | n == n' = Just ()
+  go _ = Nothing
+
+larrow :: TokenParser ()
+larrow = match LArrow
+
+rarrow :: TokenParser ()
+rarrow = match RArrow
+
+lfatArrow :: TokenParser ()
+lfatArrow = match LFatArrow
+
+rfatArrow :: TokenParser ()
+rfatArrow = match RFatArrow
+
+colon :: TokenParser ()
+colon = match Colon
+
+doubleColon :: TokenParser ()
+doubleColon = match DoubleColon
+
+equals :: TokenParser ()
+equals = match Equals
+
+pipe :: TokenParser ()
+pipe = match Pipe
+
+tick :: TokenParser ()
+tick = match Tick
+
+dot :: TokenParser ()
+dot = match Dot
+
+comma :: TokenParser ()
+comma = match Comma
+
+semi :: TokenParser ()
+semi = match Semi
+
+at :: TokenParser ()
+at = match At 
+
+-- |
+-- Parse zero or more values separated by semicolons
+--
+semiSep :: TokenParser a -> TokenParser [a]
+semiSep = flip P.sepBy semi
+
+-- |
+-- Parse one or more values separated by semicolons
+--
+semiSep1 :: TokenParser a -> TokenParser [a]
+semiSep1 = flip P.sepBy1 semi
+
+-- |
+-- Parse zero or more values separated by commas
+--
+commaSep :: TokenParser a -> TokenParser [a]
+commaSep = flip P.sepBy comma
+
+-- |
+-- Parse one or more values separated by commas
+--
+commaSep1 :: TokenParser a -> TokenParser [a]
+commaSep1 = flip P.sepBy1 comma
+
+lname :: TokenParser String
+lname = token go P.<?> "identifier"
+  where
+  go (LName s) = Just s
+  go _ = Nothing
+
+qualifier :: TokenParser String
+qualifier = token go P.<?> "qualifier"
+  where
+  go (Qualifier s) = Just s
+  go _ = Nothing
+
+reserved :: String -> TokenParser ()
+reserved s = token go P.<?> show s
+  where
+  go (LName s') | s == s' = Just ()
+  go _ = Nothing
+
+uname :: TokenParser String
+uname = token go P.<?> "proper name"
+  where
+  go (UName s) = Just s
+  go _ = Nothing
+
+mname :: TokenParser String
+mname = token go P.<?> "module name"
+  where
+  go (UName s) | validModuleName s = Just s
+  go _ = Nothing
+
+uname' :: String -> TokenParser ()
+uname' s = token go P.<?> show s
+  where
+  go (UName s') | s == s' = Just ()
+  go _ = Nothing
+  
+symbol :: TokenParser String
+symbol = token go P.<?> "symbol"
+  where
+  go (Symbol s) = Just s
+  go Colon      = Just ":"
+  go LFatArrow  = Just "<="
+  go _ = Nothing
+
+symbol' :: String -> TokenParser ()
+symbol' s = token go P.<?> show s
+  where
+  go (Symbol s') | s == s'   = Just ()
+  go Colon       | s == ":"  = Just ()
+  go LFatArrow   | s == "<=" = Just ()
+  go _ = Nothing
+  
+stringLiteral :: TokenParser String
+stringLiteral = token go P.<?> "string literal"
+  where
+  go (StringLiteral s) = Just s
+  go _ = Nothing
+
+number :: TokenParser (Either Integer Double)
+number = token go P.<?> "number"
+  where
+  go (Number n) = Just n
+  go _ = Nothing
+
+natural :: TokenParser Integer
+natural = token go P.<?> "natural"
+  where
+  go (Number (Left n)) = Just n
+  go _ = Nothing
+
+identifier :: TokenParser String
+identifier = token go P.<?> "identifier"
+  where
+  go (LName s) | s `notElem` reservedPsNames = Just s
+  go _ = Nothing
+  
+validModuleName :: String -> Bool
+validModuleName s = not ('_' `elem` s)
+  
+-- |
+-- A list of purescript reserved identifiers
+--
+reservedPsNames :: [String]
+reservedPsNames = [ "data"
+                  , "newtype"
+                  , "type"
+                  , "foreign"
+                  , "import"
+                  , "infixl"
+                  , "infixr"
+                  , "infix"
+                  , "class"
+                  , "instance"
+                  , "module"
+                  , "case"
+                  , "of"
+                  , "if"
+                  , "then"
+                  , "else"
+                  , "do"
+                  , "let"
+                  , "true"
+                  , "false"
+                  , "in"
+                  , "where"
+                  ]
+                  
+reservedTypeNames :: [String]
+reservedTypeNames = [ "forall", "where" ]
+
+-- |
+-- The characters allowed for use in operators
+--
+opChars :: [Char]
+opChars = ":!#$%&*+./<=>?@\\^|-~"
+  
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -24,46 +24,46 @@
 import Control.Monad (when, unless)
 
 import Language.PureScript.Types
-import Language.PureScript.Parser.State
 import Language.PureScript.Parser.Common
 import Language.PureScript.Parser.Kinds
+import Language.PureScript.Parser.Lexer
 import Language.PureScript.Environment
 
 import qualified Text.Parsec as P
 import qualified Text.Parsec.Expr as P
 
-parseArray :: P.Parsec String ParseState Type
+parseArray :: TokenParser Type
 parseArray = squares $ return tyArray
 
-parseArrayOf :: P.Parsec String ParseState Type
+parseArrayOf :: TokenParser Type
 parseArrayOf = squares $ TypeApp tyArray <$> parseType
 
-parseFunction :: P.Parsec String ParseState Type
-parseFunction = parens $ P.try (lexeme (P.string "->")) >> return tyFunction
+parseFunction :: TokenParser Type
+parseFunction = parens $ rarrow >> return tyFunction
 
-parseObject :: P.Parsec String ParseState Type
+parseObject :: TokenParser Type
 parseObject = braces $ TypeApp tyObject <$> parseRow
 
-parseTypeWildcard :: P.Parsec String ParseState Type
-parseTypeWildcard = lexeme (P.char '_') >> return TypeWildcard
+parseTypeWildcard :: TokenParser Type
+parseTypeWildcard = reserved "_" >> return TypeWildcard
 
-parseTypeVariable :: P.Parsec String ParseState Type
+parseTypeVariable :: TokenParser Type
 parseTypeVariable = do
   ident <- identifier
   when (ident `elem` reservedTypeNames) $ P.unexpected ident
   return $ TypeVar ident
 
-parseTypeConstructor :: P.Parsec String ParseState Type
+parseTypeConstructor :: TokenParser Type
 parseTypeConstructor = TypeConstructor <$> parseQualified properName
 
-parseForAll :: P.Parsec String ParseState Type
+parseForAll :: TokenParser Type
 parseForAll = mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> identifier) <* indented <* dot)
                        <*> parseConstrainedType
 
 -- |
 -- Parse a type as it appears in e.g. a data constructor
 --
-parseTypeAtom :: P.Parsec String ParseState Type
+parseTypeAtom :: TokenParser Type
 parseTypeAtom = indented *> P.choice (map P.try
             [ parseArray
             , parseArrayOf
@@ -76,7 +76,7 @@
             , parens parseRow
             , parens parsePolyType ])
 
-parseConstrainedType :: P.Parsec String ParseState Type
+parseConstrainedType :: TokenParser Type
 parseConstrainedType = do
   constraints <- P.optionMaybe . P.try $ do
     constraints <- parens . commaSep1 $ do
@@ -84,24 +84,24 @@
       indented
       ty <- P.many parseTypeAtom
       return (className, ty)
-    _ <- lexeme $ P.string "=>"
+    _ <- rfatArrow
     return constraints
   indented
   ty <- parseType
   return $ maybe ty (flip ConstrainedType ty) constraints
 
-parseAnyType :: P.Parsec String ParseState Type
+parseAnyType :: TokenParser Type
 parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"
   where
   operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]
-              , [ P.Infix (P.try (lexeme (P.string "->")) >> return function) P.AssocRight ] ]
-  postfixTable = [ \t -> KindedType t <$> (P.try (lexeme (indented *> P.string "::")) *> parseKind)
+              , [ P.Infix (rarrow >> return function) P.AssocRight ] ]
+  postfixTable = [ \t -> KindedType t <$> (P.try (indented *> doubleColon) *> parseKind)
                  ]
 
 -- |
 -- Parse a monotype
 --
-parseType :: P.Parsec String ParseState Type
+parseType :: TokenParser Type
 parseType = do
   ty <- parseAnyType
   unless (isMonoType ty) $ P.unexpected "polymorphic type"
@@ -110,23 +110,25 @@
 -- |
 -- Parse a polytype
 --
-parsePolyType :: P.Parsec String ParseState Type
+parsePolyType :: TokenParser Type
 parsePolyType = parseAnyType
 
 -- |
 -- Parse an atomic type with no wildcards
 --
-noWildcards :: P.Parsec String ParseState Type -> P.Parsec String ParseState Type
+noWildcards :: TokenParser Type -> TokenParser Type
 noWildcards p = do
   ty <- p
   when (containsWildcards ty) $ P.unexpected "type wildcard"
   return ty
 
-parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)
-parseNameAndType p = (,) <$> (indented *> (identifierName <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p
+parseNameAndType :: TokenParser t -> TokenParser (String, t)
+parseNameAndType p = (,) <$> (indented *> (lname <|> stringLiteral) <* indented <* doubleColon) <*> p
 
-parseRowEnding :: P.Parsec String ParseState Type
-parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
+parseRowEnding :: TokenParser Type
+parseRowEnding = P.option REmpty $ indented *> pipe *> indented *> P.choice  (map P.try
+            [ parseTypeWildcard
+            , TypeVar <$> identifier ])
 
-parseRow :: P.Parsec String ParseState Type
+parseRow :: TokenParser Type
 parseRow = (curry rowFromList <$> commaSep (parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"
diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs
--- a/src/Language/PureScript/Pretty/Common.hs
+++ b/src/Language/PureScript/Pretty/Common.hs
@@ -17,7 +17,7 @@
 
 import Control.Monad.State
 import Data.List (intercalate)
-import Language.PureScript.Parser.Common (reservedPsNames, opChars)
+import Language.PureScript.Parser.Lexer (reservedPsNames, opChars)
 
 -- |
 -- Wrap a string in parentheses
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -17,17 +17,20 @@
     prettyPrintJS
 ) where
 
-import Language.PureScript.Pretty.Common
-import Language.PureScript.CodeGen.JS (identNeedsEscaping)
-import Language.PureScript.CodeGen.JS.AST
-
 import Data.List
 import Data.Maybe (fromMaybe)
-import qualified Control.Arrow as A
-import Control.Arrow ((<+>))
-import Control.PatternArrows
+
 import Control.Applicative
+import Control.Arrow ((<+>))
 import Control.Monad.State
+import Control.PatternArrows
+import qualified Control.Arrow as A
+
+import Language.PureScript.CodeGen.JS.AST
+import Language.PureScript.CodeGen.JS.Common
+import Language.PureScript.Pretty.Common
+import Language.PureScript.Comments
+
 import Numeric
 
 literals :: Pattern PrinterState JS String
@@ -117,6 +120,32 @@
     [ return $ lbl ++ ": "
     , prettyPrintJS' js
     ]
+  match (JSComment com js) = fmap concat $ sequence $
+    [ return "\n"
+    , currentIndent
+    , return "/**\n"
+    ] ++
+    map asLine (concatMap commentLines com) ++
+    [ currentIndent
+    , return " */\n"
+    , currentIndent
+    , prettyPrintJS' js
+    ]
+    where
+    commentLines :: Comment -> [String]
+    commentLines (LineComment s) = [s]
+    commentLines (BlockComment s) = lines s
+    
+    asLine :: String -> StateT PrinterState Maybe String 
+    asLine s = do
+      i <- currentIndent
+      return $ i ++ " * " ++ removeComments s ++ "\n"
+    
+    removeComments :: String -> String
+    removeComments ('*' : '/' : s) = removeComments s
+    removeComments (c : s) = c : removeComments s
+    
+    removeComments [] = []
   match (JSRaw js) = return js
   match _ = mzero
 
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -81,7 +81,7 @@
   match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"
   match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"
   match (TypedValue _ val _) = prettyPrintValue' val
-  match (PositionedValue _ val) = prettyPrintValue' val
+  match (PositionedValue _ _ val) = prettyPrintValue' val
   match _ = mzero
 
 prettyPrintDeclaration :: Declaration -> StateT PrinterState Maybe String
@@ -90,7 +90,7 @@
   [ return $ show ident ++ " = "
   , prettyPrintValue' val
   ]
-prettyPrintDeclaration (PositionedDeclaration _ d) = prettyPrintDeclaration d
+prettyPrintDeclaration (PositionedDeclaration _ _ d) = prettyPrintDeclaration d
 prettyPrintDeclaration _ = error "Invalid argument to prettyPrintDeclaration"
 
 prettyPrintCaseAlternative :: CaseAlternative -> StateT PrinterState Maybe String
@@ -126,7 +126,7 @@
     [ return "let "
     , withIndent $ prettyPrintMany prettyPrintDeclaration ds
     ]
-prettyPrintDoNotationElement (PositionedDoNotationElement _ el) = prettyPrintDoNotationElement el
+prettyPrintDoNotationElement (PositionedDoNotationElement _ _ el) = prettyPrintDoNotationElement el
 
 ifThenElse :: Pattern PrinterState Expr ((Expr, Expr), Expr)
 ifThenElse = mkPattern match
@@ -204,7 +204,7 @@
     , return "]"
     ]
   match (NamedBinder ident binder) = ((show ident ++ "@") ++) <$> prettyPrintBinder' binder
-  match (PositionedBinder _ binder) = prettyPrintBinder' binder
+  match (PositionedBinder _ _ binder) = prettyPrintBinder' binder
   match _ = mzero
 
 -- |
diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs
--- a/src/Language/PureScript/Renamer.hs
+++ b/src/Language/PureScript/Renamer.hs
@@ -1,4 +1,5 @@
 -----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 --
 -- Module      :  Language.PureScript.Renamer
 -- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
@@ -23,8 +24,7 @@
 import qualified Data.Map as M
 import qualified Data.Set as S
 
-import Language.PureScript.AST
-import Language.PureScript.Environment
+import Language.PureScript.CoreFn
 import Language.PureScript.Names
 import Language.PureScript.Traversals
 
@@ -100,25 +100,21 @@
 -- |
 -- Finds idents introduced by declarations.
 --
-findDeclIdents :: [Declaration] -> [Ident]
+findDeclIdents :: [Bind Ann] -> [Ident]
 findDeclIdents = concatMap go
   where
-  go (ValueDeclaration ident _ _ _) = [ident]
-  go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
-  go (ExternDeclaration _ ident _ _) = [ident]
-  go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
-  go (PositionedDeclaration _ d) = go d
-  go _ = []
+  go (NonRec ident _) = [ident]
+  go (Rec ds) = map fst ds
 
 -- |
 -- Renames within each declaration in a module.
 --
-renameInModules :: [Module] -> [Module]
+renameInModules :: [Module Ann] -> [Module Ann]
 renameInModules = map go
   where
-  go :: Module -> Module
-  go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
-  renameInDecl' :: [Ident] -> Declaration -> Declaration
+  go :: Module Ann -> Module Ann
+  go m@(Module _ _ _ _ decls) = m { moduleDecls = renameInDecl' (findDeclIdents decls) `map` decls }
+  renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann
   renameInDecl' scope = runRename scope . renameInDecl True
 
 -- |
@@ -128,65 +124,57 @@
 -- been added), whereas in a Let declarations are renamed if their name shadows
 -- another in the current scope.
 --
-renameInDecl :: Bool -> Declaration -> Rename Declaration
-renameInDecl isTopLevel (ValueDeclaration name nameKind [] (Right val)) = do
+renameInDecl :: Bool -> Bind Ann -> Rename (Bind Ann)
+renameInDecl isTopLevel (NonRec name val) = do
   name' <- if isTopLevel then return name else updateScope name
-  ValueDeclaration name' nameKind [] . Right <$> renameInValue val
-renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
+  NonRec name' <$> renameInValue val
+renameInDecl isTopLevel (Rec ds) = do
   ds' <- mapM updateNames ds
-  BindingGroupDeclaration <$> mapM updateValues ds'
+  Rec <$> mapM updateValues ds'
   where
-  updateNames :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)
-  updateNames (name, nameKind, val) = do
+  updateNames :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
+  updateNames (name, val) = do
     name' <- if isTopLevel then return name else updateScope name
-    return (name', nameKind, val)
-  updateValues :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)
-  updateValues (name, nameKind, val) =
-    (,,) name nameKind <$> renameInValue val
-renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
-  TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
-renameInDecl isTopLevel (PositionedDeclaration pos d) =
-  PositionedDeclaration pos <$> renameInDecl isTopLevel d
-renameInDecl _ other = return other
+    return (name', val)
+  updateValues :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
+  updateValues (name, val) = (,) name <$> renameInValue val
 
 -- |
 -- Renames within a value.
 --
-renameInValue :: Expr -> Rename Expr
-renameInValue (UnaryMinus v) =
-  UnaryMinus <$> renameInValue v
-renameInValue (ArrayLiteral vs) =
-  ArrayLiteral <$> mapM renameInValue vs
-renameInValue (ObjectLiteral vs) =
-  ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
-renameInValue (Accessor prop v) =
-  Accessor prop <$> renameInValue v
-renameInValue (ObjectUpdate obj vs) =
-  ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
-renameInValue (Abs (Left name) v) =
-  newScope $ Abs . Left <$> updateScope name <*> renameInValue v
-renameInValue (App v1 v2) =
-  App <$> renameInValue v1 <*> renameInValue v2
-renameInValue (Var (Qualified Nothing name)) =
-  Var . Qualified Nothing <$> lookupIdent name
-renameInValue (IfThenElse v1 v2 v3) =
-  IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
-renameInValue (Case vs alts) =
-  newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
-renameInValue (TypedValue check v ty) =
-  TypedValue check <$> renameInValue v <*> pure ty
-renameInValue (Let ds v) =
-  newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
-renameInValue (TypeClassDictionaryConstructorApp name v) =
-  TypeClassDictionaryConstructorApp name <$> renameInValue v
-renameInValue (PositionedValue pos v) =
-  PositionedValue pos <$> renameInValue v
-renameInValue v = return v
+renameInValue :: Expr Ann -> Rename (Expr Ann)
+renameInValue (Literal ann l) =
+  Literal ann <$> renameInLiteral renameInValue l
+renameInValue c@(Constructor{}) = return c
+renameInValue (Accessor ann prop v) =
+  Accessor ann prop <$> renameInValue v
+renameInValue (ObjectUpdate ann obj vs) =
+  ObjectUpdate ann <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
+renameInValue e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) = return e
+renameInValue (Abs ann name v) =
+  newScope $ Abs ann <$> updateScope name <*> renameInValue v
+renameInValue (App ann v1 v2) =
+  App ann <$> renameInValue v1 <*> renameInValue v2
+renameInValue (Var ann (Qualified Nothing name)) =
+  Var ann . Qualified Nothing <$> lookupIdent name
+renameInValue v@(Var{}) = return v
+renameInValue (Case ann vs alts) =
+  newScope $ Case ann <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
+renameInValue (Let ann ds v) =
+  newScope $ Let ann <$> mapM (renameInDecl False) ds <*> renameInValue v
 
 -- |
+-- Renames within literals.
+--
+renameInLiteral :: (a -> Rename a) -> Literal a -> Rename (Literal a)
+renameInLiteral rename (ArrayLiteral bs) = ArrayLiteral <$> mapM rename bs
+renameInLiteral rename (ObjectLiteral bs) = ObjectLiteral <$> mapM (sndM rename) bs
+renameInLiteral _ l = return l
+
+-- |
 -- Renames within case alternatives.
 --
-renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
+renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
 renameInCaseAlternative (CaseAlternative bs v) =
   CaseAlternative <$> mapM renameInBinder bs
                   <*> eitherM (mapM (pairM renameInValue renameInValue)) renameInValue v
@@ -194,18 +182,13 @@
 -- |
 -- Renames within binders.
 --
-renameInBinder :: Binder -> Rename Binder
-renameInBinder (VarBinder name) =
-  VarBinder <$> updateScope name
-renameInBinder (ConstructorBinder name bs) =
-  ConstructorBinder name <$> mapM renameInBinder bs
-renameInBinder (ObjectBinder bs) =
-  ObjectBinder <$> mapM (sndM renameInBinder) bs
-renameInBinder (ArrayBinder bs) =
-  ArrayBinder <$> mapM renameInBinder bs
-renameInBinder (ConsBinder b1 b2) =
-  ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
-renameInBinder (NamedBinder name b) =
-  NamedBinder <$> updateScope name <*> renameInBinder b
-renameInBinder (PositionedBinder _ b) = renameInBinder b
-renameInBinder other = return other
+renameInBinder :: Binder a -> Rename (Binder a)
+renameInBinder n@(NullBinder{}) = return n
+renameInBinder (LiteralBinder ann b) =
+  LiteralBinder ann <$> renameInLiteral renameInBinder b
+renameInBinder (VarBinder ann name) =
+  VarBinder ann <$> updateScope name
+renameInBinder (ConstructorBinder ann tctor dctor bs) =
+  ConstructorBinder ann tctor dctor <$> mapM renameInBinder bs
+renameInBinder (NamedBinder ann name b) =
+  NamedBinder ann <$> updateScope name <*> renameInBinder b
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -88,7 +88,7 @@
   where
   go (DataBindingGroupDeclaration ds) = ds
   go (BindingGroupDeclaration ds) = map (\(ident, nameKind, val) -> ValueDeclaration ident nameKind [] (Right val)) ds
-  go (PositionedDeclaration pos d) = map (PositionedDeclaration pos) $ go d
+  go (PositionedDeclaration pos com d) = map (PositionedDeclaration pos com) $ go d
   go other = [other]
 
 collapseBindingGroupsForValue :: Expr -> Expr
@@ -139,13 +139,13 @@
 
 getIdent :: Declaration -> Ident
 getIdent (ValueDeclaration ident _ _ _) = ident
-getIdent (PositionedDeclaration _ d) = getIdent d
+getIdent (PositionedDeclaration _ _ d) = getIdent d
 getIdent _ = error "Expected ValueDeclaration"
 
 getProperName :: Declaration -> ProperName
 getProperName (DataDeclaration _ pn _ _) = pn
 getProperName (TypeSynonymDeclaration pn _ _) = pn
-getProperName (PositionedDeclaration _ d) = getProperName d
+getProperName (PositionedDeclaration _ _ d) = getProperName d
 getProperName _ = error "Expected DataDeclaration"
 
 -- |
@@ -178,7 +178,7 @@
   toBinding (CyclicSCC ~(d:ds)) = cycleError d ds
 
   cycleError :: Declaration -> [Declaration] -> Either ErrorStack a
-  cycleError (PositionedDeclaration p d) ds = rethrowWithPosition p $ cycleError d ds
+  cycleError (PositionedDeclaration p _ d) ds = rethrowWithPosition p $ cycleError d ds
   cycleError (ValueDeclaration n _ _ (Right e)) [] = Left $
     mkErrorStack ("Cycle in definition of " ++ show n) (Just (ExprError e))
   cycleError d ds@(_:_) = rethrow (<> mkErrorStack ("The following are not yet defined here: " ++ unwords (map (show . getIdent) ds)) Nothing) $ cycleError d []
@@ -195,11 +195,11 @@
 
 isTypeSynonym :: Declaration -> Maybe ProperName
 isTypeSynonym (TypeSynonymDeclaration pn _ _) = Just pn
-isTypeSynonym (PositionedDeclaration _ d) = isTypeSynonym d
+isTypeSynonym (PositionedDeclaration _ _ d) = isTypeSynonym d
 isTypeSynonym _ = Nothing
 
 fromValueDecl :: Declaration -> (Ident, NameKind, Expr)
 fromValueDecl (ValueDeclaration ident nameKind [] (Right val)) = (ident, nameKind, val)
 fromValueDecl ValueDeclaration{} = error "Binders should have been desugared"
-fromValueDecl (PositionedDeclaration _ d) = fromValueDecl d
+fromValueDecl (PositionedDeclaration _ _ d) = fromValueDecl d
 fromValueDecl _ = error "Expected ValueDeclaration"
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -75,16 +75,16 @@
       where
       go (Let ds val') = Let <$> desugarCases ds <*> pure val'
       go other = return other
-    desugarRest (PositionedDeclaration pos d : ds) = do
+    desugarRest (PositionedDeclaration pos com d : ds) = do
       (d' : ds') <- desugarRest (d : ds)
-      return (PositionedDeclaration pos d' : ds')
+      return (PositionedDeclaration pos com d' : ds')
     desugarRest (d : ds) = (:) d <$> desugarRest ds
     desugarRest [] = pure []
 
 inSameGroup :: Declaration -> Declaration -> Bool
 inSameGroup (ValueDeclaration ident1 _ _ _) (ValueDeclaration ident2 _ _ _) = ident1 == ident2
-inSameGroup (PositionedDeclaration _ d1) d2 = inSameGroup d1 d2
-inSameGroup d1 (PositionedDeclaration _ d2) = inSameGroup d1 d2
+inSameGroup (PositionedDeclaration _ _ d1) d2 = inSameGroup d1 d2
+inSameGroup d1 (PositionedDeclaration _ _ d2) = inSameGroup d1 d2
 inSameGroup _ _ = False
 
 toDecls :: [Declaration] -> SupplyT (Either ErrorStack) [Declaration]
@@ -101,9 +101,9 @@
       throwError $ mkErrorStack ("Duplicate value declaration '" ++ show ident ++ "'") Nothing
   caseDecl <- makeCaseDeclaration ident tuples
   return [caseDecl]
-toDecls (PositionedDeclaration pos d : ds) = do
+toDecls (PositionedDeclaration pos com d : ds) = do
   (d' : ds') <- rethrowWithPosition pos $ toDecls (d : ds)
-  return (PositionedDeclaration pos d' : ds')
+  return (PositionedDeclaration pos com d' : ds')
 toDecls ds = return ds
 
 isVarBinder :: Binder -> Bool
@@ -112,7 +112,7 @@
 
 toTuple :: Declaration -> ([Binder], Either [(Guard, Expr)] Expr)
 toTuple (ValueDeclaration _ _ bs result) = (bs, result)
-toTuple (PositionedDeclaration _ d) = toTuple d
+toTuple (PositionedDeclaration _ _ d) = toTuple d
 toTuple _ = error "Not a value declaration"
 
 makeCaseDeclaration :: Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> SupplyT (Either ErrorStack) Declaration
diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs
--- a/src/Language/PureScript/Sugar/DoNotation.hs
+++ b/src/Language/PureScript/Sugar/DoNotation.hs
@@ -36,7 +36,7 @@
 desugarDoModule (Module mn ds exts) = Module mn <$> parU ds desugarDo <*> pure exts
 
 desugarDo :: Declaration -> SupplyT (Either ErrorStack) Declaration
-desugarDo (PositionedDeclaration pos d) = (PositionedDeclaration pos) <$> (rethrowWithPosition pos $ desugarDo d)
+desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (rethrowWithPosition pos $ desugarDo d)
 desugarDo d =
   let (f, _, _) = everywhereOnValuesM return replace return
   in f d
@@ -49,7 +49,7 @@
 
   replace :: Expr -> SupplyT (Either ErrorStack) Expr
   replace (Do els) = go els
-  replace (PositionedValue pos v) = PositionedValue pos <$> rethrowWithPosition pos (replace v)
+  replace (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace v)
   replace other = return other
 
   go :: [DoNotationElement] -> SupplyT (Either ErrorStack) Expr
@@ -71,4 +71,4 @@
   go (DoNotationLet ds : rest) = do
     rest' <- go rest
     return $ Let ds rest'
-  go (PositionedDoNotationElement pos el : rest) = rethrowWithPosition pos $ PositionedValue pos <$> go (el : rest)
+  go (PositionedDoNotationElement pos com el : rest) = rethrowWithPosition pos $ PositionedValue pos com <$> go (el : rest)
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -199,7 +199,7 @@
   (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS
 
   updateDecl :: (Maybe SourceSpan, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Declaration)
-  updateDecl (_, bound) d@(PositionedDeclaration pos _) = return ((Just pos, bound), d)
+  updateDecl (_, bound) d@(PositionedDeclaration pos _ _) = return ((Just pos, bound), d)
   updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =
     (,) (pos, bound) <$> (DataDeclaration dtype name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)
   updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =
@@ -217,7 +217,7 @@
   updateDecl s d = return (s, d)
 
   updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Expr)
-  updateValue (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)
+  updateValue (_, bound) v@(PositionedValue pos' _ _) = return ((Just pos', bound), v)
   updateValue (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')
   updateValue (pos, bound) (Let ds val') =
       let args = mapMaybe letBoundVariable ds
@@ -235,7 +235,7 @@
   updateValue s v = return (s, v)
 
   updateBinder :: (Maybe SourceSpan, [Ident]) -> Binder -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Binder)
-  updateBinder (_, bound) v@(PositionedBinder pos _) = return ((Just pos, bound), v)
+  updateBinder (_, bound) v@(PositionedBinder pos _ _) = return ((Just pos, bound), v)
   updateBinder s@(pos, _) (ConstructorBinder name b) = (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)
   updateBinder s v = return (s, v)
 
@@ -244,7 +244,7 @@
 
   letBoundVariable :: Declaration -> Maybe Ident
   letBoundVariable (ValueDeclaration ident _ _ _) = Just ident
-  letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d
+  letBoundVariable (PositionedDeclaration _ _ d) = letBoundVariable d
   letBoundVariable _ = Nothing
 
   updateTypesEverywhere :: Maybe SourceSpan -> Type -> Either ErrorStack Type
@@ -317,14 +317,14 @@
     foldM go env' ds
     where
     go env'' (TypeDeclaration name _) = addValue env'' mn name
-    go env'' (PositionedDeclaration pos d) = rethrowWithPosition pos $ go env'' d
+    go env'' (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ go env'' d
     go _ _ = error "Invalid declaration in TypeClassDeclaration"
   addDecl mn env (DataDeclaration _ tn _ dcs) = addType env mn tn (map fst dcs)
   addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []
   addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []
   addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name
   addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name
-  addDecl mn env (PositionedDeclaration _ d) = addDecl mn env d
+  addDecl mn env (PositionedDeclaration _ _ d) = addDecl mn env d
   addDecl _  env _ = return env
 
 -- |
@@ -349,7 +349,7 @@
   -- Ensure the exported types and data constructors exist in the module and add them to the set of
   -- exports
   filterTypes :: [(ProperName, [ProperName])] -> [(ProperName, [ProperName])] -> DeclarationRef -> Either ErrorStack [(ProperName, [ProperName])]
-  filterTypes expTys result (PositionedDeclarationRef pos r) = rethrowWithPosition pos $ filterTypes expTys result r
+  filterTypes expTys result (PositionedDeclarationRef pos _ r) = rethrowWithPosition pos $ filterTypes expTys result r
   filterTypes expTys result (TypeRef name expDcons) = do
     dcons <- maybe (throwError $ mkErrorStack ("Cannot export undefined type '" ++ show name ++ "'") Nothing) return $ name `lookup` expTys
     dcons' <- maybe (return dcons) (foldM (filterDcons name dcons) []) expDcons
@@ -365,7 +365,7 @@
 
   -- Ensure the exported classes exist in the module and add them to the set of exports
   filterClasses :: [ProperName] -> [ProperName] -> DeclarationRef -> Either ErrorStack [ProperName]
-  filterClasses exps' result (PositionedDeclarationRef pos r) = rethrowWithPosition pos $ filterClasses exps' result r
+  filterClasses exps' result (PositionedDeclarationRef pos _ r) = rethrowWithPosition pos $ filterClasses exps' result r
   filterClasses exps' result (TypeClassRef name) =
     if name `elem` exps'
     then return $ name : result
@@ -374,7 +374,7 @@
 
   -- Ensure the exported values exist in the module and add them to the set of exports
   filterValues :: [Ident] -> [Ident] -> DeclarationRef -> Either ErrorStack [Ident]
-  filterValues exps' result (PositionedDeclarationRef pos r) = rethrowWithPosition pos $ filterValues exps' result r
+  filterValues exps' result (PositionedDeclarationRef pos _ r) = rethrowWithPosition pos $ filterValues exps' result r
   filterValues exps' result (ValueRef name) =
     if name `elem` exps'
     then return $ name : result
@@ -389,7 +389,7 @@
 findImports = foldl (findImports' Nothing) M.empty
   where
   findImports' pos result (ImportDeclaration mn typ qual) = M.insert mn (pos, typ, qual) result
-  findImports' _ result (PositionedDeclaration pos d) = findImports' (Just pos) result d
+  findImports' _ result (PositionedDeclaration pos _ d) = findImports' (Just pos) result d
   findImports' _ result _ = result
 
 -- |
@@ -443,7 +443,7 @@
       checkTypeRef (TypeRef _ Nothing) acc (TypeRef _ (Just _)) = acc
       checkTypeRef (TypeRef name (Just dctor)) _ (TypeRef name' (Just dctor')) = name == name' && dctor == dctor'
       checkTypeRef (TypeRef name _) _ (TypeRef name' Nothing) = name == name'
-      checkTypeRef (PositionedDeclarationRef _ r) acc hiddenRef = checkTypeRef r acc hiddenRef
+      checkTypeRef (PositionedDeclarationRef _ _ r) acc hiddenRef = checkTypeRef r acc hiddenRef
       checkTypeRef _ acc _ = acc
     in foldl (checkTypeRef ref) False hidden
   isHidden hidden ref = ref `elem` hidden
@@ -457,7 +457,7 @@
 
   -- Import something explicitly
   importExplicit :: ImportEnvironment -> DeclarationRef -> Either ErrorStack ImportEnvironment
-  importExplicit imp (PositionedDeclarationRef pos r) = rethrowWithPosition pos $ importExplicit imp r
+  importExplicit imp (PositionedDeclarationRef pos _ r) = rethrowWithPosition pos $ importExplicit imp r
   importExplicit imp (ValueRef name) = do
     values' <- updateImports (importedValues imp) name
     return $ imp { importedValues = values' }
@@ -476,7 +476,7 @@
   checkedRefs :: [DeclarationRef] -> Either ErrorStack [DeclarationRef]
   checkedRefs = mapM check
     where
-    check (PositionedDeclarationRef pos r) =
+    check (PositionedDeclarationRef pos _ r) =
       rethrowWithPosition pos $ check r
     check ref@(ValueRef name) =
       checkImportExists "value" values name >> return ref
diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
--- a/src/Language/PureScript/Sugar/Operators.hs
+++ b/src/Language/PureScript/Sugar/Operators.hs
@@ -80,7 +80,7 @@
 collectFixities (Module moduleName ds _) = concatMap collect ds
   where
   collect :: Declaration -> [(Qualified Ident, SourceSpan, Fixity)]
-  collect (PositionedDeclaration pos (FixityDeclaration fixity name)) = [(Qualified (Just moduleName) (Op name), pos, fixity)]
+  collect (PositionedDeclaration pos _ (FixityDeclaration fixity name)) = [(Qualified (Just moduleName) (Op name), pos, fixity)]
   collect FixityDeclaration{} = error "Fixity without srcpos info"
   collect _ = []
 
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -14,11 +14,13 @@
 --
 -----------------------------------------------------------------------------
 
-module Language.PureScript.Sugar.TypeClasses (
-  desugarTypeClasses
-) where
+module Language.PureScript.Sugar.TypeClasses
+  ( desugarTypeClasses
+  , typeClassMemberName
+  , superClassDictionaryNames
+  ) where
 
-import Language.PureScript.AST
+import Language.PureScript.AST hiding (isExported)
 import Language.PureScript.Names
 import Language.PureScript.Types
 import Language.PureScript.Kinds
@@ -162,9 +164,9 @@
     desugared <- lift $ desugarCases members
     dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared
     return $ (expRef name className tys, [d, dictDecl])
-  go (PositionedDeclaration pos d) = do
+  go (PositionedDeclaration pos com d) = do
     (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d
-    return (dr, map (PositionedDeclaration pos) ds)
+    return (dr, map (PositionedDeclaration pos com) ds)
   go other = return (Nothing, [other])
 
   expRef :: Ident -> Qualified ProperName -> [Type] -> Maybe DeclarationRef
@@ -195,16 +197,15 @@
 
 memberToNameAndType :: Declaration -> (Ident, Type)
 memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)
-memberToNameAndType (PositionedDeclaration _ d) = memberToNameAndType d
+memberToNameAndType (PositionedDeclaration _ _ d) = memberToNameAndType d
 memberToNameAndType _ = error "Invalid declaration in type class definition"
 
-typeClassDictionaryDeclaration :: ProperName -> [(String, Maybe Kind)] -> [(Qualified ProperName, [Type])] -> [Declaration] -> Declaration
+typeClassDictionaryDeclaration :: ProperName -> [(String, Maybe Kind)] -> [Constraint] -> [Declaration] -> Declaration
 typeClassDictionaryDeclaration name args implies members =
-  let superclassTypes = [ (fieldName, function unit tySynApp)
-                        | (index, (superclass, tyArgs)) <- zip [0..] implies
-                        , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs
-                        , let fieldName = mkSuperclassDictionaryName superclass index
-                        ]
+  let superclassTypes = superClassDictionaryNames implies `zip`
+        [ function unit (foldl TypeApp (TypeConstructor superclass) tyArgs)
+        | (superclass, tyArgs) <- implies
+        ]
       members' = map (first runIdent . memberToNameAndType) members
       mtys = members' ++ superclassTypes
   in TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (mtys, REmpty))
@@ -214,17 +215,14 @@
   ValueDeclaration ident TypeClassAccessorImport [] $ Right $
     TypedValue False (Abs (Left $ Ident "dict") (Accessor (runIdent ident) (Var $ Qualified Nothing (Ident "dict")))) $
     moveQuantifiersToFront (quantify (ConstrainedType [(Qualified (Just mn) name, map (TypeVar . fst) args)] ty))
-typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =
-  PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d
+typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =
+  PositionedDeclaration pos com $ typeClassMemberToDictionaryAccessor mn name args d
 typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"
 
-mkSuperclassDictionaryName :: Qualified ProperName -> Integer -> String
-mkSuperclassDictionaryName pn index = C.__superclass_ ++ show pn ++ "_" ++ show index
-
 unit :: Type
 unit = TypeApp tyObject REmpty
 
-typeInstanceDictionaryDeclaration :: Ident -> ModuleName -> [(Qualified ProperName, [Type])] -> Qualified ProperName -> [Type] -> [Declaration] -> Desugar Declaration
+typeInstanceDictionaryDeclaration :: Ident -> ModuleName -> [Constraint] -> Qualified ProperName -> [Type] -> [Declaration] -> Desugar Declaration
 typeInstanceDictionaryDeclaration name mn deps className tys decls =
   rethrow (strMsg ("Error in type class instance " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys) ++ ":") <>) $ do
   m <- get
@@ -242,46 +240,51 @@
 
       -- Replace the type arguments with the appropriate types in the member types
       let memberTypes = map (second (replaceAllTypeVars (zip (map fst args) tys))) instanceTys
+
       -- Create values for the type instance members
-      memberNames <- map (first runIdent) <$> mapM (memberToNameAndValue memberTypes) decls
+      members <- zip (map typeClassMemberName decls) <$> mapM (memberToValue memberTypes) decls
+
       -- Create the type of the dictionary
       -- The type is an object type, but depending on type instance dependencies, may be constrained.
       -- The dictionary itself is an object literal.
-      let superclasses =
-            [ (fieldName, Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs))
-            | (index, (superclass, suTyArgs)) <- zip [0..] implies
+      let superclasses = superClassDictionaryNames implies `zip`
+            [ Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs)
+            | (superclass, suTyArgs) <- implies
             , let tyArgs = map (replaceAllTypeVars (zip (map fst args) tys)) suTyArgs
-            , let fieldName = mkSuperclassDictionaryName superclass index
             ]
 
-      let memberNames' = ObjectLiteral (memberNames ++ superclasses)
+      let props = ObjectLiteral (members ++ superclasses)
           dictTy = foldl TypeApp (TypeConstructor className) tys
           constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)
-          dict = TypeClassDictionaryConstructorApp className memberNames'
+          dict = TypeClassDictionaryConstructorApp className props
           result = ValueDeclaration name TypeInstanceDictionaryValue [] (Right (TypedValue True dict constrainedTy))
       return result
 
   where
 
   declName :: Declaration -> Maybe Ident
-  declName (PositionedDeclaration _ d) = declName d
+  declName (PositionedDeclaration _ _ d) = declName d
   declName (ValueDeclaration ident _ _ _) = Just ident
   declName (TypeDeclaration ident _) = Just ident
   declName _ = Nothing
 
-  memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Expr)
-  memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _) = do
+  memberToValue :: [(Ident, Type)] -> Declaration -> Desugar Expr
+  memberToValue tys' (ValueDeclaration ident _ [] (Right val)) = do
     _ <- lift . lift . maybe (Left $ mkErrorStack ("Type class does not define member '" ++ show ident ++ "'") Nothing) Right $ lookup ident tys'
-    let memberValue = typeInstanceDictionaryEntryValue d
-    return (ident, memberValue)
-  memberToNameAndValue tys' (PositionedDeclaration pos d) = rethrowWithPosition pos $ do
-    (ident, val) <- memberToNameAndValue tys' d
-    return (ident, PositionedValue pos val)
-  memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"
-
-  typeInstanceDictionaryEntryValue :: Declaration -> Expr
-  typeInstanceDictionaryEntryValue (ValueDeclaration _ _ [] (Right val)) = val
-  typeInstanceDictionaryEntryValue (PositionedDeclaration pos d) = PositionedValue pos (typeInstanceDictionaryEntryValue d)
-  typeInstanceDictionaryEntryValue _ = error "Invalid declaration in type instance definition"
+    return val
+  memberToValue tys' (PositionedDeclaration pos com d) = rethrowWithPosition pos $ do
+    val <- memberToValue tys' d
+    return (PositionedValue pos com val)
+  memberToValue _ _ = error "Invalid declaration in type instance definition"
 
+typeClassMemberName :: Declaration -> String
+typeClassMemberName (TypeDeclaration ident _) = runIdent ident
+typeClassMemberName (ValueDeclaration ident _ _ _) = runIdent ident
+typeClassMemberName (PositionedDeclaration _ _ d) = typeClassMemberName d
+typeClassMemberName d = error $ "Invalid declaration in type class definition: " ++ show d
 
+superClassDictionaryNames :: [Constraint] -> [String]
+superClassDictionaryNames supers =
+  [ C.__superclass_ ++ show pn ++ "_" ++ show (index :: Integer)
+  | (index, (pn, _)) <- zip [0..] supers
+  ]
diff --git a/src/Language/PureScript/Sugar/TypeDeclarations.hs b/src/Language/PureScript/Sugar/TypeDeclarations.hs
--- a/src/Language/PureScript/Sugar/TypeDeclarations.hs
+++ b/src/Language/PureScript/Sugar/TypeDeclarations.hs
@@ -43,18 +43,18 @@
 -- Replace all top level type declarations with type annotations
 --
 desugarTypeDeclarations :: [Declaration] -> Either ErrorStack [Declaration]
-desugarTypeDeclarations (PositionedDeclaration pos d : ds) = do
+desugarTypeDeclarations (PositionedDeclaration pos com d : ds) = do
   (d' : ds') <- rethrowWithPosition pos $ desugarTypeDeclarations (d : ds)
-  return (PositionedDeclaration pos d' : ds')
+  return (PositionedDeclaration pos com d' : ds')
 desugarTypeDeclarations (TypeDeclaration name ty : d : rest) = do
   (_, nameKind, val) <- fromValueDeclaration d
   desugarTypeDeclarations (ValueDeclaration name nameKind [] (Right (TypedValue True val ty)) : rest)
   where
   fromValueDeclaration :: Declaration -> Either ErrorStack (Ident, NameKind, Expr)
   fromValueDeclaration (ValueDeclaration name' nameKind [] (Right val)) | name == name' = return (name', nameKind, val)
-  fromValueDeclaration (PositionedDeclaration pos d') = do
+  fromValueDeclaration (PositionedDeclaration pos com d') = do
     (ident, nameKind, val) <- rethrowWithPosition pos $ fromValueDeclaration d'
-    return (ident, nameKind, PositionedValue pos val)
+    return (ident, nameKind, PositionedValue pos com val)
   fromValueDeclaration _ = throwError $ mkErrorStack ("Orphan type declaration for " ++ show name) Nothing
 desugarTypeDeclarations (TypeDeclaration name _ : []) = throwError $ mkErrorStack ("Orphan type declaration for " ++ show name) Nothing
 desugarTypeDeclarations (ValueDeclaration name nameKind bs val : rest) = do
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -78,13 +78,13 @@
   env <- getEnv
   putEnv (env { names = M.insert (moduleName, name) (ty, nameKind, Defined) (names env) })
 
-addTypeClass :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> [(Qualified ProperName, [Type])] -> [Declaration] -> Check ()
+addTypeClass :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> [Constraint] -> [Declaration] -> Check ()
 addTypeClass moduleName pn args implies ds =
   let members = map toPair ds in
   modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) (args, members, implies) (typeClasses . checkEnv $ st) } }
   where
   toPair (TypeDeclaration ident ty) = (ident, ty)
-  toPair (PositionedDeclaration _ d) = toPair d
+  toPair (PositionedDeclaration _ _ d) = toPair d
   toPair _ = error "Invalid declaration in TypeClassDeclaration"
 
 addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()
@@ -163,10 +163,10 @@
     return $ d : ds
     where
     toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
-    toTypeSynonym (PositionedDeclaration _ d') = toTypeSynonym d'
+    toTypeSynonym (PositionedDeclaration _ _ d') = toTypeSynonym d'
     toTypeSynonym _ = Nothing
     toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)
-    toDataDecl (PositionedDeclaration _ d') = toDataDecl d'
+    toDataDecl (PositionedDeclaration _ _ d') = toDataDecl d'
     toDataDecl _ = Nothing
   go (TypeSynonymDeclaration name args ty : rest) = do
     rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do
@@ -235,28 +235,32 @@
     addTypeClass moduleName pn args implies tys
     ds <- go rest
     return $ d : ds
-  go (TypeInstanceDeclaration dictName deps className tys _ : rest) =
-    go (ExternInstanceDeclaration dictName deps className tys : rest)
+  go (d@(TypeInstanceDeclaration dictName deps className tys _) : rest) = do
+    goInstance d dictName deps className tys rest
   go (d@(ExternInstanceDeclaration dictName deps className tys) : rest) = do
+    goInstance d dictName deps className tys rest
+  go (PositionedDeclaration pos com d : rest) =
+    rethrowWithPosition pos $ do
+      (d' : rest') <- go (d : rest)
+      return (PositionedDeclaration pos com d' : rest')
+  goInstance :: Declaration -> Ident -> [Constraint] -> Qualified ProperName -> [Type] -> [Declaration] -> Check [Declaration]
+  goInstance d dictName deps className tys rest = do
     mapM_ (checkTypeClassInstance moduleName) tys
     forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd
     addTypeClassDictionaries [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported]
     ds <- go rest
     return $ d : ds
+
     where
+
     isInstanceExported :: Bool
     isInstanceExported = any exportsInstance exps
 
     exportsInstance :: DeclarationRef -> Bool
     exportsInstance (TypeInstanceRef name) | name == dictName = True
-    exportsInstance (PositionedDeclarationRef _ r) = exportsInstance r
+    exportsInstance (PositionedDeclarationRef _ _ r) = exportsInstance r
     exportsInstance _ = False
 
-  go (PositionedDeclaration pos d : rest) =
-    rethrowWithPosition pos $ do
-      (d' : rest') <- go (d : rest)
-      return (PositionedDeclaration pos d' : rest')
-
   -- |
   -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,
   -- extracted from the kind of the type constructor itself.
@@ -342,10 +346,10 @@
     runValueRef _ = error "non-ValueRef passed to runValueRef"
     findClassMembers :: Declaration -> Maybe [Ident]
     findClassMembers (TypeClassDeclaration name' _ _ ds) | name == name' = Just $ map extractMemberName ds
-    findClassMembers (PositionedDeclaration _ d) = findClassMembers d
+    findClassMembers (PositionedDeclaration _ _ d) = findClassMembers d
     findClassMembers _ = Nothing
     extractMemberName :: Declaration -> Ident
-    extractMemberName (PositionedDeclaration _ d) = extractMemberName d
+    extractMemberName (PositionedDeclaration _ _ d) = extractMemberName d
     extractMemberName (TypeDeclaration memberName _) = memberName
     extractMemberName _ = error "Unexpected declaration in typeclass member list"
   checkClassMembersAreExported _ = return ()
diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
--- a/src/Language/PureScript/TypeChecker/Entailment.hs
+++ b/src/Language/PureScript/TypeChecker/Entailment.hs
@@ -64,7 +64,7 @@
 -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
 -- return a type class dictionary reference.
 --
-entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Bool -> Check Expr
+entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
 entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))
   where
     sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
@@ -107,7 +107,7 @@
       -- Create dictionaries for subgoals which still need to be solved by calling go recursively
       -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
       -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
-      solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]
+      solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> [Maybe [DictionaryValue]]
       solveSubgoals _ Nothing = return Nothing
       solveSubgoals subst (Just subgoals) = do
         dict <- mapM (uncurry (go True) . second (map (replaceAllTypeVars subst))) subgoals
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -296,7 +296,7 @@
   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
   val' <- if checkType then check val ty' else return val
   return $ TypedValue True val' ty'
-infer' (PositionedValue pos val) = rethrowWithPosition pos $ infer' val
+infer' (PositionedValue pos _ val) = rethrowWithPosition pos $ infer' val
 infer' _ = error "Invalid argument to infer"
 
 inferLetBinding :: [Declaration] -> [Declaration] -> Expr -> (Expr -> UnifyT Type Check Expr) -> UnifyT Type Check ([Declaration], Expr)
@@ -322,9 +322,9 @@
   ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
   let ds' = [(ident, LocalVariable, val') | (ident, (val', _)) <- ds1' ++ ds2']
   makeBindingGroupVisible $ bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j
-inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = rethrowWithPosition pos $ do
+inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = rethrowWithPosition pos $ do
   (d' : ds', val') <- inferLetBinding seen (d : ds) ret j
-  return (PositionedDeclaration pos d' : ds', val')
+  return (PositionedDeclaration pos com d' : ds', val')
 inferLetBinding _ _ _ _ = error "Invalid argument to inferLetBinding"
 
 -- |
@@ -394,7 +394,7 @@
 inferBinder val (NamedBinder name binder) = do
   m <- inferBinder val binder
   return $ M.insert name val m
-inferBinder val (PositionedBinder pos binder) =
+inferBinder val (PositionedBinder pos _ binder) =
   rethrowWithPosition pos $ inferBinder val binder
 
 -- |
@@ -563,7 +563,7 @@
   guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
   val' <- check' val ty
   return $ TypedValue True val' kt
-check' (PositionedValue pos val) ty =
+check' (PositionedValue pos _ val) ty =
   rethrowWithPosition pos $ check val ty
 check' val ty = throwError $ mkErrorStack ("Expr does not have type " ++ prettyPrintType ty) (Just (ExprError val))
 
diff --git a/src/Language/PureScript/TypeClassDictionaries.hs b/src/Language/PureScript/TypeClassDictionaries.hs
--- a/src/Language/PureScript/TypeClassDictionaries.hs
+++ b/src/Language/PureScript/TypeClassDictionaries.hs
@@ -41,7 +41,7 @@
     -- |
     -- Type class dependencies which must be satisfied to construct this dictionary
     --
-    , tcdDependencies :: Maybe [(Qualified ProperName, [Type])]
+    , tcdDependencies :: Maybe [Constraint]
     -- |
     -- The type of this dictionary
     --
diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs
--- a/src/Language/PureScript/Types.hs
+++ b/src/Language/PureScript/Types.hs
@@ -69,7 +69,7 @@
   -- |
   -- A type with a set of type class constraints
   --
-  | ConstrainedType [(Qualified ProperName, [Type])] Type
+  | ConstrainedType [Constraint] Type
   -- |
   -- A skolem constant
   --
@@ -84,7 +84,7 @@
   | RCons String Type Type
   -- |
   -- A type with a kind annotation
-  -- 
+  --
   | KindedType Type Kind
   --
   -- |
@@ -105,6 +105,11 @@
   | PrettyPrintForAll [String] Type deriving (Show, Eq, Data, Typeable)
 
 -- |
+-- A typeclass constraint
+--
+type Constraint = (Qualified ProperName, [Type])
+
+-- |
 -- Convert a row to a list of pairs of labels and types
 --
 rowToList :: Type -> ([(String, Type)], Type)
@@ -144,9 +149,9 @@
 replaceAllTypeVars :: [(String, Type)] -> Type -> Type
 replaceAllTypeVars = go []
   where
-      
+
   go :: [String] -> [(String, Type)] -> Type -> Type
-  go _  m (TypeVar v) = 
+  go _  m (TypeVar v) =
     case v `lookup` m of
       Just r -> r
       Nothing -> TypeVar v
@@ -165,7 +170,7 @@
   go bs m (RCons name' t r) = RCons name' (go bs m t) (go bs m r)
   go bs m (KindedType t k) = KindedType (go bs m t) k
   go _  _ ty = ty
-  
+
   genName orig inUse = try 0
     where
     try :: Integer -> String