diff --git a/.hlint.yaml b/.hlint.yaml
index ac153292d3..aa116ec8d2 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -31,7 +31,7 @@
   - {name: Prelude.tail, within: []}
   - {name: Prelude.!!, within: [Swarm.Util.indexWrapNonEmpty, TestEval]}
   - {name: undefined, within: [Swarm.Language.Key, TestUtil]}
-  - {name: fromJust, within: []}
+  - {name: fromJust, within: [Text.AhoCorasick]}
 # - {name: Data.Map.!, within: []} # TODO: #1494
 # - {name: error, within: []} # TODO: #1494
 
diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt
index 91789eed9d..581eff1216 100644
--- a/data/scenarios/Testing/00-ORDER.txt
+++ b/data/scenarios/Testing/00-ORDER.txt
@@ -49,3 +49,4 @@ Achievements
 1430-built-robot-ownership.yaml
 1536-custom-unwalkable-entities.yaml
 1535-ping
+1575-structure-recognizer
diff --git a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
new file mode 100644
index 0000000000..4c9a9adcd5
--- /dev/null
+++ b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
@@ -0,0 +1 @@
+1575-browse-structures.yaml
\ No newline at end of file
diff --git a/data/scenarios/Testing/1575-structure-recognizer/1575-browse-structures.yaml b/data/scenarios/Testing/1575-structure-recognizer/1575-browse-structures.yaml
new file mode 100644
index 0000000000..a78d9ad86f
--- /dev/null
+++ b/data/scenarios/Testing/1575-structure-recognizer/1575-browse-structures.yaml
@@ -0,0 +1,119 @@
+version: 1
+name: Subworld shared structures
+description: |
+  Traverse floors of the tower
+creative: true
+robots:
+  - name: base
+    dir: [1, 0]
+    devices:
+      - ADT calculator
+      - branch predictor
+      - comparator
+      - compass
+      - dictionary
+      - GPS receiver
+      - grabber
+      - lambda
+      - lodestone
+      - logger
+      - strange loop
+      - treads
+    inventory:
+      - [50, flower]
+      - [50, log]
+      - [50, rock]
+      - [50, copper pipe]
+      - [50, iron gear]
+      - [50, quartz]
+      - [50, gold]
+      - [50, silver]
+      - [50, mithril]
+      - [50, cotton]
+solution: |
+   move;
+   place "quartz";
+   move;
+   place "quartz";
+   move;
+   place "mithril";
+structures:
+  - name: donut
+    structure:
+      palette:
+        '.': [stone]
+        '@': [dirt, rock]
+      map: |
+        .@@@.
+        @@@@@
+        @@.@@
+        @@@@@
+        .@@@.
+  - name: diamond
+    structure:
+      mask: '.'
+      palette:
+        'x': [stone, flower]
+      map: |
+        ...x...
+        ..xxx..
+        .xxxxx.
+        xxxxxxx
+        .xxxxx.
+        ..xxx..
+        ...x...
+  - name: contraption
+    structure:
+      mask: '.'
+      palette:
+        'r': [stone, log]
+        'I': [stone, rock]
+        'l': [stone, copper pipe]
+        'g': [stone, iron gear]
+      map: |
+       rllllr
+       lIIIIl
+       lIIIgg
+       rlllgg
+  - name: precious
+    structure:
+      mask: '.'
+      palette:
+        'q': [stone, quartz]
+        'g': [stone, gold]
+        's': [stone, silver]
+        'm': [stone, mithril]
+      map: |
+       qgs
+       gsq
+       qqm
+  - name: smallish
+    structure:
+      mask: '.'
+      palette:
+        'q': [stone, quartz]
+        'm': [stone, mithril]
+        'c': [stone, cotton]
+      map: |
+       qqm
+       cqq
+known: [flower, log, rock, copper pipe, iron plate]
+world:
+  name: root
+  dsl: |
+    {blank}
+  palette:
+    '.': [grass]
+    'q': [grass, quartz]
+    'g': [grass, gold]
+    's': [grass, silver]
+    'm': [grass, mithril]
+    'c': [grass, cotton]
+    'B': [grass, null, base]
+  upperleft: [0, 0]
+  map: |
+    .qgs.
+    .gsq.
+    B....
+    .cqq.
+    .....
diff --git a/src/Swarm/Game/Scenario.hs b/src/Swarm/Game/Scenario.hs
index 09b5418ab2..df3640285c 100644
--- a/src/Swarm/Game/Scenario.hs
+++ b/src/Swarm/Game/Scenario.hs
@@ -35,6 +35,7 @@ module Swarm.Game.Scenario (
   scenarioKnown,
   scenarioWorlds,
   scenarioNavigation,
+  scenarioStructures,
   scenarioRobots,
   scenarioObjectives,
   scenarioSolution,
@@ -108,6 +109,7 @@ data Scenario = Scenario
   , _scenarioKnown :: [Text]
   , _scenarioWorlds :: NonEmpty WorldDescription
   , _scenarioNavigation :: Navigation (M.Map SubworldName) Location
+  , _scenarioStructures :: Structure.InheritedStructureDefs
   , _scenarioRobots :: [TRobot]
   , _scenarioObjectives :: [Objective]
   , _scenarioSolution :: Maybe ProcessedTerm
@@ -186,6 +188,7 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
         <*> pure known
         <*> pure allWorlds
         <*> pure mergedNavigation
+        <*> pure rootLevelSharedStructures
         <*> pure rs
         <*> (liftE (v .:? "objectives" .!= []) >>= validateObjectives)
         <*> liftE (v .:? "solution")
@@ -237,6 +240,10 @@ scenarioWorlds :: Lens' Scenario (NonEmpty WorldDescription)
 -- | Waypoints and inter-world portals
 scenarioNavigation :: Lens' Scenario (Navigation (M.Map SubworldName) Location)
 
+-- | Structure templates that may be auto-recognized when constructed
+-- by a robot
+scenarioStructures :: Lens' Scenario Structure.InheritedStructureDefs
+
 -- | The starting robots for the scenario.  Note this should
 --   include the base.
 scenarioRobots :: Lens' Scenario [TRobot]
diff --git a/src/Swarm/Game/Scenario/Topography/Structure.hs b/src/Swarm/Game/Scenario/Topography/Structure.hs
index 226d766645..296003738f 100644
--- a/src/Swarm/Game/Scenario/Topography/Structure.hs
+++ b/src/Swarm/Game/Scenario/Topography/Structure.hs
@@ -35,9 +35,9 @@ data NamedStructure c = NamedStructure
   }
   deriving (Eq, Show)
 
-type InheritedStructureDefs = [NamedStructure (Maybe (PCell Entity))]
+type InheritedStructureDefs = [NamedStructure (Maybe Cell)]
 
-instance FromJSONE (EntityMap, RobotMap) (NamedStructure (Maybe (PCell Entity))) where
+instance FromJSONE (EntityMap, RobotMap) (NamedStructure (Maybe Cell)) where
   parseJSONE = withObjectE "named structure" $ \v -> do
     NamedStructure
       <$> liftE (v .: "name")
