unrestricted variant of atomic (#1231)

Closes #1227.

Demo:

    scripts/play.sh --scenario data/scenarios/Challenges/word-search.yaml --autoplay

data/scenarios/Challenges/_word-search/create-puzzle.sw

@@ -244,4 +244,4 @@ def createPuzzle = \width. \height.
     removeBoulder;
     end;
 
-createPuzzle 25 15;
+instant $ createPuzzle 25 15;

data/scenarios/Challenges/word-search.yaml

@@ -6,16 +6,6 @@ description: |
 seed: 2
 creative: false
 objectives:
-  - id: prepare_playfield
-    teaser: Wait patiently
-    goal:
-      - |
-        First, wait for the playfield to be set up,
-        and then your path forward will be cleared.
-      - |
-        You can speed this process up with CTRL+x.
-    condition: |
-      as base {knows "capital C"};
   - goal:
       - Use the `drill` command (e.g. "drill down" when on top of the
         intended letter) to mark the sequence of letters that
@@ -25,7 +15,6 @@ objectives:
         leftward or rightward direction,
         or vertically in either the upward or downward direction.
         Diagonal appearances are not valid.
-    prerequisite: prepare_playfield
     condition: |
       /**
       Algorithm:

editors/emacs/swarm-mode.el

@@ -101,6 +101,7 @@
                "try"
                "swap"
                "atomic"
+               "instant"
                "installkeyhandler"
                "teleport"
                "as"

editors/vscode/syntaxes/swarm.tmLanguage.json

@@ -58,7 +58,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|scout|whereami|detect|resonate|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
+				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|scout|whereami|detect|resonate|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},

src/Swarm/Game/Step.hs

@@ -1511,14 +1511,8 @@ execConst c vs s k = do
         n <- uniform (0, hi - 1)
         return $ Out (VInt n) s k
       _ -> badConst
-    Atomic -> case vs of
-      -- To execute an atomic block, set the runningAtomic flag,
-      -- push an FFinishAtomic frame so that we unset the flag when done, and
-      -- proceed to execute the argument.
-      [cmd] -> do
-        runningAtomic .= True
-        return $ Out cmd s (FExec : FFinishAtomic : k)
-      _ -> badConst
+    Atomic -> goAtomic
+    Instant -> goAtomic
     As -> case vs of
       [VRobot rid, prog] -> do
         -- Get the named robot and current game state
@@ -2023,6 +2017,16 @@ execConst c vs s k = do
       let msg = "The operator '$' should only be a syntactic sugar and removed in elaboration:\n"
        in throwError . Fatal $ msg <> badConstMsg
  where
+  goAtomic :: HasRobotStepState sig m => m CESK
+  goAtomic = case vs of
+    -- To execute an atomic block, set the runningAtomic flag,
+    -- push an FFinishAtomic frame so that we unset the flag when done, and
+    -- proceed to execute the argument.
+    [cmd] -> do
+      runningAtomic .= True
+      return $ Out cmd s (FExec : FFinishAtomic : k)
+    _ -> badConst
+
   -- Case-insensitive matching on entity names
   isEntityNamed :: T.Text -> Entity -> Bool
   isEntityNamed n e = ((==) `on` T.toLower) (e ^. entityName) n

src/Swarm/Language/Capability.hs

@@ -227,6 +227,7 @@ constCaps = \case
   Self -> Just CWhoami
   Swap -> Just CSwap
   Atomic -> Just CAtomic
+  Instant -> Just CGod
   Time -> Just CTime
   Wait -> Just CTime
   Scout -> Just CRecondir

src/Swarm/Language/Syntax.hs

@@ -393,6 +393,8 @@ data Const
     --   that is, no other robots will execute any commands while
     --   the robot is executing @c@.
     Atomic
+  | -- | Like @atomic@, but with no restriction on program size.
+    Instant
   | -- Keyboard input
 
     -- | Create `key` values.
@@ -757,6 +759,10 @@ constInfo c = case c of
     command 1 Intangible . doc "Execute a block of commands atomically." $
       [ "When executing `atomic c`, a robot will not be interrupted, that is, no other robots will execute any commands while the robot is executing @c@."
       ]
+  Instant ->
+    command 1 Intangible . doc "Execute a block of commands instantly." $
+      [ "Like `atomic`, but with no restriction on program size."
+      ]
   Key ->
     function 1 . doc "Create a key value from a text description." $
       [ "The key description can optionally start with modifiers like 'C-', 'M-', 'A-', or 'S-', followed by either a regular key, or a special key name like 'Down' or 'End'"

src/Swarm/Language/Typecheck.hs

@@ -395,17 +395,8 @@ infer s@(Syntax l t) = (`catchError` addLocToTypeErr s) $ case t of
   -- the form 'cmd a'.  't' must also be syntactically free of
   -- variables.
 
-  TConst Atomic :$: at -> do
-    argTy <- fresh
-    at' <- check at (UTyCmd argTy)
-    atomic' <- infer (Syntax l (TConst Atomic))
-    -- It's important that we typecheck the subterm @at@ *before* we
-    -- check that it is a valid argument to @atomic@: this way we can
-    -- ensure that we have already inferred the types of any variables
-    -- referenced.
-    validAtomic at
-    return $ Syntax' l (SApp atomic' at') (at' ^. sType)
-
+  TConst Atomic :$: at -> inferAtomic True Atomic at
+  TConst Instant :$: at -> inferAtomic False Instant at
   -- Just look up variables in the context.
   TVar x -> Syntax' l (TVar x) <$> lookup l x
   -- To infer the type of a lambda if the type of the argument is
@@ -501,6 +492,19 @@ infer s@(Syntax l t) = (`catchError` addLocToTypeErr s) $ case t of
       throwError $
         EscapedSkolem l (head (S.toList ftyvs))
 
+  inferAtomic :: Bool -> Const -> Syntax -> Infer (Syntax' UType)
+  inferAtomic validateTickBudget constName at = do
+    argTy <- fresh
+    at' <- check at (UTyCmd argTy)
+    atomic' <- infer (Syntax l (TConst constName))
+    -- It's important that we typecheck the subterm @at@ *before* we
+    -- check that it is a valid argument to @atomic@: this way we can
+    -- ensure that we have already inferred the types of any variables
+    -- referenced.
+    when validateTickBudget $
+      validAtomic at
+    return $ Syntax' l (SApp atomic' at') (at' ^. sType)
+
 addLocToTypeErr :: Syntax' ty -> TypeErr -> Infer a
 addLocToTypeErr s te = case te of
   Mismatch NoLoc a b -> throwError $ Mismatch (s ^. sLoc) a b
@@ -620,6 +624,7 @@ inferConst c = case c of
   AppF -> [tyQ| (a -> b) -> a -> b |]
   Swap -> [tyQ| text -> cmd text |]
   Atomic -> [tyQ| cmd a -> cmd a |]
+  Instant -> [tyQ| cmd a -> cmd a |]
   Key -> [tyQ| text -> key |]
   InstallKeyHandler -> [tyQ| text -> (key -> cmd unit) -> cmd unit |]
   Teleport -> [tyQ| actor -> (int * int) -> cmd unit |]