diff --git a/plutus-core/changelog.d/20260421_120000_zeme_has_ann_typeclass.md b/plutus-core/changelog.d/20260421_120000_zeme_has_ann_typeclass.md
new file mode 100644
index 00000000000..70b40a95234
--- /dev/null
+++ b/plutus-core/changelog.d/20260421_120000_zeme_has_ann_typeclass.md
@@ -0,0 +1,5 @@
+### Fixed
+
+- Fixed `SrcSpan` annotations on inner `Apply`/`TyInst` nodes from the PLC, PIR, and
+  UPLC parsers. Parser error messages and tooling that reads annotations off parsed
+  terms will now point to the specific argument involved.
diff --git a/plutus-core/plutus-core/src/PlutusCore.hs b/plutus-core/plutus-core/src/PlutusCore.hs
index 73a72f6a1f9..a1a0ddf5677 100644
--- a/plutus-core/plutus-core/src/PlutusCore.hs
+++ b/plutus-core/plutus-core/src/PlutusCore.hs
@@ -65,8 +65,7 @@ module PlutusCore
   , UniqueSet (..)
   , Normalized (..)
   , latestVersion
-  , termAnn
-  , typeAnn
+  , HasAnn (..)
   , tyVarDeclAnn
   , tyVarDeclName
   , tyVarDeclKind
@@ -161,6 +160,6 @@ applyProgram
   -> m (Program tyname name uni fun a)
 applyProgram (Program a1 v1 t1) (Program a2 v2 t2)
   | v1 == v2 =
-      pure $ Program (a1 <> a2) v1 (Apply (termAnn t1 <> termAnn t2) t1 t2)
+      pure $ Program (a1 <> a2) v1 (Apply (getAnn t1 <> getAnn t2) t1 t2)
 applyProgram (Program _a1 v1 _t1) (Program _a2 v2 _t2) =
   throwError $ MkApplyProgramError v1 v2
diff --git a/plutus-core/plutus-core/src/PlutusCore/Check/Normal.hs b/plutus-core/plutus-core/src/PlutusCore/Check/Normal.hs
index 1efffbf6fb5..cd3fccd19f6 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Check/Normal.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Check/Normal.hs
@@ -67,7 +67,7 @@ neutralType
 neutralType TyVar {} = pure ()
 neutralType (TyBuiltin ann someUni) = neutralUni ann someUni
 neutralType (TyApp _ ty1 ty2) = neutralType ty1 >> normalType ty2
-neutralType ty = Left (BadType (typeAnn ty) ty "neutral type")
+neutralType ty = Left (BadType (getAnn ty) ty "neutral type")
 
 -- See Note [Normalization of built-in types].
 neutralUni
diff --git a/plutus-core/plutus-core/src/PlutusCore/Check/Value.hs b/plutus-core/plutus-core/src/PlutusCore/Check/Value.hs
index c415d096295..7533dbbd2a7 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Check/Value.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Check/Value.hs
@@ -17,4 +17,4 @@ termValue (IWrap _ _ _ term) = termValue term
 termValue LamAbs {} = pure ()
 termValue TyAbs {} = pure ()
 termValue Constant {} = pure ()
-termValue t = Left $ BadTerm (termAnn t) t "term value"
+termValue t = Left $ BadTerm (getAnn t) t "term value"
diff --git a/plutus-core/plutus-core/src/PlutusCore/Core/Type.hs b/plutus-core/plutus-core/src/PlutusCore/Core/Type.hs
index 2d2bdff272b..e4845d3b5a5 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Core/Type.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Core/Type.hs
@@ -38,9 +38,8 @@ module PlutusCore.Core.Type
   , Binder (..)
   , module Export
 
-    -- * Helper functions
-  , termAnn
-  , typeAnn
+    -- * Annotations
+  , HasAnn (..)
   , mapFun
   , tyVarDeclAnn
   , tyVarDeclName
@@ -263,29 +262,49 @@ type instance
   HasUniques (Program tyname name uni fun ann) =
     HasUniques (Term tyname name uni fun ann)
 
