22fb343 · rowtype-yoga/purescript-native

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

Merge branch 'master' into supply-object-wildcards

Conflicts: src/Language/PureScript/Sugar.hs

commit22fb3431341551fa76dd8ef8a5362945cc390002 authorGary Burgess <gary.burgess@gmail.com> dateSun 8 Feb 2015, 01:56 (12 years ago) parent78f1610 80ecc42

6 files changed+57−4

compare with golang

unifiedsplit

examples/passing/OperatorSections.purs+21 src/Language/PureScript/AST/Declarations.hs+5 src/Language/PureScript/Parser/Declarations.hs+8−1 src/Language/PureScript/Pretty/Values.hs+2 src/Language/PureScript/Sugar.hs+4−1 src/Language/PureScript/Sugar/Operators.hs+17−2

examples/passing/OperatorSections.pursnew file+21

@@ -0,0 +1,21 @@

1+module Main where

3+foreign import eqeqeq

4+ """

5+ function eqeqeq(x) {

6+ return function (y) {

7+ if (x == y) return x;

8+ throw new Error("Unexpected result: " + x + " /== " + y);

9+ };

10+ };

11+ """ :: forall a. a -> a -> a

12+

13+(===) = eqeqeq

14+infixl 4 ===

15+

16+main = do

17+ Debug.Trace.print $ (/ 2) 4 === 2

18+ Debug.Trace.print $ (2 /) 4 === 0.5

19+ Debug.Trace.print $ (`const` 1) 2 === 2

20+ Debug.Trace.print $ (1 `const`) 2 === 1

21+ Debug.Trace.trace "Done!"

src/Language/PureScript/AST/Declarations.hs+5

@@ -312,6 +312,11 @@ data Expr

312312 --

313313 | Parens Expr

314314 -- |

315+ -- Operator section. This will be removed during desugaring and replaced with a partially applied

316+ -- operator or lambda to flip the arguments.

317+ --

318+ | OperatorSection (Qualified Ident) (Either Expr Expr)

319+ -- |

315320 -- An array literal

316321 --

317322 | ArrayLiteral [Expr]

src/Language/PureScript/Parser/Declarations.hs+8−1

@@ -353,7 +353,14 @@ parseValueAtom = P.choice

353353 , parseIfThenElse

354354 , parseDo

355355 , parseLet

356− , Parens <$> parens parseValue ]

356+ , P.try $ Parens <$> parens parseValue

357+ , parseOperatorSection ]

358+

359+parseOperatorSection :: TokenParser Expr

360+parseOperatorSection = parens $ left <|> right

361+ where

362+ right = OperatorSection <$> parseIdentInfix <* indented <*> (Right <$> parseValueAtom)

363+ left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseIdentInfix

357364

358365parsePropertyUpdate :: TokenParser (String, Maybe Expr)

359366parsePropertyUpdate = do

src/Language/PureScript/Pretty/Values.hs+2

@@ -73,6 +73,8 @@ literals = mkPattern' match

7373 , withIndent $ prettyPrintMany prettyPrintDoNotationElement els

7474 , currentIndent

7575 ]

76+ match (OperatorSection op (Right val)) = return $ "(" ++ show op ++ " " ++ prettyPrintValue val ++ ")"

77+ match (OperatorSection op (Left val)) = return $ "(" ++ prettyPrintValue val ++ " " ++ show op ++ ")"

7678 match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"

7779 match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"

7880 match (TypedValue _ val _) = prettyPrintValue' val

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

@@ -37,7 +37,9 @@ import Language.PureScript.Sugar.TypeDeclarations as S

3737--

3838-- * Remove signed literals in favour of `negate` applications

3939--

40−-- * Desguar object literals with wildcards into lambdas

40+-- * Desugar object literals with wildcards into lambdas

41+--

42+-- * Desugar operator sections

4143--

4244-- * Desugar do-notation using the @Prelude.Monad@ type class

4345--

@@ -56,6 +58,7 @@ import Language.PureScript.Sugar.TypeDeclarations as S

5658desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]

5759desugar = map removeSignedLiterals

5860 >>> mapM desugarObjectConstructors

61+ >=> mapM desugarOperatorSections

5962 >=> mapM desugarDoModule

6063 >=> desugarCasesModule

6164 >=> lift . (desugarTypeDeclarationsModule

src/Language/PureScript/Sugar/Operators.hs+17−2

@@ -21,12 +21,14 @@

2121

2222module Language.PureScript.Sugar.Operators (

2323 rebracket,

24− removeSignedLiterals

24+ removeSignedLiterals,

25+ desugarOperatorSections

2526) where

2627

27−import Language.PureScript.Names

2828import Language.PureScript.AST

2929import Language.PureScript.Errors

30+import Language.PureScript.Names

31+import Language.PureScript.Supply

3032

3133import Control.Applicative

3234import Control.Monad.State

@@ -148,3 +150,16 @@ matchOp op = do

148150 ident <- parseOp

149151 guard $ ident == op

150152

153+desugarOperatorSections :: Module -> SupplyT (Either ErrorStack) Module

154+desugarOperatorSections (Module mn ds exts) = Module mn <$> mapM goDecl ds <*> pure exts

155+ where

156+

157+ goDecl :: Declaration -> SupplyT (Either ErrorStack) Declaration

158+ (goDecl, _, _) = everywhereOnValuesM return goExpr return

159+

160+ goExpr :: Expr -> SupplyT (Either ErrorStack) Expr

161+ goExpr (OperatorSection op (Left val)) = return $ App (Var op) val

162+ goExpr (OperatorSection op (Right val)) = do

163+ arg <- Ident <$> freshName

164+ return $ Abs (Left arg) $ App (App (Var op) (Var (Qualified Nothing arg))) val

165+ goExpr other = return other