git.iko.soy/elk
on master help sign in
cosmetic: use qualified imports much more
50f2878Evan Czaplicki
compiler/Generate/Cases.hs+30−27
compare with master
unifiedsplit
@@ -3,27 +3,28 @@ module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst, newVar) whe
3
3
4import Control.Applicative ((<$>))
4import Control.Applicative ((<$>))
5import Control.Arrow (first)
5import Control.Arrow (first)
6−import Control.Monad.State
6+import qualified Control.Monad.State as State
7import Data.List (groupBy,sortBy)
7import Data.List (groupBy,sortBy)
8import Data.Maybe (fromMaybe)
8import Data.Maybe (fromMaybe)
9
9
10−import AST.Annotation
10+import qualified AST.Annotation as A
11−import AST.Expression.General
11+import qualified AST.Expression.General as Expr
12import AST.Expression.Canonical as Canonical
12import AST.Expression.Canonical as Canonical
13−import AST.Literal
13+import qualified AST.Literal as Literal
14import qualified AST.Pattern as P
14import qualified AST.Pattern as P
15import qualified AST.Variable as Var
15import qualified AST.Variable as Var
16−import Transform.Substitute
16+import Transform.Substitute (subst)
17
17
18−toMatch :: [(P.CanonicalPattern, Canonical.Expr)] -> State Int (String, Match)
18+toMatch :: [(P.CanonicalPattern, Canonical.Expr)] -> State.State Int (String, Match)
19toMatch patterns = do
19toMatch patterns = do
20 v <- newVar
20 v <- newVar
21 (,) v <$> match [v] (map (first (:[])) patterns) Fail
21 (,) v <$> match [v] (map (first (:[])) patterns) Fail
22
22
23−newVar :: State Int String
23+newVar :: State.State Int String
24−newVar = do n <- get
24+newVar =
25+ do n <- State.get
25− modify (+1)
26+ State.modify (+1)
26− return $ "_v" ++ show n
27+ return $ "_v" ++ show n
27
28
28data Match
29data Match
29 = Match String [Clause] Match
30 = Match String [Clause] Match
@@ -34,7 +35,7 @@ data Match
34 deriving Show
35 deriving Show
35
36
36data Clause =
37data Clause =
37− Clause (Either Var.Canonical Literal) [String] Match
38+ Clause (Either Var.Canonical Literal.Literal) [String] Match
38 deriving Show
39 deriving Show
39
40
40matchSubst :: [(String,String)] -> Match -> Match
41matchSubst :: [(String,String)] -> Match -> Match
@@ -43,8 +44,8 @@ matchSubst pairs match =
43 Break -> Break
44 Break -> Break
44 Fail -> Fail
45 Fail -> Fail
45 Seq ms -> Seq (map (matchSubst pairs) ms)
46 Seq ms -> Seq (map (matchSubst pairs) ms)
46− Other (A a e) ->
47+ Other (A.A a e) ->
47− Other . A a $ foldr ($) e $ map (\(x,y) -> subst x (localVar y)) pairs
48+ Other . A.A a $ foldr ($) e $ map (\(x,y) -> subst x (Expr.localVar y)) pairs
48 Match n cs m ->
49 Match n cs m ->
49 Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)
50 Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)
50 where
51 where
@@ -63,7 +64,7 @@ isCon (p:_, _) =
63isVar :: ([P.Pattern var], expr) -> Bool
64isVar :: ([P.Pattern var], expr) -> Bool
64isVar p = not (isCon p)
65isVar p = not (isCon p)
65
66
66−match :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State Int Match
67+match :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State.State Int Match
67match [] [] def = return def
68match [] [] def = return def
68match [] [([],e)] Fail = return $ Other e
69match [] [([],e)] Fail = return $ Other e
69match [] [([],e)] Break = return $ Other e
70match [] [([],e)] Break = return $ Other e
@@ -77,27 +78,27 @@ match vs@(v:_) cs def
77
78
78dealias :: String -> ([P.CanonicalPattern], Canonical.Expr) -> ([P.CanonicalPattern], Canonical.Expr)
79dealias :: String -> ([P.CanonicalPattern], Canonical.Expr) -> ([P.CanonicalPattern], Canonical.Expr)
79dealias _ ([], _) = noMatch "dealias"
80dealias _ ([], _) = noMatch "dealias"
80−dealias v c@(p:ps, A a e) =
81+dealias v c@(p:ps, A.A a e) =
81 case p of
82 case p of
82− P.Alias x pattern -> (pattern:ps, A a $ subst x (localVar v) e)
83+ P.Alias x pattern -> (pattern:ps, A.A a $ subst x (Expr.localVar v) e)
83 _ -> c
84 _ -> c
84
85
85−matchVar :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State Int Match
86+matchVar :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State.State Int Match
86matchVar [] _ _ = noMatch "matchVar"
87matchVar [] _ _ = noMatch "matchVar"
87matchVar (v:vs) cs def = match vs (map subVar cs) def
88matchVar (v:vs) cs def = match vs (map subVar cs) def
88 where
89 where
89 subVar ([], _) = noMatch "matchVar.subVar"
90 subVar ([], _) = noMatch "matchVar.subVar"
90− subVar (p:ps, (A a e)) = (ps, A a $ subOnePattern p e)
91+ subVar (p:ps, (A.A a e)) = (ps, A.A a $ subOnePattern p e)
91 where
92 where
92 subOnePattern pattern e =
93 subOnePattern pattern e =
93 case pattern of
94 case pattern of
94− P.Var x -> subst x (localVar v) e
95+ P.Var x -> subst x (Expr.localVar v) e
95 P.Anything -> e
96 P.Anything -> e
96 P.Record fs ->
97 P.Record fs ->
97− foldr (\x -> subst x (Access (A a (localVar v)) x)) e fs
98+ foldr (\x -> subst x (Expr.Access (A.A a (Expr.localVar v)) x)) e fs
98 _ -> noMatch "matchVar.subVar"
99 _ -> noMatch "matchVar.subVar"
99
100
100−matchCon :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State Int Match
101+matchCon :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State.State Int Match
101matchCon [] _ _ = noMatch "matchCon"
102matchCon [] _ _ = noMatch "matchCon"
102matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
103matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
103 where
104 where
@@ -121,11 +122,11 @@ matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
121 (P.Literal lit : _, _) -> matchClause (Right lit) (v:vs) cs Break
122 (P.Literal lit : _, _) -> matchClause (Right lit) (v:vs) cs Break
122 _ -> noMatch "matchCon"
123 _ -> noMatch "matchCon"
123
124
124−matchClause :: Either Var.Canonical Literal
125+matchClause :: Either Var.Canonical Literal.Literal
125 -> [String]
126 -> [String]
126 -> [([P.CanonicalPattern], Canonical.Expr)]
127 -> [([P.CanonicalPattern], Canonical.Expr)]
127 -> Match
128 -> Match
128− -> State Int Clause
129+ -> State.State Int Clause
129matchClause _ [] _ _ = noMatch "matchClause"
130matchClause _ [] _ _ = noMatch "matchClause"
130matchClause c (_:vs) cs def =
131matchClause c (_:vs) cs def =
131 do vs' <- getVars
132 do vs' <- getVars
@@ -140,13 +141,15 @@ matchClause c (_:vs) cs def =
140
141
141 getVars =
142 getVars =
142 case head cs of
143 case head cs of
143− (P.Data _ ps : _, _) -> forM ps (const newVar)
144+ (P.Data _ ps : _, _) -> State.forM ps (const newVar)
144 (P.Literal _ : _, _) -> return []
145 (P.Literal _ : _, _) -> return []
145 _ -> noMatch "matchClause.getVars"
146 _ -> noMatch "matchClause.getVars"
146
147
147−matchMix :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State Int Match
148+matchMix :: [String] -> [([P.CanonicalPattern], Canonical.Expr)] -> Match -> State.State Int Match
149+matchMix vs cs def =
148−matchMix vs cs def = foldM (flip $ match vs) def (reverse css)
150+ State.foldM (flip $ match vs) def (reverse css)
151+ where
149− where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
152+ css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
150
153
151noMatch :: String -> a
154noMatch :: String -> a
152noMatch name =
155noMatch name =