version 0.3.130.3.13

13 files changed, 124 insertions, 135 deletions

diff --git a/docgen/Main.hs b/docgen/Main.hs
index 544f503..9cd2a43 100644
--- a/docgen/Main.hs
+++ b/docgen/Main.hs
@@ -92,8 +92,8 @@ renderDeclaration n (P.ExternDeclaration _ ident _ ty) =
 renderDeclaration n (P.DataDeclaration name args ctors) = do
   let typeName = P.runProperName name ++ " " ++ intercalate " " args
   atIndent n $ "data " ++ typeName ++ " where"
-  forM_ ctors $ \(ctor, ty) -> do
-    atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ maybe "" ((++ " -> ") . P.prettyPrintType) ty ++ typeName
+  forM_ ctors $ \(ctor, tys) -> do
+    atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concat (map (\ty -> P.prettyPrintType ty ++ " -> ") tys) ++ typeName
 renderDeclaration n (P.ExternDataDeclaration name kind) =
   atIndent n $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
 renderDeclaration n (P.TypeSynonymDeclaration name args ty) = do
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index b830d44..c17988d 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -441,19 +441,19 @@ module Maybe where
   fromMaybe :: forall a. a -> Maybe a -> a
   fromMaybe a = maybe a (Prelude.id :: forall a. a -> a)
   
-  instance Prelude.Functor Maybe where
-    (<$>) fn (Just x) = Just (fn x)
-    (<$>) _ _ = Nothing
-  
+  instance Prelude.Monad Maybe where
+    return = Just
+    (>>=) m f = maybe Nothing f m
+    
   instance Prelude.Applicative Maybe where
     pure = Just
     (<*>) (Just fn) x = fn <$> x
     (<*>) Nothing _ = Nothing
 
-  instance Prelude.Monad Maybe where
-    return = Just
-    (>>=) m f = maybe Nothing f m
-    
+  instance Prelude.Functor Maybe where
+    (<$>) fn (Just x) = Just (fn x)
+    (<$>) _ _ = Nothing
+  
   instance (Show a) => Prelude.Show (Maybe a) where
     show (Just x) = "Just " ++ (show x)
     show Nothing = "Nothing"
@@ -468,20 +468,18 @@ module Either where
   either f _ (Left a) = f a
   either _ g (Right b) = g b
   
-  {-
-  instance Prelude.Functor (Either a) where
-    (<$>) _ (Left x) = Left x
-    (<$>) f (Right y) = Right (f y)
-  -}
+  instance Prelude.Monad (Either e) where
+    return = Right
+    (>>=) = either (\e _ -> Left e) (\a f -> f a)
     
   instance Prelude.Applicative (Either e) where
     pure = Right
     (<*>) (Left e) _ = Left e
     (<*>) (Right f) r = f <$> r
 
-  instance Prelude.Monad (Either e) where
-    return = Right
-    (>>=) = either (\e _ -> Left e) (\a f -> f a)
+  instance Prelude.Functor (Either a) where
+    (<$>) _ (Left x) = Left x
+    (<$>) f (Right y) = Right (f y)
     
   instance (Show a, Show b) => Prelude.Show (Either a b) where
     show (Left x) = "Left " ++ (show x)
@@ -518,8 +516,8 @@ module Arrays where
   foldl _ b [] = b
   foldl f b (a:as) = foldl f (f a b) as
 
-  foreign import length "function length(xs) { \
-                        \  return xs.length; \
+  foreign import length "function length(xs) {\
+                        \  return xs.length;\
                         \}" :: forall a. [a] -> Number
 
   foreign import indexOf "function indexOf(l) {\
@@ -586,7 +584,7 @@ module Arrays where
 
   foreign import splice "function splice(s) {\
                         \  return function(e) {\
-                        \    return function(l1) { \
+                        \    return function(l1) {\
                         \      return function(l2) {\
                         \        return l2.splice(s, e, l1);\
                         \      }; \
@@ -656,27 +654,24 @@ module Tuples where
   import Prelude
   import Arrays
 
