From ce534e93c9b8ca5318d48b274a455af79fe594ed Mon Sep 17 00:00:00 2001
From: PhilFreeman <>
Date: Sat, 21 Feb 2015 03:18:00 +0100
Subject: version 0.6.8


diff --git a/examples/passing/OneConstructor.purs b/examples/passing/OneConstructor.purs
index 914255a..e46cf6a 100644
--- a/examples/passing/OneConstructor.purs
+++ b/examples/passing/OneConstructor.purs
@@ -2,6 +2,6 @@ module Main where
 
 data One a = One a
 
-one (One a) = a
+one' (One a) = a
 
 main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Rank2Data.purs b/examples/passing/Rank2Data.purs
index fb030b0..ccc60f5 100644
--- a/examples/passing/Rank2Data.purs
+++ b/examples/passing/Rank2Data.purs
@@ -12,18 +12,18 @@ module Main where
   runNat = \nat -> case nat of
     Nat f -> f 0 (\n -> n + 1)
 
-  zero = Nat (\zero _ -> zero)
+  zero' = Nat (\zero' _ -> zero')
 
   succ = \n -> case n of
-    Nat f -> Nat (\zero succ -> succ (f zero succ))
+    Nat f -> Nat (\zero' succ -> succ (f zero' succ))
 
   add = \n m -> case n of
     Nat f -> case m of
-      Nat g -> Nat (\zero succ -> g (f zero succ) succ)
+      Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
 
-  one = succ zero
-  two = succ zero
+  one' = succ zero'
+  two = succ zero'
   four = add two two
   fourNumber = runNat four
 
-  main = Debug.Trace.trace "Done"
+  main = Debug.Trace.trace "Done'"
diff --git a/examples/passing/ShadowedTCO.purs b/examples/passing/ShadowedTCO.purs
index 6cc4ff9..05d6120 100644
--- a/examples/passing/ShadowedTCO.purs
+++ b/examples/passing/ShadowedTCO.purs
@@ -2,14 +2,14 @@ module Main where
 
 runNat f = f 0 (\n -> n + 1)
 
-zero z _ = z
+zero' z _ = z
 
-succ f zero succ = succ (f zero succ)
+succ f zero' succ = succ (f zero' succ)
 
-add f g zero succ = g (f zero succ) succ
+add f g zero' succ = g (f zero' succ) succ
 
-one = succ zero
-two = succ one
+one' = succ zero'
+two = succ one'
 four = add two two
 fourNumber = runNat four
 
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index 1ec9679..ceb99e0 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -13,8 +13,13 @@ module Prelude
   , Applicative, pure, liftA1
   , Bind, (>>=)
   , Monad, return, liftM1, ap
-  , Num, (+), (-), (*), (/), (%)
+  , Semiring, (+), zero, (*), one
+  , ModuloSemiring, (/), mod
+  , Ring, (-)
+  , (%)
   , negate
+  , DivisionRing
+  , Num
   , Eq, (==), (/=), refEq, refIneq
   , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
   , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
@@ -24,28 +29,28 @@ module Prelude
   , Unit(..), unit
   ) where
 
-  -- | An alias for `true`, which can be useful in guard clauses: 
-  -- | 
+  -- | An alias for `true`, which can be useful in guard clauses:
+  -- |
   -- | E.g.
-  -- | 
-  -- |     max x y | x >= y = x 
+  -- |
+  -- |     max x y | x >= y = x
   -- |             | otherwise = y
   otherwise :: Boolean
   otherwise = true
 
-  -- | Flips the order of the arguments to a function of two arguments. 
+  -- | Flips the order of the arguments to a function of two arguments.
   flip :: forall a b c. (a -> b -> c) -> b -> a -> c
   flip f b a = f a b
 
-  -- | Returns its first argument and ignores its second. 
+  -- | Returns its first argument and ignores its second.
   const :: forall a b. a -> b -> a
   const a _ = a
 
   -- | This function returns its first argument, and can be used to assert type equalities.
-  -- | This can be useful when types are otherwise ambiguous. 
-  -- | 
+  -- | This can be useful when types are otherwise ambiguous.
+  -- |
   -- | E.g.
-  -- | 
+  -- |
   -- |     main = print $ [] `asTypeOf` [0]
   -- |
   -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
@@ -205,13 +210,32 @@ module Prelude
   infixl 6 -
   infixl 6 +
 
-  class Num a where
-    (+) :: a -> a -> a
-    (-) :: a -> a -> a
-    (*) :: a -> a -> a
+  -- | Addition and multiplication
+  class Semiring a where
+    (+)  :: a -> a -> a
+    zero :: a
+    (*)  :: a -> a -> a
+    one  :: a
+
+  -- | Semiring with modulo operation and division where
+  -- | ```a / b * b + (a `mod` b) = a```
+  class (Semiring a) <= ModuloSemiring a where
     (/) :: a -> a -> a
-    (%) :: a -> a -> a
-    negate :: a -> a
+    mod :: a -> a -> a
+
+  -- | Addition, multiplication, and subtraction
+  class (Semiring a) <= Ring a where
+    (-) :: a -> a -> a
+
+  negate :: forall a. (Ring a) => a -> a
+  negate a = zero - a
+
+  -- | Ring where every nonzero element has a multiplicative inverse (possibly
+  -- | a non-commutative field) so that ```a `mod` b = zero```
+  class (Ring a, ModuloSemiring a) <= DivisionRing a
+
+  -- | A commutative field
+  class (DivisionRing a) <= Num a
 
   foreign import numAdd
     """
@@ -258,20 +282,24 @@ module Prelude
     }
     """ :: Number -> Number -> Number
 
-  foreign import numNegate
-    """
-    function numNegate(n) {
-      return -n;
-    }
-    """ :: Number -> Number
+  (%) = numMod
 
-  instance numNumber :: Num Number where
+  instance semiringNumber :: Semiring Number where
     (+) = numAdd
-    (-) = numSub
+    zero = 0
     (*) = numMul
+    one = 1
+
+  instance ringNumber :: Ring Number where
+    (-) = numSub
+
+  instance moduloSemiringNumber :: ModuloSemiring Number where
     (/) = numDiv
-    (%) = numMod
-    negate = numNegate
+    mod _ _ = 0
+
+  instance divisionRingNumber :: DivisionRing Number
+
+  instance numNumber :: Num Number
 
   newtype Unit = Unit {}
 
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
index 6ca4ec5..41113f2 100644
--- a/psc-docs/Main.hs
+++ b/psc-docs/Main.hs
@@ -18,7 +18,6 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Writer
 import Control.Arrow (first)
-import Data.Function (on)
 import Data.List
 import Data.Maybe (fromMaybe)
 import Data.Version (showVersion)
@@ -32,19 +31,18 @@ import System.Exit (exitSuccess, exitFailure)
 import System.IO (hPutStrLn, stderr)
 
 data PSCDocsOptions = PSCDocsOptions
-  { pscdIncludeHeir :: Bool
-  , pscdInputFiles  :: [FilePath]
+  { pscdInputFiles  :: [FilePath]
   }
 
 docgen :: PSCDocsOptions -> IO ()
-docgen (PSCDocsOptions showHierarchy input) = do
+docgen (PSCDocsOptions input) = do
   e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
   case e of
     Left err -> do
       hPutStrLn stderr $ show err
       exitFailure
     Right ms -> do
-      putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms)
+      putStrLn . runDocs $ renderModules (map snd ms)
       exitSuccess
 
 parseFile :: FilePath -> IO (FilePath, String)
@@ -69,55 +67,38 @@ atIndent indent text =
   let ls = lines text in
   withIndent indent (tell ls)
 
+fenced :: String -> Docs
+fenced text = fencedBlock (tell $ lines text)
+
+fencedBlock :: Docs -> Docs
+fencedBlock inner = do
+  tell ["``` purescript"]
+  inner
+  tell ["```"]
+
 ticks :: String -> String
 ticks = ("`" ++) . (++ "`")
 
-renderModules :: Bool -> [P.Module] -> Docs
-renderModules showHierarchy ms = do
+renderModules :: [P.Module] -> Docs
+renderModules ms = do
   headerLevel 1 "Module Documentation"
   spacer
-  mapM_ (renderModule showHierarchy) ms
-
-renderModule :: Bool -> P.Module -> Docs
-renderModule showHierarchy mdl@(P.Module moduleName _ exps) =
-  let ds = P.exportedDeclarations mdl
-      hasTypes = any isTypeDeclaration ds
-      hasTypeclasses = any isTypeClassDeclaration ds
-      hasTypeclassInstances = any isTypeInstanceDeclaration ds
-      hasValues = any isValueDeclaration ds
-  in do
+  mapM_ renderModule ms
+
+renderModule :: P.Module -> Docs
+renderModule mdl@(P.Module moduleName _ exps) = do
     headerLevel 2 $ "Module " ++ P.runModuleName moduleName
     spacer
-    when hasTypes $ do
-      headerLevel 3 "Types"
-      spacer
-      renderTopLevel exps (filter isTypeDeclaration ds)
-      spacer
-    when hasTypeclasses $ do
-      headerLevel 3 "Type Classes"
-      spacer
-      when showHierarchy $ do
-        renderTypeclassImage moduleName
-        spacer
-      renderTopLevel exps (filter isTypeClassDeclaration ds)
-      spacer
-    when hasTypeclassInstances $ do
-      headerLevel 3 "Type Class Instances"
-      spacer
-      renderTopLevel exps (filter isTypeInstanceDeclaration ds)
-      spacer
-    when hasValues $ do
-      headerLevel 3 "Values"
-      spacer
-      renderTopLevel exps (filter isValueDeclaration ds)
-      spacer
+    renderTopLevel exps (P.exportedDeclarations mdl)
+    spacer
 
 renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
-renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
-  traverse_ (headerLevel 4) (ticks `fmap` getDeclarationTitle decl)
-  spacer
-  renderDeclaration exps decl
-  spacer
+renderTopLevel exps decls = forM_ decls $ \decl ->
+  when (canRenderDecl decl) $ do
+    traverse_ (headerLevel 4) (ticks `fmap` getDeclarationTitle decl)
+    spacer
+    renderDeclaration exps decl
+    spacer
 
 renderTypeclassImage :: P.ModuleName -> Docs
 renderTypeclassImage name =
@@ -137,63 +118,62 @@ getDeclarationTitle _                                               = Nothing
 
 renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs
 renderDeclaration _ (P.TypeDeclaration ident ty) =
-  atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
+  fenced $ show ident ++ " :: " ++ prettyPrintType' ty
 renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =
-  atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
+  fenced $ show ident ++ " :: " ++ prettyPrintType' ty
 renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do
   let
     typeApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
     typeName = prettyPrintType' typeApp
     exported = filter (P.isDctorExported name exps . fst) ctors
