git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Allow anonymous accessor chains (_.a.b) (#2264)
fc8697aRémi Vion
examples/passing/1807.pursnew file+14
compare with golang
unifiedsplit
@@ -0,0 +1,14 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console (log)
5+
6+fn = _.b.c.d
7+a = {b:{c:{d:2}}}
8+
9+d :: Int
10+d = fn a + a.b.c.d
11+
12+main = if fn a + a.b.c.d == 4
13+ then log "Done"
14+ else log "Fail"
src/Language/PureScript/Sugar/ObjectWildcards.hs+16−9
@@ -1,5 +1,6 @@
1module Language.PureScript.Sugar.ObjectWildcards
1module Language.PureScript.Sugar.ObjectWildcards
2 ( desugarObjectConstructors
2 ( desugarObjectConstructors
3+ , desugarDecl
3 ) where
4 ) where
4
5
5import Prelude.Compat
6import Prelude.Compat
@@ -21,13 +22,12 @@ desugarObjectConstructors
21 => Module
22 => Module
22 -> m Module
23 -> m Module
23desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts
24desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts
24− where
25
25
26− desugarDecl :: Declaration -> m Declaration
26+desugarDecl :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration
27− desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d
27+desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d
28− desugarDecl other = f other
28+desugarDecl other = fn other
29− where
29+ where
30− (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return
30+ (fn, _, _) = everywhereOnValuesTopDownM return desugarExpr return
31
31
32 desugarExpr :: Expr -> m Expr
32 desugarExpr :: Expr -> m Expr
33 desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument
33 desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument
@@ -45,9 +45,10 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
45 obj <- freshIdent'
45 obj <- freshIdent'
46 Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps
46 Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps
47 desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps
47 desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps
48− desugarExpr (Accessor prop u) | isAnonymousArgument u = do
48+ desugarExpr (Accessor prop u)
49+ | Just props <- peelAnonAccessorChain u = do
49− arg <- freshIdent'
50+ arg <- freshIdent'
50− return $ Abs (Left arg) (Accessor prop (argToExpr arg))
51+ return $ Abs (Left arg) $ foldr Accessor (argToExpr arg) (prop:props)
51 desugarExpr (Case args cas) | any isAnonymousArgument args = do
52 desugarExpr (Case args cas) | any isAnonymousArgument args = do
52 argIdents <- forM args freshIfAnon
53 argIdents <- forM args freshIfAnon
53 let args' = zipWith (`maybe` argToExpr) args argIdents
54 let args' = zipWith (`maybe` argToExpr) args argIdents
@@ -73,6 +74,12 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
73 stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e
74 stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e
74 stripPositionInfo e = e
75 stripPositionInfo e = e
75
76
77+ peelAnonAccessorChain :: Expr -> Maybe [String]
78+ peelAnonAccessorChain (Accessor p e) = (p :) <$> peelAnonAccessorChain e
79+ peelAnonAccessorChain (PositionedValue _ _ e) = peelAnonAccessorChain e
80+ peelAnonAccessorChain AnonymousArgument = Just []
81+ peelAnonAccessorChain _ = Nothing
82+
76 isAnonymousArgument :: Expr -> Bool
83 isAnonymousArgument :: Expr -> Bool
77 isAnonymousArgument AnonymousArgument = True
84 isAnonymousArgument AnonymousArgument = True
78 isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e
85 isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e