version 0.5.40.5.4

32 files changed, 1021 insertions, 260 deletions

diff --git a/docgen/Main.hs b/docgen/Main.hs
index a2708be..793a13d 100644
--- a/docgen/Main.hs
+++ b/docgen/Main.hs
@@ -25,6 +25,7 @@ import qualified Paths_purescript as Paths
 import qualified System.IO.UTF8 as U
 import System.Console.CmdTheLine
 import System.Exit (exitSuccess, exitFailure)
+import System.IO (stderr)
 
 docgen :: Bool -> [FilePath] -> IO ()
 docgen showHierarchy input = do
@@ -37,7 +38,7 @@ parseFile input = do
   text <- U.readFile input
   case P.runIndentParser input P.parseModules text of
     Left err -> do
-      U.print err
+      U.hPutStr stderr $ show err
       exitFailure
     Right ms -> do
       return ms
@@ -106,7 +107,7 @@ isExported (Just exps) decl = any (matches decl) exps
   where
   matches (P.TypeDeclaration ident _) (P.ValueRef ident') = ident == ident'
   matches (P.ExternDeclaration _ ident _ _) (P.ValueRef ident') = ident == ident'
-  matches (P.DataDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
+  matches (P.DataDeclaration _ ident _ _) (P.TypeRef ident' _) = ident == ident'
   matches (P.ExternDataDeclaration ident _) (P.TypeRef ident' _) = ident == ident'
   matches (P.TypeSynonymDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
   matches (P.TypeClassDeclaration ident _ _ _) (P.TypeClassRef ident') = ident == ident'
@@ -138,10 +139,10 @@ renderDeclaration n _ (P.TypeDeclaration ident ty) =
   atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
 renderDeclaration n _ (P.ExternDeclaration _ ident _ ty) =
   atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
-renderDeclaration n exps (P.DataDeclaration name args ctors) = do
+renderDeclaration n exps (P.DataDeclaration dtype name args ctors) = do
   let typeName = P.runProperName name ++ (if null args then "" else " " ++ unwords args)
   let exported = filter (isDctorExported name exps . fst) ctors
-  atIndent n $ "data " ++ typeName ++ (if null exported then "" else " where")
+  atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
   forM_ exported $ \(ctor, tys) ->
     atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concatMap (\ty -> prettyPrintType' ty ++ " -> ") tys ++ typeName
 renderDeclaration n _ (P.ExternDataDeclaration name kind) =
@@ -168,14 +169,14 @@ prettyPrintType' :: P.Type -> String
 prettyPrintType' = P.prettyPrintType . P.everywhereOnTypes dePrim
   where
   dePrim ty@(P.TypeConstructor (P.Qualified _ name))
-    | ty == P.tyBoolean || ty == P.tyNumber || ty == P.tyString = 
+    | ty == P.tyBoolean || ty == P.tyNumber || ty == P.tyString =
       P.TypeConstructor $ P.Qualified Nothing name
   dePrim other = other
 
 getName :: P.Declaration -> String
 getName (P.TypeDeclaration ident _) = show ident
 getName (P.ExternDeclaration _ ident _ _) = show ident
-getName (P.DataDeclaration name _ _) = P.runProperName name
+getName (P.DataDeclaration _ name _ _) = P.runProperName name
 getName (P.ExternDataDeclaration name _) = P.runProperName name
 getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name
 getName (P.TypeClassDeclaration name _ _ _) = P.runProperName name
diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs
index 977f3f6..e015607 100644
--- a/hierarchy/Main.hs
+++ b/hierarchy/Main.hs
@@ -26,6 +26,7 @@ import System.Console.CmdTheLine
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>))
 import System.Exit (exitFailure, exitSuccess)
+import System.IO (stderr)
 
 import Text.Parsec (ParseError)
 
@@ -57,7 +58,7 @@ compile :: FilePath -> Maybe FilePath -> IO ()
 compile input mOutput = do
   modules <- readInput input
   case modules of
-    Left err -> U.print err >> exitFailure
+    Left err -> U.hPutStr stderr (show err) >> exitFailure
     Right ms -> do
       for_ ms $ \(P.Module moduleName decls _) ->
         let name = runModuleName moduleName
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index 2284412..23c1576 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -228,7 +228,7 @@ module Prelude
     (%) = numMod
     negate = numNegate
 
-  data Unit = Unit {}
+  newtype Unit = Unit {}
 
   unit :: Unit
   unit = Unit {}
@@ -332,12 +332,21 @@ module Prelude
     LT -> false
     _ -> true
 
-  foreign import unsafeCompare
-    "function unsafeCompare(n1) {\
-    \  return function(n2) {\
-    \    return n1 < n2 ? LT : n1 > n2 ? GT : EQ;\
+  foreign import unsafeCompareImpl
+    "function unsafeCompareImpl(lt) {\
+    \  return function (eq) {\
+    \    return function (gt) {\
+    \      return function (x) {\
+    \        return function (y) {\
+    \          return x < y ? lt : x > y ? gt : eq;\
+    \        };\
+    \      };\
+    \    };\
     \  };\
-    \}" :: forall a. a -> a -> Ordering
+    \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering
+    
+  unsafeCompare :: forall a. a -> a -> Ordering
+  unsafeCompare = unsafeCompareImpl LT EQ GT
 
   instance ordUnit :: Ord Unit where
     compare (Unit {}) (Unit {}) = EQ
@@ -490,88 +499,128 @@ module Data.Function where
   foreign import data Fn3 :: * -> * -> * -> * -> *
   foreign import data Fn4 :: * -> * -> * -> * -> * -> *
   foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
+  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
+  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
+  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
+  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
+  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
 
   foreign import mkFn0
-    "function mkFn0(f) {\
+    "function mkFn0(fn) {\
     \  return function() {\
-    \    return f({});\
+    \    return fn({});\
     \  };\
     \}" :: forall a. (Unit -> a) -> Fn0 a
 
   foreign import mkFn1
-    "function mkFn1(f) {\
+    "function mkFn1(fn) {\
     \  return function(a) {\
-    \    return f(a);\
+    \    return fn(a);\
     \  };\
     \}" :: forall a b. (a -> b) -> Fn1 a b
 
   foreign import mkFn2
-    "function mkFn2(f) {\
+    "function mkFn2(fn) {\
     \  return function(a, b) {\
-    \    return f(a)(b);\
+    \    return fn(a)(b);\
     \  };\
     \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c
 
   foreign import mkFn3
-    "function mkFn3(f) {\
+    "function mkFn3(fn) {\
     \  return function(a, b, c) {\
-    \    return f(a)(b)(c);\
+    \    return fn(a)(b)(c);\
     \  };\
     \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
 
   foreign import mkFn4
-    "function mkFn4(f) {\
+    "function mkFn4(fn) {\
     \  return function(a, b, c, d) {\
-    \    return f(a)(b)(c)(d);\
+    \    return fn(a)(b)(c)(d);\
     \  };\
     \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
 
   foreign import mkFn5
-    "function mkFn5(f) {\
+    "function mkFn5(fn) {\
     \  return function(a, b, c, d, e) {\
-    \    return f(a)(b)(c)(d)(e);\
+    \    return fn(a)(b)(c)(d)(e);\
     \  };\
     \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
 
+  foreign import mkFn6
+    "function mkFn6(fn) {\
+    \  return function(a, b, c, d, e, f) {\
+    \    return fn(a)(b)(c)(d)(e)(f);\
+    \  };\
+    \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
+
+  foreign import mkFn7
+    "function mkFn7(fn) {\
+    \  return function(a, b, c, d, e, f, g) {\
+    \    return fn(a)(b)(c)(d)(e)(f)(g);\
+    \  };\
+    \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
+
+  foreign import mkFn8
+    "function mkFn8(fn) {\
+    \  return function(a, b, c, d, e, f, g, h) {\
+    \    return fn(a)(b)(c)(d)(e)(f)(g)(h);\
+    \  };\
+    \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
+
+  foreign import mkFn9
+    "function mkFn9(fn) {\
+    \  return function(a, b, c, d, e, f, g, h, i) {\
+    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
+    \  };\
+    \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
+
+  foreign import mkFn10
+    "function mkFn10(fn) {\
+    \  return function(a, b, c, d, e, f, g, h, i, j) {\
+    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
+    \  };\
+    \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
+
   foreign import runFn0
-    "function runFn0(f) {\
-    \  return f();\
+    "function runFn0(fn) {\
+    \  return fn();\
     \}" :: forall a. Fn0 a -> a
 
   foreign import runFn1
-    "function runFn1(f) {\
+    "function runFn1(fn) {\
     \  return function(a) {\
-    \    return f(a);\
+    \    return fn(a);\
     \  };\
     \}" :: forall a b. Fn1 a b -> a -> b
 
   foreign import runFn2
-    "function runFn2(f) {\
+    "function runFn2(fn) {\
     \  return function(a) {\
     \    return function(b) {\
-    \      return f(a, b);\
+    \      return fn(a, b);\
     \    };\
     \  };\
     \}" :: forall a b c. Fn2 a b c -> a -> b -> c
 
   foreign import runFn3
-    "function runFn3(f) {\
+    "function runFn3(fn) {\
     \  return function(a) {\
     \    return function(b) {\
     \      return function(c) {\
-    \        return f(a, b, c);\
+    \        return fn(a, b, c);\
     \      };\
     \    };\
     \  };\
     \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
 
   foreign import runFn4
-    "function runFn4(f) {\
+    "function runFn4(fn) {\
     \  return function(a) {\
     \    return function(b) {\
     \      return function(c) {\
     \        return function(d) {\
-    \          return f(a, b, c, d);\
+    \          return fn(a, b, c, d);\
     \        };\
     \      };\
     \    };\
@@ -579,13 +628,13 @@ module Data.Function where
     \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
 
   foreign import runFn5
-    "function runFn5(f) {\
+    "function runFn5(fn) {\
     \  return function(a) {\
     \    return function(b) {\
     \      return function(c) {\
     \        return function(d) {\
     \          return function(e) {\
-    \            return f(a, b, c, d, e);\
+    \            return fn(a, b, c, d, e);\
     \          };\
     \        };\
     \      };\
@@ -593,9 +642,114 @@ module Data.Function where
     \  };\
     \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
 
+  foreign import runFn6
+    "function runFn6(fn) {\
+    \  return function(a) {\
+    \    return function(b) {\
+    \      return function(c) {\
+    \        return function(d) {\
+    \          return function(e) {\
+    \            return function(f) {\
+    \              return fn(a, b, c, d, e, f);\
+    \            };\
+    \          };\
+    \        };\
+    \      };\
+    \    };\
+    \  };\
+    \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
+
+  foreign import runFn7
+    "function runFn7(fn) {\
+    \  return function(a) {\
+    \    return function(b) {\
+    \      return function(c) {\
+    \        return function(d) {\
+    \          return function(e) {\
+    \            return function(f) {\
+    \              return function(g) {\
+    \                return fn(a, b, c, d, e, f, g);\
+    \              };\
+    \            };\
+    \          };\
+    \        };\
+    \      };\
+    \    };\
+    \  };\
+    \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
+
+  foreign import runFn8
+    "function runFn8(fn) {\
+    \  return function(a) {\
+    \    return function(b) {\
+    \      return function(c) {\
+    \        return function(d) {\
+    \          return function(e) {\
+    \            return function(f) {\
+    \              return function(g) {\
+    \                return function(h) {\
+    \                  return fn(a, b, c, d, e, f, g, h);\
+    \                };\
+    \              };\
+    \            };\
+    \          };\
+    \        };\
+    \      };\
+    \    };\
+    \  };\
+    \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
+
+  foreign import runFn9
+    "function runFn9(fn) {\
+    \  return function(a) {\
+    \    return function(b) {\
+    \      return function(c) {\
+    \        return function(d) {\
+    \          return function(e) {\
+    \            return function(f) {\
+    \              return function(g) {\
+    \                return function(h) {\
+    \                  return function(i) {\
+    \                    return fn(a, b, c, d, e, f, g, h, i);\
+    \                  };\
+    \                };\
+    \              };\
+    \            };\
+    \          };\
+    \        };\
+    \      };\
+    \    };\
+    \  };\
+    \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
+
+  foreign import runFn10
+    "function runFn10(fn) {\
+    \  return function(a) {\
+    \    return function(b) {\
+    \      return function(c) {\
+    \        return function(d) {\
+    \          return function(e) {\
+    \            return function(f) {\
+    \              return function(g) {\
+    \                return function(h) {\
+    \                  return function(i) {\
+    \                    return function(j) {\
+    \                      return fn(a, b, c, d, e, f, g, h, i, j);\
+    \                    };\
+    \                  };\
+    \                };\
+    \              };\
+    \            };\
+    \          };\
+    \        };\
+    \      };\
+    \    };\
+    \  };\
+    \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
+
 module Data.Eq where
 
-  data Ref a = Ref a
+  newtype Ref a = Ref a
 
   liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
   liftRef f (Ref x) (Ref y) = f x y
diff --git a/psci/Commands.hs b/psci/Commands.hs
index 28fc2b8..001f3f5 100644
--- a/psci/Commands.hs
+++ b/psci/Commands.hs
@@ -53,6 +53,10 @@ data Command
   -- Find the type of an expression
   --
   | TypeOf Value
+  -- |
+  -- Find the kind of an expression
+  -- 
+  | KindOf Type
 
 -- |
 -- The help menu.
@@ -65,4 +69,5 @@ help =
   , [":q          ", "Quit PSCi"]
   , [":r          ", "Reset"]
   , [":t <expr>   ", "Show the type of <expr>"]
+  , [":k <type>   ", "Show the kind of <type>"]
   ]
diff --git a/psci/Main.hs b/psci/Main.hs
index 577679c..6aed0d2 100644
--- a/psci/Main.hs
+++ b/psci/Main.hs
@@ -24,6 +24,7 @@ import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
 import Control.Monad.Trans.State.Strict
+import qualified Control.Monad.Trans.State.Lazy as L
 import Control.Monad.Error (ErrorT(..), MonadError)
 import Control.Monad.Error.Class (MonadError(..))
 
@@ -256,6 +257,18 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB
   in
     P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing
 
+-- |
+-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
+--
+createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
+createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =
+  let
+    moduleName = P.ModuleName [P.ProperName "Main"]
+    importDecl m = P.ImportDeclaration m Nothing Nothing
+    itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
+  in
+    P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
+
 modulesDir :: FilePath
 modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
 
@@ -293,9 +306,30 @@ handleTypeOf value = do
     Left err -> PSCI $ outputStrLn err
     Right env' ->
       case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of
-        Just (ty, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
+        Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
         Nothing -> PSCI $ outputStrLn "Could not find type"
 
+-- |
+-- Takes a value and prints its kind
+--
+handleKindOf :: P.Type -> PSCI ()
+handleKindOf typ = do
+  st <- PSCI $ lift get
+  let m = createTemporaryModuleForKind st typ
+      mName = P.ModuleName [P.ProperName "Main"]
+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])
+  case e of
+    Left err -> PSCI $ outputStrLn err
+    Right env' ->
+      case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
+        Just (_, typ') -> do
+          let chk = P.CheckState env' 0 0 (Just mName)
+              k   = L.runStateT (P.unCheck (P.kindOf mName typ')) chk
+          case k of 
+            Left errStack   -> PSCI . outputStrLn . P.prettyPrintErrorStack False $ errStack
+            Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
+        Nothing -> PSCI $ outputStrLn "Could not find kind"
+
 -- Commands
 
 -- |
@@ -339,6 +373,7 @@ handleCommand Reset = do
     Left err -> psciIO $ putStrLn err >> exitFailure
     Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])
 handleCommand (TypeOf val) = handleTypeOf val
+handleCommand (KindOf typ) = handleKindOf typ
 handleCommand _ = PSCI $ outputStrLn "Unknown command"
 
 inputFiles :: Cmd.Term [FilePath]
diff --git a/psci/Parser.hs b/psci/Parser.hs
index 6d12b00..b507f1e 100644
--- a/psci/Parser.hs
+++ b/psci/Parser.hs
@@ -42,7 +42,7 @@ psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C
 --
 parseCommand :: String -> Either ParseError Command
 parseCommand = P.runIndentParser "" $ choice
-                    [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf)
+                    [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf)
                     , try psciLet
                     , psciExpression
                     ] <* eof
@@ -90,3 +90,10 @@ psciReload = Reset <$ char 'r'
 --
 psciTypeOf :: Parsec String P.ParseState Command
 psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
+
+
+-- |
+-- Parses 'Commands.KindOf' command.
+--
+psciKindOf :: Parsec String P.ParseState Command
+psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)
diff --git a/purescript.cabal b/purescript.cabal
index 9a31906..4cb138f 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.5.3
+version: 0.5.4
 cabal-version: >=1.8
 build-type: Custom
 license: MIT
@@ -76,6 +76,7 @@ library
                      Language.PureScript.Pretty.Kinds
                      Language.PureScript.Pretty.Types
                      Language.PureScript.Pretty.Values
+                     Language.PureScript.Renamer
                      Language.PureScript.TypeChecker
                      Language.PureScript.TypeChecker.Kinds
                      Language.PureScript.TypeChecker.Monad
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index eadd44d..54bd11f 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -31,6 +31,7 @@ import Language.PureScript.Environment as P
 import Language.PureScript.Errors as P
 import Language.PureScript.DeadCodeElimination as P
 import Language.PureScript.Supply as P
+import Language.PureScript.Renamer as P
 
 import qualified Language.PureScript.Constants as C
 
@@ -70,14 +71,15 @@ compile = compile' initEnvironment
 
 compile' :: Environment -> Options -> [Module] -> Either String (String, String, Environment)
 compile' env opts ms = do
-  (sorted, _) <- sortModules $ if optionsNoPrelude opts then ms else (map importPrelude ms)
+  (sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else (map importPrelude ms)
   (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted
   (elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent
   regrouped <- stringifyErrorStack True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
   let entryPoints = moduleNameFromString `map` optionsModules opts
   let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped
+  let renamed = renameInModules elim
   let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts
-  let modulesToCodeGen = if null codeGenModules then elim else filter (\(Module mn _ _) -> mn `elem` codeGenModules) elim
+  let modulesToCodeGen = if null codeGenModules then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModules) renamed
   let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs Globals opts m env') modulesToCodeGen
   let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen
   js' <- generateMain env' opts js
@@ -170,7 +172,7 @@ make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options
 make outputDir opts ms = do
   let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
 
-  (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)
+  (sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)
 
   toRebuild <- foldM (\s (Module moduleName' _ _) -> do
     let filePath = runModuleName moduleName'
@@ -212,8 +214,10 @@ make outputDir opts ms = do
     regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
 
     let mod' = Module moduleName' regrouped exps
-    js <- prettyPrintJS <$> moduleToJs CommonJS opts mod' env'
-    let exts = moduleToPs mod' env'
+    let [renamed] = renameInModules [mod'] 
+
+    js <- prettyPrintJS <$> moduleToJs CommonJS opts renamed env'
+    let exts = moduleToPs renamed env'
 
     lift $ writeTextFile jsFile js
     lift $ writeTextFile externsFile exts
@@ -241,16 +245,19 @@ reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
   combine = M.fromList . map ((fst . head) &&& map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst)
 
 -- |
--- Add an import declaration for the Prelude to a module if it does not already explicitly import
--- it.
+-- Add an import declaration for a module if it does not already explicitly import it.
 --
-importPrelude :: Module -> Module
-importPrelude m@(Module mn decls exps)  =
-  if isPreludeImport `any` decls || mn == prelude then m
-  else Module mn (preludeImport : decls) exps
+addDefaultImport :: ModuleName -> Module -> Module
+addDefaultImport toImport m@(Module mn decls exps)  =
+  if isExistingImport `any` decls || mn == toImport then m
+  else Module mn (ImportDeclaration toImport Nothing Nothing : decls) exps
   where
-  prelude = ModuleName [ProperName C.prelude]
-  isPreludeImport (ImportDeclaration (ModuleName [ProperName mn']) _ _) | mn' == C.prelude = True
-  isPreludeImport (PositionedDeclaration _ d) = isPreludeImport d
-  isPreludeImport _ = False
-  preludeImport = ImportDeclaration prelude Nothing Nothing
+  isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
+  isExistingImport (PositionedDeclaration _ d) = isExistingImport d
+  isExistingImport _ = False
+
+importPrim :: Module -> Module
+importPrim = addDefaultImport (ModuleName [ProperName C.prim])
+
+importPrelude :: Module -> Module
+importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])
diff --git a/src/Language/PureScript/CodeGen/Common.hs b/src/Language/PureScript/CodeGen/Common.hs
index 297bdc4..f8af6d8 100644
--- a/src/Language/PureScript/CodeGen/Common.hs
+++ b/src/Language/PureScript/CodeGen/Common.hs
@@ -17,7 +17,14 @@ module Language.PureScript.CodeGen.Common where
 
 import Data.Char
 import Data.List (intercalate)
+import Data.Maybe (fromMaybe)
+import Data.Function (on)
+
+import qualified Data.Map as M
+
 import Language.PureScript.Names
+import Language.PureScript.Environment
+import Language.PureScript.Types
 
 -- |
 -- Convert an Ident into a valid Javascript identifier:
@@ -34,6 +41,12 @@ identToJs (Ident name) = concatMap identCharToString name
 identToJs (Op op) = concatMap identCharToString op
 
 -- |
+-- Test if a string is a valid JS identifier without escaping.
+--
+identNeedsEscaping :: String -> Bool
+identNeedsEscaping s = s /= identToJs (Ident s)
+
+-- |
 -- Attempts to find a human-readable name for a symbol, if none has been specified returns the
 -- ordinal value.
 --
@@ -130,12 +143,51 @@ nameIsJsReserved name =
               , "with"
               , "yield" ]
 
+moduleNameToJs :: ModuleName -> String
+moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
+
 -- |
--- Test if a string is a valid JS identifier (may return false negatives)
+-- Finds the value stored for a data constructor in the current environment.
+-- This is a partial function, but if an invalid type has reached this far then
+-- something has gone wrong in typechecking.
 --
-isIdent :: String -> Bool
-isIdent s@(first : rest) | not (nameIsJsReserved s) && isAlpha first && all isAlphaNum rest = True
-isIdent _ = False
+lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
+lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
 
-moduleNameToJs :: ModuleName -> String
-moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
+-- |
+-- Checks whether a data constructor is the only constructor for that type, used
+-- to simplify the check when generating code for binders.
+--
+isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
+isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
+  where
+  numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
+  numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
+  typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
+  typeConstructor (Qualified (Just moduleName) _, (_, tyCtor, _)) = (moduleName, tyCtor)
+  typeConstructor _ = error "Invalid argument to isOnlyConstructor"
+
+-- |
+-- Checks whether a data constructor is for a newtype.
+--
+isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
+isNewtypeConstructor e ctor = case lookupConstructor e ctor of
+  (Newtype, _, _) -> True
+  (Data, _, _) -> False
+
+-- |
+-- Checks the number of arguments a data constructor accepts.
+--
+getConstructorArity :: Environment -> Qualified ProperName -> Int
+getConstructorArity e = go . (\(_, _, ctors) -> ctors) . lookupConstructor e
+  where
+  go :: Type -> Int
+  go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
+  go (ForAll _ ty _) = go ty
+  go _ = 0
+
+-- |
+-- Checks whether a data constructor has no arguments, for example, `Nothing`.
+--
+isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
+isNullaryConstructor e = (== 0) . getConstructorArity e
diff --git a/src/Language/PureScript/CodeGen/Externs.hs b/src/Language/PureScript/CodeGen/Externs.hs
index 6757465..c8ede82 100644
--- a/src/Language/PureScript/CodeGen/Externs.hs
+++ b/src/Language/PureScript/CodeGen/Externs.hs
@@ -24,6 +24,7 @@ import qualified Data.Map as M
 
 import Control.Monad.Writer
 
+import Language.PureScript.CodeGen.Common
 import Language.PureScript.TypeClassDictionaries
 import Language.PureScript.Declarations
 import Language.PureScript.Pretty
@@ -60,7 +61,10 @@ moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWrite
               printDctor dctor = case dctor `lookup` tys of
                                    Nothing -> Nothing
                                    Just tyArgs -> Just $ show dctor ++ " " ++ unwords (map prettyPrintTypeAtom tyArgs)
-          tell ["data " ++ show pn ++ " " ++ unwords args ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
+          let dtype = if length dctors' == 1 && isNewtypeConstructor env (Qualified (Just moduleName) $ head dctors')
+                      then "newtype"
+                      else "data"
+          tell [dtype ++ " " ++ show pn ++ " " ++ unwords args ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
         Just (_, TypeSynonym) ->
           case Qualified (Just moduleName) pn `M.lookup` typeSynonyms env of
             Nothing -> error $ show pn ++ " has no type synonym info in exportToPs"
@@ -71,7 +75,7 @@ moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWrite
     exportToPs (ValueRef ident) =
       case (moduleName, ident) `M.lookup` names env of
         Nothing -> error $ show ident ++ " has no type in exportToPs"
-        Just (ty, nameKind) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
+        Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
           tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
         _ -> return ()
     exportToPs (TypeClassRef className) =
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 6184461..dfe965f 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -20,18 +20,16 @@ module Language.PureScript.CodeGen.JS (
     ModuleType(..),
     declToJs,
     moduleToJs,
-    isIdent
+    identNeedsEscaping
 ) where
 
-import Data.Maybe (catMaybes, fromJust, fromMaybe)
+import Data.Maybe (catMaybes, fromJust)
 import Data.Function (on)
-import Data.List (nub, (\\))
+import Data.List (nub, (\\), delete, sortBy)
 
 import Control.Monad (replicateM, forM)
 import Control.Applicative
 
-import qualified Data.Map as M
-
 import Language.PureScript.Names
 import Language.PureScript.Declarations
 import Language.PureScript.Options
@@ -42,6 +40,7 @@ import Language.PureScript.CodeGen.Common
 import Language.PureScript.Environment
 import Language.PureScript.Supply
 import Language.PureScript.Traversals (sndM)
+import qualified Language.PureScript.Constants as C
 
 -- |
 -- Different types of modules which are supported
@@ -54,7 +53,7 @@ data ModuleType = CommonJS | Globals
 --
 moduleToJs :: (Functor m, Applicative m, Monad m) => ModuleType -> Options -> Module -> Environment -> SupplyT m [JS]
 moduleToJs mt opts (Module name decls (Just exps)) env = do
-  let jsImports = map (importToJs mt opts) . (\\ [name]) . nub $ concatMap imports decls
+  let jsImports = map (importToJs mt opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls
   jsDecls <- mapM (\decl -> declToJs opts name decl env) decls
   let optimized = concat $ map (map $ optimize opts) $ catMaybes jsDecls
   let isModuleEmpty = null optimized
@@ -79,14 +78,19 @@ importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleB
     Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))
 
 imports :: Declaration -> [ModuleName]
-imports =
-  let (f, _, _, _, _) = everythingOnValues (++) (const []) collect (const []) (const []) (const [])
-  in f
+imports (ImportDeclaration mn _ _) = [mn]
+imports other =
+  let (f, _, _, _, _) = everythingOnValues (++) (const []) collectV collectB (const []) (const [])
+  in f other
   where
-  collect :: Value -> [ModuleName]
-  collect (Var (Qualified (Just mn) _)) = [mn]
-  collect (Constructor (Qualified (Just mn) _)) = [mn]
-  collect _ = []
+  collectV :: Value -> [ModuleName]
+  collectV (Var (Qualified (Just mn) _)) = [mn]
+  collectV (Constructor (Qualified (Just mn) _)) = [mn]
+  collectV (TypeClassDictionaryConstructorApp (Qualified (Just mn) _) _) = [mn]
+  collectV _ = []
+  collectB :: Binder -> [ModuleName]
+  collectB (ConstructorBinder (Qualified (Just mn) _) _) = [mn]
+  collectB _ = []
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a declaration
@@ -100,19 +104,55 @@ declToJs opts mp (BindingGroupDeclaration vals) e = do
     js <- valueToJs opts mp e val
     return $ JSVariableIntroduction (identToJs ident) (Just js)
   return $ Just jss
-declToJs _ mp (DataDeclaration _ _ ctors) _ = do
+declToJs _ _ (DataDeclaration Newtype _ _ [((ProperName ctor), _)]) _ =
+  return $ Just $ [JSVariableIntroduction ctor (Just $
+                    JSObjectLiteral [("create",
+                      JSFunction Nothing ["value"]
+                        (JSBlock [JSReturn $ JSVar "value"]))])]
+declToJs _ _ (DataDeclaration Newtype _ _ _) _ =
+  error "newtype has multiple constructors"
+declToJs _ mp (DataDeclaration Data _ _ ctors) e = do
   return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
-    [JSVariableIntroduction ctor (Just (go pn 0 tys []))]
+      let propName = if isNullaryConstructor e (Qualified (Just mp) pn) then "value" else "create"
+      in [ makeConstructor ctor (length tys)
+         , JSAssignment (JSAccessor propName (JSVar ctor)) (go pn 0 (length tys) [])
+         ]
     where
-    go :: ProperName -> Integer -> [Type] -> [JS] -> JS
-    go pn _ [] values =
-      JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))), ("values", JSArrayLiteral $ reverse values) ]
-    go pn index (_ : tys') values =
+    makeConstructor :: String -> Int -> JS
+    makeConstructor ctorName n =
+      let
+        args = [ "value" ++ show index | index <- [0..n-1] ]
+        body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
+      in JSFunction (Just ctorName) args (JSBlock body)
+    go :: ProperName -> Int -> Int -> [JS] -> JS
+    go pn _ 0 values = JSUnary JSNew $ JSApp (JSVar $ runProperName pn) (reverse values)
+    go pn index n values =
       JSFunction Nothing ["value" ++ show index]
-        (JSBlock [JSReturn (go pn (index + 1) tys' (JSVar ("value" ++ show index) : values))])
+        (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
 declToJs opts mp (DataBindingGroupDeclaration ds) e = do
   jss <- mapM (\decl -> declToJs opts mp decl e) ds
   return $ Just $ concat $ catMaybes jss
+declToJs _ _ (TypeClassDeclaration name _ supers members) _ =
+  return $ Just $ [
+    JSFunction (Just $ runProperName name) (identToJs `map` args)
+      (JSBlock $ assn `map` args)]
+  where
+  assn :: Ident -> JS
+  assn arg = JSAssignment (accessor arg (JSVar "this")) (var arg)
+  args :: [Ident]
+  args = sortBy (compare `on` runIdent) $ memberNames ++ superNames
+  memberNames :: [Ident]
+  memberNames = memberToName `map` members
+  superNames :: [Ident]
+  superNames = [ toSuperName superclass index
+               | (index, (superclass, _)) <- zip [0..] supers
+               ]
+  toSuperName :: Qualified ProperName -> Integer -> Ident
+  toSuperName pn index = Ident $ C.__superclass_ ++ show pn ++ "_" ++ show index
+  memberToName :: Declaration -> Ident
+  memberToName (TypeDeclaration ident _) = ident
+  memberToName (PositionedDeclaration _ d) = memberToName d
+  memberToName _ = error "Invalid declaration in type class definition"
 declToJs _ _ (ExternDeclaration _ _ (Just js) _) _ = return $ Just [js]
 declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e
 declToJs _ _ _ _ = return Nothing
@@ -124,6 +164,7 @@ exportToJs :: DeclarationRef -> [(String, JS)]
 exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors
 exportToJs (ValueRef name) = [(runIdent name, var name)]
 exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]
+exportToJs (TypeClassRef name) = [(runProperName name, var $ Ident $ runProperName name)]
 exportToJs _ = []
 
 -- |
@@ -143,8 +184,8 @@ accessor (Ident prop) = accessorString prop
 accessor (Op op) = JSIndexer (JSStringLiteral op)
 
 accessorString :: String -> JS -> JS
-accessorString prop | isIdent prop = JSAccessor prop
-                    | otherwise = JSIndexer (JSStringLiteral prop)
+accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
+                    | otherwise = JSAccessor prop
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a value or expression.
@@ -155,17 +196,36 @@ valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s
 valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b
 valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral <$> mapM (valueToJs opts m e) xs
 valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM (valueToJs opts m e)) ps
+valueToJs opts m e (TypeClassDictionaryConstructorApp name (TypedValue _ (ObjectLiteral ps) _)) =
+  JSUnary JSNew . JSApp (qualifiedToJS m (Ident . runProperName) name) <$> mapM (valueToJs opts m e . snd) (sortBy (compare `on` fst) ps)
+valueToJs _ _ _ TypeClassDictionaryConstructorApp{} =
+  error "TypeClassDictionaryConstructorApp did not contain object literal"
 valueToJs opts m e (ObjectUpdate o ps) = do
   obj <- valueToJs opts m e o
   sts <- mapM (sndM (valueToJs opts m e)) ps
   extendObj obj sts
-valueToJs _ m _ (Constructor name) = return $ qualifiedToJS m (Ident . runProperName) name
+valueToJs _ m e (Constructor name) =
+  let propName = if isNullaryConstructor e name then "value" else "create"
+  in return $ JSAccessor propName $ qualifiedToJS m (Ident . runProperName) name
 valueToJs opts m e (Case values binders) = do
   vals <- mapM (valueToJs opts m e) values
   bindersToJs opts m e binders vals
 valueToJs opts m e (IfThenElse cond th el) = JSConditional <$> valueToJs opts m e cond <*> valueToJs opts m e th <*> valueToJs opts m e el
 valueToJs opts m e (Accessor prop val) = accessorString prop <$> valueToJs opts m e val
-valueToJs opts m e (App val arg) = JSApp <$> valueToJs opts m e val <*> (return <$> valueToJs opts m e arg)
+valueToJs opts m e v@App{} = do
+  let (f, args) = unApp v []
+  args' <- mapM (valueToJs opts m e) args
+  case f of
+    Constructor name | isNewtypeConstructor e name && length args == 1 -> return (head args')
+    Constructor name | getConstructorArity e name == length args ->
+      return $ JSUnary JSNew $ JSApp (qualifiedToJS m (Ident . runProperName) name) args'
+    _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs opts m e f
+  where
+  unApp :: Value -> [Value] -> (Value, [Value])
+  unApp (App val arg) args = unApp val (arg : args)
+  unApp (PositionedValue _ val) args = unApp val args
+  unApp (TypedValue _ val _) args = unApp val args
+  unApp other args = (other, args)
 valueToJs opts m e (Let ds val) = do
   decls <- concat . catMaybes <$> mapM (flip (declToJs opts m) e) ds
   ret <- valueToJs opts m e val
@@ -260,7 +320,7 @@ bindersToJs opts m e binders vals = do
   jss <- forM binders $ \(CaseAlternative bs grd result) -> do
     ret <- valueToJs opts m e result
     go valNames [JSReturn ret] bs grd
-  return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
+  return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [(JSStringLiteral "Failed pattern match")]])))
                  vals
   where
     go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> Maybe Guard -> SupplyT m [JS]
@@ -289,13 +349,17 @@ binderToJs _ _ varName done (BooleanBinder False) =
   return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
 binderToJs _ _ varName done (VarBinder ident) =
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
+binderToJs m e varName done (ConstructorBinder ctor bs) | isNewtypeConstructor e ctor =
+  case bs of
+    [b] -> binderToJs m e varName done b
+    _ -> error "binder for newtype constructor should have a single argument"
 binderToJs m e varName done (ConstructorBinder ctor bs) = do
   js <- go 0 done bs
   if isOnlyConstructor e ctor
   then
     return js
   else
-    return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ctor)))
+    return [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS m (Ident . runProperName) ctor))
                      (JSBlock js)
                      Nothing]
   where
@@ -305,7 +369,7 @@ binderToJs m e varName done (ConstructorBinder ctor bs) = do
     argVar <- freshName
     done'' <- go (index + 1) done' bs'
     js <- binderToJs m e argVar done'' binder
-    return (JSVariableIntroduction argVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSAccessor "values" (JSVar varName)))) : js)
+    return (JSVariableIntroduction argVar (Just (JSAccessor ("value" ++ show index) (JSVar varName))) : js)
 binderToJs m e varName done (ObjectBinder bs) = go done bs
   where
   go :: (Functor m, Applicative m, Monad m) => [JS] -> [(String, Binder)] -> SupplyT m [JS]
@@ -341,17 +405,3 @@ binderToJs m e varName done (NamedBinder ident binder) = do
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
 binderToJs m e varName done (PositionedBinder _ binder) =
   binderToJs m e varName done binder
-
--- |
--- Checks whether a data constructor is the only constructor for that type, used to simplify the
--- check when generating code for binders.
---
-isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
-isOnlyConstructor e ctor =
-  let ty = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
-  in numConstructors (ctor, ty) == 1
-  where
-  numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
-  typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)
-  typeConstructor _ = error "Invalid argument to isOnlyConstructor"
-
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
index 1aa800c..4666ab0 100644
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -38,7 +38,11 @@ data UnaryOperator
   -- |
   -- Numeric unary \'plus\'
   --
-  | Positive deriving (Show, Eq, Data, Typeable)
+  | Positive
+  -- |
+  -- Constructor
+  --
+  | JSNew deriving (Show, Eq, Data, Typeable)
 
 -- |
 -- Built-in binary operators
@@ -218,6 +222,10 @@ data JS
   --
   | JSTypeOf JS
   -- |
+  -- InstanceOf test
+  --
+  | JSInstanceOf JS JS
+  -- |
   -- Labelled statement
   --
   | JSLabel String JS
@@ -262,6 +270,7 @@ everywhereOnJS f = go
   go (JSThrow js) = f (JSThrow (go js))
   go (JSTypeOf js) = f (JSTypeOf (go js))
   go (JSLabel name js) = f (JSLabel name (go js))
+  go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
   go other = f other
 
 everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
@@ -288,6 +297,7 @@ everywhereOnJSTopDown f = go . f
   go (JSThrow j) = JSThrow (go (f j))
   go (JSTypeOf j) = JSTypeOf (go (f j))
   go (JSLabel name j) = JSLabel name (go (f j))
+  go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))
   go other = f other
 
 everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
