7e92e7c · rowtype-yoga/purescript-native

examples/failing/SuggestComposition.purs+1−1

compare with golang

unifiedsplit

@@ -4,4 +4,4 @@ module SuggestComposition where

4

5import Prelude

6

7−f = g . g where g = (+1)

7+f = g . g where g = (_ + 1)

examples/passing/ConstraintInference.purs+1−1

@@ -2,6 +2,6 @@ module Main where

2

3import Prelude

4

5−shout = Control.Monad.Eff.Console.log <<< (<> "!") <<< show

5+shout = Control.Monad.Eff.Console.log <<< (_ <> "!") <<< show

6

7main = shout "Done"

examples/passing/ContextSimplification.purs+1−1

@@ -3,7 +3,7 @@ module Main where

3import Prelude

4import Control.Monad.Eff.Console

5

6−shout = log <<< (<> "!") <<< show

6+shout = log <<< (_ <> "!") <<< show

7

8-- Here, we should simplify the context so that only one Show

9-- constraint is added.

examples/passing/MonadState.purs+1−1

@@ -58,4 +58,4 @@ modify f =

58 same :: forall a. (a -> a) -> (a -> a)

59 same = id

60

61−main = print $ runState 0 (modify (+ 1))

61+main = print $ runState 0 (modify (_ + 1))

examples/passing/OperatorSections.purs+8−8

@@ -4,14 +4,14 @@ import Prelude

4import Test.Assert

5

6main = do

7− assert $ (/ 2.0) 4.0 == 2.0

7+ assert $ (_ / 2.0) 4.0 == 2.0

8− assert $ (2.0 /) 4.0 == 0.5

8+ assert $ (2.0 / _) 4.0 == 0.5

9− assert $ (`const` 1.0) 2.0 == 2.0

9+ assert $ (_ `const` 1.0) 2.0 == 2.0

10− assert $ (1.0 `const`) 2.0 == 1.0

10+ assert $ (1.0 `const` _) 2.0 == 1.0

11 let foo = { x: 2.0 }

12− assert $ (/ foo.x) 4.0 == 2.0

12+ assert $ (_ / foo.x) 4.0 == 2.0

13− assert $ (foo.x /) 4.0 == 0.5

13+ assert $ (foo.x / _) 4.0 == 0.5

14 let (//) x y = x.x / y.x

15− assert $ (// foo { x = 4.0 }) { x: 4.0 } == 1.0

15+ assert $ (_ // foo { x = 4.0 }) { x: 4.0 } == 1.0

16− assert $ (foo { x = 4.0 } //) { x: 4.0 } == 1.0

16+ assert $ (foo { x = 4.0 } // _) { x: 4.0 } == 1.0

17 Control.Monad.Eff.Console.log "Done!"

src/Language/PureScript/AST/Declarations.hs−4

@@ -360,10 +360,6 @@ data Expr

360 --

361 | Parens Expr

362 -- |

363− -- Operator section. This will be removed during desugaring and replaced with lambda.

364− --

365− | OperatorSection Expr (Either Expr Expr)

366− -- |

367 -- An object property getter (e.g. `_.x`). This will be removed during

363 -- An object property getter (e.g. `_.x`). This will be removed during

368 -- desugaring and expanded into a lambda that reads a property from an object.

364 -- desugaring and expanded into a lambda that reads a property from an object.

369 --

365 --

src/Language/PureScript/AST/Traversals.hs−14

@@ -47,8 +47,6 @@ everywhereOnValues f g h = (f', g', h')

47 g' (UnaryMinus v) = g (UnaryMinus (g' v))

48 g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))

49 g' (Parens v) = g (Parens (g' v))

50− g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))

51− g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))

52 g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))

50 g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))

53 g' (Accessor prop v) = g (Accessor prop (g' v))

51 g' (Accessor prop v) = g (Accessor prop (g' v))

54 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

52 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

@@ -116,8 +114,6 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

116 g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')

114 g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')

117 g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')

115 g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')

118 g' (Parens v) = Parens <$> (g v >>= g')

116 g' (Parens v) = Parens <$> (g v >>= g')

119− g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))

120− g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))

121 g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')

117 g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')

122 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

118 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

123 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs

119 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs

@@ -185,8 +181,6 @@ everywhereOnValuesM f g h = (f', g', h')

185 g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g

181 g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g

186 g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g

182 g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g

187 g' (Parens v) = (Parens <$> g' v) >>= g

183 g' (Parens v) = (Parens <$> g' v) >>= g

188− g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g

189− g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g

190 g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g

184 g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g

191 g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g

185 g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g

192 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g

186 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g

