git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Object wildcards
commitc98a6f9d77514c009464c3efabac526873841d7f authorGary Burgess <gary.burgess@gmail.com> dateFri 6 Feb 2015, 17:10 (12 years ago) parente33e9d2
4 files changed+70−12
compare with golang
unifiedsplit
src/Language/PureScript/AST/Declarations.hs+5 src/Language/PureScript/Parser/Declarations.hs+5−3 src/Language/PureScript/Sugar.hs+15−9 src/Language/PureScript/Sugar/ObjectWildcards.hs+45
src/Language/PureScript/AST/Declarations.hs+5
@@ -320,6 +320,11 @@ data Expr
320320 --
321321 | ObjectLiteral [(String, Expr)]
322322 -- |
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+ -- |
323328 -- An record property accessor expression
324329 --
325330 | Accessor String Expr
src/Language/PureScript/Parser/Declarations.hs+5−3
@@ -285,11 +285,13 @@ parseArrayLiteral :: TokenParser Expr
285285parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
286286
287287parseObjectLiteral :: TokenParser Expr
288−parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)
288+parseObjectLiteral = ObjectConstructor <$> braces (commaSep parseIdentifierAndValue)
289289
290−parseIdentifierAndValue :: TokenParser (String, Expr)
290+parseIdentifierAndValue :: TokenParser (String, Maybe Expr)
291291parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
292− <*> (C.indented *> parseValue)
292+ <*> (C.indented *> val)
293+ where
294+ val = (Just <$> parseValue) <|> (underscore *> pure Nothing)
293295
294296parseAbs :: TokenParser Expr
295297parseAbs = do
src/Language/PureScript/Sugar.hs+15−9
@@ -23,20 +23,21 @@ import Language.PureScript.AST
2323import Language.PureScript.Errors
2424import Language.PureScript.Supply
2525
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
3026import 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
3229import 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
3334
3435-- |
3536-- The desugaring pipeline proceeds as follows:
3637--
37−-- * Introduce type synonyms for type class dictionaries
38+-- * Remove signed literals in favour of `negate` applications
3839--
39−-- * Rebracket user-defined binary operators
40+-- * Desguar object literals with wildcards into lambdas
4041--
4142-- * Desugar do-notation using the @Prelude.Monad@ type class
4243--
@@ -44,12 +45,17 @@ import Language.PureScript.Sugar.Names as S
4445--
4546-- * Desugar type declarations into value declarations with explicit type annotations
4647--
47−-- * Group mutually recursive value and data declarations into binding groups.
48−--
4948-- * Qualify any unqualified names and types
5049--
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+--
5156desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]
5257desugar = map removeSignedLiterals
58+ >>> map desugarObjectConstructors
5359 >>> mapM desugarDoModule
5460 >=> desugarCasesModule
5561 >=> 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)))