@@ -314,4 +324,5 @@ everythingOnJS (<>) f = go
   go j@(JSThrow j1) = f j <> go j1
   go j@(JSTypeOf j1) = f j <> go j1
   go j@(JSLabel _ j1) = f j <> go j1
+  go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
   go other = f other
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
index 34c66a9..53879c6 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants.hs
@@ -23,6 +23,9 @@ module Language.PureScript.Constants where
 (#) :: String
 (#) = "#"
 
+(<>) :: String
+(<>) = "<>"
+
 (++) :: String
 (++) = "++"
 
@@ -105,6 +108,9 @@ not = "not"
 return :: String
 return = "return"
 
+pure' :: String
+pure' = "pure"
+
 returnEscaped :: String
 returnEscaped = "$return"
 
@@ -141,11 +147,20 @@ peekSTArray = "peekSTArray"
 pokeSTArray :: String
 pokeSTArray = "pokeSTArray"
 
+mkFn :: String
+mkFn = "mkFn"
+
+runFn :: String
+runFn = "runFn"
+
 -- Type Class Dictionary Names
 
 monadEffDictionary :: String
 monadEffDictionary = "monadEff"
 
+applicativeEffDictionary :: String
+applicativeEffDictionary = "applicativeEff"
+
 bindEffDictionary :: String
 bindEffDictionary = "bindEff"
 
@@ -173,6 +188,9 @@ boolLikeBoolean = "boolLikeBoolean"
 semigroupString :: String
 semigroupString = "semigroupString"
 
+semigroupoidArr :: String
+semigroupoidArr = "semigroupoidArr"
+
 -- Main module
 
 main :: String
@@ -180,8 +198,8 @@ main = "main"
 
 -- Code Generation
 
-__superclasses :: String
-__superclasses = "__superclasses"
+__superclass_ :: String
+__superclass_ = "__superclass_"
 
 -- Modules
 
@@ -199,3 +217,6 @@ eff = "Control_Monad_Eff"
 
 st :: String
 st = "Control_Monad_ST"
+
+dataFunction :: String
+dataFunction = "Data_Function"
diff --git a/src/Language/PureScript/DeadCodeElimination.hs b/src/Language/PureScript/DeadCodeElimination.hs
index 3357125..ed891a5 100644
--- a/src/Language/PureScript/DeadCodeElimination.hs
+++ b/src/Language/PureScript/DeadCodeElimination.hs
@@ -39,7 +39,8 @@ eliminateDeadCode entryPoints ms = map go ms
   entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
 
   filterExport :: [Declaration] -> DeclarationRef -> Maybe DeclarationRef
-  filterExport decls r@(TypeRef name _) | (any $ typeExists name) decls = Just r
+  filterExport decls r@(TypeRef name _) | (any $ typeOrClassExists name) decls = Just r
+  filterExport decls r@(TypeClassRef name) | (any $ typeOrClassExists name) decls = Just r
   filterExport decls r@(ValueRef name) | (any $ valueExists name) decls = Just r
   filterExport decls r@(TypeInstanceRef name) | (any $ valueExists name) decls = Just r
   filterExport _ _ = Nothing
@@ -51,11 +52,12 @@ eliminateDeadCode entryPoints ms = map go ms
   valueExists name (PositionedDeclaration _ d) = valueExists name d
   valueExists _ _ = False
 
-  typeExists :: ProperName -> Declaration -> Bool
-  typeExists name (DataDeclaration name' _ _) = name == name'
-  typeExists name (DataBindingGroupDeclaration decls) = any (typeExists name) decls
-  typeExists name (PositionedDeclaration _ d) = typeExists name d
-  typeExists _ _ = False
+  typeOrClassExists :: ProperName -> Declaration -> Bool
+  typeOrClassExists name (DataDeclaration _ name' _ _) = name == name'
+  typeOrClassExists name (TypeClassDeclaration name' _ _ _) = name == name'
+  typeOrClassExists name (DataBindingGroupDeclaration decls) = any (typeOrClassExists name) decls
+  typeOrClassExists name (PositionedDeclaration _ d) = typeOrClassExists name d
+  typeOrClassExists _ _ = False
 
 type Key = (ModuleName, Either Ident ProperName)
 
@@ -64,10 +66,11 @@ declarationsByModule (Module moduleName ds _) = concatMap go ds
   where
   go :: Declaration -> [(Key, [Key])]
   go d@(ValueDeclaration name _ _ _ _) = [((moduleName, Left name), dependencies moduleName d)]
-  go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
+  go (DataDeclaration _ _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
   go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
   go d@(BindingGroupDeclaration names') = map (\(name, _, _) -> ((moduleName, Left name), dependencies moduleName d)) names'
   go (DataBindingGroupDeclaration ds') = concatMap go ds'
+  go (TypeClassDeclaration name _ _ _) = [((moduleName, Right name), [])]
   go (PositionedDeclaration _ d) = go d
   go _ = []
 
@@ -80,6 +83,8 @@ dependencies moduleName =
   values (Var ident) = let (mn, name) = qualify moduleName ident in [(mn, Left name)]
   values (Constructor (Qualified (Just mn) name)) = [(mn, Right name)]
   values (Constructor (Qualified Nothing _)) = error "Found unqualified data constructor"
+  values (TypeClassDictionaryConstructorApp (Qualified (Just mn) name) _) = [(mn, Right name)]
+  values (TypeClassDictionaryConstructorApp (Qualified Nothing _) _) = error "Found unqualified class dictionary constructor"
   values _ = []
 
 isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Declaration -> Bool
@@ -89,7 +94,7 @@ isUsed moduleName graph vertexFor entryPointVertices (ValueDeclaration name _ _
 isUsed moduleName graph vertexFor entryPointVertices (FixityDeclaration _ name) =
   let Just v' = vertexFor (moduleName, Left $ Op name)
   in any (\v -> path graph v v') entryPointVertices
-isUsed moduleName graph vertexFor entryPointVertices (DataDeclaration _ _ dctors) =
+isUsed moduleName graph vertexFor entryPointVertices (DataDeclaration _ _ _ dctors) =
   any (\(pn, _) -> let Just v' = vertexFor (moduleName, Right pn)
                    in any (\v -> path graph v v') entryPointVertices) dctors
 isUsed moduleName graph vertexFor entryPointVertices (ExternDeclaration _ name _ _) =
@@ -100,6 +105,9 @@ isUsed moduleName graph vertexFor entryPointVertices (BindingGroupDeclaration ds
                         in any (\v -> path graph v v') entryPointVertices) ds
 isUsed moduleName graph vertexFor entryPointVertices (DataBindingGroupDeclaration ds) =
   any (isUsed moduleName graph vertexFor entryPointVertices) ds
+isUsed moduleName graph vertexFor entryPointVertices (TypeClassDeclaration name _ _ _) =
+  let Just v' = vertexFor (moduleName, Right name)
+  in any (\v -> path graph v v') entryPointVertices
 isUsed moduleName graph vertexFor entryPointVertices (PositionedDeclaration _ d) =
   isUsed moduleName graph vertexFor entryPointVertices d
 isUsed _ _ _ _ _ = True
diff --git a/src/Language/PureScript/Declarations.hs b/src/Language/PureScript/Declarations.hs
index 5e9d307..ef7e413 100644
--- a/src/Language/PureScript/Declarations.hs
+++ b/src/Language/PureScript/Declarations.hs
@@ -118,9 +118,9 @@ instance Eq DeclarationRef where
 --
 data Declaration
   -- |
-  -- A data type declaration (name, arguments, data constructors)
+  -- A data type declaration (data or newtype, name, arguments, data constructors)
   --
-  = DataDeclaration ProperName [String] [(ProperName, [Type])]
+  = DataDeclaration DataDeclType ProperName [String] [(ProperName, [Type])]
   -- |
   -- A minimal mutually recursive set of data type declarations
   --
@@ -332,6 +332,11 @@ data Value
   --
   | Do [DoNotationElement]
   -- |
+  -- An application of a typeclass dictionary constructor. The value should be
+  -- an ObjectLiteral.
+  --
+  | TypeClassDictionaryConstructorApp (Qualified ProperName) Value
+  -- |
   -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
   -- placeholders will be replaced with actual expressions representing type classes dictionaries which
   -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
@@ -483,6 +488,7 @@ everywhereOnValues f g h = (f', g', h')
   g' (Parens v) = g (Parens (g' v))
   g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
   g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
+  g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
   g' (Accessor prop v) = g (Accessor prop (g' v))
   g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
   g' (Abs name v) = g (Abs name (g' v))
@@ -538,6 +544,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
   g' (Parens v) = Parens <$> (g v >>= g')
   g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs
   g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs
+  g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
   g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
   g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs
   g' (Abs name v) = Abs name <$> (g v >>= g')
@@ -587,6 +594,7 @@ everywhereOnValuesM f g h = (f' <=< f, g' <=< g, h' <=< h)
   g' (Parens v) = (Parens <$> g' v) >>= g
   g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g
   g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g
+  g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
   g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
   g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g
   g' (Abs name v) = (Abs name <$> g' v) >>= g
@@ -639,6 +647,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
   g' v@(Parens v1) = g v <> g' v1
   g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
   g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
+  g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
   g' v@(Accessor _ v1) = g v <> g' v1
   g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
   g' v@(Abs _ v1) = g v <> g' v1
@@ -702,6 +711,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
   g' s (Parens v1) = (g'' s) v1
   g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
   g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
+  g' s (TypeClassDictionaryConstructorApp _ v1) = (g'' s) v1
   g' s (Accessor _ v1) = (g'' s) v1
   g' s (ObjectUpdate obj vs) = foldl (<>) ((g'' s) obj) (map (g'' s . snd) vs)
   g' s (Abs _ v1) = (g'' s) v1
@@ -767,6 +777,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
   g' s (Parens v) = Parens <$> g'' s v
   g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
   g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
+  g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g'' s) v
   g' s (Accessor prop v) = Accessor prop <$> g'' s v
   g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
   g' s (Abs name v) = Abs name <$> g'' s v
@@ -803,7 +814,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
 accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
 accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
   where
-  forDecls (DataDeclaration _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
+  forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
   forDecls (ExternDeclaration _ _ _ ty) = f ty
   forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
   forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
index a148869..6eef096 100644
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 --
--- Module      :  Language.PureScript.Prim
+-- Module      :  Language.PureScript.Environment
 -- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
 -- License     :  MIT
 --
@@ -33,7 +33,7 @@ data Environment = Environment {
   -- |
   -- Value names currently in scope
   --
-    names :: M.Map (ModuleName, Ident) (Type, NameKind)
+    names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
   -- |
   -- Type names currently in scope
   --
@@ -41,7 +41,7 @@ data Environment = Environment {
   -- |
   -- Data constructors currently in scope, along with their associated data type constructors
   --
-  , dataConstructors :: M.Map (Qualified ProperName) (ProperName, Type)
+  , dataConstructors :: M.Map (Qualified ProperName) (DataDeclType, ProperName, Type)
   -- |
   -- Type synonyms currently in scope
   --
@@ -76,6 +76,19 @@ data ForeignImportType
   | InlineJavascript deriving (Show, Eq, Data, Typeable)
 
 -- |
+-- The visibility of a name in scope
+--
+data NameVisibility
+  -- |
+  -- The name is defined in the current binding group, but is not visible
+  --
+  = Undefined
+  -- |
+  -- The name is defined in the another binding group, or has been made visible by a function binder
+  --
+  | Defined deriving (Show, Eq)
+
+-- |
 -- The kind of a name
 --
 data NameKind
@@ -126,6 +139,23 @@ data TypeKind
   | LocalTypeVariable deriving (Show, Eq, Data, Typeable)
 
 -- |
+-- The type ('data' or 'newtype') of a data type declaration
+--
+data DataDeclType
+  -- |
+  -- A standard data constructor
+  --
+  = Data
+  -- |
+  -- A newtype constructor
+  --
+  | Newtype deriving (Eq, Ord, Data, Typeable)
+
+instance Show DataDeclType where
+  show Data = "data"
+  show Newtype = "newtype"
+
+-- |
 -- Construct a ProperName in the Prim module
 --
 primName :: String -> Qualified ProperName
diff --git a/src/Language/PureScript/Optimizer.hs b/src/Language/PureScript/Optimizer.hs
index d75c234..9ffc4b0 100644
--- a/src/Language/PureScript/Optimizer.hs
+++ b/src/Language/PureScript/Optimizer.hs
@@ -53,6 +53,7 @@ optimize :: Options -> JS -> JS
 optimize opts | optionsNoOptimizations opts = id
               | otherwise = untilFixedPoint (applyAll
   [ collapseNestedBlocks
+  , collapseNestedIfs
   , tco opts
   , magicDo opts
   , removeCodeAfterReturnStatements
diff --git a/src/Language/PureScript/Optimizer/Blocks.hs b/src/Language/PureScript/Optimizer/Blocks.hs
index 98d383c..ef95141 100644
--- a/src/Language/PureScript/Optimizer/Blocks.hs
+++ b/src/Language/PureScript/Optimizer/Blocks.hs
@@ -13,9 +13,10 @@
 --
 -----------------------------------------------------------------------------
 
-module Language.PureScript.Optimizer.Blocks (
-  collapseNestedBlocks
-) where
+module Language.PureScript.Optimizer.Blocks
+  ( collapseNestedBlocks
+  , collapseNestedIfs
+  ) where
 
 import Language.PureScript.CodeGen.JS.AST
 
@@ -31,3 +32,11 @@ collapseNestedBlocks = everywhereOnJS collapse
   go :: JS -> [JS]
   go (JSBlock sts) = sts
   go s = [s]
+
+collapseNestedIfs :: JS -> JS
+collapseNestedIfs = everywhereOnJS collapse
+  where
+  collapse :: JS -> JS
+  collapse (JSIfElse cond1 (JSBlock [JSIfElse cond2 body Nothing]) Nothing) =
+      JSIfElse (JSBinary And cond1 cond2) body Nothing
+  collapse js = js
diff --git a/src/Language/PureScript/Optimizer/Inliner.hs b/src/Language/PureScript/Optimizer/Inliner.hs
index 0c3626e..bf39d2e 100644
--- a/src/Language/PureScript/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/Optimizer/Inliner.hs
@@ -22,6 +22,8 @@ module Language.PureScript.Optimizer.Inliner (
   evaluateIifes
 ) where
 
+import Data.Maybe (fromMaybe)
+
 import Language.PureScript.CodeGen.JS.AST
 import Language.PureScript.CodeGen.Common (identToJs)
 import Language.PureScript.Optimizer.Common
@@ -47,6 +49,8 @@ etaConvert = everywhereOnJS convert
       not (any (`isRebound` block) (map JSVar idents)) &&
       not (any (`isRebound` block) args)
       = JSBlock (map (replaceIdents (zip idents args)) body)
+  convert (JSFunction Nothing ["_"] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))
+      = fn
   convert js = js
 
 unThunk :: JS -> JS
@@ -88,7 +92,7 @@ inlineOperator (m, op) f = everywhereOnJS convert
   isOp _ = False
 
 inlineCommonOperators :: JS -> JS
-inlineCommonOperators = applyAll
+inlineCommonOperators = applyAll $
   [ binary C.numNumber (C.+) Add
   , binary C.numNumber (C.-) Subtract
   , binary C.numNumber (C.*) Multiply
@@ -108,6 +112,7 @@ inlineCommonOperators = applyAll
   , binary C.eqBoolean (C.==) EqualTo
   , binary C.eqBoolean (C./=) NotEqualTo
 
+  , binary C.semigroupString (C.<>) Add
   , binary C.semigroupString (C.++) Add
 
   , binaryFunction C.bitsNumber C.shl ShiftLeft
@@ -121,7 +126,8 @@ inlineCommonOperators = applyAll
   , binary C.boolLikeBoolean (C.&&) And
   , binary C.boolLikeBoolean (C.||) Or
   , unary  C.boolLikeBoolean C.not Not
-  ]
+  ] ++
+  [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
   where
   binary :: String -> String -> BinaryOperator -> JS -> JS
   binary dictName opString op = everywhereOnJS convert
@@ -150,3 +156,38 @@ inlineCommonOperators = applyAll
     isOp _ = False
   isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName
   isOpDict _ _ = False
+  mkFn :: Int -> JS -> JS
+  mkFn 0 = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
+      JSFunction Nothing [] (JSBlock js)
+    convert other = other
+  mkFn n = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
+      case collectArgs n [] fn of
+        Just (args, js) -> JSFunction Nothing args (JSBlock js)
+        Nothing -> orig
+    convert other = other
+    collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
+    collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
+    collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
+    collectArgs _ _   _ = Nothing
+
+  isNFn :: String -> Int -> JS -> Bool
+  isNFn prefix n (JSVar name) = name == (prefix ++ show n)
+  isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
+  isNFn _ _ _ = False
+
+  runFn :: Int -> JS -> JS
+  runFn n = everywhereOnJS convert
+    where
+    convert :: JS -> JS
+    convert js = fromMaybe js $ go n [] js
+
+    go :: Int -> [JS] -> JS -> Maybe JS
+    go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
+    go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
+    go _ _   _ = Nothing
diff --git a/src/Language/PureScript/Optimizer/MagicDo.hs b/src/Language/PureScript/Optimizer/MagicDo.hs
index 9976ff6..e271de8 100644
--- a/src/Language/PureScript/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/Optimizer/MagicDo.hs
@@ -57,6 +57,8 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
   convert :: JS -> JS
   -- Desugar return
   convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
+  -- Desugar pure
+  convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
   -- Desugar >>
   convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
     let JSReturn ret = last js in
@@ -78,6 +80,9 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
   -- Check if an expression represents a monomorphic call to return for the Eff monad
   isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
   isReturn _ = False
+  -- Check if an expression represents a monomorphic call to pure for the Eff applicative
+  isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
+  isPure _ = False
   -- Check if an expression represents the polymorphic >>= function
   isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
   isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
@@ -86,6 +91,10 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
   isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
   isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return
   isRetPoly _ = False
+  -- Check if an expression represents the polymorphic pure function
+  isPurePoly (JSAccessor pure' (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
+  isPurePoly (JSIndexer (JSStringLiteral pure') (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
+  isPurePoly _ = False
   -- Check if an expression represents a function in the Ef module
   isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
   isEffFunc _ _ = False
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index 481ccc2..1789379 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -31,6 +31,7 @@ import Language.PureScript.Names
 --
 reservedPsNames :: [String]
 reservedPsNames = [ "data"
+                  , "newtype"
                   , "type"
                   , "foreign"
                   , "import"
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 47b9e18..26b7595 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -48,13 +48,13 @@ sourcePos = toSourcePos <$> P.getPosition
 
 parseDataDeclaration :: P.Parsec String ParseState Declaration
 parseDataDeclaration = do
-  reserved "data"
+  dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)
   name <- indented *> properName
   tyArgs <- many (indented *> identifier)
   ctors <- P.option [] $ do
     _ <- lexeme $ indented *> P.char '='
     sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe
-  return $ DataDeclaration name tyArgs ctors
+  return $ DataDeclaration dtype name tyArgs ctors
 
 parseTypeDeclaration :: P.Parsec String ParseState Declaration
 parseTypeDeclaration =
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
index 76fab97..c5d2d21 100644
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -30,15 +30,6 @@ import Language.PureScript.Environment
 import qualified Text.Parsec as P
 import qualified Text.Parsec.Expr as P
 
-parseNumber :: P.Parsec String ParseState Type
-parseNumber = const tyNumber <$> reserved "Number"
-
-parseString :: P.Parsec String ParseState Type
-parseString = const tyString <$> reserved "String"
-
-parseBoolean :: P.Parsec String ParseState Type
-parseBoolean = const tyBoolean <$> reserved "Boolean"
-
 parseArray :: P.Parsec String ParseState Type
 parseArray = squares $ return tyArray
 
@@ -69,10 +60,7 @@ parseForAll = mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> id
 --
 parseTypeAtom :: P.Parsec String ParseState Type
 parseTypeAtom = indented *> P.choice (map P.try
-            [ parseNumber
-            , parseString
-            , parseBoolean
-            , parseArray
+            [ parseArray
             , parseArrayOf
             , parseFunction
             , parseObject
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index ebb42ed..7933302 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -18,7 +18,7 @@ module Language.PureScript.Pretty.JS (
 ) where
 
 import Language.PureScript.Pretty.Common
-import Language.PureScript.CodeGen.JS (isIdent)
+import Language.PureScript.CodeGen.JS (identNeedsEscaping)
 import Language.PureScript.CodeGen.JS.AST
 
 import Data.List
@@ -56,8 +56,8 @@ literals = mkPattern' match
     ]
     where
     objectPropertyToString :: String -> String
-    objectPropertyToString s | isIdent s = s
-                             | otherwise = show s
+    objectPropertyToString s | identNeedsEscaping s = show s
+                             | otherwise = s
   match (JSBlock sts) = fmap concat $ sequence
     [ return "{\n"
     , withIndent $ prettyStatements sts
@@ -174,6 +174,12 @@ typeOf = mkPattern match
   match (JSTypeOf val) = Just ((), val)
   match _ = Nothing
 
+instanceOf :: Pattern PrinterState JS (JS, JS)
+instanceOf = mkPattern match
+  where
+  match (JSInstanceOf val ty) = Just (val, ty)
+  match _ = Nothing
+
 unary :: UnaryOperator -> String -> Operator PrinterState JS String
 unary op str = Wrap match (++)
   where
@@ -223,6 +229,7 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
     OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
                   , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
                   , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]
+                  , [ unary JSNew "new " ]
                   , [ Wrap lam $ \(name, args) ret -> "function "
                         ++ fromMaybe "" name
                         ++ "(" ++ intercalate ", " args ++ ") "
@@ -232,6 +239,7 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
                   , [ binary    GreaterThan          ">" ]
                   , [ binary    GreaterThanOrEqualTo ">=" ]
                   , [ Wrap typeOf $ \_ s -> "typeof " ++ s ]
+                  , [ AssocR instanceOf $ \v1 v2 -> v1 ++ " instanceof " ++ v2 ]
                   , [ unary     Not                  "!" ]
                   , [ unary     BitwiseNot           "~" ]
                   , [ unary     Negate               "-" ]
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index ee0107d..9476053 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -51,6 +51,11 @@ literals = mkPattern' match
     , currentIndent
     , return "}"
     ]
+  match (TypeClassDictionaryConstructorApp className ps) = fmap concat $ sequence
+    [ return ((show className) ++ "(\n")
+    , match ps
+    , return ")"
+    ]
   match (Constructor name) = return $ show name
   match (Case values binders) = fmap concat $ sequence
     [ return "case "
@@ -73,8 +78,8 @@ literals = mkPattern' match
     , withIndent $ prettyPrintMany prettyPrintDoNotationElement els
     , currentIndent
     ]
-  match (TypeClassDictionary _ _ _) = return "<<dict>>"
-  match (SuperClassDictionary _ _) = return "<<superclass dict>>"
+  match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"
+  match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"
   match (TypedValue _ val _) = prettyPrintValue' val
   match (PositionedValue _ val) = prettyPrintValue' val
   match _ = mzero
diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs
new file mode 100644
index 0000000..259edef
--- /dev/null
+++ b/src/Language/PureScript/Renamer.hs
@@ -0,0 +1,206 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.Renamer
+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- Renaming pass that prevents shadowing of local identifiers.
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.Renamer (renameInModules) where
+
+import Control.Applicative
+import Control.Monad.State
+
+import Data.List (find)
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import Language.PureScript.Declarations
+import Language.PureScript.Environment
+import Language.PureScript.Names
+import Language.PureScript.Traversals
+
+-- |
+-- The state object used in this module
+--
+data RenameState = RenameState {
+    -- |
+    -- A map from names bound (in the input) to their names (in the output)
+    --
+    rsBoundNames :: M.Map Ident Ident
+    -- |
+    -- The set of names which have been used and are in scope in the output
+    --
+  , rsUsedNames :: S.Set Ident
+  }
+
+type Rename = State RenameState
+
+initState :: [Ident] -> RenameState
+initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
+
+-- |
+-- Runs renaming starting with a list of idents for the initial scope.
+--
+runRename :: [Ident] -> Rename a -> a
+runRename scope = flip evalState (initState scope)
+
+-- |
+-- Creates a new renaming scope using the current as a basis. Used to backtrack
+-- when leaving an Abs.
+--
+newScope :: Rename a -> Rename a
+newScope x = do
+  scope <- get
+  a <- x
+  put scope
+  return a
+
+-- |
+-- Adds a new scope entry for an ident. If the ident is already present, a new
+-- unique name is generated and stored.
+--
+updateScope :: Ident -> Rename Ident
+updateScope name = do
+  scope <- get
+  let name' = case name `S.member` rsUsedNames scope of
+                True ->
+                  let
+                    newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
+                    Just newName = find (`S.notMember` rsUsedNames scope) newNames
+                  in newName
+                False -> name
+  modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
+                   , rsUsedNames  = S.insert name' (rsUsedNames s)
+                   }
+  return name'
+
+-- |
+-- Finds the new name to use for an ident.
+--
+lookupIdent :: Ident -> Rename Ident
+lookupIdent name = do
+  name' <- gets $ M.lookup name . rsBoundNames
+  case name' of
+    Just name'' -> return name''
+    Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
+
+-- |
+-- Finds idents introduced by declarations.
+--
+findDeclIdents :: [Declaration] -> [Ident]
+findDeclIdents = concatMap go
+  where
+  go (ValueDeclaration ident _ _ _ _) = [ident]
+  go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
+  go (ExternDeclaration _ ident _ _) = [ident]
+  go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
+  go (PositionedDeclaration _ d) = go d
+  go _ = []
+
+-- |
+-- Renames within each declaration in a module.
+--
+renameInModules :: [Module] -> [Module]
+renameInModules = map go
+  where
+  go :: Module -> Module
+  go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
+  renameInDecl' :: [Ident] -> Declaration -> Declaration
+  renameInDecl' scope = runRename scope . renameInDecl True
+
+-- |
+-- Renames within a declaration. isTopLevel is used to determine whether the
+-- declaration is a module member or appearing within a Let. At the top level
+-- declarations are not renamed or added to the scope (they should already have
+-- been added), whereas in a Let declarations are renamed if their name shadows
+-- another in the current scope.
+--
+renameInDecl :: Bool -> Declaration -> Rename Declaration
+renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
+  name' <- if isTopLevel then return name else updateScope name
+  ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
+renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
+  ds' <- mapM updateNames ds
+  BindingGroupDeclaration <$> mapM updateValues ds'
+  where
+  updateNames :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
+  updateNames (name, nameKind, val) = do
+    name' <- if isTopLevel then return name else updateScope name
+    return (name', nameKind, val)
+  updateValues :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
+  updateValues (name, nameKind, val) =
+    (,,) name nameKind <$> renameInValue val
+renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
+  TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
+renameInDecl isTopLevel (PositionedDeclaration pos d) =
+  PositionedDeclaration pos <$> renameInDecl isTopLevel d
+renameInDecl _ other = return other
+
+-- |
+-- Renames within a value.
+--
+renameInValue :: Value -> Rename Value
+renameInValue (UnaryMinus v) =
+  UnaryMinus <$> renameInValue v
+renameInValue (ArrayLiteral vs) =
+  ArrayLiteral <$> mapM renameInValue vs
+renameInValue (ObjectLiteral vs) =
+  ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
+renameInValue (Accessor prop v) =
+  Accessor prop <$> renameInValue v
+renameInValue (ObjectUpdate obj vs) =
+  ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
+renameInValue (Abs (Left name) v) =
+  newScope $ Abs . Left <$> updateScope name <*> renameInValue v
+renameInValue (App v1 v2) =
+  App <$> renameInValue v1 <*> renameInValue v2
+renameInValue (Var (Qualified Nothing name)) =
+  Var . Qualified Nothing <$> lookupIdent name
+renameInValue (IfThenElse v1 v2 v3) =
+  IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
+renameInValue (Case vs alts) =
+  newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
+renameInValue (TypedValue check v ty) =
+  TypedValue check <$> renameInValue v <*> pure ty
+renameInValue (Let ds v) =
+  newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
+renameInValue (TypeClassDictionaryConstructorApp name v) =
+  TypeClassDictionaryConstructorApp name <$> renameInValue v
+renameInValue (PositionedValue pos v) =
+  PositionedValue pos <$> renameInValue v
+renameInValue v = return v
+
+-- |
+-- Renames within case alternatives.
+--
+renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
+renameInCaseAlternative (CaseAlternative bs g v) =
+  CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
+
+-- |
+-- Renames within binders.
+--
+renameInBinder :: Binder -> Rename Binder
+renameInBinder (VarBinder name) =
+  VarBinder <$> updateScope name
+renameInBinder (ConstructorBinder name bs) =
+  ConstructorBinder name <$> mapM renameInBinder bs
+renameInBinder (ObjectBinder bs) =
+  ObjectBinder <$> mapM (sndM renameInBinder) bs
+renameInBinder (ArrayBinder bs) =
+  ArrayBinder <$> mapM renameInBinder bs
+renameInBinder (ConsBinder b1 b2) =
+  ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
+renameInBinder (NamedBinder name b) =
+  NamedBinder <$> updateScope name <*> renameInBinder b
+renameInBinder (PositionedBinder _ b) = renameInBinder b
+renameInBinder other = return other
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
index e4c587b..180ef7f 100644
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -118,7 +118,7 @@ getIdent (PositionedDeclaration _ d) = getIdent d
 getIdent _ = error "Expected ValueDeclaration"
 
 getProperName :: Declaration -> ProperName
-getProperName (DataDeclaration pn _ _) = pn
+getProperName (DataDeclaration _ pn _ _) = pn
 getProperName (TypeSynonymDeclaration pn _ _) = pn
 getProperName (PositionedDeclaration _ d) = getProperName d
 getProperName _ = error "Expected DataDeclaration"
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
index 7af9be4..205c57a 100644
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -31,6 +31,8 @@ import Language.PureScript.Environment
 import Language.PureScript.Errors
 import Language.PureScript.Traversals
 
+import qualified Language.PureScript.Constants as C
+
 -- |
 -- The global export environment - every declaration exported from every module.
 --
@@ -180,8 +182,8 @@ renameInModule imports exports (Module mn decls exps) =
 
   updateDecl :: (Maybe SourcePos, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourcePos, [Ident]), Declaration)
   updateDecl (_, bound) d@(PositionedDeclaration pos _) = return ((Just pos, bound), d)
-  updateDecl (pos, bound) (DataDeclaration name args dctors) =
-    (,) (pos, bound) <$> (DataDeclaration name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)
+  updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =
+    (,) (pos, bound) <$> (DataDeclaration dtype name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)
   updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =
     (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)
   updateDecl (pos, bound) (TypeClassDeclaration className args implies ds) =
@@ -272,7 +274,7 @@ renameInModule imports exports (Module mn decls exps) =
 -- Finds all exported declarations in a set of modules.
 --
 findExports :: [Module] -> Either ErrorStack ExportEnvironment
-findExports = foldM addModule $ M.singleton (ModuleName [ProperName "Prim"]) primExports
+findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) primExports
   where
 
   -- The exported types from the Prim module
@@ -295,7 +297,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName "Prim"]) pri
     go env'' (TypeDeclaration name _) = addValue env'' mn name
     go env'' (PositionedDeclaration pos d) = rethrowWithPosition pos $ go env'' d
     go _ _ = error "Invalid declaration in TypeClassDeclaration"
-  addDecl mn env (DataDeclaration tn _ dcs) = addType env mn tn (map fst dcs)
+  addDecl mn env (DataDeclaration _ tn _ dcs) = addType env mn tn (map fst dcs)
   addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []
   addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []
   addDecl mn env (ValueDeclaration name _ _ _ _) = addValue env mn name
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 349f32e..b34425d 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -33,9 +33,9 @@ import Control.Applicative
 import Control.Monad.Error
 import Control.Monad.State
 import Control.Arrow (first, second)
-import Data.List ((\\))
+import Data.List ((\\), find)
 import Data.Monoid ((<>))
-import Data.Maybe (catMaybes, mapMaybe)
+import Data.Maybe (catMaybes, mapMaybe, isJust)
 
 import qualified Data.Map as M
 
@@ -52,7 +52,7 @@ desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule
 
 desugarModule :: Module -> Desugar Module
 desugarModule (Module name decls (Just exps)) = do
-  (newExpss, declss) <- unzip <$> mapM (desugarDecl name) decls
+  (newExpss, declss) <- unzip <$> mapM (desugarDecl name exps) decls
   return $ Module name (concat declss) $ Just (exps ++ catMaybes newExpss)
 desugarModule _ = error "Exports should have been elaborated in name desugaring"
 
@@ -82,63 +82,120 @@ desugarModule _ = error "Exports should have been elaborated in name desugaring"
 --   instance subString :: Sub String where
 --     sub = ""
 --
--- becomes
+-- becomes:
+--
+--   <TypeClassDeclaration Foo ...>
 --
 --   type Foo a = { foo :: a -> a }
 --
---   foreign import foo "function foo(dict) {\
---                      \  return dict.foo;\
---                      \}" :: forall a. (Foo a) => a -> a
+--   -- this following type is marked as not needing to be checked so a new Abs
+--   -- is not introduced around the definition in type checking, but when
+--   -- called the dictionary value is still passed in for the `dict` argument
+--   foo :: forall a. (Foo a) => a -> a
+--   foo dict = dict.foo
 --
 --   fooString :: {} -> Foo String
---   fooString _ = { foo: \s -> s ++ s }
+--   fooString _ = <TypeClassDictionaryConstructorApp Foo { foo: \s -> s ++ s }>
 --
 --   fooArray :: forall a. (Foo a) => Foo [a]
---   fooArray = { foo: map foo }
+--   fooArray = <TypeClassDictionaryConstructorApp Foo { foo: map foo }>
 --
 --   {- Superclasses -}
 --
---   ...
+--   <TypeClassDeclaration Sub ...>
+--
+--   type Sub a = { sub :: a
+--                , "__superclass_Foo_0" :: {} -> Foo a
+--                }
+--
+--   -- As with `foo` above, this type is unchecked at the declaration
+--   sub :: forall a. (Sub a) => a
+--   sub dict = dict.sub
+--
+--   subString :: {} -> Sub String
+--   subString _ = { sub: "",
+--                 , "__superclass_Foo_0": \_ -> <SuperClassDictionary Foo String>
+--                 }
+--
+-- and finally as the generated javascript:
+--
+--   function Foo(foo) {
+--       this.foo = foo;
+--   };
+--
+--   var foo = function (dict) {
+--       return dict.foo;
+--   };
 --
---   subString :: {} -> { __superclasses :: { "Foo": {} -> Foo String }, sub :: String }
---   subString _ = {
---     __superclasses: {
---       "Foo": \_ -> <dictionary placeholder to be inserted during type checking\>
---     }
---     sub: ""
---   }
+--   var fooString = function (_) {
+--       return new Foo(function (s) {
+--           return s + s;
+--       });
+--   };
+--
+--   var fooArray = function (__dict_Foo_15) {
+--       return new Foo(map(foo(__dict_Foo_15)));
+--   };
+--
+--   function Sub(__superclass_Foo_0, sub) {
+--       this["__superclass_Foo_0"] = __superclass_Foo_0;
+--       this.sub = sub;
+--   };
+--
+--   var sub = function (dict) {
+--       return dict.sub;
+--   };
+--
+--   var subString = function (_) {
+--       return new Sub(fooString, "");
+--   };
 -}
-desugarDecl :: ModuleName -> Declaration -> Desugar (Maybe DeclarationRef, [Declaration])
-desugarDecl mn d@(TypeClassDeclaration name args implies members) = do
+desugarDecl :: ModuleName -> [DeclarationRef] -> Declaration -> Desugar (Maybe DeclarationRef, [Declaration])
+desugarDecl mn _ 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)
-desugarDecl mn d@(TypeInstanceDeclaration name deps className ty members) = do
+desugarDecl mn exps d@(TypeInstanceDeclaration name deps className tys members) = do
   desugared <- lift $ desugarCases members
-  dictDecl <- typeInstanceDictionaryDeclaration name mn deps className ty desugared
-  return $ (Just $ TypeInstanceRef name, [d, dictDecl])
-desugarDecl mn (PositionedDeclaration pos d) = do
-  (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn d
+  dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared
+  let expRef = if isExportedClass className && all isExportedType (getConstructors `concatMap` tys)
+               then Just $ TypeInstanceRef name
+               else Nothing
+  return $ (expRef, [d, dictDecl])
+  where
+  isExportedClass :: Qualified ProperName -> Bool
+  isExportedClass = isExported (elem . TypeClassRef)
+  isExportedType :: Qualified ProperName -> Bool
+  isExportedType = isExported $ \pn -> isJust . find (matchesTypeRef pn)
+  isExported :: (ProperName -> [DeclarationRef] -> Bool) -> Qualified ProperName -> Bool
+  isExported test (Qualified (Just mn') pn) = mn /= mn' || test pn exps
+  isExported _ _ = error "Names should have been qualified in name desugaring"
+  matchesTypeRef :: ProperName -> DeclarationRef -> Bool
+  matchesTypeRef pn (TypeRef pn' _) = pn == pn'
+  matchesTypeRef _ _ = False
+  getConstructors :: Type -> [Qualified ProperName]
+  getConstructors = everythingOnTypes (++) getConstructor
+  getConstructor :: Type -> [Qualified ProperName]
+  getConstructor (TypeConstructor tcname) = [tcname]
+  getConstructor _ = []
+desugarDecl mn exps (PositionedDeclaration pos d) = do
+  (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d
   return (dr, map (PositionedDeclaration pos) ds)
-desugarDecl _ other = return (Nothing, [other])
+desugarDecl _ _ other = return (Nothing, [other])
 
 memberToNameAndType :: Declaration -> (Ident, Type)
 memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)
 memberToNameAndType (PositionedDeclaration _ d) = memberToNameAndType d
 memberToNameAndType _ = error "Invalid declaration in type class definition"
 
-identToProperty :: Ident -> String
-identToProperty (Ident name) = name
-identToProperty (Op op) = op
-
 typeClassDictionaryDeclaration :: ProperName -> [String] -> [(Qualified ProperName, [Type])] -> [Declaration] -> Declaration
 typeClassDictionaryDeclaration name args implies members =
-  let superclassesType = TypeApp tyObject (rowFromList ([ (fieldName, function unit tySynApp)
-                                                        | (index, (superclass, tyArgs)) <- zip [0..] implies
-                                                        , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs
-                                                        , let fieldName = mkSuperclassDictionaryName superclass index
-                                                        ], REmpty))
-      members' = map (first identToProperty . memberToNameAndType) members
-      mtys = if null implies then members' else (C.__superclasses, superclassesType) : members'
+  let superclassTypes = [ (fieldName, function unit tySynApp)
+                        | (index, (superclass, tyArgs)) <- zip [0..] implies
+                        , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs
+                        , let fieldName = mkSuperclassDictionaryName superclass index
+                        ]
+      members' = map (first runIdent . memberToNameAndType) members
+      mtys = members' ++ superclassTypes
   in TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (mtys, REmpty))
 
 typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration
@@ -151,7 +208,7 @@ typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =
 typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"
 
 mkSuperclassDictionaryName :: Qualified ProperName -> Integer -> String
-mkSuperclassDictionaryName pn index = show pn ++ "_" ++ show index
+mkSuperclassDictionaryName pn index = C.__superclass_ ++ show pn ++ "_" ++ show index
 
 unit :: Type
 unit = TypeApp tyObject REmpty
@@ -175,25 +232,26 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =
       -- Replace the type arguments with the appropriate types in the member types
       let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
       -- Create values for the type instance members
-      memberNames <- map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls
+      memberNames <- map (first runIdent) <$> mapM (memberToNameAndValue memberTypes) decls
       -- Create the type of the dictionary
       -- The type is an object type, but depending on type instance dependencies, may be constrained.
       -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary
       -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no
       -- dependencies, we introduce an unnamed function parameter.
-      let superclasses = ObjectLiteral
+      let superclasses =
             [ (fieldName, Abs (Left (Ident "_")) (SuperClassDictionary superclass tyArgs))
             | (index, (superclass, suTyArgs)) <- zip [0..] implies
             , let tyArgs = map (replaceAllTypeVars (zip args tys)) suTyArgs
             , let fieldName = mkSuperclassDictionaryName superclass index
             ]
 
-      let memberNames' = if null implies then memberNames else (C.__superclasses, superclasses) : memberNames
+      let memberNames' = ObjectLiteral (memberNames ++ superclasses)
           dictTy = foldl TypeApp (TypeConstructor className) tys
           constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)
-          dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'
-
-      return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)
+          dict = TypeClassDictionaryConstructorApp className memberNames'
+          dict' = if null deps then Abs (Left (Ident "_")) dict else dict
+          result = ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict' constrainedTy)
+      return result
 
   where
 
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index 63acafe..5aacf86 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -39,21 +39,21 @@ import Language.PureScript.TypeClassDictionaries
 import Language.PureScript.Environment
 import Language.PureScript.Errors
 
-addDataType :: ModuleName -> ProperName -> [String] -> [(ProperName, [Type])] -> Kind -> Check ()
-addDataType moduleName name args dctors ctorKind = do
+addDataType :: ModuleName -> DataDeclType -> ProperName -> [String] -> [(ProperName, [Type])] -> Kind -> Check ()
+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) <>) $
-      addDataConstructor moduleName name args dctor tys
+      addDataConstructor moduleName dtype name args dctor tys
 
-addDataConstructor :: ModuleName -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
-addDataConstructor moduleName name args dctor tys = do
+addDataConstructor :: ModuleName -> DataDeclType -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
+addDataConstructor moduleName dtype name args dctor tys = do
   env <- getEnv
   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) (name, polyType) (dataConstructors env) }
+  putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType) (dataConstructors env) }
 
 addTypeSynonym :: ModuleName -> ProperName -> [String] -> Type -> Kind -> Check ()
 addTypeSynonym moduleName name args ty kind = do
@@ -71,7 +71,7 @@ valueIsNotDefined moduleName name = do
 addValue :: ModuleName -> Ident -> Type -> NameKind -> Check ()
 addValue moduleName name ty nameKind = do
   env <- getEnv
-  putEnv (env { names = M.insert (moduleName, name) (ty, nameKind) (names env) })
+  putEnv (env { names = M.insert (moduleName, name) (ty, nameKind, Defined) (names env) })
 
 addTypeClass :: ModuleName -> ProperName -> [String] -> [(Qualified ProperName, [Type])] -> [Declaration] -> Check ()
 addTypeClass moduleName pn args implies ds =
@@ -111,19 +111,25 @@ checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance hea
 --
 typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]
 typeCheckAll _ _ [] = return []
-typeCheckAll mainModuleName moduleName (d@(DataDeclaration name args dctors) : rest) = do
+typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
   rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
+    when (dtype == Newtype) $ checkNewtype dctors
     ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
-    addDataType moduleName name args dctors ctorKind
+    addDataType moduleName dtype name args dctors ctorKind
   ds <- typeCheckAll mainModuleName moduleName rest
   return $ d : ds
+  where
+  checkNewtype :: [(ProperName, [Type])] -> Check ()
+  checkNewtype [(_, [_])] = return ()
+  checkNewtype [(_, _)] = throwError . strMsg $ "newtypes constructors must have a single argument"
+  checkNewtype _ = throwError . strMsg $ "newtypes must have a single constructor"
 typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
   rethrow (strMsg "Error in data binding group" <>) $ 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)
-    forM_ (zip dataDecls data_ks) $ \((name, args, dctors), ctorKind) ->
-      addDataType moduleName name args dctors ctorKind
+    (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)
+    forM_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) ->
+      addDataType moduleName dtype name args dctors ctorKind
     forM_ (zip syns syn_ks) $ \((name, args, ty), kind) ->
       addTypeSynonym moduleName name args ty kind
   ds <- typeCheckAll mainModuleName moduleName rest
@@ -132,7 +138,7 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re
   toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
   toTypeSynonym (PositionedDeclaration _ d') = toTypeSynonym d'
   toTypeSynonym _ = Nothing
-  toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
+  toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)
   toDataDecl (PositionedDeclaration _ d') = toDataDecl d'
   toDataDecl _ = Nothing
 typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
@@ -174,7 +180,7 @@ typeCheckAll mainModuleName moduleName (d@(ExternDeclaration importTy name _ ty)
     guardWith (strMsg "Expected kind *") $ kind == Star
     case M.lookup (moduleName, name) (names env) of
       Just _ -> throwError . strMsg $ show name ++ " is already defined"
-      Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Extern importTy) (names env) })
+      Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Extern importTy, Defined) (names env) })
   ds <- typeCheckAll mainModuleName moduleName rest
   return $ d : ds
 typeCheckAll mainModuleName moduleName (d@(FixityDeclaration _ name) : rest) = do
diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs
index 43b80d4..8c8731d 100644
--- a/src/Language/PureScript/TypeChecker/Monad.hs
+++ b/src/Language/PureScript/TypeChecker/Monad.hs
@@ -39,7 +39,7 @@ import qualified Data.Map as M
 -- |
 -- Temporarily bind a collection of names to values
 --
-bindNames :: (MonadState CheckState m) => M.Map (ModuleName, Ident) (Type, NameKind) -> m a -> m a
+bindNames :: (MonadState CheckState m) => M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> m a -> m a
 bindNames newNames action = do
   orig <- get
   modify $ \st -> st { checkEnv = (checkEnv st) { names = newNames `M.union` (names . checkEnv $ st) } }
@@ -79,9 +79,9 @@ getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get
 -- |
 -- Temporarily bind a collection of names to local variables
 --
-bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type)] -> m a -> m a
+bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type, NameVisibility)] -> m a -> m a
 bindLocalVariables moduleName bindings =
-  bindNames (M.fromList $ flip map bindings $ \(name, ty) -> ((moduleName, name), (ty, LocalVariable)))
+  bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, LocalVariable, visibility)))
 
 -- |
 -- Temporarily bind a collection of names to local type variables
@@ -91,6 +91,17 @@ bindLocalTypeVariables moduleName bindings =
   bindTypes (M.fromList $ flip map bindings $ \(pn, kind) -> (Qualified (Just moduleName) pn, (kind, LocalTypeVariable)))
 
 -- |
