4017b55 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge pull request #154 from garyb/master

Tests now passing

commit4017b5554b79d8e258b944318fe871ba309eef61 authorPhil Freeman <paf31@cantab.net> dateFri 31 Jan 2014, 16:51 (13 years ago) parentb37c730 6b6cfc0

9 files changed+22−21

compare with golang

unifiedsplit

examples/failing/NullaryAbs.purs+3 examples/passing/Do.purs+6−6 examples/passing/ExternData.purs+1−1 examples/passing/FFI.purs+1−1 examples/passing/Functions.purs+5−7 examples/passing/Rank2Types.purs+1−1 src/Language/PureScript/Parser/Values.hs+1−1 src/Language/PureScript/Sugar/TypeClasses.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+3−3

examples/failing/NullaryAbs.pursnew file+3

@@ -0,0 +1,3 @@

1+module NullaryAbs where

3+ func = \ -> "no"

examples/passing/Do.purs+6−6

@@ -9,15 +9,15 @@ instance Prelude.Monad Maybe where

99 (>>=) Nothing _ = Nothing

1010 (>>=) (Just a) f = f a

1111

12−test1 = \ -> do

12+test1 = \_ -> do

1313 Just "abc"

1414

15−test2 = \ -> do

15+test2 = \_ -> do

1616 (x : _) <- Just [1, 2, 3]

1717 (y : _) <- Just [4, 5, 6]

1818 Just (x + y)

1919

20−test3 = \ -> do

20+test3 = \_ -> do

2121 Just 1

2222 Nothing :: Maybe Number

2323 Just 2

@@ -34,11 +34,11 @@ test5 mx my mz = do

3434 z <- mz

3535 Just (z + sum)

3636

37−test6 mx = \ -> do

37+test6 mx = \_ -> do

3838 let Just x = mx

3939 Just x

4040

41−test8 = \ -> do

41+test8 = \_ -> do

4242 Just (do

4343 Just 1)

4444

@@ -60,7 +60,7 @@ forever a = do

6060 a

6161 forever a

6262

63−test9 = \ -> foo <$> Just 1 <*> Just 2 <*> Just 3

63+test9 = \_ -> foo <$> Just 1 <*> Just 2 <*> Just 3

6464

6565module Main where

6666

examples/passing/ExternData.purs+1−1

@@ -12,7 +12,7 @@ module ExternData where

1212

1313 foreign import prompt :: IO String

1414

15− main = \ -> prompt `bind` \s -> showMessage s

15+ main = \_ -> prompt `bind` \s -> showMessage s

1616

1717module Main where

1818

examples/passing/FFI.purs+1−1

@@ -9,7 +9,7 @@ module FFIModuleTest where

1010import FFI

1111

12−baz = \ -> foo "test"

12+baz = \_ -> foo "test"

1313

1414module Main where

1515

examples/passing/Functions.purs+5−7

@@ -1,16 +1,14 @@

11module Functions where

3− test1 = \ -> 0

3+ test1 = \_ -> 0

5− test2 = \_ -> 0

5+ test2 = \a b c d -> a + b + c + d

7− test3 = \a b c d -> a + b + c + d

7+ test3 = \a -> a

9− test4 = \a -> a

9+ test4 = \(%%) -> 1 %% 2

1010

11− test5 = \(%%) -> 1 %% 2

12−

13− test6 = \(+++) (***) -> 1 +++ 2 *** 3

11+ test5 = \(+++) (***) -> 1 +++ 2 *** 3

1412

1513module Main where

1614

examples/passing/Rank2Types.purs+1−1

@@ -9,7 +9,7 @@ module Rank2Types where

1010 foreign import exampleST :: forall s. ST s Number

1111

12− testST = \ -> runST exampleST

12+ testST = \_ -> runST exampleST

1313

1414 foreign import push :: forall el. el -> [el] -> [el]

1515

src/Language/PureScript/Parser/Values.hs+1−1

@@ -54,7 +54,7 @@ parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C

5454parseAbs :: P.Parsec String ParseState Value

5555parseAbs = do

5656 C.reservedOp "\\"

57− args <- P.many (C.indented *> (Abs <$> C.parseIdent))

57+ args <- P.many1 (C.indented *> (Abs <$> C.parseIdent))

5858 C.indented *> C.reservedOp "->"

5959 value <- parseValue

6060 return $ toFunction args value

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -97,7 +97,7 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do

9797 memberName <- mkDictionaryEntryName mn name ty ident

9898 return (identToJs ident, TypedValue False

9999 (if null deps then Var (Qualified Nothing memberName)

100− else foldr App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))

100+ else foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))

101101 (quantify memberType))

102102 memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"

103103

src/Language/PureScript/TypeChecker/Types.hs+3−3

@@ -452,7 +452,7 @@ infer' (Var var) = do

452452 ConstrainedType constraints _ -> do

453453 env <- getEnv

454454 dicts <- getTypeClassDictionaries

455− return $ TypedValue True (foldr App (Var var) (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) ty'

455+ return $ TypedValue True (foldl App (Var var) (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) ty'

456456 _ -> return $ TypedValue True (Var var) ty'

457457infer' (Block ss) = do

458458 ret <- fresh

@@ -952,7 +952,7 @@ checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

952952 env <- getEnv

953953 dicts <- getTypeClassDictionaries

954954 Just moduleName <- checkCurrentModule <$> get

955− checkFunctionApplication' (foldr App fn (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) fnTy arg ret

955+ checkFunctionApplication' (foldl App fn (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) fnTy arg ret

956956checkFunctionApplication' _ fnTy arg ret = throwError $ "Applying a function of type "

957957 ++ prettyPrintType fnTy

958958 ++ " to argument(s) " ++ prettyPrintValue arg

@@ -986,7 +986,7 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do

986986 dicts <- getTypeClassDictionaries

987987 Just moduleName <- checkCurrentModule <$> get

988988 _ <- subsumes' Nothing ty1 ty2

989− return . Just $ foldr App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))

989+ return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))

990990subsumes' val ty1 ty2 = do

991991 ty1 ?= ty2

992992 return val