-  data Tuple a b = Tuple { fst :: a, snd :: b }
+  data Tuple a b = Tuple a b
 
   instance (Prelude.Show a, Prelude.Show b) => Prelude.Show (Tuple a b) where
-    show (Tuple { fst = a, snd = b }) = "Tuple(" ++ show a ++ ", " ++ show b ++ ")"
+    show (Tuple a b) = "Tuple(" ++ show a ++ ", " ++ show b ++ ")"
 
   curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c
-  curry f a b = f (tuple a b)
+  curry f a b = f (Tuple a b)
 
   uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c
-  uncurry f (Tuple t) = f t.fst t.snd
-
-  tuple :: forall a b. a -> b -> Tuple a b
-  tuple a b = Tuple { fst: a, snd: b }
+  uncurry f (Tuple a b) = f a b
 
   zip :: forall a b. [a] -> [b] -> [Tuple a b]
-  zip = zipWith tuple
+  zip = zipWith Tuple
 
   unzip :: forall a b. [Tuple a b] -> Tuple [a] [b]
-  unzip ((Tuple t):ts) = case unzip ts of
-    Tuple { fst = as, snd = bs } -> tuple (t.fst : as) (t.snd : bs)
-  unzip [] = tuple [] []
+  unzip ((Tuple a b):ts) = case unzip ts of
+    Tuple as bs -> Tuple (a : as) (b : bs)
+  unzip [] = Tuple [] []
 
 module String where
 
@@ -692,18 +687,18 @@ module String where
 
   foreign import indexOfS "function indexOfS(s1) {\
                           \  return function(s2) {\
-                          \    return s2.indexOf(s2);\
+                          \    return s1.indexOf(s2);\
                           \  }; \
                           \}" :: String -> String -> Number
 
   foreign import lastIndexOfS "function lastIndexOfS(s1) {\
                               \  return function(s2) {\
-                              \    return s2.lastIndexOf(s2);\
+                              \    return s1.lastIndexOf(s2);\
                               \  };\
                               \}" :: String -> String -> Number
 
   foreign import localeCompare "function localeCompare(s1) {\
-                               \  return function(s2) { \
+                               \  return function(s2) {\
                                \    return s1.localeCompare(s2);\
                                \  };\
                                \}" :: String -> String -> Number
@@ -769,7 +764,7 @@ module Regex where
                        \}" :: String -> String -> Regex
 
   foreign import test "function test(r) {\
-                      \  return function (s) { \
+                      \  return function (s) {\
                       \    return r.test(s);\
                       \  };\
                       \}" :: Regex -> String -> Boolean
@@ -782,7 +777,7 @@ module Regex where
 
   foreign import replaceR "function replaceR(r) {\
                           \  return function(s1) {\
-                          \    return function(s2) { \
+                          \    return function(s2) {\
                           \      return s2.replace(r, s1);\
                           \    };\
                           \  };\
@@ -908,24 +903,24 @@ module Eff where
 
   foreign import data Eff :: # ! -> * -> *
 
-  foreign import retEff "function retEff(a) { \
-                        \  return function() { \
-                        \    return a; \
-                        \  }; \
+  foreign import retEff "function retEff(a) {\
+                        \  return function() {\
+                        \    return a;\
+                        \  };\
                         \}" :: forall e a. a -> Eff e a
 