+-- Update the visibility of all names to Defined
+--
+makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a
+makeBindingGroupVisible action = do
+  orig <- get
+  modify $ \st -> st { checkEnv = (checkEnv st) { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names . checkEnv $ st) } }
+  a <- action
+  modify $ \st -> st { checkEnv = (checkEnv st) { names = names . checkEnv $ orig } }
+  return a
+
+-- |
 -- 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
@@ -98,7 +109,27 @@ lookupVariable currentModule (Qualified moduleName var) = do
   env <- getEnv
   case M.lookup (fromMaybe currentModule moduleName, var) (names env) of
     Nothing -> throwError . strMsg $ show var ++ " is undefined"
-    Just (ty, _) -> return ty
+    Just (ty, _, _) -> return ty
+
+-- |
+-- 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 currentModule (Qualified moduleName var) = do
+  env <- getEnv
+  case M.lookup (fromMaybe currentModule moduleName, var) (names env) of
+    Nothing -> throwError . strMsg $ show var ++ " is undefined"
+    Just (_, _, vis) -> return vis
+
+-- |
+-- Assert that a name is visible
+--
+checkVisibility :: (Error e, 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
+    Undefined -> throwError . strMsg $ show var ++ " may not be defined in the current scope."
+    _ -> return ()
 
 -- |
 -- Lookup the kind of a type by name in the @Environment@
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 3b9f266..78a4d0b 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -194,7 +194,7 @@ typesOf mainModuleName moduleName vals = do
   -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
   tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts
 
-typeDictionaryForBindingGroup :: ModuleName -> [(Ident, Value)] -> UnifyT Type Check ([(Ident, (Value, Maybe (Type, Bool)))], M.Map (ModuleName, Ident) (Type, NameKind), [(Ident, Type)])
+typeDictionaryForBindingGroup :: ModuleName -> [(Ident, Value)] -> UnifyT Type Check ([(Ident, (Value, Maybe (Type, Bool)))], M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility), [(Ident, Type)])
 typeDictionaryForBindingGroup moduleName vals = do
   let
     -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed
@@ -212,15 +212,14 @@ typeDictionaryForBindingGroup moduleName vals = do
     -- Make a map of names to the unification variables of untyped declarations
     untypedDict = zip (map fst untyped) untypedNames
     -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking
-    dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable))) $ typedDict ++ untypedDict)
+    dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable, Undefined))) $ typedDict ++ untypedDict)
   return (es, dict, untypedDict)
 
-typeForBindingGroupElement :: ModuleName -> (Ident, (Value, Maybe (Type, Bool))) -> M.Map (ModuleName, Ident) (Type, NameKind) -> [(Ident, Type)] -> UnifyT Type Check (Ident, (Value, Type))
-typeForBindingGroupElement moduleName e@(_, (val, _)) dict untypedDict = do
+typeForBindingGroupElement :: ModuleName -> (Ident, (Value, Maybe (Type, Bool))) -> M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> [(Ident, Type)] -> UnifyT Type Check (Ident, (Value, Type))
+typeForBindingGroupElement moduleName el dict untypedDict =
   -- If the declaration is a function, it has access to other values in the binding group.
   -- If not, the generated code might fail at runtime since those values might be undefined.
-  let dict' = if isFunction val then dict else M.empty
-  case e of
+  case el of
     -- Typed declarations
     (ident, (val', Just (ty, checkType))) -> do
       -- Kind check
@@ -228,27 +227,18 @@ typeForBindingGroupElement moduleName e@(_, (val, _)) dict untypedDict = do
       guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
       -- Check the type with the new names in scope
       ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty
-      val'' <- bindNames dict' $ if checkType
-                               then TypedValue True <$> check val' ty' <*> pure ty'
-                               else return (TypedValue False val' ty')
+      val'' <- if checkType
+               then bindNames dict $ TypedValue True <$> check val' ty' <*> pure ty'
+               else return (TypedValue False val' ty')
       return (ident, (val'', ty'))
     -- Untyped declarations
     (ident, (val', Nothing)) -> do
       -- Infer the type with the new names in scope
-      TypedValue _ val'' ty <- bindNames dict' $ infer val'
+      TypedValue _ val'' ty <- bindNames dict $ infer val'
       ty =?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)
       return (ident, (TypedValue True val'' ty, ty))
 
 -- |
--- Check if a value introduces a function
---
-isFunction :: Value -> Bool
-isFunction (Abs _ _) = True
-isFunction (TypedValue _ val _) = isFunction val
-isFunction (PositionedValue _ val) = isFunction val
-isFunction _ = False
-
--- |
 -- Check if a value contains a type annotation
 --
 isTyped :: (Ident, Value) -> (Ident, (Value, Maybe (Type, Bool)))
@@ -317,7 +307,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
     filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
     filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True
     filterModule _ = False
-	
+
     solve context' (className, tys) trySuperclasses =
       let
         dicts = go trySuperclasses className tys
@@ -336,7 +326,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
 	    , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)
 	    -- Solve any necessary subgoals
 	    , args <- solveSubgoals subst (tcdDependencies tcd) ] ++
-	
+
 	    -- Look for implementations via superclasses
 	    [ SubclassDictionaryValue suDict superclass index
 	    | trySuperclasses'
@@ -350,7 +340,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
 	    -- Finally, satisfy the subclass constraint
 	    , args' <- maybeToList $ mapM (flip lookup subst) args
 	    , suDict <- go True subclassName args' ]
-	
+
 	  -- Create dictionaries for subgoals which still need to be solved by calling go recursively
 	  -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
 	  -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
@@ -370,8 +360,8 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
 	  dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
 	  dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
 	  dictionaryValueToValue (SubclassDictionaryValue dict superclassName index) =
-	    App (Accessor (show superclassName ++ "_" ++ show index)
-	                  (Accessor C.__superclasses (dictionaryValueToValue dict)))
+	    App (Accessor (C.__superclass_ ++ show superclassName ++ "_" ++ show index)
+	                  (dictionaryValueToValue dict))
 	        (ObjectLiteral [])
 	  -- Ensure that a substitution is valid
 	  verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]
@@ -630,7 +620,7 @@ infer' (Accessor prop val) = do
 infer' (Abs (Left arg) ret) = do
   ty <- fresh
   Just moduleName <- checkCurrentModule <$> get
-  bindLocalVariables moduleName [(arg, ty)] $ do
+  makeBindingGroupVisible $ bindLocalVariables moduleName [(arg, ty, Defined)] $ do
     body@(TypedValue _ _ bodyTy) <- infer' ret
     return $ TypedValue True (Abs (Left arg) body) $ function ty bodyTy
 infer' (Abs (Right _) _) = error "Binder was not desugared"
@@ -640,6 +630,7 @@ infer' (App f arg) = do
   return $ TypedValue True app ret
 infer' (Var var) = do
   Just moduleName <- checkCurrentModule <$> get
+  checkVisibility moduleName var
   ty <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable moduleName $ var
   case ty of
     ConstrainedType constraints ty' -> do
@@ -650,8 +641,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 ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty
-                       return $ TypedValue True v ty'
+    Just (_, _, ty) -> do ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty
+                          return $ TypedValue True v ty'
 infer' (Case vals binders) = do
   ts <- mapM infer vals
   ret <- fresh
@@ -680,29 +671,29 @@ infer' (PositionedValue pos val) = rethrowWithPosition pos $ infer' val
 infer' _ = error "Invalid argument to infer"
 
 inferLetBinding :: [Declaration] -> [Declaration] -> Value -> (Value -> UnifyT Type Check Value) -> UnifyT Type Check ([Declaration], Value)
-inferLetBinding seen [] ret j = (,) seen <$> j ret
+inferLetBinding seen [] ret j = (,) seen <$> makeBindingGroupVisible (j ret)
 inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing tv@(TypedValue checkType val ty) : rest) ret j = do
   Just moduleName <- checkCurrentModule <$> get
   kind <- liftCheck $ kindOf moduleName ty
   guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
-  let dict = if isFunction val then M.singleton (moduleName, ident) (ty, nameKind) else M.empty
+  let dict = M.singleton (moduleName, ident) (ty, nameKind, Undefined)
   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty
   TypedValue _ val' ty'' <- if checkType then bindNames dict (check val ty') else return tv
-  bindNames (M.singleton (moduleName, ident) (ty'', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty'')]) rest ret j
+  bindNames (M.singleton (moduleName, ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty'')]) rest ret j
 inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing val : rest) ret j = do
   valTy <- fresh
   Just moduleName <- checkCurrentModule <$> get