-typeAnn :: Type tyname uni ann -> ann
-typeAnn (TyVar ann _) = ann
-typeAnn (TyFun ann _ _) = ann
-typeAnn (TyIFix ann _ _) = ann
-typeAnn (TyForall ann _ _ _) = ann
-typeAnn (TyBuiltin ann _) = ann
-typeAnn (TyLam ann _ _ _) = ann
-typeAnn (TyApp ann _ _) = ann
-typeAnn (TySOP ann _) = ann
-
-termAnn :: Term tyname name uni fun ann -> ann
-termAnn (Var ann _) = ann
-termAnn (TyAbs ann _ _ _) = ann
-termAnn (Apply ann _ _) = ann
-termAnn (Constant ann _) = ann
-termAnn (Builtin ann _) = ann
-termAnn (TyInst ann _ _) = ann
-termAnn (Unwrap ann _) = ann
-termAnn (IWrap ann _ _ _) = ann
-termAnn (Error ann _) = ann
-termAnn (LamAbs ann _ _ _) = ann
-termAnn (Constr ann _ _ _) = ann
-termAnn (Case ann _ _ _) = ann
+instance HasAnn (Type tyname uni) where
+  getAnn (TyVar ann _)        = ann
+  getAnn (TyFun ann _ _)      = ann
+  getAnn (TyIFix ann _ _)     = ann
+  getAnn (TyForall ann _ _ _) = ann
+  getAnn (TyBuiltin ann _)    = ann
+  getAnn (TyLam ann _ _ _)    = ann
+  getAnn (TyApp ann _ _)      = ann
+  getAnn (TySOP ann _)        = ann
+  modifyAnn f (TyVar ann x)        = TyVar (f ann) x
+  modifyAnn f (TyFun ann a b)      = TyFun (f ann) a b
+  modifyAnn f (TyIFix ann a b)     = TyIFix (f ann) a b
+  modifyAnn f (TyForall ann tn k t) = TyForall (f ann) tn k t
+  modifyAnn f (TyBuiltin ann b)    = TyBuiltin (f ann) b
+  modifyAnn f (TyLam ann tn k t)   = TyLam (f ann) tn k t
+  modifyAnn f (TyApp ann a b)      = TyApp (f ann) a b
+  modifyAnn f (TySOP ann tss)      = TySOP (f ann) tss
+
+instance HasAnn (Term tyname name uni fun) where
+  getAnn (Var ann _)           = ann
+  getAnn (LamAbs ann _ _ _)   = ann
+  getAnn (Apply ann _ _)      = ann
+  getAnn (TyAbs ann _ _ _)    = ann
+  getAnn (TyInst ann _ _)     = ann
+  getAnn (IWrap ann _ _ _)    = ann
+  getAnn (Unwrap ann _)       = ann
+  getAnn (Constr ann _ _ _)   = ann
+  getAnn (Case ann _ _ _)     = ann
+  getAnn (Constant ann _)     = ann
+  getAnn (Builtin ann _)      = ann
+  getAnn (Error ann _)        = ann
+  modifyAnn f (Var ann x)           = Var (f ann) x
+  modifyAnn f (LamAbs ann n ty t)   = LamAbs (f ann) n ty t
+  modifyAnn f (Apply ann t1 t2)     = Apply (f ann) t1 t2
+  modifyAnn f (TyAbs ann tn k t)    = TyAbs (f ann) tn k t
+  modifyAnn f (TyInst ann t ty)     = TyInst (f ann) t ty
+  modifyAnn f (IWrap ann ty1 ty2 t) = IWrap (f ann) ty1 ty2 t
+  modifyAnn f (Unwrap ann t)        = Unwrap (f ann) t
+  modifyAnn f (Constr ann ty i ts)  = Constr (f ann) ty i ts
+  modifyAnn f (Case ann ty t ts)    = Case (f ann) ty t ts
+  modifyAnn f (Constant ann c)      = Constant (f ann) c
+  modifyAnn f (Builtin ann b)       = Builtin (f ann) b
+  modifyAnn f (Error ann ty)        = Error (f ann) ty
 
 -- | Map a function over the set of built-in functions.
 mapFun :: (fun -> fun') -> Term tyname name uni fun ann -> Term tyname name uni fun' ann
diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser.hs b/plutus-core/plutus-core/src/PlutusCore/Parser.hs
index 0661152360f..780c0e0d662 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Parser.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Parser.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
 
 -- | Parsers for PLC terms in DefaultUni.
 module PlutusCore.Parser
@@ -13,7 +12,7 @@ module PlutusCore.Parser
   ) where
 
 import PlutusCore.Annotation
-import PlutusCore.Core (Program (..), Term (..), Type)
+import PlutusCore.Core (HasAnn (..), Program (..), Term (..), Type)
 import PlutusCore.Default
 import PlutusCore.Error (ParserError (..), ParserErrorBundle)
 import PlutusCore.MkPlc (mkIterApp, mkIterInst)
@@ -24,6 +23,7 @@ import PlutusCore.Parser.Type as Export
 import PlutusCore.Quote (MonadQuote)
 import PlutusCore.Version
 
+import Control.Arrow ((&&&))
 import Control.Monad (when)
 import Control.Monad.Except (MonadError)
 import Data.Text (Text)
@@ -49,8 +49,9 @@ lamTerm = withSpan $ \sp ->
 
 appTerm :: Parser PTerm
 appTerm = withSpan $ \sp ->
-  -- TODO: should not use the same `sp` for all arguments.
-  inBrackets $ mkIterApp <$> term <*> (fmap (sp,) <$> some term)
+    inBrackets $
+      setAnn sp <$>
+        (mkIterApp <$> term <*> (fmap (getAnn &&& id) <$> some term))
 
 conTerm :: Parser PTerm
 conTerm = withSpan $ \sp ->
@@ -62,8 +63,9 @@ builtinTerm = withSpan $ \sp ->
 
 tyInstTerm :: Parser PTerm
 tyInstTerm = withSpan $ \sp ->
