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 ...`
375003eevancz
elm/src/Parse/Parser.hs+7−14
compare with master
unifiedsplit
@@ -82,14 +82,7 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
82assignExpr = do
82assignExpr = do
83 patterns <- spaceSep1 (patternTerm <?> "the definition of a variable (x = ...)")
83 patterns <- spaceSep1 (patternTerm <?> "the definition of a variable (x = ...)")
84 whitespace; string "="; whitespace; exp <- expr
84 whitespace; string "="; whitespace; exp <- expr
85− case patterns of
85+ flattenPatterns patterns exp
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."
93
86
94letExpr = do
87letExpr = do
95 reserved "let"
88 reserved "let"
@@ -97,12 +90,12 @@ letExpr = do
97 whitespace
90 whitespace
98 char '{' <?> "a set of definitions { x = ... ; y = ... }"
91 char '{' <?> "a set of definitions { x = ... ; y = ... }"
99 case brace of
92 case brace of
100− Nothing -> do whitespace; f <- assignExpr; whitespace; reserved "in"; whitespace
93+ Nothing -> do whitespace; ds <- assignExpr
101− Let [f] <$> expr
94+ whitespace; reserved "in"; whitespace; Let ds <$> expr
102− Just '{' -> do whitespace ; fs <- semiSep1 assignExpr ; whitespace
95+ Just '{' -> do whitespace ; dss <- semiSep1 assignExpr ; whitespace
103 string "}" <?> "closing bracket '}'"
96 string "}" <?> "closing bracket '}'"
104 whitespace; reserved "in"; whitespace; e <- expr
97 whitespace; reserved "in"; whitespace; e <- expr
105− return (Let fs e)
98+ return $ Let (concat dss) e
106
99
107caseExpr = do
100caseExpr = do
108 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace
101 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace
@@ -113,8 +106,8 @@ caseExpr = do
113
106
114expr = choice [ ifExpr, letExpr, caseExpr, lambdaExpr, binaryExpr ] <?> "expression"
107expr = choice [ ifExpr, letExpr, caseExpr, lambdaExpr, binaryExpr ] <?> "expression"
115
108
116−def = do (f,e) <- assignExpr
109+def = do (fs,es) <- unzip <$> assignExpr
117− return ([f], [e], guid >>= \x -> return [VarT x])
110+ return (fs, es, mapM (\_ -> liftM VarT guid) fs)
118
111
119defs1 = do optional freshLine
112defs1 = do optional freshLine
120 d <- datatype <|> def
113 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
2
2
3import Ast
3import Ast
4import Data.Char (isUpper)
4import Data.Char (isUpper)
@@ -7,11 +7,6 @@ import Control.Monad
7import Text.Parsec
7import Text.Parsec
8import ParseLib
8import ParseLib
9
9
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−
15patternBasic :: Monad m => ParsecT [Char] u m Pattern
10patternBasic :: Monad m => ParsecT [Char] u m Pattern
16patternBasic =
11patternBasic =
17 choice [ char '_' >> return PAnything
12 choice [ char '_' >> return PAnything
@@ -32,3 +27,27 @@ patternTerm = patternTuple <|> patternList <|> patternBasic <?> "pattern"
32
27
33patternExpr :: Monad m => ParsecT [Char] u m Pattern
28patternExpr :: Monad m => ParsecT [Char] u m Pattern
34patternExpr = foldl1 pcons <$> consSep1 patternTerm <?> "pattern"
29patternExpr = 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+