version 0.4.160.4.16

13 files changed, 130 insertions, 147 deletions

diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index 1669adf..b867a23 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -8,6 +8,9 @@ module Prelude where
 
   on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
   on f g x y = g x `f` g y
+  
+  asTypeOf :: forall a. a -> a -> a
+  asTypeOf x _ = x
 
   infixr 9 >>>
   infixr 9 <<<
diff --git a/purescript.cabal b/purescript.cabal
index 6ad4336..3143723 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.4.15.1
+version: 0.4.16
 cabal-version: >=1.8
 build-type: Custom
 license: MIT
diff --git a/src/Language/PureScript/CodeGen/Common.hs b/src/Language/PureScript/CodeGen/Common.hs
index 288ba23..661ce59 100644
--- a/src/Language/PureScript/CodeGen/Common.hs
+++ b/src/Language/PureScript/CodeGen/Common.hs
@@ -32,7 +32,6 @@ identToJs :: Ident -> String
 identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
 identToJs (Ident name) = concatMap identCharToString name
 identToJs (Op op) = concatMap identCharToString op
-identToJs (Escaped name) = name
 
 -- |
 -- Attempts to find a human-readable name for a symbol, if none has been specified returns the
@@ -130,5 +129,12 @@ nameIsJsReserved name =
               , "with"
               , "yield" ]
 
+-- |
+-- Test if a string is a valid JS identifier (may return false negatives)
+--
+isIdent :: String -> Bool
+isIdent s@(first : rest) | not (nameIsJsReserved s) && isAlpha first && all isAlphaNum rest = True
+isIdent _ = False
+
 moduleNameToJs :: ModuleName -> String
 moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 6ccaabb..9040722 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -19,7 +19,8 @@ module Language.PureScript.CodeGen.JS (
     module AST,
     declToJs,
     moduleToJs,
-    wrapExportsContainer
+    wrapExportsContainer,
+    isIdent
 ) where
 
 import Data.Maybe (fromMaybe, mapMaybe)
@@ -90,7 +91,7 @@ declToJs _ _ _ _ = Nothing
 -- module.
 --
 exportToJs :: DeclarationRef -> [JS]
-exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Escaped . runProperName)
+exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)
 exportToJs (ValueRef name) = [export name]
 exportToJs (TypeInstanceRef name) = [export name]
 exportToJs _ = []
@@ -115,9 +116,12 @@ var = JSVar . identToJs
 -- indexer is returned.
 --
 accessor :: Ident -> JS -> JS
-accessor (Ident name) | nameIsJsReserved name = JSIndexer (JSStringLiteral name)
+accessor (Ident prop) = accessorString prop
 accessor (Op op) = JSIndexer (JSStringLiteral op)
-accessor ident = JSAccessor (identToJs ident)
+
+accessorString :: String -> JS -> JS
+accessorString prop | isIdent prop = JSAccessor prop
+                    | otherwise = JSIndexer (JSStringLiteral prop)
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for a value or expression.
@@ -132,13 +136,14 @@ valueToJs opts m e (ObjectUpdate o ps) = extendObj (valueToJs opts m e o) (map (
 valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . runProperName) name
 valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)
 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) = JSAccessor prop (valueToJs opts m e val)