-  atIndent 4 $ show dtype ++ " " ++ typeName
-  zipWithM_ (\isFirst (ctor, tys) ->
-              atIndent 6 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
-            (True : repeat False) exported
+  fencedBlock $ do
+    tell [show dtype ++ " " ++ typeName]
+    zipWithM_ (\isFirst (ctor, tys) ->
+                atIndent 2 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
+              (True : repeat False) exported
 renderDeclaration _ (P.ExternDataDeclaration name kind) =
-  atIndent 4 $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
+  fenced $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
 renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do
   let
     typeApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
     typeName = prettyPrintType' typeApp
-  atIndent 4 $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
+  fenced $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
 renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do
   let impliesText = case implies of
                       [] -> ""
                       is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
       classApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
       className = prettyPrintType' classApp
-  atIndent 4 $ "class " ++ impliesText ++ className ++ " where"
-  mapM_ renderClassMember ds
+  fencedBlock $ do
+    tell ["class " ++ impliesText ++ className ++ " where"]
+    mapM_ renderClassMember ds
   where
     renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d
-    renderClassMember (P.TypeDeclaration ident ty) = atIndent 6 $ show ident ++ " :: " ++ prettyPrintType' ty
+    renderClassMember (P.TypeDeclaration ident ty) = atIndent 2 $ show ident ++ " :: " ++ prettyPrintType' ty
     renderClassMember _ = error "Invalid argument to renderClassMember."
 renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do
   let constraintsText = case constraints of
                           [] -> ""
                           cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
-  atIndent 4 $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
+  fenced $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
 renderDeclaration exps (P.PositionedDeclaration _ com d) = do
-  renderComments com
   renderDeclaration exps d
+  renderComments com
 renderDeclaration _ _ = return ()
 
 renderComments :: [P.Comment] -> Docs
 renderComments cs = do
   let raw = concatMap toLines cs
-  
-  if all hasPipe raw
-    then atIndent 0 . unlines . map stripPipes $ raw
-    else atIndent 4 $ unlines raw
-  
-  unless (null raw) spacer
+  when (all hasPipe raw) $ do
+    spacer
+    atIndent 0 . unlines . map stripPipes $ raw
   where
 
   toLines (P.LineComment s) = [s]
   toLines (P.BlockComment s) = lines s
-  
+
   hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }
-  
+
   stripPipes = dropPipe . dropWhile (== ' ')
 
   dropPipe ('|':' ':s) = s
@@ -223,42 +203,24 @@ getName (P.TypeInstanceDeclaration name _ _ _ _) = show name
 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 _ = False
-
-isTypeDeclaration :: P.Declaration -> Bool
-isTypeDeclaration P.DataDeclaration{} = True
-isTypeDeclaration P.ExternDataDeclaration{} = True
-isTypeDeclaration P.TypeSynonymDeclaration{} = True
-isTypeDeclaration (P.PositionedDeclaration _ _ d) = isTypeDeclaration d
-isTypeDeclaration _ = False
-
-isTypeClassDeclaration :: P.Declaration -> Bool
-isTypeClassDeclaration P.TypeClassDeclaration{} = True
-isTypeClassDeclaration (P.PositionedDeclaration _ _ d) = isTypeClassDeclaration d
-isTypeClassDeclaration _ = False
-
-isTypeInstanceDeclaration :: P.Declaration -> Bool
-isTypeInstanceDeclaration P.TypeInstanceDeclaration{} = True
-isTypeInstanceDeclaration (P.PositionedDeclaration _ _ d) = isTypeInstanceDeclaration d
-isTypeInstanceDeclaration _ = False
+canRenderDecl :: P.Declaration -> Bool
+canRenderDecl P.TypeDeclaration{} = True
+canRenderDecl P.ExternDeclaration{} = True
+canRenderDecl P.DataDeclaration{} = True
+canRenderDecl P.ExternDataDeclaration{} = True
+canRenderDecl P.TypeSynonymDeclaration{} = True
+canRenderDecl P.TypeClassDeclaration{} = True
+canRenderDecl P.TypeInstanceDeclaration{} = True
+canRenderDecl (P.PositionedDeclaration _ _ d) = canRenderDecl d
+canRenderDecl _ = False
 
 inputFile :: Parser FilePath
 inputFile = strArgument $
      metavar "FILE"
   <> help "The input .purs file(s)"
 
-includeHeirarcy :: Parser Bool
-includeHeirarcy = switch $
-     long "hierarchy-images"
-  <> help "Include markdown for type class hierarchy images in the output."
-
 pscDocsOptions :: Parser PSCDocsOptions
-pscDocsOptions = PSCDocsOptions <$> includeHeirarcy
-                                <*> many inputFile
+pscDocsOptions = PSCDocsOptions <$> many inputFile
 
 main :: IO ()
 main = execParser opts >>= docgen
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
index fcad3fb..2bf5ced 100644
--- a/psc-make/Main.hs
+++ b/psc-make/Main.hs
@@ -17,9 +17,11 @@
 module Main where
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
+import Control.Monad.Reader
 
 import Data.Version (showVersion)
+import Data.Traversable (traverse)
 
 import Options.Applicative as Opts
 
@@ -50,20 +52,19 @@ readInput InputOptions{..} = do
   content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
   return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)
 
-newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)
+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }
+  deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader (P.Options P.Make))
 
-runMake :: Make a -> IO (Either String a)
-runMake = runErrorT . unMake
+runMake :: P.Options P.Make -> Make a -> IO (Either String a)
+runMake opts = runExceptT . flip runReaderT opts . unMake
 
 makeIO :: IO a -> Make a
-makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
+makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError
 
 instance P.MonadMake Make where
   getTimestamp path = makeIO $ do
     exists <- doesFileExist path
-    case exists of
-      True -> Just <$> getModificationTime path
-      False -> return Nothing
+    traverse (const $ getModificationTime path) $ guard exists
   readTextFile path = makeIO $ do
     putStrLn $ "Reading " ++ path
     readFile path
@@ -71,7 +72,6 @@ instance P.MonadMake Make where
     mkdirp path
     putStrLn $ "Writing " ++ path
     writeFile path text
-  liftError = either throwError return
   progress = makeIO . putStrLn
 
 compile :: PSCMakeOptions -> IO ()
@@ -82,7 +82,7 @@ compile (PSCMakeOptions input outputDir opts usePrefix) = do
       print err
       exitFailure
     Right ms -> do
-      e <- runMake $ P.make outputDir opts ms prefix
+      e <- runMake opts $ P.make outputDir ms prefix
       case e of
         Left err -> do
           putStrLn err
@@ -130,6 +130,12 @@ noOpts = switch $
      long "no-opts"
   <> help "Skip the optimization phase."
 
+comments :: Parser Bool
+comments = switch $
+     short 'c'
+  <> long "comments"
+  <> help "Include comments in the generated code."
+
 verboseErrors :: Parser Bool
 verboseErrors = switch $
      short 'v'
@@ -149,6 +155,7 @@ options = P.Options <$> noPrelude
                     <*> noMagicDo
                     <*> pure Nothing
                     <*> noOpts
+                    <*> comments
                     <*> verboseErrors
                     <*> pure P.MakeOptions
 
diff --git a/psc/Main.hs b/psc/Main.hs
index df1db1f..25709a1 100644
--- a/psc/Main.hs
+++ b/psc/Main.hs
@@ -17,7 +17,8 @@
 module Main where
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
+import Control.Monad.Reader
 
 import Data.Maybe (fromMaybe)
 import Data.Version (showVersion)
@@ -61,7 +62,7 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do
       hPutStrLn stderr $ show err
       exitFailure
     Right ms -> do
-      case P.compile opts (map snd ms) prefix of
+      case P.compile (map snd ms) prefix `runReaderT` opts of
         Left err -> do
           hPutStrLn stderr err
           exitFailure
@@ -137,6 +138,12 @@ noPrelude = switch $
      long "no-prelude"
   <> help "Omit the Prelude"
 
+comments :: Parser Bool
+comments = switch $
+     short 'c'
+  <> long "comments"
+  <> help "Include comments in the generated code."
+
 useStdIn :: Parser Bool
 useStdIn = switch $
      short 's'
@@ -173,6 +180,7 @@ options = P.Options <$> noPrelude
                     <*> runMain
                     <*> noOpts
                     <*> verboseErrors
+                    <*> comments
                     <*> additionalOptions
   where
   additionalOptions =
diff --git a/psci/Main.hs b/psci/Main.hs
index 73aa302..2b8bc82 100644
--- a/psci/Main.hs
+++ b/psci/Main.hs
@@ -13,7 +13,11 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DataKinds, DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Main where
 
@@ -27,8 +31,8 @@ import qualified Data.Map as M
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error (ErrorT(..), MonadError)
-import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Except (ExceptT(..), MonadError, runExceptT)
+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
 import Control.Monad.Trans.State.Strict
@@ -53,9 +57,8 @@ import qualified Paths_purescript as Paths
 import Commands as C
 import Parser
 
-
 data PSCiOptions = PSCiOptions
-  { psciSingleLineFlag :: Bool
+  { psciMultiLineMode :: Bool
   , psciInputFile      :: [FilePath]
   }
 
@@ -96,7 +99,7 @@ updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modu
 -- Updates the state to have more let bindings.
 --
 updateLets :: [P.Declaration] -> PSCiState -> PSCiState
-updateLets ds st = st { psciLetBindings = ds ++ psciLetBindings st }
+updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
 
 -- File helpers
 -- |
@@ -150,7 +153,7 @@ loadAllImportedModules = do
   modulesOrFirstError <- psciIO $ loadAllModules files
   case modulesOrFirstError of
     Left err -> psciIO $ print err
-    Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules } 
+    Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
 
 -- |
 -- Expands tilde in path.
@@ -182,8 +185,6 @@ prologueMessage = intercalate "\n"
   , "                                       |_|        "
   , ""
   , ":? shows help"
-  , ""
-  , "Expressions are terminated using Ctrl+D"
   ]
 
 -- |
@@ -314,7 +315,7 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
 -- | Compilation options.
 --
 options :: P.Options P.Make
-options = P.Options False False False Nothing False False P.MakeOptions
+options = P.Options False False False Nothing False False False P.MakeOptions
 
 -- |
 -- PSCI monad
@@ -322,27 +323,25 @@ options = P.Options False False False Nothing False False P.MakeOptions
 newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
 
 psciIO :: IO a -> PSCI a
-psciIO io = PSCI (lift (lift io))
+psciIO io = PSCI . lift $ lift io
 
-newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)
+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }
+  deriving (Functor, Applicative, Monad, MonadError String, MonadReader (P.Options P.Make))
 
 runMake :: Make a -> IO (Either String a)
-runMake = runErrorT . unMake
+runMake = runExceptT . flip runReaderT options . unMake
 
 makeIO :: IO a -> Make a
-makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
+makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError
 
 instance P.MonadMake Make where
   getTimestamp path = makeIO $ do
     exists <- doesFileExist path
-    if exists
-      then Just <$> getModificationTime path
-      else return Nothing
+    traverse (const $ getModificationTime path) $ guard exists
   readTextFile path = makeIO $ readFile path
   writeTextFile path text = makeIO $ do
     mkdirp path
     writeFile path text
-  liftError = either throwError return
   progress s = unless (s == "Compiling $PSCI") $ makeIO . putStrLn $ s
 
 mkdirp :: FilePath -> IO ()