@@ -259,8 +253,6 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

259 g' v@(UnaryMinus v1) = g v <> g' v1

253 g' v@(UnaryMinus v1) = g v <> g' v1

260 g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2

254 g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2

261 g' v@(Parens v1) = g v <> g' v1

255 g' v@(Parens v1) = g v <> g' v1

262− g' v@(OperatorSection op (Left v1)) = g v <> g' op <> g' v1

263− g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1

264 g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1

256 g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1

265 g' v@(Accessor _ v1) = g v <> g' v1

257 g' v@(Accessor _ v1) = g v <> g' v1

266 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

258 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

@@ -338,8 +330,6 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

338 g' s (UnaryMinus v1) = g'' s v1

330 g' s (UnaryMinus v1) = g'' s v1

339 g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2

331 g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2

340 g' s (Parens v1) = g'' s v1

332 g' s (Parens v1) = g'' s v1

341− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v

342− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

343 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

333 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

344 g' s (Accessor _ v1) = g'' s v1

334 g' s (Accessor _ v1) = g'' s v1

345 g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)

335 g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)

@@ -419,8 +409,6 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

419 g' s (UnaryMinus v) = UnaryMinus <$> g'' s v

409 g' s (UnaryMinus v) = UnaryMinus <$> g'' s v

420 g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2

410 g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2

421 g' s (Parens v) = Parens <$> g'' s v

411 g' s (Parens v) = Parens <$> g'' s v

422− g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)

423− g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)

424 g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v

412 g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v

425 g' s (Accessor prop v) = Accessor prop <$> g'' s v

413 g' s (Accessor prop v) = Accessor prop <$> g'' s v

426 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs

414 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs

@@ -510,8 +498,6 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)

510 g' s (UnaryMinus v1) = g'' s v1

498 g' s (UnaryMinus v1) = g'' s v1

511 g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2

499 g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2

512 g' s (Parens v1) = g'' s v1

500 g' s (Parens v1) = g'' s v1

513− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v

514− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

515 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

501 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

516 g' s (Accessor _ v1) = g'' s v1

502 g' s (Accessor _ v1) = g'' s v1

517 g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs

503 g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs

src/Language/PureScript/Errors.hs+1−29

@@ -25,7 +25,6 @@ import Control.Arrow ((&&&))

25import Language.PureScript.Crash

26import Language.PureScript.AST

27import Language.PureScript.Pretty

28−import Language.PureScript.Pretty.Common (before)

29import Language.PureScript.Types

28import Language.PureScript.Types

30import Language.PureScript.Names

29import Language.PureScript.Names

31import Language.PureScript.Kinds

30import Language.PureScript.Kinds

@@ -141,7 +140,6 @@ data SimpleErrorMessage

