2099d51 · rowtype-yoga/purescript-native

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

compare with golang

unifiedsplit

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

312 --

313 | Parens Expr

314 -- |

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+ -- |

315 -- An array literal

320 -- An array literal

316 --

321 --

317 | ArrayLiteral [Expr]

322 | ArrayLiteral [Expr]

src/Language/PureScript/Parser/Declarations.hs+7

@@ -353,8 +353,15 @@ parseValueAtom = P.choice

353 , parseIfThenElse

354 , parseDo

355 , parseLet

356+ , P.try parseOperatorSection

356 , Parens <$> parens parseValue ]

357 , Parens <$> parens parseValue ]

357

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

364+

358parsePropertyUpdate :: TokenParser (String, Maybe Expr)

365parsePropertyUpdate :: TokenParser (String, Maybe Expr)

359parsePropertyUpdate = do

366parsePropertyUpdate = do

360 name <- lname <|> stringLiteral

367 name <- lname <|> stringLiteral

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

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

37--

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

39--

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

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

41+--

42+-- * Desugar operator sections

41--

43--

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

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

43--

45--

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

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

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

57desugar = map removeSignedLiterals

59desugar = map removeSignedLiterals

58 >>> map desugarObjectConstructors

60 >>> map desugarObjectConstructors

61+ >>> map desugarOperatorSections

59 >>> mapM desugarDoModule

62 >>> mapM desugarDoModule

60 >=> desugarCasesModule

63 >=> desugarCasesModule

61 >=> lift . (desugarTypeDeclarationsModule

64 >=> lift . (desugarTypeDeclarationsModule

src/Language/PureScript/Sugar/Operators.hs+13−1

@@ -21,7 +21,8 @@

21

22module Language.PureScript.Sugar.Operators (

23 rebracket,

24− removeSignedLiterals

24+ removeSignedLiterals,

25+ desugarOperatorSections

25) where

26) where

26

27

27import Language.PureScript.Names

28import Language.PureScript.Names

@@ -148,3 +149,14 @@ matchOp op = do

148 ident <- parseOp

149 ident <- parseOp

149 guard $ ident == op

150 guard $ ident == op

150

151

152+desugarOperatorSections :: Module -> Module

153+desugarOperatorSections (Module mn ds exts) = Module mn (map goDecl ds) exts

154+ where

155+

156+ goDecl :: Declaration -> Declaration

157+ (goDecl, _, _) = everywhereOnValues id goExpr id

158+

159+ goExpr :: Expr -> Expr

160+ goExpr (OperatorSection op (Left val)) = App (Var op) val

161+ goExpr (OperatorSection op (Right val)) = Abs (Left $ Ident "_lhs") $ App (App (Var op) (Var (Qualified Nothing (Ident "_lhs")))) val

162+ goExpr other = other