on master help sign in
Add back nice errors for infinite values
commitd88abc704674a2a38e90afa64a7609651bf8ca43 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 22 May 2018, 23:43 (8 years ago) parent4258527
4 files changed+39−14
builder/src/Generate/Nitpick.hs+1−1 compiler/src/AST/Optimized.hs+3−3 compiler/src/Generate/JavaScript.hs+33−8 compiler/src/Optimize/Module.hs+2−2
builder/src/Generate/Nitpick.hs+1−1
@@ -39,7 +39,7 @@ nodeHasDebug node =
3939 Opt.Enum _ -> False
4040 Opt.Box -> False
4141 Opt.Link _ -> False
42− Opt.Cycle vs fs _ -> any (hasDebug . snd) vs || any defHasDebug fs
42+ Opt.Cycle _ vs fs _ -> any (hasDebug . snd) vs || any defHasDebug fs
4343 Opt.Manager _ -> False
4444 Opt.Kernel _ _ -> False
4545 Opt.PortIncoming expr _ -> hasDebug expr
compiler/src/AST/Optimized.hs+3−3
@@ -150,7 +150,7 @@ data Node
150150 | Enum Index.ZeroBased
151151 | Box
152152 | Link Global
153− | Cycle [(N.Name, Expr)] [Def] (Set.Set Global)
153+ | Cycle [N.Name] [(N.Name, Expr)] [Def] (Set.Set Global)
154154 | Manager EffectsType
155155 | Kernel KContent (Maybe KContent)
156156 | PortIncoming Expr (Set.Set Global)
@@ -344,7 +344,7 @@ instance Binary Node where
344344 Enum a -> putWord8 3 >> put a
345345 Box -> putWord8 4
346346 Link a -> putWord8 5 >> put a
347− Cycle a b c -> putWord8 6 >> put a >> put b >> put c
347+ Cycle a b c d -> putWord8 6 >> put a >> put b >> put c >> put d
348348 Manager a -> putWord8 7 >> put a
349349 Kernel a b -> putWord8 8 >> put a >> put b
350350 PortIncoming a b -> putWord8 9 >> put a >> put b
@@ -359,7 +359,7 @@ instance Binary Node where
359359 3 -> liftM Enum get
360360 4 -> return Box
361361 5 -> liftM Link get
362− 6 -> liftM3 Cycle get get get
362+ 6 -> liftM4 Cycle get get get get
363363 7 -> liftM Manager get
364364 8 -> liftM2 Kernel get get
365365 9 -> liftM2 PortIncoming get get
compiler/src/Generate/JavaScript.hs+33−8
@@ -184,9 +184,9 @@ addGlobalHelp mode graph global state =
184184 Opt.Link linkedGlobal ->
185185 addGlobal mode graph state linkedGlobal
186186
187− Opt.Cycle values functions deps ->
187+ Opt.Cycle names values functions deps ->
188188 addStmt (addDeps deps state) (
189− generateCycle mode global values functions
189+ generateCycle mode global names values functions
190190 )
191191
192192 Opt.Manager effectsType ->
@@ -253,14 +253,28 @@ isDebugger (Opt.Global (ModuleName.Canonical _ home) _) =
253253-- GENERATE CYCLES
254254
255255
256−generateCycle :: Mode.Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt
257−generateCycle mode (Opt.Global home _) values functions =
256+generateCycle :: Mode.Mode -> Opt.Global -> [N.Name] -> [(N.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt
257+generateCycle mode (Opt.Global home _) names values functions =
258258 let
259− funcDefs = map (generateCycleFunc mode home) functions
260− safeDefs = map (generateSafeCycle mode home) values
261− realDefs = map (generateRealCycle home) values
259+ funcBlock = JS.Block $ map (generateCycleFunc mode home) functions
260+ safeBlock = JS.Block $ map (generateSafeCycle mode home) values
261+ realBlock = JS.Block $ map (generateRealCycle home) values
262262 in
263− JS.Block (funcDefs ++ safeDefs ++ realDefs)
263+ case mode of
264+ Mode.Prod _ _ ->
265+ JS.Block [ funcBlock, safeBlock, realBlock ]
266+
267+ Mode.Dev _ _ ->
268+ let
269+ tryRealBlock =
270+ JS.Try realBlock Name.dollar $ JS.Throw $ JS.String $
271+ "Some top-level definitions from `" <> N.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
272+ <> drawCycle names
273+ <> "\\n\\nThese errors are very tricky, so read "
274+ <> B.stringUtf8 (D.makeNakedLink "halting-problem")
275+ <> " to learn how to fix it!"
276+ in
277+ JS.Block [ funcBlock, safeBlock, tryRealBlock ]
264278
265279
266280generateCycleFunc :: Mode.Mode -> ModuleName.Canonical -> Opt.Def -> JS.Stmt
@@ -292,6 +306,17 @@ generateRealCycle home (name, _) =
292306 ]
293307
294308
309+drawCycle :: [N.Name] -> B.Builder
310+drawCycle names =
311+ let
312+ topLine = "\\n ┌─────┐"
313+ nameLine name = "\\n │ " <> N.toBuilder name
314+ midLine = "\\n │ ↓"
315+ bottomLine = "\\n └─────┘"
316+ in
317+ mconcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
318+
319+
295320
296321-- GENERATE KERNEL
297322
compiler/src/Optimize/Module.hs+2−2
@@ -308,7 +308,7 @@ data State =
308308addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
309309addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
310310 let
311− names = map toName defs
311+ names = reverse (map toName defs)
312312 cycleName = Opt.Global home (N.toCompositeName names)
313313 cycle = foldr addValueName Set.empty defs
314314 links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs
@@ -319,7 +319,7 @@ addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
319319 in
320320 Opt.Graph
321321 mains
322− (Map.insert cycleName (Opt.Cycle values funcs deps) (Map.union links nodes))
322+ (Map.insert cycleName (Opt.Cycle names values funcs deps) (Map.union links nodes))
323323 (Map.unionWith (+) fields fieldCounts)
324324
325325