git.iko.soy/elk
on master help sign in
Fix #873, detect bad recursive values
8b484abEvan Czaplicki
src/AST/Pattern.hs+42
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module AST.Pattern where
2module AST.Pattern where
3
3
4+import qualified Data.List as List
4import qualified Data.Set as Set
5import qualified Data.Set as Set
5
6
6import qualified AST.Literal as L
7import qualified AST.Literal as L
@@ -107,3 +108,44 @@ boundVarList :: Pattern ann var -> [String]
107boundVarList pattern =
108boundVarList pattern =
108 Set.toList (boundVarSet pattern)
109 Set.toList (boundVarSet pattern)
109
110
111+
112+
113+-- TO STRING
114+
115+
116+toString :: Bool -> Canonical -> String
117+toString needsParens (A.A _ pattern) =
118+ case pattern of
119+ Var name ->
120+ name
121+
122+ Data name [] ->
123+ if Var.isTuple name then
124+ "()"
125+ else
126+ Var.toString name
127+
128+ Data name args ->
129+ if Var.isTuple name then
130+ "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
131+ else
132+ parensIf needsParens $
133+ Var.toString name ++ concatMap ((" "++) . toString True) args
134+
135+ Record fields ->
136+ "{" ++ List.intercalate "," fields ++ "}"
137+
138+ Alias alias subPattern ->
139+ parensIf needsParens $
140+ toString False subPattern ++ " as " ++ alias
141+
142+ Anything ->
143+ "_"
144+
145+ Literal literal ->
146+ L.toString literal
147+
148+
149+parensIf :: Bool -> String -> String
150+parensIf needsParens str =
151+ if needsParens then "(" ++ str ++ ")" else str
src/Canonicalize.hs+3−2
@@ -82,10 +82,11 @@ module' allCanonicalImports interfaces modul =
82 typeToPair (A.A _ (D.Type name args body)) =
82 typeToPair (A.A _ (D.Type name args body)) =
83 ( name, (args, body) )
83 ( name, (args, body) )
84
84
85− program =
85+ getProgram =
86 Body.flatten (Module.name modul) canonicalDecls canonicalEffects
86 Body.flatten (Module.name modul) canonicalDecls canonicalEffects
87 in
87 in
88+ do program <- Result.mapError Error.Canonicalize getProgram
88− do canonicalImports <- filterImports uses imports
89+ canonicalImports <- filterImports uses imports
89 Result.accumulate (Result.One (Env.toDealiaser env)) $
90 Result.accumulate (Result.One (Env.toDealiaser env)) $
90 modul {
91 modul {
91 Module.info =
92 Module.info =
src/Canonicalize/Body.hs+10−3
@@ -13,11 +13,18 @@ import qualified AST.Type as Type
13import qualified AST.Variable as Var
13import qualified AST.Variable as Var
14import qualified Canonicalize.Sort as Sort
14import qualified Canonicalize.Sort as Sort
15import qualified Reporting.Annotation as A
15import qualified Reporting.Annotation as A
16+import Reporting.Error.Canonicalize (Error)
16−import qualified Reporting.Region as R
17+import Reporting.Region (Region)
18+import Reporting.Result (Result)
17
19
18
20
19
21
22+flatten
23+ :: (Monoid i)
20−flatten :: ModuleName.Canonical -> Decl.Canonical -> Effects.Canonical -> Canonical.Expr
24+ => ModuleName.Canonical
25+ -> Decl.Canonical
26+ -> Effects.Canonical
27+ -> Result i w Error Canonical.Expr
21flatten moduleName (Decl.Decls defs unions aliases _) effects =
28flatten moduleName (Decl.Decls defs unions aliases _) effects =
22 let
29 let
23 allDefs =
30 allDefs =
@@ -101,7 +108,7 @@ buildFunction vars body@(A.A ann _) =
101 (map (A.A ann . P.Var) vars)
108 (map (A.A ann . P.Var) vars)
102
109
103
110
104−definition :: String -> Canonical.Expr -> R.Region -> Type.Canonical -> Canonical.Def
111+definition :: String -> Canonical.Expr -> Region -> Type.Canonical -> Canonical.Def
105definition name expr@(A.A ann _) region tipe =
112definition name expr@(A.A ann _) region tipe =
106 Canonical.Def
113 Canonical.Def
107 region
114 region
src/Canonicalize/Sort.hs+234−120
@@ -1,7 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Sort (definitions) where
2module Canonicalize.Sort (definitions) where
3
3
4−import Control.Monad.State
4+import qualified Data.Foldable as F
5import qualified Data.Graph as Graph
5import qualified Data.Graph as Graph
6import qualified Data.Map as Map
6import qualified Data.Map as Map
7import qualified Data.Maybe as Maybe
7import qualified Data.Maybe as Maybe
@@ -12,71 +12,117 @@ import qualified AST.Expression.Canonical as Canonical
12import qualified AST.Pattern as P
12import qualified AST.Pattern as P
13import qualified AST.Variable as V
13import qualified AST.Variable as V
14import qualified Reporting.Annotation as A
14import qualified Reporting.Annotation as A
15+import qualified Reporting.Error.Canonicalize as E
16+import qualified Reporting.Result as R
15
17
16
18
17
19
18−-- STARTING POINT
20+-- SORT DEFINITIONS
19
21
20
22
21−definitions :: Canonical.Expr -> Canonical.Expr
23+definitions :: (Monoid i) => Canonical.Expr -> R.Result i w E.Error Canonical.Expr
22definitions expression =
24definitions expression =
25+ let
26+ (R.Result _ warnings answer) =
23− evalState (reorder expression) Set.empty
27+ reorder expression
28+ in
29+ R.Result mempty warnings answer
30+
31+
32+data LocalVars =
33+ LocalVars
34+ { _immediate :: Set.Set String
35+ , _delayed :: Set.Set String
36+ , _tags :: Set.Set String
37+ }
38+
24
39
40+instance Monoid LocalVars where
41+ mempty =
42+ LocalVars Set.empty Set.empty Set.empty
25
43
26−free :: String -> State (Set.Set String) ()
44+ mappend (LocalVars i1 d1 t1) (LocalVars i2 d2 t2) =
27−free x =
45+ LocalVars (Set.union i1 i2) (Set.union d1 d2) (Set.union t1 t2)
28− modify (Set.insert x)
29
46
30
47
31−freeIfLocal :: V.Canonical -> State (Set.Set String) ()
48+addTag :: String -> a -> R.Result LocalVars w e a
49+addTag name value =
50+ R.accumulate (LocalVars Set.empty Set.empty (Set.singleton name)) value
51+
52+
53+addImmediate :: V.Canonical -> a -> R.Result LocalVars w e a
32−freeIfLocal (V.Canonical home name) =
54+addImmediate (V.Canonical home name) value =
33 case home of
55 case home of
34− V.Local -> free name
56+ V.Local ->
57+ R.accumulate (LocalVars (Set.singleton name) Set.empty Set.empty) value
58+
35− V.TopLevel _ -> free name
59+ V.TopLevel _ ->
60+ R.accumulate (LocalVars (Set.singleton name) Set.empty Set.empty) value
61+
36− V.BuiltIn -> return ()
62+ V.BuiltIn ->
63+ return value
64+
37− V.Module _ -> return ()
65+ V.Module _ ->
66+ return value
67+
68+
69+capture :: P.Canonical -> R.Result LocalVars w e a -> R.Result LocalVars w e a
70+capture pattern result =
71+ captureVars (P.boundVarSet pattern) result
72+
73+
74+captureVars :: Set.Set String -> R.Result LocalVars w e a -> R.Result LocalVars w e a
75+captureVars bound (R.Result (LocalVars immediate delayed tags) warnings result) =
76+ let
77+ localVars =
78+ LocalVars (Set.difference immediate bound) (Set.difference delayed bound) tags
79+ in
80+ R.Result localVars warnings result
81+
82+
83+delay :: R.Result LocalVars w e a -> R.Result LocalVars w e a
84+delay (R.Result (LocalVars immediate delayed tags) warnings result) =
85+ R.Result (LocalVars Set.empty (Set.union immediate delayed) tags) warnings result
38
86
39
87
40
88
41-- REORDER EXPRESSIONS
89-- REORDER EXPRESSIONS
42
90
43
91
44−reorder :: Canonical.Expr -> State (Set.Set String) Canonical.Expr
92+reorder :: Canonical.Expr -> R.Result LocalVars w E.Error Canonical.Expr
45−reorder (A.A ann expression) =
93+reorder (A.A region expression) =
46− A.A ann <$>
94+ A.A region <$>
47 case expression of
95 case expression of
48− -- Be careful adding and restricting freeVars
49 Var var ->
96 Var var ->
50− do freeIfLocal var
51− return expression
97+ addImmediate var expression
52
98
53 Lambda pattern body ->
99 Lambda pattern body ->
100+ delay $
54− uncurry Lambda <$> bindingReorder (pattern,body)
101+ bindingReorder Lambda (pattern, body)
55
102
56 Binop op leftExpr rightExpr ->
103 Binop op leftExpr rightExpr ->
57− do freeIfLocal op
58− Binop op <$> reorder leftExpr <*> reorder rightExpr
104+ do binop <- Binop op <$> reorder leftExpr <*> reorder rightExpr
105+ addImmediate op binop
59
106
60 Case expr cases ->
107 Case expr cases ->
61− Case <$> reorder expr <*> mapM bindingReorder cases
108+ Case <$> reorder expr <*> traverse (bindingReorder (,)) cases
62
109
63 Data name exprs ->
110 Data name exprs ->
64− do free name
65− Data name <$> mapM reorder exprs
111+ addTag name =<< (Data name <$> traverse reorder exprs)
66
112
67 -- Just pipe the reorder though
113 -- Just pipe the reorder though
68 Literal _ ->
114 Literal _ ->
69 return expression
115 return expression
70
116
71 ExplicitList es ->
117 ExplicitList es ->
72− ExplicitList <$> mapM reorder es
118+ ExplicitList <$> traverse reorder es
73
119
74 App func arg ->
120 App func arg ->
75 App <$> reorder func <*> reorder arg
121 App <$> reorder func <*> reorder arg
76
122
77 If branches finally ->
123 If branches finally ->
78 If
124 If
79− <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
125+ <$> traverse (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
80 <*> reorder finally
126 <*> reorder finally
81
127
82 Access record field ->
128 Access record field ->
@@ -87,11 +133,11 @@ reorder (A.A ann expression) =
87 Update record fields ->
133 Update record fields ->
88 Update
134 Update
89 <$> reorder record
135 <$> reorder record
90− <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
136+ <*> traverse (traverse reorder) fields
91
137
92 Record fields ->
138 Record fields ->
93 Record
139 Record
94− <$> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
140+ <$> traverse (traverse reorder) fields
95
141
96 Cmd _ ->
142 Cmd _ ->
97 return expression
143 return expression
@@ -116,117 +162,185 @@ reorder (A.A ann expression) =
116
162
117 -- Actually do some reordering
163 -- Actually do some reordering
118 Let defs body ->
164 Let defs body ->
119− do body' <- reorder body
165+ case reorderDefs defs of
166+ R.Result () warnings (R.Err errors) ->
167+ R.Result mempty warnings (R.Err errors)
168+
169+ R.Result () warnings (R.Ok (boundVars, defGroups, defLocals)) ->
170+ captureVars boundVars $
171+ do _ <- R.Result mempty warnings (R.Ok ())
172+ newBody <- reorder body
173+ R.accumulate defLocals $ A.drop $
174+ foldr (\defGroup expr -> A.A region (Let defGroup expr)) newBody defGroups
175+
176+
177+
178+-- BINDINGS
179+
180+
181+bindingReorder
182+ :: (P.Canonical -> Canonical.Expr -> a)
183+ -> (P.Canonical, Canonical.Expr)
184+ -> R.Result LocalVars w E.Error a
185+bindingReorder func (pattern, expr) =
186+ do answer <- func pattern <$> capture pattern (reorder expr)
187+ addPatternTags pattern answer
120
188
121− -- Sort defs into strongly connected components.This
122− -- allows the programmer to write definitions in whatever
123− -- order they please, we can still define things in order
124− -- and generalize polymorphic functions when appropriate.
125− sccs <- Graph.stronglyConnComp <$> buildDefGraph defs
126− let defss = map Graph.flattenSCC sccs
127
189
128− -- remove let-bound variables from the context
129− forM_ defs $ \(Canonical.Def _ pattern _ _) -> do
130− bound pattern
131− mapM free (ctors pattern)
132
190
133− let (A.A _ let') =
191+-- FREE CONSTRUCTORS
134− foldr (\ds bod -> A.A ann (Let ds bod)) body' defss
135
192
136− return let'
137
193
194+addPatternTags :: P.Canonical -> a -> R.Result LocalVars w e a
195+addPatternTags pattern value =
196+ R.accumulate (LocalVars Set.empty Set.empty (getPatternTags pattern)) value
138
197
198+
139−ctors :: P.Canonical -> [String]
199+getPatternTags :: P.Canonical -> Set.Set String
140−ctors (A.A _ pattern) =
200+getPatternTags (A.A _ pattern) =
141 case pattern of
201 case pattern of
142 P.Var _ ->
202 P.Var _ ->
143− []
203+ Set.empty
144
204
145− P.Alias _ p ->
205+ P.Alias _ subPattern ->
146− ctors p
206+ getPatternTags subPattern
147
207
148 P.Record _ ->
208 P.Record _ ->
149− []
209+ Set.empty
150
210
151 P.Anything ->
211 P.Anything ->
152− []
212+ Set.empty
153
213
154 P.Literal _ ->
214 P.Literal _ ->
155− []
215+ Set.empty
156
216
157− P.Data (V.Canonical home name) ps ->
217+ P.Data (V.Canonical home name) patterns ->
218+ let
219+ freeCtors =
220+ Set.unions (map getPatternTags patterns)
221+ in
158 case home of
222 case home of
159− V.Local -> name : rest
223+ V.Local ->
224+ Set.insert name freeCtors
225+
160− V.TopLevel _ -> name : rest
226+ V.TopLevel _ ->
227+ Set.insert name freeCtors
228+
161− V.BuiltIn -> rest
229+ V.BuiltIn ->
230+ freeCtors
231+
162− V.Module _ -> rest
232+ V.Module _ ->
163− where
233+ freeCtors
164− rest = concatMap ctors ps
234+
235+
236+
237+-- REORDER DEFINITIONS
238+
165
239
240+reorderDefs
241+ :: [Canonical.Def]
242+ -> R.Result () w E.Error (Set.Set String, [[Canonical.Def]], LocalVars)
243+reorderDefs defs =
244+ do rawNodes <- sequenceA $ zipWith toRawNode [0..] defs
245+ let boundVarDict = toBoundVarDict rawNodes
246+ _ <- detectLoops boundVarDict rawNodes
247+ return $ groupDefs boundVarDict rawNodes
166
248
167−bound :: P.Canonical -> State (Set.Set String) ()
249+
168−bound pattern =
250+toRawNode :: Int -> Canonical.Def -> R.Result () w E.Error (Canonical.Def, Int, LocalVars)
251+toRawNode index (Canonical.Def region pattern body maybeType) =
169 let
252 let
170− boundVars =
253+ (R.Result localVars warnings answer) =
171− P.boundVarSet pattern
254+ addPatternTags pattern =<< reorder body
255+
256+ toRawNodeHelp newBody =
257+ ( Canonical.Def region pattern newBody maybeType, index, localVars )
172 in
258 in
173− modify (\freeVars -> Set.difference freeVars boundVars)
259+ toRawNodeHelp <$> R.Result () warnings answer
174
260
175
261
176−bindingReorder
262+toBoundVarDict :: [(Canonical.Def, Int, a)] -> Map.Map String Int
177− :: (P.Canonical, Canonical.Expr)
263+toBoundVarDict defAndDeps =
178− -> State (Set.Set String) (P.Canonical, Canonical.Expr)
179−bindingReorder (pattern, expr) =
180− do expr' <- reorder expr
181− bound pattern
182− mapM_ free (ctors pattern)
183− return (pattern, expr')
184−
185−
186−
187−-- BUILD DEPENDENCY GRAPH BETWEEN DEFINITIONS
188−
189−
190−-- This also reorders the all of the sub-expressions in the Def list.
191−buildDefGraph
192− :: [Canonical.Def]
193− -> State (Set.Set String) [(Canonical.Def, Int, [Int])]
194−buildDefGraph defs =
195− do pdefsDeps <- mapM reorderAndGetDependencies defs
196− return $ realDeps (addKey pdefsDeps)
197− where
198− addKey :: [(Canonical.Def, [String])] -> [(Canonical.Def, Int, [String])]
199− addKey =
200− zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]
201−
202− variableToKey :: (Canonical.Def, Int, [String]) -> [(String, Int)]
203− variableToKey (Canonical.Def _ pattern _ _, key, _) =
204− [ (var, key) | var <- P.boundVarList pattern ]
205−
206− variableToKeyMap :: [(Canonical.Def, Int, [String])] -> Map.Map String Int
207− variableToKeyMap pdefsDeps =
208− Map.fromList (concatMap variableToKey pdefsDeps)
264+ Map.fromList (concatMap toBoundVarDictHelp defAndDeps)
209−
265+
266+
210− realDeps :: [(Canonical.Def, Int, [String])] -> [(Canonical.Def, Int, [Int])]
267+toBoundVarDictHelp :: (Canonical.Def, Int, a) -> [(String, Int)]
211− realDeps pdefsDeps =
268+toBoundVarDictHelp (Canonical.Def _ pattern _ _, key, _) =
212− map convert pdefsDeps
269+ map (\(A.A _ name) -> (name, key)) (P.boundVars pattern)
213− where
270+
214− varDict =
271+
215− variableToKeyMap pdefsDeps
272+
216−
273+-- BUILD GRAPHS
217− convert (pdef, key, deps) =
274+
275+
276+toNode
277+ :: (deps -> [String])
278+ -> Map.Map String Int
279+ -> (Canonical.Def, Int, deps)
280+ -> (Canonical.Def, Int, [Int])
281+toNode toVars boundVarDict (def, index, deps) =
282+ let
283+ localDeps =
218− (pdef, key, Maybe.mapMaybe (flip Map.lookup varDict) deps)
284+ Maybe.mapMaybe (\var -> Map.lookup var boundVarDict) (toVars deps)
219−
285+ in
220−
286+ ( def, index, localDeps )
221−reorderAndGetDependencies
287+
222− :: Canonical.Def
288+
289+immediateOnly :: LocalVars -> [String]
290+immediateOnly (LocalVars immediate _ _) =
291+ Set.toList immediate
292+
293+
294+allVars :: LocalVars -> [String]
295+allVars (LocalVars immediate delayed tags) =
296+ Set.toList immediate ++ Set.toList delayed ++ Set.toList tags
297+
298+
299+
300+-- DETECT LOOPS
301+
302+
303+detectLoops
304+ :: Map.Map String Int
223− -> State (Set.Set String) (Canonical.Def, [String])
305+ -> [(Canonical.Def, Int, LocalVars)]
224−reorderAndGetDependencies (Canonical.Def facts pattern expr mType) =
306+ -> R.Result () w E.Error ()
225− do globalFrees <- get
307+detectLoops boundVarDict rawNodes =
226− -- work in a fresh environment
308+ F.traverse_ detectLoopsHelp $
227− put Set.empty
309+ Graph.stronglyConnComp $
228− expr' <- reorder expr
310+ map (toNode immediateOnly boundVarDict) rawNodes
229− localFrees <- get
311+
230− -- merge with global frees
312+
231− modify (Set.union globalFrees)
313+detectLoopsHelp :: Graph.SCC Canonical.Def -> R.Result () w E.Error ()
232− return (Canonical.Def facts pattern expr' mType, Set.toList localFrees)
314+detectLoopsHelp scc =
315+ case scc of
316+ Graph.AcyclicSCC _ ->
317+ R.ok ()
318+
319+ Graph.CyclicSCC defs ->
320+ case defs of
321+ [] ->
322+ R.ok ()
323+
324+ def@(Canonical.Def region (A.A nameRegion _) _ _) : rest ->
325+ R.throw region $ E.BadRecursion nameRegion def rest
326+
327+
328+
329+-- GROUP DEFINITIONS
330+
331+
332+groupDefs
333+ :: Map.Map String Int
334+ -> [(Canonical.Def, Int, LocalVars)]
335+ -> ( Set.Set String, [[Canonical.Def]], LocalVars )
336+groupDefs boundVarDict rawNodes =
337+ let
338+ allLocalVars =
339+ mconcat (map (\(_, _, localVars) -> localVars) rawNodes)
340+
341+ defGroups =
342+ map Graph.flattenSCC $
343+ Graph.stronglyConnComp $
344+ map (toNode allVars boundVarDict) rawNodes
345+ in
346+ ( Map.keysSet boundVarDict, defGroups, allLocalVars )
src/Reporting/Error/Canonicalize.hs+73
@@ -5,7 +5,9 @@ import Control.Arrow (second)
5import qualified Data.Char as Char
5import qualified Data.Char as Char
6import Text.PrettyPrint.ANSI.Leijen (indent, text)
6import Text.PrettyPrint.ANSI.Leijen (indent, text)
7
7
8+import qualified AST.Expression.Canonical as Canonical
8import qualified AST.Module.Name as ModuleName
9import qualified AST.Module.Name as ModuleName
10+import qualified AST.Pattern as P
9import qualified AST.Type as Type
11import qualified AST.Type as Type
10import qualified AST.Variable as Var
12import qualified AST.Variable as Var
11import qualified Reporting.Annotation as A
13import qualified Reporting.Annotation as A
@@ -17,6 +19,7 @@ import qualified Reporting.Report as Report
17
19
18data Error
20data Error
19 = Var VarError
21 = Var VarError
22+ | BadRecursion Region.Region Canonical.Def [Canonical.Def]
20 | Pattern PatternError
23 | Pattern PatternError
21 | Alias AliasError
24 | Alias AliasError
22 | Import ModuleName.Raw ImportError
25 | Import ModuleName.Raw ImportError
@@ -154,6 +157,15 @@ toReport localizer err =
154 ("Cannot find " ++ var)
157 ("Cannot find " ++ var)
155 (Help.maybeYouWant suggestions)
158 (Help.maybeYouWant suggestions)
156
159
160+ BadRecursion region def defs ->
161+ case defs of
162+ [] ->
163+ badSelfRecursion region (defToString def)
164+
165+ _ ->
166+ badMutualRecursion region (defToString def) (map (defToString) defs)
167+
168+
157 Pattern patternError ->
169 Pattern patternError ->
158 case patternError of
170 case patternError of
159 PatternArgMismatch var expected actual ->
171 PatternArgMismatch var expected actual ->
@@ -281,6 +293,9 @@ extractSuggestions err =
281 Var (VarError _ _ _ suggestions) ->
293 Var (VarError _ _ _ suggestions) ->
282 Just suggestions
294 Just suggestions
283
295
296+ BadRecursion _ _ _ ->
297+ Nothing
298+
284 Pattern _ ->
299 Pattern _ ->
285 Nothing
300 Nothing
286
301
@@ -326,3 +341,61 @@ unsafePromote (A.A _ rawType) =
326 Type.RRecord fields ext ->
341 Type.RRecord fields ext ->
327 Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)
342 Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)
328
343
344+
345+
346+-- BAD RECURSION
347+
348+
349+badSelfRecursion :: Region.Region -> String -> Report.Report
350+badSelfRecursion region name =
351+ let
352+ header =
353+ Help.functionName name ++ " is defined diretly in terms of itself, causing an infinite loop."
354+ in
355+ Report.report "BAD RECURSION" (Just region) header $
356+ Help.stack
357+ [ Help.reflowParagraph $
358+ "To define " ++ Help.functionName name ++ " we need to know what "
359+ ++ Help.functionName name ++ " is, so let’s just expand that!\
360+ \ Wait, but now we need to know what " ++ Help.functionName name
361+ ++ " is, so let’s expand that..."
362+ , Help.reflowParagraph $
363+ "Check out the following links for more info on this situation and how to fix it: "
364+ ++ Help.hintLink "bad-recursion"
365+ ++ " <http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#lazy>"
366+ ]
367+
368+
369+badMutualRecursion :: Region.Region -> String -> [String] -> Report.Report
370+badMutualRecursion region name names =
371+ let
372+ header =
373+ Help.functionName name ++ " is defined in terms of itself in a sneaky way, causing an infinite loop."
374+
375+ otherDefs =
376+ if length names == 1 then
377+ "one other definition"
378+ else
379+ show (length names) ++ " other definitions"
380+ in
381+ Report.report "BAD RECURSION" (Just region) header $
382+ Help.stack
383+ [ Help.reflowParagraph $
384+ "The following definitions depend directly on each other:"
385+ , indent 4 $ Help.drawCycle (name : names)
386+ , Help.reflowParagraph $
387+ "So to define " ++ Help.functionName name
388+ ++ " we go through " ++ otherDefs ++ " before needing to know what "
389+ ++ Help.functionName name
390+ ++ " is. We can expand it again, but then we need to know what "
391+ ++ Help.functionName name ++ " is... This will keep going infinitely!"
392+ , Help.reflowParagraph $
393+ "Check out the following links for more info on this situation and how to fix it: "
394+ ++ Help.hintLink "bad-recursion"
395+ ++ " <http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#lazy>"
396+ ]
397+
398+
399+defToString :: Canonical.Def -> String
400+defToString (Canonical.Def _ pattern _ _) =
401+ P.toString False pattern