67d9183 · rowtype-yoga/purescript-native

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

Underscores in the object position for updaters

commit67d9183afed11c3d7109d84b45d536942cbdc098 authorGary Burgess <gary.burgess@gmail.com> dateSun 8 Feb 2015, 23:53 (12 years ago) parent99d3fd8

6 files changed+25−11

compare with golang

unifiedsplit

examples/passing/ObjectUpdater.purs+3 src/Language/PureScript/AST/Declarations.hs+1−1 src/Language/PureScript/AST/Traversals.hs+6−6 src/Language/PureScript/Parser/Declarations.hs+9−2 src/Language/PureScript/Pretty/Values.hs+2−1 src/Language/PureScript/Sugar/ObjectWildcards.hs+4−1

examples/passing/ObjectUpdater.purs+3

@@ -30,3 +30,6 @@ main = do

3030

3131 print $ point'.x === 100

3232 print $ point'.y === 10

33+

34+ let record2 = (_ { x = _ }) { x: 0 } 10

35+ print $ record2.x === 10

src/Language/PureScript/AST/Declarations.hs+1−1

@@ -346,7 +346,7 @@ data Expr

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

347347 -- expanded into a lambda that returns an object update.

348348 --

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

349+ | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]

350350 -- |

351351 -- Function introduction

352352 --

src/Language/PureScript/AST/Traversals.hs+6−6

@@ -53,7 +53,7 @@ everywhereOnValues f g h = (f', g', h')

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

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

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

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

56+ g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))

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

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

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

@@ -111,7 +111,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

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

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

113113 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs

114− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (g obj >>= g') <*> mapM (sndM $ maybeM (g' <=< g)) vs

114+ g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> mapM (sndM $ maybeM (g' <=< g)) vs

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

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

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

@@ -164,7 +164,7 @@ everywhereOnValuesM f g h = (f', g', h')

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

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

166166 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g

167− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> g' obj <*> mapM (sndM $ maybeM g') vs) >>= g

167+ g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> mapM (sndM $ maybeM g') vs) >>= g

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

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

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

@@ -220,7 +220,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

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

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

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

223− g' v@(ObjectUpdater obj vs) = foldl (<>) (g v <> g' obj) (map g' (mapMaybe snd vs))

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

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

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

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

@@ -287,7 +287,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

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

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

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

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

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

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

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

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

@@ -357,7 +357,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

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

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

359359 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs

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

360+ g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> mapM (sndM $ maybeM (g'' s)) vs

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

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

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

src/Language/PureScript/Parser/Declarations.hs+9−2

@@ -355,7 +355,8 @@ parseValueAtom = P.choice

355355 , parseDo

356356 , parseLet

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

358− , parseOperatorSection ]

358+ , parseOperatorSection

359+ , P.try parseObjectUpdaterWildcard ]

359360

360361-- |

361362-- Parse an expression in backticks or an operator

@@ -413,7 +414,7 @@ parseValue = withSourceSpan PositionedValue

413414 where

414415 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

415416 postfixTable1 = [ parseAccessor

416− , \v -> P.try $ flip ObjectUpdater <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]

417+ , P.try . parseUpdaterBody . Just ]

417418 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v

418419 , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v

419420 ]

@@ -424,6 +425,12 @@ parseValue = withSourceSpan PositionedValue

424425 ]

425426 ]

426427

428+parseUpdaterBody :: Maybe Expr -> TokenParser Expr

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

430+

431+parseObjectUpdaterWildcard :: TokenParser Expr

432+parseObjectUpdaterWildcard = underscore *> C.indented *> parseUpdaterBody Nothing

433+

427434parseStringBinder :: TokenParser Binder

428435parseStringBinder = StringBinder <$> stringLiteral

429436

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

@@ -27,6 +27,7 @@ import Control.Monad.State

2727import Control.Applicative

2828

2929import Language.PureScript.AST

30+import Language.PureScript.Names

3031import Language.PureScript.Pretty.Common

3132import Language.PureScript.Pretty.Types (prettyPrintType)

3233

@@ -151,7 +152,7 @@ objectUpdate :: Pattern PrinterState Expr ([String], Expr)

151152objectUpdate = mkPattern match

152153 where

153154 match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)

154− match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, o)

155+ match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, fromMaybe (Var (Qualified Nothing $ Ident "_")) o)

155156 match _ = Nothing

156157

157158app :: Pattern PrinterState Expr (String, Expr)

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

@@ -36,7 +36,10 @@ desugarObjectConstructors (Module mn ds exts) = Module mn <$> mapM desugarDecl d

3636

3737 desugarExpr :: Expr -> SupplyT (Either ErrorStack) Expr

3838 desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps

39− desugarExpr (ObjectUpdater obj ps) = wrapLambda (ObjectUpdate obj) ps

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

40+ desugarExpr (ObjectUpdater Nothing ps) = do

41+ obj <- Ident <$> freshName

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

4043 desugarExpr (ObjectGetter prop) = do

4144 arg <- Ident <$> freshName

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