@@ -114,7 +114,7 @@ mergeStructures inheritedStrucDefs parentPlacement (Structure origArea subStruct
   g placement@(Placement sName _ _) =
     sequenceA (placement, M.lookup sName structureMap)
 
-instance FromJSONE (EntityMap, RobotMap) (PStructure (Maybe (PCell Entity))) where
+instance FromJSONE (EntityMap, RobotMap) (PStructure (Maybe Cell)) where
   parseJSONE = withObjectE "structure definition" $ \v -> do
     pal <- v ..:? "palette" ..!= WorldPalette mempty
     localStructureDefs <- v ..:? "structures" ..!= []
diff --git a/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
new file mode 100644
index 0000000000..e3033ea5f5
--- /dev/null
+++ b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Structure recognizer: precomputation
+module Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute where
+
+import Control.Lens hiding (from, (<.>))
+import Data.Hashable (Hashable)
+import Data.Int (Int32)
+import Data.List.NonEmpty qualified as NE
+import Data.Map (Map)
+import Data.Map qualified as M
+import Data.Maybe (catMaybes)
+import Data.Semigroup (sconcat)
+import Data.Tuple (swap)
+import GHC.Generics (Generic)
+import Swarm.Game.Entity (Entity)
+import Swarm.Game.Scenario.Topography.Cell
+import Swarm.Game.Scenario.Topography.Structure
+import Swarm.Util (binTuples, histogram)
+import Swarm.Util.Erasable (erasableToMaybe)
+import Text.AhoCorasick
+
+type AtomicKeySymbol = Maybe Entity
+
+data StructureRow = StructureRow
+  { wholeStructure :: StructureWithGrid
+  , rowIndex :: Int32
+  , rowContent :: [AtomicKeySymbol]
+  }
+
+data StructureWithGrid = StructureWithGrid
+  { originalDefinition :: NamedStructure (Maybe Cell)
+  , entityGrid :: [[AtomicKeySymbol]]
+  }
+
+data StructureInfo = StructureInfo
+  { withGrid :: StructureWithGrid
+  , entityCounts :: Map Entity Int
+  }
+
+-- | For all of the rows that contain a given entity
+-- (and are recognized by a single automaton),
+-- compute the left-most and right-most position
+-- within the row that the given entity may occur.
+--
+-- This determines how far to the left and to the right
+-- our search of the world cells needs to begin and
+-- end, respectively.
+--
+-- The 'Semigroup' instance always grows in extent, taking the minimum
+-- of the leftward offsets and the maximum of the rightward offsets.
+data InspectionOffsets = InspectionOffsets
+  { startOffset :: Int32
+  -- ^ Always non-positive (i.e. either zero or negative).
+  -- For the first-level search, this extends to the left.
+  -- For the second-level search, this extends upward.
+  , endOffset :: Int32
+  -- ^ Always non-negative.
+  -- For the first-level search, this extends to the right.
+  -- For the second-level search, this extends downward.
+  }
+  deriving (Show)
+
+instance Semigroup InspectionOffsets where
+  InspectionOffsets l1 r1 <> InspectionOffsets l2 r2 =
+    InspectionOffsets (min l1 l2) (max r1 r2)
+
+-- | Each automaton shall be initialized to recognize
+-- a certain subset of structure rows, that may either
+-- all be within one structure, or span multiple structures.
+data AutomatonInfo k = AutomatonInfo
+  { _inspectionOffsets :: InspectionOffsets
+  , _automaton :: StateMachine k StructureRow
+  }
+  deriving (Generic)
+
+makeLenses ''AutomatonInfo
+
+-- | The complete set of data needed to identify applicable
+-- structures, based on a just-placed entity.
+data RecognizerAutomatons = RecognizerAutomatons
+  { _definitions :: [StructureInfo]
+  , _automatonsByEntity :: Map Entity (AutomatonInfo AtomicKeySymbol)
+  , _automatonsByRow :: Map [AtomicKeySymbol] (AutomatonInfo [AtomicKeySymbol])
+  }
+  deriving (Generic)
+
+makeLenses ''RecognizerAutomatons
+
+getEntityGrid :: NamedStructure (Maybe Cell) -> [[AtomicKeySymbol]]
+getEntityGrid = map (map ((erasableToMaybe . cellEntity) =<<)) . area . structure
+
+allStructureRows :: [StructureWithGrid] -> [StructureRow]
+allStructureRows =
+  concatMap getRows
+ where
+  getRows :: StructureWithGrid -> [StructureRow]
+  getRows g = zipWith (StructureRow g) [0 ..] $ entityGrid g
+
+data RowPosition = RowPosition
+  { position :: Int32
+  , structureRow :: StructureRow
+  }
+
+mkOffsets :: Foldable f => Int32 -> f a -> InspectionOffsets
+mkOffsets pos xs =
+  InspectionOffsets (negate pos) $
+    fromIntegral (length xs) - 1 - pos
+
+mkGenericLookup ::
+  (Foldable t, Ord k, Hashable keySymb) =>
+  [StructureRow] ->
+  (a -> InspectionOffsets) ->
+  (a -> ([keySymb], StructureRow)) ->
+  ([StructureRow] -> t (k, a)) ->
+  Map k (AutomatonInfo keySymb)
+mkGenericLookup gs f mkSmTuple preprocessAllRows =
+  M.map mkValues structuresByRow
+ where
+  mkValues neList = AutomatonInfo bounds sm
+   where
+    bounds = sconcat $ NE.map f neList
+    sm = makeStateMachine $ NE.toList $ NE.map mkSmTuple neList
+
+  structuresByRow = binTuples $ preprocessAllRows gs
+
+mkRowLookup :: [StructureRow] -> Map [AtomicKeySymbol] (AutomatonInfo [AtomicKeySymbol])
+mkRowLookup gs =
+  mkGenericLookup gs deriveRowOffsets mkSmTuple preprocessAllRows
+ where
+  mkSmTuple x = (entityGrid $ wholeStructure x, x)
+  preprocessAllRows = map (\r@(StructureRow _ _ content) -> (content, r))
+
+  deriveRowOffsets :: StructureRow -> InspectionOffsets
+  deriveRowOffsets (StructureRow (StructureWithGrid _ g) rwIdx _) =
+    mkOffsets rwIdx g
+
+-- | Make the first-phase lookup map, keyed by 'Entity',
+-- along with automatons whose key symbols are "Maybe Entity".
+mkEntityLookup :: [StructureRow] -> Map Entity (AutomatonInfo AtomicKeySymbol)
+mkEntityLookup gs =
+  mkGenericLookup gs deriveEntityOffsets mkSmTuple preprocessAllRows
+ where
+  mkSmTuple = (\x -> (rowContent x, x)) . structureRow
+
+  deriveEntityOffsets :: RowPosition -> InspectionOffsets
+  deriveEntityOffsets (RowPosition pos r) =
+    mkOffsets pos $ rowContent r
+
+  preprocessAllRows = concatMap f
+   where
+    f :: StructureRow -> [(Entity, RowPosition)]
+    f r@(StructureRow _ _ content) =
+      map swap $
+        catMaybes $
+          zipWith (\idx -> fmap (RowPosition idx r,)) [0 :: Int32 ..] content
+
+mkAutomatons :: InheritedStructureDefs -> RecognizerAutomatons
+mkAutomatons xs =
+  RecognizerAutomatons
+    infos
+    (mkEntityLookup rowsAcrossAllStructures)
+    (mkRowLookup rowsAcrossAllStructures)
+ where
+  infos = map process grids
+  grids = map (\x -> StructureWithGrid x $ getEntityGrid x) xs
+  rowsAcrossAllStructures = allStructureRows grids
+
+  process g = StructureInfo g . histogram . concatMap catMaybes $ entityGrid g
diff --git a/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
new file mode 100644
index 0000000000..cd18928cf3
--- /dev/null
+++ b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Structure recognizer: online operations
+module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking where
+
+import Control.Carrier.State.Lazy
+import Control.Effect.Lens
+import Control.Lens ((^.))
+import Control.Monad (forM_)
+import Data.Int (Int32)
+import Data.IntervalMap.FingerTree
+import Data.List.NonEmpty qualified as NE
+import Data.Map qualified as M
+import Data.Text qualified as T
+import Linear (V2 (..))
+import Swarm.Game.Entity
+import Swarm.Game.Location
+import Swarm.Game.Scenario.Topography.Structure qualified as Structure
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
+import Swarm.Game.State
+import Swarm.Game.Step.Util.Inspect
+import Swarm.Game.Universe
+import Text.AhoCorasick
+
+-- | Intervals will go into a 'Map' keyed by the vertical coordinate.
+mkIntervals :: Cosmic Location -> [Position StructureRow] -> [MapInsertion]
+mkIntervals firstLoc@(Cosmic sw (Location x y)) = map mkOneInterval
+ where
+  mkOneInterval p = MapInsertion y (Interval leftCoord $ leftCoord + fromIntegral (pLength p)) $ pVal p
+   where
+    leftCoord = x + fromIntegral (pIndex p)
+
+entityModified ::
+  (Has (State GameState) sig m) =>
+  Cosmic Location ->
+  m ()
+entityModified cLoc = do
+  maybeEntity <- entityAt cLoc
+  forM_ maybeEntity $ \newEntity -> do
+    entLookup <- use $ discovery . structureRecognition . automatons . automatonsByEntity
+    let maybeFinder :: Maybe (AutomatonInfo AtomicKeySymbol)
+        maybeFinder = M.lookup newEntity entLookup
+        msg =
+          T.unwords
+            [ "Found new"
+            , view entityName newEntity
+            , "; Finder:"
+            , maybe "<none>" (T.pack . show . (^. inspectionOffsets)) maybeFinder
+            ]
+    discovery . structureRecognition . recognitionLog %= (msg :)
+    forM_ maybeFinder $ registerRowMatches cLoc
+
+getWorldRow ::
+  (Has (State GameState) sig m) =>
+  Cosmic Location ->
+  Int32 ->
+  InspectionOffsets ->
+  m ([Maybe Entity], NE.NonEmpty (Cosmic Location))
+getWorldRow cLoc yOffset (InspectionOffsets offsetLeft offsetRight) = do
+  entitiesRow <- mapM entityAt $ NE.toList horizontalOffsets
+  return (entitiesRow, horizontalOffsets)
+ where
+  horizontalOffsets = NE.fromList [cLoc `offsetBy` V2 x yOffset | x <- [offsetLeft .. offsetRight]]
+
+registerRowMatches ::
+  (Has (State GameState) sig m) =>
+  Cosmic Location ->
+  AutomatonInfo AtomicKeySymbol ->
+  m ()
+registerRowMatches cLoc (AutomatonInfo horizontalOffsets sm) = do
+  (entitiesRow, offsets) <- getWorldRow cLoc 0 horizontalOffsets
+  let rowContentMsg =
+        T.unwords
+          [ "Row content:"
+          , T.pack $ show $ map (fmap $ view entityName) entitiesRow
+          ]
+
+  discovery . structureRecognition . recognitionLog %= (rowContentMsg :)
+
+  let candidates = findAll sm entitiesRow
+
+      intervalInsertions = mkIntervals (NE.head offsets) candidates
+
+      newMsg =
+        T.intercalate ", " $
+          map
+            ( \z ->
+                T.unwords
+                  [ T.pack . show . Structure.name . originalDefinition . wholeStructure $ pVal z
+                  , "; Row"
+                  , T.pack . show . rowIndex $ pVal z
+                  ]
+            )
+            candidates
+
+  discovery . structureRecognition . recognitionLog %= ("Found: " <> newMsg :)
+
+  forM_ candidates $ checkVerticalMatch cLoc horizontalOffsets
+
+checkVerticalMatch ::
+  (Has (State GameState) sig m) =>
+  Cosmic Location ->
+  -- | Horizontal search offsets
+  InspectionOffsets ->
+  Position StructureRow ->
+  m ()
+checkVerticalMatch cLoc horizontalSearchOffsets@(InspectionOffsets searchOffsetLeft searchOffsetRight) foundRow = do
+  rowLookup <- use $ discovery . structureRecognition . automatons . automatonsByRow
+  let maybeFinder2D :: Maybe (AutomatonInfo [AtomicKeySymbol])
+
+      rowMembers = rowContent $ pVal foundRow
+      maybeFinder2D = M.lookup rowMembers rowLookup
+
+      msg =
+        T.unwords
+          [ "Checking for structures containing row:"
+          , T.pack $ show $ map (fmap (view entityName)) rowMembers
+          , "; 2D Finder:"
+          , maybe "<none>" (T.pack . show . (^. inspectionOffsets)) maybeFinder2D
+          ]
+
+  discovery . structureRecognition . recognitionLog %= (msg :)
+
+  forM_ maybeFinder2D $ registerStructureMatches cLoc horizontalFoundOffsets
+ where
+  foundLeftOffset = searchOffsetLeft + fromIntegral (pIndex foundRow)
+  foundRightInclusiveIndex = foundLeftOffset + fromIntegral (pLength foundRow) - 1
+  horizontalFoundOffsets = InspectionOffsets foundLeftOffset foundRightInclusiveIndex
+
+registerStructureMatches ::
+  (Has (State GameState) sig m) =>
+  Cosmic Location ->
+  -- | Horizontal found offsets (inclusive indices)
+  InspectionOffsets ->
+  AutomatonInfo [AtomicKeySymbol] ->
+  m ()
+registerStructureMatches cLoc horizontalFoundOffsets (AutomatonInfo (InspectionOffsets offsetTop offsetBottom) sm) = do
+  entityRows <- mapM getRow verticalOffsets
+
+  let candidates = findAll sm entityRows
+
+      newMsg =
+        T.intercalate ", " $
+          map
+            ( T.pack . show . Structure.name . originalDefinition . wholeStructure . pVal
+            )
+            candidates
+
+  discovery . structureRecognition . recognitionLog %= ("Completed: " <> newMsg :)
+ where
+  getRow i = fst <$> getWorldRow cLoc i horizontalFoundOffsets
+  verticalOffsets = reverse [offsetTop .. offsetBottom]
diff --git a/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
new file mode 100644
index 0000000000..5d2296377d
--- /dev/null
+++ b/src/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Structure recognizer
+module Swarm.Game.Scenario.Topography.Structure.Recognition.Type where
+
+import Control.Lens hiding (from, (<.>))
+import Data.Int (Int32)
+import Data.IntervalMap.FingerTree
+import Data.Map (Map)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Swarm.Game.Scenario.Topography.Structure
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+
+data MapInsertion = MapInsertion
+  { verticalCoord :: Int32
+  , horizontalInterval :: Interval Int32
+  , matchCandidate :: StructureRow
+  }
+
+data StructureRecognizer = StructureRecognizer
+  { _automatons :: RecognizerAutomatons
+  , _intervals :: Map Int32 (IntervalMap Int32 StructureRow)
+  , _recognitionLog :: [Text]
+  }
+  deriving (Generic)
+
+makeLenses ''StructureRecognizer
+
+mkRecognizer :: InheritedStructureDefs -> StructureRecognizer
+mkRecognizer xs = StructureRecognizer (mkAutomatons xs) mempty []
diff --git a/src/Swarm/Game/State.hs b/src/Swarm/Game/State.hs
index 505346c585..ea4d1acd3b 100644
--- a/src/Swarm/Game/State.hs
+++ b/src/Swarm/Game/State.hs
@@ -100,6 +100,7 @@ module Swarm.Game.State (
   availableCommands,
   knownEntities,
   gameAchievements,
+  structureRecognition,
 
   -- *** Landscape
   Landscape,
@@ -211,6 +212,8 @@ import Swarm.Game.Robot
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Status
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.ScenarioInfo
 import Swarm.Game.Terrain (TerrainType (..))
 import Swarm.Game.Universe as U
@@ -513,6 +516,7 @@ data Discovery = Discovery
   , _availableCommands :: Notifications Const
   , _knownEntities :: [Text]
   , _gameAchievements :: Map GameplayAchievement Attainment
+  , _structureRecognition :: StructureRecognizer
   }
 
 makeLensesNoSigs ''Discovery
@@ -533,6 +537,9 @@ knownEntities :: Lens' Discovery [Text]
 -- | Map of in-game achievements that were obtained
 gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
 
+-- | Recognizer for robot-constructed structures
+structureRecognition :: Lens' Discovery StructureRecognizer
+
 data Landscape = Landscape
   { _worldNavigation :: Navigation (M.Map SubworldName) Location
   , _multiWorld :: W.MultiWorld Int Entity
@@ -1166,6 +1173,7 @@ initGameState gsc =
           , -- This does not need to be initialized with anything,
             -- since the master list of achievements is stored in UIState
             _gameAchievements = mempty
+          , _structureRecognition = StructureRecognizer (RecognizerAutomatons [] mempty mempty) mempty []
           }
     , _activeRobots = IS.empty
     , _waitingRobots = M.empty
@@ -1310,6 +1318,7 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun))
       & internalActiveRobots .~ setOf (traverse . robotID) robotList'
       & discovery . availableCommands .~ Notifications 0 initialCommands
       & discovery . knownEntities .~ scenario ^. scenarioKnown
