git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Underscores in the object position for updaters
67d9183Gary Burgess
examples/passing/ObjectUpdater.purs+3
@@ -30,3 +30,6 @@ main = do
30
30
31 print $ point'.x === 100
31 print $ point'.x === 100
32 print $ point'.y === 10
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
346 -- Partial record updater. This will be removed during desugaring and
347 -- expanded into a lambda that returns an object update.
347 -- expanded into a lambda that returns an object update.
348 --
348 --
349− | ObjectUpdater Expr [(String, Maybe Expr)]
349+ | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]
350 -- |
350 -- |
351 -- Function introduction
351 -- Function introduction
352 --
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))
53 g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
54 g' (Accessor prop v) = g (Accessor prop (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))
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))
57 g' (Abs name v) = g (Abs name (g' v))
58 g' (App v1 v2) = g (App (g' v1) (g' v2))
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))
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')
111 g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
112 g' (Accessor prop v) = Accessor prop <$> (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
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')
115 g' (Abs name v) = Abs name <$> (g v >>= g')
116 g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= 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')
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
164 g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
165 g' (Accessor prop v) = (Accessor prop <$> 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
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
168 g' (Abs name v) = (Abs name <$> g' v) >>= g
169 g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= 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
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
220 g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
221 g' v@(Accessor _ 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)
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
224 g' v@(Abs _ v1) = g v <> g' v1
225 g' v@(App v1 v2) = g v <> g' v1 <> g' v2
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
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
287 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
288 g' s (Accessor _ 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)
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
291 g' s (Abs _ v1) = g'' s v1
292 g' s (App v1 v2) = g'' s v1 <> g'' s v2
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
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
357 g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
358 g' s (Accessor prop v) = Accessor prop <$> 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
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
361 g' s (Abs name v) = Abs name <$> g'' s v
362 g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
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
363 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
355 , parseDo
355 , parseDo
356 , parseLet
356 , parseLet
357 , P.try $ Parens <$> parens parseValue
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
@@ -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 ]
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
27import Control.Applicative
28
28
29import Language.PureScript.AST
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)
32
33
@@ -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
36
36
37 desugarExpr :: Expr -> SupplyT (Either ErrorStack) Expr
37 desugarExpr :: Expr -> SupplyT (Either ErrorStack) Expr
38 desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps
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)))