git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2020 from purescript/1558-case-wildcards

Wildcards for case and if

commit1fe80a5782868946db77becb451dabbe40fe5861 authorGary Burgess <gary.burgess@gmail.com> dateSat 16 Apr 2016, 18:41 (11 years ago) parentf6f4de90a67e5b
3 files changed+61−7
compare with golang
unifiedsplit
examples/passing/CaseInputWildcard.purs+18 examples/passing/IfWildcard.purs+19 src/Language/PureScript/Sugar/ObjectWildcards.hs+24−7
examples/passing/CaseInputWildcard.pursnew file+18
@@ -0,0 +1,18 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff (Eff)
5+import Control.Monad.Eff.Console (log, CONSOLE)
6+
7+data Foo = X | Y
8+
9+what ∷ Foo → Int → Boolean → Foo
10+what x = case _, x, _ of
11+ 0, X, true → X
12+ 0, Y, true → X
13+ _, _, _ → Y
14+
15+main :: forall e. Eff (console :: CONSOLE | e) Unit
16+main = do
17+ let tmp = what Y 0 true
18+ log "Done"
examples/passing/IfWildcard.pursnew file+19
@@ -0,0 +1,19 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff (Eff)
5+import Control.Monad.Eff.Console (log, CONSOLE)
6+
7+data Foo = X | Y
8+
9+cond ∷ ∀ a. Boolean → a → a → a
10+cond = if _ then _ else _
11+
12+what ∷ Boolean → Foo
13+what = if _ then X else Y
14+
15+main :: forall e. Eff (console :: CONSOLE | e) Unit
16+main = do
17+ let tmp1 = what true
18+ tmp2 = cond true 0 1
19+ log "Done"
src/Language/PureScript/Sugar/ObjectWildcards.hs+24−7
@@ -9,6 +9,7 @@ module Language.PureScript.Sugar.ObjectWildcards (
99import Prelude ()
1010import Prelude.Compat
1111
12+import Control.Monad (forM)
1213import Control.Monad.Error.Class (MonadError(..))
1314import Control.Monad.Supply.Class
1415
@@ -45,11 +46,21 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
4546 desugarExpr (Literal (ObjectLiteral ps)) = wrapLambda (Literal . ObjectLiteral) ps
4647 desugarExpr (ObjectUpdate u ps) | isAnonymousArgument u = do
4748 obj <- freshIdent'
48− Abs (Left obj) <$> wrapLambda (ObjectUpdate (Var (Qualified Nothing obj))) ps
49+ Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps
4950 desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps
5051 desugarExpr (Accessor prop u) | isAnonymousArgument u = do
5152 arg <- freshIdent'
52− return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))
53+ return $ Abs (Left arg) (Accessor prop (argToExpr arg))
54+ desugarExpr (Case args cas) | any isAnonymousArgument args = do
55+ argIdents <- forM args freshIfAnon
56+ let args' = zipWith (\p -> maybe p argToExpr) args argIdents
57+ return $ foldr (Abs . Left) (Case args' cas) (catMaybes argIdents)
58+ desugarExpr (IfThenElse u t f) | any isAnonymousArgument [u, t, f] = do
59+ u' <- freshIfAnon u
60+ t' <- freshIfAnon t
61+ f' <- freshIfAnon f
62+ let if_ = IfThenElse (maybe u argToExpr u') (maybe t argToExpr t') (maybe f argToExpr f')
63+ return $ foldr (Abs . Left) if_ (catMaybes [u', t', f'])
5364 desugarExpr e = return e
5465
5566 wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Expr)] -> m Expr
@@ -71,8 +82,14 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
7182 isAnonymousArgument _ = False
7283
7384 mkProp :: (String, Expr) -> m (Maybe Ident, (String, Expr))
74− mkProp (name, e)
75− | isAnonymousArgument e = do
76− arg <- freshIdent'
77− return (Just arg, (name, Var (Qualified Nothing arg)))
78− | otherwise = return (Nothing, (name, e))
85+ mkProp (name, e) = do
86+ arg <- freshIfAnon e
87+ return (arg, (name, maybe e argToExpr arg))
88+
89+ freshIfAnon :: Expr -> m (Maybe Ident)
90+ freshIfAnon u
91+ | isAnonymousArgument u = Just <$> freshIdent'
92+ | otherwise = return Nothing
93+
94+ argToExpr :: Ident -> Expr
95+ argToExpr = Var . Qualified Nothing