+      & discovery . structureRecognition .~ mkRecognizer (scenario ^. scenarioStructures)
       & robotNaming . gensym .~ initGensym
       & seed .~ theSeed
       & randGen .~ mkStdGen theSeed
diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs
index ec914efc4d..826e8a8dbd 100644
--- a/src/Swarm/Game/Step.hs
+++ b/src/Swarm/Game/Step.hs
@@ -79,6 +79,7 @@ import Swarm.Game.State
 import Swarm.Game.Step.Combustion qualified as Combustion
 import Swarm.Game.Step.Pathfinding
 import Swarm.Game.Step.Util
+import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
 import Swarm.Game.Value
 import Swarm.Game.World qualified as W
diff --git a/src/Swarm/Game/Step/Combustion.hs b/src/Swarm/Game/Step/Combustion.hs
index b66617cde0..446eb43dde 100644
--- a/src/Swarm/Game/Step/Combustion.hs
+++ b/src/Swarm/Game/Step/Combustion.hs
@@ -32,6 +32,7 @@ import Swarm.Game.Location
 import Swarm.Game.Robot
 import Swarm.Game.State
 import Swarm.Game.Step.Util
+import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
 import Swarm.Language.Context (empty)
 import Swarm.Language.Pipeline (ProcessedTerm)
