22c9dfd · rowtype-yoga/purescript-native

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

Fix #1846, start work on '_ - 1' syntax for sections

commit22c9dfdaec294adb53257be090748dbf06cbb118 authorPhil Freeman <paf31@cantab.net> dateTue 2 Feb 2016, 21:12 (11 years ago) parent1b5d32d

9 files changed+88−103

compare with golang

unifiedsplit

examples/failing/AnonArgument.purs+5 examples/passing/ExplicitOperatorSections.purs+11 src/Language/PureScript/AST/Declarations.hs+4−15 src/Language/PureScript/AST/Traversals.hs+1−22 src/Language/PureScript/Errors.hs+25−19 src/Language/PureScript/Parser/Declarations.hs+14−20 src/Language/PureScript/Pretty/Values.hs+1−3 src/Language/PureScript/Sugar/ObjectWildcards.hs+26−15 src/Language/PureScript/Sugar/Operators.hs+1−9

examples/failing/AnonArgument.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldFailWith IncorrectAnonymousArgument

2+module Main where

4+test :: Int -> Int

5+test = _

examples/passing/ExplicitOperatorSections.pursnew file+11

@@ -0,0 +1,11 @@

1+module Main where

3+import Prelude

5+subtractOne :: Int -> Int

6+subtractOne = _ - 1

8+addOne :: Int -> Int

9+addOne = 1 + _

10+

11+main = Control.Monad.Eff.Console.log "Done"

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

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

334334 --

335335 | BinaryNoParens Expr Expr Expr

336336 -- |

337− -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor

338− -- will be removed.

339− --

340− | Parens Expr

341− -- |

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

343338 -- operator or lambda to flip the arguments.

344339 --

@@ -352,11 +347,6 @@ data Expr

352347 --

353348 | ObjectLiteral [(String, Expr)]

354349 -- |

355− -- An object constructor (object literal with underscores). This will be removed during

356− -- desugaring and expanded into a lambda that returns an object literal.

357− --

358− | ObjectConstructor [(String, Maybe Expr)]

359− -- |

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

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

362352 --

@@ -370,11 +360,6 @@ data Expr

370360 --

371361 | ObjectUpdate Expr [(String, Expr)]

372362 -- |

373− -- Partial record updater. This will be removed during desugaring and

374− -- expanded into a lambda that returns an object update.

375− --

376− | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]

377− -- |

378363 -- Function introduction

379364 --

380365 | Abs (Either Ident Binder) Expr

@@ -433,6 +418,10 @@ data Expr

433418 --

434419 | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]

435420 -- |

421+ -- A placeholder for an anonymous function argument

422+ --

423+ | AnonymousArgument

424+ -- |

436425 -- A value with source position information

437426 --

438427 | PositionedValue SourceSpan [Comment] Expr

src/Language/PureScript/AST/Traversals.hs+1−22

@@ -23,7 +23,7 @@ import Data.Foldable (fold)

2323import qualified Data.Set as S

2424

2525import Control.Monad

26−import Control.Arrow ((***), (+++), second)

26+import Control.Arrow ((***), (+++))

2727

2828import Language.PureScript.AST.Binders

2929import Language.PureScript.AST.Declarations

@@ -49,16 +49,13 @@ everywhereOnValues f g h = (f', g', h')

4949 g' :: Expr -> Expr

5050 g' (UnaryMinus v) = g (UnaryMinus (g' v))

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

52− g' (Parens v) = g (Parens (g' v))

5352 g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))

5453 g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))

5554 g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))

5655 g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))

57− g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))

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

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

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

61− g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))

6259 g' (Abs name v) = g (Abs name (g' v))

6360 g' (App v1 v2) = g (App (g' v1) (g' v2))

6461 g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))

@@ -107,16 +104,13 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

107104

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

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

110− g' (Parens v) = Parens <$> (g v >>= g')

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

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

113109 g' (ArrayLiteral vs) = ArrayLiteral <$> traverse (g' <=< g) vs

114110 g' (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g' <=< g)) vs

115− g' (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g' <=< g)) vs

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

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

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

119− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> traverse (sndM $ maybeM (g' <=< g)) vs

120114 g' (Abs name v) = Abs name <$> (g v >>= g')

121115 g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')

122116 g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')

@@ -160,16 +154,13 @@ everywhereOnValuesM f g h = (f', g', h')

160154

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

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

163− g' (Parens v) = (Parens <$> g' v) >>= g

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

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

166159 g' (ArrayLiteral vs) = (ArrayLiteral <$> traverse g' vs) >>= g