+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) [valueToJs opts m e arg]
 valueToJs opts m e (Let ds val) = JSApp (JSFunction Nothing [] (JSBlock (concat (mapMaybe (flip (declToJs opts m) e) ds) ++ [JSReturn $ valueToJs opts m e val]))) []
 valueToJs opts m e (Abs (Left arg) val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])
 valueToJs opts m e (TypedValue _ (Abs (Left arg) val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
 valueToJs _ m _ (Var ident) = varToJs m ident
 valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
+valueToJs opts m e (PositionedValue _ val) = valueToJs opts m e val
 valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
 valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
 
@@ -198,7 +203,7 @@ runtimeTypeChecks arg ty =
     let
       (pairs, _) = rowToList row
     in
-      typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (JSAccessor prop val) ty') pairs
+      typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (accessorString prop val) ty') pairs
   argumentCheck val (TypeApp (TypeApp t _) _) | t == tyFunction = [typeCheck val "function"]
   argumentCheck val (ForAll _ ty' _) = argumentCheck val ty'
   argumentCheck _ _ = []
@@ -283,7 +288,7 @@ binderToJs m e varName done (ObjectBinder bs) = go done bs
     propVar <- fresh
     done'' <- go done' bs'
     js <- binderToJs m e propVar done'' binder
-    return (JSVariableIntroduction propVar (Just (JSAccessor prop (JSVar varName))) : js)
+    return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
 binderToJs m e varName done (ArrayBinder bs) = do
   js <- go done 0 bs
   return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
index fd7034c..2111774 100644
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -19,8 +19,6 @@ module Language.PureScript.CodeGen.JS.AST where
 
 import Data.Data
 
-
-
 -- |
 -- Built-in unary operators
 --
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
index 673a08d..599e48f 100644
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -102,11 +102,7 @@ data NameKind
   -- |
   -- A type class dictionary, generated during desugaring of type class declarations
   --
-  | TypeInstanceDictionaryValue
-  -- |
-  -- A type instance member, generated during desugaring of type class declarations
-  --
-  | TypeInstanceMember deriving (Show, Eq, Data, Typeable)
+  | TypeInstanceDictionaryValue deriving (Show, Eq, Data, Typeable)
 
 -- |
 -- The kinds of a type
diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs
index 3f87e12..a384266 100644
--- a/src/Language/PureScript/Names.hs
+++ b/src/Language/PureScript/Names.hs
@@ -19,7 +19,6 @@ module Language.PureScript.Names where
 
 import Data.List
 import Data.Data
-import Data.Function (on)
 
 -- |
 -- Names for value identifiers
@@ -32,27 +31,11 @@ data Ident
   -- |
   -- A symbolic name for an infix operator
   --
-  | Op String
-  -- |
-  -- An escaped name
-  --
-  | Escaped String deriving (Data, Typeable)
+  | Op String deriving (Eq, Ord, Data, Typeable)
 
 instance Show Ident where
   show (Ident s) = s
   show (Op op) = '(':op ++ ")"
-  show (Escaped s) = s
-
-instance Eq Ident where
-  Ident s1   == Ident s2   = s1 == s2
-  Op s1      == Op s2      = s1 == s2
-  Escaped s1 == Escaped s2 = s1 == s2
-  Ident s1   == Escaped s2 = s1 == s2
-  Escaped s1 == Ident s2   = s1 == s2
-  _          == _          = False
-
-instance Ord Ident where
-  compare = compare `on` show
 
 -- |
 -- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index af01730..3ff4fec 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -227,7 +227,7 @@ parseObjectLiteral :: P.Parsec String ParseState Value
 parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)
 
 parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)
-parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
+parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifier <|> C.stringLiteral) <* C.indented <* C.colon)
                               <*> (C.indented *> parseValue)
 
 parseAbs :: P.Parsec String ParseState Value
@@ -290,14 +290,14 @@ parseValueAtom = P.choice
 
 parsePropertyUpdate :: P.Parsec String ParseState (String, Value)
 parsePropertyUpdate = do
-  name <- C.lexeme C.identifier
+  name <- C.lexeme (C.identifier <|> C.stringLiteral)
   _ <- C.lexeme $ C.indented *> P.char '='
   value <- C.indented *> parseValue
   return (name, value)
 
 parseAccessor :: Value -> P.Parsec String ParseState Value
 parseAccessor (Constructor _) = P.unexpected "constructor"
-parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> C.identifier) <*> pure obj
+parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifier <|> C.stringLiteral)) <*> pure obj
 
 parseDo :: P.Parsec String ParseState Value
 parseDo = do
@@ -372,7 +372,7 @@ parseNullBinder = C.lexeme (P.char '_') *> P.notFollowedBy C.identLetter *> retu
 
 parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)
 parseIdentifierAndBinder = do
-  name <- C.lexeme C.identifier
+  name <- C.lexeme (C.identifier <|> C.stringLiteral)
   _ <- C.lexeme $ C.indented *> P.char '='
   binder <- C.indented *> parseBinder
   return (name, binder)
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
index a3d2c70..76fab97 100644
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -118,7 +118,7 @@ parsePolyType :: P.Parsec String ParseState Type
 parsePolyType = parseAnyType
 
 parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)
-parseNameAndType p = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> p
+parseNameAndType p = (,) <$> (indented *> (identifier <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p
 
 parseRowEnding :: P.Parsec String ParseState Type
 parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index 47b353c..3ab0153 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -18,6 +18,7 @@ module Language.PureScript.Pretty.JS (
 ) where
 
 import Language.PureScript.Pretty.Common
+import Language.PureScript.CodeGen.JS (isIdent)
 import Language.PureScript.CodeGen.JS.AST
 
 import Data.List
@@ -46,13 +47,17 @@ literals = mkPattern' match
   match (JSObjectLiteral ps) = fmap concat $ sequence
     [ return "{\n"
     , withIndent $ do
-        jss <- forM ps $ \(key, value) -> fmap ((key ++ ": ") ++) . prettyPrintJS' $ value
+        jss <- forM ps $ \(key, value) -> fmap ((objectPropertyToString key ++ ": ") ++) . prettyPrintJS' $ value
         indentString <- currentIndent
         return $ intercalate ", \n" $ map (indentString ++) jss
     , return "\n"
     , currentIndent
     , return "}"
     ]
+    where
+    objectPropertyToString :: String -> String
+    objectPropertyToString s | isIdent s = s
+                             | otherwise = show s
   match (JSBlock sts) = fmap concat $ sequence
     [ return "{\n"
     , withIndent $ prettyStatements sts
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index e7ea5c5..8202007 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -47,6 +47,7 @@ literals = mkPattern' match
   match (ObjectLiteral ps) = fmap concat $ sequence
     [ return "{\n"
     , withIndent $ prettyPrintMany prettyPrintObjectProperty ps
+    , return "\n"
     , currentIndent
     , return "}"
     ]
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index b836e5b..f02a063 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -15,8 +15,7 @@
 -----------------------------------------------------------------------------
 
 module Language.PureScript.Sugar.TypeClasses (
-  desugarTypeClasses,
-  mkDictionaryEntryName
+  desugarTypeClasses
 ) where
 
 import Language.PureScript.Declarations
@@ -30,12 +29,12 @@ import Language.PureScript.CodeGen.Common (identToJs)
 
 import Control.Applicative
 import Control.Monad.State
-import Control.Arrow (second)
+import Control.Arrow (first, second)
 import Data.Maybe (catMaybes)
 
 import qualified Data.Map as M
 
-type MemberMap = M.Map (ModuleName, ProperName) ([String], [(String, Type)])
+type MemberMap = M.Map (ModuleName, ProperName) ([String], [(Ident, Type)])
 
 type Desugar = StateT MemberMap (Either ErrorStack)
 
@@ -65,10 +64,10 @@ desugarModule _ = error "Exports should have been elaborated in name desugaring"
 --   class Foo a where
 --     foo :: a -> a
 --
---   instance Foo String where
+--   instance fooString :: Foo String where
 --     foo s = s ++ s
 --
---   instance (Foo a) => Foo [a] where
+--   instance fooArray :: (Foo a) => Foo [a] where
 --     foo = map foo
 --
 -- becomes
@@ -79,16 +78,11 @@ desugarModule _ = error "Exports should have been elaborated in name desugaring"
 --                      \  return dict.foo;\
 --                      \}" :: forall a. (Foo a) => a -> a
 --
---   __Test_Foo_string_foo = (\s -> s ++ s) :: String -> String
+--   fooString :: {} -> Foo String
+--   fooString _ = { foo: \s -> s ++ s }
 --
---   __Test_Foo_string :: {} -> Foo String
---   __Test_Foo_string = { foo: __Test_Foo_string_foo :: String -> String (unchecked) }
---
---   __Test_Foo_array_foo :: forall a. (Foo a) => [a] -> [a]
---   __Test_Foo_array_foo _1 = map (foo _1)
---
---   __Test_Foo_array :: forall a. Foo a -> Foo [a]
---   __Test_Foo_array _1 = { foo: __Test_Foo_array_foo _1 :: [a] -> [a] (unchecked) }
+--   fooArray :: forall a. (Foo a) => Foo [a]
+--   fooArray = { foo: map foo }
 --
 desugarDecl :: ModuleName -> Declaration -> Desugar (Maybe DeclarationRef, [Declaration])
 desugarDecl mn d@(TypeClassDeclaration name args members) = do
@@ -97,27 +91,30 @@ desugarDecl mn d@(TypeClassDeclaration name args members) = do
   return $ (Nothing, d : typeClassDictionaryDeclaration name args members : map (typeClassMemberToDictionaryAccessor mn name args) members)
 desugarDecl mn d@(TypeInstanceDeclaration name deps className ty members) = do
   desugared <- lift $ desugarCases members
-  entries <- mapM (typeInstanceDictionaryEntryDeclaration name mn deps className ty) desugared
   dictDecl <- typeInstanceDictionaryDeclaration name mn deps className ty desugared
-  return $ (Just $ TypeInstanceRef name, d : entries ++ [dictDecl])
+  return $ (Just $ TypeInstanceRef name, [d, dictDecl])
 desugarDecl mn (PositionedDeclaration pos d) = do
   (dr, ds) <- desugarDecl mn d
   return (dr, map (PositionedDeclaration pos) ds)
 desugarDecl _ other = return (Nothing, [other])
 
-memberToNameAndType :: Declaration -> (String, Type)
-memberToNameAndType (TypeDeclaration ident ty) = (identToJs ident, ty)
+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] -> [Declaration] -> Declaration
 typeClassDictionaryDeclaration name args members =
-  TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map memberToNameAndType members, REmpty))
+  TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map (first identToProperty . memberToNameAndType) members, REmpty))
 
 typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration
 typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =
   ExternDeclaration TypeClassAccessorImport ident
