@@ -1,22 +1,24 @@
11module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst) where
22
3+import Control.Applicative ((<$>),(<*>))
34import Control.Arrow (first)
4−import Control.Monad (liftM,foldM)
5+import Control.Monad.State
56import Data.List (groupBy,sortBy,lookup)
67import Data.Maybe (fromMaybe)
78
8−import Unique
99import SourceSyntax.Location
1010import SourceSyntax.Literal
1111import SourceSyntax.Pattern
1212import SourceSyntax.Expression
1313import Transform.Substitute
1414
15+
1516caseToMatch patterns = do
1617 v <- newVar
17− (,) v `liftM` match [v] (map (first (:[])) patterns) Fail
18+ (,) v <$> match [v] (map (first (:[])) patterns) Fail
1819
19−newVar = do n <- guid
20+newVar = do n <- get
21+ modify (+1)
2022 return $ "case" ++ show n
2123
2224data Match t v
@@ -51,7 +53,7 @@ isCon (p:ps, e) =
5153
5254isVar p = not (isCon p)
5355
54−match :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> Unique (Match t v)
56+match :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)
5557match [] [] def = return def
5658match [] [([],e)] Fail = return $ Other e
5759match [] [([],e)] Break = return $ Other e
@@ -68,8 +70,7 @@ dealias v c@(p:ps, L s e) =
6870 PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)
6971 _ -> c
7072
71−matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v
72− -> Unique (Match t v)
73+matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)
7374matchVar (v:vs) cs def = match vs (map subVar cs) def
7475 where
7576 subVar (p:ps, ce@(L s e)) = (ps, L s $ subOnePattern p e)
@@ -82,8 +83,8 @@ matchVar (v:vs) cs def = match vs (map subVar cs) def
8283 foldr (\x -> subst x (Access (L s (Var v)) x)) e fs
8384
8485matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v
85− -> Unique (Match t v)
86−matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css
86+ -> State Int (Match t v)
87+matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
8788 where
8889 css = groupBy eq (sortBy cmp cs)
8990
@@ -106,10 +107,10 @@ matchClause :: Either String Literal
106107 -> [String]
107108 -> [([Pattern],LExpr t v)]
108109 -> Match t v
109− -> Unique (Clause t v)
110+ -> State Int (Clause t v)
110111matchClause c (v:vs) cs def =
111112 do vs' <- getVars
112− Clause c vs' `liftM` match (vs' ++ vs) (map flatten cs) def
113+ Clause c vs' <$> match (vs' ++ vs) (map flatten cs) def
113114 where
114115
115116 flatten (p:ps, e) =
@@ -122,7 +123,6 @@ matchClause c (v:vs) cs def =
122123 (PData _ ps : _, _) -> mapM (\_ -> newVar) ps
123124 (PLiteral _ : _, _) -> return []
124125
125−matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v
126− -> Unique (Match t v)
126+matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)
127127matchMix vs cs def = foldM (flip $ match vs) def (reverse css)
128128 where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs