7e92e7c · rowtype-yoga/purescript-native

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

Remove legacy operator sections, merge #2024

commit7e92e7cc1580dc6a6a787f4ab4f05f7647d9fec8 authorPhil Freeman <paf31@cantab.net> dateSat 30 Apr 2016, 14:37 (11 years ago) parent7fcebc8

14 files changed+18−98

compare with golang

unifiedsplit

examples/failing/SuggestComposition.purs+1−1

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

55import Prelude

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

33import Prelude

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

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

77main = shout "Done"

examples/passing/ContextSimplification.purs+1−1

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

33import Prelude

44import Control.Monad.Eff.Console

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

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

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

99-- constraint is added.

examples/passing/MonadState.purs+1−1

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

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

5959 same = id

6060

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

44import Test.Assert

66main = do

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

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

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

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

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

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

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

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

1111 let foo = { x: 2.0 }

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

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

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

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

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

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

16− 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

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

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

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

360360 --

361361 | Parens Expr

362362 -- |

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

364− --

365− | OperatorSection Expr (Either Expr Expr)

366− -- |

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

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

369365 --

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

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

4747 g' (UnaryMinus v) = g (UnaryMinus (g' v))

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

4949 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))

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

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

5452 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)

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

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

118116 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'))

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

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

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

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

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

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

187183 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

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

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

192186 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')

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

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

261255 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

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

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

266258 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'

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

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

340332 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

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

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

345335 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

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

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

421411 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)

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

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

426414 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)

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

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

512500 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

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

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

517503 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 ((&&&))

2525import Language.PureScript.Crash

2626import Language.PureScript.AST

2727import Language.PureScript.Pretty

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

2928import Language.PureScript.Types

3029import Language.PureScript.Names

3130import Language.PureScript.Kinds

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

141140 | UnusedDctorImport (ProperName 'TypeName)

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

143142 | DeprecatedOperatorDecl String

144− | DeprecatedOperatorSection Expr (Either Expr Expr)

145143 | DeprecatedClassImport ModuleName (ProperName 'ClassName)

146144 | DeprecatedClassExport (ProperName 'ClassName)

147145 | DuplicateSelectiveImport ModuleName

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

329327 UnusedDctorImport{} -> "UnusedDctorImport"

330328 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

331329 DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"

332− DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"

333330 DeprecatedClassImport{} -> "DeprecatedClassImport"

334331 DeprecatedClassExport{} -> "DeprecatedClassExport"

335332 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"

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

455452-- TODO Other possible suggestions:

456453-- WildcardInferredType - source span not small enough

457454-- 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?

459456errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

460457errorSuggestion err = case err of

461458 UnusedImport{} -> emptySuggestion

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

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

924921 ]

925922

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−

951923 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

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

953925 , indent $ line $ runProperName name

src/Language/PureScript/Linter.hs−1

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

7171 go d | Just i <- getDeclIdent d

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

7373 | otherwise = mempty

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

7574 stepE _ _ = mempty

7675

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

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

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

373373 , Literal <$> parseStringLiteral

374374 , Literal <$> parseBooleanLiteral

375375 , Literal <$> parseArrayLiteral parseValue

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

376+ , Literal <$> parseObjectLiteral parseIdentifierAndValue

377377 , parseAbs

378378 , P.try parseConstructor

379379 , P.try parseVar

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

382382 , parseDo

383383 , parseLet

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

385− , parseOperatorSection

386385 , parseHole

387386 ]

388387

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

393392parseInfixExpr = P.between tick tick parseValue

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

395394

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−

402395parseHole :: TokenParser Expr

403396parseHole = Hole <$> holeLit

404397

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

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

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

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

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

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

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

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

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

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

8079prettyPrintValueAtom _ AnonymousArgument = text "_"

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

8281prettyPrintValueAtom _ (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 ")"

8582prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =

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

8784 where

src/Language/PureScript/Sugar.hs−1

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

6767desugar externs =

6868 map removeSignedLiterals

6969 >>> traverse desugarObjectConstructors

70− >=> traverse desugarOperatorSections

7170 >=> traverse desugarDoModule

7271 >=> desugarCasesModule

7372 >=> 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

3939 desugarExpr (Parens b)

4040 | b' <- stripPositionInfo b

4141 , 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))

4344 | b' <- stripPositionInfo b

4445 , 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

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

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

4850 obj <- freshIdent'

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

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

1313module Language.PureScript.Sugar.Operators

1414 ( rebracket

1515 , removeSignedLiterals

16− , desugarOperatorSections

1716 ) where

1817

1918import Prelude ()

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

3231

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

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

35−import Control.Monad.Supply.Class

3634

3735import Data.Function (on)

3836import Data.Functor.Identity

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

260258 in

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

262260

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−

285261updateTypes

286262 :: forall m

287263 . Monad m