git.iko.soy/elk
on master help sign in
Enable assignment of ADTs. I.e. `let (x,y) = pos in ...` or `let (x:xs) = lst in ...`
commit375003e9be018acfca140fcda96bbc96b18559f9 authorevancz <info@elm-lang.org> dateSun 10 Jun 2012, 00:08 (14 years ago) parentad56915
2 files changed+32−20
compare with master
unifiedsplit
elm/src/Parse/Parser.hs+7−14 elm/src/Parse/Patterns.hs+25−6
elm/src/Parse/Parser.hs+7−14
@@ -82,14 +82,7 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
8282assignExpr = do
8383 patterns <- spaceSep1 (patternTerm <?> "the definition of a variable (x = ...)")
8484 whitespace; string "="; whitespace; exp <- expr
85− case patterns of
86− PVar f : args -> return (f, makeFunction args exp)
87− [PData x ps] -> if "Tuple" == take 5 x && all isDigit (drop 5 x) then
88− fail "matching tuples is not yet supported in this context"
89− else fail $ "Only tuples can be matched in this context, " ++
90− "not other abstract data types such as lists."
91− _ -> fail $ "Left-hand side of assign statement is not acceptable: " ++
92− "only named variables, named functions, and tuples are okay."
85+ flattenPatterns patterns exp
9386
9487letExpr = do
9588 reserved "let"
@@ -97,12 +90,12 @@ letExpr = do
9790 whitespace
9891 char '{' <?> "a set of definitions { x = ... ; y = ... }"
9992 case brace of
100− Nothing -> do whitespace; f <- assignExpr; whitespace; reserved "in"; whitespace
101− Let [f] <$> expr
102− Just '{' -> do whitespace ; fs <- semiSep1 assignExpr ; whitespace
93+ Nothing -> do whitespace; ds <- assignExpr
94+ whitespace; reserved "in"; whitespace; Let ds <$> expr
95+ Just '{' -> do whitespace ; dss <- semiSep1 assignExpr ; whitespace
10396 string "}" <?> "closing bracket '}'"
10497 whitespace; reserved "in"; whitespace; e <- expr
105− return (Let fs e)
98+ return $ Let (concat dss) e
10699
107100caseExpr = do
108101 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace
@@ -113,8 +106,8 @@ caseExpr = do
113106
114107expr = choice [ ifExpr, letExpr, caseExpr, lambdaExpr, binaryExpr ] <?> "expression"
115108
116−def = do (f,e) <- assignExpr
117− return ([f], [e], guid >>= \x -> return [VarT x])
109+def = do (fs,es) <- unzip <$> assignExpr
110+ return (fs, es, mapM (\_ -> liftM VarT guid) fs)
118111
119112defs1 = do optional freshLine
120113 d <- datatype <|> def
elm/src/Parse/Patterns.hs+25−6
@@ -1,4 +1,4 @@
1−module Patterns (patternTerm, patternExpr, makeFunction) where
1+module Patterns (patternTerm, patternExpr, makeFunction, flattenPatterns) where
22
33import Ast
44import Data.Char (isUpper)
@@ -7,11 +7,6 @@ import Control.Monad
77import Text.Parsec
88import ParseLib
99
10−makeFunction args body = foldr func body args
11− where func PAnything e = Lambda "_" e
12− func (PVar x) e = Lambda x e
13− func p e = "t" `Lambda` Case (Var "t") [(p,e)]
14−
1510patternBasic :: Monad m => ParsecT [Char] u m Pattern
1611patternBasic =
1712 choice [ char '_' >> return PAnything
@@ -32,3 +27,27 @@ patternTerm = patternTuple <|> patternList <|> patternBasic <?> "pattern"
3227
3328patternExpr :: Monad m => ParsecT [Char] u m Pattern
3429patternExpr = foldl1 pcons <$> consSep1 patternTerm <?> "pattern"
30+
31+
32+
33+makeFunction args body = foldr func body args
34+ where func PAnything e = Lambda "_" e
35+ func (PVar x) e = Lambda x e
36+ func p e = "t" `Lambda` Case (Var "t") [(p,e)]
37+
38+flattenPatterns (PVar f : args) exp = return [(f, makeFunction args exp)]
39+flattenPatterns [p] exp = return $ matchSingle p exp p
40+flattenPatterns ps _ =
41+ fail $ "Pattern (" ++ unwords (map show ps) ++
42+ ") cannot be used on the left-hand side of an assign statement."
43+
44+matchSingle pat exp p@(PData _ ps) =
45+ (v, exp) : concatMap (matchSingle p $ Var v) ps
46+ where v = "'" ++ getName p
47+matchSingle pat exp (PVar x) = [ (x, Case exp [(pat,Var x)]) ]
48+matchSingle pat exp PAnything = []
49+
50+getName (PData n ps) = n ++ concatMap getName ps
51+getName (PAnything) = "_"
52+getName (PVar x) = x
53+