141 | UnusedDctorImport (ProperName 'TypeName)

140 | UnusedDctorImport (ProperName 'TypeName)

142 | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

141 | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

143 | DeprecatedOperatorDecl String

142 | DeprecatedOperatorDecl String

144− | DeprecatedOperatorSection Expr (Either Expr Expr)

145 | DeprecatedClassImport ModuleName (ProperName 'ClassName)

143 | DeprecatedClassImport ModuleName (ProperName 'ClassName)

146 | DeprecatedClassExport (ProperName 'ClassName)

144 | DeprecatedClassExport (ProperName 'ClassName)

147 | DuplicateSelectiveImport ModuleName

145 | DuplicateSelectiveImport ModuleName

@@ -329,7 +327,6 @@ errorCode em = case unwrapErrorMessage em of

329 UnusedDctorImport{} -> "UnusedDctorImport"

327 UnusedDctorImport{} -> "UnusedDctorImport"

330 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

328 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

331 DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"

329 DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"

332− DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"

333 DeprecatedClassImport{} -> "DeprecatedClassImport"

330 DeprecatedClassImport{} -> "DeprecatedClassImport"

334 DeprecatedClassExport{} -> "DeprecatedClassExport"

331 DeprecatedClassExport{} -> "DeprecatedClassExport"

335 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"

332 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"

@@ -455,7 +452,7 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error

455-- TODO Other possible suggestions:

452-- TODO Other possible suggestions:

456-- WildcardInferredType - source span not small enough

453-- WildcardInferredType - source span not small enough

457-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert

454-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert

458−-- DeprecatedClassExport, DeprecatedClassImport, DeprecatedOperatorSection, would want to replace smaller span?

455+-- DeprecatedClassExport, DeprecatedClassImport, would want to replace smaller span?

459errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

456errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

460errorSuggestion err = case err of

457errorSuggestion err = case err of

461 UnusedImport{} -> emptySuggestion

458 UnusedImport{} -> emptySuggestion

@@ -923,31 +920,6 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

923 , line "Support for value-declared operators will be removed in PureScript 0.9."

920 , line "Support for value-declared operators will be removed in PureScript 0.9."

924 ]

921 ]

925

922

926− renderSimpleErrorMessage (DeprecatedOperatorSection op val) =

927− paras [ line "An operator section uses legacy syntax. Operator sections are now written using anonymous function syntax:"

928− , indent $ foldr1 before $

929− case val of

930− Left l ->

931− [ line "("

932− , prettyPrintValue valueDepth l

933− , line " "

934− , renderOperator op

935− , line " _)"

936− ]

937− Right r ->

938− [ line "(_ "

939− , renderOperator op

940− , line " "

941− , prettyPrintValue valueDepth r

942− , line ")"

943− ]

944− , line "Support for legacy operator sections will be removed in PureScript 0.9."

945− ]

946− where

947− renderOperator (PositionedValue _ _ ex) = renderOperator ex

948− renderOperator (Var (Qualified _ (Op ident))) = line ident

949− renderOperator other = Box.hcat Box.top [ line "`", prettyPrintValue valueDepth other, line "`" ]

950−

951 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

923 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

952 paras [ line $ "Class import from " ++ runModuleName mn ++ " uses deprecated syntax that omits the 'class' keyword:"

924 paras [ line $ "Class import from " ++ runModuleName mn ++ " uses deprecated syntax that omits the 'class' keyword:"

953 , indent $ line $ runProperName name

925 , indent $ line $ runProperName name

src/Language/PureScript/Linter.hs−1

@@ -71,7 +71,6 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl

71 go d | Just i <- getDeclIdent d

72 , i `S.member` s = errorMessage (ShadowedName i)

73 | otherwise = mempty

74− stepE _ (OperatorSection op val) = errorMessage $ DeprecatedOperatorSection op val

75 stepE _ _ = mempty

74 stepE _ _ = mempty

76

75

77 stepB :: S.Set Ident -> Binder -> MultipleErrors

76 stepB :: S.Set Ident -> Binder -> MultipleErrors

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

@@ -373,7 +373,7 @@ parseValueAtom = P.choice

373 , Literal <$> parseStringLiteral

374 , Literal <$> parseBooleanLiteral

375 , Literal <$> parseArrayLiteral parseValue

376− , Literal <$> P.try (parseObjectLiteral parseIdentifierAndValue)

376+ , Literal <$> parseObjectLiteral parseIdentifierAndValue

377 , parseAbs

378 , P.try parseConstructor

379 , P.try parseVar

@@ -382,7 +382,6 @@ parseValueAtom = P.choice

382 , parseDo

383 , parseLet

384 , P.try $ Parens <$> parens parseValue

385− , parseOperatorSection

386 , parseHole

385 , parseHole

387 ]

386 ]

388

387

@@ -393,12 +392,6 @@ parseInfixExpr :: TokenParser Expr

393parseInfixExpr = P.between tick tick parseValue

392parseInfixExpr = P.between tick tick parseValue

394 <|> Var <$> parseQualified (Op <$> symbol)

393 <|> Var <$> parseQualified (Op <$> symbol)

395

394

396−parseOperatorSection :: TokenParser Expr

397−parseOperatorSection = parens $ left <|> right

398− where

399− right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> indexersAndAccessors)

400− left = flip OperatorSection <$> (Left <$> indexersAndAccessors) <* indented <*> parseInfixExpr

401−

402parseHole :: TokenParser Expr

395parseHole :: TokenParser Expr

403parseHole = Hole <$> holeLit

396parseHole = Hole <$> holeLit

404

397

src/Language/PureScript/Pretty/Values.hs−3

@@ -68,7 +68,6 @@ prettyPrintValue _ (Hole name) = text "?" <> text name

68prettyPrintValue d expr@AnonymousArgument{} = prettyPrintValueAtom d expr

69prettyPrintValue d expr@Constructor{} = prettyPrintValueAtom d expr

70prettyPrintValue d expr@Var{} = prettyPrintValueAtom d expr

71−prettyPrintValue d expr@OperatorSection{} = prettyPrintValueAtom d expr

72prettyPrintValue d expr@BinaryNoParens{} = prettyPrintValueAtom d expr

71prettyPrintValue d expr@BinaryNoParens{} = prettyPrintValueAtom d expr

73prettyPrintValue d expr@Parens{} = prettyPrintValueAtom d expr

72prettyPrintValue d expr@Parens{} = prettyPrintValueAtom d expr

74prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr

73prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr

@@ -80,8 +79,6 @@ prettyPrintValueAtom d (Literal l) = prettyPrintLiteralValue d l

80prettyPrintValueAtom _ AnonymousArgument = text "_"

79prettyPrintValueAtom _ AnonymousArgument = text "_"

81prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify name)

80prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify name)

82prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)

81prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)

83−prettyPrintValueAtom d (OperatorSection op (Right val)) = ((text "(" <> prettyPrintValue (d - 1) op) `beforeWithSpace` prettyPrintValue (d - 1) val) `before` text ")"

84−prettyPrintValueAtom d (OperatorSection op (Left val)) = ((text "(" <> prettyPrintValue (d - 1) val) `beforeWithSpace` prettyPrintValue (d - 1) op) `before` text ")"

85prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =

82prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =

86 prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs

83 prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs

87 where

84 where

src/Language/PureScript/Sugar.hs−1

@@ -67,7 +67,6 @@ desugar :: (MonadSupply m, MonadError MultipleErrors m, MonadWriter MultipleErro

67desugar externs =

68 map removeSignedLiterals

69 >>> traverse desugarObjectConstructors

70− >=> traverse desugarOperatorSections

71 >=> traverse desugarDoModule

70 >=> traverse desugarDoModule

72 >=> desugarCasesModule

71 >=> desugarCasesModule

73 >=> desugarTypeDeclarationsModule

72 >=> desugarTypeDeclarationsModule

src/Language/PureScript/Sugar/ObjectWildcards.hs+4−2

@@ -39,10 +39,12 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

39 desugarExpr (Parens b)

40 | b' <- stripPositionInfo b

41 , BinaryNoParens op val u <- b'

42− , isAnonymousArgument u = return $ OperatorSection op (Left val)

42+ , isAnonymousArgument u = do arg <- freshIdent'

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

43 | b' <- stripPositionInfo b

44 | b' <- stripPositionInfo b

44 , BinaryNoParens op u val <- b'

45 , BinaryNoParens op u val <- b'

45− , isAnonymousArgument u = return $ OperatorSection op (Right val)

46+ , isAnonymousArgument u = do arg <- freshIdent'

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

46 desugarExpr (Literal (ObjectLiteral ps)) = wrapLambda (Literal . ObjectLiteral) ps

48 desugarExpr (Literal (ObjectLiteral ps)) = wrapLambda (Literal . ObjectLiteral) ps

47 desugarExpr (ObjectUpdate u ps) | isAnonymousArgument u = do

49 desugarExpr (ObjectUpdate u ps) | isAnonymousArgument u = do

48 obj <- freshIdent'

50 obj <- freshIdent'

src/Language/PureScript/Sugar/Operators.hs−24

@@ -13,7 +13,6 @@

13module Language.PureScript.Sugar.Operators

14 ( rebracket

15 , removeSignedLiterals

16− , desugarOperatorSections

17 ) where

16 ) where

18

17

19import Prelude ()

18import Prelude ()

@@ -32,7 +31,6 @@ import Language.PureScript.Types

32

31

33import Control.Monad ((<=<))

32import Control.Monad ((<=<))

34import Control.Monad.Error.Class (MonadError(..))

33import Control.Monad.Error.Class (MonadError(..))

35−import Control.Monad.Supply.Class

36

34

37import Data.Function (on)

35import Data.Function (on)

38import Data.Functor.Identity

36import Data.Functor.Identity

@@ -260,28 +258,6 @@ customOperatorTable fixities =

260 in

258 in

261 map (map (\(name, _, a) -> (name, a))) groups

259 map (map (\(name, _, a) -> (name, a))) groups

262

260

263−desugarOperatorSections

264− :: forall m

265− . (MonadSupply m, MonadError MultipleErrors m)

266− => Module

267− -> m Module

268−desugarOperatorSections (Module ss coms mn ds exts) =

269− Module ss coms mn <$> traverse goDecl ds <*> pure exts

270− where

271−

272− goDecl :: Declaration -> m Declaration

273− (goDecl, _, _) = everywhereOnValuesM return goExpr return

274−

275− goExpr :: Expr -> m Expr

276− goExpr (OperatorSection op eVal) = do

277− arg <- freshIdent'

278− let var = Var (Qualified Nothing arg)

279− f2 a b = Abs (Left arg) $ App (App op a) b

280− return $ case eVal of

281− Left val -> f2 val var

282− Right val -> f2 var val

283− goExpr other = return other

284−

285updateTypes

261updateTypes

286 :: forall m

262 :: forall m

287 . Monad m

263 . Monad m