Don't set it variable when an exception was raised (#1922)

Fixes #1899.  It turned out the problem was not specifically with infinite loop detection but simply any time an exception was thrown and bubbled up to the top level.  After logging the exception the CESK machine returned `VUnit` and there was no way for the UI to tell the difference between a computation that ended successfully with value `VUnit` and one with an uncaught exception.  This PR adds a new special value `VExc` to denote the result of a computation that threw an exception.  The UI can then check for this and not set the `it` variable in that case.

feedback.yaml

@@ -1,4 +1,4 @@
 loops:
-  build: cabal build -j -O0 all
+  build: cabal build -j -O0 --ghc-options='-Wall -Werror' all
   test: cabal test -j -O0 --test-show-details=direct swarm:swarm-integration swarm:swarm-unit
   unit: cabal test -j -O0 --test-show-details=direct swarm:swarm-unit

src/swarm-engine/Swarm/Game/Step.hs

@@ -847,11 +847,9 @@ stepCESK cesk = case cesk of
     let s' = resetBlackholes s
     h <- hasCapability CLog
     em <- use $ landscape . terrainAndEntities . entityMap
-    if h
-      then do
-        void $ traceLog RobotError Error (formatExn em exn)
-        return $ Out VUnit s []
-      else return $ Out VUnit s' []
+    when h $ void $ traceLog RobotError Error (formatExn em exn)
+    return $ Out VExc s' []
+
   -- Fatal errors, capability errors, and infinite loop errors can't
   -- be caught; just throw away the continuation stack.
   Up exn@Fatal {} s _ -> return $ Up exn s []

src/swarm-engine/Swarm/Game/Step/Arithmetic.hs

@@ -75,6 +75,7 @@ compareValues v1 = case v1 of
   VDelay {} -> incomparable v1
   VRef {} -> incomparable v1
   VRequirements {} -> incomparable v1
+  VExc {} -> incomparable v1
 
 -- | Values with different types were compared; this should not be
 --   possible since the type system should catch it.

src/swarm-lang/Swarm/Language/Value.hs

@@ -92,6 +92,9 @@ data Value where
   VKey :: KeyCombo -> Value
   -- | A 'requirements' command awaiting execution.
   VRequirements :: Text -> Term -> Env -> Value
+  -- | A special value representing a program that terminated with
+  --   an exception.
+  VExc :: Value
   deriving (Eq, Show, Generic)
 
 instance ToJSON Value where
@@ -133,6 +136,7 @@ valueToTerm (VRef n) = TRef n
 valueToTerm (VRcd m) = TRcd (Just . valueToTerm <$> m)
 valueToTerm (VKey kc) = TApp (TConst Key) (TText (prettyKeyCombo kc))
 valueToTerm (VRequirements x t _) = TRequirements x t
+valueToTerm VExc = TConst Undefined
 
 -- | An environment is a mapping from variable names to values.
 type Env = Ctx Value

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -104,7 +104,7 @@ import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax hiding (Key)
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Types
-import Swarm.Language.Value (Value (VKey, VUnit), prettyValue, stripVResult)
+import Swarm.Language.Value (Value (VExc, VKey, VUnit), prettyValue, stripVResult)
 import Swarm.Log
 import Swarm.TUI.Controller.Util
 import Swarm.TUI.Editor.Controller qualified as EC
@@ -829,26 +829,28 @@ updateUI = do
 
   -- Now check if the base finished running a program entered at the REPL.
   replUpdated <- case g ^. gameControls . replStatus of
-    -- It did, and the result was the unit value.  Just reset replStatus.
-    REPLWorking (Typed (Just VUnit) typ reqs) -> do
-      gameState . gameControls . replStatus .= REPLDone (Just $ Typed VUnit typ reqs)
-      pure True
+    REPLWorking (Typed (Just v) pty reqs)
+      -- It did, and the result was the unit value or an exception.  Just reset replStatus.
+      | v `elem` [VUnit, VExc] -> do
+          gameState . gameControls . replStatus .= REPLDone (Just $ Typed v pty reqs)
+          pure True
 
-    -- It did, and returned some other value.  Pretty-print the
-    -- result as a REPL output, with its type, and reset the replStatus.
-    REPLWorking (Typed (Just v) pty reqs) -> do
-      let finalType = stripCmd pty
-      let val = Typed (stripVResult v) finalType reqs
-      itIx <- use (gameState . gameControls . replNextValueIndex)
-      let itName = fromString $ "it" ++ show itIx
-      let out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
-      uiState . uiGameplay . uiREPL . replHistory %= addREPLItem (REPLOutput out)
-      invalidateCacheEntry REPLHistoryCache
-      vScrollToEnd replScroll
-      gameState . gameControls . replStatus .= REPLDone (Just val)
-      gameState . baseRobot . robotContext . at itName .= Just val
-      gameState . gameControls . replNextValueIndex %= (+ 1)
-      pure True
+      -- It did, and returned some other value.  Create a new 'it'
+      -- variable, pretty-print the result as a REPL output, with its
+      -- type, and reset the replStatus.
+      | otherwise -> do
+          itIx <- use (gameState . gameControls . replNextValueIndex)
+          let finalType = stripCmd pty
+              val = Typed (stripVResult v) finalType reqs
+              itName = fromString $ "it" ++ show itIx
+              out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
+          uiState . uiGameplay . uiREPL . replHistory %= addREPLItem (REPLOutput out)
+          invalidateCacheEntry REPLHistoryCache
+          vScrollToEnd replScroll
+          gameState . gameControls . replStatus .= REPLDone (Just val)
+          gameState . baseRobot . robotContext . at itName .= Just val
+          gameState . gameControls . replNextValueIndex %= (+ 1)
+          pure True
 
     -- Otherwise, do nothing.
     _ -> pure False

src/swarm-tui/Swarm/TUI/Model.hs

@@ -93,6 +93,8 @@ import Swarm.Game.State.Runtime
 import Swarm.Game.State.Substate
 import Swarm.Game.Tick (TickNumber (..))
 import Swarm.Game.World.Gen (Seed)
+import Swarm.Language.Typed (Typed (..))
+import Swarm.Language.Value (Value (VExc))
 import Swarm.Log
 import Swarm.TUI.Inventory.Sorting
 import Swarm.TUI.Model.Menu
@@ -317,5 +319,5 @@ topContext s = ctxPossiblyWithIt
   ctx = fromMaybe emptyRobotContext $ s ^? gameState . baseRobot . robotContext
 
   ctxPossiblyWithIt = case s ^. gameState . gameControls . replStatus of
-    REPLDone (Just p) -> ctx & at "it" ?~ p
+    REPLDone (Just p@(Typed v _ _)) | v /= VExc -> ctx & at "it" ?~ p
     _ -> ctx