-    (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar "dict"))])))
+    (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))
     (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))
 typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =
   PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d
@@ -126,54 +123,39 @@ typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type
 typeInstanceDictionaryDeclaration :: Ident -> ModuleName -> [(Qualified ProperName, [Type])] -> Qualified ProperName -> [Type] -> [Declaration] -> Desugar Declaration
 typeInstanceDictionaryDeclaration name mn deps className tys decls = do
   m <- get
+
+  -- Lookup the type arguments and member types for the type class
   (args, instanceTys) <- lift $ maybe (Left $ mkErrorStack ("Type class " ++ show className ++ " is undefined") Nothing) Right
                         $ M.lookup (qualify mn className) m
+
+  -- Replace the type arguments with the appropriate types in the member types
   let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
-  let entryName = Escaped (show name)
-  memberNames <- mapM (memberToNameAndValue memberTypes) decls
-  return $ ValueDeclaration entryName TypeInstanceDictionaryValue [] Nothing
-    (TypedValue True
-      (foldr (Abs . (\n -> Left . Ident $ '_' : show n)) (ObjectLiteral memberNames) [1..max 1 (length deps)])
-      (quantify (if null deps then
-                   function unit (foldl TypeApp (TypeConstructor className) tys)
-                 else
-                   foldr (function . (\(pn, tys') -> foldl TypeApp (TypeConstructor pn) tys')) (foldl TypeApp (TypeConstructor className) tys) deps))
-    )
+  -- Create values for the type instance members
+  memberNames <- map (first identToProperty) <$> 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 dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, REmpty))
+      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)
   where
   unit :: Type
   unit = TypeApp tyObject REmpty
 