diff --git a/src/Swarm/Game/Step/Pathfinding.hs b/src/Swarm/Game/Step/Pathfinding.hs
index 15f02f0ce3..650e4efb60 100644
--- a/src/Swarm/Game/Step/Pathfinding.hs
+++ b/src/Swarm/Game/Step/Pathfinding.hs
@@ -35,6 +35,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Location
 import Swarm.Game.State
 import Swarm.Game.Step.Util
+import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
 import Swarm.Language.Syntax
 import Swarm.Util (hoistMaybe)
diff --git a/src/Swarm/Game/Step/Util.hs b/src/Swarm/Game/Step/Util.hs
index e3d6831514..d6c6e852a7 100644
--- a/src/Swarm/Game/Step/Util.hs
+++ b/src/Swarm/Game/Step/Util.hs
@@ -13,13 +13,10 @@ import Control.Effect.Error
 import Control.Effect.Lens
 import Control.Effect.Lift
 import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
-import Control.Monad (forM, guard, join, when)
+import Control.Monad (guard, when)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import Data.Array (bounds, (!))
-import Data.IntMap qualified as IM
-import Data.List (find)
-import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as S
 import Data.Text (Text)
@@ -30,7 +27,9 @@ import Swarm.Game.Exception
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (NameGenerator (..))
 import Swarm.Game.Robot
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking qualified as SRT
 import Swarm.Game.State
+import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.Language.Capability
@@ -72,8 +71,9 @@ updateEntityAt cLoc@(Cosmic subworldName loc) upd = do
     fmap (fromMaybe False) $
       zoomWorld subworldName $
         W.updateM @Int (W.locToCoords loc) upd
-  when didChange $
+  when didChange $ do
     wakeWatchingRobots cLoc
+    SRT.entityModified cLoc
 
 -- * Capabilities
 
@@ -120,38 +120,6 @@ getNow = sendIO $ System.Clock.getTime System.Clock.Monotonic
 flagRedraw :: (Has (State GameState) sig m) => m ()
 flagRedraw = needsRedraw .= True
 