@@ -402,7 +401,7 @@ handleDeclaration :: P.Expr -> PSCI ()
 handleDeclaration val = do
   st <- PSCI $ lift get
   let m = createTemporaryModule True st val
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right _ -> do
@@ -423,7 +422,7 @@ handleLet ds = do
   st <- PSCI $ lift get
   let st' = updateLets ds st
   let m = createTemporaryModule False st' (P.ObjectLiteral [])
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right _ -> PSCI $ lift (put st')
@@ -456,7 +455,7 @@ handleImport :: P.ModuleName -> PSCI ()
 handleImport moduleName = do
    st <- updateImports moduleName <$> PSCI (lift get)
    let m = createTemporaryModuleForImports st
-   e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
+   e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
    case e of
      Left err -> PSCI $ outputStrLn err
      Right _  -> do
@@ -470,7 +469,7 @@ handleTypeOf :: P.Expr -> PSCI ()
 handleTypeOf val = do
   st <- PSCI $ lift get
   let m = createTemporaryModule False st val
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right env' ->
@@ -504,7 +503,7 @@ handleBrowse :: P.ModuleName -> PSCI ()
 handleBrowse moduleName = do
   st <- PSCI $ lift get
   let loadedModules = psciLoadedModules st
-  env <- psciIO . runMake $ P.make modulesDir options loadedModules []
+  env <- psciIO . runMake $ P.make modulesDir loadedModules []
   case env of
     Left err -> PSCI $ outputStrLn err
     Right env' ->
@@ -520,7 +519,7 @@ handleKindOf typ = do
   st <- PSCI $ lift get
   let m = createTemporaryModuleForKind st typ
       mName = P.ModuleName [P.ProperName "$PSCI"]
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right env' ->
@@ -571,7 +570,7 @@ handleCommand (LoadFile filePath) = do
     PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
 handleCommand Reset = do
   files <- psciImportedFilenames <$> PSCI (lift get)
-  PSCI . lift . modify $ \st -> st 
+  PSCI . lift . modify $ \st -> st
     { psciImportedFilenames   = files
     , psciImportedModuleNames = defaultImports
     , psciLetBindings         = []
@@ -601,32 +600,33 @@ loadUserConfig = do
 -- The PSCI main loop.
 --
 loop :: PSCiOptions -> IO ()
-loop (PSCiOptions singleLineMode files) = do
+loop PSCiOptions{..} = do
   config <- loadUserConfig
-  modulesOrFirstError <- loadAllModules files
+  modulesOrFirstError <- loadAllModules psciInputFile
   case modulesOrFirstError of
     Left err -> print err >> exitFailure
     Right modules -> do
       historyFilename <- getHistoryFilename
       let settings = defaultSettings { historyFile = Just historyFilename }
-      flip evalStateT (PSCiState files defaultImports modules []) . runInputT (setComplete completion settings) $ do
+      flip evalStateT (PSCiState psciInputFile defaultImports modules []) . runInputT (setComplete completion settings) $ do
         outputStrLn prologueMessage
         traverse_ (mapM_ (runPSCI . handleCommand)) config
         go
       where
         go :: InputT (StateT PSCiState IO) ()
         go = do
-          c <- getCommand singleLineMode
+          c <- getCommand (not psciMultiLineMode)
           case c of
             Left err -> outputStrLn err >> go
             Right Nothing -> go
             Right (Just Quit) -> outputStrLn quitMessage
             Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
 
-singleLineFlag :: Parser Bool
-singleLineFlag = switch $
-     long "single-line-mode"
-  <> Opts.help "Run in single-line mode"
+multiLineMode :: Parser Bool
+multiLineMode = switch $
+     long "multi-line-mode"
+  <> short 'm'
+  <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
 
 inputFile :: Parser FilePath
 inputFile = strArgument $
@@ -634,7 +634,7 @@ inputFile = strArgument $
   <> Opts.help "Optional .purs files to load on start"
 
 psciOptions :: Parser PSCiOptions
-psciOptions = PSCiOptions <$> singleLineFlag
+psciOptions = PSCiOptions <$> multiLineMode
                           <*> many inputFile
 
 main :: IO ()
diff --git a/purescript.cabal b/purescript.cabal
index e23d58d..223e9b3 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.6.7.1
+version: 0.6.8
 cabal-version: >=1.8
 build-type: Simple
 license: MIT
@@ -31,10 +31,9 @@ library
                    filepath -any,
                    mtl >= 2.1.0 && < 2.3.0,
                    parsec -any,
-                   transformers >= 0.3 && < 0.5,
+                   transformers >= 0.4.0 && < 0.5,
                    utf8-string >= 1 && < 2,
                    pattern-arrows >= 0.0.2 && < 0.1,
-                   monad-unify >= 0.2.2 && < 0.3,
                    file-embed >= 0.0.7 && < 0.0.8,
                    time -any
     exposed-modules: Language.PureScript
@@ -111,11 +110,13 @@ library
                      Language.PureScript.TypeChecker.Unify
                      Language.PureScript.TypeClassDictionaries
                      Language.PureScript.Types
+
+                     Control.Monad.Unify
     exposed: True
     buildable: True
     hs-source-dirs: src
     other-modules: Paths_purescript
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
+    ghc-options: -Wall -O2
 
 executable psc
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -125,7 +126,7 @@ executable psc
     buildable: True
     hs-source-dirs: psc
     other-modules:
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
+    ghc-options: -Wall -O2 -fno-warn-unused-do-bind
 
 executable psc-make
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -135,7 +136,7 @@ executable psc-make
     buildable: True
     hs-source-dirs: psc-make
     other-modules:
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
+    ghc-options: -Wall -O2 -fno-warn-unused-do-bind
 
 executable psci
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -148,7 +149,7 @@ executable psci
     hs-source-dirs: psci
     other-modules: Commands
                    Parser
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
+    ghc-options: -Wall -O2
 
 executable psc-docs
     build-depends: base >=4 && <5, purescript -any,
@@ -157,7 +158,7 @@ executable psc-docs
     buildable: True
     hs-source-dirs: psc-docs
     other-modules:
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
+    ghc-options: -Wall -O2
 
 executable psc-hierarchy
     build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
@@ -166,7 +167,7 @@ executable psc-hierarchy
     buildable: True
     hs-source-dirs: hierarchy
     other-modules:
-    ghc-options: -Wall -fno-warn-warnings-deprecations -O2
+    ghc-options: -Wall -O2
 
 test-suite tests
     build-depends: base >=4 && <5, containers -any, directory -any,
diff --git a/src/Control/Monad/Unify.hs b/src/Control/Monad/Unify.hs
new file mode 100644
index 0000000..4fe55e9
--- /dev/null
+++ b/src/Control/Monad/Unify.hs
@@ -0,0 +1,155 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Control.Monad.Unify
+-- Copyright   :  (c) Phil Freeman 2013
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Control.Monad.Unify where
+
+import Data.String (IsString)
+import Data.Monoid
+
+import Control.Applicative
+import Control.Monad.State
+import Control.Monad.Error.Class
+
+import Data.HashMap.Strict as M
+
+-- |
+-- Untyped unification variables
+--
+type Unknown = Int
+
+-- |
+-- A type which can contain unification variables
+--
+class Partial t where
+  unknown :: Unknown -> t
+  isUnknown :: t -> Maybe Unknown
+  unknowns :: t -> [Unknown]
+  ($?) :: Substitution t -> t -> t
+
+-- |
+-- Identifies types which support unification
+--
+class (Partial t) => Unifiable m t | t -> m where
+  (=?=) :: t -> t -> UnifyT t m ()
+
+-- |
+-- A substitution maintains a mapping from unification variables to their values
+--
+data Substitution t = Substitution { runSubstitution :: M.HashMap Int t }
+
+instance (Partial t) => Monoid (Substitution t) where
+  mempty = Substitution M.empty
+  s1 `mappend` s2 = Substitution $
+                      M.map (s2 $?) (runSubstitution s1) `M.union`
+                      M.map (s1 $?) (runSubstitution s2)
+
+-- |
+-- State required for type checking
+--
+data UnifyState t = UnifyState {
+  -- |
+  -- The next fresh unification variable
+  --
+    unifyNextVar :: Int
+  -- |
+  -- The current substitution
+  --
+  , unifyCurrentSubstitution :: Substitution t
+  }
+
+-- |
+-- An empty @UnifyState@
+--
+defaultUnifyState :: (Partial t) => UnifyState t
+defaultUnifyState = UnifyState 0 mempty
+
+-- |
+-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
+--
+newtype UnifyT t m a = UnifyT { unUnify :: (StateT (UnifyState t) m) a }
+  deriving (Functor, Monad, Applicative, Alternative, MonadPlus)
+
+instance (MonadState s m) => MonadState s (UnifyT t m) where
+  get = UnifyT . lift $ get
+  put = UnifyT . lift . put
+
+instance (MonadError e m) => MonadError e (UnifyT t m) where
+  throwError = UnifyT . throwError
+  catchError e f = UnifyT $ catchError (unUnify e) (unUnify . f)
+
+-- |
+-- Run a computation in the Unify monad, failing with an error, or succeeding with a return value and the new next unification variable
+--
+runUnify :: UnifyState t -> UnifyT t m a -> m (a, UnifyState t)
+runUnify s = flip runStateT s . unUnify
+
+-- |
+-- Substitute a single unification variable
+--
+substituteOne :: (Partial t) => Unknown -> t -> Substitution t
+substituteOne u t = Substitution $ M.singleton u t
+
+-- |
+-- Replace a unification variable with the specified value in the current substitution
+--
+(=:=) :: (IsString e, Monad m, MonadError e m, Unifiable m t) => Unknown -> t -> UnifyT t m ()
+(=:=) u t' = do
+  st <- UnifyT get
+  let sub = unifyCurrentSubstitution st
+  let t = sub $? t'
+  occursCheck u t
+  let current = sub $? unknown u
+  case isUnknown current of
+    Just u1 | u1 == u -> return ()
+    _ -> current =?= t
+  UnifyT $ modify $ \s -> s { unifyCurrentSubstitution = substituteOne u t <> unifyCurrentSubstitution s }
+
+-- |
+-- Perform the occurs check, to make sure a unification variable does not occur inside a value
+--
+occursCheck :: (IsString e, Monad m, MonadError e m, Partial t) => Unknown -> t -> UnifyT t m ()
+occursCheck u t =
+  case isUnknown t of
+    Nothing -> when (u `elem` unknowns t) $ UnifyT . lift . throwError $ "Occurs check fails"
+    _ -> return ()
+
+-- |
+-- Generate a fresh untyped unification variable
+--
+fresh' :: (Monad m) => UnifyT t m Unknown
+fresh' = do
+  st <- UnifyT get
+  UnifyT $ modify $ \s -> s { unifyNextVar = succ (unifyNextVar s) }
+  return $ unifyNextVar st
+
+-- |
+-- Generate a fresh unification variable at a specific type
+--
+fresh :: (Monad m, Partial t) => UnifyT t m t
+fresh = do
+  u <- fresh'
+  return $ unknown u
+
+
+
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 16f2189..a1a5ef7 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DataKinds, QuasiQuotes, TemplateHaskell #-}
+{-# LANGUAGE DataKinds, QuasiQuotes, TemplateHaskell, FlexibleContexts #-}
 
 module Language.PureScript (module P, compile, compile', RebuildPolicy(..), MonadMake(..), make, prelude) where
 
@@ -22,13 +22,15 @@ import Data.Function (on)
 import Data.List (sortBy, groupBy, intercalate)
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock
+import qualified Data.Traversable as T (traverse)
 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 Control.Monad.Except
+import Control.Monad.Reader
 
 import System.FilePath ((</>))
 
@@ -71,42 +73,47 @@ import qualified Language.PureScript.Constants as C
 --
 --  * Pretty-print the generated Javascript
 --
-compile :: Options Compile -> [Module] -> [String] -> Either String (String, String, Environment)
+compile :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)
+        => [Module] -> [String] -> m (String, String, Environment)
 compile = compile' initEnvironment
 
-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
+compile' :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)
+         => Environment -> [Module] -> [String] -> m (String, String, Environment)
+compile' env ms prefix = do
+  noPrelude <- asks optionsNoPrelude
+  additional <- asks optionsAdditional
+  mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)
+  (sorted, _) <- sortModules $ map importPrim $ if noPrelude then ms else map importPrelude ms
   (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted
-  (elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent
+  (elaborated, env') <- runCheck' 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 entryPoints = moduleNameFromString `map` entryPointModules additional
   let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
   let renamed = renameInModules elim
-  let codeGenModuleNames = moduleNameFromString `map` codeGenModules (optionsAdditional opts)
+  let codeGenModuleNames = moduleNameFromString `map` codeGenModules additional
   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
+  js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)
   let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
-  js' <- generateMain env' opts js
+  js' <- generateMain env' js
   let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']
   return (pjs, exts, env')
-  where
-  mainModuleIdent = moduleNameFromString <$> optionsMain opts
 
-generateMain :: Environment -> Options Compile -> [JS] -> Either String [JS]
-generateMain env opts js =
-  case moduleNameFromString <$> optionsMain opts of
+generateMain :: (MonadError String m, MonadReader (Options Compile) m) => Environment -> [JS] -> m [JS]
+generateMain env js = do
+  main <- asks optionsMain
+  additional <- asks optionsAdditional
+  case moduleNameFromString <$> main of
     Just mmi -> do
       when ((mmi, Ident C.main) `M.notMember` names env) $
-        Left $ show mmi ++ "." ++ C.main ++ " is undefined"
-      return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace (optionsAdditional opts))))) []]
+        throwError $ show mmi ++ "." ++ C.main ++ " is undefined"
+      return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace additional)))) []]
     _ -> return js
 
 -- |
 -- A type class which collects the IO actions we need to be able to run in "make" mode
 --
-class MonadMake m where
+class (MonadReader (P.Options P.Make) m, MonadError String m) => MonadMake m where
   -- |
   -- Get a file timestamp
   --
@@ -123,11 +130,6 @@ class MonadMake m where
   writeTextFile :: FilePath -> String -> m ()
 
   -- |
-  -- Report an error
-  --
-  liftError :: Either String a -> m a
-
-  -- |
   -- Respond to a progress update
   --
   progress :: String -> m ()
@@ -152,11 +154,13 @@ traverseEither f (Right y) = Right <$> f y
 -- If timestamps have not changed, the externs file can be used to provide the module's types without
 -- having to typecheck the module again.
 --