-  foreign import bindEff "function bindEff(a) { \
-                         \  return function(f) { \
-                         \    return function() { \
-                         \      return f(a())(); \
-                         \    }; \
-                         \  }; \
+  foreign import bindEff "function bindEff(a) {\
+                         \  return function(f) {\
+                         \    return function() {\
+                         \      return f(a())();\
+                         \    };\
+                         \  };\
                          \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
 
   type Pure a = forall e. Eff e a
 
-  foreign import runPure "function runPure(f) { \
-                         \  return f(); \
+  foreign import runPure "function runPure(f) {\
+                         \  return f();\
                          \}" :: forall a. Pure a -> a
 
   instance Prelude.Monad (Eff e) where
@@ -988,22 +983,22 @@ module Errors where
 
   foreign import data Error :: * -> !
 
-  foreign import throwError "function throwError(e) { \
-                            \  return function() { \
-                            \    throw e; \
-                            \  }; \
+  foreign import throwError "function throwError(e) {\
+                            \  return function() {\
+                            \    throw e;\
+                            \  };\
                             \}" :: forall a e r. e -> Eff (err :: Error e | r) a
 
-  foreign import catchError "function catchError(c) { \
-                            \  return function(t) { \
-                            \    return function() { \
-                            \      try { \
-                            \        return t(); \
-                            \      } catch(e) { \
-                            \        return c(e)(); \
+  foreign import catchError "function catchError(c) {\
+                            \  return function(t) {\
+                            \    return function() {\
+                            \      try {\
+                            \        return t();\
+                            \      } catch(e) {\
+                            \        return c(e)();\
                             \      }\
-                            \    }; \
-                            \  }; \
+                            \    };\
+                            \  };\
                             \}" :: forall e r a. (e -> Eff r a) -> Eff (err :: Error e | r) a -> Eff r a
 
 module IORef where
@@ -1056,11 +1051,11 @@ module Trace where
 
   foreign import data Trace :: !
 
-  foreign import trace "function trace(s) { \
-                       \  return function() { \
-                       \    console.log(s); \
-                       \    return {}; \
-                       \  }; \
+  foreign import trace "function trace(s) {\
+                       \  return function() {\
+                       \    console.log(s);\
+                       \    return {};\
+                       \  };\
                        \}" :: forall r. String -> Eff (trace :: Trace | r) {}
 
   print :: forall a r. (Prelude.Show a) => a -> Eff (trace :: Trace | r) {}
diff --git a/purescript.cabal b/purescript.cabal
index 581f926..7d45c47 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.3.12
+version: 0.3.13
 cabal-version: >=1.8
 build-type: Simple
 license: MIT
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 3cce144..ab01907 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -74,16 +74,14 @@ declToJs opts mp (BindingGroupDeclaration vals) e =
            : setProperty ident (var ident) mp
          ) vals
 declToJs _ mp (DataDeclaration _ _ ctors) _ =
-  Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->
-    let
-      ctorJs =
-        case maybeTy of
-          Nothing -> JSVariableIntroduction ctor (Just (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))) ]))
-          Just _ -> JSFunction (Just ctor) ["value"]
-                      (JSBlock [JSReturn
-                        (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn)))
-                                         , ("value", JSVar "value") ])])
-    in ctorJs : setProperty (Escaped ctor) (JSVar ctor) mp
+  Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
+    JSVariableIntroduction ctor (Just (go pn 0 tys [])) : setProperty (Escaped ctor) (JSVar ctor) mp
+    where
+    go pn _ [] values =
+      JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))), ("values", JSArrayLiteral $ reverse values) ]
+    go pn index (_ : tys') values =
+      JSFunction Nothing ["value" ++ show index]
+        (JSBlock [JSReturn (go pn (index + 1) tys' (JSVar ("value" ++ show index) : values))])
 declToJs opts mp (DataBindingGroupDeclaration ds) e =
   Just $ concat $ mapMaybe (flip (declToJs opts mp) e) ds
 declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =
@@ -263,23 +261,23 @@ binderToJs _ _ varName done (BooleanBinder False) =
   return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
 binderToJs m e varName done (VarBinder ident) =
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
-binderToJs m e varName done (NullaryBinder ctor) =
+binderToJs m e varName done (ConstructorBinder ctor bs) = do
+  js <- go 0 done bs
   if isOnlyConstructor m e ctor
   then
-    return done
-  else
-    return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor)))) (JSBlock done) Nothing]
-binderToJs m e varName done (UnaryBinder ctor b) = do
-  value <- fresh
-  js <- binderToJs m e value done b
-  let success = JSBlock (JSVariableIntroduction value (Just (JSAccessor "value" (JSVar varName))) : js)
-  if isOnlyConstructor m e ctor
-  then
-    return [success]
+    return js
   else
     return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor))))
-                     success
+                     (JSBlock js)
                      Nothing]