-  let dict = if isFunction val then M.singleton (moduleName, ident) (valTy, nameKind) else M.empty
+  let dict = M.singleton (moduleName, ident) (valTy, nameKind, Undefined)
   TypedValue _ val' valTy' <- bindNames dict $ infer val
   valTy =?= valTy'
-  bindNames (M.singleton (moduleName, ident) (valTy', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing val']) rest ret j
+  bindNames (M.singleton (moduleName, ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing val']) rest ret j
 inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do
   Just moduleName <- checkCurrentModule <$> get
   (es, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)
   ds' <- forM es $ \e -> do
     (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict
     return $ (ident, LocalVariable, val')
-  bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j
+  makeBindingGroupVisible $ bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j
 inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = rethrowWithPosition pos $ do
   ((d' : ds'), val') <- inferLetBinding seen (d : ds) ret j
   return (PositionedDeclaration pos d' : ds', val')
@@ -735,9 +726,9 @@ 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' <- replaceAllTypeSynonyms fn
+      fn' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ fn
       go binders fn'
         where
         go [] ty' = do
@@ -786,7 +777,7 @@ checkBinders _ _ [] = return []
 checkBinders nvals ret (CaseAlternative binders grd val : bs) = do
   Just moduleName <- checkCurrentModule <$> get
   m1 <- M.unions <$> zipWithM inferBinder nvals binders
-  r <- bindLocalVariables moduleName (M.toList m1) $ do
+  r <- bindLocalVariables moduleName [ (name, ty, Defined) | (name, ty) <- M.toList m1 ] $ do
     val' <- TypedValue True <$> check val ret <*> pure ret
     case grd of
       Nothing -> return $ CaseAlternative binders Nothing val'
@@ -861,7 +852,7 @@ check' val t@(ConstrainedType constraints ty) = do
   dictNames <- forM constraints $ \(Qualified _ (ProperName className), _) -> do
     n <- liftCheck freshDictionaryName
     return $ Ident $ "__dict_" ++ className ++ "_" ++ show n
-  val' <- withTypeClassDictionaries (zipWith (\name (className, instanceTy) ->
+  val' <- makeBindingGroupVisible $ withTypeClassDictionaries (zipWith (\name (className, instanceTy) ->
     TypeClassDictionaryInScope name className instanceTy Nothing TCDRegular) (map (Qualified Nothing) dictNames)
       constraints) $ check val ty
   return $ TypedValue True (foldr (Abs . Left) val' dictNames) t
@@ -886,7 +877,7 @@ check' (ArrayLiteral vals) t@(TypeApp a ty) = do
   return $ TypedValue True array t
 check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) | t == tyFunction = do
   Just moduleName <- checkCurrentModule <$> get
-  ret' <- bindLocalVariables moduleName [(arg, argTy)] $ check ret retTy
+  ret' <- makeBindingGroupVisible $ bindLocalVariables moduleName [(arg, argTy, Defined)] $ check ret retTy
   return $ TypedValue True (Abs (Left arg) ret') ty
 check' (Abs (Right _) _) _ = error "Binder was not desugared"
 check' (App f arg) ret = do
@@ -895,6 +886,7 @@ check' (App f arg) ret = do
   return $ TypedValue True app ret
 check' v@(Var var) ty = do
   Just moduleName <- checkCurrentModule <$> get
+  checkVisibility moduleName var
   repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable moduleName $ var
   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty
   v' <- subsumes (Just v) repl ty'
@@ -939,6 +931,9 @@ check' (ObjectLiteral ps) t@(TypeApp obj row) | obj == tyObject = do
   ensureNoDuplicateProperties ps
   ps' <- checkProperties ps row False
   return $ TypedValue True (ObjectLiteral ps') t
+check' (TypeClassDictionaryConstructorApp name ps) t = do
+  ps' <- check' ps t
+  return $ TypedValue True (TypeClassDictionaryConstructorApp name ps') t
 check' (ObjectUpdate obj ps) t@(TypeApp o row) | o == tyObject = do
   ensureNoDuplicateProperties ps
   us <- zip (map fst ps) <$> replicateM (length ps) fresh
@@ -956,7 +951,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
@@ -1013,7 +1008,9 @@ 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 :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)
-checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (Just (ValueError fn)) <>) $ checkFunctionApplication' fn fnTy arg ret
+checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (Just (ValueError fn)) <>) $ do
+  subst <- unifyCurrentSubstitution <$> UnifyT get
+  checkFunctionApplication' fn (subst $? fnTy) arg (($?) subst <$> ret)
   where
   errorMessage = "Error applying function of type "
     ++ prettyPrintType fnTy
@@ -1025,10 +1022,12 @@ checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (J
 checkFunctionApplication' :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)
 checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do
   tyFunction' =?= tyFunction
-  _ <- maybe (return Nothing) (subsumes Nothing retTy) ret
-  subst <- unifyCurrentSubstitution <$> UnifyT get
-  arg' <- check arg (subst $? argTy)
-  return (retTy, App fn arg')
+  arg' <- check arg argTy
+  case ret of
+    Nothing -> return (retTy, App fn arg')
+    Just ret' -> do
+      Just app' <- subsumes (Just (App fn arg')) retTy ret'
+      return (retTy, app')
 checkFunctionApplication' fn (ForAll ident ty _) arg ret = do
   replaced <- replaceVarWithUnknown ident ty
   checkFunctionApplication fn replaced arg ret
@@ -1088,8 +1087,7 @@ subsumes' val ty1 (SaturatedTypeSynonym name tyArgs) = do
   subsumes val ty1 ty2
 subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
   dicts <- getTypeClassDictionaries
-  _ <- subsumes' Nothing ty1 ty2
-  return . Just $ foldl App val (map (flip (TypeClassDictionary True) dicts) constraints)
+  subsumes' (Just $ foldl App val (map (flip (TypeClassDictionary True) dicts) constraints)) ty1 ty2
 subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject = do
   let
     (ts1, r1') = rowToList r1