167160 g' (ObjectLiteral vs) = (ObjectLiteral <$> traverse (sndM g') vs) >>= g

168− g' (ObjectConstructor vs) = (ObjectConstructor <$> traverse (sndM $ maybeM g') vs) >>= g

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

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

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

172− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> traverse (sndM $ maybeM g') vs) >>= g

173164 g' (Abs name v) = (Abs name <$> g' v) >>= g

174165 g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g

175166 g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g

@@ -216,16 +207,13 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

216207

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

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

219− g' v@(Parens v1) = g v <> g' v1

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

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

222212 g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)

223213 g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)

224− g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))

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

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

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

228− g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))

229217 g' v@(Abs _ v1) = g v <> g' v1

230218 g' v@(App v1 v2) = g v <> g' v1 <> g' v2

231219 g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3

@@ -283,16 +271,13 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

283271

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

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

286− g' s (Parens v1) = g'' s v1

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

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

289276 g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)

290277 g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)

291− g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))

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

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

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

295− g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))

296281 g' s (Abs _ v1) = g'' s v1

297282 g' s (App v1 v2) = g'' s v1 <> g'' s v2

298283 g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3

@@ -353,16 +338,13 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

353338

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

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

356− g' s (Parens v) = Parens <$> g'' s v

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

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

359343 g' s (ArrayLiteral vs) = ArrayLiteral <$> traverse (g'' s) vs

360344 g' s (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g'' s)) vs

361− g' s (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g'' s)) vs

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

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

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

365− g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> traverse (sndM $ maybeM (g'' s)) vs

366348 g' s (Abs name v) = Abs name <$> g'' s v

367349 g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2

368350 g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3

@@ -435,16 +417,13 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)

435417

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

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

438− g' s (Parens v1) = g'' s v1

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

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

441422 g' s (ArrayLiteral vs) = foldMap (g'' s) vs

442423 g' s (ObjectLiteral vs) = foldMap (g'' s . snd) vs

443− g' s (ObjectConstructor vs) = foldMap (g'' s) (mapMaybe snd vs)

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

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

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

447− g' s (ObjectUpdater obj vs) = foldMap (g'' s) obj <> foldMap (g'' s) (mapMaybe snd vs)

448427 g' s (Abs (Left name) v1) =

449428 let s' = S.insert name s

450429 in g'' s' v1

src/Language/PureScript/Errors.hs+25−19

@@ -142,6 +142,7 @@ data SimpleErrorMessage

142142 | ImplicitImport ModuleName [DeclarationRef]

143143 | HidingImport ModuleName [DeclarationRef]

144144 | CaseBinderLengthDiffers Int [Binder]

145+ | IncorrectAnonymousArgument

145146 deriving (Show)

146147

147148-- | Error message hints, providing more detailed information about failure.

@@ -317,6 +318,7 @@ errorCode em = case unwrapErrorMessage em of

317318 ImplicitImport{} -> "ImplicitImport"

318319 HidingImport{} -> "HidingImport"

319320 CaseBinderLengthDiffers{} -> "CaseBinderLengthDiffers"

321+ IncorrectAnonymousArgument -> "IncorrectAnonymousArgument"

320322

321323-- |

322324-- A stack trace for an error

@@ -798,7 +800,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

798800 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =

799801 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."

800802 renderSimpleErrorMessage (ImportHidingModule name) =

801− paras [ line $ "'hiding' imports cannot be used to hide modules."

803+ paras [ line "'hiding' imports cannot be used to hide modules."

802804 , line $ "An attempt was made to hide the import of " ++ runModuleName name

803805 ]

804806 renderSimpleErrorMessage (WildcardInferredType ty) =

@@ -812,14 +814,14 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

812814 , indent $ typeAsBox ty

813815 ]

814816 renderSimpleErrorMessage (NotExhaustivePattern bs b) =

815− paras $ [ line "A case expression could not be determined to cover all inputs."

816− , line "The following additional cases are required to cover all inputs:\n"

817− , indent $ paras $

818− [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]

819− ++ [ line "..." | not b ]

820− , line "Or alternatively, add a Partial constraint to the type of the enclosing value."

821− , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."

822− ]

817+ paras [ line "A case expression could not be determined to cover all inputs."

818+ , line "The following additional cases are required to cover all inputs:\n"

819+ , indent $ paras $

820+ [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]

821+ ++ [ line "..." | not b ]

822+ , line "Or alternatively, add a Partial constraint to the type of the enclosing value."

823+ , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."

824+ ]