-make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment
-make outputDir opts ms prefix = do
+make :: (Functor m, Applicative m, Monad m, MonadMake m)
+     => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment
+make outputDir ms prefix = do
+  noPrelude <- asks optionsNoPrelude
   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) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms
 
   toRebuild <- foldM (\s (Module moduleName' _ _) -> do
     let filePath = runModuleName moduleName'
@@ -176,15 +180,16 @@ make outputDir opts ms prefix = do
 
   marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
 
-  (desugared, nextVar) <- liftError $ stringifyErrorStack True $ runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
+  (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
 
-  evalSupplyT nextVar (go initEnvironment desugared)
+  evalSupplyT nextVar $ go initEnvironment desugared
 
   where
-  go :: (Functor m, Applicative m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> SupplyT m Environment
+  go :: (Functor m, Applicative m, Monad m, MonadMake m)
+     => Environment -> [(Bool, Module)] -> SupplyT m Environment
   go env [] = return env
   go env ((False, m) : ms') = do
-    (_, env') <- lift . liftError . runCheck' opts env $ typeCheckModule Nothing m
+    (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m
 
     go env' ms'
   go env ((True, m@(Module moduleName' _ exps)) : ms') = do
@@ -194,15 +199,15 @@ make outputDir opts ms prefix = do
 
     lift . progress $ "Compiling " ++ runModuleName moduleName'
 
-    (Module _ elaborated _, env') <- lift . liftError . runCheck' opts env $ typeCheckModule Nothing m
+    (Module _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m
 
-    regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
+    regrouped <- stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
 
     let mod' = Module moduleName' regrouped exps
     let corefn = CoreFn.moduleToCoreFn env' mod'
     let [renamed] = renameInModules [corefn]
 
-    pjs <- prettyPrintJS <$> moduleToJs opts renamed
+    pjs <- prettyPrintJS <$> moduleToJs renamed
     let js = unlines $ map ("// " ++) prefix ++ [pjs]
     let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
 
@@ -220,10 +225,10 @@ make outputDir opts ms prefix = do
   rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
     let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
     externs <- readTextFile externsFile
-    externsModules <- liftError . fmap (map snd) . either (Left . show) Right $ P.parseModulesFromFiles id [(externsFile, externs)]
+    externsModules <- fmap (map snd) . either (throwError . show) return $ 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"
+      _ -> throwError $ "Externs file " ++ externsFile ++ " was invalid"
 
 reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]
 reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index 9ed3f88..ef097e5 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -398,6 +398,10 @@ data Expr
   --
   | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
   -- |
+  -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
+  --
+  | TypeClassDictionaryAccessor (Qualified ProperName) Ident
+  -- |
   -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
   --
   | SuperClassDictionary (Qualified ProperName) [Type]
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index c5305e4..e677751 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -13,21 +13,22 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE GADTs, ViewPatterns #-}
+{-# LANGUAGE GADTs, ViewPatterns, FlexibleContexts #-}
 
 module Language.PureScript.CodeGen.JS (
     module AST,
     module Common,
-    bindToJs,
     moduleToJs
 ) where
 
 import Data.List ((\\), delete)
 import Data.Maybe (mapMaybe)
+import qualified Data.Traversable as T (traverse)
 
 import Control.Applicative
 import Control.Arrow ((&&&))
 import Control.Monad (foldM, replicateM, forM)
+import Control.Monad.Reader (MonadReader, asks, lift)
 
 import Language.PureScript.CodeGen.JS.AST as AST
 import Language.PureScript.CodeGen.JS.Common as Common
@@ -43,16 +44,18 @@ import qualified Language.PureScript.Constants as C
 -- Generate code in the simplified Javascript intermediate representation for all declarations in a
 -- module.
 --
-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
+moduleToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+           => Module Ann -> SupplyT m [JS]
+moduleToJs (Module name imps exps foreigns decls) = do
+  additional <- lift $ asks optionsAdditional
+  jsImports <- lift . T.traverse importToJs . 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
+  optimized <- lift $ T.traverse (T.traverse optimize) jsDecls
   let isModuleEmpty = null exps
-  let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ optimized
+  let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ concat optimized
   let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps
-  return $ case optionsAdditional opts of
+  return $ case additional of
     MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
     CompileOptions ns _ _ | not isModuleEmpty ->
       [ JSVariableIntroduction ns
@@ -65,18 +68,19 @@ moduleToJs opts (Module name imps exps foreigns decls) = do
 -- |
 -- Generates Javascript code for a module import.
 --
-importToJs :: Options mode -> ModuleName -> JS
-importToJs opts mn =
-  JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)
-  where
-  moduleBody = case optionsAdditional opts of
-    MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]
-    CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn) (JSVar ns)
+importToJs :: (Monad m, MonadReader (Options mode) m) => ModuleName -> m JS
+importToJs mn = do
+  additional <- asks optionsAdditional
+  let moduleBody = case additional of
+        MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]
+        CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn) (JSVar ns)
+  return $ JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a declaration
 --
-bindToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Bind Ann -> SupplyT m [JS]
+bindToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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))
 
@@ -86,9 +90,13 @@ bindToJs mp (Rec vals) = forM vals (uncurry (nonRecToJS mp))
 --
 -- 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 :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+           => ModuleName -> Ident -> Expr Ann -> SupplyT m JS
+nonRecToJS m i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
+  withoutComment <- lift $ asks optionsNoComments
+  if withoutComment
+     then nonRecToJS m i (modifyAnn removeComments e)
+     else JSComment com <$> nonRecToJS m i (modifyAnn removeComments e)
 nonRecToJS mp ident val = do
   js <- valueToJs mp val
   return $ JSVariableIntroduction (identToJs ident) (Just js)
@@ -117,10 +125,11 @@ accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a value or expression.
 --
-valueToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Expr Ann -> SupplyT m JS
+valueToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+          => ModuleName -> Expr Ann -> SupplyT m JS
 valueToJs m (Literal _ l) =
   literalToValueJS m l
-valueToJs m (Var (_, _, _, Just (IsConstructor _ 0)) name) =
+valueToJs m (Var (_, _, _, Just (IsConstructor _ [])) name) =
   return $ JSAccessor "value" $ qualifiedToJS m id name
 valueToJs m (Var (_, _, _, Just (IsConstructor _ _)) name) =
   return $ JSAccessor "create" $ qualifiedToJS m id name
@@ -128,7 +137,7 @@ 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
+  sts <- mapM (sndM $ valueToJs m) ps
   extendObj obj sts
 valueToJs _ e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
   let args = unAbs e
@@ -148,7 +157,7 @@ valueToJs m e@App{} = do
   args' <- mapM (valueToJs m) args
   case f of
     Var (_, _, _, Just IsNewtype) _ -> return (head args')
-    Var (_, _, _, Just (IsConstructor _ arity)) name | arity == length args ->
+    Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
       return $ JSUnary JSNew $ JSApp (qualifiedToJS m id name) args'
     Var (_, _, _, Just IsTypeClassConstructor) name ->
       return $ JSUnary JSNew $ JSApp (qualifiedToJS m id name) args'
@@ -171,30 +180,25 @@ valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
               JSObjectLiteral [("create",
                 JSFunction Nothing ["value"]
                   (JSBlock [JSReturn $ JSVar "value"]))])
-valueToJs _ (Constructor _ _ (ProperName ctor) 0) =
+valueToJs _ (Constructor _ _ (ProperName ctor) []) =
   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))])
-
+valueToJs _ (Constructor _ _ (ProperName ctor) fields) =
+  let constructor =
+        let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fields ]
+        in JSFunction (Just ctor) (identToJs `map` fields) (JSBlock body)
+      createFn =
+        let body = JSUnary JSNew $ JSApp (JSVar ctor) (var `map` fields)
+        in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
+  in return $ iife ctor [ constructor
+                        , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
+                        ]
 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 :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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
@@ -241,7 +245,8 @@ qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)
 -- Generate code in the simplified Javascript intermediate representation for pattern match binders
 -- and guards.
 --
-bindersToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> [CaseAlternative Ann] -> [JS] -> SupplyT m JS
+bindersToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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)
@@ -251,14 +256,16 @@ bindersToJs m binders vals = do
   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 Ann] -> SupplyT m [JS]
+    go :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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 v done'' b
     go _ _ _ = error "Invalid arguments to bindersToJs"
 
-    guardsToJs :: (Functor m, Applicative m, Monad m) => Either [(Guard Ann, Expr Ann)] (Expr Ann) -> SupplyT m [JS]
+    guardsToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+               => Either [(Guard Ann, Expr Ann)] (Expr Ann) -> SupplyT m [JS]
     guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
       cond' <- valueToJs m cond
       done  <- valueToJs m val
@@ -269,7 +276,8 @@ bindersToJs m binders vals = do
 -- Generate code in the simplified Javascript intermediate representation for a pattern match
 -- binder.
 --
-binderToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> String -> [JS] -> Binder Ann -> SupplyT m [JS]
+binderToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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
@@ -277,8 +285,8 @@ binderToJs _ varName done (VarBinder _ ident) =
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
 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
+binderToJs m varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
+  js <- go (zip fields bs) done
   return $ case ctorType of
     ProductType -> js
     SumType ->
@@ -286,13 +294,14 @@ binderToJs m varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorT
                 (JSBlock js)
                 Nothing]
   where
-  go :: (Functor m, Applicative m, Monad m) => Integer -> [JS] -> [Binder Ann] -> SupplyT m [JS]
-  go _ done' [] = return done'
-  go index done' (binder:bs') = do
+  go :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+     => [(Ident, Binder Ann)] -> [JS] -> SupplyT m [JS]
+  go [] done' = return done'
+  go ((field, binder) : remain) done' = do
     argVar <- freshName
-    done'' <- go (index + 1) done' bs'
+    done'' <- go remain done'
     js <- binderToJs m argVar done'' binder
-    return (JSVariableIntroduction argVar (Just (JSAccessor ("value" ++ show index) (JSVar varName))) : js)
+    return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
 binderToJs m varName done binder@(ConstructorBinder _ _ ctor _) | isCons ctor = do
   let (headBinders, tailBinder) = uncons [] binder
       numberOfHeadBinders = fromIntegral $ length headBinders
@@ -316,7 +325,8 @@ binderToJs m varName done (NamedBinder _ ident binder) = do
   js <- binderToJs m varName done binder
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
 
-literalToBinderJS :: (Functor m, Applicative m, Monad m) => ModuleName -> String -> [JS] -> Literal (Binder Ann) -> SupplyT m [JS]
+literalToBinderJS :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) 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) =
@@ -327,7 +337,8 @@ 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 :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+     => [JS] -> [(String, Binder Ann)] -> SupplyT m [JS]
   go done' [] = return done'
   go done' ((prop, binder):bs') = do
     propVar <- freshName
@@ -338,7 +349,8 @@ 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 :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m)
+     => [JS] -> Integer -> [Binder Ann] -> SupplyT m [JS]
   go done' _ [] = return done'
   go done' index (binder:bs') = do
     elVar <- freshName
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
index 551e179..3906cd5 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -31,10 +31,14 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE FlexibleContexts #-}
+
 module Language.PureScript.CodeGen.JS.Optimizer (
     optimize
 ) where
 
+import Control.Monad.Reader (MonadReader, ask, asks)
+
 import Language.PureScript.CodeGen.JS.AST
 import Language.PureScript.Options
 import qualified Language.PureScript.Constants as C
@@ -49,28 +53,34 @@ 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 ])
+optimize :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
+optimize js = do
+  noOpt <- asks optionsNoOptimizations
+  if noOpt then return js else optimize' js
+
+optimize' :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
+optimize' js = do
+  opts <- ask
+  return $ untilFixedPoint (applyAll
+    [ collapseNestedBlocks
+    , collapseNestedIfs
+    , tco opts
+    , magicDo opts
+    , removeCodeAfterReturnStatements
+    , removeUnusedArg
+    , removeUndefinedApp
+    , unThunk
+    , etaConvert
+    , evaluateIifes
+    , inlineVariables
+    , inlineValues
+    , 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 ]) js
 
 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/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
index a4dc800..caf7017 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
@@ -15,6 +15,7 @@
 
 module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
   inlineVariables,
+  inlineValues,
   inlineOperator,
   inlineCommonOperators,
   etaConvert,
@@ -79,6 +80,15 @@ inlineVariables = everywhereOnJS $ removeFromBlock go
       go (map (replaceIdent var js) sts)
   go (s:sts) = s : go sts
 
+inlineValues :: JS -> JS
+inlineValues = everywhereOnJS convert
+  where
+  convert :: JS -> JS
+  convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)
+  convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)
+  convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y
+  convert other = other
+
 inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
 inlineOperator (m, op) f = everywhereOnJS convert
   where
@@ -91,12 +101,11 @@ inlineOperator (m, op) f = everywhereOnJS convert
 
 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.semiringNumber (C.+) Add
+  , binary C.semiringNumber (C.*) Multiply
+  , binary C.ringNumber (C.-) Subtract
+  , unary  C.ringNumber C.negate Negate
+  , binary C.moduloSemiringNumber (C./) Divide
 
   , binary C.ordNumber (C.<) LessThan
   , binary C.ordNumber (C.>) GreaterThan
