Merge branch 'singleargs' of github.com:paf31/purescript into singleargs

paf31 · paf31 · commit b2fb5419e108 · 2014-01-31T17:34:22.000-08:00
diff --git a/examples/failing/NullaryAbs.purs b/examples/failing/NullaryAbs.purs
@@ -0,0 +1,3 @@
+module NullaryAbs where
+
+  func = \ -> "no"
diff --git a/examples/passing/Do.purs b/examples/passing/Do.purs
@@ -9,15 +9,15 @@ instance Prelude.Monad Maybe where
   (>>=) Nothing _ = Nothing
   (>>=) (Just a) f = f a
 
-test1 = \ -> do 
+test1 = \_ -> do 
   Just "abc"
 
-test2 = \ -> do
+test2 = \_ -> do
   (x : _) <- Just [1, 2, 3]
   (y : _) <- Just [4, 5, 6]
   Just (x + y)
 
-test3 = \ -> do
+test3 = \_ -> do
   Just 1
   Nothing :: Maybe Number
   Just 2
@@ -34,11 +34,11 @@ test5 mx my mz = do
   z <- mz
   Just (z + sum)
 
-test6 mx = \ -> do 
+test6 mx = \_ -> do 
   let Just x = mx
   Just x
 
-test8 = \ -> do 
+test8 = \_ -> do 
   Just (do 
     Just 1)
 
@@ -60,7 +60,7 @@ forever a = do
   a
   forever a
 
-test9 = \ -> foo <$> Just 1 <*> Just 2 <*> Just 3
+test9 = \_ -> foo <$> Just 1 <*> Just 2 <*> Just 3
     
 module Main where
 
diff --git a/examples/passing/ExternData.purs b/examples/passing/ExternData.purs
@@ -12,7 +12,7 @@ module ExternData where
 
   foreign import prompt :: IO String
 
-  main = \ -> prompt `bind` \s -> showMessage s
+  main = \_ -> prompt `bind` \s -> showMessage s
     
 module Main where
 
diff --git a/examples/passing/FFI.purs b/examples/passing/FFI.purs
@@ -9,7 +9,7 @@ module FFIModuleTest where
 
 import FFI
 
-baz = \ -> foo "test"
+baz = \_ -> foo "test"
     
 module Main where
 
diff --git a/examples/passing/Functions.purs b/examples/passing/Functions.purs
@@ -1,16 +1,14 @@
 module Functions where
 
-  test1 = \ -> 0
+  test1 = \_ -> 0
 
-  test2 = \_ -> 0
+  test2 = \a b c d -> a + b + c + d
 
-  test3 = \a b c d -> a + b + c + d
+  test3 = \a -> a
 
-  test4 = \a -> a
+  test4 = \(%%) -> 1 %% 2
 
-  test5 = \(%%) -> 1 %% 2
-
-  test6 = \(+++) (***) -> 1 +++ 2 *** 3
+  test5 = \(+++) (***) -> 1 +++ 2 *** 3
     
 module Main where
 
diff --git a/examples/passing/Rank2Types.purs b/examples/passing/Rank2Types.purs
@@ -9,7 +9,7 @@ module Rank2Types where
 
   foreign import exampleST :: forall s. ST s Number
 
-  testST = \ -> runST exampleST
+  testST = \_ -> runST exampleST
 
   foreign import push :: forall el. el -> [el] -> [el]
 
diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs
@@ -54,7 +54,7 @@ parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C
 parseAbs :: P.Parsec String ParseState Value
 parseAbs = do
   C.reservedOp "\\"
-  args <- P.many (C.indented *> (Abs <$> C.parseIdent))
+  args <- P.many1 (C.indented *> (Abs <$> C.parseIdent))
   C.indented *> C.reservedOp "->"
   value <- parseValue
   return $ toFunction args value
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -97,7 +97,7 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do
     memberName <- mkDictionaryEntryName mn name ty ident
     return (identToJs ident, TypedValue False
                                (if null deps then Var (Qualified Nothing memberName)
-                                else foldr App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
+                                else 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/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
@@ -453,7 +453,7 @@ infer' (Var var) = do
     ConstrainedType constraints _ -> do
       env <- getEnv
       dicts <- getTypeClassDictionaries
-      return $ TypedValue True (foldr App (Var var) (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) ty'
+      return $ TypedValue True (foldl App (Var var) (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) ty'
     _ -> return $ TypedValue True (Var var) ty'
 infer' (Block ss) = do
   ret <- fresh
@@ -953,7 +953,7 @@ checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do
   env <- getEnv
   dicts <- getTypeClassDictionaries
   Just moduleName <- checkCurrentModule <$> get
-  checkFunctionApplication' (foldr App fn (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) fnTy arg ret
+  checkFunctionApplication' (foldl App fn (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) fnTy arg ret
 checkFunctionApplication' _ fnTy arg ret = throwError $ "Applying a function of type "
   ++ prettyPrintType fnTy
   ++ " to argument(s) " ++ prettyPrintValue arg
@@ -987,7 +987,7 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
   dicts <- getTypeClassDictionaries
   Just moduleName <- checkCurrentModule <$> get
   _ <- subsumes' Nothing ty1 ty2
-  return . Just $ foldr App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))
+  return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))
 subsumes' val ty1 ty2 = do
   ty1 ?= ty2
   return val

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+module NullaryAbs where`
	`2`	`+`
	`3`	`+ func = \ -> "no"`