823825 renderSimpleErrorMessage (OverlappingPattern bs b) =

824826 paras $ [ line "A case expression contains unreachable cases:\n"

825827 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

@@ -835,7 +837,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

835837 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =

836838 paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"

837839 , indent $ paras $ map line names

838− , line $ "It could be replaced with:"

840+ , line "It could be replaced with:"

839841 , indent $ line $ showSuggestion msg ]

840842

841843 renderSimpleErrorMessage (UnusedDctorImport name) =

@@ -849,15 +851,15 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

849851 paras [ line $ "The operator (" ++ name ++ ") was declared as a value rather than an alias for a named function."

850852 , line "Operator aliases are declared by using a fixity declaration, for example:"

851853 , indent $ line $ "infixl 9 someFunction as " ++ name

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

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

853855 ]

854856

855857 renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =

856− paras [ line $ "Import uses the deprecated 'qualified' syntax:"

858+ paras [ line "Import uses the deprecated 'qualified' syntax:"

857859 , indent $ line $ "import qualified " ++ runModuleName name ++ " as " ++ runModuleName qualName

858860 , line "Should instead use the form:"

859861 , indent $ line $ "import " ++ runModuleName name ++ " as " ++ runModuleName qualName

860− , line $ "The deprecated syntax will be removed in PureScript 0.9."

862+ , line "The deprecated syntax will be removed in PureScript 0.9."

861863 ]

862864

863865 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

@@ -865,15 +867,15 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

865867 , indent $ line $ runProperName name

866868 , line "Should instead use the form:"

867869 , indent $ line $ "class " ++ runProperName name

868− , line $ "The deprecated syntax will be removed in PureScript 0.9."

870+ , line "The deprecated syntax will be removed in PureScript 0.9."

869871 ]

870872

871873 renderSimpleErrorMessage (DeprecatedClassExport name) =

872− paras [ line $ "Class export uses deprecated syntax that omits the 'class' keyword:"

874+ paras [ line "Class export uses deprecated syntax that omits the 'class' keyword:"

873875 , indent $ line $ runProperName name

874876 , line "Should instead use the form:"

875877 , indent $ line $ "class " ++ runProperName name

876− , line $ "The deprecated syntax will be removed in PureScript 0.9."

878+ , line "The deprecated syntax will be removed in PureScript 0.9."

877879 ]

878880

879881 renderSimpleErrorMessage (RedundantUnqualifiedImport name imp) =

@@ -915,9 +917,13 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

915917 ]

916918

917919 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =

918− paras $ [ line $ "Binder list length differs in case alternative:"

919− , indent $ line $ intercalate ", " $ fmap prettyPrintBinderAtom bs

920− , line $ "Expecting " ++ show l ++ " binder" ++ (if l == 1 then "" else "s") ++ "." ]

920+ paras [ line "Binder list length differs in case alternative:"

921+ , indent $ line $ intercalate ", " $ fmap prettyPrintBinderAtom bs

922+ , line $ "Expecting " ++ show l ++ " binder" ++ (if l == 1 then "" else "s") ++ "."

923+ ]

924+

925+ renderSimpleErrorMessage IncorrectAnonymousArgument =

926+ line "An anonymous function argument appears in an invalid context."

921927

922928 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

923929 renderHint (ErrorUnifyingTypes t1 t2) detail =

src/Language/PureScript/Parser/Declarations.hs+14−20

@@ -312,18 +312,17 @@ parseArrayLiteral :: TokenParser Expr

312312parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)

313313

314314parseObjectLiteral :: TokenParser Expr

315−parseObjectLiteral = ObjectConstructor <$> braces (commaSep parseIdentifierAndValue)

315+parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)

316316

317−parseIdentifierAndValue :: TokenParser (String, Maybe Expr)

317+parseIdentifierAndValue :: TokenParser (String, Expr)

318318parseIdentifierAndValue =

319319 do

320320 name <- C.indented *> lname

321− b <- P.option (Just $ Var $ Qualified Nothing (Ident name)) rest

321+ b <- P.option (Var $ Qualified Nothing (Ident name)) rest

322322 return (name, b)

323323 <|> (,) <$> (C.indented *> stringLiteral) <*> rest

324324 where

325− rest = C.indented *> colon *> C.indented *> val

326− val = P.try (Just <$> parseValue) <|> (underscore *> pure Nothing)

