git.iko.soy/elk
on master help sign in
Stop using the Unique library
42fb11eEvan Czaplicki
compiler/Generate/Cases.hs+13−13
compare with master
unifiedsplit
@@ -1,22 +1,24 @@
1module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst) where
1module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst) where
2
2
3+import Control.Applicative ((<$>),(<*>))
3import Control.Arrow (first)
4import Control.Arrow (first)
4−import Control.Monad (liftM,foldM)
5+import Control.Monad.State
5import Data.List (groupBy,sortBy,lookup)
6import Data.List (groupBy,sortBy,lookup)
6import Data.Maybe (fromMaybe)
7import Data.Maybe (fromMaybe)
7
8
8−import Unique
9import SourceSyntax.Location
9import SourceSyntax.Location
10import SourceSyntax.Literal
10import SourceSyntax.Literal
11import SourceSyntax.Pattern
11import SourceSyntax.Pattern
12import SourceSyntax.Expression
12import SourceSyntax.Expression
13import Transform.Substitute
13import Transform.Substitute
14
14
15+
15caseToMatch patterns = do
16caseToMatch patterns = do
16 v <- newVar
17 v <- newVar
17− (,) v `liftM` match [v] (map (first (:[])) patterns) Fail
18+ (,) v <$> match [v] (map (first (:[])) patterns) Fail
18
19
19−newVar = do n <- guid
20+newVar = do n <- get
21+ modify (+1)
20 return $ "case" ++ show n
22 return $ "case" ++ show n
21
23
22data Match t v
24data Match t v
@@ -51,7 +53,7 @@ isCon (p:ps, e) =
51
53
52isVar p = not (isCon p)
54isVar p = not (isCon p)
53
55
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)
55match [] [] def = return def
57match [] [] def = return def
56match [] [([],e)] Fail = return $ Other e
58match [] [([],e)] Fail = return $ Other e
57match [] [([],e)] Break = return $ Other e
59match [] [([],e)] Break = return $ Other e
@@ -68,8 +70,7 @@ dealias v c@(p:ps, L s e) =
68 PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)
70 PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)
69 _ -> c
71 _ -> c
70
72
71−matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v
73+matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)
72− -> Unique (Match t v)
73matchVar (v:vs) cs def = match vs (map subVar cs) def
74matchVar (v:vs) cs def = match vs (map subVar cs) def
74 where
75 where
75 subVar (p:ps, ce@(L s e)) = (ps, L s $ subOnePattern p e)
76 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
82 foldr (\x -> subst x (Access (L s (Var v)) x)) e fs
83 foldr (\x -> subst x (Access (L s (Var v)) x)) e fs
83
84
84matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v
85matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v
85− -> Unique (Match t v)
86+ -> State Int (Match t v)
86−matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css
87+matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
87 where
88 where
88 css = groupBy eq (sortBy cmp cs)
89 css = groupBy eq (sortBy cmp cs)
89
90
@@ -106,10 +107,10 @@ matchClause :: Either String Literal
106 -> [String]
107 -> [String]
107 -> [([Pattern],LExpr t v)]
108 -> [([Pattern],LExpr t v)]
108 -> Match t v
109 -> Match t v
109− -> Unique (Clause t v)
110+ -> State Int (Clause t v)
110matchClause c (v:vs) cs def =
111matchClause c (v:vs) cs def =
111 do vs' <- getVars
112 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
113 where
114 where
114
115
115 flatten (p:ps, e) =
116 flatten (p:ps, e) =
@@ -122,7 +123,6 @@ matchClause c (v:vs) cs def =
122 (PData _ ps : _, _) -> mapM (\_ -> newVar) ps
123 (PData _ ps : _, _) -> mapM (\_ -> newVar) ps
123 (PLiteral _ : _, _) -> return []
124 (PLiteral _ : _, _) -> return []
124
125
125−matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v
126+matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)
126− -> Unique (Match t v)
127matchMix vs cs def = foldM (flip $ match vs) def (reverse css)
127matchMix vs cs def = foldM (flip $ match vs) def (reverse css)
128 where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
128 where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs