6f0f53f · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #853 from purescript/object-getter-underscores

6f0f53fPhil Freeman12 years ago

examples/passing/ObjectGetter.purs+4−4

compare with golang

unifiedsplit

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

1module Main where

3−getX = (.x)

3+getX = _.x

5point = { x: 1, y: 0 }

7main = do

8 Debug.Trace.print $ getX point

9− Debug.Trace.trace $ (." 123 string Prop Name ") { " 123 string Prop Name ": "OK" }

9+ Debug.Trace.trace $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }

10− Debug.Trace.trace $ ((.x) >>> (.y)) { x: { y: "Nested" } }

10+ Debug.Trace.trace $ (_.x >>> _.y) { x: { y: "Nested" } }

11− Debug.Trace.trace $ (.value) { value: "Done!" }

11+ Debug.Trace.trace $ _.value { value: "Done!" }

examples/passing/ObjectUpdater.purs+3

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

31 print $ point'.x === 100

32 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

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

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

348 --

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

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

350 -- |

351 -- Function introduction

352 --

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

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

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

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

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

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

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

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

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

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

113 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

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

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

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

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

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

166 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

293 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

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

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

359 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

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

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

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

src/Language/PureScript/Parser/Declarations.hs+11−4

@@ -355,13 +355,14 @@ parseValueAtom = P.choice

355 , parseDo

356 , parseLet

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

358− , parseOperatorSection ]

358+ , parseOperatorSection

359+ , P.try parseObjectUpdaterWildcard ]

359

360

360-- |

361-- |

361-- Parse an expression in backticks or an operator

362-- Parse an expression in backticks or an operator

362--

363--

363parseInfixExpr :: TokenParser Expr

364parseInfixExpr :: TokenParser Expr

364−parseInfixExpr = P.between tick tick parseValue

365+parseInfixExpr = P.between tick tick parseValue

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

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

366

367

367parseOperatorSection :: TokenParser Expr

368parseOperatorSection :: TokenParser Expr

@@ -400,7 +401,7 @@ parseDoNotationElement = P.choice

400 , P.try (DoNotationValue <$> parseValue) ]

401 , P.try (DoNotationValue <$> parseValue) ]

401

402

402parseObjectGetter :: TokenParser Expr

403parseObjectGetter :: TokenParser Expr

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

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

404

405

405-- |

406-- |

406-- Parse a value

407-- Parse a value

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

413 where

414 where

414 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

415 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

415 postfixTable1 = [ parseAccessor

416 postfixTable1 = [ parseAccessor

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

417+ , P.try . parseUpdaterBody . Just ]

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

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

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

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

419 ]

420 ]

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

424 ]

425 ]

426 ]

426

427

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+

427parseStringBinder :: TokenParser Binder

434parseStringBinder :: TokenParser Binder

428parseStringBinder = StringBinder <$> stringLiteral

435parseStringBinder = StringBinder <$> stringLiteral

429

436

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

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

27import Control.Applicative

29import Language.PureScript.AST

30+import Language.PureScript.Names

30import Language.PureScript.Pretty.Common

31import Language.PureScript.Pretty.Common

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

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

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

151objectUpdate = mkPattern match

152objectUpdate = mkPattern match

152 where

153 where

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

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

155 match _ = Nothing

156 match _ = Nothing

156

157

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

158app :: 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

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

38 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

40 desugarExpr (ObjectGetter prop) = do

43 desugarExpr (ObjectGetter prop) = do

41 arg <- Ident <$> freshName

44 arg <- Ident <$> freshName

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

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