325+ rest = C.indented *> colon *> C.indented *> parseValue

327326

328327parseAbs :: TokenParser Expr

329328parseAbs = do

@@ -373,13 +372,13 @@ parseLet = do

373372

374373parseValueAtom :: TokenParser Expr

375374parseValueAtom = P.choice

376− [ parseNumericLiteral

375+ [ parseAnonymousArgument

376+ , parseNumericLiteral

377377 , parseCharLiteral

378378 , parseStringLiteral

379379 , parseBooleanLiteral

380380 , parseArrayLiteral

381381 , P.try parseObjectLiteral

382− , P.try parseObjectGetter

383382 , parseAbs

384383 , P.try parseConstructor

385384 , P.try parseVar

@@ -387,10 +386,8 @@ parseValueAtom = P.choice

387386 , parseIfThenElse

388387 , parseDo

389388 , parseLet

390− , P.try $ Parens <$> parens parseValue

389+ , P.try $ parens parseValue

391390 , parseOperatorSection

392− -- TODO: combine this with parseObjectGetter

393− , parseObjectUpdaterWildcard

394391 ]

395392

396393-- |

@@ -406,11 +403,11 @@ parseOperatorSection = parens $ left <|> right

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

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

408405

409−parsePropertyUpdate :: TokenParser (String, Maybe Expr)

406+parsePropertyUpdate :: TokenParser (String, Expr)

410407parsePropertyUpdate = do

411408 name <- lname <|> stringLiteral

412409 _ <- C.indented *> equals

413− value <- C.indented *> (underscore *> pure Nothing) <|> (Just <$> parseValue)

410+ value <- C.indented *> parseValue

414411 return (name, value)

415412

416413parseAccessor :: Expr -> TokenParser Expr

@@ -436,15 +433,12 @@ parseDoNotationElement = P.choice

436433 , DoNotationValue <$> parseValue

437434 ]

438435

439−parseObjectGetter :: TokenParser Expr

440−parseObjectGetter = ObjectGetter <$> (underscore *> C.indented *> dot *> C.indented *> (lname <|> stringLiteral))

441−

442436-- | Expressions including indexers and record updates

443437indexersAndAccessors :: TokenParser Expr

444438indexersAndAccessors = C.buildPostfixParser postfixTable parseValueAtom

445439 where

446440 postfixTable = [ parseAccessor

447− , P.try . parseUpdaterBody . Just

441+ , P.try . parseUpdaterBody

448442 ]

449443

450444-- |

@@ -466,11 +460,11 @@ parseValue = withSourceSpan PositionedValue

466460 ]

467461 ]

468462

469−parseUpdaterBody :: Maybe Expr -> TokenParser Expr

470−parseUpdaterBody v = ObjectUpdater v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))

463+parseUpdaterBody :: Expr -> TokenParser Expr

464+parseUpdaterBody v = ObjectUpdate v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))

471465

472−parseObjectUpdaterWildcard :: TokenParser Expr

473−parseObjectUpdaterWildcard = underscore *> C.indented *> parseUpdaterBody Nothing

466+parseAnonymousArgument :: TokenParser Expr

467+parseAnonymousArgument = underscore *> pure AnonymousArgument

474468

475469parseStringBinder :: TokenParser Binder

476470parseStringBinder = StringBinder <$> stringLiteral

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

@@ -57,7 +57,6 @@ prettyPrintValue d (IfThenElse cond th el) =

5757 ])

5858prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> text ("." ++ show prop)

5959prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> prettyPrintValue (d - 1) val) ps

60−prettyPrintValue d (ObjectUpdater o ps) = maybe (text "_") (prettyPrintValueAtom (d - 1)) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> maybe (text "_") (prettyPrintValue (d - 1)) val) ps

6160prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg

6261prettyPrintValue d (Abs (Left arg) val) = text ('\\' : showIdent arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)

6362prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =

@@ -86,8 +85,7 @@ prettyPrintValueAtom _ (BooleanLiteral True) = text "true"

8685prettyPrintValueAtom _ (BooleanLiteral False) = text "false"

8786prettyPrintValueAtom d (ArrayLiteral xs) = list '[' ']' (prettyPrintValue (d - 1)) xs

8887prettyPrintValueAtom d (ObjectLiteral ps) = prettyPrintObject (d - 1) $ second Just `map` ps

89−prettyPrintValueAtom d (ObjectConstructor ps) = prettyPrintObject (d - 1) ps

