git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Object wildcards
c98a6f9Gary Burgess
src/Language/PureScript/AST/Declarations.hs+5
compare with golang
unifiedsplit
@@ -320,6 +320,11 @@ data Expr
320 --
320 --
321 | ObjectLiteral [(String, Expr)]
321 | ObjectLiteral [(String, Expr)]
322 -- |
322 -- |
323+ -- An object constructor (object literal with underscores). This will be removed during
324+ -- desugaring and expanded into a lambda that returns an object literal.
325+ --
326+ | ObjectConstructor [(String, Maybe Expr)]
327+ -- |
323 -- An record property accessor expression
328 -- An record property accessor expression
324 --
329 --
325 | Accessor String Expr
330 | Accessor String Expr
src/Language/PureScript/Parser/Declarations.hs+5−3
@@ -285,11 +285,13 @@ parseArrayLiteral :: TokenParser Expr
285parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
285parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
286
286
287parseObjectLiteral :: TokenParser Expr
287parseObjectLiteral :: TokenParser Expr
288−parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)
288+parseObjectLiteral = ObjectConstructor <$> braces (commaSep parseIdentifierAndValue)
289
289
290−parseIdentifierAndValue :: TokenParser (String, Expr)
290+parseIdentifierAndValue :: TokenParser (String, Maybe Expr)
291parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
291parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
292− <*> (C.indented *> parseValue)
292+ <*> (C.indented *> val)
293+ where
294+ val = (Just <$> parseValue) <|> (underscore *> pure Nothing)
293
295
294parseAbs :: TokenParser Expr
296parseAbs :: TokenParser Expr
295parseAbs = do
297parseAbs = do
src/Language/PureScript/Sugar.hs+15−9
@@ -23,20 +23,21 @@ import Language.PureScript.AST
23import Language.PureScript.Errors
23import Language.PureScript.Errors
24import Language.PureScript.Supply
24import Language.PureScript.Supply
25
25
26−import Language.PureScript.Sugar.Operators as S
27−import Language.PureScript.Sugar.DoNotation as S
28−import Language.PureScript.Sugar.CaseDeclarations as S
29−import Language.PureScript.Sugar.TypeDeclarations as S
30import Language.PureScript.Sugar.BindingGroups as S
26import Language.PureScript.Sugar.BindingGroups as S
31−import Language.PureScript.Sugar.TypeClasses as S
27+import Language.PureScript.Sugar.CaseDeclarations as S
28+import Language.PureScript.Sugar.DoNotation as S
32import Language.PureScript.Sugar.Names as S
29import Language.PureScript.Sugar.Names as S
30+import Language.PureScript.Sugar.ObjectWildcards as S
31+import Language.PureScript.Sugar.Operators as S
32+import Language.PureScript.Sugar.TypeClasses as S
33+import Language.PureScript.Sugar.TypeDeclarations as S
33
34
34-- |
35-- |
35-- The desugaring pipeline proceeds as follows:
36-- The desugaring pipeline proceeds as follows:
36--
37--
37−-- * Introduce type synonyms for type class dictionaries
38+-- * Remove signed literals in favour of `negate` applications
38--
39--
39−-- * Rebracket user-defined binary operators
40+-- * Desguar object literals with wildcards into lambdas
40--
41--
41-- * Desugar do-notation using the @Prelude.Monad@ type class
42-- * Desugar do-notation using the @Prelude.Monad@ type class
42--
43--
@@ -44,12 +45,17 @@ import Language.PureScript.Sugar.Names as S
44--
45--
45-- * Desugar type declarations into value declarations with explicit type annotations
46-- * Desugar type declarations into value declarations with explicit type annotations
46--
47--
47−-- * Group mutually recursive value and data declarations into binding groups.
48−--
49-- * Qualify any unqualified names and types
48-- * Qualify any unqualified names and types
50--
49--
50+-- * Rebracket user-defined binary operators
51+--
52+-- * Introduce type synonyms for type class dictionaries
53+--
54+-- * Group mutually recursive value and data declarations into binding groups.
55+--
51desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]
56desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]
52desugar = map removeSignedLiterals
57desugar = map removeSignedLiterals
58+ >>> map desugarObjectConstructors
53 >>> mapM desugarDoModule
59 >>> mapM desugarDoModule
54 >=> desugarCasesModule
60 >=> desugarCasesModule
55 >=> lift . (desugarTypeDeclarationsModule
61 >=> lift . (desugarTypeDeclarationsModule
src/Language/PureScript/Sugar/ObjectWildcards.hsnew file+45
@@ -0,0 +1,45 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Sugar.ObjectWildcards
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.Sugar.ObjectWildcards (
16+ desugarObjectConstructors
17+) where
18+
19+import Control.Arrow (second)
20+
21+import Data.List (partition)
22+import Data.Maybe (isJust, fromJust)
23+
24+import Language.PureScript.AST
25+import Language.PureScript.Names
26+
27+desugarObjectConstructors :: Module -> Module
28+desugarObjectConstructors (Module mn ds exts) = Module mn (map desugarDecl ds) exts
29+
30+desugarDecl :: Declaration -> Declaration
31+desugarDecl d =
32+ let (f, _, _) = everywhereOnValues id desugarExpr id
33+ in f d
34+
35+desugarExpr :: Expr -> Expr
36+desugarExpr (ObjectConstructor ps) =
37+ let (props, args) = partition (isJust . snd) ps
38+ in if null args
39+ then ObjectLiteral $ second fromJust `map` props
40+ else foldr (Abs . Left . Ident . fst) (ObjectLiteral (mkProp `map` ps)) (reverse args)
41+desugarExpr e = e
42+
43+mkProp :: (String, Maybe Expr) -> (String, Expr)
44+mkProp (name, Just e) = (name, e)
45+mkProp (name, Nothing) = (name, Var (Qualified Nothing (Ident name)))