git.iko.soy/elk
on master help sign in
More HLint warnings
37cab45Abhinav Gupta
src/Parse/Binop.hs+1−1
compare with master
unifiedsplit
@@ -26,7 +26,7 @@ sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j)
26binops term anyOp = do
26binops term anyOp = do
27 e <- term
27 e <- term
28 (ops,es) <- liftM unzip $ star (do { op <- anyOp; e <- term; return (op,e) })
28 (ops,es) <- liftM unzip $ star (do { op <- anyOp; e <- term; return (op,e) })
29− case binopOf (Map.empty) (sortOps table) ops (e:es) of
29+ case binopOf Map.empty (sortOps table) ops (e:es) of
30 Right e -> return e
30 Right e -> return e
31 Left msg -> zero
31 Left msg -> zero
32
32
src/Parse/Combinators.hs+5−5
@@ -13,7 +13,7 @@ instance Monad (Parser from) where
13 p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])
13 p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])
14
14
15instance MonadPlus (Parser from) where
15instance MonadPlus (Parser from) where
16− mzero = Parser (\cs -> [])
16+ mzero = Parser $ const []
17 mplus p q = Parser (\cs -> parse p cs ++ parse q cs)
17 mplus p q = Parser (\cs -> parse p cs ++ parse q cs)
18
18
19-- True recursive descent, tries everything.
19-- True recursive descent, tries everything.
@@ -24,7 +24,7 @@ p +|+ q = Parser (\cs -> case parse (mplus p q) cs of
24 [] -> []
24 [] -> []
25 (x:xs) -> [x])
25 (x:xs) -> [x])
26
26
27−zero = Parser (\cs -> [])
27+zero = Parser $ const []
28
28
29item = Parser (\cs -> case cs of
29item = Parser (\cs -> case cs of
30 [] -> []
30 [] -> []
@@ -40,7 +40,7 @@ string (c:cs) = do {char c; string cs; return (c:cs)}
40star p = plus p +++ return []
40star p = plus p +++ return []
41plus p = do {a <- p; as <- star p; return (a:as)}
41plus p = do {a <- p; as <- star p; return (a:as)}
42
42
43−optional p = do { p >>= return . Just } +++ return Nothing
43+optional p = (Just `liftM` p) +++ return Nothing
44
44
45nospace = guard . (==0) . length =<< space
45nospace = guard . (==0) . length =<< space
46space = star $ sat isSpace
46space = star $ sat isSpace
@@ -66,7 +66,7 @@ sepBy1 sep p = do
66 xs <- star (sep >> p)
66 xs <- star (sep >> p)
67 return $ x:xs
67 return $ x:xs
68
68
69−select ps = foldl1 (+|+) ps
69+select = foldl1 (+|+)
70
70
71chainl p op a = (chainl1 p op) +++ return a
71chainl p op a = (chainl1 p op) +++ return a
72chainl1 p op = do {a <- p; rest a}
72chainl1 p op = do {a <- p; rest a}
@@ -79,4 +79,4 @@ extractResult err parse =
79 case parse of
79 case parse of
80 (r,[]) : _ -> Right r
80 (r,[]) : _ -> Right r
81 _ : rest -> extractResult err rest
81 _ : rest -> extractResult err rest
82− [] -> Left err
82+ [] -> Left err
src/Replace.hs+11−7
@@ -1,8 +1,9 @@
1module Replace (replace, depth) where
1module Replace (replace, depth) where
2
2
3import Ast
3import Ast
4−import Data.Set (singleton,empty,unions,member)
4+import Data.Set (singleton,empty,unions,member, Set)
5
5
6+replace :: String -> Expr -> Expr -> Expr
6replace y v expr =
7replace y v expr =
7 let f = replace y v in
8 let f = replace y v in
8 case expr of
9 case expr of
@@ -14,22 +15,25 @@ replace y v expr =
14 Lift e es -> Lift (f e) (map f es)
15 Lift e es -> Lift (f e) (map f es)
15 Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3)
16 Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3)
16 Async e -> Async (f e)
17 Async e -> Async (f e)
17− Let defs e -> if elem y vs then Let defs e else Let (zip vs (map f es)) (f e)
18+ Let defs e -> if y `elem` vs then Let defs e else Let (zip vs (map f es)) (f e)
18 where (vs,es) = unzip defs
19 where (vs,es) = unzip defs
19 Var x -> if x == y then v else Var x
20 Var x -> if x == y then v else Var x
20 Data name es -> Data name (map f es)
21 Data name es -> Data name (map f es)
21− Case e cases -> Case (f e) $ map (case_replace y v) cases
22+ Case e cases -> Case (f e) $ map (caseReplace y v) cases
22 _ -> expr
23 _ -> expr
23
24
24−case_replace y v (p,e) =
25+caseReplace :: String -> Expr -> (Pattern, Expr) -> (Pattern, Expr)
26+caseReplace y v (p,e) =
25− if member y (pattern_vars p) then (p,e) else (p, replace y v e)
27+ if member y (patternVars p) then (p,e) else (p, replace y v e)
26
28
27−pattern_vars pattern =
29+patternVars :: Pattern -> Set String
30+patternVars pattern =
28 case pattern of
31 case pattern of
29− PData _ ps -> unions (map pattern_vars ps)
32+ PData _ ps -> unions (map patternVars ps)
30 PVar x -> singleton x
33 PVar x -> singleton x
31 PAnything -> empty
34 PAnything -> empty
32
35
36+depth :: Expr -> Integer
33depth = depth' 0
37depth = depth' 0
34depth' d expr =
38depth' d expr =
35 let f = depth' (d+1) in
39 let f = depth' (d+1) in