-  memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)
-  memberToNameAndValue tys' (ValueDeclaration ident _ _ _ _) = do
-    memberType <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup (identToJs ident) tys'
-    memberName <- mkDictionaryEntryName name ident
-    return (identToJs ident, TypedValue False
-                               (foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
-                               (quantify memberType))
+  memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)
+  memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do
+    _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup ident tys'
+    let memberValue = typeInstanceDictionaryEntryValue d
+    return (ident, memberValue)
   memberToNameAndValue tys' (PositionedDeclaration pos d) = do
     (ident, val) <- memberToNameAndValue tys' d
     return (ident, PositionedValue pos val)
   memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"
 
-typeInstanceDictionaryEntryDeclaration :: Ident -> ModuleName -> [(Qualified ProperName, [Type])] -> Qualified ProperName -> [Type] -> Declaration -> Desugar Declaration
-typeInstanceDictionaryEntryDeclaration name mn deps className tys (ValueDeclaration ident _ [] _ val) = do
-  m <- get
-  valTy <- lift $ do (args, members) <- lookupTypeClass m
-                     ty' <- lookupIdent members
-                     return $ replaceAllTypeVars (zip args tys) ty'
-  entryName <- mkDictionaryEntryName name ident
-  return $ ValueDeclaration entryName TypeInstanceMember [] Nothing
-    (TypedValue True val (quantify (if null deps then valTy else ConstrainedType deps valTy)))
-  where
-  lookupTypeClass m = maybe (Left $ mkErrorStack ("Type class " ++ show className ++ " is undefined") Nothing) Right $ M.lookup (qualify mn className) m
-  lookupIdent members = maybe (Left $ mkErrorStack ("Type class " ++ show className ++ " does not have method " ++ show ident) Nothing) Right $ lookup (identToJs ident) members
-typeInstanceDictionaryEntryDeclaration name mn deps className tys (PositionedDeclaration pos d) =
-  PositionedDeclaration pos <$> typeInstanceDictionaryEntryDeclaration name mn deps className tys d
-typeInstanceDictionaryEntryDeclaration _ _ _ _ _ _ = error "Invalid declaration in type instance definition"
-
--- |
--- Generate a name for a type class dictionary member, based on the module name, class name, type name and
--- member name
---
-mkDictionaryEntryName :: Ident -> Ident -> Desugar Ident
-mkDictionaryEntryName dictName ident = return $ Escaped $ show dictName ++ "_" ++ identToJs ident
+  typeInstanceDictionaryEntryValue :: Declaration -> Value
+  typeInstanceDictionaryEntryValue (ValueDeclaration _ _ [] _ val) = val
+  typeInstanceDictionaryEntryValue (PositionedDeclaration pos d) = PositionedValue pos (typeInstanceDictionaryEntryValue d)
+  typeInstanceDictionaryEntryValue _ = error "Invalid declaration in type instance definition"
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index b0dd3b9..7ec773e 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -270,7 +270,7 @@ replaceTypeClassDictionaries mn = everywhereM' (mkM go)
 -- A simplified representation of expressions which are used to represent type
 -- class dictionaries at runtime, which can be compared for equality
 --
-data DictionaryValue 
+data DictionaryValue
   -- |
   -- A dictionary which is brought into scope by a local constraint
   --
@@ -283,59 +283,63 @@ data DictionaryValue
   -- A dictionary which depends on other dictionaries
   --
   | DependentDictionaryValue (Qualified Ident) [DictionaryValue]
-  deriving (Show, Eq)
+  deriving (Show, Ord, Eq)
 
 -- |
 -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
 -- return a type class dictionary reference.
 --
 entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Check Value
