mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-05 20:19:09 +03:00
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.
This commit is contained in:
parent
1eabd556b9
commit
08730162bd
@ -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
|
||||
|
@ -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 []
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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,19 +829,21 @@ 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)
|
||||
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
|
||||
-- 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 itName = fromString $ "it" ++ show itIx
|
||||
let out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
|
||||
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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user