-  -- TODO: should not use the same `sp` for all arguments.
-  inBraces $ mkIterInst <$> term <*> (fmap (sp,) <$> many pType)
+    inBraces $
+      setAnn sp <$>
+        (mkIterInst <$> term <*> (fmap (getAnn &&& id) <$> many pType))
 
 unwrapTerm :: Parser PTerm
 unwrapTerm = withSpan $ \sp ->
diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs
index cfd039561f8..555518dbec3 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs
@@ -1,7 +1,6 @@
 -- editorconfig-checker-disable-file
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module PlutusCore.Parser.Type where
@@ -65,8 +64,7 @@ appType :: Parser PType
 appType = withSpan $ \sp -> inBrackets $ do
   fn <- pType
   args <- some pType
-  -- TODO: should not use the same `sp` for all arguments.
-  pure $ mkIterTyApp fn ((sp,) <$> args)
+  pure . setAnn sp $ mkIterTyApp fn (map (getAnn &&& id) args)
 
 kind :: Parser (Kind SrcSpan)
 kind = withSpan $ \sp ->
diff --git a/plutus-core/plutus-core/test/Parser/Spec.hs b/plutus-core/plutus-core/test/Parser/Spec.hs
index 4db81aec211..5b4e301c079 100644
--- a/plutus-core/plutus-core/test/Parser/Spec.hs
+++ b/plutus-core/plutus-core/test/Parser/Spec.hs
@@ -28,7 +28,7 @@ propTermSrcSpan = property $ do
   trailingSpaces <- forAll $ Gen.text (Range.linear 0 10) (Gen.element [' ', '\n'])
   case runQuoteT . parseTerm $ code <> trailingSpaces of
     Right parsed ->
-      let sp = termAnn parsed
+      let sp = getAnn parsed
        in (srcSpanELine sp, srcSpanECol sp) === (endingLine, endingCol + 1)
     Left err -> annotate (display err) >> failure
 
@@ -92,4 +92,32 @@ tests =
     , testCase
         "parser of Value should succeed"
         parseValueValid
+    , testCase
+        "multi-arg application has per-argument spans on inner nodes"
+        multiArgSpans
     ]
+
+-- | Test that inner Apply nodes get per-argument spans, not the bracket span.
+-- For @[ (con integer 1) (con integer 2) (con integer 3) ]@, the outer Apply
+-- should have the bracket span, but the inner Apply should have the span of
+-- its argument @(con integer 2)@, NOT the bracket span.
+multiArgSpans :: Assertion
+multiArgSpans = do
+  let code = "[ (con integer 1) (con integer 2) (con integer 3) ]"
+  case runQuoteT (parseTerm code) of
+    Left err -> assertFailure $ "parse failed: " <> show err
+    Right parsed ->
+      case parsed of
+        Apply outerAnn (Apply innerAnn _ _) _ -> do
+          -- outer should have the bracket span (col 1 to col 52)
+          assertBool "outer span should start at col 1"
+            (srcSpanSCol outerAnn == 1)
+          -- inner should NOT have the same span as outer
+          assertBool
+            ("inner Apply should have a different span than outer, but both are: " <> show outerAnn)
+            (outerAnn /= innerAnn)
+          -- inner span should start after col 1 (it's the span of the 2nd arg)
+          assertBool
+            ("inner Apply span should not start at col 1, got: " <> show innerAnn)
+            (srcSpanSCol innerAnn /= 1)
+        other -> assertFailure $ "expected nested Apply, got: " <> show other
diff --git a/plutus-core/plutus-ir/src/PlutusIR.hs b/plutus-core/plutus-ir/src/PlutusIR.hs
index 81e2e8b821a..edaa4dac820 100644
--- a/plutus-core/plutus-ir/src/PlutusIR.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR.hs
@@ -1,14 +1,13 @@
 module PlutusIR
   ( -- * AST
-    Term (..)
+    HasAnn (..)
+  , Term (..)
   , progAnn
   , progVer
   , progTerm
   , termSubterms
   , termSubtypes
   , termBindings
-  , termAnn
-  , bindingAnn
   , Type (..)
   , typeSubtypes
   , Datatype (..)
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Recursion.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Recursion.hs
index a68da2441b0..a9505e125db 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Recursion.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Recursion.hs
@@ -91,7 +91,7 @@ mkFixpoint bs = do
     case PIR.mkFunctionDef p name ty term of
       Just fun -> pure fun
       Nothing ->
-        lift $ throwError $ CompilationError (PLC.typeAnn ty) "Recursive values must be of function type"
+        lift $ throwError $ CompilationError (PLC.getAnn ty) "Recursive values must be of function type"
 
   inlineFix <- view (ccOpts . coInlineConstants)
 
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs b/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs
index 19fed02883c..f4175e3a9b2 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs
@@ -7,7 +7,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module PlutusIR.Core.Type
-  ( TyName (..)
+  ( HasAnn (..)
+  , TyName (..)
   , Name (..)
   , VarDecl (..)
   , TyVarDecl (..)
@@ -24,8 +25,6 @@ module PlutusIR.Core.Type
   , Program (..)
   , Version (..)
   , applyProgram
-  , termAnn
-  , bindingAnn
   , progAnn
   , progVer
   , progTerm
@@ -227,28 +226,46 @@ applyProgram
   -> m (Program tyname name uni fun a)
 applyProgram (Program a1 v1 t1) (Program a2 v2 t2)
   | v1 == v2 =
-      pure $ Program (a1 <> a2) v1 (Apply (termAnn t1 <> termAnn t2) t1 t2)
+      pure $ Program (a1 <> a2) v1 (Apply (getAnn t1 <> getAnn t2) t1 t2)
 applyProgram (Program _a1 v1 _t1) (Program _a2 v2 _t2) =
   throwError $ MkApplyProgramError v1 v2
 
-termAnn :: Term tyname name uni fun a -> a
-termAnn = \case
-  Let a _ _ _ -> a
-  Var a _ -> a
-  TyAbs a _ _ _ -> a
-  LamAbs a _ _ _ -> a
-  Apply a _ _ -> a
-  Constant a _ -> a
-  Builtin a _ -> a
-  TyInst a _ _ -> a
-  Error a _ -> a
-  IWrap a _ _ _ -> a
-  Unwrap a _ -> a
-  Constr a _ _ _ -> a
-  Case a _ _ _ -> a
-
-bindingAnn :: Binding tyname name uni fun a -> a
-bindingAnn = \case
-  TermBind a _ _ _ -> a
-  TypeBind a _ _ -> a
-  DatatypeBind a _ -> a
+instance HasAnn (Term tyname name uni fun) where
+  getAnn = \case
+    Let a _ _ _   -> a
+    Var a _       -> a
+    TyAbs a _ _ _ -> a
+    LamAbs a _ _ _ -> a
+    Apply a _ _   -> a
+    Constant a _  -> a
+    Builtin a _   -> a
+    TyInst a _ _  -> a
+    Error a _     -> a
+    IWrap a _ _ _ -> a
+    Unwrap a _    -> a
+    Constr a _ _ _ -> a
+    Case a _ _ _  -> a
+  modifyAnn f = \case
+    Let a r bs t      -> Let (f a) r bs t
+    Var a x           -> Var (f a) x
+    TyAbs a tn k t    -> TyAbs (f a) tn k t
+    LamAbs a n ty t   -> LamAbs (f a) n ty t
+    Apply a t1 t2     -> Apply (f a) t1 t2
+    Constant a c      -> Constant (f a) c
+    Builtin a b       -> Builtin (f a) b
+    TyInst a t ty     -> TyInst (f a) t ty
+    Error a ty        -> Error (f a) ty
+    IWrap a ty1 ty2 t -> IWrap (f a) ty1 ty2 t
+    Unwrap a t        -> Unwrap (f a) t
+    Constr a ty i ts  -> Constr (f a) ty i ts
+    Case a ty t ts    -> Case (f a) ty t ts
+
+instance HasAnn (Binding tyname name uni fun) where
+  getAnn = \case
+    TermBind a _ _ _  -> a
+    TypeBind a _ _    -> a
+    DatatypeBind a _  -> a
+  modifyAnn f = \case
+    TermBind a s d t  -> TermBind (f a) s d t
+    TypeBind a d t    -> TypeBind (f a) d t
+    DatatypeBind a d  -> DatatypeBind (f a) d
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Parser.hs b/plutus-core/plutus-ir/src/PlutusIR/Parser.hs
index c9f5d1bc901..a0272b76a86 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/Parser.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/Parser.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
 
 -- | Parsers for PIR terms in DefaultUni.
 module PlutusIR.Parser
@@ -128,13 +127,15 @@ letTerm = withSpan $ \sp ->
 
 appTerm :: Parametric
 appTerm tm = withSpan $ \sp ->
-  -- TODO: should not use the same `sp` for all arguments.
-  inBrackets $ PIR.mkIterApp <$> tm <*> (fmap (sp,) <$> some tm)
+    inBrackets $
+      setAnn sp <$>
+        (PIR.mkIterApp <$> tm <*> (fmap (getAnn &&& id) <$> some tm))
 
 tyInstTerm :: Parametric
 tyInstTerm tm = withSpan $ \sp ->
-  -- TODO: should not use the same `sp` for all arguments.
-  inBraces $ PIR.mkIterInst <$> tm <*> (fmap (sp,) <$> some pType)
+    inBraces $
+      setAnn sp <$>
+        (PIR.mkIterInst <$> tm <*> (fmap (getAnn &&& id) <$> some pType))
 
 pTerm :: Parser PTerm
 pTerm = leadingWhitespace go
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Beta.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/Beta.hs
index 8e922f8c41e..b9741477ef5 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/Transform/Beta.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/Beta.hs
@@ -127,11 +127,11 @@ beta = over termSubterms beta . localTransform
     localTransform = \case
       -- See Note [Multi-beta]
       -- This maybe isn't the best annotation for this term, but it will do.
-      (extractBindings -> Just (bs, t)) -> Let (termAnn t) NonRec bs t
+      (extractBindings -> Just (bs, t)) -> Let (getAnn t) NonRec bs t
       -- See Note [Multi-beta] for why we don't perform multi-beta on `TyInst`.
       TyInst _ (TyAbs a n k body) tyArg ->
         let b = TypeBind a (TyVarDecl a n k) tyArg
-         in Let (termAnn body) NonRec (pure b) body
+         in Let (getAnn body) NonRec (pure b) body
       t -> t
 
 betaPassSC
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatIn.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatIn.hs
index e718114f461..739a000cd94 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatIn.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatIn.hs
@@ -372,15 +372,15 @@ floatTerm binfo relaxed t0 =
 
 -- | The set of `Unique`s of used variables in a `Term`.
 termUniqs :: Term tyname name uni fun (a, Uniques) -> Uniques
-termUniqs = snd . termAnn
+termUniqs = snd . getAnn
 
 -- | The set of `Unique`s of used variables in a `Type`.
 typeUniqs :: Type tyname uni (a, Uniques) -> Uniques
-typeUniqs = snd . PLC.typeAnn
+typeUniqs = snd . getAnn
 
 -- | The set of `Unique`s of used variables in the RHS of a `Binding`.
 bindingUniqs :: Binding tyname name uni fun (a, Uniques) -> Uniques
-bindingUniqs = snd . bindingAnn
+bindingUniqs = snd . getAnn
 
 -- | The set of `Unique`s of used variables in a `VarDecl`.
 varDeclUniqs :: VarDecl tyname name uni (a, Uniques) -> Uniques
diff --git a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs
index 13ab72044fe..a26625043ad 100644
--- a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs
+++ b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs
@@ -33,7 +33,7 @@ import PlutusIR.Error qualified as PIR
 import PlutusIR.MkPir qualified as PIR
 import PlutusIR.Transform.Rename ()
 
-import PlutusCore (toPatFuncKind, tyVarDeclName, typeAnn)
+import PlutusCore (toPatFuncKind, tyVarDeclName)
 import PlutusCore.Builtin (annotateCaseBuiltin)
 import PlutusCore.Core qualified as PLC
 import PlutusCore.Error as PLC
@@ -371,7 +371,7 @@ checkKindFromBinding =
       checkKindM ann rhs $ void k
     -- For a term binding, correct means that the declared type has kind *.
     TermBind _ _ (VarDecl _ _ ty) _ ->
-      checkKindM (typeAnn ty) ty $ Type ()
+      checkKindM (getAnn ty) ty $ Type ()
     -- For a datatype binding, correct means that the type constructor has kind * when fully-applied to its type arguments.
     DatatypeBind _ dt@(Datatype ann tycon tyargs _ vdecls) ->
       -- tycon+tyargs must be in scope during kindchecking
diff --git a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs
index 98bf8315ad2..43b92fefd75 100644
--- a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs
+++ b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs
@@ -131,7 +131,7 @@ propTermSrcSpan = property $ do
   trailingSpaces <- forAll $ Gen.text (Range.linear 0 10) (Gen.element [' ', '\n'])
   case parseTerm (code <> trailingSpaces) of
     Right term ->
-      let sp = termAnn term
+      let sp = getAnn term
        in (srcSpanELine sp, srcSpanECol sp) === (endingLine, endingCol + 1)
     Left err -> annotate (display err) >> failure
 
diff --git a/plutus-core/prelude/PlutusPrelude.hs b/plutus-core/prelude/PlutusPrelude.hs
index 6f18cf2bc97..7dda208e610 100644
--- a/plutus-core/prelude/PlutusPrelude.hs
+++ b/plutus-core/prelude/PlutusPrelude.hs
@@ -102,6 +102,9 @@ module PlutusPrelude
   , showText
   , Default (def)
 
+    -- * Annotations
+  , HasAnn (..)
+
     -- * Lists
   , zipExact
   , allSame
@@ -161,6 +164,16 @@ import Prettyprinter
 import Text.PrettyBy.Default
 import Text.PrettyBy.Internal
 
+-- | Types that have an outermost annotation.
+class HasAnn f where
+  -- | Get the outermost annotation.
+  getAnn :: f a -> a
+  -- | Modify the outermost annotation.
+  modifyAnn :: (a -> a) -> f a -> f a
+  -- | Set the outermost annotation.
+  setAnn :: a -> f a -> f a
+  setAnn = modifyAnn . const
+
 infixr 2 ?
 infixl 4 <<$>>, <<*>>
 infixr 6 <^>
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore.hs
index 4bfd66cbd72..bf183d916f5 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore.hs
@@ -19,6 +19,7 @@ import UntypedPlutusCore.Subst as Export
 
 import PlutusCore.Default qualified as PLC
 import PlutusCore.Error (ApplyProgramError (MkApplyProgramError))
+import PlutusPrelude (getAnn)
 import PlutusCore.Name.Unique as Export
 
 import Control.Monad.Except
@@ -41,4 +42,4 @@ applyTerm
   => Term name uni fun a
   -> Term name uni fun a
   -> Term name uni fun a
-applyTerm t1 t2 = Apply (termAnn t1 <> termAnn t2) t1 t2
+applyTerm t1 t2 = Apply (getAnn t1 <> getAnn t2) t1 t2
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs
index 5bb131cd520..c98bcbaf4aa 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs
@@ -20,8 +20,6 @@ module UntypedPlutusCore.Core.Type
   , bindFunM
   , bindFun
   , mapFun
-  , termAnn
-  , modifyTermAnn
   , UVarDecl (..)
   , uvarDeclName
   , uvarDeclAnn
@@ -165,30 +163,28 @@ data UVarDecl name ann = UVarDecl
 makeLenses ''UVarDecl
 
 -- | Return the outermost annotation of a 'Term'.
-termAnn :: Term name uni fun ann -> ann
-termAnn (Constant ann _) = ann
-termAnn (Builtin ann _) = ann
-termAnn (Var ann _) = ann
-termAnn (LamAbs ann _ _) = ann
-termAnn (Apply ann _ _) = ann
-termAnn (Delay ann _) = ann
-termAnn (Force ann _) = ann
-termAnn (Error ann) = ann
-termAnn (Constr ann _ _) = ann
-termAnn (Case ann _ _) = ann
-
-modifyTermAnn :: (ann -> ann) -> Term name uni fun ann -> Term name uni fun ann
-modifyTermAnn f = \case
-  Constant ann c -> Constant (f ann) c
-  Builtin ann b -> Builtin (f ann) b
-  Var ann v -> Var (f ann) v
-  LamAbs ann x body -> LamAbs (f ann) x body
-  Apply ann fun arg -> Apply (f ann) fun arg
-  Delay ann body -> Delay (f ann) body
-  Force ann body -> Force (f ann) body
-  Error ann -> Error (f ann)
-  Constr ann i args -> Constr (f ann) i args
-  Case ann scrut alts -> Case (f ann) scrut alts
+instance HasAnn (Term name uni fun) where
+  getAnn (Constant ann _) = ann
+  getAnn (Builtin ann _)  = ann
+  getAnn (Var ann _)      = ann
+  getAnn (LamAbs ann _ _) = ann
+  getAnn (Apply ann _ _)  = ann
+  getAnn (Delay ann _)    = ann
+  getAnn (Force ann _)    = ann
+  getAnn (Error ann)      = ann
+  getAnn (Constr ann _ _) = ann
+  getAnn (Case ann _ _)   = ann
+  modifyAnn f = \case
+    Constant ann c      -> Constant (f ann) c
+    Builtin ann b       -> Builtin (f ann) b
+    Var ann v           -> Var (f ann) v
+    LamAbs ann x body   -> LamAbs (f ann) x body
+    Apply ann fun arg   -> Apply (f ann) fun arg
+    Delay ann body      -> Delay (f ann) body
+    Force ann body      -> Force (f ann) body
+    Error ann           -> Error (f ann)
+    Constr ann i args   -> Constr (f ann) i args
+    Case ann scrut alts -> Case (f ann) scrut alts
 
 bindFunM
   :: Monad m
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs
index 9bb868f5fb2..27ede1bc1ce 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs
@@ -141,11 +141,11 @@ computeCek !ctx !env (Delay _ body) = do
 -- s ; ρ ▻ lam x L  ↦  s ◅ lam x (L , ρ)
 computeCek !ctx !env (Force _ body) = do
   stepAndMaybeSpend BForce
-  pure $ Computing (FrameForce (termAnn body) ctx) env body
+  pure $ Computing (FrameForce (getAnn body) ctx) env body
 -- s ; ρ ▻ [L M]  ↦  s , [_ (M,ρ)]  ; ρ ▻ L
 computeCek !ctx !env (Apply _ fun arg) = do
   stepAndMaybeSpend BApply
-  pure $ Computing (FrameAwaitFunTerm (termAnn fun) env arg ctx) env fun
+  pure $ Computing (FrameAwaitFunTerm (getAnn fun) env arg ctx) env fun
 -- s ; ρ ▻ abs α L  ↦  s ◅ abs α (L , ρ)
 -- s ; ρ ▻ con c  ↦  s ◅ con c
 -- s ; ρ ▻ builtin bn  ↦  s ◅ builtin bn arity arity [] [] ρ
@@ -184,7 +184,7 @@ returnCek (FrameForce _ ctx) fun = forceEvaluate ctx fun
 -- s , [_ (M,ρ)] ◅ V  ↦  s , [V _] ; ρ ▻ M
 returnCek (FrameAwaitFunTerm _funAnn argVarEnv arg ctx) fun =
   -- MAYBE: perhaps it is worth here to merge the _funAnn with argAnn
-  pure $ Computing (FrameAwaitArg (termAnn arg) fun ctx) argVarEnv arg
+  pure $ Computing (FrameAwaitArg (getAnn arg) fun ctx) argVarEnv arg
 -- s , [(lam x (M,ρ)) _] ◅ V  ↦  s ; ρ [ x  ↦  V ] ▻ M
 -- FIXME (https://github.com/IntersectMBO/plutus-private/issues/1878):
 -- add rule for VBuiltin once it's in the specification.
@@ -399,7 +399,7 @@ cekStateContext f = \case
 
 cekStateAnn :: CekState uni fun ann -> Maybe ann
 cekStateAnn = \case
-  Computing _ _ t -> pure $ termAnn t
+  Computing _ _ t -> pure $ getAnn t
   Returning ctx _ -> contextAnn ctx
   _ -> empty
 
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs
index 57c16b6f6c6..fcdd4424a23 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs
@@ -1,6 +1,5 @@
 -- editorconfig-checker-disable-file
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
 
 module UntypedPlutusCore.Parser
   ( parse
@@ -21,7 +20,7 @@ import Control.Monad.Except
 import PlutusCore qualified as PLC
 import PlutusCore.Annotation
 import PlutusCore.Error qualified as PLC
-import PlutusPrelude (through)
+import PlutusPrelude ((&&&), getAnn, setAnn, through)
 import Text.Megaparsec hiding (ParseError, State, parse)
 import Text.Megaparsec.Char (char)
 import Text.Megaparsec.Char.Lexer qualified as Lex
@@ -59,8 +58,8 @@ lamTerm sp =
 
 appTerm :: SrcSpan -> Parser PTerm
 appTerm sp =
-  -- TODO: should not use the same `sp` for all arguments.
-  mkIterApp <$> term <*> (fmap (sp,) <$> some term)
+  setAnn sp <$>
+    (mkIterApp <$> term <*> (fmap (getAnn &&& id) <$> some term))
 
 delayTerm :: SrcSpan -> Parser PTerm
 delayTerm sp =
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ApplyToCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ApplyToCase.hs
index 3e6f59a340f..1fd8d19b22b 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ApplyToCase.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ApplyToCase.hs
@@ -17,6 +17,7 @@ module UntypedPlutusCore.Transform.ApplyToCase (applyToCase) where
 
 import Control.Lens (over)
 import Data.Vector qualified as V
+import PlutusPrelude (getAnn)
 import UntypedPlutusCore.Core
 import UntypedPlutusCore.Transform.Optimizer
   ( OptimizerT
@@ -41,6 +42,6 @@ processTerm :: Term name uni fun a -> Term name uni fun a
 processTerm t = case splitApplication t of
   (fun, args)
     | length args >= minArgs ->
-        let ann = termAnn t
+        let ann = getAnn t
          in Case ann (Constr ann 0 (processTerm . snd <$> args)) (V.singleton (processTerm fun))
   _ -> over termSubterms processTerm t
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs
index 8b496ab7ea5..703361b2a06 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs
@@ -7,7 +7,7 @@
 
 module UntypedPlutusCore.Transform.Cse (cse) where
 
-import PlutusCore (MonadQuote, Name, Rename, freshName, rename)
+import PlutusCore (MonadQuote, Name, Rename, freshName, getAnn, rename)
 import PlutusCore.Builtin (ToBuiltinMeaning (BuiltinSemanticsVariant))
 import UntypedPlutusCore.AstSize (termAstSize)
 import UntypedPlutusCore.Core
@@ -338,7 +338,7 @@ countOccs whichSubterms builtinSemanticsVariant =
         t
       where
         t = void t0
-        path = fst (termAnn t0)
+        path = fst (getAnn t0)
 
 -- | Combine a new path with a number of existing (path, count) pairs.
 combinePaths
@@ -385,16 +385,16 @@ applyCse
   -> Term Name uni fun (Path, ann)
 applyCse candidate = mkLamApp . transformOf termSubterms substCseVarForTerm
   where
-    candidatePath = fst (termAnn (ccAnnotatedTerm candidate))
+    candidatePath = fst (getAnn (ccAnnotatedTerm candidate))
 
     substCseVarForTerm :: Term Name uni fun (Path, ann) -> Term Name uni fun (Path, ann)
     substCseVarForTerm t =
       if currTerm == ccTerm candidate && candidatePath `isAncestorOrSelf` currPath
-        then Var (termAnn t) (ccFreshName candidate)
+        then Var (getAnn t) (ccFreshName candidate)
         else t
       where
         currTerm = void t
-        currPath = fst (termAnn t)
+        currPath = fst (getAnn t)
 
     mkLamApp :: Term Name uni fun (Path, ann) -> Term Name uni fun (Path, ann)
     mkLamApp t
@@ -412,7 +412,7 @@ applyCse candidate = mkLamApp . transformOf termSubterms substCseVarForTerm
           Case ann scrut branches -> Case ann (mkLamApp scrut) (mkLamApp <$> branches)
       | otherwise = t
       where
-        currPath = fst (termAnn t)
+        currPath = fst (getAnn t)
 
         -- See Note [CSE and immediately applied lambdas]
         placeCseBinding :: Term Name uni fun (Path, ann) -> Term Name uni fun (Path, ann)
@@ -448,8 +448,8 @@ applyCse candidate = mkLamApp . transformOf termSubterms substCseVarForTerm
             cseName = ccFreshName candidate
             wrapWithCse n =
               Apply
-                (termAnn n)
-                (LamAbs (termAnn n) cseName n)
+                (getAnn n)
+                (LamAbs (getAnn n) cseName n)
                 (ccAnnotatedTerm candidate)
 
 occursIn :: Eq name => name -> Term name uni fun a -> Bool
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs
index bece1f37f20..0857f0d094d 100644
--- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs
+++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs
@@ -53,12 +53,12 @@ import PlutusCore.Name.Unique (HasUnique, TermUnique (..), Unique (..))
 import PlutusCore.Name.UniqueMap qualified as UMap
 import PlutusCore.Quote (MonadQuote (..), Quote)
 import PlutusCore.Rename (Dupable, dupable, liftDupable)
-import PlutusPrelude (Generic)
+import PlutusPrelude (Generic, getAnn, modifyAnn)
 import UntypedPlutusCore.Analysis.Usages qualified as Usages
 import UntypedPlutusCore.AstSize (AstSize, termAstSize)
 import UntypedPlutusCore.Core qualified as UPLC
 import UntypedPlutusCore.Core.Plated (termSubterms)
-import UntypedPlutusCore.Core.Type (Term (..), modifyTermAnn, termAnn)
+import UntypedPlutusCore.Core.Type (Term (..))
 import UntypedPlutusCore.MkUPlc (Def (..), UTermDef, UVarDecl (..))
 import UntypedPlutusCore.Purity
   ( EvalTerm (EvalTerm, Unknown)
@@ -672,7 +672,7 @@ decorations = _1
 
 -- | Prepend the given decorations
 decorateWith :: [Decoration] -> Term name uni fun (Ann a) -> Term name uni fun (Ann a)
-decorateWith ds = modifyTermAnn (first (ds ++))
+decorateWith ds = modifyAnn (first (ds ++))
 {-# INLINE decorateWith #-}
 
 -- | Fold a decorated term into certifier hints.
@@ -686,7 +686,7 @@ mkHints = go
           DDrop -> CertifierHints.InlDrop h
           DExpand -> CertifierHints.InlExpand h
 
-        ds = termAnn t ^. decorations
+        ds = getAnn t ^. decorations
 
         hints = case t of
           Var {} -> CertifierHints.InlVar
diff --git a/plutus-core/untyped-plutus-core/testlib/Generators/Spec.hs b/plutus-core/untyped-plutus-core/testlib/Generators/Spec.hs
index b6036a90b52..ac0126bfd94 100644
--- a/plutus-core/untyped-plutus-core/testlib/Generators/Spec.hs
+++ b/plutus-core/untyped-plutus-core/testlib/Generators/Spec.hs
@@ -5,7 +5,7 @@
 -- | UPLC property tests (pretty-printing\/parsing and binary encoding\/decoding).
 module Generators.Spec where
 
-import PlutusPrelude (display, fold, void, (&&&))
+import PlutusPrelude (display, fold, getAnn, void, (&&&))
 
 import Control.Lens (view)
 import Data.Text (Text)
@@ -34,7 +34,7 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.Text.Encoding (encodeUtf8)
 import UntypedPlutusCore (Program)
 import UntypedPlutusCore qualified as UPLC
-import UntypedPlutusCore.Core.Type (progTerm, termAnn)
+import UntypedPlutusCore.Core.Type (progTerm)
 import UntypedPlutusCore.Generators.Hedgehog.AST (genProgram, regenConstantsUntil)
 import UntypedPlutusCore.Parser (parseProgram, parseTerm)
 
@@ -116,7 +116,7 @@ propTermSrcSpan = testPropertyNamed
     genTrailingSpaces = forAllPretty $ Gen.text (Range.linear 0 10) (Gen.element [' ', '\n'])
 
     getTermEndingLineAndCol term = do
-      let sp = termAnn term
+      let sp = getAnn term
       (srcSpanELine sp, srcSpanECol sp)
 
     handleParseError err = annotate (display err) >> failure
diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs
index 09daca581be..ba1204e504c 100644
--- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs
+++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs
@@ -1266,7 +1266,7 @@ compileExpr mloc e = do
             ( -- If the head of the application is an `AsData` matcher, propagate the
               -- `annIsAsDataMatcher` annotation to the whole application.
               -- See Note [Compiling AsData Matchers and Their Invocations]
-              if annIsAsDataMatcher (PIR.termAnn l')
+              if annIsAsDataMatcher (PIR.getAnn l')
                 then fmap (\ann -> ann {annIsAsDataMatcher = True})
                 else id
             )
@@ -1278,7 +1278,7 @@ compileExpr mloc e = do
         -- otherwise it's a normal application
         l `GHC.App` arg -> do
           l' <- compileExpr Nothing l
-          let isAsDataMatcher = annIsAsDataMatcher (PIR.termAnn l')
+          let isAsDataMatcher = annIsAsDataMatcher (PIR.getAnn l')
           fmap
             ( -- If the head of the application is an `AsData` matcher, propagate the
               -- `annIsAsDataMatcher` annotation to the whole application.