90−prettyPrintValueAtom _ (ObjectGetter prop) = text $ "_." ++ show prop

88+prettyPrintValueAtom _ AnonymousArgument = text "_"

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

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

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

src/Language/PureScript/Sugar/ObjectWildcards.hs+26−15

@@ -8,12 +8,11 @@ module Language.PureScript.Sugar.ObjectWildcards (

88import Prelude ()

99import Prelude.Compat

1010

11−import Control.Arrow (second)

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

1312import Control.Monad.Supply.Class

1413

1514import Data.List (partition)

16−import Data.Maybe (isJust, fromJust, catMaybes)

15+import Data.Maybe (catMaybes)

1716

1817import Language.PureScript.AST

1918import Language.PureScript.Errors

@@ -24,30 +23,42 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

2423 where

2524

2625 desugarDecl :: Declaration -> m Declaration

27− (desugarDecl, _, _) = everywhereOnValuesM return desugarExpr return

26+ desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d

27+ desugarDecl other = f other

28+ where

29+ (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return

2830

2931 desugarExpr :: Expr -> m Expr

30− desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps

31− desugarExpr (ObjectUpdater (Just obj) ps) = wrapLambda (ObjectUpdate obj) ps

32− desugarExpr (ObjectUpdater Nothing ps) = do

32+ desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument

33+ desugarExpr (BinaryNoParens op val u) | isAnonymousArgument u = return $ OperatorSection op (Left val)

34+ desugarExpr (BinaryNoParens op u val) | isAnonymousArgument u = return $ OperatorSection op (Right val)

35+ desugarExpr (ObjectLiteral ps) = wrapLambda ObjectLiteral ps

36+ desugarExpr (ObjectUpdate u ps) | isAnonymousArgument u = do

3337 obj <- freshIdent'

3438 Abs (Left obj) <$> wrapLambda (ObjectUpdate (Var (Qualified Nothing obj))) ps

35− desugarExpr (ObjectGetter prop) = do

39+ desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps

40+ desugarExpr (Accessor prop u) | isAnonymousArgument u = do

3641 arg <- freshIdent'

3742 return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))

3843 desugarExpr e = return e

3944

40− wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Maybe Expr)] -> m Expr

45+ wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Expr)] -> m Expr

4146 wrapLambda mkVal ps =

42− let (props, args) = partition (isJust . snd) ps

47+ let (args, props) = partition (isAnonymousArgument . snd) ps

4348 in if null args

44− then return . mkVal $ second fromJust `map` props

49+ then return $ mkVal props

4550 else do

4651 (args', ps') <- unzip <$> mapM mkProp ps

4752 return $ foldr (Abs . Left) (mkVal ps') (catMaybes args')

4853

49− mkProp :: (String, Maybe Expr) -> m (Maybe Ident, (String, Expr))

50− mkProp (name, Just e) = return (Nothing, (name, e))

51− mkProp (name, Nothing) = do

52− arg <- freshIdent'

53− return (Just arg, (name, Var (Qualified Nothing arg)))

54+ isAnonymousArgument :: Expr -> Bool

55+ isAnonymousArgument AnonymousArgument = True

56+ isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e

57+ isAnonymousArgument _ = False

58+

59+ mkProp :: (String, Expr) -> m (Maybe Ident, (String, Expr))

60+ mkProp (name, e)

61+ | isAnonymousArgument e = do

62+ arg <- freshIdent'

63+ return (Just arg, (name, Var (Qualified Nothing arg)))

64+ | otherwise = return (Nothing, (name, e))

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

@@ -77,15 +77,7 @@ removeSignedLiterals (Module ss coms mn ds exts) = Module ss coms mn (map f' ds)

7777rebracketModule :: (Applicative m, MonadError MultipleErrors m) => [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Module -> m Module

7878rebracketModule opTable (Module ss coms mn ds exts) =

7979 let (f, _, _) = everywhereOnValuesTopDownM return (matchOperators opTable) return

80− in Module ss coms mn <$> (map removeParens <$> parU ds f) <*> pure exts

81−

82−removeParens :: Declaration -> Declaration

83−removeParens =

84− let (f, _, _) = everywhereOnValues id go id

85− in f

86− where

87− go (Parens val) = val

88− go val = val

80+ in Module ss coms mn <$> parU ds f <*> pure exts

8981

9082externsFixities :: ExternsFile -> [(Qualified Ident, SourceSpan, Fixity, Maybe (Qualified Ident))]

9183externsFixities ExternsFile{..} =