-entails env moduleName context goal@(className, tys) = do
-  case go goal of
-    [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++  unwords (map prettyPrintTypeAtom tys)
-    [dict] -> return (dictionaryValueToValue dict)
-    _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
+entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))
   where
-  go (className', tys') =
-    [ mkDictionary (canonicalizeDictionary tcd) args
-    | tcd <- nubBy ((==) `on` canonicalizeDictionary) context
-    -- Choose type class dictionaries in scope in the current module
-    , filterModule tcd
-    -- Make sure the type class name matches the one we are trying to satisfy
-    , className' == tcdClassName tcd
-    -- Make sure the type unifies with the type in the type instance definition
-    , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)
-    -- Solve any necessary subgoals
-    , args <- solveSubgoals subst (tcdDependencies tcd) ]
-  -- Create dictionaries for subgoals which still need to be solved by calling go recursively
-  -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
-  -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
-  solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]
-  solveSubgoals _ Nothing = return Nothing
-  solveSubgoals subst (Just subgoals) = do
-    dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals
-    return $ Just dict
-  -- Make a dictionary from subgoal dictionaries by applying the correct function
-  mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
-  mkDictionary fnName Nothing = LocalDictionaryValue fnName
-  mkDictionary fnName (Just []) = GlobalDictionaryValue fnName
-  mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts
-  -- Turn a DictionaryValue into a Value
-  dictionaryValueToValue :: DictionaryValue -> Value
-  dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName
-  dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
-  dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
-  -- Filter out type dictionaries which are in scope in the current module
-  filterModule :: TypeClassDictionaryInScope -> Bool
-  filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
-  filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True
-  filterModule _ = False
-  -- Ensure that a substitution is valid
-  verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]
-  verifySubstitution subst = do
-    let grps = groupBy ((==) `on` fst) subst
-    guard (all (pairwise (unifiesWith env) . map snd) grps)
-    return $ map head grps
+    sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
+    sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))
+
+    -- Filter out type dictionaries which are in scope in the current module
+    filterModule :: TypeClassDictionaryInScope -> Bool
+    filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
+    filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True
+    filterModule _ = False
+	
+    solve context' goal@(className, tys) =
+      case go goal of
+        [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
+        [dict] -> return (dictionaryValueToValue dict)
+        _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
+      where
+	  go (className', tys') =
+	    [ mkDictionary (canonicalizeDictionary tcd) args
+	    | tcd <- context'
+	    -- Make sure the type class name matches the one we are trying to satisfy
+	    , className' == tcdClassName tcd
+	    -- Make sure the type unifies with the type in the type instance definition
+	    , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)
+	    -- Solve any necessary subgoals
+	    , args <- solveSubgoals subst (tcdDependencies tcd) ]
+	  -- Create dictionaries for subgoals which still need to be solved by calling go recursively
+	  -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
+	  -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
+	  solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]
+	  solveSubgoals _ Nothing = return Nothing
+	  solveSubgoals subst (Just subgoals) = do
+	    dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals
+	    return $ Just dict
+	  -- Make a dictionary from subgoal dictionaries by applying the correct function
+	  mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
+	  mkDictionary fnName Nothing = LocalDictionaryValue fnName
+	  mkDictionary fnName (Just []) = GlobalDictionaryValue fnName
+	  mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts
+	  -- Turn a DictionaryValue into a Value
+	  dictionaryValueToValue :: DictionaryValue -> Value
+	  dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName
+	  dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
+	  dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
+	  -- Ensure that a substitution is valid
+	  verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]
+	  verifySubstitution subst = do
+	    let grps = groupBy ((==) `on` fst) subst
+	    guard (all (pairwise (unifiesWith env) . map snd) grps)
+	    return $ map head grps
 
 -- |
 -- Check all values in a list pairwise match a predicate