on master help sign in
Add back nice errors for infinite values
d88abc7Evan Czaplicki
builder/src/Generate/Nitpick.hs+1−1
@@ -39,7 +39,7 @@ nodeHasDebug node =
39 Opt.Enum _ -> False
39 Opt.Enum _ -> False
40 Opt.Box -> False
40 Opt.Box -> False
41 Opt.Link _ -> False
41 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
43 Opt.Manager _ -> False
43 Opt.Manager _ -> False
44 Opt.Kernel _ _ -> False
44 Opt.Kernel _ _ -> False
45 Opt.PortIncoming expr _ -> hasDebug expr
45 Opt.PortIncoming expr _ -> hasDebug expr
compiler/src/AST/Optimized.hs+3−3
@@ -150,7 +150,7 @@ data Node
150 | Enum Index.ZeroBased
150 | Enum Index.ZeroBased
151 | Box
151 | Box
152 | Link Global
152 | Link Global
153− | Cycle [(N.Name, Expr)] [Def] (Set.Set Global)
153+ | Cycle [N.Name] [(N.Name, Expr)] [Def] (Set.Set Global)
154 | Manager EffectsType
154 | Manager EffectsType
155 | Kernel KContent (Maybe KContent)
155 | Kernel KContent (Maybe KContent)
156 | PortIncoming Expr (Set.Set Global)
156 | PortIncoming Expr (Set.Set Global)
@@ -344,7 +344,7 @@ instance Binary Node where
344 Enum a -> putWord8 3 >> put a
344 Enum a -> putWord8 3 >> put a
345 Box -> putWord8 4
345 Box -> putWord8 4
346 Link a -> putWord8 5 >> put a
346 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
348 Manager a -> putWord8 7 >> put a
348 Manager a -> putWord8 7 >> put a
349 Kernel a b -> putWord8 8 >> put a >> put b
349 Kernel a b -> putWord8 8 >> put a >> put b
350 PortIncoming a b -> putWord8 9 >> put a >> put b
350 PortIncoming a b -> putWord8 9 >> put a >> put b
@@ -359,7 +359,7 @@ instance Binary Node where
359 3 -> liftM Enum get
359 3 -> liftM Enum get
360 4 -> return Box
360 4 -> return Box
361 5 -> liftM Link get
361 5 -> liftM Link get
362− 6 -> liftM3 Cycle get get get
362+ 6 -> liftM4 Cycle get get get get
363 7 -> liftM Manager get
363 7 -> liftM Manager get
364 8 -> liftM2 Kernel get get
364 8 -> liftM2 Kernel get get
365 9 -> liftM2 PortIncoming get get
365 9 -> liftM2 PortIncoming get get
compiler/src/Generate/JavaScript.hs+33−8
@@ -184,9 +184,9 @@ addGlobalHelp mode graph global state =
184 Opt.Link linkedGlobal ->
184 Opt.Link linkedGlobal ->
185 addGlobal mode graph state linkedGlobal
185 addGlobal mode graph state linkedGlobal
186
186
187− Opt.Cycle values functions deps ->
187+ Opt.Cycle names values functions deps ->
188 addStmt (addDeps deps state) (
188 addStmt (addDeps deps state) (
189− generateCycle mode global values functions
189+ generateCycle mode global names values functions
190 )
190 )
191
191
192 Opt.Manager effectsType ->
192 Opt.Manager effectsType ->
@@ -253,14 +253,28 @@ isDebugger (Opt.Global (ModuleName.Canonical _ home) _) =
253-- GENERATE CYCLES
253-- GENERATE CYCLES
254
254
255
255
256−generateCycle :: Mode.Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt
256+generateCycle :: Mode.Mode -> Opt.Global -> [N.Name] -> [(N.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt
257−generateCycle mode (Opt.Global home _) values functions =
257+generateCycle mode (Opt.Global home _) names values functions =
258 let
258 let
259− funcDefs = map (generateCycleFunc mode home) functions
259+ funcBlock = JS.Block $ map (generateCycleFunc mode home) functions
260− safeDefs = map (generateSafeCycle mode home) values
260+ safeBlock = JS.Block $ map (generateSafeCycle mode home) values
261− realDefs = map (generateRealCycle home) values
261+ realBlock = JS.Block $ map (generateRealCycle home) values
262 in
262 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 ]
264
278
265
279
266generateCycleFunc :: Mode.Mode -> ModuleName.Canonical -> Opt.Def -> JS.Stmt
280generateCycleFunc :: Mode.Mode -> ModuleName.Canonical -> Opt.Def -> JS.Stmt
@@ -292,6 +306,17 @@ generateRealCycle home (name, _) =
292 ]
306 ]
293
307
294
308
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+
295
320
296-- GENERATE KERNEL
321-- GENERATE KERNEL
297
322
compiler/src/Optimize/Module.hs+2−2
@@ -308,7 +308,7 @@ data State =
308addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
308addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
309addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
309addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
310 let
310 let
311− names = map toName defs
311+ names = reverse (map toName defs)
312 cycleName = Opt.Global home (N.toCompositeName names)
312 cycleName = Opt.Global home (N.toCompositeName names)
313 cycle = foldr addValueName Set.empty defs
313 cycle = foldr addValueName Set.empty defs
314 links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs
314 links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs
@@ -319,7 +319,7 @@ addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
319 in
319 in
320 Opt.Graph
320 Opt.Graph
321 mains
321 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))
323 (Map.unionWith (+) fields fieldCounts)
323 (Map.unionWith (+) fields fieldCounts)
324
324
325
325