+  where
+  go :: Integer -> [JS] -> [Binder] -> Gen [JS]
+  go _ done' [] = return done'
+  go index done' (binder:bs') = do
+    argVar <- fresh
+    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)
 binderToJs m e varName done (ObjectBinder bs) = go done bs
   where
   go :: [JS] -> [(String, Binder)] -> Gen [JS]
diff --git a/src/Language/PureScript/Declarations.hs b/src/Language/PureScript/Declarations.hs
index 40f041d..b13d4d9 100644
--- a/src/Language/PureScript/Declarations.hs
+++ b/src/Language/PureScript/Declarations.hs
@@ -72,7 +72,7 @@ data Declaration
   -- |
   -- A data type declaration (name, arguments, data constructors)
   --
-  = DataDeclaration ProperName [String] [(ProperName, Maybe Type)]
+  = DataDeclaration ProperName [String] [(ProperName, [Type])]
   -- |
   -- A minimal mutually recursive set of data type declarations
   --
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 79f4248..7858419 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -40,7 +40,7 @@ parseDataDeclaration = do
   name <- indented *> properName
   tyArgs <- many (indented *> identifier)
   _ <- lexeme $ indented *> P.char '='
-  ctors <- sepBy1 ((,) <$> properName <*> P.optionMaybe (indented *> parsePolyType)) pipe
+  ctors <- sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe
   return $ DataDeclaration name tyArgs ctors
 
 parseTypeDeclaration :: P.Parsec String ParseState Declaration
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
index d88f906..ecd9bdc 100644
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -15,7 +15,8 @@
 
 module Language.PureScript.Parser.Types (
     parseType,
-    parsePolyType
+    parsePolyType,
+    parseTypeAtom
 ) where
 
 import Language.PureScript.Types
@@ -60,6 +61,9 @@ parseForAll :: P.Parsec String ParseState Type
 parseForAll = (mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> identifier) <* indented <* dot)
                         <*> parseConstrainedType)
 
+-- |
+-- Parse a type as it appears in e.g. a data constructor
+--
 parseTypeAtom :: P.Parsec String ParseState Type
 parseTypeAtom = indented *> P.choice (map P.try
             [ parseNumber
diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs
index 07fd6f4..6d45baf 100644
--- a/src/Language/PureScript/Parser/Values.hs
+++ b/src/Language/PureScript/Parser/Values.hs
@@ -228,11 +228,11 @@ parseNumberBinder = NumberBinder <$> C.integerOrFloat
 parseVarBinder :: P.Parsec String ParseState Binder
 parseVarBinder = VarBinder <$> C.parseIdent
 
-parseNullaryBinder :: P.Parsec String ParseState Binder
-parseNullaryBinder = NullaryBinder <$> C.lexeme (C.parseQualified C.properName)
+parseNullaryConstructorBinder :: P.Parsec String ParseState Binder
+parseNullaryConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> pure []
 
-parseUnaryBinder :: P.Parsec String ParseState Binder
-parseUnaryBinder = UnaryBinder <$> C.lexeme (C.parseQualified C.properName) <*> (C.indented *> parseBinder)
+parseConstructorBinder :: P.Parsec String ParseState Binder
+parseConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> (many (C.indented *> parseBinderNoParens))
 
 parseObjectBinder :: P.Parsec String ParseState Binder
 parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseIdentifierAndBinder))
@@ -262,8 +262,7 @@ parseBinderAtom = P.choice (map P.try
                   , parseNumberBinder
                   , parseNamedBinder
                   , parseVarBinder
-                  , parseUnaryBinder
-                  , parseNullaryBinder
+                  , parseConstructorBinder
                   , parseObjectBinder
                   , parseArrayBinder
                   , C.parens parseBinder ]) P.<?> "binder"
@@ -287,7 +286,7 @@ parseBinderNoParens = P.choice (map P.try
                   , parseNumberBinder
                   , parseNamedBinder
                   , parseVarBinder
-                  , parseNullaryBinder
+                  , parseNullaryConstructorBinder
                   , parseObjectBinder
                   , parseArrayBinder
                   , C.parens parseBinder ]) P.<?> "binder"
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index 0932d84..1e47f52 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -119,8 +119,7 @@ prettyPrintBinderAtom = mkPattern match
   match (BooleanBinder True) = Just "true"
   match (BooleanBinder False) = Just "false"
   match (VarBinder ident) = Just $ show ident