@@ -131,29 +140,20 @@ inlineCommonOperators = applyAll $
   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 (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeDict dictName dict && isPreludeFn opString fn = 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 (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeFn fnName fn && isPreludeDict 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 (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict 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
@@ -189,3 +189,13 @@ inlineCommonOperators = applyAll $
     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
+
+isPreludeDict :: String -> JS -> Bool
+isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
+isPreludeDict _ _ = False
+
+isPreludeFn :: String -> JS -> Bool
+isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
+isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
+isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)
+isPreludeFn _ _ = False
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
index fb4952b..51ba984 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants.hs
@@ -105,6 +105,12 @@ not = "not"
 
 -- Prelude Values
 
+zero :: String
+zero = "zero"
+
+one :: String
+one = "one"
+
 return :: String
 return = "return"
 
@@ -163,6 +169,15 @@ applicativeEffDictionary = "applicativeEff"
 bindEffDictionary :: String
 bindEffDictionary = "bindEff"
 
+semiringNumber :: String
+semiringNumber = "semiringNumber"
+
+ringNumber :: String
+ringNumber = "ringNumber"
+
+moduloSemiringNumber :: String
+moduloSemiringNumber = "moduloSemiringNumber"
+
 numNumber :: String
 numNumber = "numNumber"
 
diff --git a/src/Language/PureScript/CoreFn/Binders.hs b/src/Language/PureScript/CoreFn/Binders.hs
index c88dceb..595f2cc 100644
--- a/src/Language/PureScript/CoreFn/Binders.hs
+++ b/src/Language/PureScript/CoreFn/Binders.hs
@@ -13,6 +13,7 @@
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module Language.PureScript.CoreFn.Binders where
 
@@ -44,4 +45,4 @@ data Binder a
   -- |
   -- A binder which binds its input to an identifier
   --
-  | NamedBinder a Ident (Binder a) deriving (Show, D.Data, D.Typeable)
+  | NamedBinder a Ident (Binder a) deriving (Show, D.Data, D.Typeable, Functor)
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index 35e6eec..cc5e16c 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -40,14 +40,148 @@ import qualified Language.PureScript.AST as A
 -- Desugars a module from AST to CoreFn representation.
 --
 moduleToCoreFn :: Environment -> A.Module -> Module Ann
+moduleToCoreFn _ (A.Module _ _ Nothing) =
+  error "Module exports were not elaborated before moduleToCoreFn"
 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
+      decls' = concatMap (declToCoreFn Nothing []) decls
   in Module mn imports exps' externs decls'
-moduleToCoreFn _ (A.Module{}) =
-  error "Module exports were not elaborated before moduleToCoreFn"
+
+  where
+
+  -- |
+  -- Desugars member declarations from AST to CoreFn representation.
+  --
+  declToCoreFn :: 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, _) ->
+      let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)
+      in NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
+  declToCoreFn ss _   (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
+  declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
+    [NonRec name (exprToCoreFn ss com Nothing e)]
+  declToCoreFn ss _   (A.BindingGroupDeclaration ds) =
+    [Rec $ map (\(name, _, e) -> (name, exprToCoreFn ss [] Nothing e)) ds]
+  declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
+    [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
+  declToCoreFn _  com (A.PositionedDeclaration ss com1 d) =
+    declToCoreFn (Just ss) (com ++ com1) d
+  declToCoreFn _ _ _ = []
+
+  -- |
+  -- Desugars expressions from AST to CoreFn representation.
+  --
+  exprToCoreFn :: 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 ss com ty (A.ArrayLiteral vs) =
+    Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn ss [] Nothing) vs)
+  exprToCoreFn ss com ty (A.ObjectLiteral vs) =
+    Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn ss [] Nothing)) vs)
+  exprToCoreFn ss com ty (A.Accessor name v) =
+    Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
+  exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
+    ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs
+  exprToCoreFn ss com ty (A.Abs (Left name) v) =
+    Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
+  exprToCoreFn _ _ _ (A.Abs _ _) =
+    error "Abs with Binder argument was not desugared before exprToCoreFn mn"
+  exprToCoreFn ss com ty (A.App v1 v2) =
+    App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
+  exprToCoreFn ss com ty (A.Var ident) =
+    Var (ss, com, ty, Nothing) ident
+  exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
+    Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
+      [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
+                        (Right $ exprToCoreFn Nothing [] Nothing v2)
+      , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
+                        (Right $ exprToCoreFn Nothing [] Nothing v3) ]
+  exprToCoreFn ss com ty (A.Constructor name) =
+    Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
+  exprToCoreFn ss com ty (A.Case vs alts) =
+    Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)
+  exprToCoreFn ss com _ (A.TypedValue _ v ty) =
+    exprToCoreFn ss com (Just ty) v
+  exprToCoreFn ss com ty (A.Let ds v) =
+    Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)
+  exprToCoreFn ss com _  (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
+    let args = map (exprToCoreFn 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 ss com ty  (A.TypeClassDictionaryAccessor _ ident) =
+    Abs (ss, com, ty, Nothing) (Ident "dict")
+      (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))
+  exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =
+    exprToCoreFn (Just ss) (com ++ com1) ty v
+  exprToCoreFn _ _ _ e =
+    error $ "Unexpected value in exprToCoreFn mn: " ++ show e
+
+  -- |
+  -- Desugars case alternatives from AST to CoreFn representation.
+  --
+  altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
+  altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn 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 ss [] Nothing *** exprToCoreFn ss [] Nothing) ges
+    go (Right e) = Right (exprToCoreFn ss [] Nothing e)
+
+  -- |
+  -- Desugars case binders from AST to CoreFn representation.
+  --
+  binderToCoreFn :: 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 ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
+    let (_, tctor, _, _) = lookupConstructor env dctor
+    in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)
+  binderToCoreFn ss com (A.ObjectBinder bs) =
+    LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
+  binderToCoreFn ss com (A.ArrayBinder bs) =
+    LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
+  binderToCoreFn 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 ss []) [b1, b2]
+  binderToCoreFn ss com (A.NamedBinder name b) =
+    NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
+  binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
+    binderToCoreFn (Just ss) (com ++ com1) b
+
+  -- |
+  -- Gets metadata for data constructors.
+  --
+  getConstructorMeta :: Qualified ProperName -> Meta
+  getConstructorMeta ctor =
+    case lookupConstructor env ctor of
+      (Newtype, _, _, _) -> IsNewtype
+      dc@(Data, _, _, fields) ->
+        let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
+        in IsConstructor constructorType fields
+    where
+    numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> Int
+    numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
+    typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> (ModuleName, ProperName)
+    typeConstructor (Qualified (Just mn') _, (_, tyCtor, _, _)) = (mn', tyCtor)
+    typeConstructor _ = error "Invalid argument to typeConstructor"
 
 -- |
 -- Find module names from qualified references to values. This is used to
@@ -94,29 +228,6 @@ 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.
@@ -132,116 +243,7 @@ mkTypeClassConstructor ss com supers members =
          (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
index 02fa24d..67decc3 100644
--- a/src/Language/PureScript/CoreFn/Expr.hs
+++ b/src/Language/PureScript/CoreFn/Expr.hs
@@ -13,14 +13,16 @@
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module Language.PureScript.CoreFn.Expr where
 
+import Control.Arrow ((***))
+
 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
 
 -- |
@@ -32,9 +34,9 @@ data Expr a
   --
   = Literal a (Literal (Expr a))
   -- |
-  -- A data constructor (type name, constructor name, arity)
+  -- A data constructor (type name, constructor name, field names)
   --
-  | Constructor a ProperName ProperName Arity
+  | Constructor a ProperName ProperName [Ident]
   -- |
   -- A record property accessor
   --
@@ -62,7 +64,7 @@ data Expr a
   -- |
   -- A let binding
   --
-  | Let a [Bind a] (Expr a) deriving (Show, D.Data, D.Typeable)
+  | Let a [Bind a] (Expr a) deriving (Show, D.Data, D.Typeable, Functor)
 
 -- |
 -- A let or module binding.
@@ -75,7 +77,7 @@ data Bind a
   -- |
   -- Mutually recursive binding group for several values
   --
-  | Rec [(Ident, Expr a)] deriving (Show, D.Data, D.Typeable)
+  | Rec [(Ident, Expr a)] deriving (Show, D.Data, D.Typeable, Functor)
 
 -- |
 -- A guard is just a boolean-valued expression that appears alongside a set of binders
@@ -96,6 +98,12 @@ data CaseAlternative a = CaseAlternative
   , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
   } deriving (Show, D.Data, D.Typeable)
 
+instance Functor CaseAlternative where
+
+  fmap f (CaseAlternative cabs car) = CaseAlternative
+    (fmap (fmap f) $ cabs)
+    (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
+
 -- |
 -- Extract the annotation from a term
 --
@@ -110,6 +118,7 @@ extractAnn (Var a _) = a
 extractAnn (Case a _ _) = a
 extractAnn (Let a _ _) = a
 
+
 -- |
 -- Modify the annotation on a term
 --
diff --git a/src/Language/PureScript/CoreFn/Literals.hs b/src/Language/PureScript/CoreFn/Literals.hs
index 8e56d97..e610566 100644
--- a/src/Language/PureScript/CoreFn/Literals.hs
+++ b/src/Language/PureScript/CoreFn/Literals.hs
@@ -13,6 +13,7 @@
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module Language.PureScript.CoreFn.Literals where
 
@@ -42,4 +43,4 @@ data Literal a
   -- |
   -- An object literal
   --
-  | ObjectLiteral [(String, a)] deriving (Show, D.Data, D.Typeable)
+  | ObjectLiteral [(String, a)] deriving (Show, D.Data, D.Typeable, Functor)
diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs
index 7c2199c..84859bc 100644
--- a/src/Language/PureScript/CoreFn/Meta.hs
+++ b/src/Language/PureScript/CoreFn/Meta.hs
@@ -18,6 +18,8 @@ module Language.PureScript.CoreFn.Meta where
 
 import qualified Data.Data as D
 
+import Language.PureScript.Names
+
 -- |
 -- Metadata annotations
 --
@@ -25,7 +27,7 @@ data Meta
   -- |
   -- The contained value is a data constructor
   --
-  = IsConstructor ConstructorType Arity
+  = IsConstructor ConstructorType [Ident]
   -- |
   -- The contained value is a newtype
   --
@@ -36,11 +38,6 @@ data Meta
   | IsTypeClassConstructor deriving (Show, D.Data, D.Typeable)
 
 -- |
--- Type alias for constructor arity
---
-type Arity = Int
-
--- |
 -- Data constructor metadata
 --
 data ConstructorType
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
index 71472e3..29096d5 100644
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -41,7 +41,7 @@ data Environment = Environment {
   -- |
   -- Data constructors currently in scope, along with their associated data type constructors
   --
-  , dataConstructors :: M.Map (Qualified ProperName) (DataDeclType, ProperName, Type)
+  , dataConstructors :: M.Map (Qualified ProperName) (DataDeclType, ProperName, Type, [Ident])
   -- |
   -- Type synonyms currently in scope
   --
@@ -228,7 +228,7 @@ primTypes = M.fromList [ (primName "Function" , (FunKind Star (FunKind Star Star
 -- |
 -- Finds information about data constructors from the current environment.
 --
-lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
+lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type, [Ident])
 lookupConstructor env ctor =
   fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors env
 
@@ -237,5 +237,5 @@ lookupConstructor env ctor =
 --
 isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
 isNewtypeConstructor e ctor = case lookupConstructor e ctor of
-  (Newtype, _, _) -> True
-  (Data, _, _) -> False
+  (Newtype, _, _, _) -> True
+  (Data, _, _, _) -> False
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
index 4ced126..3ff82ff 100644
--- a/src/Language/PureScript/Errors.hs
+++ b/src/Language/PureScript/Errors.hs
@@ -17,10 +17,11 @@
 module Language.PureScript.Errors where
 
 import Data.Either (lefts, rights)
+import Data.String (IsString(..))
 import Data.List (intersperse, intercalate)
 import Data.Monoid
 
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Applicative ((<$>))
 
 import Language.PureScript.AST
@@ -67,15 +68,14 @@ data ErrorStack
   = ErrorStack { runErrorStack :: [CompileError] }
   | MultipleErrors [ErrorStack] deriving (Show)
 
-instance Monoid ErrorStack where
-  mempty = ErrorStack []
-  mappend (ErrorStack xs) (ErrorStack ys) = ErrorStack (xs ++ ys)
-  mappend (MultipleErrors es) x = MultipleErrors [ e <> x | e <- es ]
-  mappend x (MultipleErrors es) = MultipleErrors [ x <> e | e <- es ]
+-- TODO: Remove strMsg, the IsString instance, and unnecessary
+-- OverloadedStrings pragmas. See #745
+-- | Create an ErrorStack from a string
+strMsg :: String -> ErrorStack
+strMsg s = ErrorStack [CompileError s Nothing Nothing]
 
-instance Error ErrorStack where
-  strMsg s = ErrorStack [CompileError s Nothing Nothing]
-  noMsg = ErrorStack []
+instance IsString ErrorStack where
+  fromString = strMsg
 
 prettyPrintErrorStack :: Bool -> ErrorStack -> String
 prettyPrintErrorStack printFullStack (ErrorStack es) =
@@ -95,8 +95,8 @@ prettyPrintErrorStack printFullStack (ErrorStack es) =
 prettyPrintErrorStack printFullStack (MultipleErrors es) =
   unlines $ intersperse "" $ "Multiple errors:" : map (prettyPrintErrorStack printFullStack) es
 
-stringifyErrorStack :: Bool -> Either ErrorStack a -> Either String a
-stringifyErrorStack printFullStack = either (Left . prettyPrintErrorStack printFullStack) Right
+stringifyErrorStack :: (MonadError String m) => Bool -> Either ErrorStack a -> m a
+stringifyErrorStack printFullStack = either (throwError . prettyPrintErrorStack printFullStack) return
 
 isErrorNonEmpty :: CompileError -> Bool
 isErrorNonEmpty = not . null . compileErrorMessage
@@ -107,10 +107,13 @@ showError (CompileError msg (Just (ExprError val)) _) = "Error in expression " +
 showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ ":\n" ++ msg
 
 mkErrorStack :: String -> Maybe ErrorSource -> ErrorStack
-mkErrorStack msg t = ErrorStack [CompileError msg t Nothing]
+mkErrorStack msg t = ErrorStack [mkCompileError msg t]
 
-positionError :: SourceSpan -> ErrorStack
-positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]
+mkCompileError :: String -> Maybe ErrorSource -> CompileError
+mkCompileError msg t = CompileError msg t Nothing
+
+positionError :: SourceSpan -> CompileError
+positionError pos = CompileError "" Nothing (Just pos)
 
 -- |
 -- Rethrow an error with a more detailed error message in the case of failure
@@ -122,7 +125,7 @@ rethrow f = flip catchError $ \e -> throwError (f e)
 -- Rethrow an error with source position information
 --
 rethrowWithPosition :: (MonadError ErrorStack m) => SourceSpan -> m a -> m a
-rethrowWithPosition pos = rethrow (positionError pos <>)
+rethrowWithPosition pos = rethrow (positionError pos `combineErrors`)
 
 -- |
 -- Collect errors in in parallel
@@ -138,3 +141,13 @@ parU xs f = forM xs (withError . f) >>= collectErrors
     [err] -> throwError err
     [] -> return $ rights es
     errs -> throwError $ MultipleErrors errs
+ 
+-- |
+-- Add an extra error string onto the top of each error stack in a list of possibly many errors
+--
+combineErrors :: CompileError -> ErrorStack -> ErrorStack
+combineErrors ce err = go (ErrorStack [ce]) err
+  where 
+  go (ErrorStack xs) (ErrorStack ys) = ErrorStack (xs ++ ys)
+  go (MultipleErrors es) x = MultipleErrors [ go e x | e <- es ]
+  go x (MultipleErrors es) = MultipleErrors [ go x e | e <- es ]
diff --git a/src/Language/PureScript/ModuleDependencies.hs b/src/Language/PureScript/ModuleDependencies.hs
index 4a9cb20..71e516f 100644
--- a/src/Language/PureScript/ModuleDependencies.hs
+++ b/src/Language/PureScript/ModuleDependencies.hs
@@ -12,11 +12,15 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE FlexibleContexts #-}
+
 module Language.PureScript.ModuleDependencies (
   sortModules,
   ModuleGraph
 ) where
 
+import Control.Monad.Except
+
 import Data.Graph
 import Data.List (nub)
 import Data.Maybe (mapMaybe)
@@ -35,7 +39,7 @@ type ModuleGraph = [(ModuleName, [ModuleName])]
 --
 -- Reports an error if the module graph contains a cycle.
 --
-sortModules :: [Module] -> Either String ([Module], ModuleGraph)
+sortModules :: (MonadError String m) => [Module] -> m ([Module], ModuleGraph)
 sortModules ms = do
   let verts = map (\m@(Module _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms
   ms' <- mapM toModule $ stronglyConnComp verts
@@ -66,7 +70,7 @@ usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (
 -- |
 -- Convert a strongly connected component of the module graph to a module
 --
-toModule :: SCC Module -> Either String Module
+toModule :: (MonadError String m) => SCC Module -> m Module
 toModule (AcyclicSCC m) = return m
 toModule (CyclicSCC [m]) = return m
-toModule (CyclicSCC ms) = Left $ "Cycle in module dependencies: " ++ show (map getModuleName ms)
+toModule (CyclicSCC ms) = throwError $ "Cycle in module dependencies: " ++ show (map getModuleName ms)
diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs
index 421ab1f..a7265f4 100644
--- a/src/Language/PureScript/Options.hs
+++ b/src/Language/PureScript/Options.hs
@@ -70,6 +70,9 @@ data Options mode = Options {
     --
   , optionsVerboseErrors :: Bool
     -- |
+    -- Remove the comments from the generated js
+  , optionsNoComments :: Bool
+    -- |
     -- Specify the namespace that PureScript modules will be exported to when running in the
     -- browser.
     --
@@ -80,10 +83,10 @@ data Options mode = Options {
 -- Default compiler options
 --
 defaultCompileOptions :: Options Compile
-defaultCompileOptions = Options False False False Nothing False False (CompileOptions "PS" [] [])
+defaultCompileOptions = Options False False False Nothing False False False (CompileOptions "PS" [] [])
 
 -- |
 -- Default make options
 --
 defaultMakeOptions :: Options Make
-defaultMakeOptions = Options False False False Nothing False False MakeOptions
+defaultMakeOptions = Options False False False Nothing False False False MakeOptions
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
index 38841aa..c477180 100644
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -24,7 +24,6 @@ module Language.PureScript.Sugar.BindingGroups (
 import Data.Graph
 import Data.List (nub, intersect)
 import Data.Maybe (isJust, mapMaybe)
-import Data.Monoid ((<>))
 import Control.Applicative ((<$>), (<*>), pure)
 import Control.Monad ((<=<))
 
@@ -181,7 +180,7 @@ toBindingGroup moduleName (CyclicSCC 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 []
+  cycleError d ds@(_:_) = rethrow (mkCompileError ("The following are not yet defined here: " ++ unwords (map (show . getIdent) ds)) Nothing `combineErrors`) $ cycleError d []
   cycleError _ _ = error "Expected ValueDeclaration"
 
 toDataBindingGroup :: SCC Declaration -> Either ErrorStack Declaration
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
index 842c0fb..dde2428 100644
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -19,12 +19,11 @@ module Language.PureScript.Sugar.CaseDeclarations (
     desugarCasesModule
 ) where
 
-import Data.Monoid ((<>))
 import Data.List (nub, groupBy)
 
 import Control.Applicative
 import Control.Monad ((<=<), forM, join, unless, replicateM)
-import Control.Monad.Error.Class
+import Control.Monad.Except (throwError)
 
 import Language.PureScript.Names
 import Language.PureScript.AST
@@ -44,7 +43,7 @@ isLeft (Right _) = False
 --
 desugarCasesModule :: [Module] -> SupplyT (Either ErrorStack) [Module]
 desugarCasesModule ms = forM ms $ \(Module name ds exps) ->
-  rethrow (strMsg ("Error in module " ++ show name) <>) $
+  rethrow (mkCompileError ("Error in module " ++ show name) Nothing `combineErrors`) $
     Module name <$> (desugarCases <=< desugarAbs $ ds) <*> pure exps
 
 desugarAbs :: [Declaration] -> SupplyT (Either ErrorStack) [Declaration]
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
index 31eb7d7..fc22e34 100644
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -18,10 +18,9 @@ module Language.PureScript.Sugar.Names (
 
 import Data.List (nub)
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
-import Data.Monoid ((<>))
 
 import Control.Applicative (Applicative(..), (<$>), (<*>))
-import Control.Monad.Error
+import Control.Monad.Except
 
 import qualified Data.Map as M
 
@@ -166,7 +165,7 @@ desugarImports modules = do
   -- the module has access to an unfiltered list of its own members.
   renameInModule' :: ExportEnvironment -> ExportEnvironment -> Module -> Either ErrorStack Module
   renameInModule' unfilteredExports exports m@(Module mn _ _) =
-    rethrow (strMsg ("Error in module " ++ show mn) <>) $ do
+    rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $ do
       let env = M.update (\_ -> M.lookup mn unfilteredExports) mn exports
       let exps = fromMaybe (error "Module is missing in renameInModule'") $ M.lookup mn exports
       imports <- resolveImports env m
@@ -233,7 +232,8 @@ renameInModule imports exports (Module mn decls exps) =
   updateValue (pos, bound) (Let ds val') = do
       let args = mapMaybe letBoundVariable ds
       unless (length (nub args) == length args) $
-        throwError $ maybe id (\p e -> positionError p <> e) pos $ mkErrorStack ("Overlapping names in let binding.") Nothing
+        maybe id rethrowWithPosition pos $ 
+          throwError $ mkErrorStack ("Overlapping names in let binding.") Nothing
       return ((pos, args ++ bound), Let ds val')
       where
   updateValue (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =
@@ -318,7 +318,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) pri
   addModule :: ExportEnvironment -> Module -> Either ErrorStack ExportEnvironment
   addModule env (Module mn ds _) = do
     env' <- addEmptyModule env mn
-    rethrow (strMsg ("Error in module " ++ show mn) <>) $ foldM (addDecl mn) env' ds
+    rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $ foldM (addDecl mn) env' ds
 
   -- Add a declaration from a module to the global export environment
   addDecl :: ModuleName -> ExportEnvironment -> Declaration -> Either ErrorStack ExportEnvironment
@@ -344,7 +344,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) pri
 filterExports :: ModuleName -> [DeclarationRef] -> ExportEnvironment -> Either ErrorStack ExportEnvironment
 filterExports mn exps env = do
   let moduleExports = fromMaybe (error "Module is missing") (mn `M.lookup` env)
-  moduleExports' <- rethrow (strMsg ("Error in module " ++ show mn) <>) $ filterModule moduleExports
+  moduleExports' <- rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $ filterModule moduleExports
   return $ M.insert mn moduleExports' env
   where
 
diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
index 2120d8b..9038e63 100644
--- a/src/Language/PureScript/Sugar/Operators.hs
+++ b/src/Language/PureScript/Sugar/Operators.hs
@@ -32,9 +32,8 @@ import Language.PureScript.Supply
 
 import Control.Applicative
 import Control.Monad.State
-import Control.Monad.Error.Class
+import Control.Monad.Except
 
-import Data.Monoid ((<>))
 import Data.Function (on)
 import Data.Functor.Identity
 import Data.List (groupBy, sortBy)
@@ -90,7 +89,7 @@ ensureNoDuplicates m = go $ sortBy (compare `on` fst) m
   go [] = return ()
   go [_] = return ()
   go ((x@(Qualified (Just mn) name), _) : (y, pos) : _) | x == y =
-    rethrow (strMsg ("Error in module " ++ show mn) <>) $
+    rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $
       rethrowWithPosition pos $
         throwError $ mkErrorStack ("Redefined fixity for " ++ show name) Nothing
   go (_ : rest) = go rest
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 49a8dc9..ed08fc2 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -21,23 +21,22 @@ module Language.PureScript.Sugar.TypeClasses
   ) where
 
 import Language.PureScript.AST hiding (isExported)
-import Language.PureScript.Names
-import Language.PureScript.Types
-import Language.PureScript.Kinds
-import Language.PureScript.Sugar.CaseDeclarations
 import Language.PureScript.Environment
 import Language.PureScript.Errors
-import Language.PureScript.Supply
+import Language.PureScript.Kinds
+import Language.PureScript.Names
 import Language.PureScript.Pretty.Types (prettyPrintTypeAtom)
+import Language.PureScript.Sugar.CaseDeclarations
+import Language.PureScript.Supply
+import Language.PureScript.Types
 
 import qualified Language.PureScript.Constants as C
 
 import Control.Applicative
-import Control.Monad.Error
-import Control.Monad.State
 import Control.Arrow (first, second)
+import Control.Monad.Except
+import Control.Monad.State
 import Data.List ((\\), find)
-import Data.Monoid ((<>))
 import Data.Maybe (catMaybes, mapMaybe, isJust)
 
 import qualified Data.Map as M
@@ -158,12 +157,12 @@ desugarDecl mn exps = go
   where
   go d@(TypeClassDeclaration name args implies members) = do
     modify (M.insert (mn, name) d)
-    return $ (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)
+    return (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)
   go d@(ExternInstanceDeclaration name _ className tys) = return (expRef name className tys, [d])
   go d@(TypeInstanceDeclaration name deps className tys members) = do
     desugared <- lift $ desugarCases members
     dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared
-    return $ (expRef name className tys, [d, dictDecl])
+    return (expRef name className tys, [d, dictDecl])
   go (PositionedDeclaration pos com d) = do
     (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d
     return (dr, map (PositionedDeclaration pos com) ds)
@@ -212,9 +211,10 @@ typeClassDictionaryDeclaration name args implies members =
 
 typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Declaration -> Declaration
 typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =
-  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))
+  let className = Qualified (Just mn) name
+  in ValueDeclaration ident TypeClassAccessorImport [] $ Right $
+      TypedValue False (TypeClassDictionaryAccessor className ident) $
+      moveQuantifiersToFront (quantify (ConstrainedType [(className, map (TypeVar . fst) args)] ty))
 typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =
   PositionedDeclaration pos com $ typeClassMemberToDictionaryAccessor mn name args d
 typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"
@@ -224,7 +224,7 @@ unit = TypeApp tyObject REmpty
 
 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
+  rethrow (mkCompileError ("Error in type class instance " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys) ++ ":") Nothing `combineErrors`) $ do
   m <- get
 
   -- Lookup the type arguments and member types for the type class
diff --git a/src/Language/PureScript/Sugar/TypeDeclarations.hs b/src/Language/PureScript/Sugar/TypeDeclarations.hs
index aa4427e..7779fd1 100644
--- a/src/Language/PureScript/Sugar/TypeDeclarations.hs
+++ b/src/Language/PureScript/Sugar/TypeDeclarations.hs
@@ -19,11 +19,9 @@ module Language.PureScript.Sugar.TypeDeclarations (
     desugarTypeDeclarationsModule
 ) where
 
-import Data.Monoid ((<>))
-
 import Control.Applicative
-import Control.Monad.Error.Class
 import Control.Monad (forM)
+import Control.Monad.Except (throwError)
 
 import Language.PureScript.AST
 import Language.PureScript.Names
@@ -36,7 +34,7 @@ import Language.PureScript.Traversals
 --
 desugarTypeDeclarationsModule :: [Module] -> Either ErrorStack [Module]
 desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds exps) ->
-  rethrow (strMsg ("Error in module " ++ show name) <>) $
+  rethrow (mkCompileError ("Error in module " ++ show name) Nothing `combineErrors`) $
     Module name <$> desugarTypeDeclarations ds <*> pure exps
 
 -- |
diff --git a/src/Language/PureScript/Supply.hs b/src/Language/PureScript/Supply.hs
index c11725b..8ff03c8 100644
--- a/src/Language/PureScript/Supply.hs
+++ b/src/Language/PureScript/Supply.hs
@@ -24,7 +24,7 @@ import Data.Functor.Identity
 
 import Control.Applicative
 import Control.Monad.State
-import Control.Monad.Error.Class
+import Control.Monad.Except
 
 newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a } deriving (Functor, Applicative, Monad, MonadTrans)
 
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index 150df69..bc5c64d 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -27,12 +27,11 @@ import Language.PureScript.TypeChecker.Synonyms as T
 
 import Data.Maybe
 import Data.List (nub, (\\), find, intercalate)
-import Data.Monoid ((<>))
 import Data.Foldable (for_)
 import qualified Data.Map as M
 
 import Control.Monad.State
-import Control.Monad.Error
+import Control.Monad.Except
 
 import Language.PureScript.Types
 import Language.PureScript.Names
@@ -47,7 +46,7 @@ addDataType moduleName dtype name args dctors ctorKind = do
   env <- getEnv
   putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (ctorKind, DataType args dctors) (types env) }
   forM_ dctors $ \(dctor, tys) ->
-    rethrow (strMsg ("Error in data constructor " ++ show dctor) <>) $
+    rethrow (mkCompileError ("Error in data constructor " ++ show dctor) Nothing `combineErrors`) $
       addDataConstructor moduleName dtype name (map fst args) dctor tys
 
 addDataConstructor :: ModuleName -> DataDeclType -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
@@ -57,7 +56,8 @@ addDataConstructor moduleName dtype name args dctor tys = do
   let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)
   let dctorTy = foldr function retTy tys
   let polyType = mkForAll args dctorTy
-  putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType) (dataConstructors env) }
+  let fields = [Ident ("value" ++ show n) | n <- [0..(length tys - 1)]]
+  putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType, fields) (dataConstructors env) }
 
 addTypeSynonym :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Type -> Kind -> Check ()
 addTypeSynonym moduleName name args ty kind = do
@@ -133,7 +133,7 @@ typeCheckAll mainModuleName moduleName exps = go
   go :: [Declaration] -> Check [Declaration]
   go [] = return []
   go (DataDeclaration dtype name args dctors : rest) = do
-    rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
+    rethrow (mkCompileError ("Error in type constructor " ++ show name) Nothing `combineErrors`) $ do
       when (dtype == Newtype) $ checkNewtype dctors
       checkDuplicateTypeArguments $ map fst args
       ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
@@ -147,7 +147,7 @@ typeCheckAll mainModuleName moduleName exps = go
     checkNewtype [(_, _)] = throwError . strMsg $ "newtypes constructors must have a single argument"
     checkNewtype _ = throwError . strMsg $ "newtypes must have a single constructor"
   go (d@(DataBindingGroupDeclaration tys) : rest) = do
-    rethrow (strMsg "Error in data binding group" <>) $ do
+    rethrow (mkCompileError "Error in data binding group" Nothing `combineErrors`) $ do
       let syns = mapMaybe toTypeSynonym tys
       let dataDecls = mapMaybe toDataDecl tys
       (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)
@@ -169,7 +169,7 @@ typeCheckAll mainModuleName moduleName exps = go
     toDataDecl (PositionedDeclaration _ _ d') = toDataDecl d'
     toDataDecl _ = Nothing
   go (TypeSynonymDeclaration name args ty : rest) = do
-    rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do
+    rethrow (mkCompileError ("Error in type synonym " ++ show name) Nothing `combineErrors`) $ do
       checkDuplicateTypeArguments $ map fst args
       kind <- kindsOf False moduleName name args [ty]
       let args' = args `withKinds` kind
@@ -178,7 +178,7 @@ typeCheckAll mainModuleName moduleName exps = go
     return $ TypeSynonymDeclaration name args ty : ds
   go (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
   go (ValueDeclaration name nameKind [] (Right val) : rest) = do
-    d <- rethrow (strMsg ("Error in declaration " ++ show name) <>) $ do
+    d <- rethrow (mkCompileError ("Error in declaration " ++ show name) Nothing `combineErrors`) $ do
       valueIsNotDefined moduleName name
       [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]
       addValue moduleName name ty nameKind
@@ -187,7 +187,7 @@ typeCheckAll mainModuleName moduleName exps = go
     return $ d : ds
   go (ValueDeclaration{} : _) = error "Binders were not desugared"
   go (BindingGroupDeclaration vals : rest) = do
-    d <- rethrow (strMsg ("Error in binding group " ++ show (map (\(ident, _, _) -> ident) vals)) <>) $ do
+    d <- rethrow (mkCompileError ("Error in binding group " ++ show (map (\(ident, _, _) -> ident) vals)) Nothing `combineErrors`) $ do
       forM_ (map (\(ident, _, _) -> ident) vals) $ \name ->
         valueIsNotDefined moduleName name
       tys <- typesOf mainModuleName moduleName $ map (\(ident, _, ty) -> (ident, ty)) vals
@@ -207,7 +207,7 @@ typeCheckAll mainModuleName moduleName exps = go
     ds <- go rest
     return $ d : ds
   go (d@(ExternDeclaration importTy name _ ty) : rest) = do
-    rethrow (strMsg ("Error in foreign import declaration " ++ show name) <>) $ do
+    rethrow (mkCompileError ("Error in foreign import declaration " ++ show name) Nothing `combineErrors`) $ do
       env <- getEnv
       kind <- kindOf moduleName ty
       guardWith (strMsg "Expected kind *") $ kind == Star
diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
index 6486860..c86f979 100644
--- a/src/Language/PureScript/TypeChecker/Entailment.hs
+++ b/src/Language/PureScript/TypeChecker/Entailment.hs
@@ -25,9 +25,10 @@ import qualified Data.Map as M
 
 import Control.Applicative
 import Control.Arrow (Arrow(..))
-import Control.Monad.Error
+import Control.Monad.Except
 
 import Language.PureScript.AST
+import Language.PureScript.Errors
 import Language.PureScript.Environment
 import Language.PureScript.Names
 import Language.PureScript.Pretty
diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs
index 60083cc..fa3d630 100644
--- a/src/Language/PureScript/TypeChecker/Kinds.hs
+++ b/src/Language/PureScript/TypeChecker/Kinds.hs
@@ -24,14 +24,13 @@ module Language.PureScript.TypeChecker.Kinds (
 ) where
 
 import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
 
 import qualified Data.HashMap.Strict as H
 import qualified Data.Map as M
 
 import Control.Arrow (second)
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.State
 import Control.Monad.Unify
 
@@ -79,7 +78,7 @@ kindOf _ ty = fst <$> kindOfWithScopedVars ty
 --
 kindOfWithScopedVars :: Type -> Check (Kind, [(String, Kind)])   
 kindOfWithScopedVars ty = 
-  rethrow (mkErrorStack "Error checking kind" (Just (TypeError ty)) <>) $
+  rethrow (mkCompileError "Error checking kind" (Just (TypeError ty)) `combineErrors`) $
     fmap tidyUp . liftUnify $ infer ty
   where
   tidyUp ((k, args), sub) = ( starIfUnknown (sub $? k)
@@ -157,7 +156,7 @@ starIfUnknown k = k
 -- Infer a kind for a type
 --
 infer :: Type -> UnifyT Kind Check (Kind, [(String, Kind)])
-infer ty = rethrow (mkErrorStack "Error inferring type of value" (Just (TypeError ty)) <>) $ infer' ty
+infer ty = rethrow (mkCompileError "Error inferring type of value" (Just (TypeError ty)) `combineErrors`) $ infer' ty
 
 infer' :: Type -> UnifyT Kind Check (Kind, [(String, Kind)])
 infer' (ForAll ident ty _) = do
diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs
index b59c08a..7abb0ac 100644
--- a/src/Language/PureScript/TypeChecker/Monad.hs
+++ b/src/Language/PureScript/TypeChecker/Monad.hs
@@ -14,7 +14,7 @@
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, RankNTypes,
-    MultiParamTypeClasses, FlexibleContexts #-}
+    MultiParamTypeClasses, FlexibleContexts, GADTs #-}
 
 module Language.PureScript.TypeChecker.Monad where
 
@@ -22,7 +22,8 @@ import Data.Maybe
 import qualified Data.Map as M
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
+import Control.Monad.Reader.Class
 import Control.Monad.State
 import Control.Monad.Unify
 
@@ -108,7 +109,7 @@ makeBindingGroupVisible action = do
 -- |
 -- Lookup the type of a value by name in the @Environment@
 --
-lookupVariable :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m Type
+lookupVariable :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m Type
 lookupVariable currentModule (Qualified moduleName var) = do
   env <- getEnv
   case M.lookup (fromMaybe currentModule moduleName, var) (names env) of
@@ -118,7 +119,7 @@ lookupVariable currentModule (Qualified moduleName var) = do
 -- |
 -- Lookup the visibility of a value by name in the @Environment@
 --
-getVisibility :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m NameVisibility
+getVisibility :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m NameVisibility
 getVisibility currentModule (Qualified moduleName var) = do
   env <- getEnv
   case M.lookup (fromMaybe currentModule moduleName, var) (names env) of
@@ -128,7 +129,7 @@ getVisibility currentModule (Qualified moduleName var) = do
 -- |
 -- Assert that a name is visible
 --
-checkVisibility :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m ()
+checkVisibility :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m ()
 checkVisibility currentModule name@(Qualified _ var) = do
   vis <- getVisibility currentModule name
   case vis of
@@ -138,7 +139,7 @@ checkVisibility currentModule name@(Qualified _ var) = do
 -- |
 -- Lookup the kind of a type by name in the @Environment@
 --
-lookupTypeVariable :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified ProperName -> m Kind
+lookupTypeVariable :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified ProperName -> m Kind
 lookupTypeVariable currentModule (Qualified moduleName name) = do
   env <- getEnv
   case M.lookup (Qualified (Just $ fromMaybe currentModule moduleName) name) (types env) of
@@ -171,7 +172,7 @@ data CheckState = CheckState {
 -- The type checking monad, which provides the state of the type checker, and error reporting capabilities
 --
 newtype Check a = Check { unCheck :: StateT CheckState (Either ErrorStack) a }
-  deriving (Functor, Monad, Applicative, Alternative, MonadPlus, MonadState CheckState, MonadError ErrorStack)
+  deriving (Functor, Monad, Applicative, MonadState CheckState, MonadError ErrorStack)
 
 -- |
 -- Get the current @Environment@
@@ -194,14 +195,16 @@ modifyEnv f = modify (\s -> s { checkEnv = f (checkEnv s) })
 -- |
 -- Run a computation in the Check monad, starting with an empty @Environment@
 --
-runCheck :: Options mode -> Check a -> Either String (a, Environment)
-runCheck opts = runCheck' opts initEnvironment
+runCheck :: (MonadReader (Options mode) m, MonadError String m) => Check a -> m (a, Environment)
+runCheck = runCheck' initEnvironment
 
 -- |
 -- Run a computation in the Check monad, failing with an error, or succeeding with a return value and the final @Environment@.
 --
-runCheck' :: Options mode -> Environment -> Check a -> Either String (a, Environment)
-runCheck' opts env c = stringifyErrorStack (optionsVerboseErrors opts) $ do
+runCheck' :: (MonadReader (Options mode) m, MonadError String m) => Environment -> Check a -> m (a, Environment)
+runCheck' env c = do
+  verbose <- asks optionsVerboseErrors
+  stringifyErrorStack verbose $ do
   (a, s) <- flip runStateT (CheckState env 0 0 Nothing) $ unCheck c
   return (a, checkEnv s)
 
diff --git a/src/Language/PureScript/TypeChecker/Rows.hs b/src/Language/PureScript/TypeChecker/Rows.hs
index 1c3115a..f1fec1b 100644
--- a/src/Language/PureScript/TypeChecker/Rows.hs
+++ b/src/Language/PureScript/TypeChecker/Rows.hs
@@ -19,7 +19,7 @@ module Language.PureScript.TypeChecker.Rows (
 
 import Data.List
 
-import Control.Monad.Error
+import Control.Monad.Except
 
 import Language.PureScript.AST
 import Language.PureScript.Errors
diff --git a/src/Language/PureScript/TypeChecker/Skolems.hs b/src/Language/PureScript/TypeChecker/Skolems.hs
index 62ee80a..221cb1a 100644
--- a/src/Language/PureScript/TypeChecker/Skolems.hs
+++ b/src/Language/PureScript/TypeChecker/Skolems.hs
@@ -26,7 +26,7 @@ import Data.List (nub, (\\))
 import Data.Monoid
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.Unify
 
 import Language.PureScript.AST
diff --git a/src/Language/PureScript/TypeChecker/Subsumption.hs b/src/Language/PureScript/TypeChecker/Subsumption.hs
index 5d8ab24..e9a7ac2 100644
--- a/src/Language/PureScript/TypeChecker/Subsumption.hs
+++ b/src/Language/PureScript/TypeChecker/Subsumption.hs
@@ -18,11 +18,10 @@ module Language.PureScript.TypeChecker.Subsumption (
 ) where
 
 import Data.List (sortBy)
-import Data.Monoid
 import Data.Ord (comparing)
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.Unify
 
 import Language.PureScript.AST
@@ -39,7 +38,7 @@ import Language.PureScript.Types
 -- Check whether one type subsumes another, rethrowing errors to provide a better error message
 --
 subsumes :: Maybe Expr -> Type -> Type -> UnifyT Type Check (Maybe Expr)
-subsumes val ty1 ty2 = rethrow (mkErrorStack errorMessage (ExprError <$> val) <>) $ subsumes' val ty1 ty2
+subsumes val ty1 ty2 = rethrow (mkCompileError errorMessage (ExprError <$> val) `combineErrors`) $ subsumes' val ty1 ty2
   where
   errorMessage = "Error checking that type "
     ++ prettyPrintType ty1
diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs
index 7ad00e2..1457a8c 100644
--- a/src/Language/PureScript/TypeChecker/Synonyms.hs
+++ b/src/Language/PureScript/TypeChecker/Synonyms.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, GADTs #-}
 
 module Language.PureScript.TypeChecker.Synonyms (
     saturateAllTypeSynonyms,
@@ -28,10 +28,11 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.State
 
 import Language.PureScript.Environment
+import Language.PureScript.Errors
 import Language.PureScript.Names
 import Language.PureScript.TypeChecker.Monad
 import Language.PureScript.Types
@@ -82,7 +83,7 @@ replaceAllTypeSynonyms' env d =
   in
     saturateAllTypeSynonyms syns d
 
-replaceAllTypeSynonyms :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
+replaceAllTypeSynonyms :: (e ~ ErrorStack, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
 replaceAllTypeSynonyms d = do
   env <- getEnv
   either (throwError . strMsg) return $ replaceAllTypeSynonyms' env d
@@ -98,12 +99,12 @@ expandTypeSynonym' env name args =
       replaceAllTypeSynonyms' env repl
     Nothing -> error "Type synonym was not defined"
 
-expandTypeSynonym :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type
+expandTypeSynonym :: (e ~ ErrorStack, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type
 expandTypeSynonym name args = do
   env <- getEnv
   either (throwError . strMsg) return $ expandTypeSynonym' env name args
 
-expandAllTypeSynonyms :: (Error e, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
+expandAllTypeSynonyms :: (e ~ ErrorStack, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
 expandAllTypeSynonyms = everywhereOnTypesTopDownM go
   where
   go (SaturatedTypeSynonym name args) = expandTypeSynonym name args
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 49f7d0d..7ad5a97 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings #-}
 
 module Language.PureScript.TypeChecker.Types (
     typesOf
@@ -38,11 +38,11 @@ module Language.PureScript.TypeChecker.Types (
 import Data.Either (lefts, rights)
 import Data.List
 import Data.Maybe (fromMaybe)
-import Data.Monoid
 import qualified Data.Map as M
+import Data.String (IsString)
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.State
 import Control.Monad.Unify
 
@@ -207,7 +207,7 @@ instantiatePolyTypeWithUnknowns val ty = return (val, ty)
 -- Infer a type for a value, rethrowing any error to provide a more useful error message
 --
 infer :: Expr -> UnifyT Type Check Expr
-infer val = rethrow (mkErrorStack "Error inferring type of value" (Just (ExprError val)) <>) $ infer' val
+infer val = rethrow (mkCompileError "Error inferring type of value" (Just (ExprError val)) `combineErrors`) $ infer' val
 
 -- |
 -- Infer a type for a value
@@ -270,8 +270,8 @@ infer' v@(Constructor c) = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
     Nothing -> throwError . strMsg $ "Constructor " ++ show c ++ " is undefined"
-    Just (_, _, ty) -> do (v', ty') <- sndM (introduceSkolemScope <=< replaceAllTypeSynonyms) <=< instantiatePolyTypeWithUnknowns v $ ty
-                          return $ TypedValue True v' ty'
+    Just (_, _, ty, _) -> do (v', ty') <- sndM (introduceSkolemScope <=< replaceAllTypeSynonyms) <=< instantiatePolyTypeWithUnknowns v $ ty
+                             return $ TypedValue True v' ty'
 infer' (Case vals binders) = do
   ts <- mapM infer vals
   ret <- fresh
@@ -355,7 +355,7 @@ inferBinder val (VarBinder name) = return $ M.singleton name val
 inferBinder val (ConstructorBinder ctor binders) = do
   env <- getEnv
   case M.lookup ctor (dataConstructors env) of
-    Just (_, _, ty) -> do
+    Just (_, _, ty, _) -> do
       (_, fn) <- instantiatePolyTypeWithUnknowns (error "Data constructor types cannot contain constraints") ty
       fn' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ fn
       go binders fn'
@@ -427,7 +427,7 @@ checkBinders nvals ret (CaseAlternative binders result : bs) = do
 -- Check the type of a value, rethrowing errors to provide a better error message
 --
 check :: Expr -> Type -> UnifyT Type Check Expr
-check val ty = rethrow (mkErrorStack errorMessage (Just (ExprError val)) <>) $ check' val ty
+check val ty = rethrow (mkCompileError errorMessage (Just (ExprError val)) `combineErrors`) $ check' val ty
   where
   errorMessage =
     "Error checking type of term " ++
@@ -552,7 +552,7 @@ check' (Constructor c) ty = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
     Nothing -> throwError . strMsg $ "Constructor " ++ show c ++ " is undefined"
-    Just (_, _, ty1) -> do
+    Just (_, _, ty1, _) -> do
       repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
       _ <- subsumes Nothing repl ty
       return $ TypedValue True (Constructor c) ty
@@ -583,7 +583,7 @@ containsTypeSynonyms = everythingOnTypes (||) go where
 checkProperties :: [(String, Expr)] -> Type -> Bool -> UnifyT Type Check [(String, Expr)]
 checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where
   go [] [] REmpty = return []
-  go [] [] u@(TUnknown _) 
+  go [] [] u@(TUnknown _)
     | lax = return []
     | otherwise = do u =?= REmpty
                      return []
@@ -609,7 +609,7 @@ checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where
 -- Check the type of a function application, rethrowing errors to provide a better error message
 --
 checkFunctionApplication :: Expr -> Type -> Expr -> Maybe Type -> UnifyT Type Check (Type, Expr)
-checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (Just (ExprError fn)) <>) $ do
+checkFunctionApplication fn fnTy arg ret = rethrow (mkCompileError errorMessage (Just (ExprError fn)) `combineErrors`) $ do
   subst <- unifyCurrentSubstitution <$> UnifyT get
   checkFunctionApplication' fn (subst $? fnTy) arg (($?) subst <$> ret)
   where
@@ -673,5 +673,5 @@ meet e1 e2 t1 t2 = do
 -- |
 -- Ensure a set of property names and value does not contain duplicate labels
 --
-ensureNoDuplicateProperties :: (Error e, MonadError e m) => [(String, Expr)] -> m ()
-ensureNoDuplicateProperties ps = guardWith (strMsg "Duplicate property names") $ length (nub . map fst $ ps) == length ps
+ensureNoDuplicateProperties :: (IsString e, MonadError e m) => [(String, Expr)] -> m ()
+ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (nub . map fst $ ps) == length ps
diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs
index 197ca9a..48381a2 100644
--- a/src/Language/PureScript/TypeChecker/Unify.hs
+++ b/src/Language/PureScript/TypeChecker/Unify.hs
@@ -27,10 +27,9 @@ module Language.PureScript.TypeChecker.Unify (
 
 import Data.List (nub, sort)
 import Data.Maybe (fromMaybe)
-import Data.Monoid
 import qualified Data.HashMap.Strict as H
 
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.Unify
 
 import Language.PureScript.Environment
@@ -61,7 +60,7 @@ instance Unifiable Check Type where
 -- Unify two types, updating the current substitution
 --
 unifyTypes :: Type -> Type -> UnifyT Type Check ()
-unifyTypes t1 t2 = rethrow (mkErrorStack ("Error unifying type " ++ prettyPrintType t1 ++ " with type " ++ prettyPrintType t2) Nothing <>) $
+unifyTypes t1 t2 = rethrow (mkCompileError ("Error unifying type " ++ prettyPrintType t1 ++ " with type " ++ prettyPrintType t2) Nothing `combineErrors`) $
   unifyTypes' t1 t2
   where
   unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()
diff --git a/tests/Main.hs b/tests/Main.hs
index bfc9930..47922b0 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -22,6 +22,7 @@ import Data.List (isSuffixOf)
 import Data.Traversable (traverse)
 import Control.Monad
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
+import Control.Monad.Reader (runReaderT)
 import Control.Applicative
 import System.Exit
 import System.Process
@@ -38,7 +39,7 @@ loadPrelude :: Either String (String, String, P.Environment)
 loadPrelude =
   case P.parseModulesFromFiles id [("", P.prelude)] of
     Left parseError -> Left (show parseError)
-    Right ms -> P.compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) (map snd ms) []
+    Right ms -> runReaderT (P.compile (map snd ms) []) $ P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }
 
 compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))
 compile opts inputFiles = do
@@ -46,7 +47,7 @@ compile opts inputFiles = do
   case modules of
     Left parseError ->
       return (Left $ show parseError)
-    Right ms -> return $ P.compile opts (map snd ms) []
+    Right ms -> return $ runReaderT (P.compile (map snd ms) []) opts
 
 assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
 assert preludeExterns opts inputFile f = do
-- 
cgit v0.10.2