--- * World queries
-
-getNeighborLocs :: Cosmic Location -> [Cosmic Location]
-getNeighborLocs loc = map (offsetBy loc . flip applyTurn north . DRelative . DPlanar) listEnums
-
--- | Perform an action requiring a 'W.World' state component in a
---   larger context with a 'GameState'.
-zoomWorld ::
-  (Has (State GameState) sig m) =>
-  SubworldName ->
-  StateC (W.World Int Entity) Identity b ->
-  m (Maybe b)
-zoomWorld swName n = do
-  mw <- use $ landscape . multiWorld
-  forM (M.lookup swName mw) $ \w -> do
-    let (w', a) = run (runState w n)
-    landscape . multiWorld %= M.insert swName w'
-    return a
-
--- | Get the entity (if any) at a given location.
-entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
-entityAt (Cosmic subworldName loc) =
-  join <$> zoomWorld subworldName (W.lookupEntityM @Int (W.locToCoords loc))
-
--- | Get the robot with a given ID.
-robotWithID :: (Has (State GameState) sig m) => RID -> m (Maybe Robot)
-robotWithID rid = use (robotMap . at rid)
-
--- | Get the robot with a given name.
-robotWithName :: (Has (State GameState) sig m) => Text -> m (Maybe Robot)
-robotWithName rname = use (robotMap . to IM.elems . to (find $ \r -> r ^. robotName == rname))
-
 -- * Randomness
 
 -- | Generate a uniformly random number using the random generator in
diff --git a/src/Swarm/Game/Step/Util/Inspect.hs b/src/Swarm/Game/Step/Util/Inspect.hs
new file mode 100644
index 0000000000..1f1f8d430f
--- /dev/null
+++ b/src/Swarm/Game/Step/Util/Inspect.hs
@@ -0,0 +1,52 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Step.Util.Inspect where
+
+import Control.Carrier.State.Lazy
+import Control.Effect.Lens
+import Control.Lens hiding (from, use, (%=), (<.>))
+import Control.Monad (forM, join)
+import Data.IntMap qualified as IM
+import Data.List (find)
+import Data.Map qualified as M
+import Data.Text (Text)
+import Swarm.Game.Entity
+import Swarm.Game.Location
+import Swarm.Game.Robot
+import Swarm.Game.State
+import Swarm.Game.Universe
+import Swarm.Game.World qualified as W
+import Swarm.Language.Direction
+import Swarm.Util (listEnums)
+
+-- * World queries
+
+getNeighborLocs :: Cosmic Location -> [Cosmic Location]
+getNeighborLocs loc = map (offsetBy loc . flip applyTurn north . DRelative . DPlanar) listEnums
+
+-- | Perform an action requiring a 'W.World' state component in a
+--   larger context with a 'GameState'.
+zoomWorld ::
+  (Has (State GameState) sig m) =>
+  SubworldName ->
+  StateC (W.World Int Entity) Identity b ->
+  m (Maybe b)
+zoomWorld swName n = do
+  mw <- use $ landscape . multiWorld
+  forM (M.lookup swName mw) $ \w -> do
+    let (w', a) = run (runState w n)
+    landscape . multiWorld %= M.insert swName w'
+    return a
+
+-- | Get the robot with a given ID.
+robotWithID :: (Has (State GameState) sig m) => RID -> m (Maybe Robot)
+robotWithID rid = use (robotMap . at rid)
+
+-- | Get the robot with a given name.
+robotWithName :: (Has (State GameState) sig m) => Text -> m (Maybe Robot)
+robotWithName rname = use (robotMap . to IM.elems . to (find $ \r -> r ^. robotName == rname))
+
+-- | Get the entity (if any) at a given location.
+entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
+entityAt (Cosmic subworldName loc) =
+  join <$> zoomWorld subworldName (W.lookupEntityM @Int (W.locToCoords loc))
diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs
index bddb2b1ab1..85b27a115d 100644
--- a/src/Swarm/TUI/Controller.hs
+++ b/src/Swarm/TUI/Controller.hs
@@ -331,6 +331,7 @@ handleMainEvent ev = do
     FKey 5 | not (null (s ^. gameState . messageNotifications . notificationsContent)) -> do
       toggleModal MessagesModal
       gameState . messageInfo . lastSeenMessageTime .= s ^. gameState . temporal . ticks
+    FKey 6 -> toggleModal StructuresModal
     -- show goal
     ControlChar 'g' ->
       if hasAnythingToShow $ s ^. uiState . uiGoal . goalsContent
diff --git a/src/Swarm/TUI/Model/Menu.hs b/src/Swarm/TUI/Model/Menu.hs
index 254a6a6a46..ba70aae812 100644
--- a/src/Swarm/TUI/Model/Menu.hs
+++ b/src/Swarm/TUI/Model/Menu.hs
@@ -47,6 +47,7 @@ data ModalType
   | RecipesModal
   | CommandsModal
   | MessagesModal
+  | StructuresModal
   | EntityPaletteModal
   | TerrainPaletteModal
   | RobotsModal
diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs
index d415fda119..d366dc6c5a 100644
--- a/src/Swarm/TUI/View.hs
+++ b/src/Swarm/TUI/View.hs
@@ -93,6 +93,10 @@ import Swarm.Game.Scenario.Scoring.CodeSize
 import Swarm.Game.Scenario.Scoring.ConcreteMetrics
 import Swarm.Game.Scenario.Scoring.GenericMetrics
 import Swarm.Game.Scenario.Status
+import Swarm.Game.Scenario.Topography.Placement (StructureName (..))
+import Swarm.Game.Scenario.Topography.Structure qualified as Structure
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.ScenarioInfo (
   ScenarioItem (..),
   scenarioItemName,
@@ -617,6 +621,7 @@ drawModal s = \case
   RecipesModal -> availableListWidget (s ^. gameState) RecipeList
   CommandsModal -> commandsListWidget (s ^. gameState)
   MessagesModal -> availableListWidget (s ^. gameState) MessageList
+  StructuresModal -> structuresListWidget (s ^. gameState)
   ScenarioEndModal outcome ->
     padBottom (Pad 1) $
       vBox $
@@ -807,6 +812,7 @@ helpWidget theSeed mport =
     , ("F3", "Available recipes")
     , ("F4", "Available commands")
     , ("F5", "Messages")
+    , ("F6", "Structures")
     , ("Ctrl-g", "show goal")
     , ("Ctrl-p", "pause")
     , ("Ctrl-o", "single step")
@@ -844,6 +850,12 @@ mkAvailableList gs notifLens notifRender = map padRender news <> notifSep <> map
         ]
     | otherwise = []
 
+structuresListWidget :: GameState -> Widget Name
+structuresListWidget gs =
+  vBox $ map (padTopBottom 1 . structureWidget) defs
+ where
+  defs = gs ^. discovery . structureRecognition . automatons . definitions
+
 commandsListWidget :: GameState -> Widget Name
 commandsListWidget gs =
   hCenter $
@@ -952,6 +964,7 @@ drawModalMenu s = vLimit 1 . hBox $ map (padLeftRight 1 . drawKeyCmd) globalKeyC
       , notificationKey (discovery . availableRecipes) "F3" "Recipes"
       , notificationKey (discovery . availableCommands) "F4" "Commands"
       , notificationKey messageNotifications "F5" "Messages"
+      , Just (NoHighlight, "F6", "Structures")
       ]
 
 -- | Draw a menu explaining what key commands are available for the
@@ -1078,6 +1091,36 @@ drawKeyCmd (h, key, cmd) =
 -- World panel
 ------------------------------------------------------------
 
+structureWidget :: StructureInfo -> Widget n
+structureWidget s =
+  hLimit 30 $
+    vBox $
+      map
+        hCenter
+        [ txt theName
+        , padTop (Pad 1) $
+            hBox
+              [ stuctureIllustration
+              , padLeft (Pad 2) countLines
+              ]
+        ]
+ where
+  stuctureIllustration = vBox $ map (hBox . map g) cells
+  d = originalDefinition $ withGrid s
+
+  countLines = vBox . map showCount . M.toList $ entityCounts s
+
+  showCount (e, c) =
+    txt $
+      T.unwords
+        [ view entityName e <> ":"
+        , T.pack $ show c
+        ]
+
+  StructureName theName = Structure.name d
+  cells = getEntityGrid d
+  g = maybe (txt " ") (renderDisplay . view entityDisplay)
+
 worldWidget ::
   (Cosmic W.Coords -> Widget n) ->
   -- | view center
diff --git a/src/Swarm/TUI/View/Util.hs b/src/Swarm/TUI/View/Util.hs
index 3bf207f137..e3032b07f5 100644
--- a/src/Swarm/TUI/View/Util.hs
+++ b/src/Swarm/TUI/View/Util.hs
@@ -50,6 +50,7 @@ generateModal s mt = Modal mt (dialog (Just $ str title) buttons (maxModalWindow
       RecipesModal -> ("Available Recipes", Nothing, descriptionWidth)
       CommandsModal -> ("Available Commands", Nothing, descriptionWidth)
       MessagesModal -> ("Messages", Nothing, descriptionWidth)
+      StructuresModal -> ("Structures", Nothing, descriptionWidth)
       ScenarioEndModal WinModal ->
         let nextMsg = "Next challenge!"
             stopMsg = fromMaybe "Return to the menu" haltingMessage
diff --git a/src/Swarm/Web.hs b/src/Swarm/Web.hs
index c694dc659b..299f622d4a 100644
--- a/src/Swarm/Web.hs
+++ b/src/Swarm/Web.hs
@@ -63,6 +63,7 @@ import Swarm.Game.Robot
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Objective.Graph
 import Swarm.Game.Scenario.Objective.WinCheck
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.State
 import Swarm.Language.Module
 import Swarm.Language.Pipeline
@@ -90,6 +91,7 @@ type SwarmAPI =
     :<|> "goals" :> "graph" :> Get '[JSON] (Maybe GraphInfo)
     :<|> "goals" :> "uigoal" :> Get '[JSON] GoalTracking
     :<|> "goals" :> Get '[JSON] WinCondition
+    :<|> "recognize" :> Get '[JSON] [T.Text]
     :<|> "code" :> "render" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
     :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
     :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem]
@@ -138,6 +140,7 @@ mkApp state events =
     :<|> goalsGraphHandler state
     :<|> uiGoalHandler state
     :<|> goalsHandler state
+    :<|> recogLogHandler state
     :<|> codeRenderHandler
     :<|> codeRunHandler events
     :<|> replHandler state
@@ -183,6 +186,11 @@ goalsHandler appStateRef = do
   appState <- liftIO (readIORef appStateRef)
   return $ appState ^. gameState . winCondition
 
+recogLogHandler :: ReadableIORef AppState -> Handler [T.Text]
+recogLogHandler appStateRef = do
+  appState <- liftIO (readIORef appStateRef)
+  return $ appState ^. gameState . discovery . structureRecognition . recognitionLog
+
 codeRenderHandler :: Text -> Handler Text
 codeRenderHandler contents = do
   return $ case processTermEither contents of
diff --git a/src/Text/AhoCorasick.hs b/src/Text/AhoCorasick.hs
new file mode 100644
index 0000000000..84e01c8455
--- /dev/null
+++ b/src/Text/AhoCorasick.hs
@@ -0,0 +1,376 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- Module:      Text.AhoCorasick
+-- Copyright:   Sergey S Lymar (c) 2012
+-- License:     BSD3
+-- Maintainer:  Sergey S Lymar <sergey.lymar@gmail.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Aho-Corasick string matching algorithm
+
+-- | Aho-Corasick string matching algorithm
+--
+-- Simplest example:
+--
+-- @
+-- example1 = mapM_ print $ findAll simpleSM \"ushers\" where
+--     simpleSM = makeSimpleStateMachine [\"he\",\"she\",\"his\",\"hers\"]
+-- @
+--
+-- @
+-- Position {pIndex = 1, pLength = 3, pVal = \"she\"}
+-- Position {pIndex = 2, pLength = 2, pVal = \"he\"}
+-- Position {pIndex = 2, pLength = 4, pVal = \"hers\"}
+-- @
+--
+-- With data:
+--
+-- @
+-- example2 = mapM_ print $ findAll sm \"ushers\" where
+--     sm = makeStateMachine [(\"he\",0),(\"she\",1),(\"his\",2),(\"hers\",3)]
+-- @
+--
+-- @
+-- Position {pIndex = 1, pLength = 3, pVal = 1}
+-- Position {pIndex = 2, pLength = 2, pVal = 0}
+-- Position {pIndex = 2, pLength = 4, pVal = 3}
+-- @
+--
+-- Step-by-step state machine evaluation:
+--
+-- @
+-- example3 = mapM_ print $ next sm \"ushers\" where
+--     sm = makeSimpleStateMachine [\"he\",\"she\",\"his\",\"hers\"]
+--     next _ [] = []
+--     next sm (s:n) = let (SMStepRes match nextSM) = stateMachineStep sm s in
+--         (s, match) : next nextSM n
+-- @
+--
+-- @
+-- (\'u\',[])
+-- (\'s\',[])
+-- (\'h\',[])
+-- (\'e\',[(3,\"she\"),(2,\"he\")])
+-- (\'r\',[])
+-- (\'s\',[(4,\"hers\")])
+-- @
+module Text.AhoCorasick (
+  StateMachine,
+  makeStateMachine,
+  makeSimpleStateMachine,
+  findAll,
+  Position (..),
+  stateMachineStep,
+  KeyLength,
+  SMStepRes (..),
+  resetStateMachine,
+) where
+
+import Control.Monad.ST.Strict (ST, runST)
+import Control.Monad.State.Lazy (execStateT, get, put)
+import Control.Monad.Trans (lift)
+import Data.Array.IArray (Array, array, (!))
+import Data.HashMap.Strict qualified as M
+import Data.Hashable (Hashable)
+import Data.Maybe (fromJust)
+import Data.STRef (STRef, modifySTRef, newSTRef, readSTRef, writeSTRef)
+
+import Text.AhoCorasick.Internal.Deque (DQ, dqLength, mkDQ, popFront, pushBack)
+
+data (Eq keySymb, Hashable keySymb) => TNode keySymb s = TNode
+  { tnId :: Int
+  , tnLinks :: M.HashMap keySymb (STRef s (TNode keySymb s))
+  , tnFail :: Maybe (STRef s (TNode keySymb s))
+  , tnValuesIds :: [Int]
+  }
+
+type KeyLength = Int
+
+data (Eq keySymb, Hashable keySymb) => TTree keySymb val s = TTree
+  { ttRoot :: STRef s (TNode keySymb s)
+  , ttLastId :: STRef s Int
+  , ttValues :: DQ (KeyLength, val) s
+  }
+
+type NodeIndex = Int
+
+data (Eq keySymb, Hashable keySymb) => SMElem keySymb = SMElem
+  { smeLinks :: M.HashMap keySymb NodeIndex
+  , smeFail :: NodeIndex
+  , smeValuesIds :: [Int]
+  }
+
+data (Eq keySymb, Hashable keySymb) => StateMachine keySymb val = StateMachine
+  { smStates :: Array NodeIndex (SMElem keySymb)
+  , smValues :: Array Int (KeyLength, val)
+  , smState :: Int
+  }
+
+data (Eq keySymb, Hashable keySymb) => SMStepRes keySymb val = SMStepRes
+  { smsrMatch :: [(KeyLength, val)]
+  , smsrNextSM :: StateMachine keySymb val
+  }
+
+data Position val = Position
+  { pIndex :: Int
+  , pLength :: Int
+  , pVal :: val
+  }
+
+instance
+  (Eq keySymb, Hashable keySymb, Show keySymb) =>
+  Show (SMElem keySymb)
+  where
+  show (SMElem l f v) =
+    concat
+      [ "SMElem {smeLinks = "
+      , show l
+      , ", smeFail = "
+      , show f
+      , ", smeValuesIds = "
+      , show v
+      , "}"
+      ]
+
+instance
+  (Eq keySymb, Hashable keySymb, Show keySymb, Show val) =>
+  Show (StateMachine keySymb val)
+  where
+  show (StateMachine st vals state) =
+    concat
+      [ "StateMachine {smStates = "
+      , show st
+      , ", smValues = "
+      , show vals
+      , ", smState = "
+      , show state
+      , "}"
+      ]
+
+instance
+  (Eq keySymb, Hashable keySymb, Show keySymb, Show val) =>
+  Show (SMStepRes keySymb val)
+  where
+  show (SMStepRes f n) =
+    concat
+      [ "StateMachineStepRes {smsrFound = "
+      , show f
+      , ", smsrNewSM = "
+      , show n
+      , "}"
+      ]
+
+instance (Show val) => Show (Position val) where
+  show (Position i l v) =
+    concat
+      [ "Position {pIndex = "
+      , show i
+      , ", pLength = "
+      , show l
+      , ", pVal = "
+      , show v
+      , "}"
+      ]
+
+(~>) :: t1 -> (t1 -> t2) -> t2
+x ~> f = f x
+infixl 9 ~>
+
+rootNodeId :: Int
+rootNodeId = 0
+
+initNewTTree :: (Eq keySymb, Hashable keySymb) => ST s (TTree keySymb a s)
+initNewTTree = do
+  root <- newSTRef $ TNode rootNodeId M.empty Nothing []
+  lid <- newSTRef rootNodeId
+  TTree root lid <$> mkDQ
+
+mkNewTNode ::
+  (Eq keySymb, Hashable keySymb) =>
+  TTree keySymb a s ->
+  ST s (TNode keySymb s)
+mkNewTNode tree = do
+  modifySTRef lid (+ 1)
+  lv <- readSTRef lid
+  return $ TNode lv M.empty Nothing []
+ where
+  lid = ttLastId tree
+
+addKeyVal ::
+  forall val s keySymb.
+  (Eq keySymb, Hashable keySymb) =>
+  TTree keySymb val s ->
+  [keySymb] ->
+  val ->
+  ST s ()
+addKeyVal tree key val = addSymb (ttRoot tree) key
+ where
+  addSymb :: STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
+  addSymb node [] = do
+    vi <- dqLength (ttValues tree)
+    pushBack (ttValues tree) (length key, val)
+    modifySTRef node (\r -> r {tnValuesIds = [vi]})
+  addSymb node (c : nc) = do
+    n <- readSTRef node
+    let nlnks = tnLinks n
+    case M.lookup c nlnks of
+      Just tn -> addSymb tn nc
+      Nothing -> do
+        nnd <- mkNewTNode tree
+        refNewN <- newSTRef nnd
+        writeSTRef node (n {tnLinks = M.insert c refNewN nlnks})
+        addSymb refNewN nc
+
+findFailures :: (Eq keySymb, Hashable keySymb) => TTree keySymb val s -> ST s ()
+findFailures tree = do
+  modifySTRef root (\n -> n {tnFail = Just root})
+  dq <- mkDQ
+  pushBack dq root
+  procAll dq
+ where
+  root = ttRoot tree
+  procAll dq = do
+    n <- popFront dq
+    case n of
+      Nothing -> return ()
+      Just node -> do
+        procNode dq node
+        procAll dq
+  procNode dq nodeRef = do
+    node <- readSTRef nodeRef
+    mapM_
+      ( \(symb, link) -> do
+          pushBack dq link
+          fRef <- findParentFail link (tnFail node) symb
+          f <- readSTRef fRef
+          modifySTRef
+            link
+            ( \n ->
+                n
+                  { tnFail = Just fRef
+                  , tnValuesIds = tnValuesIds n ++ tnValuesIds f
+                  }
+            )
+      )
+      $ tnLinks node ~> M.toList
+
+  findParentFail _ Nothing _ = error "Impossible; cfRef  must not be Nothing"
+  findParentFail link (Just cfRef) symb = do
+    cf <- readSTRef cfRef
+    case (M.lookup symb (tnLinks cf), cfRef == root) of
+      (Just nl, _) ->
+        if nl == link
+          then return root
+          else return nl
+      (Nothing, True) -> return root
+      _ -> findParentFail link (tnFail cf) symb
+
+convertToStateMachine ::
+  forall val s keySymb.
+  (Eq keySymb, Hashable keySymb) =>
+  TTree keySymb val s ->
+  ST s (StateMachine keySymb val)
+convertToStateMachine tree = do
+  size <- readSTRef $ ttLastId tree
+  nds <- execStateT (convertNode $ ttRoot tree) []
+
+  vlsSize <- dqLength $ ttValues tree
+  vls <-
+    mapM
+      ( \i -> do
+          k <- popFront (ttValues tree)
+          return (i, fromJust k)
+      )
+      [0 .. (vlsSize - 1)]
+
+  StateMachine (array (0, size) nds) (array (0, vlsSize - 1) vls) rootNodeId
+    ~> return
+ where
+  convertNode node = do
+    (n, l, fail2) <- lift $ do
+      n <- readSTRef node
+      l <- tnLinks n ~> convertLinks
+      fail1 <- tnFail n ~> fromJust ~> readSTRef >>= return . tnId
+      return (n, l, fail1)
+    v <- get
+    put $ (tnId n, SMElem l fail2 (tnValuesIds n)) : v
+    M.toList (tnLinks n) ~> map snd ~> mapM_ convertNode
+
+  convertLinks ::
+    M.HashMap keySymb (STRef s (TNode keySymb s)) ->
+    ST s (M.HashMap keySymb Int)
+  convertLinks lnksMap = do
+    nl <-
+      mapM
+        ( \(symb, link) -> do
+            l <- readSTRef link
+            return (symb, tnId l)
+        )
+        $ M.toList lnksMap
+    return $ M.fromList nl
+
+resetStateMachine ::
+  (Eq keySymb, Hashable keySymb) =>
+  StateMachine keySymb val ->
+  StateMachine keySymb val
+resetStateMachine m = m {smState = rootNodeId}
+
+stateMachineStep ::
+  (Eq keySymb, Hashable keySymb) =>
+  StateMachine keySymb val ->
+  keySymb ->
+  SMStepRes keySymb val
+stateMachineStep sm symb =
+  case (M.lookup symb links, currentState == rootNodeId) of
+    (Just nextState, _) ->
+      SMStepRes
+        (smStates sm ! nextState ~> smeValuesIds ~> convertToVals)
+        (sm {smState = nextState})
+    (Nothing, True) -> SMStepRes [] sm
+    (Nothing, False) ->
+      stateMachineStep
+        (sm {smState = smeFail currentNode})
+        symb
+ where
+  currentState = smState sm
+  currentNode = smStates sm ! currentState
+  links = smeLinks currentNode
+  convertToVals = map (\i -> smValues sm ! i)
+
+findAll ::
+  (Eq keySymb, Hashable keySymb) =>
+  StateMachine keySymb val ->
+  [keySymb] ->
+  [Position val]
+findAll sm str =
+  step (resetStateMachine sm) (zip [0 ..] str) ~> concat
+ where
+  step _ [] = []
+  step csm ((idx, symb) : next) = case stateMachineStep csm symb of
+    SMStepRes [] newsm -> step newsm next
+    SMStepRes r newsm -> map (cnvToPos idx) r : step newsm next
+  cnvToPos idx (keyLength, val) = Position (idx - keyLength + 1) keyLength val
+
+makeSimpleStateMachine ::
+  (Eq keySymb, Hashable keySymb) =>
+  [[keySymb]] ->
+  StateMachine keySymb [keySymb]
+makeSimpleStateMachine keys = runST $ do
+  tree <- initNewTTree
+  mapM_ (\s -> addKeyVal tree s s) keys
+  findFailures tree
+  convertToStateMachine tree
+
+makeStateMachine ::
+  (Eq keySymb, Hashable keySymb) =>
+  [([keySymb], val)] ->
+  StateMachine keySymb val
+makeStateMachine kv = runST $ do
+  tree <- initNewTTree
+  mapM_ (uncurry (addKeyVal tree)) kv
+  findFailures tree
+  convertToStateMachine tree
diff --git a/src/Text/AhoCorasick/Internal/Deque.hs b/src/Text/AhoCorasick/Internal/Deque.hs
new file mode 100644
index 0000000000..d125f85554
--- /dev/null
+++ b/src/Text/AhoCorasick/Internal/Deque.hs
@@ -0,0 +1,58 @@
+-- Simple FIFO queue in ST monad
+module Text.AhoCorasick.Internal.Deque (
+  mkDQ,
+  pushBack,
+  popFront,
+  dqLength,
+  DQ,
+) where
+
+import Control.Monad.ST.Strict
+import Data.STRef
+
+data DQNode a s = DQNode
+  { dqnData :: a
+  , dqnNext :: Maybe (STRef s (DQNode a s))
+  }
+
+type DQ a s =
+  STRef
+    s
+    ( Maybe
+        ( STRef s (DQNode a s)
+        , STRef s (DQNode a s)
+        )
+    , Int
+    )
+
+mkDQ :: ST s (DQ a s)
+mkDQ = newSTRef (Nothing, 0)
+
+pushBack :: DQ a s -> a -> ST s ()
+pushBack dq dt = do
+  dqr <- readSTRef dq
+  case dqr of
+    (Nothing, _) -> do
+      nn <- newSTRef $ DQNode dt Nothing
+      writeSTRef dq (Just (nn, nn), 1)
+    (Just (f, l), lng) -> do
+      nn <- newSTRef $ DQNode dt Nothing
+      modifySTRef l (\v -> v {dqnNext = Just nn})
+      writeSTRef dq $ (Just (f, nn), lng + 1)
+
+popFront :: DQ a s -> ST s (Maybe a)
+popFront dq = do
+  dqr <- readSTRef dq
+  case dqr of
+    (Nothing, _) -> return Nothing
+    (Just (f, l), lng) -> do
+      fd <- readSTRef f
+      case dqnNext fd of
+        Nothing -> writeSTRef dq (Nothing, 0)
+        Just k -> writeSTRef dq $ (Just (k, l), lng - 1)
+      return $ Just $ dqnData fd
+
+dqLength :: DQ a s -> ST s Int
+dqLength dq = do
+  (_, l) <- readSTRef dq
+  return l
diff --git a/swarm.cabal b/swarm.cabal
index c4415e447c..fc94f7fe81 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -99,6 +99,8 @@ library
     import:           stan-config, common, ghc2021-extensions
     exposed-modules:  Control.Carrier.Accum.FixedStrict
                       Data.BoolExpr.Simplify
+                      Text.AhoCorasick
+                      Text.AhoCorasick.Internal.Deque
                       Swarm.App
                       Swarm.Constant
                       Swarm.Doc.Gen
@@ -142,6 +144,9 @@ library
                       Swarm.Game.Scenario.Topography.Navigation.Waypoint
                       Swarm.Game.Scenario.Topography.Placement
                       Swarm.Game.Scenario.Topography.Structure
+                      Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+                      Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking
+                      Swarm.Game.Scenario.Topography.Structure.Recognition.Type
                       Swarm.Game.Scenario.Topography.WorldDescription
                       Swarm.Game.Scenario.Topography.WorldPalette
                       Swarm.Game.ScenarioInfo
@@ -150,6 +155,7 @@ library
                       Swarm.Game.Step.Combustion
                       Swarm.Game.Step.Pathfinding
                       Swarm.Game.Step.Util
+                      Swarm.Game.Step.Util.Inspect
                       Swarm.Game.Terrain
                       Swarm.Game.Value
                       Swarm.Game.World
@@ -248,6 +254,7 @@ library
                       either                        >= 5.0 && < 5.1,
                       extra                         >= 1.7 && < 1.8,
                       filepath                      >= 1.4 && < 1.5,
+                      fingertree                    >= 0.1.5 && < 0.1.6,
                       fused-effects                 >= 1.1.1.1 && < 1.2,
                       fused-effects-lens            >= 1.2.0.1 && < 1.3,
                       fuzzy                         >= 0.1 && < 0.2,
@@ -330,6 +337,7 @@ test-suite swarm-unit
                       TestLanguagePipeline
                       TestPretty
                       TestBoolExpr
+                      TestAhoCorasick
                       TestCommand
                       TestLSP
                       TestScoring
diff --git a/test/unit/Main.hs b/test/unit/Main.hs
index 15c4c04c1d..d84fc99efd 100644
--- a/test/unit/Main.hs
+++ b/test/unit/Main.hs
@@ -26,6 +26,7 @@ import Test.Tasty.QuickCheck (
   testProperty,
   (==>),
  )
+import TestAhoCorasick (testAhoCorasick)
 import TestBoolExpr (testBoolExpr)
 import TestCommand (testCommands)
 import TestEval (testEval)
@@ -52,6 +53,7 @@ tests s =
     "Tests"
     [ testLanguagePipeline
     , testPrettyConst
+    , testAhoCorasick
     , testBoolExpr
     , testCommands
     , testHighScores
diff --git a/test/unit/TestAhoCorasick.hs b/test/unit/TestAhoCorasick.hs
new file mode 100644
index 0000000000..0b2ec389de
--- /dev/null
+++ b/test/unit/TestAhoCorasick.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- AhoCrosick unit tests
+module TestAhoCorasick where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit
+
+import Text.AhoCorasick
+
+testAhoCorasick :: TestTree
+testAhoCorasick =
+  testGroup
+    "AhoCorasick"
+    [ testCase "Simplest example" $
+        assertEqual
+          "Found strings not equal!"
+          ["she", "he", "hers"]
+          example1
+    , testCase "With data" $
+        assertEqual
+          "Found strings not equal!"
+          [1, 0, 3]
+          example2
+    , testCase "Step-by-step state machine evaluation" $
+        assertEqual
+          "Steps were not equal!"
+          [ ('u', [])
+          , ('s', [])
+          , ('h', [])
+          , ('e', [(3, "she"), (2, "he")])
+          , ('r', [])
+          , ('s', [(4, "hers")])
+          ]
+          example3
+    ]
+
+example1 :: [String]
+example1 = map pVal $ findAll simpleSM "ushers"
+ where
+  simpleSM = makeSimpleStateMachine ["he", "she", "his", "hers"]
+
+example2 :: [Int]
+example2 = map pVal $ findAll sm "ushers"
+ where
+  sm = makeStateMachine [("he", 0), ("she", 1), ("his", 2), ("hers", 3)]
+
+example3 :: [(Char, [(Int, String)])]
+example3 = next sm "ushers"
+ where
+  sm = makeSimpleStateMachine ["he", "she", "his", "hers"]
+  next _ [] = []
+  next sm1 (s : n) =
+    let (SMStepRes match nextSM) = stateMachineStep sm1 s
+     in (s, match) : next nextSM n