-  match (NullaryBinder ctor) = Just $ show ctor
-  match (UnaryBinder ctor b) = Just $ show ctor ++ " " ++ prettyPrintBinder b
+  match (ConstructorBinder ctor args) = Just $ show ctor ++ " " ++ intercalate " " (map (parens . prettyPrintBinder) args)
   match (ObjectBinder bs) = Just $ "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"
   match (ArrayBinder bs) = Just $ "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ " ]"
   match (NamedBinder ident binder) = Just $ show ident ++ "@" ++ prettyPrintBinder binder
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 40a35fc..3c08625 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -81,7 +81,7 @@ desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl
 --
 --   __Test_Foo_string_foo = (\s -> s ++ s) :: String -> String
 --
---   __Test_Foo_string :: Foo String
+--   __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]
@@ -127,8 +127,11 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do
   memberNames <- mapM (memberToNameAndValue memberTypes) decls
   return $ ValueDeclaration entryName [] Nothing
     (TypedValue True
-      (foldr Abs (ObjectLiteral memberNames) (map (\n -> Ident ('_' : show n)) [1..length deps]))
-      (quantify (foldr function (TypeApp (TypeConstructor name) ty) (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps)))
+      (foldr Abs (ObjectLiteral memberNames) (map (\n -> Ident ('_' : show n)) [1..max 1 (length deps)]))
+      (quantify (if null deps then
+                   function unit (TypeApp (TypeConstructor name) ty)
+                 else
+                   foldr function (TypeApp (TypeConstructor name) ty) (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps)))
     )
   where
   memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)
@@ -136,8 +139,7 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do
     memberType <- lift . maybe (Left "Type class member type not found") Right $ lookup (identToJs ident) tys
     memberName <- mkDictionaryEntryName mn name ty ident
     return (identToJs ident, TypedValue False
-                               (if null deps then Var (Qualified Nothing memberName)
-                                else foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
+                               (foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
                                (quantify memberType))
   memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"
 
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index e1c790e..0d993eb 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -38,21 +38,21 @@ import Language.PureScript.Kinds
 import Language.PureScript.Declarations
 import Language.PureScript.Sugar.TypeClasses
 
-addDataType :: ModuleName -> ProperName -> [String] -> [(ProperName, Maybe Type)] -> Kind -> Check ()
+addDataType :: ModuleName -> ProperName -> [String] -> [(ProperName, [Type])] -> Kind -> Check ()
 addDataType moduleName name args dctors ctorKind = do
   env <- getEnv
   putEnv $ env { types = M.insert (moduleName, name) (ctorKind, Data) (types env) }
-  forM_ dctors $ \(dctor, maybeTy) ->
+  forM_ dctors $ \(dctor, tys) ->
     rethrow (("Error in data constructor " ++ show dctor ++ ":\n") ++) $
-      addDataConstructor moduleName name args dctor maybeTy
+      addDataConstructor moduleName name args dctor tys
 
-addDataConstructor :: ModuleName -> ProperName -> [String] -> ProperName -> Maybe Type -> Check ()
-addDataConstructor moduleName name args dctor maybeTy = do
+addDataConstructor :: ModuleName -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
+addDataConstructor moduleName name args dctor tys = do
   env <- getEnv
   dataConstructorIsNotDefined moduleName dctor
   when (runModuleName moduleName == dctor) $ throwError "A data constructor may not have the same name as its enclosing module."
   let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)
-  let dctorTy = maybe retTy (flip function retTy) maybeTy
+  let dctorTy = foldr function retTy tys
   let polyType = mkForAll args dctorTy
   putEnv $ env { dataConstructors = M.insert (moduleName, dctor) (qualifyAllUnqualifiedNames moduleName env polyType, DataConstructor) (dataConstructors env) }
 
@@ -117,7 +117,7 @@ typeCheckAll _ [] = return []
 typeCheckAll moduleName (d@(DataDeclaration name args dctors) : rest) = do
   rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
     typeIsNotDefined moduleName name
-    ctorKind <- kindsOf moduleName name args (mapMaybe snd dctors)
+    ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
     addDataType moduleName name args dctors ctorKind
   ds <- typeCheckAll moduleName rest
   return $ d : ds
@@ -125,7 +125,7 @@ typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
   rethrow ("Error in data binding group:\n" ++) $ do
     let syns = mapMaybe toTypeSynonym tys
     let dataDecls = mapMaybe toDataDecl tys
-    (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(name, args, dctors) -> (name, args, mapMaybe snd dctors)) dataDecls)
+    (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) -> do
       typeIsNotDefined moduleName name
       addDataType moduleName name args dctors ctorKind
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 7ffdeaf..429803e 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -287,6 +287,7 @@ entails moduleName context goal@(className, ty) = do
   -- Make a dictionary from subgoal dictionaries by applying the correct function
   mkDictionary :: Qualified Ident -> Maybe [Value] -> Value
   mkDictionary fnName Nothing = Var fnName
+  mkDictionary fnName (Just []) = App (Var fnName) (ObjectLiteral [])
   mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts
   -- Filter out type dictionaries which are in scope in the current module
   filterModule :: TypeClassDictionaryInScope -> Bool
@@ -596,25 +597,20 @@ inferBinder val (StringBinder _) = val =?= tyString >> return M.empty
 inferBinder val (NumberBinder _) = val =?= tyNumber >> return M.empty
 inferBinder val (BooleanBinder _) = val =?= tyBoolean >> return M.empty
 inferBinder val (VarBinder name) = return $ M.singleton name val
-inferBinder val (NullaryBinder ctor) = do
-  env <- getEnv
-  Just moduleName <- checkCurrentModule <$> get
-  case M.lookup (qualify moduleName ctor) (dataConstructors env) of
-    Just (ty, _) -> do
-      _ <- subsumes Nothing ty val
-      return M.empty
-    _ -> throwError $ "Constructor " ++ show ctor ++ " is not defined"
-inferBinder val (UnaryBinder ctor binder) = do
+inferBinder val (ConstructorBinder ctor binders) = do
   env <- getEnv
   Just moduleName <- checkCurrentModule <$> get
   case M.lookup (qualify moduleName ctor) (dataConstructors env) of
     Just (ty, _) -> do
       (_, fn) <- instantiatePolyTypeWithUnknowns (error "Data constructor types cannot contains constraints") ty
-      case fn of
-        TypeApp (TypeApp t obj) ret | t == tyFunction -> do
-          _ <- subsumes Nothing val ret
-          inferBinder obj binder
-        _ -> throwError $ "Constructor " ++ show ctor ++ " is not a unary constructor"
+      go binders fn
+        where
+        go [] ty = do
+          subsumes Nothing val ty
+          return M.empty
+        go (binder : binders) (TypeApp (TypeApp t obj) ret) | t == tyFunction =
+          M.union <$> inferBinder obj binder <*> go binders ret
+        go _ _ = throwError $ "Wrong number of arguments to constructor " ++ show ctor
     _ -> throwError $ "Constructor " ++ show ctor ++ " is not defined"
 inferBinder val (ObjectBinder props) = do
   row <- fresh
diff --git a/src/Language/PureScript/Values.hs b/src/Language/PureScript/Values.hs
index 5433b1c..3049a01 100644
--- a/src/Language/PureScript/Values.hs
+++ b/src/Language/PureScript/Values.hs
@@ -247,13 +247,9 @@ data Binder
   --
   | VarBinder Ident
   -- |
-  -- A binder which matches a data constructor with no argument
+  -- A binder which matches a data constructor
   --
-  | NullaryBinder (Qualified ProperName)
-  -- |
-  -- A binder which matches a data constructor with one argument
-  --
-  | UnaryBinder (Qualified ProperName) Binder
+  | ConstructorBinder (Qualified ProperName) [Binder]
   -- |
   -- A binder which matches a record and binds its properties
   --