From 78d0250d4f41a35b592854fc941f78a05feed146 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 10:46:37 +0900
Subject: [PATCH 01/35] Add diagnostic data model

---
 sol-core.cabal             |   3 +
 src/Solcore/Diagnostics.hs | 297 +++++++++++++++++++++++++++++++++++++
 2 files changed, 300 insertions(+)
 create mode 100644 src/Solcore/Diagnostics.hs

diff --git a/sol-core.cabal b/sol-core.cabal
index 93113804d..bfa283896 100644
--- a/sol-core.cabal
+++ b/sol-core.cabal
@@ -31,6 +31,8 @@ common common-opts
     , optparse-applicative
     , parser-combinators >= 1.3
     , pretty
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , pretty-simple
     , split
     , syb
@@ -72,6 +74,7 @@ library
       Solcore.Desugarer.ContractDispatch
       Solcore.Desugarer.ReplaceFunTypeArgs
       Solcore.Desugarer.UniqueTypeGen
+      Solcore.Diagnostics
       Solcore.Frontend.Lexer.SolcoreLexer
       Solcore.Frontend.Module.Identity
       Solcore.Frontend.Module.Loader
diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
new file mode 100644
index 000000000..70105b3b3
--- /dev/null
+++ b/src/Solcore/Diagnostics.hs
@@ -0,0 +1,297 @@
+module Solcore.Diagnostics
+  ( Severity (..),
+    DiagnosticCode (..),
+    SourceSpan (..),
+    LabelStyle (..),
+    Label (..),
+    Diagnostic (..),
+    SourceId (..),
+    SourceFile (..),
+    SourceMap,
+    DiagnosticFormat (..),
+    ColorChoice (..),
+    UnicodeChoice (..),
+    DiagnosticRenderOptions (..),
+    defaultDiagnosticRenderOptions,
+    makeSourceFile,
+    sourceMapFromFiles,
+    emptySourceMap,
+    insertSourceFile,
+    legacyDiagnostic,
+    diagnosticPrimarySpan,
+    renderDiagnostic,
+    renderDiagnostics,
+  )
+where
+
+import Data.List (foldl')
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty, pretty, vsep)
+import Prettyprinter.Render.String (renderString)
+
+data Severity
+  = Error
+  | Warning
+  deriving (Eq, Ord, Show)
+
+newtype DiagnosticCode = DiagnosticCode String
+  deriving (Eq, Ord, Show)
+
+data SourceSpan
+  = SourceSpan
+  { spanFile :: FilePath,
+    spanStartByte :: Int,
+    spanEndByte :: Int,
+    spanStartLine :: Int,
+    spanStartColumn :: Int,
+    spanEndLine :: Int,
+    spanEndColumn :: Int
+  }
+  deriving (Eq, Ord, Show)
+
+data LabelStyle
+  = Primary
+  | Secondary
+  deriving (Eq, Ord, Show)
+
+data Label
+  = Label
+  { labelSpan :: SourceSpan,
+    labelStyle :: LabelStyle,
+    labelMessage :: Maybe String
+  }
+  deriving (Eq, Ord, Show)
+
+data Diagnostic
+  = Diagnostic
+  { diagnosticSeverity :: Severity,
+    diagnosticCode :: Maybe DiagnosticCode,
+    diagnosticMessage :: String,
+    diagnosticLabels :: [Label],
+    diagnosticNotes :: [String],
+    diagnosticHelp :: [String]
+  }
+  deriving (Eq, Ord, Show)
+
+newtype SourceId = SourceId FilePath
+  deriving (Eq, Ord, Show)
+
+data SourceFile
+  = SourceFile
+  { sourceId :: SourceId,
+    sourcePath :: FilePath,
+    sourceText :: String,
+    sourceLineStarts :: [Int]
+  }
+  deriving (Eq, Ord, Show)
+
+newtype SourceMap = SourceMap (Map FilePath SourceFile)
+  deriving (Eq, Ord, Show)
+
+data DiagnosticFormat
+  = DiagnosticHuman
+  | DiagnosticShort
+  deriving (Eq, Ord, Show)
+
+data ColorChoice
+  = ColorAuto
+  | ColorAlways
+  | ColorNever
+  deriving (Eq, Ord, Show)
+
+data UnicodeChoice
+  = UnicodeAuto
+  | UnicodeAlways
+  | UnicodeNever
+  deriving (Eq, Ord, Show)
+
+data DiagnosticRenderOptions
+  = DiagnosticRenderOptions
+  { diagnosticColor :: ColorChoice,
+    diagnosticUnicode :: UnicodeChoice,
+    diagnosticWidth :: Int,
+    diagnosticFormat :: DiagnosticFormat
+  }
+  deriving (Eq, Ord, Show)
+
+defaultDiagnosticRenderOptions :: DiagnosticRenderOptions
+defaultDiagnosticRenderOptions =
+  DiagnosticRenderOptions
+    { diagnosticColor = ColorAuto,
+      diagnosticUnicode = UnicodeAuto,
+      diagnosticWidth = 100,
+      diagnosticFormat = DiagnosticHuman
+    }
+
+makeSourceFile :: FilePath -> String -> SourceFile
+makeSourceFile path content =
+  SourceFile
+    { sourceId = SourceId path,
+      sourcePath = path,
+      sourceText = content,
+      sourceLineStarts = computeLineStarts content
+    }
+
+sourceMapFromFiles :: [SourceFile] -> SourceMap
+sourceMapFromFiles =
+  foldl' (\sourceMap source -> insertSourceFile source sourceMap) emptySourceMap
+
+emptySourceMap :: SourceMap
+emptySourceMap = SourceMap Map.empty
+
+insertSourceFile :: SourceFile -> SourceMap -> SourceMap
+insertSourceFile source (SourceMap sources) =
+  SourceMap (Map.insert (sourcePath source) source sources)
+
+legacyDiagnostic :: String -> Diagnostic
+legacyDiagnostic msg =
+  Diagnostic
+    { diagnosticSeverity = Error,
+      diagnosticCode = Nothing,
+      diagnosticMessage = msg,
+      diagnosticLabels = [],
+      diagnosticNotes = [],
+      diagnosticHelp = []
+    }
+
+diagnosticPrimarySpan :: Diagnostic -> Maybe SourceSpan
+diagnosticPrimarySpan diagnostic =
+  case filter ((== Primary) . labelStyle) (diagnosticLabels diagnostic) of
+    label : _ -> Just (labelSpan label)
+    [] ->
+      case diagnosticLabels diagnostic of
+        label : _ -> Just (labelSpan label)
+        [] -> Nothing
+
+renderDiagnostics :: DiagnosticRenderOptions -> SourceMap -> [Diagnostic] -> String
+renderDiagnostics opts sources diagnostics =
+  joinWithBlankLines (map (renderDiagnostic opts sources) diagnostics)
+
+renderDiagnostic :: DiagnosticRenderOptions -> SourceMap -> Diagnostic -> String
+renderDiagnostic opts sources diagnostic =
+  case diagnosticFormat opts of
+    DiagnosticShort -> renderShortDiagnostic diagnostic
+    DiagnosticHuman -> renderDoc (vsep (map pretty (humanDiagnosticLines sources diagnostic)))
+
+renderDoc :: Doc ann -> String
+renderDoc = renderString . layoutPretty defaultLayoutOptions
+
+renderShortDiagnostic :: Diagnostic -> String
+renderShortDiagnostic diagnostic =
+  case diagnosticPrimarySpan diagnostic of
+    Just sourceSpan ->
+      spanFile sourceSpan
+        ++ ":"
+        ++ show (spanStartLine sourceSpan)
+        ++ ":"
+        ++ show (spanStartColumn sourceSpan)
+        ++ ": "
+        ++ diagnosticHeader diagnostic
+    Nothing -> diagnosticHeader diagnostic
+
+humanDiagnosticLines :: SourceMap -> Diagnostic -> [String]
+humanDiagnosticLines sources diagnostic =
+  [diagnosticHeader diagnostic]
+    ++ locationLines diagnostic
+    ++ concatMap (labelSnippetLines sources) (diagnosticLabels diagnostic)
+    ++ map ("note: " ++) (diagnosticNotes diagnostic)
+    ++ map ("help: " ++) (diagnosticHelp diagnostic)
+
+diagnosticHeader :: Diagnostic -> String
+diagnosticHeader diagnostic =
+  severityName (diagnosticSeverity diagnostic)
+    ++ codeText (diagnosticCode diagnostic)
+    ++ ": "
+    ++ diagnosticMessage diagnostic
+
+severityName :: Severity -> String
+severityName Error = "error"
+severityName Warning = "warning"
+
+codeText :: Maybe DiagnosticCode -> String
+codeText Nothing = ""
+codeText (Just (DiagnosticCode code)) = "[" ++ code ++ "]"
+
+locationLines :: Diagnostic -> [String]
+locationLines diagnostic =
+  case diagnosticPrimarySpan diagnostic of
+    Nothing -> []
+    Just sourceSpan ->
+      [ "  --> "
+          ++ spanFile sourceSpan
+          ++ ":"
+          ++ show (spanStartLine sourceSpan)
+          ++ ":"
+          ++ show (spanStartColumn sourceSpan)
+      ]
+
+labelSnippetLines :: SourceMap -> Label -> [String]
+labelSnippetLines (SourceMap sources) label =
+  case Map.lookup (spanFile sourceSpan) sources of
+    Nothing -> []
+    Just source -> sourceLabelSnippet source label
+  where
+    sourceSpan = labelSpan label
+
+sourceLabelSnippet :: SourceFile -> Label -> [String]
+sourceLabelSnippet source label =
+  [gutter]
+    ++ concatMap renderLine [firstLine .. lastLine]
+  where
+    sourceSpan = labelSpan label
+    firstLine = max 1 (spanStartLine sourceSpan)
+    lastLine = max firstLine (spanEndLine sourceSpan)
+    lineNoWidth = length (show lastLine)
+    gutter = replicate lineNoWidth ' ' ++ " |"
+    marker = case labelStyle label of
+      Primary -> '^'
+      Secondary -> '-'
+
+    renderLine lineNo =
+      let lineText = sourceLine source lineNo
+          underline = underlineForLine sourceSpan lineNo lineText marker
+          message = if lineNo == firstLine then maybe "" (" " ++) (labelMessage label) else ""
+       in [ padLeft lineNoWidth (show lineNo) ++ " | " ++ lineText,
+            replicate lineNoWidth ' ' ++ " | " ++ underline ++ message
+          ]
+
+underlineForLine :: SourceSpan -> Int -> String -> Char -> String
+underlineForLine sourceSpan lineNo lineText marker =
+  replicate (startCol - 1) ' ' ++ replicate markerWidth marker
+  where
+    startCol
+      | lineNo == spanStartLine sourceSpan = max 1 (spanStartColumn sourceSpan)
+      | otherwise = 1
+    endCol
+      | lineNo == spanEndLine sourceSpan = max startCol (spanEndColumn sourceSpan)
+      | otherwise = max startCol (length lineText + 1)
+    markerWidth = max 1 (endCol - startCol)
+
+sourceLine :: SourceFile -> Int -> String
+sourceLine source lineNo =
+  case drop (lineNo - 1) (sourceLines source) of
+    lineText : _ -> lineText
+    [] -> ""
+
+sourceLines :: SourceFile -> [String]
+sourceLines source =
+  case lines (sourceText source) of
+    [] -> [""]
+    xs -> xs
+
+computeLineStarts :: String -> [Int]
+computeLineStarts =
+  (0 :) . reverse . fst . foldl' step ([], 0)
+  where
+    step (starts, offset) '\n' = (offset + 1 : starts, offset + 1)
+    step (starts, offset) _ = (starts, offset + 1)
+
+padLeft :: Int -> String -> String
+padLeft width str =
+  replicate (max 0 (width - length str)) ' ' ++ str
+
+joinWithBlankLines :: [String] -> String
+joinWithBlankLines [] = ""
+joinWithBlankLines [x] = x
+joinWithBlankLines (x : xs) = x ++ "\n\n" ++ joinWithBlankLines xs

From b5efcf768560bac2c2528a7deb71e879f7bf88f8 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 11:31:12 +0900
Subject: [PATCH 02/35] Add diagnostic output options

---
 src/Solcore/Pipeline/Options.hs         | 90 +++++++++++++++++++++++++
 src/Solcore/Pipeline/SolcorePipeline.hs |  5 +-
 2 files changed, 93 insertions(+), 2 deletions(-)

diff --git a/src/Solcore/Pipeline/Options.hs b/src/Solcore/Pipeline/Options.hs
index 35efef7ca..ce3840d65 100644
--- a/src/Solcore/Pipeline/Options.hs
+++ b/src/Solcore/Pipeline/Options.hs
@@ -1,6 +1,7 @@
 module Solcore.Pipeline.Options where
 
 import Options.Applicative
+import Solcore.Diagnostics
 
 data Option
   = Option
@@ -25,6 +26,10 @@ data Option
     optDebugSpec :: !Bool,
     optDebugHull :: !Bool,
     optTiming :: !Bool,
+    optDiagnosticColor :: !ColorChoice,
+    optDiagnosticUnicode :: !UnicodeChoice,
+    optDiagnosticWidth :: !Int,
+    optDiagnosticFormat :: !DiagnosticFormat,
     -- Partial evaluation options
     optPEFuel :: !(Maybe Int)
   }
@@ -54,6 +59,10 @@ emptyOption path =
       optDebugSpec = False,
       optDebugHull = False,
       optTiming = False,
+      optDiagnosticColor = diagnosticColor defaultDiagnosticRenderOptions,
+      optDiagnosticUnicode = diagnosticUnicode defaultDiagnosticRenderOptions,
+      optDiagnosticWidth = diagnosticWidth defaultDiagnosticRenderOptions,
+      optDiagnosticFormat = diagnosticFormat defaultDiagnosticRenderOptions,
       -- Partial evaluation options
       optPEFuel = Nothing
     }
@@ -168,6 +177,38 @@ options =
       ( long "timing"
           <> help "Measure time of some phases"
       )
+    <*> option
+      colorChoiceReader
+      ( long "color"
+          <> metavar "auto|always|never"
+          <> value (optDiagnosticColor stdOpt)
+          <> showDefaultWith showColorChoice
+          <> help "Configure diagnostic colors"
+      )
+    <*> option
+      unicodeChoiceReader
+      ( long "unicode"
+          <> metavar "auto|always|never"
+          <> value (optDiagnosticUnicode stdOpt)
+          <> showDefaultWith showUnicodeChoice
+          <> help "Configure diagnostic Unicode output"
+      )
+    <*> option
+      auto
+      ( long "diagnostic-width"
+          <> metavar "N"
+          <> value (optDiagnosticWidth stdOpt)
+          <> showDefault
+          <> help "Set diagnostic output width"
+      )
+    <*> option
+      diagnosticFormatReader
+      ( long "diagnostic-format"
+          <> metavar "human|short"
+          <> value (optDiagnosticFormat stdOpt)
+          <> showDefaultWith showDiagnosticFormat
+          <> help "Configure diagnostic output format"
+      )
     -- Partial evaluation options
     <*> optional
       ( option
@@ -188,3 +229,52 @@ argumentsParser = do
               <> header "Solcore - solidity core language"
           )
   execParser opts
+
+diagnosticRenderOptions :: Option -> DiagnosticRenderOptions
+diagnosticRenderOptions opts =
+  DiagnosticRenderOptions
+    { diagnosticColor = optDiagnosticColor opts,
+      diagnosticUnicode = optDiagnosticUnicode opts,
+      diagnosticWidth = optDiagnosticWidth opts,
+      diagnosticFormat = optDiagnosticFormat opts
+    }
+
+colorChoiceReader :: ReadM ColorChoice
+colorChoiceReader =
+  eitherReader $ \raw ->
+    case raw of
+      "auto" -> Right ColorAuto
+      "always" -> Right ColorAlways
+      "never" -> Right ColorNever
+      _ -> Left "expected one of: auto, always, never"
+
+unicodeChoiceReader :: ReadM UnicodeChoice
+unicodeChoiceReader =
+  eitherReader $ \raw ->
+    case raw of
+      "auto" -> Right UnicodeAuto
+      "always" -> Right UnicodeAlways
+      "never" -> Right UnicodeNever
+      _ -> Left "expected one of: auto, always, never"
+
+diagnosticFormatReader :: ReadM DiagnosticFormat
+diagnosticFormatReader =
+  eitherReader $ \raw ->
+    case raw of
+      "human" -> Right DiagnosticHuman
+      "short" -> Right DiagnosticShort
+      _ -> Left "expected one of: human, short"
+
+showColorChoice :: ColorChoice -> String
+showColorChoice ColorAuto = "auto"
+showColorChoice ColorAlways = "always"
+showColorChoice ColorNever = "never"
+
+showUnicodeChoice :: UnicodeChoice -> String
+showUnicodeChoice UnicodeAuto = "auto"
+showUnicodeChoice UnicodeAlways = "always"
+showUnicodeChoice UnicodeNever = "never"
+
+showDiagnosticFormat :: DiagnosticFormat -> String
+showDiagnosticFormat DiagnosticHuman = "human"
+showDiagnosticFormat DiagnosticShort = "short"
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 8650a5bc8..d951d5f8d 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -22,6 +22,7 @@ import Solcore.Desugarer.IfDesugarer (ifDesugarer)
 import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
 import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
+import Solcore.Diagnostics (emptySourceMap, legacyDiagnostic, renderDiagnostic)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Module.Loader (ModuleGraph (..), loadModuleGraph, moduleSourcePath, moduleValidationTopDeclSegments)
 import Solcore.Frontend.Pretty.SolcorePretty
@@ -31,7 +32,7 @@ import Solcore.Frontend.TypeInference.Id
 import Solcore.Frontend.TypeInference.SccAnalysis
 import Solcore.Frontend.TypeInference.TcEnv
 import Solcore.Frontend.TypeInference.TcModule
-import Solcore.Pipeline.Options (Option (..), argumentsParser, noDesugarOpt)
+import Solcore.Pipeline.Options (Option (..), argumentsParser, diagnosticRenderOptions, noDesugarOpt)
 import System.Directory (makeAbsolute)
 import System.Exit (ExitCode (..), exitWith)
 import System.TimeIt qualified as TimeIt
@@ -44,7 +45,7 @@ pipeline = do
   result <- compile opts
   case result of
     Left err -> do
-      putStrLn err
+      putStrLn (renderDiagnostic (diagnosticRenderOptions opts) emptySourceMap (legacyDiagnostic err))
       exitWith (ExitFailure 1)
     Right contracts -> do
       forM_ (zip [(1 :: Int) ..] contracts) $ \(i, c) -> do

From 331f34f3f4f5263324d4e98eff14acf56664ff82 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 14:08:54 +0900
Subject: [PATCH 03/35] Track source spans on lexer tokens

---
 src/Solcore/Frontend/Lexer/SolcoreLexer.x   | 149 ++++++++++++++------
 src/Solcore/Frontend/Module/Loader.hs       |   4 +-
 src/Solcore/Frontend/Parser/SolcoreParser.y |   7 +-
 3 files changed, 114 insertions(+), 46 deletions(-)

diff --git a/src/Solcore/Frontend/Lexer/SolcoreLexer.x b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
index f20f6c4f6..ec03599e6 100644
--- a/src/Solcore/Frontend/Lexer/SolcoreLexer.x
+++ b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
@@ -4,6 +4,7 @@ module Solcore.Frontend.Lexer.SolcoreLexer where
 
 import Control.Monad
 import Numeric (readHex)
+import Solcore.Diagnostics
 }
 
 
@@ -123,11 +124,12 @@ data AlexUserState
       nestLevel :: Int
     , strStart :: AlexPosn
     , strBuffer :: String
+    , sourceName :: FilePath
     }
 
 alexInitUserState :: AlexUserState
 alexInitUserState
-  = AlexUserState 0 (AlexPn 0 0 0) []
+  = AlexUserState 0 (AlexPn 0 0 0) [] "<input>"
 
 get :: Alex AlexUserState
 get = Alex $ \s -> Right (s, alex_ust s)
@@ -139,6 +141,10 @@ modify :: (AlexUserState -> AlexUserState) -> Alex ()
 modify f
   = Alex $ \s -> Right (s{alex_ust = f (alex_ust s)}, ())
 
+setSourceName :: FilePath -> Alex ()
+setSourceName name =
+  modify $ \s -> s{sourceName = name}
+
 alexEOF :: Alex Token
 alexEOF = do
   (pos, _, _, _) <- alexGetInput
@@ -147,21 +153,72 @@ alexEOF = do
     alexError "Error: unclosed comment"
   when (startCode == state_string) $
     alexError "Error: unclosed string"
-  pure $ Token (position pos) TEOF
-
--- FIXME: Use AlexPosn in the token type to represent the location.
+  file <- sourceName <$> get
+  pure $ mkToken file pos 0 TEOF
 
 position :: AlexPosn -> (Int, Int)
 position (AlexPn _ x y) = (x,y)
 
+sourceSpan :: FilePath -> AlexPosn -> Int -> SourceSpan
+sourceSpan file (AlexPn offset line column) len =
+  SourceSpan
+    { spanFile = file,
+      spanStartByte = offset,
+      spanEndByte = offset + len,
+      spanStartLine = line,
+      spanStartColumn = column,
+      spanEndLine = line,
+      spanEndColumn = column + max 1 len
+    }
+
+sourceSpanBetween :: FilePath -> AlexPosn -> AlexPosn -> Int -> SourceSpan
+sourceSpanBetween file (AlexPn startOffset startLine startColumn) (AlexPn endOffset endLine endColumn) endLen =
+  SourceSpan
+    { spanFile = file,
+      spanStartByte = startOffset,
+      spanEndByte = endOffset + endLen,
+      spanStartLine = startLine,
+      spanStartColumn = startColumn,
+      spanEndLine = endLine,
+      spanEndColumn = endColumn + max 1 endLen
+    }
+
+mkToken :: FilePath -> AlexPosn -> Int -> Lexeme -> Token
+mkToken file st len lx =
+  TokenWithSpan (sourceSpan file st len) (position st) lx
+
+mkTokenWithSpan :: SourceSpan -> Lexeme -> Token
+mkTokenWithSpan span lx =
+  TokenWithSpan span (spanStartLine span, spanStartColumn span) lx
+
 -- token definition
 
 data Token
-  = Token {
-      pos :: (Int, Int)
+  = TokenWithSpan {
+      tokenSpan :: SourceSpan
+    , pos :: (Int, Int)
     , lexeme :: Lexeme
     } deriving (Eq, Ord, Show)
 
+pattern Token :: (Int, Int) -> Lexeme -> Token
+pattern Token p lx <- TokenWithSpan _ p lx
+  where
+    Token p lx = TokenWithSpan (uncurriedSourceSpan p) p lx
+
+{-# COMPLETE Token #-}
+
+uncurriedSourceSpan :: (Int, Int) -> SourceSpan
+uncurriedSourceSpan (line, column) =
+  SourceSpan
+    { spanFile = "<input>",
+      spanStartByte = 0,
+      spanEndByte = 0,
+      spanStartLine = line,
+      spanStartColumn = column,
+      spanEndLine = line,
+      spanEndColumn = column + 1
+    }
+
 data Lexeme
   = TIdent { unIdent :: String }
   | TNumber { unNum :: Integer }
@@ -240,44 +297,50 @@ data Lexeme
 
 mkIdent :: AlexAction Token
 mkIdent (st, _, _, str) len
-  = case take len str of
-      "match" -> return $ Token (position st) TMatch
-      "data" -> return $ Token (position st) TData
-      "import" -> return $ Token (position st) TImport
-      "export" -> return $ Token (position st) TExport
-      "hiding" -> return $ Token (position st) THiding
-      "as" -> return $ Token (position st) TAs
-      "contract" -> return $ Token (position st) TContract
-      "function" -> return $ Token (position st) TFunction
-      "constructor" -> return $ Token (position st) TConstructor
-      "return" -> return $ Token (position st) TReturn
-      "continue" -> return $ Token (position st) TContinue
-      "break" -> return $ Token (position st) TBreak
-      "let" -> return $ Token (position st) TLet
-      "assembly" -> return $ Token (position st) TAssembly
-      "if" -> return $ Token (position st) TIf
-      "else" -> return $ Token (position st) TElse
-      "switch" -> return $ Token (position st) TSwitch
-      "for" -> return $ Token (position st) TFor
-      "default" -> return $ Token (position st) TDefault
-      "type" -> return $ Token (position st) TType
-      "forall" -> return $ Token (position st) TForall
-      "pragma" -> return $ Token (position st) TPragma
-      "no-coverage-condition" ->
-        return $ Token (position st) TNoCoverageCondition
-      "no-patterson-condition" ->
-        return $ Token (position st) TNoPattersonCondition
-      "no-bounded-variable-condition" ->
-        return $ Token (position st) TNoBoundVariableCondition
-      _ -> return $ Token (position st) (TIdent $ take len str)
+  = do
+      file <- sourceName <$> get
+      pure $ mkToken file st len (lexemeFor (take len str))
+  where
+    lexemeFor str =
+      case str of
+        "match" -> TMatch
+        "data" -> TData
+        "import" -> TImport
+        "export" -> TExport
+        "hiding" -> THiding
+        "as" -> TAs
+        "contract" -> TContract
+        "function" -> TFunction
+        "constructor" -> TConstructor
+        "return" -> TReturn
+        "continue" -> TContinue
+        "break" -> TBreak
+        "let" -> TLet
+        "assembly" -> TAssembly
+        "if" -> TIf
+        "else" -> TElse
+        "switch" -> TSwitch
+        "for" -> TFor
+        "default" -> TDefault
+        "type" -> TType
+        "forall" -> TForall
+        "pragma" -> TPragma
+        "no-coverage-condition" -> TNoCoverageCondition
+        "no-patterson-condition" -> TNoPattersonCondition
+        "no-bounded-variable-condition" -> TNoBoundVariableCondition
+        _ -> TIdent str
 
 mkNumber :: AlexAction Token
 mkNumber (st, _, _, str) len
-  = pure $ Token (position st) (TNumber $ read $ take len str)
+  = do
+      file <- sourceName <$> get
+      pure $ mkToken file st len (TNumber $ read $ take len str)
 
 mkHexlit :: AlexAction Token
 mkHexlit (st, _, _, str) len
-  = pure $ Token (position st) (TNumber $ parseHex $ take len str)
+  = do
+      file <- sourceName <$> get
+      pure $ mkToken file st len (TNumber $ parseHex $ take len str)
 
 parseHex :: String -> Integer
 parseHex str = case readHex (drop 2 str) of
@@ -285,8 +348,10 @@ parseHex str = case readHex (drop 2 str) of
     _         -> error "impossible :)"
 
 simpleToken :: Lexeme -> AlexAction Token
-simpleToken lx (st, _, _, _) _
-  = return $ Token (position st) lx
+simpleToken lx (st, _, _, _) len
+  = do
+      file <- sourceName <$> get
+      return $ mkToken file st len lx
 
 -- string literals
 
@@ -299,12 +364,12 @@ enterString inp@(pos, _, _, _) len
       skip inp len
 
 exitString :: AlexAction Token
-exitString (pos, _, _, _) _
+exitString (pos, _, _, _) len
   = do
       s <- get
       put s{strStart = AlexPn 0 0 0, strBuffer = []}
       let tk = TString $ reverse $ '"' : strBuffer s
-      return $ Token (position pos) tk
+      return $ mkTokenWithSpan (sourceSpanBetween (sourceName s) (strStart s) pos len) tk
 
 emit :: Char -> AlexAction Token
 emit c inp@(_, _, _, _) len = do
diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 408a59fd0..80f4eaae8 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -20,7 +20,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Solcore.Frontend.Module.Identity qualified as Mod
-import Solcore.Frontend.Parser.SolcoreParser (parseCompUnit)
+import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.SyntaxTree
 import System.Directory (doesFileExist, makeAbsolute)
@@ -124,7 +124,7 @@ visit cfg moduleId sourcePath = do
   unless (alreadyLoaded || loading) do
     modify (\st -> st {loadingModules = Set.insert moduleId (loadingModules st)})
     content <- liftIO (readFile sourcePath)
-    parsed <- liftIO (parseCompUnit content)
+    parsed <- liftIO (parseCompUnitWithPath sourcePath content)
     cunit <- either throwError pure parsed
     importedModules <- mapM (resolveImportPath cfg moduleId) (imports cunit)
     exportedModules <-
diff --git a/src/Solcore/Frontend/Parser/SolcoreParser.y b/src/Solcore/Frontend/Parser/SolcoreParser.y
index 4058cfaab..314f6f010 100644
--- a/src/Solcore/Frontend/Parser/SolcoreParser.y
+++ b/src/Solcore/Frontend/Parser/SolcoreParser.y
@@ -607,9 +607,12 @@ OptSemi : ';'                                      { () }
 {
 
 moduleParser :: [String] -> String -> IO (Either String CompUnit)
-moduleParser _dirs content
+moduleParser _dirs = parseCompUnitWithPath "<input>"
+
+parseCompUnitWithPath :: FilePath -> String -> IO (Either String CompUnit)
+parseCompUnitWithPath sourcePath content
   = do
-      let r = runAlex content parser
+      let r = runAlex content (setSourceName sourcePath >> parser)
       case r of
         Left err -> pure $ Left err
         Right cunit -> pure (Right cunit)

From a38d5777fd1c1c0b42c1c53266c335329fd25777 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 14:34:27 +0900
Subject: [PATCH 04/35] Store loaded source text

---
 src/Solcore/Frontend/Module/Loader.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 80f4eaae8..365b18939 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -19,6 +19,7 @@ import Data.Map qualified as Map
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
+import Solcore.Diagnostics (SourceFile, makeSourceFile)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
 import Solcore.Frontend.Syntax.Name
@@ -29,6 +30,7 @@ import System.FilePath
 data LoadedModule
   = LoadedModule
   { loadedSourcePath :: FilePath,
+    loadedSource :: SourceFile,
     loadedCompUnit :: CompUnit,
     loadedModuleRefs :: Map ModulePath Mod.ModuleId
   }
@@ -124,6 +126,7 @@ visit cfg moduleId sourcePath = do
   unless (alreadyLoaded || loading) do
     modify (\st -> st {loadingModules = Set.insert moduleId (loadingModules st)})
     content <- liftIO (readFile sourcePath)
+    let source = makeSourceFile sourcePath content
     parsed <- liftIO (parseCompUnitWithPath sourcePath content)
     cunit <- either throwError pure parsed
     importedModules <- mapM (resolveImportPath cfg moduleId) (imports cunit)
@@ -142,7 +145,7 @@ visit cfg moduleId sourcePath = do
     modify
       ( \st ->
           st
-            { loadedModules = Map.insert moduleId (LoadedModule sourcePath cunit moduleRefs) (loadedModules st),
+            { loadedModules = Map.insert moduleId (LoadedModule sourcePath source cunit moduleRefs) (loadedModules st),
               moduleDeps = Map.insert moduleId (map fst importedModules) (moduleDeps st),
               moduleRefDeps = Map.insert moduleId (map fst referencedModules) (moduleRefDeps st),
               loadingModules = Set.delete moduleId (loadingModules st),

From 8a828193cfb3894784928ea86ffdbea616acf4d0 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 18:12:43 +0900
Subject: [PATCH 05/35] Render compile failures with source maps

---
 src/Solcore/Frontend/Module/Loader.hs   |  7 +-
 src/Solcore/Pipeline/SolcorePipeline.hs | 86 ++++++++++++++++++-------
 2 files changed, 70 insertions(+), 23 deletions(-)

diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 365b18939..32dea3ccf 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -3,6 +3,7 @@ module Solcore.Frontend.Module.Loader
     LoadedModule (..),
     ModuleTypeCheckSurface (..),
     loadModuleGraph,
+    moduleSourceMap,
     moduleValidationTopDeclSegments,
     moduleSourcePath,
     moduleLocalTypeCheckSurface,
@@ -19,7 +20,7 @@ import Data.Map qualified as Map
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Solcore.Diagnostics (SourceFile, makeSourceFile)
+import Solcore.Diagnostics (SourceFile, SourceMap, makeSourceFile, sourceMapFromFiles)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
 import Solcore.Frontend.Syntax.Name
@@ -345,6 +346,10 @@ moduleSourcePath graph modulePath =
     (Right . loadedSourcePath)
     (Map.lookup modulePath (modules graph))
 
+moduleSourceMap :: ModuleGraph -> SourceMap
+moduleSourceMap graph =
+  sourceMapFromFiles (map loadedSource (Map.elems (modules graph)))
+
 moduleImportPairsFor :: ModuleGraph -> Mod.ModuleId -> CompUnit -> [(Import, Mod.ModuleId)]
 moduleImportPairsFor graph modulePath unit =
   zip (imports unit) (Map.findWithDefault [] modulePath (dependencies graph))
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index d951d5f8d..db6f2e2a2 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -22,9 +22,9 @@ import Solcore.Desugarer.IfDesugarer (ifDesugarer)
 import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
 import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
-import Solcore.Diagnostics (emptySourceMap, legacyDiagnostic, renderDiagnostic)
+import Solcore.Diagnostics (Diagnostic, SourceMap, diagnosticMessage, emptySourceMap, legacyDiagnostic, renderDiagnostics)
 import Solcore.Frontend.Module.Identity qualified as Mod
-import Solcore.Frontend.Module.Loader (ModuleGraph (..), loadModuleGraph, moduleSourcePath, moduleValidationTopDeclSegments)
+import Solcore.Frontend.Module.Loader (ModuleGraph (..), loadModuleGraph, moduleSourceMap, moduleSourcePath, moduleValidationTopDeclSegments)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax hiding (contracts)
 import Solcore.Frontend.Syntax.NameResolution
@@ -42,10 +42,10 @@ pipeline :: IO ()
 pipeline = do
   _startTime <- Time.getCurrentTime
   opts <- argumentsParser
-  result <- compile opts
+  result <- compileWithDiagnostics opts
   case result of
     Left err -> do
-      putStrLn (renderDiagnostic (diagnosticRenderOptions opts) emptySourceMap (legacyDiagnostic err))
+      putStrLn (renderCompileDiagnostics opts err)
       exitWith (ExitFailure 1)
     Right contracts -> do
       forM_ (zip [(1 :: Int) ..] contracts) $ \(i, c) -> do
@@ -53,9 +53,20 @@ pipeline = do
         putStrLn ("Writing to " ++ filename)
         writeFile filename (show c)
 
+data CompileDiagnostics
+  = CompileDiagnostics
+  { compileDiagnosticSources :: SourceMap,
+    compileDiagnosticMessages :: [Diagnostic]
+  }
+  deriving (Eq, Show)
+
 -- Version that returns Either for testing
 compile :: Option -> IO (Either String [Hull.Object])
-compile opts = runExceptT $ do
+compile opts =
+  first compileDiagnosticsText <$> compileWithDiagnostics opts
+
+compileWithDiagnostics :: Option -> IO (Either CompileDiagnostics [Hull.Object])
+compileWithDiagnostics opts = runExceptT $ do
   let verbose = optVerbose opts
       noMatchCompiler = optNoMatchCompiler opts
       noIfDesugar = optNoIfDesugar opts
@@ -63,34 +74,39 @@ compile opts = runExceptT $ do
       timeItNamed = optTimeItNamed opts
       file = fileName opts
   mainRoot <- liftIO $ makeAbsolute (optRootDir opts)
-  stdRoot <- ExceptT $ pure (parseStdRoot (optImportDirs opts))
-  externalLibs <- ExceptT $ pure (parseExternalLibSpecs (optExternalLibs opts))
+  stdRoot <- liftEitherDiagnostic emptySourceMap (parseStdRoot (optImportDirs opts))
+  externalLibs <- liftEitherDiagnostic emptySourceMap (parseExternalLibSpecs (optExternalLibs opts))
 
   -- Parsing and import loading
-  graph <- ExceptT $ loadModuleGraph mainRoot stdRoot externalLibs file
+  graph <- liftEitherDiagnosticIO emptySourceMap (loadModuleGraph mainRoot stdRoot externalLibs file)
+  let sources = moduleSourceMap graph
 
   -- Validate each module against only its own direct imports.
   forM_ (moduleOrder graph) $ \moduleId -> do
-    sourcePath <- ExceptT $ pure (moduleSourcePath graph moduleId)
+    sourcePath <- liftEitherDiagnostic sources (moduleSourcePath graph moduleId)
     (validationImports, validationSegments) <-
-      ExceptT $
-        pure (moduleValidationTopDeclSegments graph moduleId)
+      liftEitherDiagnostic sources (moduleValidationTopDeclSegments graph moduleId)
     _ <-
-      ExceptT $
-        pure $
-          first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e) $
+      liftEitherDiagnostic
+        sources
+        ( first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e) $
             validateDuplicateNamespacesInTopDeclSegments validationSegments
+        )
     _ <-
-      ExceptT $
-        first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e)
-          <$> nameResolutionTopDeclSegments validationImports validationSegments
+      liftEitherDiagnosticIO
+        sources
+        ( first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e)
+            <$> nameResolutionTopDeclSegments validationImports validationSegments
+        )
     pure ()
 
   checkedModules <-
-    ExceptT $
-      timeItNamed "Typecheck modules" $
-        runExceptT (typeCheckLoadedModules opts graph)
-  checkedAssembly <- ExceptT $ pure (assembleCheckedModules graph checkedModules)
+    liftEitherDiagnosticIO
+      sources
+      ( timeItNamed "Typecheck modules" $
+          runExceptT (typeCheckLoadedModules opts graph)
+      )
+  checkedAssembly <- liftEitherDiagnostic sources (assembleCheckedModules graph checkedModules)
   let typed = checkedAssemblyCompUnit checkedAssembly
       tcEnv = checkedAssemblyEnv checkedAssembly
 
@@ -110,7 +126,7 @@ compile opts = runExceptT $ do
     if noMatchCompiler
       then pure desugared
       else do
-        (ast, warns) <- ExceptT $ timeItNamed "Match compiler" $ matchCompiler desugared
+        (ast, warns) <- liftEitherDiagnosticIO sources (timeItNamed "Match compiler" $ matchCompiler desugared)
         when (verbose && not (null warns)) $ liftIO $ mapM_ (putStrLn . showWarning) warns
         pure ast
 
@@ -161,6 +177,32 @@ compile opts = runExceptT $ do
 
       pure hull
 
+renderCompileDiagnostics :: Option -> CompileDiagnostics -> String
+renderCompileDiagnostics opts diagnostics =
+  renderDiagnostics
+    (diagnosticRenderOptions opts)
+    (compileDiagnosticSources diagnostics)
+    (compileDiagnosticMessages diagnostics)
+
+compileDiagnosticsText :: CompileDiagnostics -> String
+compileDiagnosticsText =
+  unlines . map diagnosticMessage . compileDiagnosticMessages
+
+liftEitherDiagnostic :: SourceMap -> Either String a -> ExceptT CompileDiagnostics IO a
+liftEitherDiagnostic sources =
+  ExceptT . pure . first (compileDiagnosticError sources)
+
+liftEitherDiagnosticIO :: SourceMap -> IO (Either String a) -> ExceptT CompileDiagnostics IO a
+liftEitherDiagnosticIO sources action =
+  ExceptT (first (compileDiagnosticError sources) <$> action)
+
+compileDiagnosticError :: SourceMap -> String -> CompileDiagnostics
+compileDiagnosticError sources err =
+  CompileDiagnostics
+    { compileDiagnosticSources = sources,
+      compileDiagnosticMessages = [legacyDiagnostic err]
+    }
+
 typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT String IO (Map Mod.ModuleId CheckedModule)
 typeCheckLoadedModules opts graph =
   Map.fromList <$> mapM (typeCheckModuleFromGraph opts graph) (moduleOrder graph)

From ec7c6213d99aa0d3a173b9e45b8026af4e87c94a Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 20 May 2026 21:06:18 +0900
Subject: [PATCH 06/35] Add diagnostic string envelope

---
 src/Solcore/Diagnostics.hs | 39 +++++++++++++++++++++++++++++++-------
 1 file changed, 32 insertions(+), 7 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 70105b3b3..5b90f2e35 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -17,26 +17,31 @@ module Solcore.Diagnostics
     sourceMapFromFiles,
     emptySourceMap,
     insertSourceFile,
+    lookupSourceFile,
+    sourceMapNull,
     legacyDiagnostic,
+    encodeDiagnostic,
+    decodeDiagnostic,
     diagnosticPrimarySpan,
     renderDiagnostic,
     renderDiagnostics,
   )
 where
 
-import Data.List (foldl')
+import Data.List (foldl', stripPrefix)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty, pretty, vsep)
 import Prettyprinter.Render.String (renderString)
+import Text.Read (readMaybe)
 
 data Severity
   = Error
   | Warning
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 newtype DiagnosticCode = DiagnosticCode String
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 data SourceSpan
   = SourceSpan
@@ -48,12 +53,12 @@ data SourceSpan
     spanEndLine :: Int,
     spanEndColumn :: Int
   }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 data LabelStyle
   = Primary
   | Secondary
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 data Label
   = Label
@@ -61,7 +66,7 @@ data Label
     labelStyle :: LabelStyle,
     labelMessage :: Maybe String
   }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 data Diagnostic
   = Diagnostic
@@ -72,7 +77,7 @@ data Diagnostic
     diagnosticNotes :: [String],
     diagnosticHelp :: [String]
   }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 newtype SourceId = SourceId FilePath
   deriving (Eq, Ord, Show)
@@ -144,6 +149,14 @@ insertSourceFile :: SourceFile -> SourceMap -> SourceMap
 insertSourceFile source (SourceMap sources) =
   SourceMap (Map.insert (sourcePath source) source sources)
 
+lookupSourceFile :: FilePath -> SourceMap -> Maybe SourceFile
+lookupSourceFile path (SourceMap sources) =
+  Map.lookup path sources
+
+sourceMapNull :: SourceMap -> Bool
+sourceMapNull (SourceMap sources) =
+  Map.null sources
+
 legacyDiagnostic :: String -> Diagnostic
 legacyDiagnostic msg =
   Diagnostic
@@ -155,6 +168,18 @@ legacyDiagnostic msg =
       diagnosticHelp = []
     }
 
+encodeDiagnostic :: Diagnostic -> String
+encodeDiagnostic diagnostic =
+  diagnosticEnvelopePrefix ++ show diagnostic
+
+decodeDiagnostic :: String -> Maybe Diagnostic
+decodeDiagnostic raw = do
+  encoded <- stripPrefix diagnosticEnvelopePrefix raw
+  readMaybe encoded
+
+diagnosticEnvelopePrefix :: String
+diagnosticEnvelopePrefix = "\STXsolcore-diagnostic\ETX"
+
 diagnosticPrimarySpan :: Diagnostic -> Maybe SourceSpan
 diagnosticPrimarySpan diagnostic =
   case filter ((== Primary) . labelStyle) (diagnosticLabels diagnostic) of

From e45325fb95cc5b8c0ecd83bf73b4bc1471723187 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 10:34:21 +0900
Subject: [PATCH 07/35] Emit structured parse diagnostics

---
 src/Solcore/Frontend/Parser/SolcoreParser.y | 29 ++++++++--
 src/Solcore/Pipeline/SolcorePipeline.hs     | 60 +++++++++++++++++++--
 2 files changed, 82 insertions(+), 7 deletions(-)

diff --git a/src/Solcore/Frontend/Parser/SolcoreParser.y b/src/Solcore/Frontend/Parser/SolcoreParser.y
index 314f6f010..e293e624f 100644
--- a/src/Solcore/Frontend/Parser/SolcoreParser.y
+++ b/src/Solcore/Frontend/Parser/SolcoreParser.y
@@ -8,6 +8,7 @@ import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.SyntaxTree
 import Solcore.Primitives.Primitives hiding (pairTy)
 import Language.Yul
+import Solcore.Diagnostics
 
 }
 
@@ -653,9 +654,31 @@ tupleExp (t1 : ts) = pairExp t1 (tupleExp ts)
 rmquotes :: String -> String
 rmquotes = read
 
-parseError (Token (line, col) lexeme)
-  = alexError $ "Parse error while processing lexeme: " ++ show lexeme
-                ++ "\n at line " ++ show line ++ ", column " ++ show col
+parseError token@(Token _ lexeme)
+  = alexError $
+      encodeDiagnostic
+        Diagnostic
+          { diagnosticSeverity = Error,
+            diagnosticCode = Just (DiagnosticCode "SC0001"),
+            diagnosticMessage = "parse error: unexpected " ++ lexemeDescription lexeme,
+            diagnosticLabels =
+              [ Label
+                  { labelSpan = tokenSpan token,
+                    labelStyle = Primary,
+                    labelMessage = Just (labelDescription lexeme)
+                  }
+              ],
+            diagnosticNotes = [],
+            diagnosticHelp = []
+          }
+
+lexemeDescription :: Lexeme -> String
+lexemeDescription TEOF = "end of file"
+lexemeDescription lexeme = show lexeme
+
+labelDescription :: Lexeme -> String
+labelDescription TEOF = "expected more input"
+labelDescription _ = "unexpected token"
 
 lexer :: (Token -> Alex a) -> Alex a
 lexer = (=<< alexMonadScan)
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index db6f2e2a2..6e2144ac3 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -22,7 +22,20 @@ import Solcore.Desugarer.IfDesugarer (ifDesugarer)
 import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
 import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
-import Solcore.Diagnostics (Diagnostic, SourceMap, diagnosticMessage, emptySourceMap, legacyDiagnostic, renderDiagnostics)
+import Solcore.Diagnostics
+  ( Diagnostic,
+    SourceMap,
+    decodeDiagnostic,
+    diagnosticMessage,
+    diagnosticPrimarySpan,
+    emptySourceMap,
+    insertSourceFile,
+    legacyDiagnostic,
+    lookupSourceFile,
+    makeSourceFile,
+    renderDiagnostics,
+    spanFile,
+  )
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Module.Loader (ModuleGraph (..), loadModuleGraph, moduleSourceMap, moduleSourcePath, moduleValidationTopDeclSegments)
 import Solcore.Frontend.Pretty.SolcorePretty
@@ -33,7 +46,7 @@ import Solcore.Frontend.TypeInference.SccAnalysis
 import Solcore.Frontend.TypeInference.TcEnv
 import Solcore.Frontend.TypeInference.TcModule
 import Solcore.Pipeline.Options (Option (..), argumentsParser, diagnosticRenderOptions, noDesugarOpt)
-import System.Directory (makeAbsolute)
+import System.Directory (doesFileExist, makeAbsolute)
 import System.Exit (ExitCode (..), exitWith)
 import System.TimeIt qualified as TimeIt
 
@@ -194,15 +207,54 @@ liftEitherDiagnostic sources =
 
 liftEitherDiagnosticIO :: SourceMap -> IO (Either String a) -> ExceptT CompileDiagnostics IO a
 liftEitherDiagnosticIO sources action =
-  ExceptT (first (compileDiagnosticError sources) <$> action)
+  ExceptT $ do
+    result <- action
+    case result of
+      Left err -> Left <$> compileDiagnosticErrorIO sources err
+      Right value -> pure (Right value)
 
 compileDiagnosticError :: SourceMap -> String -> CompileDiagnostics
 compileDiagnosticError sources err =
   CompileDiagnostics
     { compileDiagnosticSources = sources,
-      compileDiagnosticMessages = [legacyDiagnostic err]
+      compileDiagnosticMessages = diagnosticsFromError err
     }
 
+compileDiagnosticErrorIO :: SourceMap -> String -> IO CompileDiagnostics
+compileDiagnosticErrorIO sources err = do
+  let diagnostics = diagnosticsFromError err
+  sources' <- ensureDiagnosticSources sources diagnostics
+  pure
+    CompileDiagnostics
+      { compileDiagnosticSources = sources',
+        compileDiagnosticMessages = diagnostics
+      }
+
+diagnosticsFromError :: String -> [Diagnostic]
+diagnosticsFromError err =
+  case decodeDiagnostic err of
+    Just diagnostic -> [diagnostic]
+    Nothing -> [legacyDiagnostic err]
+
+ensureDiagnosticSources :: SourceMap -> [Diagnostic] -> IO SourceMap
+ensureDiagnosticSources =
+  foldM ensureDiagnosticSource
+
+ensureDiagnosticSource :: SourceMap -> Diagnostic -> IO SourceMap
+ensureDiagnosticSource sources diagnostic =
+  case diagnosticPrimarySpan diagnostic of
+    Nothing -> pure sources
+    Just sourceSpan
+      | null (spanFile sourceSpan) -> pure sources
+      | Just _ <- lookupSourceFile (spanFile sourceSpan) sources -> pure sources
+      | otherwise -> do
+          exists <- doesFileExist (spanFile sourceSpan)
+          if exists
+            then do
+              content <- readFile (spanFile sourceSpan)
+              pure (insertSourceFile (makeSourceFile (spanFile sourceSpan) content) sources)
+            else pure sources
+
 typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT String IO (Map Mod.ModuleId CheckedModule)
 typeCheckLoadedModules opts graph =
   Map.fromList <$> mapM (typeCheckModuleFromGraph opts graph) (moduleOrder graph)

From ae4faf159534ed6430b97533399d2f5499abb6f3 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 11:19:58 +0900
Subject: [PATCH 08/35] Emit structured lexer diagnostics

---
 src/Solcore/Frontend/Lexer/SolcoreLexer.x | 42 ++++++++++++++++++++---
 1 file changed, 37 insertions(+), 5 deletions(-)

diff --git a/src/Solcore/Frontend/Lexer/SolcoreLexer.x b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
index ec03599e6..a2dc75327 100644
--- a/src/Solcore/Frontend/Lexer/SolcoreLexer.x
+++ b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
@@ -31,7 +31,7 @@ tokens :-
         <0>    $white+                           ;
         <0>    "//" .*                           ;
         <0>   "/*"                               {nestComment `andBegin` state_comment}
-        <0>   "*/"                               {\ _ _ -> alexError "Error: unexpected close comment!"}
+        <0>   "*/"                               {unexpectedCloseComment}
         <state_comment> "/*"                     {nestComment}
         <state_comment> "*/"                     {unnestComment}
         <state_comment> .                        ;
@@ -149,12 +149,15 @@ alexEOF :: Alex Token
 alexEOF = do
   (pos, _, _, _) <- alexGetInput
   startCode <- alexGetStartCode
+  state <- get
   when (startCode == state_comment) $
-    alexError "Error: unclosed comment"
+    lexerErrorAt pos 1 "unclosed comment" "comment is not closed"
   when (startCode == state_string) $
-    alexError "Error: unclosed string"
-  file <- sourceName <$> get
-  pure $ mkToken file pos 0 TEOF
+    lexerErrorWithSpan
+      (sourceSpanBetween (sourceName state) (strStart state) pos 0)
+      "unclosed string"
+      "string literal is not closed"
+  pure $ mkToken (sourceName state) pos 0 TEOF
 
 position :: AlexPosn -> (Int, Int)
 position (AlexPn _ x y) = (x,y)
@@ -191,6 +194,31 @@ mkTokenWithSpan :: SourceSpan -> Lexeme -> Token
 mkTokenWithSpan span lx =
   TokenWithSpan span (spanStartLine span, spanStartColumn span) lx
 
+lexerErrorAt :: AlexPosn -> Int -> String -> String -> Alex a
+lexerErrorAt pos len message label =
+  do
+    file <- sourceName <$> get
+    lexerErrorWithSpan (sourceSpan file pos len) message label
+
+lexerErrorWithSpan :: SourceSpan -> String -> String -> Alex a
+lexerErrorWithSpan span message label =
+  alexError $
+    encodeDiagnostic
+      Diagnostic
+        { diagnosticSeverity = Error,
+          diagnosticCode = Just (DiagnosticCode "SC0000"),
+          diagnosticMessage = message,
+          diagnosticLabels =
+            [ Label
+                { labelSpan = span,
+                  labelStyle = Primary,
+                  labelMessage = Just label
+                }
+            ],
+          diagnosticNotes = [],
+          diagnosticHelp = []
+        }
+
 -- token definition
 
 data Token
@@ -353,6 +381,10 @@ simpleToken lx (st, _, _, _) len
       file <- sourceName <$> get
       return $ mkToken file st len lx
 
+unexpectedCloseComment :: AlexAction Token
+unexpectedCloseComment (st, _, _, _) len =
+  lexerErrorAt st len "unexpected close comment" "this close comment has no matching open comment"
+
 -- string literals
 
 enterString :: AlexAction Token

From 87af9ff4f162a87f1919cc7d64a184d84f930576 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 12:03:14 +0900
Subject: [PATCH 09/35] Preserve structured diagnostics in contexts

---
 src/Solcore/Frontend/Syntax/NameResolution.hs | 10 +++++++++-
 src/Solcore/Frontend/TypeInference/TcMonad.hs | 10 +++++++++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 471daff0a..27eb14d1d 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -8,6 +8,7 @@ import Control.Monad.State
 import Data.List ((\\))
 import Data.Map (Map)
 import Data.Map qualified as Map
+import Solcore.Diagnostics (Diagnostic (..), decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
 import Solcore.Frontend.Syntax.Name
@@ -1009,7 +1010,14 @@ wrapError m e =
   catchError m handler
   where
     handler msg = throwError (decorate msg)
-    decorate msg = msg ++ "\n - in:" ++ pretty e
+    decorate msg =
+      case decodeDiagnostic msg of
+        Just diagnostic ->
+          encodeDiagnostic
+            diagnostic
+              { diagnosticNotes = diagnosticNotes diagnostic ++ ["in: " ++ pretty e]
+              }
+        Nothing -> msg ++ "\n - in:" ++ pretty e
 
 addContractName :: Name -> ResolveM ()
 addContractName n =
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index e44176cbe..e18e67d9a 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -8,6 +8,7 @@ import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
 import Data.Set qualified as Set
+import Solcore.Diagnostics (Diagnostic (..), decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -657,7 +658,14 @@ wrapError m e =
   catchError m handler
   where
     handler msg = throwError (decorate msg)
-    decorate msg = msg ++ "\n - in:" ++ pretty e
+    decorate msg =
+      case decodeDiagnostic msg of
+        Just diagnostic ->
+          encodeDiagnostic
+            diagnostic
+              { diagnosticNotes = diagnosticNotes diagnostic ++ ["in: " ++ pretty e]
+              }
+        Nothing -> msg ++ "\n - in:" ++ pretty e
 
 tcmMgu :: Ty -> Ty -> TcM Subst
 tcmMgu t u = catchError (mgu t u) tcmError

From 9af79470782d64e132c36aae5213a377818917d1 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 14:21:47 +0900
Subject: [PATCH 10/35] Emit structured type mismatch diagnostics

---
 src/Solcore/Frontend/TypeInference/TcUnify.hs | 32 +++++++++++--------
 src/Solcore/Pipeline/SolcorePipeline.hs       | 26 +++++++++------
 2 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/src/Solcore/Frontend/TypeInference/TcUnify.hs b/src/Solcore/Frontend/TypeInference/TcUnify.hs
index ca134453c..a4c4b79a0 100644
--- a/src/Solcore/Frontend/TypeInference/TcUnify.hs
+++ b/src/Solcore/Frontend/TypeInference/TcUnify.hs
@@ -3,6 +3,7 @@ module Solcore.Frontend.TypeInference.TcUnify where
 import Common.Pretty
 import Control.Monad.Except
 import Data.List
+import Solcore.Diagnostics
 import Solcore.Frontend.Pretty.ShortName
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
@@ -179,13 +180,7 @@ infiniteTyErr v t =
 
 typesNotMatch :: (MonadError String m) => Ty -> Ty -> m a
 typesNotMatch t1 t2 =
-  throwError $
-    unwords
-      [ "Types do not match:",
-        pretty t1,
-        "and",
-        pretty t2
-      ]
+  typeMismatchDiagnostic "types do not match" t1 t2
 
 typesMatchListErr :: (MonadError String m) => [String] -> [String] -> m a
 typesMatchListErr ts ts' =
@@ -213,14 +208,23 @@ typesMguListErr ts ts' =
 
 typesDoNotUnify :: (MonadError String m) => Ty -> Ty -> m a
 typesDoNotUnify t1 t2 =
+  typeMismatchDiagnostic "types do not unify" t1 t2
+
+typeMismatchDiagnostic :: (MonadError String m) => String -> Ty -> Ty -> m a
+typeMismatchDiagnostic message t1 t2 =
   throwError $
-    unwords
-      [ "Types:",
-        pretty t1,
-        "and",
-        pretty t2,
-        "do not unify"
-      ]
+    encodeDiagnostic
+      Diagnostic
+        { diagnosticSeverity = Error,
+          diagnosticCode = Just (DiagnosticCode "SC0201"),
+          diagnosticMessage = message ++ ": " ++ pretty t1 ++ " and " ++ pretty t2,
+          diagnosticLabels = [],
+          diagnosticNotes =
+            [ "left type: " ++ pretty t1,
+              "right type: " ++ pretty t2
+            ],
+          diagnosticHelp = []
+        }
 
 boundVariablesErr :: (MonadError String m) => [Tyvar] -> m a
 boundVariablesErr ts =
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 6e2144ac3..3d52d98d4 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -23,12 +23,13 @@ import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
 import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
 import Solcore.Diagnostics
-  ( Diagnostic,
+  ( Diagnostic (..),
     SourceMap,
     decodeDiagnostic,
     diagnosticMessage,
     diagnosticPrimarySpan,
     emptySourceMap,
+    encodeDiagnostic,
     insertSourceFile,
     legacyDiagnostic,
     lookupSourceFile,
@@ -102,13 +103,13 @@ compileWithDiagnostics opts = runExceptT $ do
     _ <-
       liftEitherDiagnostic
         sources
-        ( first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e) $
+        ( first (decorateDiagnosticContext ("module validation failed for " ++ sourcePath)) $
             validateDuplicateNamespacesInTopDeclSegments validationSegments
         )
     _ <-
       liftEitherDiagnosticIO
         sources
-        ( first (\e -> "Module validation failed for " ++ sourcePath ++ ":\n" ++ e)
+        ( first (decorateDiagnosticContext ("module validation failed for " ++ sourcePath))
             <$> nameResolutionTopDeclSegments validationImports validationSegments
         )
     pure ()
@@ -343,12 +344,19 @@ dumpModuleTypeInference opts sourcePath typed tcEnv =
 
 moduleTypeCheckError :: FilePath -> String -> String -> String
 moduleTypeCheckError sourcePath phase err =
-  "Module typecheck failed for "
-    ++ sourcePath
-    ++ " ("
-    ++ phase
-    ++ "):\n"
-    ++ err
+  decorateDiagnosticContext
+    ("module typecheck failed for " ++ sourcePath ++ " (" ++ phase ++ ")")
+    err
+
+decorateDiagnosticContext :: String -> String -> String
+decorateDiagnosticContext context err =
+  case decodeDiagnostic err of
+    Just diagnostic ->
+      encodeDiagnostic
+        diagnostic
+          { diagnosticNotes = diagnosticNotes diagnostic ++ [context]
+          }
+    Nothing -> context ++ ":\n" ++ err
 
 prepareInferenceDeclsForTypeInference ::
   Option ->

From a38f3a8bb8ac95554ebbab889d54a919bebc460d Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 16:07:33 +0900
Subject: [PATCH 11/35] Emit structured name resolution diagnostics

---
 src/Solcore/Frontend/Syntax/NameResolution.hs | 62 +++++++++++++++----
 1 file changed, 49 insertions(+), 13 deletions(-)

diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 27eb14d1d..30accb0e5 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -8,7 +8,7 @@ import Control.Monad.State
 import Data.List ((\\))
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Solcore.Diagnostics (Diagnostic (..), decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
 import Solcore.Frontend.Syntax.Name
@@ -1080,33 +1080,69 @@ resolveQualifiedConstructorName qualifier conName =
 
 undefinedTypeVariables :: [Name] -> ResolveM a
 undefinedTypeVariables ns =
-  throwError $ unlines ["Undefined type variables:", unwords (map pretty ns)]
+  diagnosticError
+    "SC0102"
+    ("undefined type variables: " ++ unwords (map pretty ns))
+    []
+    []
 
 undefinedTypeConstructor :: S.Ty -> ResolveM a
 undefinedTypeConstructor t =
-  throwError $ unlines ["Undefined type constructor:", pretty t]
+  diagnosticError
+    "SC0103"
+    ("undefined type constructor: " ++ pretty t)
+    []
+    []
 
 invalidTypeSynonymError :: S.TySym -> ResolveM a
 invalidTypeSynonymError t =
-  throwError $ unlines ["Invalid type synonym:", pretty t]
+  diagnosticError
+    "SC0104"
+    ("invalid type synonym: " ++ pretty t)
+    []
+    []
 
 undefinedClassError :: Name -> ResolveM a
 undefinedClassError n =
-  throwError $ unlines ["Undefined class:", pretty n]
+  diagnosticError
+    "SC0105"
+    ("undefined class: " ++ pretty n)
+    []
+    []
 
 undefinedName :: Name -> ResolveM a
 undefinedName n =
-  throwError $ unwords ["Undefined name:", pretty n]
+  diagnosticError
+    "SC0101"
+    ("undefined name: " ++ pretty n)
+    []
+    []
 
 unqualifiedConstructorError :: Name -> ResolveM a
 unqualifiedConstructorError n =
-  throwError $
-    unlines
-      [ "Unqualified constructor:",
-        pretty n,
-        "Use Type.Constructor form."
-      ]
+  diagnosticError
+    "SC0106"
+    ("unqualified constructor: " ++ pretty n)
+    []
+    ["use Type.Constructor form"]
 
 invalidPatternSyntax :: S.Pat -> ResolveM a
 invalidPatternSyntax p =
-  throwError $ unwords ["Invalid pattern syntax:", pretty p]
+  diagnosticError
+    "SC0107"
+    ("invalid pattern syntax: " ++ pretty p)
+    []
+    []
+
+diagnosticError :: String -> String -> [String] -> [String] -> ResolveM a
+diagnosticError code message notes help =
+  throwError $
+    encodeDiagnostic
+      Diagnostic
+        { diagnosticSeverity = Error,
+          diagnosticCode = Just (DiagnosticCode code),
+          diagnosticMessage = message,
+          diagnosticLabels = [],
+          diagnosticNotes = notes,
+          diagnosticHelp = help
+        }

From 4d97ae598314484aff12a79a2d2d3b6779519f52 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 21 May 2026 21:42:09 +0900
Subject: [PATCH 12/35] Emit structured type lookup diagnostics

---
 src/Solcore/Frontend/TypeInference/TcMonad.hs | 75 ++++++++++++-------
 1 file changed, 49 insertions(+), 26 deletions(-)

diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index e18e67d9a..f71634802 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -8,7 +8,7 @@ import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
 import Data.Set qualified as Set
-import Solcore.Diagnostics (Diagnostic (..), decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -680,43 +680,45 @@ tcmError s = do
 
 undefinedName :: Name -> TcM a
 undefinedName n =
-  throwError $ unwords ["Undefined name:", pretty n]
+  tcDiagnosticError
+    "SC0202"
+    ("undefined name: " ++ pretty n)
+    []
+    []
 
 undefinedType :: Name -> TcM a
 undefinedType n =
   do
     s <- (unlines . reverse) <$> gets logs
-    throwError $ unwords ["Undefined type:", pretty n, "\n", s]
+    tcDiagnosticError
+      "SC0203"
+      ("undefined type: " ++ pretty n)
+      (if null s then [] else [s])
+      []
 
 undefinedField :: Name -> Name -> TcM a
 undefinedField n n' =
-  throwError $
-    unlines
-      [ "Undefined field:",
-        pretty n,
-        "in type:",
-        pretty n'
-      ]
+  tcDiagnosticError
+    "SC0204"
+    ("undefined field: " ++ pretty n)
+    ["in type: " ++ pretty n']
+    []
 
 undefinedConstr :: Name -> Name -> TcM a
 undefinedConstr tn cn =
-  throwError $
-    unlines
-      [ "Undefined constructor:",
-        pretty cn,
-        "in type:",
-        pretty tn
-      ]
+  tcDiagnosticError
+    "SC0205"
+    ("undefined constructor: " ++ pretty cn)
+    ["in type: " ++ pretty tn]
+    []
 
 undefinedFunction :: Name -> Name -> TcM a
 undefinedFunction t n =
-  throwError $
-    unlines
-      [ "The type:",
-        pretty t,
-        "does not define function:",
-        pretty n
-      ]
+  tcDiagnosticError
+    "SC0206"
+    ("undefined function: " ++ pretty n)
+    ["type " ++ pretty t ++ " does not define this function"]
+    []
 
 typeNotPolymorphicEnough :: Signature Name -> Scheme -> Scheme -> TcM a
 typeNotPolymorphicEnough sig sch1 sch2 =
@@ -732,11 +734,32 @@ typeNotPolymorphicEnough sig sch1 sch2 =
 
 undefinedClass :: Name -> TcM a
 undefinedClass n =
-  throwError $ unlines ["Undefined class:", pretty n]
+  tcDiagnosticError
+    "SC0207"
+    ("undefined class: " ++ pretty n)
+    []
+    []
 
 undefinedSynonym :: Name -> TcM a
 undefinedSynonym n =
-  throwError $ unwords ["Undefined type synonym:", pretty n]
+  tcDiagnosticError
+    "SC0208"
+    ("undefined type synonym: " ++ pretty n)
+    []
+    []
+
+tcDiagnosticError :: String -> String -> [String] -> [String] -> TcM a
+tcDiagnosticError code message notes help =
+  throwError $
+    encodeDiagnostic
+      Diagnostic
+        { diagnosticSeverity = Error,
+          diagnosticCode = Just (DiagnosticCode code),
+          diagnosticMessage = message,
+          diagnosticLabels = [],
+          diagnosticNotes = notes,
+          diagnosticHelp = help
+        }
 
 typeAlreadyDefinedError :: DataTy -> Name -> TcM a
 typeAlreadyDefinedError d n =

From 48b45aec63448b7255bdfe1bc69de557db7299db Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Sun, 24 May 2026 10:17:29 +0200
Subject: [PATCH 13/35] Add source text span lookup

---
 src/Solcore/Diagnostics.hs | 41 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 40 insertions(+), 1 deletion(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 5b90f2e35..73af86516 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -18,7 +18,9 @@ module Solcore.Diagnostics
     emptySourceMap,
     insertSourceFile,
     lookupSourceFile,
+    sourceMapFiles,
     sourceMapNull,
+    findTextSpansInSource,
     legacyDiagnostic,
     encodeDiagnostic,
     decodeDiagnostic,
@@ -28,7 +30,7 @@ module Solcore.Diagnostics
   )
 where
 
-import Data.List (foldl', stripPrefix)
+import Data.List (foldl', isPrefixOf, stripPrefix, tails)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty, pretty, vsep)
@@ -153,10 +155,47 @@ lookupSourceFile :: FilePath -> SourceMap -> Maybe SourceFile
 lookupSourceFile path (SourceMap sources) =
   Map.lookup path sources
 
+sourceMapFiles :: SourceMap -> [SourceFile]
+sourceMapFiles (SourceMap sources) =
+  Map.elems sources
+
 sourceMapNull :: SourceMap -> Bool
 sourceMapNull (SourceMap sources) =
   Map.null sources
 
+findTextSpansInSource :: SourceFile -> String -> [SourceSpan]
+findTextSpansInSource source needle
+  | null needle = []
+  | otherwise =
+      [ lineSpan lineNo lineStart column
+        | (lineNo, lineStart, lineText) <- sourceLinesWithOffsets source,
+          column <- findColumns needle lineText
+      ]
+  where
+    needleLen = length needle
+    lineSpan lineNo lineStart column =
+      SourceSpan
+        { spanFile = sourcePath source,
+          spanStartByte = lineStart + column - 1,
+          spanEndByte = lineStart + column - 1 + needleLen,
+          spanStartLine = lineNo,
+          spanStartColumn = column,
+          spanEndLine = lineNo,
+          spanEndColumn = column + needleLen
+        }
+
+sourceLinesWithOffsets :: SourceFile -> [(Int, Int, String)]
+sourceLinesWithOffsets source =
+  zipWith3
+    (\lineNo lineStart lineText -> (lineNo, lineStart, lineText))
+    [1 ..]
+    (sourceLineStarts source)
+    (sourceLines source)
+
+findColumns :: String -> String -> [Int]
+findColumns needle haystack =
+  [column | (column, suffix) <- zip [1 ..] (tails haystack), needle `isPrefixOf` suffix]
+
 legacyDiagnostic :: String -> Diagnostic
 legacyDiagnostic msg =
   Diagnostic

From 1d06605c6a39d31fec7493eea4f1d1d017d1acdf Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Sun, 24 May 2026 13:56:44 +0200
Subject: [PATCH 14/35] Infer source labels for diagnostics

---
 src/Solcore/Pipeline/SolcorePipeline.hs | 207 +++++++++++++++++++++++-
 1 file changed, 201 insertions(+), 6 deletions(-)

diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 3d52d98d4..2b6521ec0 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -4,9 +4,11 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Data.Bifunctor (first)
-import Data.Char (isAlpha, isAlphaNum)
+import Data.Char (isAlpha, isAlphaNum, isSpace)
+import Data.List (isInfixOf, isPrefixOf, nub, stripPrefix)
 import Data.Map (Map)
 import Data.Map qualified as Map
+import Data.Maybe (mapMaybe)
 import Data.Time qualified as Time
 import Language.Hull qualified as Hull
 -- Pretty instances for MastCompUnit
@@ -24,17 +26,24 @@ import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
 import Solcore.Diagnostics
   ( Diagnostic (..),
+    DiagnosticCode (..),
+    Label (..),
+    LabelStyle (..),
+    SourceFile,
     SourceMap,
+    SourceSpan,
     decodeDiagnostic,
     diagnosticMessage,
     diagnosticPrimarySpan,
     emptySourceMap,
     encodeDiagnostic,
+    findTextSpansInSource,
     insertSourceFile,
     legacyDiagnostic,
     lookupSourceFile,
     makeSourceFile,
     renderDiagnostics,
+    sourceMapFiles,
     spanFile,
   )
 import Solcore.Frontend.Module.Identity qualified as Mod
@@ -216,10 +225,11 @@ liftEitherDiagnosticIO sources action =
 
 compileDiagnosticError :: SourceMap -> String -> CompileDiagnostics
 compileDiagnosticError sources err =
-  CompileDiagnostics
-    { compileDiagnosticSources = sources,
-      compileDiagnosticMessages = diagnosticsFromError err
-    }
+  let diagnostics = diagnosticsFromError err
+   in CompileDiagnostics
+        { compileDiagnosticSources = sources,
+          compileDiagnosticMessages = map (enrichDiagnostic sources) diagnostics
+        }
 
 compileDiagnosticErrorIO :: SourceMap -> String -> IO CompileDiagnostics
 compileDiagnosticErrorIO sources err = do
@@ -228,7 +238,7 @@ compileDiagnosticErrorIO sources err = do
   pure
     CompileDiagnostics
       { compileDiagnosticSources = sources',
-        compileDiagnosticMessages = diagnostics
+        compileDiagnosticMessages = map (enrichDiagnostic sources') diagnostics
       }
 
 diagnosticsFromError :: String -> [Diagnostic]
@@ -237,6 +247,191 @@ diagnosticsFromError err =
     Just diagnostic -> [diagnostic]
     Nothing -> [legacyDiagnostic err]
 
+enrichDiagnostic :: SourceMap -> Diagnostic -> Diagnostic
+enrichDiagnostic sources diagnostic
+  | not (null (diagnosticLabels diagnostic)) = diagnostic
+  | isDuplicateDiagnostic diagnostic,
+    Just labels <- inferDuplicateLabels sources diagnostic =
+      diagnostic {diagnosticLabels = labels}
+  | Just label <- inferPrimaryLabel sources diagnostic =
+      diagnostic {diagnosticLabels = [label]}
+  | otherwise = diagnostic
+
+inferPrimaryLabel :: SourceMap -> Diagnostic -> Maybe Label
+inferPrimaryLabel sources diagnostic = do
+  term <- firstMatchTerm sources diagnostic (diagnosticSearchTerms diagnostic)
+  foundSpan <- firstSpanForTerm sources diagnostic term
+  pure
+    Label
+      { labelSpan = foundSpan,
+        labelStyle = Primary,
+        labelMessage = Just (primaryLabelMessage diagnostic)
+      }
+
+inferDuplicateLabels :: SourceMap -> Diagnostic -> Maybe [Label]
+inferDuplicateLabels sources diagnostic =
+  case firstTwoSpans of
+    [previous, duplicate] ->
+      Just
+        [ Label previous Secondary (Just "previous definition"),
+          Label duplicate Primary (Just "duplicate definition")
+        ]
+    _ -> Nothing
+  where
+    firstTwoSpans =
+      take 2 $
+        concat
+          [ spansForTerm sources diagnostic term
+            | term <- duplicateSearchTerms diagnostic
+          ]
+
+firstMatchTerm :: SourceMap -> Diagnostic -> [String] -> Maybe String
+firstMatchTerm sources diagnostic =
+  go . filter (not . null)
+  where
+    go [] = Nothing
+    go (term : terms)
+      | null (spansForTerm sources diagnostic term) = go terms
+      | otherwise = Just term
+
+firstSpanForTerm :: SourceMap -> Diagnostic -> String -> Maybe SourceSpan
+firstSpanForTerm sources diagnostic term =
+  case spansForTerm sources diagnostic term of
+    foundSpan : _ -> Just foundSpan
+    [] -> Nothing
+
+spansForTerm :: SourceMap -> Diagnostic -> String -> [SourceSpan]
+spansForTerm sources diagnostic term =
+  concatMap (`findTextSpansInSource` term) (candidateSources sources diagnostic)
+
+candidateSources :: SourceMap -> Diagnostic -> [SourceFile]
+candidateSources sources diagnostic =
+  case mapMaybe (`lookupSourceFile` sources) (diagnosticSourcePaths diagnostic) of
+    [] -> sourceMapFiles sources
+    matched -> matched
+
+diagnosticSearchTerms :: Diagnostic -> [String]
+diagnosticSearchTerms diagnostic =
+  uniqueStrings $
+    concat
+      [ prefixedTerms
+          [ "undefined name: ",
+            "undefined type constructor: ",
+            "undefined type: ",
+            "undefined field: ",
+            "undefined constructor: ",
+            "undefined class: ",
+            "invalid pattern syntax: "
+          ]
+          (diagnosticMessage diagnostic),
+        typeMismatchTerms diagnostic,
+        unknownImportTerms diagnostic,
+        duplicateSearchTerms diagnostic
+      ]
+
+duplicateSearchTerms :: Diagnostic -> [String]
+duplicateSearchTerms diagnostic =
+  uniqueStrings $
+    concatMap indentedTerms (allDiagnosticText diagnostic)
+      ++ prefixedTerms
+        [ "Duplicated function definition:",
+          "Duplicated class definition:",
+          "Duplicated class method definition:",
+          "Duplicated type synonym definition:"
+        ]
+        (diagnosticMessage diagnostic)
+
+typeMismatchTerms :: Diagnostic -> [String]
+typeMismatchTerms diagnostic =
+  [trim (drop (length inPrefix) note) | note <- diagnosticNotes diagnostic, inPrefix `isPrefixOf` note, isSmallNote note]
+  where
+    inPrefix = "in: "
+    isSmallNote note = length note <= 80 && '\n' `notElem` note
+
+unknownImportTerms :: Diagnostic -> [String]
+unknownImportTerms diagnostic =
+  concatMap itemTerms (allDiagnosticText diagnostic)
+  where
+    itemTerms line =
+      case words (trim line) of
+        [word]
+          | "." `isInfixOf` word ->
+              [word, lastSegment word]
+        _ -> []
+
+prefixedTerms :: [String] -> String -> [String]
+prefixedTerms prefixes body =
+  [trim rest | prefix <- prefixes, Just rest <- [stripPrefix prefix body]]
+
+primaryLabelMessage :: Diagnostic -> String
+primaryLabelMessage diagnostic =
+  case diagnosticCode diagnostic of
+    Just (DiagnosticCode "SC0201") -> "expression has mismatched type"
+    Just (DiagnosticCode "SC0101") -> "unknown name"
+    Just (DiagnosticCode "SC0202") -> "unknown name"
+    _ -> diagnosticMessage diagnostic
+
+isDuplicateDiagnostic :: Diagnostic -> Bool
+isDuplicateDiagnostic diagnostic =
+  any
+    (`isInfixOf` diagnosticMessage diagnostic)
+    [ "Duplicate declarations",
+      "Duplicated ",
+      "Duplicate exported",
+      "Duplicate import",
+      "Duplicate names"
+    ]
+    || any ("Duplicate declarations" `isInfixOf`) (diagnosticNotes diagnostic)
+
+diagnosticSourcePaths :: Diagnostic -> [FilePath]
+diagnosticSourcePaths diagnostic =
+  uniqueStrings (concatMap sourcePathsFromLine (allDiagnosticText diagnostic))
+
+sourcePathsFromLine :: String -> [FilePath]
+sourcePathsFromLine line =
+  mapMaybe (`sourcePathAfterPrefix` line) prefixes
+  where
+    prefixes =
+      [ "module validation failed for ",
+        "module typecheck failed for ",
+        "source file is outside library root:"
+      ]
+
+sourcePathAfterPrefix :: String -> String -> Maybe FilePath
+sourcePathAfterPrefix prefix line = do
+  rest <- stripPrefix prefix (trim line)
+  let path = trim (takeWhile (\c -> c /= ':' && c /= '(') rest)
+  if null path then Nothing else Just path
+
+allDiagnosticText :: Diagnostic -> [String]
+allDiagnosticText diagnostic =
+  concatMap lines (diagnosticMessage diagnostic : diagnosticNotes diagnostic ++ diagnosticHelp diagnostic)
+
+indentedTerms :: String -> [String]
+indentedTerms line
+  | "  " `isPrefixOf` line =
+      case words (trim line) of
+        [term]
+          | term /= "module" -> [term, lastSegment term]
+        _ -> []
+  | otherwise = []
+
+lastSegment :: String -> String
+lastSegment =
+  reverse . takeWhile (/= '.') . reverse
+
+uniqueStrings :: [String] -> [String]
+uniqueStrings =
+  nub . filter (not . null) . map trim
+
+trim :: String -> String
+trim =
+  dropWhileEnd isSpace . dropWhile isSpace
+
+dropWhileEnd :: (a -> Bool) -> [a] -> [a]
+dropWhileEnd p =
+  reverse . dropWhile p . reverse
+
 ensureDiagnosticSources :: SourceMap -> [Diagnostic] -> IO SourceMap
 ensureDiagnosticSources =
   foldM ensureDiagnosticSource

From c90f52cae83571c1bd94aa02121c34f9abac2882 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Sun, 24 May 2026 15:45:07 +0200
Subject: [PATCH 15/35] Render match compiler warnings as diagnostics

---
 src/Solcore/Desugarer/DecisionTreeCompiler.hs | 38 +++++++++-
 src/Solcore/Pipeline/SolcorePipeline.hs       | 71 +++++++++++++++++--
 2 files changed, 101 insertions(+), 8 deletions(-)

diff --git a/src/Solcore/Desugarer/DecisionTreeCompiler.hs b/src/Solcore/Desugarer/DecisionTreeCompiler.hs
index 7756ad3de..1d2f4b02b 100644
--- a/src/Solcore/Desugarer/DecisionTreeCompiler.hs
+++ b/src/Solcore/Desugarer/DecisionTreeCompiler.hs
@@ -12,6 +12,7 @@ import Data.Map qualified as Map
 import Data.Maybe
 import Data.Ord (comparing)
 import Language.Yul (YulExp (..))
+import Solcore.Diagnostics qualified as Diag
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -30,7 +31,7 @@ matchCompiler cunit =
         if null nonExaustive
           then
             pure $ Right (unit', redundant)
-          else pure $ Left $ unlines $ map showWarning nonExaustive
+          else pure $ Left $ unlines $ map (Diag.encodeDiagnostic . warningAsErrorDiagnostic) nonExaustive
 
 -- type class for the defining the pattern matching compilation
 -- over the syntax tree
@@ -822,6 +823,41 @@ showWarnCtx ctx = "\n  in " ++ intercalate "\n  in " (reverse ctx)
 showRow :: [Pattern] -> String
 showRow = intercalate ", " . map pretty
 
+warningDiagnostic :: Warning -> Diag.Diagnostic
+warningDiagnostic (RedundantClause ctx row blk) =
+  Diag.Diagnostic
+    { Diag.diagnosticSeverity = Diag.Warning,
+      Diag.diagnosticCode = Just (Diag.DiagnosticCode "SC0301"),
+      Diag.diagnosticMessage = "redundant pattern clause",
+      Diag.diagnosticLabels = [],
+      Diag.diagnosticNotes =
+        [ "clause: " ++ pretty (row, blk)
+        ]
+          ++ warningContextNotes ctx,
+      Diag.diagnosticHelp = ["remove this clause or make an earlier pattern more specific"]
+    }
+warningDiagnostic (NonExhaustive ctx pats) =
+  Diag.Diagnostic
+    { Diag.diagnosticSeverity = Diag.Warning,
+      Diag.diagnosticCode = Just (Diag.DiagnosticCode "SC0302"),
+      Diag.diagnosticMessage = "non-exhaustive pattern match",
+      Diag.diagnosticLabels = [],
+      Diag.diagnosticNotes =
+        ["missing case: " ++ showRow (nub pats)]
+          ++ warningContextNotes ctx,
+      Diag.diagnosticHelp = ["add a clause that covers the missing case"]
+    }
+
+warningAsErrorDiagnostic :: Warning -> Diag.Diagnostic
+warningAsErrorDiagnostic warning =
+  (warningDiagnostic warning)
+    { Diag.diagnosticSeverity = Diag.Error
+    }
+
+warningContextNotes :: WarnCtx -> [String]
+warningContextNotes =
+  map ("in: " ++) . reverse
+
 -- error messages
 
 undefinedConstructorError :: Name -> CompilerM a
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 2b6521ec0..c015e22b0 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -8,7 +8,7 @@ import Data.Char (isAlpha, isAlphaNum, isSpace)
 import Data.List (isInfixOf, isPrefixOf, nub, stripPrefix)
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Maybe (mapMaybe)
+import Data.Maybe (mapMaybe, maybeToList)
 import Data.Time qualified as Time
 import Language.Hull qualified as Hull
 -- Pretty instances for MastCompUnit
@@ -18,7 +18,7 @@ import Solcore.Backend.Mast ()
 import Solcore.Backend.MastEval (defaultFuel, eliminateDeadCode, evalCompUnit)
 import Solcore.Backend.Specialise (specialiseCompUnit)
 import Solcore.Desugarer.ContractDispatch (contractDispatchTopDecls)
-import Solcore.Desugarer.DecisionTreeCompiler (matchCompiler, showWarning)
+import Solcore.Desugarer.DecisionTreeCompiler (matchCompiler, warningDiagnostic)
 import Solcore.Desugarer.FieldAccess (fieldDesugarTopDecls)
 import Solcore.Desugarer.IfDesugarer (ifDesugarer)
 import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
@@ -150,7 +150,10 @@ compileWithDiagnostics opts = runExceptT $ do
       then pure desugared
       else do
         (ast, warns) <- liftEitherDiagnosticIO sources (timeItNamed "Match compiler" $ matchCompiler desugared)
-        when (verbose && not (null warns)) $ liftIO $ mapM_ (putStrLn . showWarning) warns
+        let warningDiagnostics = map (enrichDiagnostic sources . warningDiagnostic) warns
+        when (verbose && not (null warningDiagnostics)) $
+          liftIO $
+            putStrLn (renderDiagnostics (diagnosticRenderOptions opts) sources warningDiagnostics)
         pure ast
 
   let printMatch = not noMatchCompiler && (verbose || optDumpDS opts)
@@ -243,9 +246,13 @@ compileDiagnosticErrorIO sources err = do
 
 diagnosticsFromError :: String -> [Diagnostic]
 diagnosticsFromError err =
-  case decodeDiagnostic err of
-    Just diagnostic -> [diagnostic]
-    Nothing -> [legacyDiagnostic err]
+  case mapM decodeDiagnostic (filter (not . null) (lines err)) of
+    Just diagnostics
+      | not (null diagnostics) -> diagnostics
+    _ ->
+      case decodeDiagnostic err of
+        Just diagnostic -> [diagnostic]
+        Nothing -> [legacyDiagnostic err]
 
 enrichDiagnostic :: SourceMap -> Diagnostic -> Diagnostic
 enrichDiagnostic sources diagnostic
@@ -325,6 +332,7 @@ diagnosticSearchTerms diagnostic =
           ]
           (diagnosticMessage diagnostic),
         typeMismatchTerms diagnostic,
+        warningSearchTerms diagnostic,
         unknownImportTerms diagnostic,
         duplicateSearchTerms diagnostic
       ]
@@ -343,11 +351,45 @@ duplicateSearchTerms diagnostic =
 
 typeMismatchTerms :: Diagnostic -> [String]
 typeMismatchTerms diagnostic =
-  [trim (drop (length inPrefix) note) | note <- diagnosticNotes diagnostic, inPrefix `isPrefixOf` note, isSmallNote note]
+  case diagnosticCode diagnostic of
+    Just (DiagnosticCode "SC0201") ->
+      [trim (drop (length inPrefix) note) | note <- diagnosticNotes diagnostic, inPrefix `isPrefixOf` note, isSmallNote note]
+    _ -> []
   where
     inPrefix = "in: "
     isSmallNote note = length note <= 80 && '\n' `notElem` note
 
+warningSearchTerms :: Diagnostic -> [String]
+warningSearchTerms diagnostic =
+  case diagnosticCode diagnostic of
+    Just (DiagnosticCode "SC0301") ->
+      uniqueStrings (clauseSearchTerms diagnostic ++ matchContextTerms diagnostic)
+    Just (DiagnosticCode "SC0302") ->
+      uniqueStrings (matchContextTerms diagnostic)
+    _ -> []
+
+clauseSearchTerms :: Diagnostic -> [String]
+clauseSearchTerms diagnostic =
+  concatMap clauseTerms (diagnosticNotes diagnostic)
+  where
+    clauseTerms note = do
+      rest <- maybeToList (stripPrefix "clause: " note)
+      let clauseLine = takeWhile (/= '\n') rest
+          rowText =
+            trim $
+              takeWhile (/= '=') $
+                dropWhile (== '|') $
+                  trim (stripPrettyTypeAnnotations clauseLine)
+      rowText : splitCommaTerms rowText
+
+matchContextTerms :: Diagnostic -> [String]
+matchContextTerms diagnostic =
+  concatMap matchTerm (diagnosticNotes diagnostic)
+  where
+    matchTerm note
+      | "in: match" `isPrefixOf` note = ["match"]
+      | otherwise = []
+
 unknownImportTerms :: Diagnostic -> [String]
 unknownImportTerms diagnostic =
   concatMap itemTerms (allDiagnosticText diagnostic)
@@ -369,6 +411,8 @@ primaryLabelMessage diagnostic =
     Just (DiagnosticCode "SC0201") -> "expression has mismatched type"
     Just (DiagnosticCode "SC0101") -> "unknown name"
     Just (DiagnosticCode "SC0202") -> "unknown name"
+    Just (DiagnosticCode "SC0301") -> "redundant clause"
+    Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
     _ -> diagnosticMessage diagnostic
 
 isDuplicateDiagnostic :: Diagnostic -> Bool
@@ -420,6 +464,19 @@ lastSegment :: String -> String
 lastSegment =
   reverse . takeWhile (/= '.') . reverse
 
+splitCommaTerms :: String -> [String]
+splitCommaTerms raw =
+  case break (== ',') raw of
+    (term, []) -> [trim term]
+    (term, _ : rest) -> trim term : splitCommaTerms rest
+
+stripPrettyTypeAnnotations :: String -> String
+stripPrettyTypeAnnotations [] = []
+stripPrettyTypeAnnotations ('<' : rest) =
+  stripPrettyTypeAnnotations (drop 1 (dropWhile (/= '>') rest))
+stripPrettyTypeAnnotations (c : rest) =
+  c : stripPrettyTypeAnnotations rest
+
 uniqueStrings :: [String] -> [String]
 uniqueStrings =
   nub . filter (not . null) . map trim

From 221e75445bbc83bffe8f3c56bc7defc119f9a1a9 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Sun, 24 May 2026 19:34:58 +0200
Subject: [PATCH 16/35] Honor diagnostic render options

---
 src/Solcore/Diagnostics.hs | 206 +++++++++++++++++++++++++++++--------
 1 file changed, 165 insertions(+), 41 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 73af86516..d516193b1 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -33,7 +33,7 @@ where
 import Data.List (foldl', isPrefixOf, stripPrefix, tails)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
-import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty, pretty, vsep)
+import Prettyprinter (Doc, LayoutOptions (..), PageWidth (..), layoutPretty, pretty, vsep)
 import Prettyprinter.Render.String (renderString)
 import Text.Read (readMaybe)
 
@@ -235,14 +235,20 @@ renderDiagnostics opts sources diagnostics =
 renderDiagnostic :: DiagnosticRenderOptions -> SourceMap -> Diagnostic -> String
 renderDiagnostic opts sources diagnostic =
   case diagnosticFormat opts of
-    DiagnosticShort -> renderShortDiagnostic diagnostic
-    DiagnosticHuman -> renderDoc (vsep (map pretty (humanDiagnosticLines sources diagnostic)))
+    DiagnosticShort -> renderShortDiagnostic opts diagnostic
+    DiagnosticHuman -> renderDoc opts (vsep (map pretty (humanDiagnosticLines opts sources diagnostic)))
 
-renderDoc :: Doc ann -> String
-renderDoc = renderString . layoutPretty defaultLayoutOptions
+renderDoc :: DiagnosticRenderOptions -> Doc ann -> String
+renderDoc opts =
+  renderString . layoutPretty layoutOptions
+  where
+    layoutOptions =
+      LayoutOptions
+        { layoutPageWidth = AvailablePerLine (max 20 (diagnosticWidth opts)) 1.0
+        }
 
-renderShortDiagnostic :: Diagnostic -> String
-renderShortDiagnostic diagnostic =
+renderShortDiagnostic :: DiagnosticRenderOptions -> Diagnostic -> String
+renderShortDiagnostic opts diagnostic =
   case diagnosticPrimarySpan diagnostic of
     Just sourceSpan ->
       spanFile sourceSpan
@@ -251,23 +257,24 @@ renderShortDiagnostic diagnostic =
         ++ ":"
         ++ show (spanStartColumn sourceSpan)
         ++ ": "
-        ++ diagnosticHeader diagnostic
-    Nothing -> diagnosticHeader diagnostic
-
-humanDiagnosticLines :: SourceMap -> Diagnostic -> [String]
-humanDiagnosticLines sources diagnostic =
-  [diagnosticHeader diagnostic]
-    ++ locationLines diagnostic
-    ++ concatMap (labelSnippetLines sources) (diagnosticLabels diagnostic)
-    ++ map ("note: " ++) (diagnosticNotes diagnostic)
-    ++ map ("help: " ++) (diagnosticHelp diagnostic)
-
-diagnosticHeader :: Diagnostic -> String
-diagnosticHeader diagnostic =
-  severityName (diagnosticSeverity diagnostic)
-    ++ codeText (diagnosticCode diagnostic)
+        ++ diagnosticHeader opts diagnostic
+    Nothing -> diagnosticHeader opts diagnostic
+
+humanDiagnosticLines :: DiagnosticRenderOptions -> SourceMap -> Diagnostic -> [String]
+humanDiagnosticLines opts sources diagnostic =
+  [diagnosticHeader opts diagnostic]
+    ++ locationLines opts diagnostic
+    ++ concatMap (labelSnippetLines opts (diagnosticSeverity diagnostic) sources) (diagnosticLabels diagnostic)
+    ++ concatMap (prefixedWrappedLines opts "note: ") (diagnosticNotes diagnostic)
+    ++ concatMap (prefixedWrappedLines opts "help: ") (diagnosticHelp diagnostic)
+
+diagnosticHeader :: DiagnosticRenderOptions -> Diagnostic -> String
+diagnosticHeader opts diagnostic =
+  colorize opts (severityAnsi (diagnosticSeverity diagnostic)) header
     ++ ": "
     ++ diagnosticMessage diagnostic
+  where
+    header = severityName (diagnosticSeverity diagnostic) ++ codeText (diagnosticCode diagnostic)
 
 severityName :: Severity -> String
 severityName Error = "error"
@@ -277,29 +284,33 @@ codeText :: Maybe DiagnosticCode -> String
 codeText Nothing = ""
 codeText (Just (DiagnosticCode code)) = "[" ++ code ++ "]"
 
-locationLines :: Diagnostic -> [String]
-locationLines diagnostic =
+locationLines :: DiagnosticRenderOptions -> Diagnostic -> [String]
+locationLines opts diagnostic =
   case diagnosticPrimarySpan diagnostic of
     Nothing -> []
     Just sourceSpan ->
-      [ "  --> "
-          ++ spanFile sourceSpan
-          ++ ":"
-          ++ show (spanStartLine sourceSpan)
-          ++ ":"
-          ++ show (spanStartColumn sourceSpan)
+      [ colorize
+          opts
+          locationAnsi
+          ( locationArrow opts
+              ++ spanFile sourceSpan
+              ++ ":"
+              ++ show (spanStartLine sourceSpan)
+              ++ ":"
+              ++ show (spanStartColumn sourceSpan)
+          )
       ]
 
-labelSnippetLines :: SourceMap -> Label -> [String]
-labelSnippetLines (SourceMap sources) label =
+labelSnippetLines :: DiagnosticRenderOptions -> Severity -> SourceMap -> Label -> [String]
+labelSnippetLines opts severity (SourceMap sources) label =
   case Map.lookup (spanFile sourceSpan) sources of
     Nothing -> []
-    Just source -> sourceLabelSnippet source label
+    Just source -> sourceLabelSnippet opts severity source label
   where
     sourceSpan = labelSpan label
 
-sourceLabelSnippet :: SourceFile -> Label -> [String]
-sourceLabelSnippet source label =
+sourceLabelSnippet :: DiagnosticRenderOptions -> Severity -> SourceFile -> Label -> [String]
+sourceLabelSnippet opts severity source label =
   [gutter]
     ++ concatMap renderLine [firstLine .. lastLine]
   where
@@ -307,17 +318,27 @@ sourceLabelSnippet source label =
     firstLine = max 1 (spanStartLine sourceSpan)
     lastLine = max firstLine (spanEndLine sourceSpan)
     lineNoWidth = length (show lastLine)
-    gutter = replicate lineNoWidth ' ' ++ " |"
+    gutter = gutterLine opts lineNoWidth
     marker = case labelStyle label of
       Primary -> '^'
       Secondary -> '-'
+    markerAnsi = case labelStyle label of
+      Primary -> severityAnsi severity
+      Secondary -> secondaryAnsi
 
     renderLine lineNo =
       let lineText = sourceLine source lineNo
+          displayLine = expandTabs tabWidth lineText
           underline = underlineForLine sourceSpan lineNo lineText marker
           message = if lineNo == firstLine then maybe "" (" " ++) (labelMessage label) else ""
-       in [ padLeft lineNoWidth (show lineNo) ++ " | " ++ lineText,
-            replicate lineNoWidth ' ' ++ " | " ++ underline ++ message
+       in [ colorize opts lineNumberAnsi (padLeft lineNoWidth (show lineNo))
+              ++ gutterSeparator opts
+              ++ " "
+              ++ displayLine,
+            gutterLine opts lineNoWidth
+              ++ " "
+              ++ colorize opts markerAnsi underline
+              ++ message
           ]
 
 underlineForLine :: SourceSpan -> Int -> String -> Char -> String
@@ -325,11 +346,11 @@ underlineForLine sourceSpan lineNo lineText marker =
   replicate (startCol - 1) ' ' ++ replicate markerWidth marker
   where
     startCol
-      | lineNo == spanStartLine sourceSpan = max 1 (spanStartColumn sourceSpan)
+      | lineNo == spanStartLine sourceSpan = sourceColumnToVisual lineText (max 1 (spanStartColumn sourceSpan))
       | otherwise = 1
     endCol
-      | lineNo == spanEndLine sourceSpan = max startCol (spanEndColumn sourceSpan)
-      | otherwise = max startCol (length lineText + 1)
+      | lineNo == spanEndLine sourceSpan = max startCol (sourceColumnToVisual lineText (max 1 (spanEndColumn sourceSpan)))
+      | otherwise = max startCol (visualLength lineText + 1)
     markerWidth = max 1 (endCol - startCol)
 
 sourceLine :: SourceFile -> Int -> String
@@ -355,6 +376,109 @@ padLeft :: Int -> String -> String
 padLeft width str =
   replicate (max 0 (width - length str)) ' ' ++ str
 
+prefixedWrappedLines :: DiagnosticRenderOptions -> String -> String -> [String]
+prefixedWrappedLines opts prefix body =
+  case linesOrBlank body of
+    [] -> [prefix]
+    firstLine : restLines ->
+      wrapPhysicalLine prefix firstLine
+        ++ concatMap (wrapPhysicalLine continuationPrefix) restLines
+  where
+    continuationPrefix = replicate (length prefix) ' '
+    wrapPhysicalLine linePrefix line =
+      case wrapWords (max 20 (diagnosticWidth opts)) linePrefix line of
+        [] -> [linePrefix]
+        wrapped -> wrapped
+
+wrapWords :: Int -> String -> String -> [String]
+wrapWords width prefix raw =
+  case words raw of
+    [] -> [prefix]
+    word : rest -> go [prefix ++ word] rest
+  where
+    continuationPrefix = replicate (length prefix) ' '
+    go acc [] = reverse acc
+    go [] _ = []
+    go (line : acc) (word : rest)
+      | length line + 1 + length word <= width =
+          go ((line ++ " " ++ word) : acc) rest
+      | length word + length continuationPrefix <= width =
+          go ((continuationPrefix ++ word) : line : acc) rest
+      | otherwise =
+          go ((continuationPrefix ++ word) : line : acc) rest
+
+linesOrBlank :: String -> [String]
+linesOrBlank "" = [""]
+linesOrBlank body = lines body
+
+gutterLine :: DiagnosticRenderOptions -> Int -> String
+gutterLine opts lineNoWidth =
+  replicate lineNoWidth ' ' ++ gutterSeparator opts
+
+gutterSeparator :: DiagnosticRenderOptions -> String
+gutterSeparator opts
+  | useUnicode opts = " │"
+  | otherwise = " |"
+
+locationArrow :: DiagnosticRenderOptions -> String
+locationArrow opts
+  | useUnicode opts = "  ──> "
+  | otherwise = "  --> "
+
+useUnicode :: DiagnosticRenderOptions -> Bool
+useUnicode opts =
+  case diagnosticUnicode opts of
+    UnicodeAlways -> True
+    UnicodeAuto -> False
+    UnicodeNever -> False
+
+useColor :: DiagnosticRenderOptions -> Bool
+useColor opts =
+  case diagnosticColor opts of
+    ColorAlways -> True
+    ColorAuto -> False
+    ColorNever -> False
+
+colorize :: DiagnosticRenderOptions -> String -> String -> String
+colorize opts ansi body
+  | useColor opts = "\ESC[" ++ ansi ++ "m" ++ body ++ "\ESC[0m"
+  | otherwise = body
+
+severityAnsi :: Severity -> String
+severityAnsi Error = "1;31"
+severityAnsi Warning = "1;33"
+
+locationAnsi :: String
+locationAnsi = "1;36"
+
+lineNumberAnsi :: String
+lineNumberAnsi = "1;34"
+
+secondaryAnsi :: String
+secondaryAnsi = "1;34"
+
+tabWidth :: Int
+tabWidth = 4
+
+expandTabs :: Int -> String -> String
+expandTabs width =
+  go 1
+  where
+    go _ [] = []
+    go column ('\t' : rest) =
+      let spaces = width - ((column - 1) `mod` width)
+       in replicate spaces ' ' ++ go (column + spaces) rest
+    go column (c : rest) =
+      c : go (column + 1) rest
+
+visualLength :: String -> Int
+visualLength =
+  length . expandTabs tabWidth
+
+sourceColumnToVisual :: String -> Int -> Int
+sourceColumnToVisual lineText sourceColumn =
+  visualLength (take (sourceColumn - 1) lineText) + 1
+
 joinWithBlankLines :: [String] -> String
 joinWithBlankLines [] = ""
 joinWithBlankLines [x] = x

From ea89a3ad5319b12f716a081c50322af0c5603631 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Sun, 24 May 2026 22:18:35 +0200
Subject: [PATCH 17/35] Add diagnostic renderer snapshots

---
 sol-core.cabal          |   1 +
 test/DiagnosticTests.hs | 120 ++++++++++++++++++++++++++++++++++++++++
 test/Main.hs            |   2 +
 3 files changed, 123 insertions(+)
 create mode 100644 test/DiagnosticTests.hs

diff --git a/sol-core.cabal b/sol-core.cabal
index bfa283896..e92bff360 100644
--- a/sol-core.cabal
+++ b/sol-core.cabal
@@ -169,6 +169,7 @@ test-suite sol-core-tests
   -- cabal-fmt: expand test -Main
   other-modules:
     Cases
+    DiagnosticTests
     HullCases
     MatchCompilerTests
     ModuleTypeCheckTests
diff --git a/test/DiagnosticTests.hs b/test/DiagnosticTests.hs
new file mode 100644
index 000000000..3c4e3ae36
--- /dev/null
+++ b/test/DiagnosticTests.hs
@@ -0,0 +1,120 @@
+module DiagnosticTests where
+
+import Solcore.Diagnostics
+import Test.Tasty
+import Test.Tasty.HUnit
+
+diagnosticTests :: TestTree
+diagnosticTests =
+  testGroup
+    "Diagnostics"
+    [ testCase "human diagnostic snapshot" test_humanDiagnosticSnapshot,
+      testCase "short diagnostic snapshot" test_shortDiagnosticSnapshot,
+      testCase "unicode diagnostic snapshot" test_unicodeDiagnosticSnapshot,
+      testCase "diagnostic notes wrap to configured width" test_diagnosticWidthWrapsNotes,
+      testCase "color always emits ANSI styles" test_colorAlwaysEmitsAnsi
+    ]
+
+test_humanDiagnosticSnapshot :: Assertion
+test_humanDiagnosticSnapshot =
+  renderDiagnostic defaultDiagnosticRenderOptions sourceMap undefinedNameDiagnostic
+    @?= unlinesNoTrailing
+      [ "error[SC0101]: undefined name `missing`",
+        "  --> main.solc:2:10",
+        "  |",
+        "2 |   return missing;",
+        "  |          ^^^^^^^ unknown name",
+        "note: names must be in scope",
+        "help: import it explicitly"
+      ]
+
+test_shortDiagnosticSnapshot :: Assertion
+test_shortDiagnosticSnapshot =
+  renderDiagnostic
+    defaultDiagnosticRenderOptions {diagnosticFormat = DiagnosticShort}
+    sourceMap
+    undefinedNameDiagnostic
+    @?= "main.solc:2:10: error[SC0101]: undefined name `missing`"
+
+test_unicodeDiagnosticSnapshot :: Assertion
+test_unicodeDiagnosticSnapshot =
+  renderDiagnostic
+    defaultDiagnosticRenderOptions {diagnosticUnicode = UnicodeAlways}
+    sourceMap
+    undefinedNameDiagnostic
+    @?= unlinesNoTrailing
+      [ "error[SC0101]: undefined name `missing`",
+        "  ──> main.solc:2:10",
+        "  │",
+        "2 │   return missing;",
+        "  │          ^^^^^^^ unknown name",
+        "note: names must be in scope",
+        "help: import it explicitly"
+      ]
+
+test_diagnosticWidthWrapsNotes :: Assertion
+test_diagnosticWidthWrapsNotes =
+  renderDiagnostic
+    defaultDiagnosticRenderOptions {diagnosticWidth = 24}
+    sourceMap
+    ( undefinedNameDiagnostic
+        { diagnosticNotes = ["alpha beta gamma delta epsilon"],
+          diagnosticHelp = []
+        }
+    )
+    @?= unlinesNoTrailing
+      [ "error[SC0101]: undefined name `missing`",
+        "  --> main.solc:2:10",
+        "  |",
+        "2 |   return missing;",
+        "  |          ^^^^^^^ unknown name",
+        "note: alpha beta gamma",
+        "      delta epsilon"
+      ]
+
+test_colorAlwaysEmitsAnsi :: Assertion
+test_colorAlwaysEmitsAnsi =
+  renderDiagnostic
+    defaultDiagnosticRenderOptions {diagnosticColor = ColorAlways, diagnosticFormat = DiagnosticShort}
+    sourceMap
+    undefinedNameDiagnostic
+    @?= "main.solc:2:10: \ESC[1;31merror[SC0101]\ESC[0m: undefined name `missing`"
+
+sourceMap :: SourceMap
+sourceMap =
+  sourceMapFromFiles [sourceFile]
+
+sourceFile :: SourceFile
+sourceFile =
+  makeSourceFile "main.solc" (unlines ["function main() -> word {", "  return missing;", "}"])
+
+undefinedNameDiagnostic :: Diagnostic
+undefinedNameDiagnostic =
+  Diagnostic
+    { diagnosticSeverity = Error,
+      diagnosticCode = Just (DiagnosticCode "SC0101"),
+      diagnosticMessage = "undefined name `missing`",
+      diagnosticLabels =
+        [ Label
+            { labelSpan =
+                SourceSpan
+                  { spanFile = "main.solc",
+                    spanStartByte = 34,
+                    spanEndByte = 41,
+                    spanStartLine = 2,
+                    spanStartColumn = 10,
+                    spanEndLine = 2,
+                    spanEndColumn = 17
+                  },
+              labelStyle = Primary,
+              labelMessage = Just "unknown name"
+            }
+        ],
+      diagnosticNotes = ["names must be in scope"],
+      diagnosticHelp = ["import it explicitly"]
+    }
+
+unlinesNoTrailing :: [String] -> String
+unlinesNoTrailing [] = ""
+unlinesNoTrailing [line] = line
+unlinesNoTrailing (line : rest) = line ++ "\n" ++ unlinesNoTrailing rest
diff --git a/test/Main.hs b/test/Main.hs
index 77ba788ae..ad12d77b2 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,6 +1,7 @@
 module Main where
 
 import Cases
+import DiagnosticTests
 import HullCases
 import MatchCompilerTests
 import ModuleTypeCheckTests
@@ -18,6 +19,7 @@ tests =
       pragmas,
       spec,
       std,
+      diagnosticTests,
       imports,
       moduleTypeCheckTests,
       dispatches,

From f002c07a0dd2fed8d35e74263b4b4925946c6e23 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 10:52:16 +0200
Subject: [PATCH 18/35] Add module diagnostics codes

---
 src/Solcore/Frontend/Module/Loader.hs         | 144 ++++++++++--------
 src/Solcore/Frontend/Syntax/NameResolution.hs |  33 ++--
 src/Solcore/Pipeline/SolcorePipeline.hs       |   8 +-
 3 files changed, 109 insertions(+), 76 deletions(-)

diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 32dea3ccf..617c4baa4 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -20,7 +20,7 @@ import Data.Map qualified as Map
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Solcore.Diagnostics (SourceFile, SourceMap, makeSourceFile, sourceMapFromFiles)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), SourceFile, SourceMap, encodeDiagnostic, makeSourceFile, sourceMapFromFiles)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
 import Solcore.Frontend.Syntax.Name
@@ -242,17 +242,23 @@ rootForLibrary cfg (Mod.ExternalLibrary libName) =
   case Map.lookup libName (externalRoots cfg) of
     Just root -> Right root
     Nothing ->
-      Left ("external library root is not configured: @" ++ show libName)
+      Left $
+        loaderDiagnostic
+          "SC0118"
+          ("external library root is not configured: @" ++ show libName)
+          []
+          ["pass --external-lib " ++ show libName ++ "=PATH"]
 
 moduleIdForPath :: Mod.LibraryId -> FilePath -> FilePath -> ExceptT String IO Mod.ModuleId
 moduleIdForPath libId root filePath =
   case makeRelativeToRoot root filePath of
     Nothing ->
       throwError $
-        "source file is outside library root:\n  "
-          ++ filePath
-          ++ "\n  root: "
-          ++ root
+        loaderDiagnostic
+          "SC0119"
+          "source file is outside library root"
+          [filePath, "root: " ++ root]
+          ["choose --root so it contains the source file"]
     Just relPath ->
       case splitDirectories (dropExtension relPath) of
         [] ->
@@ -515,10 +521,13 @@ ensureImportItemsExist graph importPairs = do
     ([], []) -> Right ()
     (selectedXs, hiddenXs) ->
       Left $
-        unlines
-          ( (if null selectedXs then [] else ["Unknown selected imports:", unlines selectedXs])
-              ++ (if null hiddenXs then [] else ["Unknown hidden imports:", unlines hiddenXs])
+        loaderDiagnostic
+          "SC0110"
+          "unknown import item"
+          ( (if null selectedXs then [] else "unknown selected imports:" : selectedXs)
+              ++ (if null hiddenXs then [] else "unknown hidden imports:" : hiddenXs)
           )
+          ["check the imported module's exported names"]
   where
     unknowns (ImportOnly importPath items, modulePath) = do
       available <- importableNamesForModule graph modulePath
@@ -831,25 +840,26 @@ selectRemoteExportRefs sourcePath exportPath (SelectExportItems items) available
         Nothing
           | shouldValidate ->
               Left $
-                unlines
-                  [ "Unknown re-exported constructors:",
-                    "  " ++ sourcePath,
-                    "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName
-                  ]
+                loaderDiagnostic
+                  "SC0115"
+                  "unknown re-exported constructor"
+                  [sourcePath, "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName]
+                  ["re-export constructors provided by the target module"]
           | otherwise ->
               pure []
         Just ref
           | shouldValidate,
             missingVisibleConstructors constructorSelector ref /= [] ->
               Left $
-                unlines
-                  [ "Unknown re-exported constructors:",
-                    "  " ++ sourcePath,
-                    unlines
-                      [ "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName ++ "." ++ show constructorName
-                        | constructorName <- missingVisibleConstructors constructorSelector ref
-                      ]
-                  ]
+                loaderDiagnostic
+                  "SC0115"
+                  "unknown re-exported constructor"
+                  ( sourcePath
+                      : [ "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName ++ "." ++ show constructorName
+                          | constructorName <- missingVisibleConstructors constructorSelector ref
+                        ]
+                  )
+                  ["re-export constructors provided by the target module"]
           | otherwise ->
               pure [ref]
 
@@ -934,11 +944,11 @@ ensureNoDuplicateExportedItems modulePath itemRefs =
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Duplicate exported item names:",
-            "  " ++ modulePath,
-            unlines (map (\n -> "  " ++ show n) xs)
-          ]
+        loaderDiagnostic
+          "SC0111"
+          "duplicate exported item names"
+          (("module: " ++ modulePath) : map (\n -> "  " ++ show n) xs)
+          ["export each item name from only one origin"]
   where
     conflicts =
       [ itemName
@@ -953,11 +963,11 @@ ensureNoDuplicateExportedModules modulePath moduleBindings =
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Duplicate exported module names:",
-            "  " ++ modulePath,
-            unlines (map (\n -> "  " ++ show n) xs)
-          ]
+        loaderDiagnostic
+          "SC0112"
+          "duplicate exported module names"
+          (("module: " ++ modulePath) : map (\n -> "  " ++ show n) xs)
+          ["export each module name from only one origin"]
   where
     conflicts =
       [ bindingName
@@ -971,22 +981,22 @@ ensureLocalExportExists sourcePath ds itemName
   | itemName `elem` availableExportNames ds = Right ()
   | otherwise =
       Left $
-        unlines
-          [ "Unknown export:",
-            "  " ++ sourcePath,
-            "  " ++ show itemName
-          ]
+        loaderDiagnostic
+          "SC0113"
+          "unknown export"
+          [sourcePath, show itemName]
+          ["export a name defined in this module or re-export it from another module"]
 
 ensureLocalConstructorExportExists :: FilePath -> [TopDecl] -> Name -> ConstructorSelector -> Either String ()
 ensureLocalConstructorExportExists sourcePath topLevelDecls typeName constructorSelector =
   case findLocalDataType typeName topLevelDecls of
     Nothing ->
       Left $
-        unlines
-          [ "Unknown export:",
-            "  " ++ sourcePath,
-            "  " ++ show typeName
-          ]
+        loaderDiagnostic
+          "SC0113"
+          "unknown export"
+          [sourcePath, show typeName]
+          ["export a type defined in this module or re-export it from another module"]
     Just (DataTy _ _ constrs) ->
       ensureConstructorSelectorExists sourcePath typeName constructorSelector constrs
 
@@ -1008,11 +1018,11 @@ ensureConstructorSelectorExists sourcePath typeName (SelectConstructors construc
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Unknown exported constructors:",
-            "  " ++ sourcePath,
-            unlines ["  " ++ show typeName ++ "." ++ show constructorName | constructorName <- xs]
-          ]
+        loaderDiagnostic
+          "SC0114"
+          "unknown exported constructor"
+          (sourcePath : ["  " ++ show typeName ++ "." ++ show constructorName | constructorName <- xs])
+          ["select constructors defined by the exported type"]
   where
     availableNames = uniqueNames (map (constructorLeafName . constrName) constrs)
     missing = filter (`notElem` availableNames) constructorNames
@@ -1035,11 +1045,11 @@ ensureRemoteExportsExist sourcePath exportPath names availableNames =
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Unknown re-exported names:",
-            "  " ++ sourcePath,
-            unlines [formatMissing exportPath missingName | missingName <- xs]
-          ]
+        loaderDiagnostic
+          "SC0115"
+          "unknown re-exported name"
+          (sourcePath : [formatMissing exportPath missingName | missingName <- xs])
+          ["re-export a name provided by the target module"]
   where
     missing = filter (`notElem` availableNames) names
 
@@ -1957,10 +1967,11 @@ ensureNoDuplicateModuleQualifiers (CompUnit imps _) =
     [] -> Right ()
     qs ->
       Left $
-        unlines
-          [ "Duplicate import qualifiers:",
-            unlines (map (\q -> "  " ++ show q) qs)
-          ]
+        loaderDiagnostic
+          "SC0116"
+          "duplicate import qualifier"
+          (map (\q -> "  " ++ show q) qs)
+          ["use an explicit alias to disambiguate one of the imports"]
   where
     duplicates = duplicateNames (mapMaybe moduleQualifier imps)
 
@@ -1991,10 +2002,11 @@ ensureNoDuplicateSelectedItems (CompUnit imps _) =
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Duplicate names in selective import:",
-            unlines xs
-          ]
+        loaderDiagnostic
+          "SC0117"
+          "duplicate name in selective import"
+          xs
+          ["list each selected or hidden name only once"]
   where
     duplicateItems (ImportOnly moduleName selector) =
       [ "  " ++ Mod.modulePathDisplay moduleName ++ "." ++ show item
@@ -2005,6 +2017,18 @@ ensureNoDuplicateSelectedItems (CompUnit imps _) =
            ]
     duplicateItems _ = []
 
+loaderDiagnostic :: String -> String -> [String] -> [String] -> String
+loaderDiagnostic code message notes help =
+  encodeDiagnostic
+    Diagnostic
+      { diagnosticSeverity = Error,
+        diagnosticCode = Just (DiagnosticCode code),
+        diagnosticMessage = message,
+        diagnosticLabels = [],
+        diagnosticNotes = notes,
+        diagnosticHelp = help
+      }
+
 explicitSelectorNames :: ItemSelector -> [Name]
 explicitSelectorNames (SelectItems items _) =
   [itemName | SelectItem itemName <- items]
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 30accb0e5..51e4a71bd 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -142,11 +142,11 @@ ensureNoDuplicateNamesIn ctx ns names =
     [] -> pure ()
     xs ->
       Left $
-        unlines
-          [ "Duplicate declarations in " ++ ns ++ ":",
-            "  " ++ ctx,
-            unlines (map (\n -> "  " ++ pretty n) xs)
-          ]
+        diagnosticString
+          "SC0108"
+          ("duplicate declarations in " ++ ns)
+          (("context: " ++ ctx) : map (\n -> "  " ++ pretty n) xs)
+          ["rename or remove the duplicate declaration"]
   where
     counts :: Map Name Int
     counts = Map.fromListWith (+) [(n, 1) | n <- names]
@@ -1136,13 +1136,16 @@ invalidPatternSyntax p =
 
 diagnosticError :: String -> String -> [String] -> [String] -> ResolveM a
 diagnosticError code message notes help =
-  throwError $
-    encodeDiagnostic
-      Diagnostic
-        { diagnosticSeverity = Error,
-          diagnosticCode = Just (DiagnosticCode code),
-          diagnosticMessage = message,
-          diagnosticLabels = [],
-          diagnosticNotes = notes,
-          diagnosticHelp = help
-        }
+  throwError $ diagnosticString code message notes help
+
+diagnosticString :: String -> String -> [String] -> [String] -> String
+diagnosticString code message notes help =
+  encodeDiagnostic
+    Diagnostic
+      { diagnosticSeverity = Error,
+        diagnosticCode = Just (DiagnosticCode code),
+        diagnosticMessage = message,
+        diagnosticLabels = [],
+        diagnosticNotes = notes,
+        diagnosticHelp = help
+      }
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index c015e22b0..fa2b4f7c5 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -420,12 +420,18 @@ isDuplicateDiagnostic diagnostic =
   any
     (`isInfixOf` diagnosticMessage diagnostic)
     [ "Duplicate declarations",
+      "duplicate declarations",
       "Duplicated ",
+      "duplicate ",
       "Duplicate exported",
+      "duplicate exported",
       "Duplicate import",
-      "Duplicate names"
+      "duplicate import",
+      "Duplicate names",
+      "duplicate name"
     ]
     || any ("Duplicate declarations" `isInfixOf`) (diagnosticNotes diagnostic)
+    || any ("duplicate declarations" `isInfixOf`) (diagnosticNotes diagnostic)
 
 diagnosticSourcePaths :: Diagnostic -> [FilePath]
 diagnosticSourcePaths diagnostic =

From 855f027df92e0c70d0325b24937dc1426344bdb1 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 13:26:49 +0200
Subject: [PATCH 19/35] Add diagnostic CLI snapshots

---
 sol-core.cabal                             |   2 +
 test/DiagnosticCliTests.hs                 | 128 +++++++++++++++++++++
 test/Main.hs                               |   2 +
 test/diagnostics/duplicate-definition.solc |   3 +
 test/diagnostics/parse-error.solc          |   1 +
 test/diagnostics/type-mismatch.solc        |   1 +
 test/diagnostics/undefined-name.solc       |   1 +
 7 files changed, 138 insertions(+)
 create mode 100644 test/DiagnosticCliTests.hs
 create mode 100644 test/diagnostics/duplicate-definition.solc
 create mode 100644 test/diagnostics/parse-error.solc
 create mode 100644 test/diagnostics/type-mismatch.solc
 create mode 100644 test/diagnostics/undefined-name.solc

diff --git a/sol-core.cabal b/sol-core.cabal
index e92bff360..9dafd4eb7 100644
--- a/sol-core.cabal
+++ b/sol-core.cabal
@@ -169,6 +169,7 @@ test-suite sol-core-tests
   -- cabal-fmt: expand test -Main
   other-modules:
     Cases
+    DiagnosticCliTests
     DiagnosticTests
     HullCases
     MatchCompilerTests
@@ -181,6 +182,7 @@ test-suite sol-core-tests
     , tasty-expected-failure
     , tasty-hunit
     , HUnit
+    , process
 
   build-tool-depends: sol-core:sol-core, sol-core:yule
 
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
new file mode 100644
index 000000000..da7cf5eb3
--- /dev/null
+++ b/test/DiagnosticCliTests.hs
@@ -0,0 +1,128 @@
+module DiagnosticCliTests where
+
+import Data.List (isSuffixOf, stripPrefix)
+import System.Directory (getCurrentDirectory)
+import System.Exit (ExitCode (..))
+import System.Process (readProcessWithExitCode)
+import Test.Tasty
+import Test.Tasty.HUnit
+
+diagnosticCliTests :: TestTree
+diagnosticCliTests =
+  testGroup
+    "Diagnostic CLI snapshots"
+    [ testCase "parser error" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/parse-error.solc", "--no-specialise"]
+          [ "error[SC0001]: parse error: unexpected TArrow",
+            "  --> <cwd>/test/diagnostics/parse-error.solc:1:16",
+            "  |",
+            "1 | function main( -> word { return 0; }",
+            "  |                ^^ unexpected token"
+          ],
+      testCase "undefined name" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/undefined-name.solc", "--no-specialise"]
+          [ "error[SC0101]: undefined name: missing",
+            "  --> <cwd>/test/diagnostics/undefined-name.solc:1:34",
+            "  |",
+            "1 | function main() -> word { return missing; }",
+            "  |                                  ^^^^^^^ unknown name",
+            "note: in: return missing ;",
+            "note: in: function main () -> word {",
+            "      return missing ;",
+            "      }",
+            "note: in: function main () -> word {",
+            "      return missing ;",
+            "      }",
+            "note: module validation failed for",
+            "      <cwd>/test/diagnostics/undefined-name.solc"
+          ],
+      testCase "duplicate definition" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/duplicate-definition.solc", "--no-specialise"]
+          [ "error[SC0108]: duplicate declarations in term namespace",
+            "  --> <cwd>/test/diagnostics/duplicate-definition.solc:2:10",
+            "  |",
+            "1 | function foo() -> word { return 1; }",
+            "  |          --- previous definition",
+            "  |",
+            "2 | function foo() -> word { return 2; }",
+            "  |          ^^^ duplicate definition",
+            "note: context: module",
+            "note: foo",
+            "note: module validation failed for",
+            "      <cwd>/test/diagnostics/duplicate-definition.solc",
+            "help: rename or remove the duplicate declaration"
+          ],
+      testCase "type mismatch" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/type-mismatch.solc", "--no-specialise"]
+          [ "error[SC0201]: types do not unify: bool and word",
+            "  --> <cwd>/test/diagnostics/type-mismatch.solc:1:34",
+            "  |",
+            "1 | function main() -> word { return true; }",
+            "  |                                  ^^^^ expression has mismatched type",
+            "note: left type: bool",
+            "note: right type: word",
+            "note: in: true",
+            "note: in: function main () -> word {",
+            "      return true;",
+            "      }",
+            "note: module typecheck failed for",
+            "      <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
+          ],
+      testCase "import error" $
+        expectFailure
+          ["--root", "test/imports", "--file", "test/imports/select_unknown.solc", "--no-specialise"]
+          [ "error[SC0110]: unknown import item",
+            "  --> <cwd>/test/imports/select_unknown.solc:1:19",
+            "  |",
+            "1 | import selectlib.{missing};",
+            "  |                   ^^^^^^^ unknown import item",
+            "note: unknown selected imports:",
+            "note: selectlib.missing",
+            "help: check the imported module's exported names"
+          ],
+      testCase "short output" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/undefined-name.solc", "--no-specialise", "--diagnostic-format", "short"]
+          ["<cwd>/test/diagnostics/undefined-name.solc:1:34: error[SC0101]: undefined name: missing"]
+    ]
+
+expectFailure :: [String] -> [String] -> Assertion
+expectFailure args expectedLines = do
+  (exitCode, stdout, stderr) <- readProcessWithExitCode "sol-core" args ""
+  assertEqual "exit code" (ExitFailure 1) exitCode
+  assertEqual "stderr" "" stderr
+  cwd <- normalizePath <$> getCurrentDirectory
+  assertEqual "stdout" (unlinesNoTrailing expectedLines) (stripFinalNewline (normalizeOutput cwd stdout))
+
+normalizeOutput :: FilePath -> String -> String
+normalizeOutput cwd =
+  replace cwd "<cwd>" . normalizePath
+
+normalizePath :: FilePath -> FilePath
+normalizePath =
+  map (\c -> if c == '\\' then '/' else c)
+
+replace :: String -> String -> String -> String
+replace needle replacement haystack
+  | null needle = haystack
+  | otherwise =
+      case stripPrefix needle haystack of
+        Just rest -> replacement ++ replace needle replacement rest
+        Nothing ->
+          case haystack of
+            [] -> []
+            c : rest -> c : replace needle replacement rest
+
+stripFinalNewline :: String -> String
+stripFinalNewline text
+  | "\n" `isSuffixOf` text = take (length text - 1) text
+  | otherwise = text
+
+unlinesNoTrailing :: [String] -> String
+unlinesNoTrailing [] = ""
+unlinesNoTrailing [line] = line
+unlinesNoTrailing (line : rest) = line ++ "\n" ++ unlinesNoTrailing rest
diff --git a/test/Main.hs b/test/Main.hs
index ad12d77b2..3c1340e68 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,6 +1,7 @@
 module Main where
 
 import Cases
+import DiagnosticCliTests
 import DiagnosticTests
 import HullCases
 import MatchCompilerTests
@@ -19,6 +20,7 @@ tests =
       pragmas,
       spec,
       std,
+      diagnosticCliTests,
       diagnosticTests,
       imports,
       moduleTypeCheckTests,
diff --git a/test/diagnostics/duplicate-definition.solc b/test/diagnostics/duplicate-definition.solc
new file mode 100644
index 000000000..11e1185e3
--- /dev/null
+++ b/test/diagnostics/duplicate-definition.solc
@@ -0,0 +1,3 @@
+function foo() -> word { return 1; }
+function foo() -> word { return 2; }
+function main() -> word { return foo(); }
diff --git a/test/diagnostics/parse-error.solc b/test/diagnostics/parse-error.solc
new file mode 100644
index 000000000..88b553a77
--- /dev/null
+++ b/test/diagnostics/parse-error.solc
@@ -0,0 +1 @@
+function main( -> word { return 0; }
diff --git a/test/diagnostics/type-mismatch.solc b/test/diagnostics/type-mismatch.solc
new file mode 100644
index 000000000..64d7ed2c4
--- /dev/null
+++ b/test/diagnostics/type-mismatch.solc
@@ -0,0 +1 @@
+function main() -> word { return true; }
diff --git a/test/diagnostics/undefined-name.solc b/test/diagnostics/undefined-name.solc
new file mode 100644
index 000000000..6aae2ad1e
--- /dev/null
+++ b/test/diagnostics/undefined-name.solc
@@ -0,0 +1 @@
+function main() -> word { return missing; }

From 189098f75354bf992c47149c6df6479b40204568 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 15:12:03 +0200
Subject: [PATCH 20/35] Index source token spans

---
 src/Solcore/Diagnostics.hs              | 81 ++++++++++++++++++++++++-
 src/Solcore/Pipeline/SolcorePipeline.hs |  9 ++-
 test/DiagnosticTests.hs                 | 11 +++-
 3 files changed, 97 insertions(+), 4 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index d516193b1..b07188351 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -6,6 +6,7 @@ module Solcore.Diagnostics
     Label (..),
     Diagnostic (..),
     SourceId (..),
+    SourceToken (..),
     SourceFile (..),
     SourceMap,
     DiagnosticFormat (..),
@@ -20,6 +21,7 @@ module Solcore.Diagnostics
     lookupSourceFile,
     sourceMapFiles,
     sourceMapNull,
+    findTokenSpansInSource,
     findTextSpansInSource,
     legacyDiagnostic,
     encodeDiagnostic,
@@ -30,6 +32,7 @@ module Solcore.Diagnostics
   )
 where
 
+import Data.Char (isAlpha, isAlphaNum)
 import Data.List (foldl', isPrefixOf, stripPrefix, tails)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
@@ -89,7 +92,15 @@ data SourceFile
   { sourceId :: SourceId,
     sourcePath :: FilePath,
     sourceText :: String,
-    sourceLineStarts :: [Int]
+    sourceLineStarts :: [Int],
+    sourceTokens :: [SourceToken]
+  }
+  deriving (Eq, Ord, Show)
+
+data SourceToken
+  = SourceToken
+  { sourceTokenText :: String,
+    sourceTokenSpan :: SourceSpan
   }
   deriving (Eq, Ord, Show)
 
@@ -137,7 +148,8 @@ makeSourceFile path content =
     { sourceId = SourceId path,
       sourcePath = path,
       sourceText = content,
-      sourceLineStarts = computeLineStarts content
+      sourceLineStarts = computeLineStarts content,
+      sourceTokens = computeSourceTokens path content
     }
 
 sourceMapFromFiles :: [SourceFile] -> SourceMap
@@ -163,6 +175,15 @@ sourceMapNull :: SourceMap -> Bool
 sourceMapNull (SourceMap sources) =
   Map.null sources
 
+findTokenSpansInSource :: SourceFile -> String -> [SourceSpan]
+findTokenSpansInSource source needle
+  | null needle = []
+  | otherwise =
+      [ sourceTokenSpan sourceToken
+        | sourceToken <- sourceTokens source,
+          sourceTokenText sourceToken == needle
+      ]
+
 findTextSpansInSource :: SourceFile -> String -> [SourceSpan]
 findTextSpansInSource source needle
   | null needle = []
@@ -372,6 +393,62 @@ computeLineStarts =
     step (starts, offset) '\n' = (offset + 1 : starts, offset + 1)
     step (starts, offset) _ = (starts, offset + 1)
 
+computeSourceTokens :: FilePath -> String -> [SourceToken]
+computeSourceTokens path content =
+  concat
+    [ lineTokens path lineNo lineStart lineText
+      | (lineNo, lineStart, lineText) <- zip3 [1 ..] (computeLineStarts content) (sourceLinesFromText content)
+    ]
+
+sourceLinesFromText :: String -> [String]
+sourceLinesFromText content =
+  case lines content of
+    [] -> [""]
+    xs -> xs
+
+lineTokens :: FilePath -> Int -> Int -> String -> [SourceToken]
+lineTokens path lineNo lineStart lineText =
+  go 1 lineText
+  where
+    go _ [] = []
+    go column chars@(c : rest)
+      | isIdentifierStart c =
+          let (tokenText, suffix) = spanQualifiedIdentifier chars
+              endColumn = column + length tokenText
+           in SourceToken
+                { sourceTokenText = tokenText,
+                  sourceTokenSpan =
+                    SourceSpan
+                      { spanFile = path,
+                        spanStartByte = lineStart + column - 1,
+                        spanEndByte = lineStart + endColumn - 1,
+                        spanStartLine = lineNo,
+                        spanStartColumn = column,
+                        spanEndLine = lineNo,
+                        spanEndColumn = endColumn
+                      }
+                }
+                : go endColumn suffix
+      | otherwise = go (column + 1) rest
+
+spanQualifiedIdentifier :: String -> (String, String)
+spanQualifiedIdentifier chars =
+  let (segment, rest) = span isIdentifierContinue chars
+   in case rest of
+        '.' : next : suffix
+          | isIdentifierStart next ->
+              let (tailText, finalRest) = spanQualifiedIdentifier (next : suffix)
+               in (segment ++ "." ++ tailText, finalRest)
+        _ -> (segment, rest)
+
+isIdentifierStart :: Char -> Bool
+isIdentifierStart c =
+  isAlpha c || c == '_'
+
+isIdentifierContinue :: Char -> Bool
+isIdentifierContinue c =
+  isAlphaNum c || c == '_' || c == '\''
+
 padLeft :: Int -> String -> String
 padLeft width str =
   replicate (max 0 (width - length str)) ' ' ++ str
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index fa2b4f7c5..fee6cadf6 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -38,6 +38,7 @@ import Solcore.Diagnostics
     emptySourceMap,
     encodeDiagnostic,
     findTextSpansInSource,
+    findTokenSpansInSource,
     insertSourceFile,
     legacyDiagnostic,
     lookupSourceFile,
@@ -309,7 +310,13 @@ firstSpanForTerm sources diagnostic term =
 
 spansForTerm :: SourceMap -> Diagnostic -> String -> [SourceSpan]
 spansForTerm sources diagnostic term =
-  concatMap (`findTextSpansInSource` term) (candidateSources sources diagnostic)
+  concatMap (`spansInSource` term) (candidateSources sources diagnostic)
+
+spansInSource :: SourceFile -> String -> [SourceSpan]
+spansInSource source term =
+  case findTokenSpansInSource source term of
+    [] -> findTextSpansInSource source term
+    tokenSpans -> tokenSpans
 
 candidateSources :: SourceMap -> Diagnostic -> [SourceFile]
 candidateSources sources diagnostic =
diff --git a/test/DiagnosticTests.hs b/test/DiagnosticTests.hs
index 3c4e3ae36..9dd4d4b73 100644
--- a/test/DiagnosticTests.hs
+++ b/test/DiagnosticTests.hs
@@ -12,7 +12,8 @@ diagnosticTests =
       testCase "short diagnostic snapshot" test_shortDiagnosticSnapshot,
       testCase "unicode diagnostic snapshot" test_unicodeDiagnosticSnapshot,
       testCase "diagnostic notes wrap to configured width" test_diagnosticWidthWrapsNotes,
-      testCase "color always emits ANSI styles" test_colorAlwaysEmitsAnsi
+      testCase "color always emits ANSI styles" test_colorAlwaysEmitsAnsi,
+      testCase "source token spans are exact" test_sourceTokenSpansAreExact
     ]
 
 test_humanDiagnosticSnapshot :: Assertion
@@ -80,6 +81,14 @@ test_colorAlwaysEmitsAnsi =
     undefinedNameDiagnostic
     @?= "main.solc:2:10: \ESC[1;31merror[SC0101]\ESC[0m: undefined name `missing`"
 
+test_sourceTokenSpansAreExact :: Assertion
+test_sourceTokenSpansAreExact =
+  map spanStartColumn (findTokenSpansInSource tokenSourceFile "missing")
+    @?= [20]
+  where
+    tokenSourceFile =
+      makeSourceFile "tokens.solc" "let missingValue = missing;"
+
 sourceMap :: SourceMap
 sourceMap =
   sourceMapFromFiles [sourceFile]

From 4659529cf65b2124e8748c7c4189ea9a2e2279c3 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 17:39:41 +0200
Subject: [PATCH 21/35] Add warning diagnostics policy

---
 src/Solcore/Pipeline/Options.hs         | 33 +++++++++++++++
 src/Solcore/Pipeline/SolcorePipeline.hs | 37 +++++++++++++++--
 test/DiagnosticCliTests.hs              | 54 ++++++++++++++++++++++++-
 3 files changed, 119 insertions(+), 5 deletions(-)

diff --git a/src/Solcore/Pipeline/Options.hs b/src/Solcore/Pipeline/Options.hs
index ce3840d65..e4d269d92 100644
--- a/src/Solcore/Pipeline/Options.hs
+++ b/src/Solcore/Pipeline/Options.hs
@@ -30,11 +30,19 @@ data Option
     optDiagnosticUnicode :: !UnicodeChoice,
     optDiagnosticWidth :: !Int,
     optDiagnosticFormat :: !DiagnosticFormat,
+    optWarningPolicy :: !WarningPolicy,
     -- Partial evaluation options
     optPEFuel :: !(Maybe Int)
   }
   deriving (Eq, Show)
 
+data WarningPolicy
+  = WarningsDefault
+  | WarningsAlways
+  | WarningsNever
+  | WarningsDeny
+  deriving (Eq, Ord, Show)
+
 emptyOption :: FilePath -> Option
 emptyOption path =
   Option
@@ -63,6 +71,7 @@ emptyOption path =
       optDiagnosticUnicode = diagnosticUnicode defaultDiagnosticRenderOptions,
       optDiagnosticWidth = diagnosticWidth defaultDiagnosticRenderOptions,
       optDiagnosticFormat = diagnosticFormat defaultDiagnosticRenderOptions,
+      optWarningPolicy = WarningsDefault,
       -- Partial evaluation options
       optPEFuel = Nothing
     }
@@ -209,6 +218,14 @@ options =
           <> showDefaultWith showDiagnosticFormat
           <> help "Configure diagnostic output format"
       )
+    <*> option
+      warningPolicyReader
+      ( long "warnings"
+          <> metavar "default|always|never|deny"
+          <> value (optWarningPolicy stdOpt)
+          <> showDefaultWith showWarningPolicy
+          <> help "Configure compiler warning diagnostics"
+      )
     -- Partial evaluation options
     <*> optional
       ( option
@@ -265,6 +282,16 @@ diagnosticFormatReader =
       "short" -> Right DiagnosticShort
       _ -> Left "expected one of: human, short"
 
+warningPolicyReader :: ReadM WarningPolicy
+warningPolicyReader =
+  eitherReader $ \raw ->
+    case raw of
+      "default" -> Right WarningsDefault
+      "always" -> Right WarningsAlways
+      "never" -> Right WarningsNever
+      "deny" -> Right WarningsDeny
+      _ -> Left "expected one of: default, always, never, deny"
+
 showColorChoice :: ColorChoice -> String
 showColorChoice ColorAuto = "auto"
 showColorChoice ColorAlways = "always"
@@ -278,3 +305,9 @@ showUnicodeChoice UnicodeNever = "never"
 showDiagnosticFormat :: DiagnosticFormat -> String
 showDiagnosticFormat DiagnosticHuman = "human"
 showDiagnosticFormat DiagnosticShort = "short"
+
+showWarningPolicy :: WarningPolicy -> String
+showWarningPolicy WarningsDefault = "default"
+showWarningPolicy WarningsAlways = "always"
+showWarningPolicy WarningsNever = "never"
+showWarningPolicy WarningsDeny = "deny"
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index fee6cadf6..802cb31bd 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -29,6 +29,7 @@ import Solcore.Diagnostics
     DiagnosticCode (..),
     Label (..),
     LabelStyle (..),
+    Severity (..),
     SourceFile,
     SourceMap,
     SourceSpan,
@@ -56,7 +57,7 @@ import Solcore.Frontend.TypeInference.Id
 import Solcore.Frontend.TypeInference.SccAnalysis
 import Solcore.Frontend.TypeInference.TcEnv
 import Solcore.Frontend.TypeInference.TcModule
-import Solcore.Pipeline.Options (Option (..), argumentsParser, diagnosticRenderOptions, noDesugarOpt)
+import Solcore.Pipeline.Options (Option (..), WarningPolicy (..), argumentsParser, diagnosticRenderOptions, noDesugarOpt)
 import System.Directory (doesFileExist, makeAbsolute)
 import System.Exit (ExitCode (..), exitWith)
 import System.TimeIt qualified as TimeIt
@@ -152,9 +153,7 @@ compileWithDiagnostics opts = runExceptT $ do
       else do
         (ast, warns) <- liftEitherDiagnosticIO sources (timeItNamed "Match compiler" $ matchCompiler desugared)
         let warningDiagnostics = map (enrichDiagnostic sources . warningDiagnostic) warns
-        when (verbose && not (null warningDiagnostics)) $
-          liftIO $
-            putStrLn (renderDiagnostics (diagnosticRenderOptions opts) sources warningDiagnostics)
+        handleWarningDiagnostics opts sources warningDiagnostics
         pure ast
 
   let printMatch = not noMatchCompiler && (verbose || optDumpDS opts)
@@ -215,6 +214,36 @@ compileDiagnosticsText :: CompileDiagnostics -> String
 compileDiagnosticsText =
   unlines . map diagnosticMessage . compileDiagnosticMessages
 
+handleWarningDiagnostics :: Option -> SourceMap -> [Diagnostic] -> ExceptT CompileDiagnostics IO ()
+handleWarningDiagnostics _ _ [] =
+  pure ()
+handleWarningDiagnostics opts sources diagnostics =
+  case optWarningPolicy opts of
+    WarningsNever -> pure ()
+    WarningsDefault
+      | optVerbose opts -> printWarnings
+      | otherwise -> pure ()
+    WarningsAlways -> printWarnings
+    WarningsDeny ->
+      throwError
+        CompileDiagnostics
+          { compileDiagnosticSources = sources,
+            compileDiagnosticMessages = map denyWarning diagnostics
+          }
+  where
+    printWarnings =
+      liftIO $
+        putStrLn (renderDiagnostics (diagnosticRenderOptions opts) sources diagnostics)
+
+denyWarning :: Diagnostic -> Diagnostic
+denyWarning diagnostic =
+  diagnostic
+    { diagnosticSeverity = Error,
+      diagnosticHelp =
+        diagnosticHelp diagnostic
+          ++ ["pass --warnings=default, --warnings=always, or --warnings=never to allow this warning"]
+    }
+
 liftEitherDiagnostic :: SourceMap -> Either String a -> ExceptT CompileDiagnostics IO a
 liftEitherDiagnostic sources =
   ExceptT . pure . first (compileDiagnosticError sources)
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index da7cf5eb3..df669b2c6 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -87,9 +87,29 @@ diagnosticCliTests =
       testCase "short output" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/undefined-name.solc", "--no-specialise", "--diagnostic-format", "short"]
-          ["<cwd>/test/diagnostics/undefined-name.solc:1:34: error[SC0101]: undefined name: missing"]
+          ["<cwd>/test/diagnostics/undefined-name.solc:1:34: error[SC0101]: undefined name: missing"],
+      testCase "warnings always" $
+        expectSuccess
+          ["--root", "test/examples/cases", "--file", "test/examples/cases/redundant-match.solc", "--no-specialise", "--warnings", "always"]
+          redundantWarningsSnapshot,
+      testCase "warnings never" $
+        expectSuccess
+          ["--root", "test/examples/cases", "--file", "test/examples/cases/redundant-match.solc", "--no-specialise", "--warnings", "never"]
+          [],
+      testCase "warnings deny" $
+        expectFailure
+          ["--root", "test/examples/cases", "--file", "test/examples/cases/redundant-match.solc", "--no-specialise", "--warnings", "deny"]
+          (map denyWarningLine redundantWarningsSnapshot)
     ]
 
+expectSuccess :: [String] -> [String] -> Assertion
+expectSuccess args expectedLines = do
+  (exitCode, stdout, stderr) <- readProcessWithExitCode "sol-core" args ""
+  assertEqual "exit code" ExitSuccess exitCode
+  assertEqual "stderr" "" stderr
+  cwd <- normalizePath <$> getCurrentDirectory
+  assertEqual "stdout" (unlinesNoTrailing expectedLines) (stripFinalNewline (normalizeOutput cwd stdout))
+
 expectFailure :: [String] -> [String] -> Assertion
 expectFailure args expectedLines = do
   (exitCode, stdout, stderr) <- readProcessWithExitCode "sol-core" args ""
@@ -98,6 +118,38 @@ expectFailure args expectedLines = do
   cwd <- normalizePath <$> getCurrentDirectory
   assertEqual "stdout" (unlinesNoTrailing expectedLines) (stripFinalNewline (normalizeOutput cwd stdout))
 
+redundantWarningsSnapshot :: [String]
+redundantWarningsSnapshot =
+  [ "warning[SC0301]: redundant pattern clause",
+    "  --> <cwd>/test/examples/cases/redundant-match.solc:6:7",
+    "  |",
+    "6 |     | Bool.True  => return Bool.True;",
+    "  |       ^^^^^^^^^ redundant clause",
+    "note: clause: | Bool.True<Bool> =>",
+    "      return Bool.True<Bool>;",
+    "note: in: match (x<Bool>)",
+    "note: in: function f",
+    "help: remove this clause or make an earlier pattern more specific",
+    "",
+    "warning[SC0301]: redundant pattern clause",
+    "  --> <cwd>/test/examples/cases/redundant-match.solc:7:7",
+    "  |",
+    "7 |     | Bool.False => return Bool.False;",
+    "  |       ^^^^^^^^^^ redundant clause",
+    "note: clause: | Bool.False<Bool> =>",
+    "      return Bool.False<Bool>;",
+    "note: in: match (x<Bool>)",
+    "note: in: function f",
+    "help: remove this clause or make an earlier pattern more specific"
+  ]
+
+denyWarningLine :: String -> String
+denyWarningLine "warning[SC0301]: redundant pattern clause" =
+  "error[SC0301]: redundant pattern clause"
+denyWarningLine "help: remove this clause or make an earlier pattern more specific" =
+  "help: remove this clause or make an earlier pattern more specific\nhelp: pass --warnings=default, --warnings=always, or --warnings=never to allow this warning"
+denyWarningLine line = line
+
 normalizeOutput :: FilePath -> String -> String
 normalizeOutput cwd =
   replace cwd "<cwd>" . normalizePath

From 93c5b91904db84160fe47eaa809ee6dd72da915e Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 21:07:28 +0200
Subject: [PATCH 22/35] Polish diagnostic rendering

---
 src/Solcore/Diagnostics.hs              | 125 +++++++++++++++++++-----
 src/Solcore/Pipeline/SolcorePipeline.hs |  18 +++-
 test/DiagnosticCliTests.hs              |   1 -
 test/DiagnosticTests.hs                 |  62 ++++++++++++
 4 files changed, 177 insertions(+), 29 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index b07188351..29e0a97cf 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -14,6 +14,7 @@ module Solcore.Diagnostics
     UnicodeChoice (..),
     DiagnosticRenderOptions (..),
     defaultDiagnosticRenderOptions,
+    resolveDiagnosticRenderOptions,
     makeSourceFile,
     sourceMapFromFiles,
     emptySourceMap,
@@ -33,11 +34,13 @@ module Solcore.Diagnostics
 where
 
 import Data.Char (isAlpha, isAlphaNum)
-import Data.List (foldl', isPrefixOf, stripPrefix, tails)
+import Data.List (foldl', isPrefixOf, sortOn, stripPrefix, tails)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Prettyprinter (Doc, LayoutOptions (..), PageWidth (..), layoutPretty, pretty, vsep)
 import Prettyprinter.Render.String (renderString)
+import System.Environment (lookupEnv)
+import System.IO (hIsTerminalDevice, stdout)
 import Text.Read (readMaybe)
 
 data Severity
@@ -142,6 +145,35 @@ defaultDiagnosticRenderOptions =
       diagnosticFormat = DiagnosticHuman
     }
 
+resolveDiagnosticRenderOptions :: DiagnosticRenderOptions -> IO DiagnosticRenderOptions
+resolveDiagnosticRenderOptions opts = do
+  isTerminal <- hIsTerminalDevice stdout
+  columns <- lookupEnv "COLUMNS"
+  pure
+    opts
+      { diagnosticColor = resolveColor isTerminal (diagnosticColor opts),
+        diagnosticUnicode = resolveUnicode isTerminal (diagnosticUnicode opts),
+        diagnosticWidth = resolveWidth columns (diagnosticWidth opts)
+      }
+
+resolveColor :: Bool -> ColorChoice -> ColorChoice
+resolveColor isTerminal ColorAuto
+  | isTerminal = ColorAlways
+  | otherwise = ColorNever
+resolveColor _ choice = choice
+
+resolveUnicode :: Bool -> UnicodeChoice -> UnicodeChoice
+resolveUnicode isTerminal UnicodeAuto
+  | isTerminal = UnicodeAlways
+  | otherwise = UnicodeNever
+resolveUnicode _ choice = choice
+
+resolveWidth :: Maybe String -> Int -> Int
+resolveWidth columns width
+  | width == diagnosticWidth defaultDiagnosticRenderOptions =
+      maybe width (max 20) (columns >>= readMaybe)
+  | otherwise = width
+
 makeSourceFile :: FilePath -> String -> SourceFile
 makeSourceFile path content =
   SourceFile
@@ -285,7 +317,7 @@ humanDiagnosticLines :: DiagnosticRenderOptions -> SourceMap -> Diagnostic -> [S
 humanDiagnosticLines opts sources diagnostic =
   [diagnosticHeader opts diagnostic]
     ++ locationLines opts diagnostic
-    ++ concatMap (labelSnippetLines opts (diagnosticSeverity diagnostic) sources) (diagnosticLabels diagnostic)
+    ++ labelSnippetLines opts (diagnosticSeverity diagnostic) sources (diagnosticLabels diagnostic)
     ++ concatMap (prefixedWrappedLines opts "note: ") (diagnosticNotes diagnostic)
     ++ concatMap (prefixedWrappedLines opts "help: ") (diagnosticHelp diagnostic)
 
@@ -322,45 +354,88 @@ locationLines opts diagnostic =
           )
       ]
 
-labelSnippetLines :: DiagnosticRenderOptions -> Severity -> SourceMap -> Label -> [String]
-labelSnippetLines opts severity (SourceMap sources) label =
-  case Map.lookup (spanFile sourceSpan) sources of
-    Nothing -> []
-    Just source -> sourceLabelSnippet opts severity source label
+labelSnippetLines :: DiagnosticRenderOptions -> Severity -> SourceMap -> [Label] -> [String]
+labelSnippetLines opts severity (SourceMap sources) labels =
+  concatMap renderGroup (groupNearbyLabels labels)
+  where
+    renderGroup [] = []
+    renderGroup group@(label : _) =
+      case Map.lookup (spanFile (labelSpan label)) sources of
+        Nothing -> []
+        Just source -> sourceLabelsSnippet opts severity source group
+
+groupNearbyLabels :: [Label] -> [[Label]]
+groupNearbyLabels =
+  foldr insertLabel [] . sortOn labelSortKey
+  where
+    insertLabel label [] = [[label]]
+    insertLabel label (group : groups)
+      | labelBelongsWith label group = (label : group) : groups
+      | otherwise = [label] : group : groups
+
+labelBelongsWith :: Label -> [Label] -> Bool
+labelBelongsWith _ [] = False
+labelBelongsWith label group@(firstLabel : _) =
+  spanFile nextSpan == spanFile firstSpan
+    && spanStartLine nextSpan <= groupEndLine group + 2
+  where
+    nextSpan = labelSpan label
+    firstSpan = labelSpan firstLabel
+
+groupEndLine :: [Label] -> Int
+groupEndLine =
+  maximum . map (spanEndLine . labelSpan)
+
+labelSortKey :: Label -> (FilePath, Int, Int, Int)
+labelSortKey label =
+  (spanFile sourceSpan, spanStartLine sourceSpan, spanStartColumn sourceSpan, labelStyleRank (labelStyle label))
   where
     sourceSpan = labelSpan label
 
-sourceLabelSnippet :: DiagnosticRenderOptions -> Severity -> SourceFile -> Label -> [String]
-sourceLabelSnippet opts severity source label =
+labelStyleRank :: LabelStyle -> Int
+labelStyleRank Primary = 0
+labelStyleRank Secondary = 1
+
+sourceLabelsSnippet :: DiagnosticRenderOptions -> Severity -> SourceFile -> [Label] -> [String]
+sourceLabelsSnippet opts severity source labels =
   [gutter]
     ++ concatMap renderLine [firstLine .. lastLine]
   where
-    sourceSpan = labelSpan label
-    firstLine = max 1 (spanStartLine sourceSpan)
-    lastLine = max firstLine (spanEndLine sourceSpan)
+    firstLine = minimum (map (spanStartLine . labelSpan) labels)
+    lastLine = maximum (map (spanEndLine . labelSpan) labels)
     lineNoWidth = length (show lastLine)
     gutter = gutterLine opts lineNoWidth
-    marker = case labelStyle label of
-      Primary -> '^'
-      Secondary -> '-'
-    markerAnsi = case labelStyle label of
-      Primary -> severityAnsi severity
-      Secondary -> secondaryAnsi
 
     renderLine lineNo =
       let lineText = sourceLine source lineNo
           displayLine = expandTabs tabWidth lineText
-          underline = underlineForLine sourceSpan lineNo lineText marker
-          message = if lineNo == firstLine then maybe "" (" " ++) (labelMessage label) else ""
+          lineLabels = filter (labelTouchesLine lineNo) labels
        in [ colorize opts lineNumberAnsi (padLeft lineNoWidth (show lineNo))
               ++ gutterSeparator opts
               ++ " "
-              ++ displayLine,
-            gutterLine opts lineNoWidth
-              ++ " "
-              ++ colorize opts markerAnsi underline
-              ++ message
+              ++ displayLine
           ]
+            ++ map (renderLabelMarker lineNo lineText) lineLabels
+
+    renderLabelMarker lineNo lineText label =
+      let marker = case labelStyle label of
+            Primary -> '^'
+            Secondary -> '-'
+          markerAnsi = case labelStyle label of
+            Primary -> severityAnsi severity
+            Secondary -> secondaryAnsi
+          underline = underlineForLine (labelSpan label) lineNo lineText marker
+          message = if lineNo == spanStartLine (labelSpan label) then maybe "" (" " ++) (labelMessage label) else ""
+       in gutterLine opts lineNoWidth
+            ++ " "
+            ++ colorize opts markerAnsi underline
+            ++ message
+
+labelTouchesLine :: Int -> Label -> Bool
+labelTouchesLine lineNo label =
+  lineNo >= spanStartLine sourceSpan && lineNo <= spanEndLine sourceSpan
+  where
+    sourceSpan = labelSpan label
 
 underlineForLine :: SourceSpan -> Int -> String -> Char -> String
 underlineForLine sourceSpan lineNo lineText marker =
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 802cb31bd..dcffac467 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -45,6 +45,7 @@ import Solcore.Diagnostics
     lookupSourceFile,
     makeSourceFile,
     renderDiagnostics,
+    resolveDiagnosticRenderOptions,
     sourceMapFiles,
     spanFile,
   )
@@ -70,7 +71,8 @@ pipeline = do
   result <- compileWithDiagnostics opts
   case result of
     Left err -> do
-      putStrLn (renderCompileDiagnostics opts err)
+      rendered <- renderCompileDiagnosticsIO opts err
+      putStrLn rendered
       exitWith (ExitFailure 1)
     Right contracts -> do
       forM_ (zip [(1 :: Int) ..] contracts) $ \(i, c) -> do
@@ -210,6 +212,15 @@ renderCompileDiagnostics opts diagnostics =
     (compileDiagnosticSources diagnostics)
     (compileDiagnosticMessages diagnostics)
 
+renderCompileDiagnosticsIO :: Option -> CompileDiagnostics -> IO String
+renderCompileDiagnosticsIO opts diagnostics = do
+  renderOptions <- resolveDiagnosticRenderOptions (diagnosticRenderOptions opts)
+  pure $
+    renderDiagnostics
+      renderOptions
+      (compileDiagnosticSources diagnostics)
+      (compileDiagnosticMessages diagnostics)
+
 compileDiagnosticsText :: CompileDiagnostics -> String
 compileDiagnosticsText =
   unlines . map diagnosticMessage . compileDiagnosticMessages
@@ -232,8 +243,9 @@ handleWarningDiagnostics opts sources diagnostics =
           }
   where
     printWarnings =
-      liftIO $
-        putStrLn (renderDiagnostics (diagnosticRenderOptions opts) sources diagnostics)
+      liftIO $ do
+        renderOptions <- resolveDiagnosticRenderOptions (diagnosticRenderOptions opts)
+        putStrLn (renderDiagnostics renderOptions sources diagnostics)
 
 denyWarning :: Diagnostic -> Diagnostic
 denyWarning diagnostic =
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index df669b2c6..1f9a90fcb 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -46,7 +46,6 @@ diagnosticCliTests =
             "  |",
             "1 | function foo() -> word { return 1; }",
             "  |          --- previous definition",
-            "  |",
             "2 | function foo() -> word { return 2; }",
             "  |          ^^^ duplicate definition",
             "note: context: module",
diff --git a/test/DiagnosticTests.hs b/test/DiagnosticTests.hs
index 9dd4d4b73..d3a21e4e1 100644
--- a/test/DiagnosticTests.hs
+++ b/test/DiagnosticTests.hs
@@ -13,6 +13,7 @@ diagnosticTests =
       testCase "unicode diagnostic snapshot" test_unicodeDiagnosticSnapshot,
       testCase "diagnostic notes wrap to configured width" test_diagnosticWidthWrapsNotes,
       testCase "color always emits ANSI styles" test_colorAlwaysEmitsAnsi,
+      testCase "nearby labels share one snippet" test_nearbyLabelsShareOneSnippet,
       testCase "source token spans are exact" test_sourceTokenSpansAreExact
     ]
 
@@ -81,6 +82,19 @@ test_colorAlwaysEmitsAnsi =
     undefinedNameDiagnostic
     @?= "main.solc:2:10: \ESC[1;31merror[SC0101]\ESC[0m: undefined name `missing`"
 
+test_nearbyLabelsShareOneSnippet :: Assertion
+test_nearbyLabelsShareOneSnippet =
+  renderDiagnostic defaultDiagnosticRenderOptions duplicateSourceMap duplicateDiagnostic
+    @?= unlinesNoTrailing
+      [ "error[SC0108]: duplicate declarations",
+        "  --> dup.solc:2:10",
+        "  |",
+        "1 | function foo() -> word { return 1; }",
+        "  |          --- previous definition",
+        "2 | function foo() -> word { return 2; }",
+        "  |          ^^^ duplicate definition"
+      ]
+
 test_sourceTokenSpansAreExact :: Assertion
 test_sourceTokenSpansAreExact =
   map spanStartColumn (findTokenSpansInSource tokenSourceFile "missing")
@@ -97,6 +111,14 @@ sourceFile :: SourceFile
 sourceFile =
   makeSourceFile "main.solc" (unlines ["function main() -> word {", "  return missing;", "}"])
 
+duplicateSourceMap :: SourceMap
+duplicateSourceMap =
+  sourceMapFromFiles [duplicateSourceFile]
+
+duplicateSourceFile :: SourceFile
+duplicateSourceFile =
+  makeSourceFile "dup.solc" (unlines ["function foo() -> word { return 1; }", "function foo() -> word { return 2; }"])
+
 undefinedNameDiagnostic :: Diagnostic
 undefinedNameDiagnostic =
   Diagnostic
@@ -123,6 +145,46 @@ undefinedNameDiagnostic =
       diagnosticHelp = ["import it explicitly"]
     }
 
+duplicateDiagnostic :: Diagnostic
+duplicateDiagnostic =
+  Diagnostic
+    { diagnosticSeverity = Error,
+      diagnosticCode = Just (DiagnosticCode "SC0108"),
+      diagnosticMessage = "duplicate declarations",
+      diagnosticLabels =
+        [ Label
+            { labelSpan =
+                SourceSpan
+                  { spanFile = "dup.solc",
+                    spanStartByte = 9,
+                    spanEndByte = 12,
+                    spanStartLine = 1,
+                    spanStartColumn = 10,
+                    spanEndLine = 1,
+                    spanEndColumn = 13
+                  },
+              labelStyle = Secondary,
+              labelMessage = Just "previous definition"
+            },
+          Label
+            { labelSpan =
+                SourceSpan
+                  { spanFile = "dup.solc",
+                    spanStartByte = 47,
+                    spanEndByte = 50,
+                    spanStartLine = 2,
+                    spanStartColumn = 10,
+                    spanEndLine = 2,
+                    spanEndColumn = 13
+                  },
+              labelStyle = Primary,
+              labelMessage = Just "duplicate definition"
+            }
+        ],
+      diagnosticNotes = [],
+      diagnosticHelp = []
+    }
+
 unlinesNoTrailing :: [String] -> String
 unlinesNoTrailing [] = ""
 unlinesNoTrailing [line] = line

From 8fb5a89b3b8afb47398e206402f3319ea89d31e8 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Mon, 25 May 2026 22:46:52 +0200
Subject: [PATCH 23/35] Deduplicate diagnostic notes

---
 src/Solcore/Diagnostics.hs                    | 16 ++++++++++++++++
 src/Solcore/Frontend/Syntax/NameResolution.hs |  7 ++-----
 src/Solcore/Frontend/TypeInference/TcMonad.hs |  7 ++-----
 src/Solcore/Pipeline/SolcorePipeline.hs       | 16 ++++++----------
 test/DiagnosticCliTests.hs                    |  3 ---
 test/DiagnosticTests.hs                       | 10 ++++++++++
 6 files changed, 36 insertions(+), 23 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 29e0a97cf..59411ad2e 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -25,6 +25,8 @@ module Solcore.Diagnostics
     findTokenSpansInSource,
     findTextSpansInSource,
     legacyDiagnostic,
+    addDiagnosticNote,
+    addDiagnosticHelp,
     encodeDiagnostic,
     decodeDiagnostic,
     diagnosticPrimarySpan,
@@ -260,6 +262,20 @@ legacyDiagnostic msg =
       diagnosticHelp = []
     }
 
+addDiagnosticNote :: String -> Diagnostic -> Diagnostic
+addDiagnosticNote note diagnostic =
+  diagnostic {diagnosticNotes = appendUnique note (diagnosticNotes diagnostic)}
+
+addDiagnosticHelp :: String -> Diagnostic -> Diagnostic
+addDiagnosticHelp help diagnostic =
+  diagnostic {diagnosticHelp = appendUnique help (diagnosticHelp diagnostic)}
+
+appendUnique :: String -> [String] -> [String]
+appendUnique item items
+  | null item = items
+  | item `elem` items = items
+  | otherwise = items ++ [item]
+
 encodeDiagnostic :: Diagnostic -> String
 encodeDiagnostic diagnostic =
   diagnosticEnvelopePrefix ++ show diagnostic
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 51e4a71bd..f43a13067 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -8,7 +8,7 @@ import Control.Monad.State
 import Data.List ((\\))
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
 import Solcore.Frontend.Syntax.Name
@@ -1013,10 +1013,7 @@ wrapError m e =
     decorate msg =
       case decodeDiagnostic msg of
         Just diagnostic ->
-          encodeDiagnostic
-            diagnostic
-              { diagnosticNotes = diagnosticNotes diagnostic ++ ["in: " ++ pretty e]
-              }
+          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) diagnostic)
         Nothing -> msg ++ "\n - in:" ++ pretty e
 
 addContractName :: Name -> ResolveM ()
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index f71634802..9ff64051e 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -8,7 +8,7 @@ import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
 import Data.Set qualified as Set
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -661,10 +661,7 @@ wrapError m e =
     decorate msg =
       case decodeDiagnostic msg of
         Just diagnostic ->
-          encodeDiagnostic
-            diagnostic
-              { diagnosticNotes = diagnosticNotes diagnostic ++ ["in: " ++ pretty e]
-              }
+          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) diagnostic)
         Nothing -> msg ++ "\n - in:" ++ pretty e
 
 tcmMgu :: Ty -> Ty -> TcM Subst
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index dcffac467..61d662ab5 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -33,6 +33,8 @@ import Solcore.Diagnostics
     SourceFile,
     SourceMap,
     SourceSpan,
+    addDiagnosticHelp,
+    addDiagnosticNote,
     decodeDiagnostic,
     diagnosticMessage,
     diagnosticPrimarySpan,
@@ -249,12 +251,9 @@ handleWarningDiagnostics opts sources diagnostics =
 
 denyWarning :: Diagnostic -> Diagnostic
 denyWarning diagnostic =
-  diagnostic
-    { diagnosticSeverity = Error,
-      diagnosticHelp =
-        diagnosticHelp diagnostic
-          ++ ["pass --warnings=default, --warnings=always, or --warnings=never to allow this warning"]
-    }
+  addDiagnosticHelp
+    "pass --warnings=default, --warnings=always, or --warnings=never to allow this warning"
+    diagnostic {diagnosticSeverity = Error}
 
 liftEitherDiagnostic :: SourceMap -> Either String a -> ExceptT CompileDiagnostics IO a
 liftEitherDiagnostic sources =
@@ -658,10 +657,7 @@ decorateDiagnosticContext :: String -> String -> String
 decorateDiagnosticContext context err =
   case decodeDiagnostic err of
     Just diagnostic ->
-      encodeDiagnostic
-        diagnostic
-          { diagnosticNotes = diagnosticNotes diagnostic ++ [context]
-          }
+      encodeDiagnostic (addDiagnosticNote context diagnostic)
     Nothing -> context ++ ":\n" ++ err
 
 prepareInferenceDeclsForTypeInference ::
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index 1f9a90fcb..5d15ac8f2 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -32,9 +32,6 @@ diagnosticCliTests =
             "note: in: function main () -> word {",
             "      return missing ;",
             "      }",
-            "note: in: function main () -> word {",
-            "      return missing ;",
-            "      }",
             "note: module validation failed for",
             "      <cwd>/test/diagnostics/undefined-name.solc"
           ],
diff --git a/test/DiagnosticTests.hs b/test/DiagnosticTests.hs
index d3a21e4e1..e7dbb1327 100644
--- a/test/DiagnosticTests.hs
+++ b/test/DiagnosticTests.hs
@@ -14,6 +14,7 @@ diagnosticTests =
       testCase "diagnostic notes wrap to configured width" test_diagnosticWidthWrapsNotes,
       testCase "color always emits ANSI styles" test_colorAlwaysEmitsAnsi,
       testCase "nearby labels share one snippet" test_nearbyLabelsShareOneSnippet,
+      testCase "diagnostic notes are deduplicated" test_diagnosticNotesAreDeduplicated,
       testCase "source token spans are exact" test_sourceTokenSpansAreExact
     ]
 
@@ -95,6 +96,15 @@ test_nearbyLabelsShareOneSnippet =
         "  |          ^^^ duplicate definition"
       ]
 
+test_diagnosticNotesAreDeduplicated :: Assertion
+test_diagnosticNotesAreDeduplicated =
+  diagnosticNotes
+    ( addDiagnosticNote
+        "in: main"
+        (addDiagnosticNote "in: main" undefinedNameDiagnostic)
+    )
+    @?= ["names must be in scope", "in: main"]
+
 test_sourceTokenSpansAreExact :: Assertion
 test_sourceTokenSpansAreExact =
   map spanStartColumn (findTokenSpansInSource tokenSourceFile "missing")

From 0e18b3224c667ddc0965949485f63689fcb41f00 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Tue, 26 May 2026 14:04:13 +0200
Subject: [PATCH 24/35] Add fallback spans for diagnostics

---
 src/Solcore/Diagnostics.hs              |   9 +-
 src/Solcore/Pipeline/SolcorePipeline.hs | 126 ++++++++++++++++++++----
 test/DiagnosticCliTests.hs              |  12 +++
 test/diagnostics/missing-signature.solc |   3 +
 4 files changed, 131 insertions(+), 19 deletions(-)
 create mode 100644 test/diagnostics/missing-signature.solc

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 59411ad2e..b612db090 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -256,11 +256,16 @@ legacyDiagnostic msg =
   Diagnostic
     { diagnosticSeverity = Error,
       diagnosticCode = Nothing,
-      diagnosticMessage = msg,
+      diagnosticMessage = message,
       diagnosticLabels = [],
-      diagnosticNotes = [],
+      diagnosticNotes = notes,
       diagnosticHelp = []
     }
+  where
+    (message, notes) =
+      case lines msg of
+        [] -> ("", [])
+        firstLine : restLines -> (firstLine, restLines)
 
 addDiagnosticNote :: String -> Diagnostic -> Diagnostic
 addDiagnosticNote note diagnostic =
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 61d662ab5..a352d51be 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -1,6 +1,7 @@
 module Solcore.Pipeline.SolcorePipeline where
 
 import Control.Monad
+import Control.Applicative ((<|>))
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Data.Bifunctor (first)
@@ -32,12 +33,13 @@ import Solcore.Diagnostics
     Severity (..),
     SourceFile,
     SourceMap,
-    SourceSpan,
+    SourceSpan (..),
     addDiagnosticHelp,
     addDiagnosticNote,
     decodeDiagnostic,
     diagnosticMessage,
     diagnosticPrimarySpan,
+    defaultDiagnosticRenderOptions,
     emptySourceMap,
     encodeDiagnostic,
     findTextSpansInSource,
@@ -49,8 +51,8 @@ import Solcore.Diagnostics
     renderDiagnostics,
     resolveDiagnosticRenderOptions,
     sourceMapFiles,
-    spanFile,
   )
+import Solcore.Diagnostics qualified as Diag
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Module.Loader (ModuleGraph (..), loadModuleGraph, moduleSourceMap, moduleSourcePath, moduleValidationTopDeclSegments)
 import Solcore.Frontend.Pretty.SolcorePretty
@@ -224,8 +226,11 @@ renderCompileDiagnosticsIO opts diagnostics = do
       (compileDiagnosticMessages diagnostics)
 
 compileDiagnosticsText :: CompileDiagnostics -> String
-compileDiagnosticsText =
-  unlines . map diagnosticMessage . compileDiagnosticMessages
+compileDiagnosticsText diagnostics =
+  renderDiagnostics
+    defaultDiagnosticRenderOptions
+    (compileDiagnosticSources diagnostics)
+    (compileDiagnosticMessages diagnostics)
 
 handleWarningDiagnostics :: Option -> SourceMap -> [Diagnostic] -> ExceptT CompileDiagnostics IO ()
 handleWarningDiagnostics _ _ [] =
@@ -303,6 +308,8 @@ enrichDiagnostic sources diagnostic
       diagnostic {diagnosticLabels = labels}
   | Just label <- inferPrimaryLabel sources diagnostic =
       diagnostic {diagnosticLabels = [label]}
+  | Just label <- inferFallbackLabel sources diagnostic =
+      diagnostic {diagnosticLabels = [label]}
   | otherwise = diagnostic
 
 inferPrimaryLabel :: SourceMap -> Diagnostic -> Maybe Label
@@ -381,9 +388,46 @@ diagnosticSearchTerms diagnostic =
         typeMismatchTerms diagnostic,
         warningSearchTerms diagnostic,
         unknownImportTerms diagnostic,
-        duplicateSearchTerms diagnostic
+        duplicateSearchTerms diagnostic,
+        declarationSearchTerms diagnostic,
+        inContextSearchTerms diagnostic
       ]
 
+inferFallbackLabel :: SourceMap -> Diagnostic -> Maybe Label
+inferFallbackLabel sources diagnostic = do
+  source <- firstSource (candidateSources sources diagnostic)
+  pure
+    Label
+      { labelSpan = sourceFallbackSpan source,
+        labelStyle = Primary,
+        labelMessage = Just (fallbackLabelMessage diagnostic)
+      }
+
+firstSource :: [SourceFile] -> Maybe SourceFile
+firstSource [] = Nothing
+firstSource (source : _) = Just source
+
+sourceFallbackSpan :: SourceFile -> SourceSpan
+sourceFallbackSpan source =
+  case Diag.sourceTokens source of
+    token : _ -> Diag.sourceTokenSpan token
+    [] ->
+      SourceSpan
+        { spanFile = Diag.sourcePath source,
+          spanStartByte = 0,
+          spanEndByte = 1,
+          spanStartLine = 1,
+          spanStartColumn = 1,
+          spanEndLine = 1,
+          spanEndColumn = 2
+        }
+
+fallbackLabelMessage :: Diagnostic -> String
+fallbackLabelMessage diagnostic =
+  case diagnosticCode diagnostic of
+    Nothing -> "diagnostic reported here"
+    Just _ -> primaryLabelMessage diagnostic
+
 duplicateSearchTerms :: Diagnostic -> [String]
 duplicateSearchTerms diagnostic =
   uniqueStrings $
@@ -448,6 +492,46 @@ unknownImportTerms diagnostic =
               [word, lastSegment word]
         _ -> []
 
+declarationSearchTerms :: Diagnostic -> [String]
+declarationSearchTerms diagnostic =
+  concatMap declarationTerms (allDiagnosticText diagnostic)
+  where
+    declarationTerms raw =
+      case words (stripContextPrefix (trim raw)) of
+        "function" : declName : _ -> [stripTrailingParens declName]
+        "contract" : declName : _ -> [stripTrailingParens declName]
+        "class" : _vars : ":" : declName : _ -> [stripTrailingParens declName]
+        "class" : declName : _ -> [stripTrailingParens declName]
+        "data" : declName : _ -> [stripTrailingParens declName]
+        "type" : declName : _ -> [stripTrailingParens declName]
+        "constructor" : _ -> ["constructor"]
+        "instance" : _mainTy : ":" : instanceClassName : _ -> [stripTrailingParens instanceClassName, "instance"]
+        "instance" : instanceClassName : _ -> [stripTrailingParens instanceClassName, "instance"]
+        _ -> []
+
+inContextSearchTerms :: Diagnostic -> [String]
+inContextSearchTerms diagnostic =
+  concatMap contextTerms (allDiagnosticText diagnostic)
+  where
+    contextTerms raw =
+      case stripPrefix "in: " (trim raw) <|> stripPrefix "- in:" (trim raw) of
+        Nothing -> []
+        Just context ->
+          take 1 (declarationSearchTerms (diagnostic {diagnosticMessage = context, diagnosticNotes = []}))
+
+stripContextPrefix :: String -> String
+stripContextPrefix raw =
+  case stripPrefix "- in:" raw of
+    Just rest -> trim rest
+    Nothing ->
+      case stripPrefix "in: " raw of
+        Just rest -> trim rest
+        Nothing -> raw
+
+stripTrailingParens :: String -> String
+stripTrailingParens =
+  takeWhile (\c -> c /= '(' && c /= ',' && c /= ';' && c /= '{')
+
 prefixedTerms :: [String] -> String -> [String]
 prefixedTerms prefixes body =
   [trim rest | prefix <- prefixes, Just rest <- [stripPrefix prefix body]]
@@ -460,6 +544,7 @@ primaryLabelMessage diagnostic =
     Just (DiagnosticCode "SC0202") -> "unknown name"
     Just (DiagnosticCode "SC0301") -> "redundant clause"
     Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
+    Nothing -> "diagnostic reported here"
     _ -> diagnosticMessage diagnostic
 
 isDuplicateDiagnostic :: Diagnostic -> Bool
@@ -548,18 +633,25 @@ ensureDiagnosticSources =
 
 ensureDiagnosticSource :: SourceMap -> Diagnostic -> IO SourceMap
 ensureDiagnosticSource sources diagnostic =
-  case diagnosticPrimarySpan diagnostic of
-    Nothing -> pure sources
-    Just sourceSpan
-      | null (spanFile sourceSpan) -> pure sources
-      | Just _ <- lookupSourceFile (spanFile sourceSpan) sources -> pure sources
-      | otherwise -> do
-          exists <- doesFileExist (spanFile sourceSpan)
-          if exists
-            then do
-              content <- readFile (spanFile sourceSpan)
-              pure (insertSourceFile (makeSourceFile (spanFile sourceSpan) content) sources)
-            else pure sources
+  foldM ensureSourcePath sources (diagnosticReferencedSourcePaths diagnostic)
+
+diagnosticReferencedSourcePaths :: Diagnostic -> [FilePath]
+diagnosticReferencedSourcePaths diagnostic =
+  uniqueStrings $
+    maybeToList (spanFile <$> diagnosticPrimarySpan diagnostic)
+      ++ diagnosticSourcePaths diagnostic
+
+ensureSourcePath :: SourceMap -> FilePath -> IO SourceMap
+ensureSourcePath sources path
+  | null path = pure sources
+  | Just _ <- lookupSourceFile path sources = pure sources
+  | otherwise = do
+      exists <- doesFileExist path
+      if exists
+        then do
+          content <- readFile path
+          pure (insertSourceFile (makeSourceFile path content) sources)
+        else pure sources
 
 typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT String IO (Map Mod.ModuleId CheckedModule)
 typeCheckLoadedModules opts graph =
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index 5d15ac8f2..ffcda9286 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -68,6 +68,18 @@ diagnosticCliTests =
             "note: module typecheck failed for",
             "      <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
           ],
+      testCase "legacy typecheck error has fallback span" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/missing-signature.solc", "--no-specialise"]
+          [ "error: module typecheck failed for <cwd>/test/diagnostics/missing-signature.solc (no desugaring):",
+            "  --> <cwd>/test/diagnostics/missing-signature.solc:1:10",
+            "  |",
+            "1 | function foo() {",
+            "  |          ^^^ diagnostic reported here",
+            "note: Top-level function must have complete type annotations:",
+            "note: function foo ()",
+            "note: Annotate every parameter (name : Type) and provide a return type (-> Type)."
+          ],
       testCase "import error" $
         expectFailure
           ["--root", "test/imports", "--file", "test/imports/select_unknown.solc", "--no-specialise"]
diff --git a/test/diagnostics/missing-signature.solc b/test/diagnostics/missing-signature.solc
new file mode 100644
index 000000000..059ca49d1
--- /dev/null
+++ b/test/diagnostics/missing-signature.solc
@@ -0,0 +1,3 @@
+function foo() {
+  return 1;
+}

From f04ab0ce963557fa04fb882683bc1280d3b4838d Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Tue, 26 May 2026 16:42:09 +0200
Subject: [PATCH 25/35] Preserve diagnostic source spans

---
 src/Solcore/Frontend/Module/Loader.hs        | 45 ++++++++++---
 src/Solcore/Pipeline/SolcorePipeline.hs      | 69 ++++++++++++++++++--
 test/DiagnosticCliTests.hs                   | 35 ++++++++++
 test/diagnostics/not-polymorphic-enough.solc |  5 ++
 4 files changed, 140 insertions(+), 14 deletions(-)
 create mode 100644 test/diagnostics/not-polymorphic-enough.solc

diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 617c4baa4..28f3c2e4e 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -130,9 +130,9 @@ visit cfg moduleId sourcePath = do
     let source = makeSourceFile sourcePath content
     parsed <- liftIO (parseCompUnitWithPath sourcePath content)
     cunit <- either throwError pure parsed
-    importedModules <- mapM (resolveImportPath cfg moduleId) (imports cunit)
+    importedModules <- mapM (resolveImportPath cfg moduleId sourcePath) (imports cunit)
     exportedModules <-
-      mapM (resolveModuleReference cfg moduleId "export") (exportModulePaths cunit)
+      mapM (resolveModuleReference cfg moduleId sourcePath "export") (exportModulePaths cunit)
     let moduleRefs =
           Map.fromList $
             [(importModule imp, importId) | (imp, (importId, _)) <- zip (imports cunit) importedModules]
@@ -157,29 +157,54 @@ visit cfg moduleId sourcePath = do
 resolveImportPath ::
   LoaderConfig ->
   Mod.ModuleId ->
+  FilePath ->
   Import ->
   StateT LoadState (ExceptT String IO) (Mod.ModuleId, FilePath)
-resolveImportPath cfg currentModule imp =
+resolveImportPath cfg currentModule currentSourcePath imp =
   fmap (\(_, targetId, targetPath) -> (targetId, targetPath)) $
-    resolveModuleReference cfg currentModule "import" (importModule imp)
+    resolveModuleReference cfg currentModule currentSourcePath "import" (importModule imp)
 
 resolveModuleReference ::
   LoaderConfig ->
   Mod.ModuleId ->
+  FilePath ->
   String ->
   ModulePath ->
   StateT LoadState (ExceptT String IO) (ModulePath, Mod.ModuleId, FilePath)
-resolveModuleReference cfg currentModule refKind modulePath = do
-  candidates <- either throwError pure (resolveModuleImportCandidates cfg currentModule modulePath)
+resolveModuleReference cfg currentModule currentSourcePath refKind modulePath = do
+  candidates <-
+    either
+      (throwError . moduleReferenceDiagnostic "SC0118" currentSourcePath refKind modulePath)
+      pure
+      (resolveModuleImportCandidates cfg currentModule modulePath)
   resolved <- liftIO $ firstExisting candidates
   case resolved of
     Just (targetId, targetPath) -> pure (modulePath, targetId, targetPath)
     Nothing ->
       throwError $
-        refKind
-          ++ " "
-          ++ Mod.modulePathDisplay modulePath
-          ++ ": file not found"
+        moduleReferenceDiagnostic
+          "SC0109"
+          currentSourcePath
+          refKind
+          modulePath
+          ( refKind
+              ++ " "
+              ++ Mod.modulePathDisplay modulePath
+              ++ ": file not found"
+          )
+
+moduleReferenceDiagnostic :: String -> FilePath -> String -> ModulePath -> String -> String
+moduleReferenceDiagnostic code sourcePath refKind modulePath message =
+  loaderDiagnostic
+    code
+    message
+    [sourcePath, refKind ++ " " ++ Mod.modulePathDisplay modulePath]
+    (moduleReferenceHelp code)
+
+moduleReferenceHelp :: String -> [String]
+moduleReferenceHelp "SC0118" = ["pass --external-lib NAME=PATH for external imports"]
+moduleReferenceHelp "SC0109" = ["check the module path or add the missing source file"]
+moduleReferenceHelp _ = []
 
 toFilePath :: FilePath -> Name -> FilePath
 toFilePath base = (base </>) . Mod.moduleFilePath
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index a352d51be..0e3cde8ed 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -6,7 +6,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Data.Bifunctor (first)
 import Data.Char (isAlpha, isAlphaNum, isSpace)
-import Data.List (isInfixOf, isPrefixOf, nub, stripPrefix)
+import Data.List (isInfixOf, isPrefixOf, isSuffixOf, nub, stripPrefix)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe, maybeToList)
@@ -388,6 +388,7 @@ diagnosticSearchTerms diagnostic =
         typeMismatchTerms diagnostic,
         warningSearchTerms diagnostic,
         unknownImportTerms diagnostic,
+        moduleReferenceTerms diagnostic,
         duplicateSearchTerms diagnostic,
         declarationSearchTerms diagnostic,
         inContextSearchTerms diagnostic
@@ -492,6 +493,31 @@ unknownImportTerms diagnostic =
               [word, lastSegment word]
         _ -> []
 
+moduleReferenceTerms :: Diagnostic -> [String]
+moduleReferenceTerms diagnostic =
+  concatMap referenceTerms (allDiagnosticText diagnostic)
+  where
+    referenceTerms line =
+      case words (trim line) of
+        ("import" : path : _) -> modulePathTerms path
+        ("export" : path : _) -> modulePathTerms path
+        _ -> []
+
+modulePathTerms :: String -> [String]
+modulePathTerms raw =
+  uniqueStrings
+    [ dropAt cleanPath,
+      cleanPath,
+      lastSegment cleanPath
+    ]
+  where
+    cleanPath =
+      trimModulePath raw
+
+trimModulePath :: String -> String
+trimModulePath =
+  takeWhile (\c -> c /= ';' && c /= ',' && c /= '{' && c /= '}')
+
 declarationSearchTerms :: Diagnostic -> [String]
 declarationSearchTerms diagnostic =
   concatMap declarationTerms (allDiagnosticText diagnostic)
@@ -539,13 +565,40 @@ prefixedTerms prefixes body =
 primaryLabelMessage :: Diagnostic -> String
 primaryLabelMessage diagnostic =
   case diagnosticCode diagnostic of
-    Just (DiagnosticCode "SC0201") -> "expression has mismatched type"
     Just (DiagnosticCode "SC0101") -> "unknown name"
+    Just (DiagnosticCode "SC0102") -> "undefined type variable"
+    Just (DiagnosticCode "SC0103") -> "undefined type constructor"
+    Just (DiagnosticCode "SC0104") -> "invalid type synonym"
+    Just (DiagnosticCode "SC0105") -> "undefined class"
+    Just (DiagnosticCode "SC0106") -> "unqualified constructor"
+    Just (DiagnosticCode "SC0107") -> "invalid pattern"
+    Just (DiagnosticCode "SC0110") -> "unknown import item"
+    Just (DiagnosticCode "SC0201") -> "expression has mismatched type"
     Just (DiagnosticCode "SC0202") -> "unknown name"
+    Just (DiagnosticCode "SC0203") -> "undefined type"
+    Just (DiagnosticCode "SC0204") -> "undefined field"
+    Just (DiagnosticCode "SC0205") -> "undefined constructor"
+    Just (DiagnosticCode "SC0206") -> "undefined function"
+    Just (DiagnosticCode "SC0207") -> "undefined class"
+    Just (DiagnosticCode "SC0208") -> "undefined type synonym"
     Just (DiagnosticCode "SC0301") -> "redundant clause"
     Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
+    Just (DiagnosticCode "SC0109") -> "module reference"
+    Just (DiagnosticCode "SC0118") -> "external library import"
+    Just (DiagnosticCode "SC0119") -> "source file"
     Nothing -> "diagnostic reported here"
-    _ -> diagnosticMessage diagnostic
+    _ -> defaultPrimaryLabelMessage diagnostic
+
+defaultPrimaryLabelMessage :: Diagnostic -> String
+defaultPrimaryLabelMessage diagnostic
+  | diagnosticMessageLooksLikeHeader diagnostic = "diagnostic reported here"
+  | otherwise = diagnosticMessage diagnostic
+
+diagnosticMessageLooksLikeHeader :: Diagnostic -> Bool
+diagnosticMessageLooksLikeHeader diagnostic =
+  '\n' `elem` message || length message > 80
+  where
+    message = diagnosticMessage diagnostic
 
 isDuplicateDiagnostic :: Diagnostic -> Bool
 isDuplicateDiagnostic diagnostic =
@@ -571,7 +624,7 @@ diagnosticSourcePaths diagnostic =
 
 sourcePathsFromLine :: String -> [FilePath]
 sourcePathsFromLine line =
-  mapMaybe (`sourcePathAfterPrefix` line) prefixes
+  mapMaybe (`sourcePathAfterPrefix` line) prefixes ++ standaloneSourcePaths line
   where
     prefixes =
       [ "module validation failed for ",
@@ -579,6 +632,10 @@ sourcePathsFromLine line =
         "source file is outside library root:"
       ]
 
+standaloneSourcePaths :: String -> [FilePath]
+standaloneSourcePaths line =
+  [path | let path = trim line, ".solc" `isSuffixOf` path]
+
 sourcePathAfterPrefix :: String -> String -> Maybe FilePath
 sourcePathAfterPrefix prefix line = do
   rest <- stripPrefix prefix (trim line)
@@ -602,6 +659,10 @@ lastSegment :: String -> String
 lastSegment =
   reverse . takeWhile (/= '.') . reverse
 
+dropAt :: String -> String
+dropAt ('@' : rest) = rest
+dropAt path = path
+
 splitCommaTerms :: String -> [String]
 splitCommaTerms raw =
   case break (== ',') raw of
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index ffcda9286..92e3ee0d0 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -80,6 +80,29 @@ diagnosticCliTests =
             "note: function foo ()",
             "note: Annotate every parameter (name : Type) and provide a return type (-> Type)."
           ],
+      testCase "legacy typecheck label does not repeat the full error" $
+        expectFailure
+          ["--root", "test/diagnostics", "--file", "test/diagnostics/not-polymorphic-enough.solc", "--no-specialise"]
+          [ "error: module typecheck failed for <cwd>/test/diagnostics/not-polymorphic-enough.solc (no desugaring):",
+            "  --> <cwd>/test/diagnostics/not-polymorphic-enough.solc:3:26",
+            "  |",
+            "3 |   assembly { result := x }",
+            "  |                          ^ diagnostic reported here",
+            "note: Type not polymorphic enough! The annotated type is:",
+            "note: forall a . word -> a",
+            "note: but the infered type is:",
+            "note: word -> word",
+            "note: in:",
+            "note: forall a . function fromWord (x : word) -> a",
+            "note: ",
+            "note: - in:forall a . function fromWord (x : word) -> a {",
+            "note: let result ;",
+            "note: assembly {",
+            "note: result := x",
+            "note: }",
+            "note: return result;",
+            "note: }"
+          ],
       testCase "import error" $
         expectFailure
           ["--root", "test/imports", "--file", "test/imports/select_unknown.solc", "--no-specialise"]
@@ -92,6 +115,18 @@ diagnosticCliTests =
             "note: selectlib.missing",
             "help: check the imported module's exported names"
           ],
+      testCase "loader error before graph keeps source span" $
+        expectFailure
+          ["--root", "test/imports", "--file", "test/imports/external_lib_missing_fail.solc", "--no-specialise"]
+          [ "error[SC0118]: external library root is not configured: @missing",
+            "  --> <cwd>/test/imports/external_lib_missing_fail.solc:1:9",
+            "  |",
+            "1 | import @missing.math.api;",
+            "  |         ^^^^^^^^^^^^^^^^ external library import",
+            "note: <cwd>/test/imports/external_lib_missing_fail.solc",
+            "note: import @missing.math.api",
+            "help: pass --external-lib NAME=PATH for external imports"
+          ],
       testCase "short output" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/undefined-name.solc", "--no-specialise", "--diagnostic-format", "short"]
diff --git a/test/diagnostics/not-polymorphic-enough.solc b/test/diagnostics/not-polymorphic-enough.solc
new file mode 100644
index 000000000..7400c26ce
--- /dev/null
+++ b/test/diagnostics/not-polymorphic-enough.solc
@@ -0,0 +1,5 @@
+forall a . function fromWord(x : word) -> a {
+  let result;
+  assembly { result := x }
+  return result;
+}

From e7c4c1568ae90a8dcf4359a6ed42a33f935f95ff Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Tue, 26 May 2026 19:09:13 +0200
Subject: [PATCH 26/35] Carry source spans through names

---
 src/Language/Yul/Parser.hs                    |   2 +-
 src/Solcore/Diagnostics.hs                    |  25 +++-
 src/Solcore/Frontend/Lexer/SolcoreLexer.x     |  16 ++-
 src/Solcore/Frontend/Module/Loader.hs         |  38 +++---
 src/Solcore/Frontend/Parser/SolcoreParser.y   |  30 +++--
 src/Solcore/Frontend/Syntax/Name.hs           |  61 ++++++++-
 src/Solcore/Frontend/Syntax/NameResolution.hs | 127 ++++++++++++++----
 .../Frontend/TypeInference/TcModule.hs        |   6 +-
 src/Solcore/Frontend/TypeInference/TcMonad.hs | 114 +++++++++++++---
 src/Solcore/Frontend/TypeInference/TcStmt.hs  |  18 +--
 src/Solcore/Pipeline/SolcorePipeline.hs       |   1 +
 test/DiagnosticCliTests.hs                    |  37 +++--
 12 files changed, 358 insertions(+), 117 deletions(-)

diff --git a/src/Language/Yul/Parser.hs b/src/Language/Yul/Parser.hs
index 546c26cb6..fa59528d9 100644
--- a/src/Language/Yul/Parser.hs
+++ b/src/Language/Yul/Parser.hs
@@ -2,7 +2,7 @@ module Language.Yul.Parser (parseYul, yulBlock, yulStmt, yulExp) where
 
 import Common.LightYear
 import Language.Yul
-import Solcore.Frontend.Syntax.Name (Name (..))
+import Solcore.Frontend.Syntax.Name (Name, pattern Name)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 parseYul :: String -> Yul
diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index b612db090..276eec413 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -24,6 +24,7 @@ module Solcore.Diagnostics
     sourceMapNull,
     findTokenSpansInSource,
     findTextSpansInSource,
+    combineSourceSpans,
     legacyDiagnostic,
     addDiagnosticNote,
     addDiagnosticHelp,
@@ -36,6 +37,7 @@ module Solcore.Diagnostics
 where
 
 import Data.Char (isAlpha, isAlphaNum)
+import Data.Generics (Data, Typeable)
 import Data.List (foldl', isPrefixOf, sortOn, stripPrefix, tails)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
@@ -63,7 +65,7 @@ data SourceSpan
     spanEndLine :: Int,
     spanEndColumn :: Int
   }
-  deriving (Eq, Ord, Read, Show)
+  deriving (Eq, Ord, Read, Show, Data, Typeable)
 
 data LabelStyle
   = Primary
@@ -237,7 +239,28 @@ findTextSpansInSource source needle
           spanStartColumn = column,
           spanEndLine = lineNo,
           spanEndColumn = column + needleLen
+      }
+
+combineSourceSpans :: SourceSpan -> SourceSpan -> SourceSpan
+combineSourceSpans left right
+  | spanFile left /= spanFile right = left
+  | otherwise =
+      SourceSpan
+        { spanFile = spanFile left,
+          spanStartByte = spanStartByte start,
+          spanEndByte = spanEndByte end,
+          spanStartLine = spanStartLine start,
+          spanStartColumn = spanStartColumn start,
+          spanEndLine = spanEndLine end,
+          spanEndColumn = spanEndColumn end
         }
+  where
+    start
+      | spanStartByte left <= spanStartByte right = left
+      | otherwise = right
+    end
+      | spanEndByte left >= spanEndByte right = left
+      | otherwise = right
 
 sourceLinesWithOffsets :: SourceFile -> [(Int, Int, String)]
 sourceLinesWithOffsets source =
diff --git a/src/Solcore/Frontend/Lexer/SolcoreLexer.x b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
index a2dc75327..f2a86723d 100644
--- a/src/Solcore/Frontend/Lexer/SolcoreLexer.x
+++ b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
@@ -247,8 +247,15 @@ uncurriedSourceSpan (line, column) =
       spanEndColumn = column + 1
     }
 
+data LocatedText
+  = LocatedText
+  { locatedTextSpan :: SourceSpan,
+    locatedTextText :: String
+  }
+  deriving (Eq, Ord, Show)
+
 data Lexeme
-  = TIdent { unIdent :: String }
+  = TIdent { unIdent :: LocatedText }
   | TNumber { unNum :: Integer }
   | TString { unStr :: String }
   | TContract
@@ -327,9 +334,10 @@ mkIdent :: AlexAction Token
 mkIdent (st, _, _, str) len
   = do
       file <- sourceName <$> get
-      pure $ mkToken file st len (lexemeFor (take len str))
+      let identSpan = sourceSpan file st len
+      pure $ mkTokenWithSpan identSpan (lexemeFor identSpan (take len str))
   where
-    lexemeFor str =
+    lexemeFor identSpan str =
       case str of
         "match" -> TMatch
         "data" -> TData
@@ -356,7 +364,7 @@ mkIdent (st, _, _, str) len
         "no-coverage-condition" -> TNoCoverageCondition
         "no-patterson-condition" -> TNoPattersonCondition
         "no-bounded-variable-condition" -> TNoBoundVariableCondition
-        _ -> TIdent str
+        _ -> TIdent (LocatedText identSpan str)
 
 mkNumber :: AlexAction Token
 mkNumber (st, _, _, str) len
diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 28f3c2e4e..9a21e9b0f 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -1083,8 +1083,8 @@ defaultModuleBindingName =
   moduleLeafName . Mod.modulePathName
 
 moduleLeafName :: Name -> Name
-moduleLeafName (Name n) = Name n
-moduleLeafName (QualName _ n) = Name n
+moduleLeafName n@(Name _) = n
+moduleLeafName q@(QualName _ n) = copyNameSourceSpan q (Name n)
 
 importModuleQualifiers :: ModulePath -> [Name]
 importModuleQualifiers importPath =
@@ -1138,17 +1138,17 @@ qualifiedImportStubDecls graph (imp, modulePath) =
           ++ nestedDecls
 
     stubNestedModule qualifier (ExportedModuleBinding bindingName targetModule) =
-      stubDecls (QualName qualifier (show bindingName)) targetModule
+      stubDecls (qualifyName qualifier bindingName) targetModule
 
 qualifyFunctionSignature :: Name -> FunDef -> FunDef
 qualifyFunctionSignature qualifier (FunDef sig body) =
   FunDef
-    (sig {sigName = QualName qualifier (show (sigName sig))})
+    (sig {sigName = qualifyName qualifier (sigName sig)})
     body
 
 qualifiedFunctionStubDecls :: Name -> CompUnit -> [TopDecl]
 qualifiedFunctionStubDecls qualifier cunit =
-  [ TFunDef (stubFunction (QualName qualifier (show (sigName (funSignature fd)))))
+  [ TFunDef (stubFunction (qualifyName qualifier (sigName (funSignature fd))))
     | TFunDef fd <- topDeclsFrom cunit
   ]
 
@@ -1157,7 +1157,7 @@ qualifierFromExpVarChain (ExpVar Nothing n) =
   Just n
 qualifierFromExpVarChain (ExpVar (Just e) n) = do
   q <- qualifierFromExpVarChain e
-  pure (QualName q (show n))
+  pure (qualifyName q n)
 qualifierFromExpVarChain _ =
   Nothing
 
@@ -1245,11 +1245,11 @@ renamePatTypeRefs _ p@(PWildcard) = p
 renamePatTypeRefs _ p@(PLit _) = p
 
 renamePatNameTypeRefs :: Map Name Name -> Name -> Name
-renamePatNameTypeRefs renameMap (QualName q n) =
-  QualName (renameTypeName renameMap q) n
+renamePatNameTypeRefs renameMap qn@(QualName q n) =
+  copyNameSourceSpan qn (QualName (renameTypeName renameMap q) n)
 renamePatNameTypeRefs renameMap n =
   case Map.lookup n renameMap of
-    Just qn -> QualName qn (show n)
+    Just qn -> qualifyName qn n
     Nothing -> n
 
 renameExpTypeRefs :: Map Name Name -> Exp -> Exp
@@ -1394,8 +1394,8 @@ renameConstrTypeRefs renameMap (Constr n tys) =
   Constr (renameConstrNameTypeRefs renameMap n) (map (renameTyTypeRefs renameMap) tys)
 
 renameConstrNameTypeRefs :: Map Name Name -> Name -> Name
-renameConstrNameTypeRefs renameMap (QualName q n) =
-  QualName (renameTypeName renameMap q) n
+renameConstrNameTypeRefs renameMap qn@(QualName q n) =
+  copyNameSourceSpan qn (QualName (renameTypeName renameMap q) n)
 renameConstrNameTypeRefs _ n = n
 
 renameTySymTypeRefs :: Map Name Name -> TySym -> TySym
@@ -1422,7 +1422,7 @@ renameTypeName renameMap n =
     Just n' -> n'
     Nothing ->
       case n of
-        QualName q x -> QualName (renameTypeName renameMap q) x
+        qn@(QualName q x) -> copyNameSourceSpan qn (QualName (renameTypeName renameMap q) x)
         _ -> n
 
 qualifiedTypeAliasDecls :: Map Name Name -> Name -> CompUnit -> [TopDecl]
@@ -1447,25 +1447,25 @@ qualifiedTypeStubDecls qualifier cunit =
     dataAliases =
       [ TDataDef
           ( DataTy
-              (QualName qualifier (show n))
+              (qualifyName qualifier n)
               []
               [Constr (constructorLeafName (constrName c)) [] | c <- cs]
           )
         | TDataDef (DataTy n _ cs) <- topDeclsFrom cunit
       ]
     symAliases =
-      [ TSym (stubType (QualName qualifier (show n)))
+      [ TSym (stubType (qualifyName qualifier n))
         | TSym (TySym n _ _) <- topDeclsFrom cunit
       ]
 
 constructorLeafName :: Name -> Name
-constructorLeafName (QualName _ n) = Name n
+constructorLeafName q@(QualName _ n) = copyNameSourceSpan q (Name n)
 constructorLeafName n = n
 
 qualifyTyCon :: Name -> Name -> [Ty] -> TySym
 qualifyTyCon qualifier unqualName tyVars =
   TySym
-    { symName = QualName qualifier (show unqualName),
+    { symName = qualifyName qualifier unqualName,
       symVars = tyVars,
       symType = TyCon unqualName tyVars
     }
@@ -1532,7 +1532,7 @@ typeCheckQualifiedImportDecls collidingTypeNames graph (imp, modulePath) =
           ++ nestedDecls
 
     qualifyNestedModule qualifier (ExportedModuleBinding bindingName targetModule) =
-      qualifyDecls (QualName qualifier (show bindingName)) targetModule
+      qualifyDecls (qualifyName qualifier bindingName) targetModule
 
 qualifiedFunctionSignatureDecls :: Map Name Name -> Name -> CompUnit -> [TopDecl]
 qualifiedFunctionSignatureDecls typeRenameMap qualifier cunit =
@@ -1580,7 +1580,7 @@ typeCheckImportedDecls collidingTypeNames graph (imp, modulePath) =
       pure (localSupportDecls ++ shadowImportedDecls localSupportDecls nestedSupportDecls)
 
     nestedModuleImportDecls qualifier (ExportedModuleBinding bindingName targetModule) =
-      moduleImportDecls (QualName qualifier (show bindingName)) targetModule
+      moduleImportDecls (qualifyName qualifier bindingName) targetModule
 
 typeCheckSupportNonFunctionDecls :: ModuleGraph -> Mod.ModuleId -> Either String [TopDecl]
 typeCheckSupportNonFunctionDecls graph =
@@ -1683,7 +1683,7 @@ fullConstructorNamesForRef graph itemRef = do
 importedTypeRenameMap :: Set Name -> Name -> [TopDecl] -> Map Name Name
 importedTypeRenameMap collidingTypeNames qualifier ds =
   Map.fromList
-    [ (n, QualName qualifier (show n))
+    [ (n, qualifyName qualifier n)
       | d <- ds,
         n <- topDeclImportedTypeNames d,
         n `Set.member` collidingTypeNames
diff --git a/src/Solcore/Frontend/Parser/SolcoreParser.y b/src/Solcore/Frontend/Parser/SolcoreParser.y
index e293e624f..1e86c3a7d 100644
--- a/src/Solcore/Frontend/Parser/SolcoreParser.y
+++ b/src/Solcore/Frontend/Parser/SolcoreParser.y
@@ -121,10 +121,10 @@ Import : 'import' ModName ';'                      { ImportModule (classifyImpor
        | 'import' ModName 'as' Name ';'            { ImportAlias (classifyImportPath $2) $4 }
        | 'import' ModName '.' '{' ImportItems '}' ImportHiding ';'
            { ImportOnly (classifyImportPath $2) (SelectItems $5 $7) }
-       | 'import' '@' identifier '.' ModName ';'   { ImportModule (ExternalPath (Name $3) $5) }
-       | 'import' '@' identifier '.' ModName 'as' Name ';' { ImportAlias (ExternalPath (Name $3) $5) $7 }
+       | 'import' '@' identifier '.' ModName ';'   { ImportModule (ExternalPath (nameFromIdent $3) $5) }
+       | 'import' '@' identifier '.' ModName 'as' Name ';' { ImportAlias (ExternalPath (nameFromIdent $3) $5) $7 }
        | 'import' '@' identifier '.' ModName '.' '{' ImportItems '}' ImportHiding ';'
-           { ImportOnly (ExternalPath (Name $3) $5) (SelectItems $8 $10) }
+           { ImportOnly (ExternalPath (nameFromIdent $3) $5) (SelectItems $8 $10) }
 
 ImportItems :: { [ItemSelectorEntry] }
 ImportItems : ImportItemList                       { $1 }
@@ -146,11 +146,11 @@ HidingItemList : ItemName ',' HidingItemList       { $1 : $3 }
                | ItemName                          { [$1] }
 
 ModName :: { Name }
-ModName : identifier                               { Name $1 }
-        | ModName '.' identifier                   { QualName $1 $3 }
+ModName : identifier                               { nameFromIdent $1 }
+        | ModName '.' identifier                   { qualNameFromIdent $1 $3 }
 
 ItemName :: { Name }
-ItemName : identifier                              { Name $1 }
+ItemName : identifier                              { nameFromIdent $1 }
 
 TopDeclList :: { [TopDecl] }
 TopDeclList : TopDecl TopDeclList                  { $1 : $2 }
@@ -173,7 +173,7 @@ ExportDecl :: { Export }
 ExportDecl : 'export' '{' ExportItems '}' ';'      { ExportList $3 }
            | 'export' ModName ExportTail           { $3 (classifyImportPath $2) }
            | 'export' '@' identifier '.' ModName ExportTail
-               { $6 (ExternalPath (Name $3) $5) }
+               { $6 (ExternalPath (nameFromIdent $3) $5) }
 
 ExportTail :: { ModulePath -> Export }
 ExportTail : ';'                                   { ExportModule }
@@ -194,7 +194,7 @@ ExportListItem : '*'                               { ExportAll }
                | ItemName                          { ExportName $1 }
                | ItemName '(' ExportConstructorItems ')' { ExportNameWithConstructors $1 $3 }
                | ModName '.' '*'                   { ExportModuleAll (classifyImportPath $1) }
-               | '@' identifier '.' ModName '.' '*' { ExportModuleAll (ExternalPath (Name $2) $4) }
+               | '@' identifier '.' ModName '.' '*' { ExportModuleAll (ExternalPath (nameFromIdent $2) $4) }
 
 ExportFromItems :: { [ExportSelectorEntry] }
 ExportFromItems : ExportFromItemList               { $1 }
@@ -517,11 +517,11 @@ Var :: { Ty }
 Var : Name                                         {TyCon $1 []}
 
 Name :: { Name }
-Name : identifier                                 { Name $1 }
+Name : identifier                                 { nameFromIdent $1 }
 
 TypeName :: { Name }
-TypeName : identifier                             { Name $1 }
-         | TypeName '.' identifier               { QualName $1 $3 }
+TypeName : identifier                             { nameFromIdent $1 }
+         | TypeName '.' identifier               { qualNameFromIdent $1 $3 }
 
 -- Yul statments and blocks
 
@@ -621,6 +621,14 @@ parseCompUnitWithPath sourcePath content
 parseCompUnit :: String -> IO (Either String CompUnit)
 parseCompUnit = moduleParser []
 
+nameFromIdent :: LocatedText -> Name
+nameFromIdent ident =
+  locatedName (locatedTextSpan ident) (Name (locatedTextText ident))
+
+qualNameFromIdent :: Name -> LocatedText -> Name
+qualNameFromIdent qualifier ident =
+  locatedQualName qualifier (locatedTextSpan ident) (locatedTextText ident)
+
 classifyImportPath :: Name -> ModulePath
 classifyImportPath modName =
   case splitName modName of
diff --git a/src/Solcore/Frontend/Syntax/Name.hs b/src/Solcore/Frontend/Syntax/Name.hs
index 56c111d01..b6cf2d098 100644
--- a/src/Solcore/Frontend/Syntax/Name.hs
+++ b/src/Solcore/Frontend/Syntax/Name.hs
@@ -1,15 +1,36 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Solcore.Frontend.Syntax.Name where
 
 import Common.Pretty
+import Control.Applicative ((<|>))
 import Data.Generics (Data, Typeable)
 import Data.String
+import Solcore.Diagnostics (SourceSpan, combineSourceSpans)
 
 data Name
-  = Name String
-  | QualName Name String
-  deriving (Eq, Ord, Data, Typeable)
+  = NameWithSpan (Maybe SourceSpan) String
+  | QualNameWithSpan (Maybe SourceSpan) Name String
+  deriving (Data, Typeable)
+
+pattern Name :: String -> Name
+pattern Name s <- NameWithSpan _ s
+  where
+    Name s = NameWithSpan Nothing s
+
+pattern QualName :: Name -> String -> Name
+pattern QualName n s <- QualNameWithSpan _ n s
+  where
+    QualName n s = QualNameWithSpan Nothing n s
+
+{-# COMPLETE Name, QualName #-}
+
+instance Eq Name where
+  left == right = nameSegments left == nameSegments right
+
+instance Ord Name where
+  compare left right = compare (nameSegments left) (nameSegments right)
 
 instance Show Name where
   show (Name s) = s
@@ -22,3 +43,37 @@ instance IsString Name where
 instance Pretty Name where
   ppr (QualName n s) = ppr n <> text "." <> text s
   ppr (Name s) = text s
+
+nameSourceSpan :: Name -> Maybe SourceSpan
+nameSourceSpan (NameWithSpan sourceSpan _) = sourceSpan
+nameSourceSpan (QualNameWithSpan sourceSpan qualifier _) = sourceSpan <|> nameSourceSpan qualifier
+
+locatedName :: SourceSpan -> Name -> Name
+locatedName sourceSpan (Name s) = NameWithSpan (Just sourceSpan) s
+locatedName sourceSpan (QualName qualifier s) = QualNameWithSpan (Just sourceSpan) qualifier s
+
+withNameSourceSpan :: Maybe SourceSpan -> Name -> Name
+withNameSourceSpan Nothing name = name
+withNameSourceSpan (Just sourceSpan) name = locatedName sourceSpan name
+
+copyNameSourceSpan :: Name -> Name -> Name
+copyNameSourceSpan source target =
+  withNameSourceSpan (nameSourceSpan source) target
+
+qualifyName :: Name -> Name -> Name
+qualifyName qualifier leaf =
+  copyNameSourceSpan leaf (QualName qualifier (show leaf))
+
+locatedQualName :: Name -> SourceSpan -> String -> Name
+locatedQualName qualifier leafSpan leaf =
+  QualNameWithSpan (Just sourceSpan) qualifier leaf
+  where
+    sourceSpan = maybe leafSpan (`combineSourceSpans` leafSpan) (nameSourceSpan qualifier)
+
+stripNameSourceSpan :: Name -> Name
+stripNameSourceSpan (Name s) = Name s
+stripNameSourceSpan (QualName qualifier s) = QualName (stripNameSourceSpan qualifier) s
+
+nameSegments :: Name -> [String]
+nameSegments (Name s) = [s]
+nameSegments (QualName n s) = nameSegments n ++ [s]
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index f43a13067..51db7ffe0 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -5,10 +5,13 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.State
+import Data.Generics (Data, everything, mkQ)
 import Data.List ((\\))
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
+import Data.Maybe (mapMaybe)
+import Data.Monoid (First (..))
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
 import Solcore.Frontend.Syntax.Name
@@ -131,7 +134,7 @@ contractTermNames = concatMap collect
 
 qualifiedConstructorName :: Name -> Name -> Name
 qualifiedConstructorName tyCon conName =
-  QualName tyCon (pretty (constructorLeafName conName))
+  qualifyName tyCon (constructorLeafName conName)
 
 ensureNoDuplicateNames :: String -> [Name] -> Either String ()
 ensureNoDuplicateNames ns = ensureNoDuplicateNamesIn "module" ns
@@ -455,11 +458,11 @@ pairPat :: Pat Name -> Pat Name -> Pat Name
 pairPat p1 p2 = PCon (Name "pair") [p1, p2]
 
 constructorLeafName :: Name -> Name
-constructorLeafName (QualName _ n) = Name n
+constructorLeafName q@(QualName _ n) = copyNameSourceSpan q (Name n)
 constructorLeafName n = n
 
 dotConstructorMarker :: Name -> Name
-dotConstructorMarker n = Name ('.' : pretty (constructorLeafName n))
+dotConstructorMarker n = copyNameSourceSpan n (Name ('.' : pretty (constructorLeafName n)))
 
 isPrimitiveConstructor :: Name -> Bool
 isPrimitiveConstructor n =
@@ -475,8 +478,8 @@ isPrimitiveConstructor n =
       ]
 
 splitQualifiedName :: Name -> Maybe (Name, Name)
-splitQualifiedName (QualName qualifier conName) =
-  Just (qualifier, Name conName)
+splitQualifiedName q@(QualName qualifier conName) =
+  Just (qualifier, copyNameSourceSpan q (Name conName))
 splitQualifiedName _ = Nothing
 
 hasQualifiedConstructorLeaf :: Name -> ResolveM Bool
@@ -555,7 +558,7 @@ instance Resolve S.Exp where
         (Just (Var d), Just TDataCon) ->
           Con <$> resolveQualifiedConstructorName d n <*> pure []
         (Just (Var d), Just TTyCon) -> do
-          let qn = QualName d (pretty n)
+          let qn = qualifyName d n
           qdt <- lookupName qn
           case qdt of
             Just TFunction -> pure (Var qn)
@@ -575,7 +578,7 @@ instance Resolve S.Exp where
         (_, Just TModule) -> pure (Var n)
         -- module-qualified function or constructor reference
         (Just (Var d), Nothing) -> do
-          let qn = QualName d (pretty n)
+          let qn = qualifyName d n
           qdt <- lookupName qn
           case qdt of
             Just TFunction -> pure (Var qn)
@@ -583,7 +586,7 @@ instance Resolve S.Exp where
             Just TTyCon -> pure (Var qn)
             Just TModule -> pure (Var qn)
             _ -> do
-              let fallback = QualName (constructorLeafName d) (pretty n)
+              let fallback = qualifyName (constructorLeafName d) n
               fdt <- lookupName fallback
               case fdt of
                 Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
@@ -622,7 +625,7 @@ instance Resolve S.Exp where
         (Just (Var d), Just TDataCon) ->
           Con <$> resolveQualifiedConstructorName d n <*> pure es'
         (Just (Var c), Just TTyCon) -> do
-          let qn = QualName c (pretty n)
+          let qn = qualifyName c n
           qdt <- lookupName qn
           case qdt of
             Just TFunction -> pure (Call Nothing qn es')
@@ -631,7 +634,7 @@ instance Resolve S.Exp where
         -- class functions
         (Just (Var c), Just TFunction) -> do
           ct <- lookupName c
-          let qn = QualName c (pretty n)
+          let qn = qualifyName c n
           case ct of
             Just TClass ->
               pure (Call Nothing qn es')
@@ -644,7 +647,7 @@ instance Resolve S.Exp where
             _ -> undefinedName c
         (Just (Var c), Nothing) -> do
           ct <- lookupName c
-          let qn = QualName c (pretty n)
+          let qn = qualifyName c n
           cf <- lookupName qn
           case (ct, cf) of
             (Just TClass, Just TFunction) ->
@@ -654,14 +657,14 @@ instance Resolve S.Exp where
             (_, Just TDataCon) ->
               Con <$> resolveQualifiedConstructorName c n <*> pure es'
             _ -> do
-              let fallback = QualName (constructorLeafName c) (pretty n)
+              let fallback = qualifyName (constructorLeafName c) n
               fdt <- lookupName fallback
               case fdt of
                 Just TDataCon ->
                   Con <$> resolveQualifiedConstructorName c n <*> pure es'
                 _ -> undefinedName n
         (Just (Var c), Just TTyVar) -> do
-          let qn = QualName c (pretty n)
+          let qn = qualifyName c n
           cf <- gets (Map.lookup qn . scopeEnv)
           case cf of
             Just TFunction -> pure (Call Nothing qn es')
@@ -924,7 +927,7 @@ addTopDecl (S.TClassDef (S.Class _ _ n _ _ sigs)) env =
   let env' =
         foldr
           ( \s ac ->
-              let qn = QualName n (pretty (S.sigName s))
+              let qn = qualifyName n (S.sigName s)
                in Map.insert qn TFunction ac
           )
           (scopeEnv env)
@@ -1005,7 +1008,7 @@ lookupName n =
         fdt = Map.lookup n (fieldEnv env)
     pure (ldt <|> gdt <|> cdt <|> fdt)
 
-wrapError :: (Pretty b) => ResolveM a -> b -> ResolveM a
+wrapError :: (Pretty b, Data b) => ResolveM a -> b -> ResolveM a
 wrapError m e =
   catchError m handler
   where
@@ -1013,9 +1016,45 @@ wrapError m e =
     decorate msg =
       case decodeDiagnostic msg of
         Just diagnostic ->
-          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) diagnostic)
+          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) (addContextLabel e diagnostic))
         Nothing -> msg ++ "\n - in:" ++ pretty e
 
+addContextLabel :: (Data b) => b -> Diagnostic -> Diagnostic
+addContextLabel context diagnostic
+  | any ((== Primary) . labelStyle) (diagnosticLabels diagnostic) = diagnostic
+  | otherwise =
+      case contextSourceSpan context of
+        Just sourceSpan ->
+          diagnostic
+            { diagnosticLabels =
+                Label
+                  { labelSpan = sourceSpan,
+                    labelStyle = Primary,
+                    labelMessage = Just (contextLabelMessage diagnostic)
+                  }
+                  : diagnosticLabels diagnostic
+            }
+        Nothing -> diagnostic
+
+contextLabelMessage :: Diagnostic -> String
+contextLabelMessage diagnostic =
+  case diagnosticCode diagnostic of
+    Just (DiagnosticCode "SC0101") -> "unknown name"
+    Just (DiagnosticCode "SC0102") -> "undefined type variable"
+    Just (DiagnosticCode "SC0103") -> "undefined type constructor"
+    Just (DiagnosticCode "SC0104") -> "invalid type synonym"
+    Just (DiagnosticCode "SC0105") -> "undefined class"
+    Just (DiagnosticCode "SC0106") -> "unqualified constructor"
+    Just (DiagnosticCode "SC0107") -> "invalid pattern"
+    _ -> "diagnostic reported here"
+
+contextSourceSpan :: (Data a) => a -> Maybe SourceSpan
+contextSourceSpan value =
+  getFirst $ everything (<>) (mkQ (First Nothing) nameSpan) value
+  where
+    nameSpan :: Name -> First SourceSpan
+    nameSpan = First . nameSourceSpan
+
 addContractName :: Name -> ResolveM ()
 addContractName n =
   modify (\env -> env {typeEnv = Map.insert n TContract (typeEnv env)})
@@ -1061,12 +1100,12 @@ addTyVar n =
 resolveQualifiedConstructorName :: Name -> Name -> ResolveM Name
 resolveQualifiedConstructorName qualifier conName =
   do
-    let qn = QualName qualifier (pretty conName)
+    let qn = qualifyName qualifier conName
     dt <- lookupName qn
     case dt of
       Just TDataCon -> pure qn
       _ ->
-        let fallback = QualName (constructorLeafName qualifier) (pretty conName)
+        let fallback = qualifyName (constructorLeafName qualifier) conName
          in do
               fdt <- lookupName fallback
               case fdt of
@@ -1077,49 +1116,60 @@ resolveQualifiedConstructorName qualifier conName =
 
 undefinedTypeVariables :: [Name] -> ResolveM a
 undefinedTypeVariables ns =
-  diagnosticError
+  diagnosticErrorWithLabels
     "SC0102"
     ("undefined type variables: " ++ unwords (map pretty ns))
+    (mapMaybe (primaryNameLabel "undefined type variable") ns)
     []
     []
 
 undefinedTypeConstructor :: S.Ty -> ResolveM a
 undefinedTypeConstructor t =
-  diagnosticError
+  diagnosticErrorAtName
     "SC0103"
     ("undefined type constructor: " ++ pretty t)
+    (S.tyName t)
+    "undefined type constructor"
     []
     []
 
 invalidTypeSynonymError :: S.TySym -> ResolveM a
 invalidTypeSynonymError t =
-  diagnosticError
+  diagnosticErrorAtName
     "SC0104"
     ("invalid type synonym: " ++ pretty t)
+    (S.symName t)
+    "invalid type synonym"
     []
     []
 
 undefinedClassError :: Name -> ResolveM a
 undefinedClassError n =
-  diagnosticError
+  diagnosticErrorAtName
     "SC0105"
     ("undefined class: " ++ pretty n)
+    n
+    "undefined class"
     []
     []
 
 undefinedName :: Name -> ResolveM a
 undefinedName n =
-  diagnosticError
+  diagnosticErrorAtName
     "SC0101"
     ("undefined name: " ++ pretty n)
+    n
+    "unknown name"
     []
     []
 
 unqualifiedConstructorError :: Name -> ResolveM a
 unqualifiedConstructorError n =
-  diagnosticError
+  diagnosticErrorAtName
     "SC0106"
     ("unqualified constructor: " ++ pretty n)
+    n
+    "constructor must be qualified"
     []
     ["use Type.Constructor form"]
 
@@ -1133,16 +1183,39 @@ invalidPatternSyntax p =
 
 diagnosticError :: String -> String -> [String] -> [String] -> ResolveM a
 diagnosticError code message notes help =
-  throwError $ diagnosticString code message notes help
+  diagnosticErrorWithLabels code message [] notes help
+
+diagnosticErrorAtName :: String -> String -> Name -> String -> [String] -> [String] -> ResolveM a
+diagnosticErrorAtName code message identName label notes help =
+  diagnosticErrorWithLabels code message (maybe [] pure (primaryNameLabel label identName)) notes help
+
+diagnosticErrorWithLabels :: String -> String -> [Label] -> [String] -> [String] -> ResolveM a
+diagnosticErrorWithLabels code message labels notes help =
+  throwError $ diagnosticStringWithLabels code message labels notes help
 
 diagnosticString :: String -> String -> [String] -> [String] -> String
 diagnosticString code message notes help =
+  diagnosticStringWithLabels code message [] notes help
+
+diagnosticStringWithLabels :: String -> String -> [Label] -> [String] -> [String] -> String
+diagnosticStringWithLabels code message labels notes help =
   encodeDiagnostic
     Diagnostic
       { diagnosticSeverity = Error,
         diagnosticCode = Just (DiagnosticCode code),
         diagnosticMessage = message,
-        diagnosticLabels = [],
+        diagnosticLabels = labels,
         diagnosticNotes = notes,
         diagnosticHelp = help
       }
+
+primaryNameLabel :: String -> Name -> Maybe Label
+primaryNameLabel message identName =
+  do
+    sourceSpan <- nameSourceSpan identName
+    pure
+      Label
+        { labelSpan = sourceSpan,
+          labelStyle = Primary,
+          labelMessage = Just message
+        }
diff --git a/src/Solcore/Frontend/TypeInference/TcModule.hs b/src/Solcore/Frontend/TypeInference/TcModule.hs
index f58d2a9e7..7e91ad838 100644
--- a/src/Solcore/Frontend/TypeInference/TcModule.hs
+++ b/src/Solcore/Frontend/TypeInference/TcModule.hs
@@ -401,8 +401,8 @@ defaultImportQualifiers importPath =
     leafName = importedModuleLeafName fullName
 
 importedModuleLeafName :: Name -> Name
-importedModuleLeafName (Name n) = Name n
-importedModuleLeafName (QualName _ n) = Name n
+importedModuleLeafName n@(Name _) = n
+importedModuleLeafName q@(QualName _ n) = copyNameSourceSpan q (Name n)
 
 typedForwardingWrapper :: Name -> FunDef Id -> FunDef Id
 typedForwardingWrapper qualifier (FunDef sig body)
@@ -416,7 +416,7 @@ typedForwardingWrapper qualifier (FunDef sig body)
         [Return (Call Nothing targetId args)]
   where
     originalName = sigName sig
-    qualifiedName = QualName qualifier (show originalName)
+    qualifiedName = qualifyName qualifier originalName
     targetId = Id originalName (typedSignatureType sig)
     args = map (Var . paramName) (sigParams sig)
 
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index 9ff64051e..0506a8ce2 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -3,12 +3,14 @@ module Solcore.Frontend.TypeInference.TcMonad where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.State
+import Data.Generics (Data, everything, mkQ)
 import Data.List
 import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
+import Data.Monoid (First (..))
 import Data.Set qualified as Set
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -653,7 +655,7 @@ dumpLogs = do
 
 -- wrapping error messages
 
-wrapError :: (Pretty b) => TcM a -> b -> TcM a
+wrapError :: (Pretty b, Data b) => TcM a -> b -> TcM a
 wrapError m e =
   catchError m handler
   where
@@ -661,9 +663,47 @@ wrapError m e =
     decorate msg =
       case decodeDiagnostic msg of
         Just diagnostic ->
-          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) diagnostic)
+          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) (addContextLabel e diagnostic))
         Nothing -> msg ++ "\n - in:" ++ pretty e
 
+addContextLabel :: (Data b) => b -> Diagnostic -> Diagnostic
+addContextLabel context diagnostic
+  | any ((== Primary) . labelStyle) (diagnosticLabels diagnostic) = diagnostic
+  | otherwise =
+      case contextSourceSpan context of
+        Just sourceSpan ->
+          diagnostic
+            { diagnosticLabels =
+                Label
+                  { labelSpan = sourceSpan,
+                    labelStyle = Primary,
+                    labelMessage = Just (contextLabelMessage diagnostic)
+                  }
+                  : diagnosticLabels diagnostic
+            }
+        Nothing -> diagnostic
+
+contextLabelMessage :: Diagnostic -> String
+contextLabelMessage diagnostic =
+  case diagnosticCode diagnostic of
+    Just (DiagnosticCode "SC0201") -> "expression has mismatched type"
+    Just (DiagnosticCode "SC0202") -> "unknown name"
+    Just (DiagnosticCode "SC0203") -> "undefined type"
+    Just (DiagnosticCode "SC0204") -> "undefined field"
+    Just (DiagnosticCode "SC0205") -> "undefined constructor"
+    Just (DiagnosticCode "SC0206") -> "undefined function"
+    Just (DiagnosticCode "SC0207") -> "undefined class"
+    Just (DiagnosticCode "SC0208") -> "undefined type synonym"
+    Just (DiagnosticCode "SC0209") -> "type is not polymorphic enough"
+    _ -> "diagnostic reported here"
+
+contextSourceSpan :: (Data a) => a -> Maybe SourceSpan
+contextSourceSpan value =
+  getFirst $ everything (<>) (mkQ (First Nothing) nameSpan) value
+  where
+    nameSpan :: Name -> First SourceSpan
+    nameSpan = First . nameSourceSpan
+
 tcmMgu :: Ty -> Ty -> TcM Subst
 tcmMgu t u = catchError (mgu t u) tcmError
 
@@ -677,9 +717,11 @@ tcmError s = do
 
 undefinedName :: Name -> TcM a
 undefinedName n =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0202"
     ("undefined name: " ++ pretty n)
+    n
+    "unknown name"
     []
     []
 
@@ -687,77 +729,109 @@ undefinedType :: Name -> TcM a
 undefinedType n =
   do
     s <- (unlines . reverse) <$> gets logs
-    tcDiagnosticError
+    tcDiagnosticErrorAtName
       "SC0203"
       ("undefined type: " ++ pretty n)
+      n
+      "undefined type"
       (if null s then [] else [s])
       []
 
 undefinedField :: Name -> Name -> TcM a
 undefinedField n n' =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0204"
     ("undefined field: " ++ pretty n)
+    n
+    "undefined field"
     ["in type: " ++ pretty n']
     []
 
 undefinedConstr :: Name -> Name -> TcM a
 undefinedConstr tn cn =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0205"
     ("undefined constructor: " ++ pretty cn)
+    cn
+    "undefined constructor"
     ["in type: " ++ pretty tn]
     []
 
 undefinedFunction :: Name -> Name -> TcM a
 undefinedFunction t n =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0206"
     ("undefined function: " ++ pretty n)
+    n
+    "undefined function"
     ["type " ++ pretty t ++ " does not define this function"]
     []
 
 typeNotPolymorphicEnough :: Signature Name -> Scheme -> Scheme -> TcM a
 typeNotPolymorphicEnough sig sch1 sch2 =
-  tcmError $
-    unlines
-      [ "Type not polymorphic enough! The annotated type is:",
-        pretty sch2,
-        "but the infered type is:",
-        pretty sch1,
-        "in:",
-        pretty sig
-      ]
+  tcDiagnosticErrorAtName
+    "SC0209"
+    "type is not polymorphic enough"
+    (sigName sig)
+    "annotated type is not polymorphic enough"
+    [ "annotated type: " ++ pretty sch2,
+      "inferred type: " ++ pretty sch1,
+      "in: " ++ pretty sig
+    ]
+    []
 
 undefinedClass :: Name -> TcM a
 undefinedClass n =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0207"
     ("undefined class: " ++ pretty n)
+    n
+    "undefined class"
     []
     []
 
 undefinedSynonym :: Name -> TcM a
 undefinedSynonym n =
-  tcDiagnosticError
+  tcDiagnosticErrorAtName
     "SC0208"
     ("undefined type synonym: " ++ pretty n)
+    n
+    "undefined type synonym"
     []
     []
 
 tcDiagnosticError :: String -> String -> [String] -> [String] -> TcM a
 tcDiagnosticError code message notes help =
+  tcDiagnosticErrorWithLabels code message [] notes help
+
+tcDiagnosticErrorAtName :: String -> String -> Name -> String -> [String] -> [String] -> TcM a
+tcDiagnosticErrorAtName code message identName label notes help =
+  tcDiagnosticErrorWithLabels code message (maybe [] pure (primaryNameLabel label identName)) notes help
+
+tcDiagnosticErrorWithLabels :: String -> String -> [Label] -> [String] -> [String] -> TcM a
+tcDiagnosticErrorWithLabels code message labels notes help =
   throwError $
     encodeDiagnostic
       Diagnostic
         { diagnosticSeverity = Error,
           diagnosticCode = Just (DiagnosticCode code),
           diagnosticMessage = message,
-          diagnosticLabels = [],
+          diagnosticLabels = labels,
           diagnosticNotes = notes,
           diagnosticHelp = help
         }
 
+primaryNameLabel :: String -> Name -> Maybe Label
+primaryNameLabel message identName =
+  do
+    sourceSpan <- nameSourceSpan identName
+    pure
+      Label
+        { labelSpan = sourceSpan,
+          labelStyle = Primary,
+          labelMessage = Just message
+        }
+
 typeAlreadyDefinedError :: DataTy -> Name -> TcM a
 typeAlreadyDefinedError d n =
   do
diff --git a/src/Solcore/Frontend/TypeInference/TcStmt.hs b/src/Solcore/Frontend/TypeInference/TcStmt.hs
index 92bfffbd2..98e075df4 100644
--- a/src/Solcore/Frontend/TypeInference/TcStmt.hs
+++ b/src/Solcore/Frontend/TypeInference/TcStmt.hs
@@ -860,12 +860,12 @@ annotateParam t (Untyped n) = Typed n t
 
 correctName :: Name -> TcM Name
 correctName n@(QualName _ _) = pure n
-correctName (Name s) =
+correctName n@(Name s) =
   do
     c <- gets contract
     if isJust c
-      then pure (QualName (fromJust c) s)
-      else pure (Name s)
+      then pure (copyNameSourceSpan n (QualName (fromJust c) s))
+      else pure n
 
 extSignature :: Signature Name -> TcM ()
 extSignature sig@(Signature _ _ n _ _) =
@@ -942,7 +942,7 @@ verifySignatures instd@(Instance _ _ ps n ts t funs) =
     s <- match classc' ih `wrapError` instd
     -- getting method types
     let qnames = map qual (methods cinfo)
-        qual v = if v == invoke then v else QualName n (pretty v)
+        qual v = if v == invoke then v else qualifyName n v
     -- getting most general types and instantiate them
     aqts <-
       mapM
@@ -1019,7 +1019,7 @@ schemeFromSignature sig =
 
 updateSignature :: [Tyvar] -> Name -> FunDef Id -> FunDef Id
 updateSignature vs' c (FunDef (Signature vs ps n args rt) bd) =
-  FunDef (Signature (vs \\ vs') ps (QualName c (pretty n)) args rt) bd
+  FunDef (Signature (vs \\ vs') ps (qualifyName c n) args rt) bd
 
 checkDeferedConstraints :: [(FunDef Id, [Pred])] -> TcM ()
 checkDeferedConstraints = mapM_ checkDeferedConstraint
@@ -1203,7 +1203,7 @@ checkMethod ih@(InCls n _ _) d@(FunDef sig _) =
     -- checking if the signature is fully annotated
     fullSignature sig
     -- getting current method signature in class
-    let qn = QualName n (show (sigName sig))
+    let qn = qualifyName n (sigName sig)
     sch <- askEnv qn `wrapError` d
     (qs :=> _) <- freshInst sch
     p <-
@@ -1393,7 +1393,7 @@ canonicalizeConstructorName n =
     case mUnqual of
       Just _ -> pure n
       Nothing -> do
-        let qn = QualName n (pretty n)
+        let qn = qualifyName n n
         mQual <- maybeAskEnv qn
         pure (if isJust mQual then qn else n)
 
@@ -1517,11 +1517,11 @@ isDotConstructorMarker (Name ('.' : _)) = True
 isDotConstructorMarker _ = False
 
 dotMarkerLeafName :: Name -> Name
-dotMarkerLeafName (Name ('.' : xs)) = Name xs
+dotMarkerLeafName n@(Name ('.' : xs)) = copyNameSourceSpan n (Name xs)
 dotMarkerLeafName n = constructorLeafName n
 
 constructorLeafName :: Name -> Name
-constructorLeafName (QualName _ n) = Name n
+constructorLeafName q@(QualName _ n) = copyNameSourceSpan q (Name n)
 constructorLeafName n = n
 
 typeName :: Ty -> TcM Name
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 0e3cde8ed..0f0be3e6c 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -581,6 +581,7 @@ primaryLabelMessage diagnostic =
     Just (DiagnosticCode "SC0206") -> "undefined function"
     Just (DiagnosticCode "SC0207") -> "undefined class"
     Just (DiagnosticCode "SC0208") -> "undefined type synonym"
+    Just (DiagnosticCode "SC0209") -> "type is not polymorphic enough"
     Just (DiagnosticCode "SC0301") -> "redundant clause"
     Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
     Just (DiagnosticCode "SC0109") -> "module reference"
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index 92e3ee0d0..cd55f0636 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -80,28 +80,27 @@ diagnosticCliTests =
             "note: function foo ()",
             "note: Annotate every parameter (name : Type) and provide a return type (-> Type)."
           ],
-      testCase "legacy typecheck label does not repeat the full error" $
+      testCase "polymorphic type error uses signature span" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/not-polymorphic-enough.solc", "--no-specialise"]
-          [ "error: module typecheck failed for <cwd>/test/diagnostics/not-polymorphic-enough.solc (no desugaring):",
-            "  --> <cwd>/test/diagnostics/not-polymorphic-enough.solc:3:26",
+          [ "error[SC0209]: type is not polymorphic enough",
+            "  --> <cwd>/test/diagnostics/not-polymorphic-enough.solc:1:21",
             "  |",
-            "3 |   assembly { result := x }",
-            "  |                          ^ diagnostic reported here",
-            "note: Type not polymorphic enough! The annotated type is:",
-            "note: forall a . word -> a",
-            "note: but the infered type is:",
-            "note: word -> word",
-            "note: in:",
-            "note: forall a . function fromWord (x : word) -> a",
-            "note: ",
-            "note: - in:forall a . function fromWord (x : word) -> a {",
-            "note: let result ;",
-            "note: assembly {",
-            "note: result := x",
-            "note: }",
-            "note: return result;",
-            "note: }"
+            "1 | forall a . function fromWord(x : word) -> a {",
+            "  |                     ^^^^^^^^ annotated type is not polymorphic enough",
+            "note: annotated type: forall a . word -> a",
+            "note: inferred type: word -> word",
+            "note: in: forall a . function fromWord (x : word) -> a",
+            "note: in: forall a . function fromWord (x : word) -> a {",
+            "      let result ;",
+            "      assembly {",
+            "      result := x",
+            "      }",
+            "      return result;",
+            "      }",
+            "note: module typecheck failed for",
+            "      <cwd>/test/diagnostics/not-polymorphic-enough.solc (no",
+            "      desugaring)"
           ],
       testCase "import error" $
         expectFailure

From 87b025aee9fe849b9ab7615e1ead20f0d02cc533 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Tue, 26 May 2026 22:54:17 +0200
Subject: [PATCH 27/35] Add explicit AST locations

---
 sol-core.cabal                                |   1 +
 src/Solcore/Backend/Mast.hs                   |   2 +-
 src/Solcore/Frontend/Lexer/SolcoreLexer.x     |  22 +-
 src/Solcore/Frontend/Parser/SolcoreParser.y   | 149 +++---
 src/Solcore/Frontend/Syntax.hs                |   2 +
 src/Solcore/Frontend/Syntax/Location.hs       |  51 ++
 src/Solcore/Frontend/Syntax/Name.hs           |   4 +
 src/Solcore/Frontend/Syntax/NameResolution.hs | 100 ++--
 src/Solcore/Frontend/Syntax/Stmt.hs           | 251 +++++++++-
 src/Solcore/Frontend/Syntax/SyntaxTree.hs     | 441 ++++++++++++++++--
 src/Solcore/Frontend/Syntax/Ty.hs             |  43 +-
 src/Solcore/Frontend/TypeInference/TcStmt.hs  |  81 +++-
 12 files changed, 938 insertions(+), 209 deletions(-)
 create mode 100644 src/Solcore/Frontend/Syntax/Location.hs

diff --git a/sol-core.cabal b/sol-core.cabal
index 9dafd4eb7..d50ff5c9c 100644
--- a/sol-core.cabal
+++ b/sol-core.cabal
@@ -86,6 +86,7 @@ library
       Solcore.Frontend.Syntax
       Solcore.Frontend.Syntax.Ty
       Solcore.Frontend.Syntax.Contract
+      Solcore.Frontend.Syntax.Location
       Solcore.Frontend.Syntax.Name
       Solcore.Frontend.Syntax.NameResolution
       Solcore.Frontend.Syntax.Stmt
diff --git a/src/Solcore/Backend/Mast.hs b/src/Solcore/Backend/Mast.hs
index 515bd38f1..e02b092ba 100644
--- a/src/Solcore/Backend/Mast.hs
+++ b/src/Solcore/Backend/Mast.hs
@@ -14,7 +14,7 @@ import Solcore.Frontend.Pretty.SolcorePretty ()
 import Solcore.Frontend.Syntax.Contract (DataTy (..), Import (..))
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.Stmt (Literal (..))
-import Solcore.Frontend.Syntax.Ty (Ty (..), Tyvar (..))
+import Solcore.Frontend.Syntax.Ty (Ty (..), Tyvar (..), pattern TyCon)
 import Solcore.Primitives.Primitives (word)
 
 deployerName :: Name
diff --git a/src/Solcore/Frontend/Lexer/SolcoreLexer.x b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
index f2a86723d..91a1a5f00 100644
--- a/src/Solcore/Frontend/Lexer/SolcoreLexer.x
+++ b/src/Solcore/Frontend/Lexer/SolcoreLexer.x
@@ -254,10 +254,17 @@ data LocatedText
   }
   deriving (Eq, Ord, Show)
 
+data LocatedValue a
+  = LocatedValue
+  { locatedValueSpan :: SourceSpan,
+    locatedValue :: a
+  }
+  deriving (Eq, Ord, Show)
+
 data Lexeme
   = TIdent { unIdent :: LocatedText }
-  | TNumber { unNum :: Integer }
-  | TString { unStr :: String }
+  | TNumber { unNum :: LocatedValue Integer }
+  | TString { unStr :: LocatedValue String }
   | TContract
   | TImport
   | TExport
@@ -370,13 +377,15 @@ mkNumber :: AlexAction Token
 mkNumber (st, _, _, str) len
   = do
       file <- sourceName <$> get
-      pure $ mkToken file st len (TNumber $ read $ take len str)
+      let numberSpan = sourceSpan file st len
+      pure $ mkTokenWithSpan numberSpan (TNumber $ LocatedValue numberSpan $ read $ take len str)
 
 mkHexlit :: AlexAction Token
 mkHexlit (st, _, _, str) len
   = do
       file <- sourceName <$> get
-      pure $ mkToken file st len (TNumber $ parseHex $ take len str)
+      let numberSpan = sourceSpan file st len
+      pure $ mkTokenWithSpan numberSpan (TNumber $ LocatedValue numberSpan $ parseHex $ take len str)
 
 parseHex :: String -> Integer
 parseHex str = case readHex (drop 2 str) of
@@ -408,8 +417,9 @@ exitString (pos, _, _, _) len
   = do
       s <- get
       put s{strStart = AlexPn 0 0 0, strBuffer = []}
-      let tk = TString $ reverse $ '"' : strBuffer s
-      return $ mkTokenWithSpan (sourceSpanBetween (sourceName s) (strStart s) pos len) tk
+      let stringSpan = sourceSpanBetween (sourceName s) (strStart s) pos len
+          tk = TString $ LocatedValue stringSpan $ reverse $ '"' : strBuffer s
+      return $ mkTokenWithSpan stringSpan tk
 
 emit :: Char -> AlexAction Token
 emit c inp@(_, _, _, _) len = do
diff --git a/src/Solcore/Frontend/Parser/SolcoreParser.y b/src/Solcore/Frontend/Parser/SolcoreParser.y
index 1e86c3a7d..b1cb994ca 100644
--- a/src/Solcore/Frontend/Parser/SolcoreParser.y
+++ b/src/Solcore/Frontend/Parser/SolcoreParser.y
@@ -4,6 +4,7 @@ module Solcore.Frontend.Parser.SolcoreParser where
 import Data.List.NonEmpty (NonEmpty, cons, singleton)
 
 import Solcore.Frontend.Lexer.SolcoreLexer hiding (lexer)
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.SyntaxTree
 import Solcore.Primitives.Primitives hiding (pairTy)
@@ -43,7 +44,7 @@ import Solcore.Diagnostics
       'leave'    {Token _ TLeave}
       'continue' {Token _ TContinue}
       'break'    {Token _ TBreak}
-      'assembly' {Token _ TAssembly}
+      'assembly' {TokenWithSpan $$ _ TAssembly}
       'data'     {Token _ TData}
       'match'    {Token _ TMatch}
       'function' {Token _ TFunction}
@@ -60,7 +61,7 @@ import Solcore.Diagnostics
       ':'        {Token _ TColon}
       ','        {Token _ TComma}
       '->'       {Token _ TArrow}
-      '_'        {Token _ TWildCard}
+      '_'        {TokenWithSpan $$ _ TWildCard}
       '=>'       {Token _ TDArrow}
       '('        {Token _ TLParen}
       ')'        {Token _ TRParen}
@@ -357,7 +358,7 @@ InstBody : '{' Functions '}'                       {$2}
 Function :: { FunDef }
 Function : Signature Body {FunDef $1 $2}
 -- Proposed Rust-style short return, e.g `function d(x) { 2*x }`
-         | Signature '{' Expr '}' {FunDef $1 [Return $3]}
+         | Signature '{' Expr '}' {FunDef $1 [locatedFrom $3 locatedStmt (Return $3)]}
 
 OptRetTy :: { Maybe Ty }
 OptRetTy : '->' Type                               {Just $2}
@@ -380,32 +381,32 @@ StmtList : Stmt StmtList                       {$1 : $2}
 -- Statements
 
 Stmt :: { Stmt }
-Stmt : Expr '=' Expr ';'                              {Assign $1 $3}
-     | Expr '+=' Expr ';'                             {StmtPlusEq $1 $3}
-     | Expr '-=' Expr ';'                             {StmtMinusEq $1 $3}
-     | 'let' Name ':' Type InitOpt ';'                {Let $2 (Just $4) $5}
-     | 'let' Name InitOpt ';'                         {Let $2 Nothing $3}
-     | Expr ';'                                       {StmtExp $1}
-     | 'return' Expr ';'                              {Return $2}
-     | 'match' MatchArgList '{' Equations  '}'        {Match $2 $4}
-     | AsmBlock                                       {Asm $1}
-     | 'if' '(' Expr ')' Body %shift                  {If $3 $5 []}
-     | 'if' '(' Expr ')' Body 'else' Body             {If $3 $5 $7}
-        | 'for' '(' ForInitStmt ';' Expr ';' ForPostStmt ')' Body {For $3 $5 $7 $9}
+Stmt : Expr '=' Expr ';'                              {locatedBetween $1 $3 locatedStmt (Assign $1 $3)}
+     | Expr '+=' Expr ';'                             {locatedBetween $1 $3 locatedStmt (StmtPlusEq $1 $3)}
+     | Expr '-=' Expr ';'                             {locatedBetween $1 $3 locatedStmt (StmtMinusEq $1 $3)}
+     | 'let' Name ':' Type InitOpt ';'                {locatedBetween $2 (Just $4, $5) locatedStmt (Let $2 (Just $4) $5)}
+     | 'let' Name InitOpt ';'                         {locatedBetween $2 $3 locatedStmt (Let $2 Nothing $3)}
+     | Expr ';'                                       {locatedFrom $1 locatedStmt (StmtExp $1)}
+     | 'return' Expr ';'                              {locatedFrom $2 locatedStmt (Return $2)}
+     | 'match' MatchArgList '{' Equations  '}'        {locatedBetween $2 $4 locatedStmt (Match $2 $4)}
+     | AsmBlock                                       {locatedValueWith locatedStmt $1 Asm}
+     | 'if' '(' Expr ')' Body %shift                  {locatedBetween $3 $5 locatedStmt (If $3 $5 [])}
+     | 'if' '(' Expr ')' Body 'else' Body             {locatedBetween $3 ($5, $7) locatedStmt (If $3 $5 $7)}
+        | 'for' '(' ForInitStmt ';' Expr ';' ForPostStmt ')' Body {locatedBetween $3 ($5, $7, $9) locatedStmt (For $3 $5 $7 $9)}
 
 ForInitStmt :: { Stmt }
-ForInitStmt : Expr '=' Expr                               {Assign $1 $3}
-            | Expr '+=' Expr                              {StmtPlusEq $1 $3}
-            | Expr '-=' Expr                              {StmtMinusEq $1 $3}
-            | 'let' Name ':' Type InitOpt                 {Let $2 (Just $4) $5}
-            | 'let' Name InitOpt                          {Let $2 Nothing $3}
-            | Expr                                        {StmtExp $1}
+ForInitStmt : Expr '=' Expr                               {locatedBetween $1 $3 locatedStmt (Assign $1 $3)}
+            | Expr '+=' Expr                              {locatedBetween $1 $3 locatedStmt (StmtPlusEq $1 $3)}
+            | Expr '-=' Expr                              {locatedBetween $1 $3 locatedStmt (StmtMinusEq $1 $3)}
+            | 'let' Name ':' Type InitOpt                 {locatedBetween $2 (Just $4, $5) locatedStmt (Let $2 (Just $4) $5)}
+            | 'let' Name InitOpt                          {locatedBetween $2 $3 locatedStmt (Let $2 Nothing $3)}
+            | Expr                                        {locatedFrom $1 locatedStmt (StmtExp $1)}
 
 ForPostStmt :: { Stmt }
-ForPostStmt : Expr '=' Expr                               {Assign $1 $3}
-            | Expr '+=' Expr                              {StmtPlusEq $1 $3}
-            | Expr '-=' Expr                              {StmtMinusEq $1 $3}
-            | Expr                                        {StmtExp $1}
+ForPostStmt : Expr '=' Expr                               {locatedBetween $1 $3 locatedStmt (Assign $1 $3)}
+            | Expr '+=' Expr                              {locatedBetween $1 $3 locatedStmt (StmtPlusEq $1 $3)}
+            | Expr '-=' Expr                              {locatedBetween $1 $3 locatedStmt (StmtMinusEq $1 $3)}
+            | Expr                                        {locatedFrom $1 locatedStmt (StmtExp $1)}
 
 
 MatchArgList :: {[Exp]}
@@ -419,37 +420,37 @@ InitOpt : {- empty -}                              {Nothing}
 -- Expressions
 
 Expr :: { Exp }
-Expr : Name FunArgs                                {ExpName Nothing $1 $2}
-     | Literal                                     {Lit $1}
+Expr : Name FunArgs                                {locatedBetween $1 $2 locatedExp (ExpName Nothing $1 $2)}
+     | Literal                                     {locatedValueWith locatedExp $1 Lit}
      | '(' Expr ')'                                {$2}
-     | '.' Name FunArgs                            {ExpDotName $2 $3}
-     | Expr '.' Name FunArgs                       {ExpName (Just $1) $3 $4}
-     | Name                                        {ExpVar Nothing $1}
-     | '.' Name                                    {ExpDotName $2 []}
-     | Expr '.' Name                               {ExpVar (Just $1) $3}
-     | 'lam' '(' ParamList ')' OptRetTy Body       {Lam $3 $6 $5}
-     | Expr ':' Type                               {TyExp $1 $3}
-     | '(' TupleArgs ')'                           {tupleExp $2}
-     | Expr '[' Expr ']'                           {ExpIndexed $1 $3 }
-     | Expr '+' Expr                               {ExpPlus $1 $3 }
-     | Expr '-' Expr                               {ExpMinus $1 $3 }
-     | Expr '*' Expr                               {ExpTimes $1 $3 }
-     | Expr '/' Expr                               {ExpDivide $1 $3 }
-     | Expr '%' Expr                               {ExpModulo $1 $3 }
-     | Expr '<' Expr                               {ExpLT $1 $3 }
-     | Expr '>' Expr                               {ExpGT $1 $3 }
-     | Expr '<=' Expr                              {ExpLE $1 $3 }
-     | Expr '>=' Expr                              {ExpGE $1 $3 }
-     | Expr '==' Expr                              {ExpEE $1 $3 }
-     | Expr '!=' Expr                              {ExpNE $1 $3 }
-     | Expr '&&' Expr                              {ExpLAnd $1 $3 }
-     | Expr '||' Expr                              {ExpLOr $1 $3 }
-     | '!' Expr                                    {ExpLNot $2 }
+     | '.' Name FunArgs                            {locatedBetween $2 $3 locatedExp (ExpDotName $2 $3)}
+     | Expr '.' Name FunArgs                       {locatedBetween $1 ($3, $4) locatedExp (ExpName (Just $1) $3 $4)}
+     | Name                                        {locatedFrom $1 locatedExp (ExpVar Nothing $1)}
+     | '.' Name                                    {locatedFrom $2 locatedExp (ExpDotName $2 [])}
+     | Expr '.' Name                               {locatedBetween $1 $3 locatedExp (ExpVar (Just $1) $3)}
+     | 'lam' '(' ParamList ')' OptRetTy Body       {locatedBetween $3 ($5, $6) locatedExp (Lam $3 $6 $5)}
+     | Expr ':' Type                               {locatedBetween $1 $3 locatedExp (TyExp $1 $3)}
+     | '(' TupleArgs ')'                           {locatedFrom $2 locatedExp (tupleExp $2)}
+     | Expr '[' Expr ']'                           {locatedBetween $1 $3 locatedExp (ExpIndexed $1 $3)}
+     | Expr '+' Expr                               {locatedBetween $1 $3 locatedExp (ExpPlus $1 $3)}
+     | Expr '-' Expr                               {locatedBetween $1 $3 locatedExp (ExpMinus $1 $3)}
+     | Expr '*' Expr                               {locatedBetween $1 $3 locatedExp (ExpTimes $1 $3)}
+     | Expr '/' Expr                               {locatedBetween $1 $3 locatedExp (ExpDivide $1 $3)}
+     | Expr '%' Expr                               {locatedBetween $1 $3 locatedExp (ExpModulo $1 $3)}
+     | Expr '<' Expr                               {locatedBetween $1 $3 locatedExp (ExpLT $1 $3)}
+     | Expr '>' Expr                               {locatedBetween $1 $3 locatedExp (ExpGT $1 $3)}
+     | Expr '<=' Expr                              {locatedBetween $1 $3 locatedExp (ExpLE $1 $3)}
+     | Expr '>=' Expr                              {locatedBetween $1 $3 locatedExp (ExpGE $1 $3)}
+     | Expr '==' Expr                              {locatedBetween $1 $3 locatedExp (ExpEE $1 $3)}
+     | Expr '!=' Expr                              {locatedBetween $1 $3 locatedExp (ExpNE $1 $3)}
+     | Expr '&&' Expr                              {locatedBetween $1 $3 locatedExp (ExpLAnd $1 $3)}
+     | Expr '||' Expr                              {locatedBetween $1 $3 locatedExp (ExpLOr $1 $3)}
+     | '!' Expr                                    {locatedFrom $2 locatedExp (ExpLNot $2)}
      | Conditional                                 {$1}
-     | '@' Type                                    {ExpAt $2}
+     | '@' Type                                    {locatedFrom $2 locatedExp (ExpAt $2)}
 
 Conditional :: { Exp }
-Conditional : 'if' Expr 'then' Expr 'else' Expr    {ExpCond $2 $4 $6}
+Conditional : 'if' Expr 'then' Expr 'else' Expr    {locatedBetween $2 $6 locatedExp (ExpCond $2 $4 $6)}
 
 TupleArgs :: { [Exp] }
 TupleArgs : Expr ',' Expr                          {[$1, $3]}
@@ -478,12 +479,12 @@ PatCommaList : Pattern                             {[$1]}
              | Pattern ',' PatCommaList            {$1 : $3}
 
 Pattern :: { Pat }
-Pattern : TypeName PatternList                     {Pat $1 $2}
-        | '.' Name PatternList                     {PatDot $2 $3}
-        | '_'                                      {PWildcard}
-        | Literal                                  {PLit $1}
+Pattern : TypeName PatternList                     {locatedBetween $1 $2 locatedPat (Pat $1 $2)}
+        | '.' Name PatternList                     {locatedBetween $2 $3 locatedPat (PatDot $2 $3)}
+        | '_'                                      {locatedPat $1 PWildcard}
+        | Literal                                  {locatedValueWith locatedPat $1 PLit}
         | '(' Pattern ')'                          {$2}
-        | PatternList                              {Pat (Name "pair") $1}
+        | PatternList                              {locatedFrom $1 locatedPat (Pat (Name "pair") $1)}
 
 PatternList :: {[Pat]}
 PatternList : '(' PatList ')'                      {$2}
@@ -495,17 +496,17 @@ PatList : Pattern %shift                           {[$1]}
 
 -- literals
 
-Literal :: { Literal }
-Literal : number                                   {IntLit $ toInteger $1}
-        | stringlit                                {StrLit $ rmquotes $1}
+Literal :: { LocatedValue Literal }
+Literal : number                                   {LocatedValue (locatedValueSpan $1) (IntLit (toInteger (locatedValue $1)))}
+        | stringlit                                {LocatedValue (locatedValueSpan $1) (StrLit (rmquotes (locatedValue $1)))}
 
 -- basic type definitions
 
 Type :: { Ty }
-Type : TypeName OptTypeParam                        {TyCon $1 $2}
-     | LamType                                      {uncurry funtype $1}
+Type : TypeName OptTypeParam                        {locatedBetween $1 $2 locatedTy (TyCon $1 $2)}
+     | LamType                                      {locatedFrom $1 locatedTy (uncurry funtype $1)}
      | TupleTy                                      {$1}
-     | '@' Type                                     {TyCon (Name "Proxy") [$2]}
+     | '@' Type                                     {locatedFrom $2 locatedTy (TyCon (Name "Proxy") [$2])}
 
 TupleTy :: { Ty }
 TupleTy : '(' TypeCommaList ')'                     {mkTupleTy $2}
@@ -514,7 +515,7 @@ LamType :: {([Ty], Ty)}
 LamType : '(' TypeCommaList ')' '->' Type          {($2, $5)}
 
 Var :: { Ty }
-Var : Name                                         {TyCon $1 []}
+Var : Name                                         {locatedFrom $1 locatedTy (TyCon $1 [])}
 
 Name :: { Name }
 Name : identifier                                 { nameFromIdent $1 }
@@ -525,8 +526,8 @@ TypeName : identifier                             { nameFromIdent $1 }
 
 -- Yul statments and blocks
 
-AsmBlock :: {YulBlock}
-AsmBlock : 'assembly' YulBlock                     {$2}
+AsmBlock :: {LocatedValue YulBlock}
+AsmBlock : 'assembly' YulBlock                     {LocatedValue $1 $2}
 
 YulBlock :: {YulBlock}
 YulBlock : '{' YulStmts '}'                        {$2}
@@ -598,8 +599,8 @@ YulExpCommaList : YulExp                           {[$1]}
               | YulExp ',' YulExpCommaList         {$1 : $3}
 
 YulLiteral :: { YLiteral }
-YulLiteral : number                                {YulNumber $ toInteger $1}
-        | stringlit                                {YulString (rmquotes $1)}
+YulLiteral : number                                {YulNumber (toInteger (locatedValue $1))}
+        | stringlit                                {YulString (rmquotes (locatedValue $1))}
 
 OptSemi :: { () }
 OptSemi : ';'                                      { () }
@@ -659,6 +660,18 @@ tupleExp [t1] = t1
 tupleExp [t1, t2] = pairExp t1 t2
 tupleExp (t1 : ts) = pairExp t1 (tupleExp ts)
 
+locatedFrom :: (HasSourceSpan anchor) => anchor -> (SourceSpan -> node -> node) -> node -> node
+locatedFrom anchor locate node =
+  maybe node (`locate` node) (sourceSpanOf anchor)
+
+locatedBetween :: (HasSourceSpan left, HasSourceSpan right) => left -> right -> (SourceSpan -> node -> node) -> node -> node
+locatedBetween left right locate node =
+  maybe node (`locate` node) (combineMaybeSourceSpans (sourceSpanOf left) (sourceSpanOf right))
+
+locatedValueWith :: (SourceSpan -> node -> node) -> LocatedValue value -> (value -> node) -> node
+locatedValueWith locate located build =
+  locate (locatedValueSpan located) (build (locatedValue located))
+
 rmquotes :: String -> String
 rmquotes = read
 
diff --git a/src/Solcore/Frontend/Syntax.hs b/src/Solcore/Frontend/Syntax.hs
index ce3cc43f6..4ac40813b 100644
--- a/src/Solcore/Frontend/Syntax.hs
+++ b/src/Solcore/Frontend/Syntax.hs
@@ -1,5 +1,6 @@
 module Solcore.Frontend.Syntax
   ( module Solcore.Frontend.Syntax.Contract,
+    module Solcore.Frontend.Syntax.Location,
     module Solcore.Frontend.Syntax.Name,
     module Solcore.Frontend.Syntax.Stmt,
     module Solcore.Frontend.Syntax.Ty,
@@ -7,6 +8,7 @@ module Solcore.Frontend.Syntax
 where
 
 import Solcore.Frontend.Syntax.Contract
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.Stmt
 import Solcore.Frontend.Syntax.Ty
diff --git a/src/Solcore/Frontend/Syntax/Location.hs b/src/Solcore/Frontend/Syntax/Location.hs
new file mode 100644
index 000000000..b9ba548f3
--- /dev/null
+++ b/src/Solcore/Frontend/Syntax/Location.hs
@@ -0,0 +1,51 @@
+module Solcore.Frontend.Syntax.Location where
+
+import Control.Applicative ((<|>))
+import Data.Generics (Data, Typeable)
+import Solcore.Diagnostics (SourceSpan, combineSourceSpans)
+
+newtype NodeLocation
+  = NodeLocation {nodeLocationSpan :: Maybe SourceSpan}
+  deriving (Show, Data, Typeable)
+
+instance Eq NodeLocation where
+  _ == _ = True
+
+instance Ord NodeLocation where
+  compare _ _ = EQ
+
+unlocatedNode :: NodeLocation
+unlocatedNode = NodeLocation Nothing
+
+locatedNode :: SourceSpan -> NodeLocation
+locatedNode = NodeLocation . Just
+
+withNodeSourceSpan :: Maybe SourceSpan -> NodeLocation
+withNodeSourceSpan = NodeLocation
+
+combineMaybeSourceSpans :: Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan
+combineMaybeSourceSpans Nothing right = right
+combineMaybeSourceSpans left Nothing = left
+combineMaybeSourceSpans (Just left) (Just right) = Just (combineSourceSpans left right)
+
+firstSourceSpan :: [Maybe SourceSpan] -> Maybe SourceSpan
+firstSourceSpan = foldr (<|>) Nothing
+
+class HasSourceSpan a where
+  sourceSpanOf :: a -> Maybe SourceSpan
+
+instance HasSourceSpan NodeLocation where
+  sourceSpanOf = nodeLocationSpan
+
+instance (HasSourceSpan a) => HasSourceSpan (Maybe a) where
+  sourceSpanOf = (>>= sourceSpanOf)
+
+instance (HasSourceSpan a) => HasSourceSpan [a] where
+  sourceSpanOf = firstSourceSpan . map sourceSpanOf
+
+instance (HasSourceSpan a, HasSourceSpan b) => HasSourceSpan (a, b) where
+  sourceSpanOf (left, right) = firstSourceSpan [sourceSpanOf left, sourceSpanOf right]
+
+instance (HasSourceSpan a, HasSourceSpan b, HasSourceSpan c) => HasSourceSpan (a, b, c) where
+  sourceSpanOf (left, middle, right) =
+    firstSourceSpan [sourceSpanOf left, sourceSpanOf middle, sourceSpanOf right]
diff --git a/src/Solcore/Frontend/Syntax/Name.hs b/src/Solcore/Frontend/Syntax/Name.hs
index b6cf2d098..d9f750a11 100644
--- a/src/Solcore/Frontend/Syntax/Name.hs
+++ b/src/Solcore/Frontend/Syntax/Name.hs
@@ -8,6 +8,7 @@ import Control.Applicative ((<|>))
 import Data.Generics (Data, Typeable)
 import Data.String
 import Solcore.Diagnostics (SourceSpan, combineSourceSpans)
+import Solcore.Frontend.Syntax.Location
 
 data Name
   = NameWithSpan (Maybe SourceSpan) String
@@ -48,6 +49,9 @@ nameSourceSpan :: Name -> Maybe SourceSpan
 nameSourceSpan (NameWithSpan sourceSpan _) = sourceSpan
 nameSourceSpan (QualNameWithSpan sourceSpan qualifier _) = sourceSpan <|> nameSourceSpan qualifier
 
+instance HasSourceSpan Name where
+  sourceSpanOf = nameSourceSpan
+
 locatedName :: SourceSpan -> Name -> Name
 locatedName sourceSpan (Name s) = NameWithSpan (Just sourceSpan) s
 locatedName sourceSpan (QualName qualifier s) = QualNameWithSpan (Just sourceSpan) qualifier s
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 51db7ffe0..824a3d6f1 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -14,6 +14,7 @@ import Data.Monoid (First (..))
 import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.Stmt
 import Solcore.Frontend.Syntax.SyntaxTree qualified as S
@@ -176,6 +177,10 @@ instance (Resolve a) => Resolve (Maybe a) where
   resolve Nothing = pure Nothing
   resolve (Just x) = Just <$> resolve x
 
+locatedLike :: (HasSourceSpan source) => source -> (SourceSpan -> target -> target) -> target -> target
+locatedLike source locate target =
+  maybe target (`locate` target) (sourceSpanOf source)
+
 instance Resolve S.TopDecl where
   type Result S.TopDecl = TopDecl Name
 
@@ -360,34 +365,34 @@ instance Resolve S.Stmt where
   type Result S.Stmt = Stmt Name
 
   resolve s@(S.Assign lhs rhs) =
-    do
+    locatedLike s locatedStmt <$> do
       lhs' <- resolve lhs `wrapError` s
       rhs' <- resolve rhs `wrapError` s
       pure (lhs' := rhs')
-  resolve (S.StmtPlusEq lhs rhs) =
-    (:=) <$> resolve lhs <*> resolve (S.ExpPlus lhs rhs)
-  resolve (S.StmtMinusEq lhs rhs) =
-    (:=) <$> resolve lhs <*> resolve (S.ExpMinus lhs rhs)
+  resolve s@(S.StmtPlusEq lhs rhs) =
+    locatedLike s locatedStmt <$> ((:=) <$> resolve lhs <*> resolve (S.ExpPlus lhs rhs))
+  resolve s@(S.StmtMinusEq lhs rhs) =
+    locatedLike s locatedStmt <$> ((:=) <$> resolve lhs <*> resolve (S.ExpMinus lhs rhs))
   resolve s@(S.Let n mt me) =
-    do
+    locatedLike s locatedStmt <$> do
       mt' <- resolve mt `wrapError` s
       me' <- resolve me `wrapError` s
       addLocalVar n
       pure (Let n mt' me')
-  resolve (S.Block blk) =
-    withLocalCtx (Block <$> resolve blk)
+  resolve s@(S.Block blk) =
+    locatedLike s locatedStmt <$> withLocalCtx (Block <$> resolve blk)
   resolve s@(S.StmtExp e) =
-    StmtExp <$> resolve e `wrapError` s
+    locatedLike s locatedStmt <$> (StmtExp <$> resolve e `wrapError` s)
   resolve s@(S.Return e) =
-    Return <$> resolve e `wrapError` s
-  resolve (S.Match es eqns) =
-    Match <$> resolve es <*> resolve eqns
-  resolve (S.Asm blk) =
-    pure (Asm blk)
-  resolve (S.If e blk1 blk2) =
-    If <$> resolve e <*> resolve blk1 <*> resolve blk2
-  resolve (S.For initStmt cond postStmt body) =
-    For <$> resolve initStmt <*> resolve cond <*> resolve postStmt <*> resolve body
+    locatedLike s locatedStmt <$> (Return <$> resolve e `wrapError` s)
+  resolve s@(S.Match es eqns) =
+    locatedLike s locatedStmt <$> (Match <$> resolve es <*> resolve eqns)
+  resolve s@(S.Asm blk) =
+    pure (locatedLike s locatedStmt (Asm blk))
+  resolve s@(S.If e blk1 blk2) =
+    locatedLike s locatedStmt <$> (If <$> resolve e <*> resolve blk1 <*> resolve blk2)
+  resolve s@(S.For initStmt cond postStmt body) =
+    locatedLike s locatedStmt <$> (For <$> resolve initStmt <*> resolve cond <*> resolve postStmt <*> resolve body)
 
 instance Resolve S.Equation where
   type Result S.Equation = Equation Name
@@ -399,13 +404,13 @@ instance Resolve S.Equation where
 instance Resolve S.Pat where
   type Result S.Pat = Pat Name
 
-  resolve S.PWildcard = pure PWildcard
-  resolve (S.PLit l) = PLit <$> resolve l
+  resolve p@S.PWildcard = pure (locatedLike p locatedPat PWildcard)
+  resolve p@(S.PLit l) = locatedLike p locatedPat <$> (PLit <$> resolve l)
   resolve p@(S.PatDot n ps) = do
     ps' <- resolve ps `wrapError` p
-    pure (PCon (dotConstructorMarker n) ps')
+    pure (locatedLike p locatedPat (PCon (dotConstructorMarker n) ps'))
   resolve p@(S.Pat n ps) =
-    do
+    locatedLike p locatedPat <$> do
       ps' <- resolve ps `wrapError` p
       mdt <- lookupName n
       case mdt of
@@ -516,10 +521,13 @@ resolveSameNameConstructorName n =
 instance Resolve S.Exp where
   type Result S.Exp = Exp Name
 
-  resolve (S.Lit l) = Lit <$> resolve l
-  resolve e@(S.ExpDotName n es) =
+  resolve e = locatedLike e locatedExp <$> resolveExp e
+
+resolveExp :: S.Exp -> ResolveM (Exp Name)
+resolveExp (S.Lit l) = Lit <$> resolve l
+resolveExp e@(S.ExpDotName n es) =
     Con (dotConstructorMarker n) <$> resolve es `wrapError` e
-  resolve e@(S.Lam ps bd mt) =
+resolveExp e@(S.Lam ps bd mt) =
     withLocalCtx $ do
       ps' <- resolve ps `wrapError` e
       mt' <- resolve mt `wrapError` e
@@ -527,9 +535,9 @@ instance Resolve S.Exp where
       mapM_ addParameter args
       bd' <- resolve bd `wrapError` e
       pure (Lam ps' bd' mt')
-  resolve (S.TyExp e t) =
+resolveExp (S.TyExp e t) =
     TyExp <$> resolve e <*> resolve t
-  resolve c@(S.ExpVar me n) =
+resolveExp c@(S.ExpVar me n) =
     do
       me' <- resolve me `wrapError` c
       dt <- lookupName n
@@ -600,7 +608,7 @@ instance Resolve S.Exp where
               if hasQualified
                 then unqualifiedConstructorError n
                 else undefinedName n
-  resolve x@(S.ExpName me n es) =
+resolveExp x@(S.ExpName me n es) =
     do
       me' <- resolve me `wrapError` x
       es' <- resolve es `wrapError` x
@@ -684,80 +692,80 @@ instance Resolve S.Exp where
               if hasQualified
                 then unqualifiedConstructorError n
                 else undefinedName n
-  resolve c@(S.ExpPlus e1 e2) =
+resolveExp c@(S.ExpPlus e1 e2) =
     do
       e1' <- resolve e1 `wrapError` c
       e2' <- resolve e2 `wrapError` c
       let fun = QualName (Name "Add") "add"
       pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpMinus e1 e2) =
+resolveExp c@(S.ExpMinus e1 e2) =
     do
       e1' <- resolve e1 `wrapError` c
       e2' <- resolve e2 `wrapError` c
       let fun = QualName (Name "Sub") "sub"
       pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpTimes e1 e2) =
+resolveExp c@(S.ExpTimes e1 e2) =
     do
       e1' <- resolve e1 `wrapError` c
       e2' <- resolve e2 `wrapError` c
       let fun = QualName (Name "Mul") "mul"
       pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpDivide e1 e2) =
+resolveExp c@(S.ExpDivide e1 e2) =
     do
       e1' <- resolve e1 `wrapError` c
       e2' <- resolve e2 `wrapError` c
       let fun = QualName (Name "Div") "div"
       pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpModulo e1 e2) =
+resolveExp c@(S.ExpModulo e1 e2) =
     do
       e1' <- resolve e1 `wrapError` c
       e2' <- resolve e2 `wrapError` c
       let fun = QualName (Name "Mod") "mod"
       pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpIndexed array idx) = do
+resolveExp c@(S.ExpIndexed array idx) = do
     arr' <- resolve array `wrapError` c
     idx' <- resolve idx `wrapError` c
     pure $ Indexed arr' idx'
-  resolve c@(S.ExpLT e1 e2) = do
+resolveExp c@(S.ExpLT e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "lt") [e1', e2']
-  resolve c@(S.ExpGT e1 e2) = do
+resolveExp c@(S.ExpGT e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     let fun = QualName (Name "Ord") "gt"
     pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpLE e1 e2) = do
+resolveExp c@(S.ExpLE e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "le") [e1', e2']
-  resolve c@(S.ExpGE e1 e2) = do
+resolveExp c@(S.ExpGE e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "ge") [e1', e2']
-  resolve c@(S.ExpEE e1 e2) = do
+resolveExp c@(S.ExpEE e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     let fun = QualName (Name "Eq") "eq"
     pure $ Call Nothing fun [e1', e2']
-  resolve c@(S.ExpNE e1 e2) = do
+resolveExp c@(S.ExpNE e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "ne") [e1', e2']
-  resolve c@(S.ExpLAnd e1 e2) = do
+resolveExp c@(S.ExpLAnd e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "and") [e1', e2']
-  resolve c@(S.ExpLOr e1 e2) = do
+resolveExp c@(S.ExpLOr e1 e2) = do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
     pure $ Call Nothing (Name "or") [e1', e2']
-  resolve c@(S.ExpLNot e) = do
+resolveExp c@(S.ExpLNot e) = do
     e' <- resolve e `wrapError` c
     pure $ Call Nothing (Name "not") [e']
-  resolve (S.ExpCond e1 e2 e3) =
+resolveExp (S.ExpCond e1 e2 e3) =
     Cond <$> resolve e1 <*> resolve e2 <*> resolve e3
-  resolve (S.ExpAt t) = do
+resolveExp (S.ExpAt t) = do
     t' <- resolve t
     pure
       ( TyExp
@@ -822,7 +830,7 @@ instance Resolve S.Ty where
   type Result S.Ty = Ty
 
   resolve tc@(S.TyCon n ts) =
-    do
+    locatedLike tc locatedTy <$> do
       ndt <- lookupType n
       case ndt of
         Just TTyCon -> TyCon n <$> resolve ts `wrapError` tc
diff --git a/src/Solcore/Frontend/Syntax/Stmt.hs b/src/Solcore/Frontend/Syntax/Stmt.hs
index d5a5c1911..2da689c1f 100644
--- a/src/Solcore/Frontend/Syntax/Stmt.hs
+++ b/src/Solcore/Frontend/Syntax/Stmt.hs
@@ -1,7 +1,12 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Solcore.Frontend.Syntax.Stmt where
 
 import Data.Generics (Data, Typeable)
 import Language.Yul
+import Prelude hiding (exp)
+import Solcore.Diagnostics (SourceSpan)
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Ty
 
 -- definition of statements
@@ -11,19 +16,99 @@ type Equation a = ([Pat a], [Stmt a])
 type Equations a = [Equation a]
 
 data Stmt a
-  = (Exp a) := (Exp a) -- assignment
-  | Let a (Maybe Ty) (Maybe (Exp a)) -- local variable
-  | Block (Body a) -- lexical block
-  | StmtExp (Exp a) -- expression level statements
-  | Return (Exp a) -- return statements
-  | Match [Exp a] (Equations a) -- pattern matching
-  | Asm YulBlock -- Yul block
-  | If (Exp a) (Body a) (Body a) -- If statement
-  | For (Stmt a) (Exp a) (Stmt a) (Body a) -- for(init; cond; post) { body }
+  = AssignWithLocation NodeLocation (Exp a) (Exp a) -- assignment
+  | LetWithLocation NodeLocation a (Maybe Ty) (Maybe (Exp a)) -- local variable
+  | BlockWithLocation NodeLocation (Body a) -- lexical block
+  | StmtExpWithLocation NodeLocation (Exp a) -- expression level statements
+  | ReturnWithLocation NodeLocation (Exp a) -- return statements
+  | MatchWithLocation NodeLocation [Exp a] (Equations a) -- pattern matching
+  | AsmWithLocation NodeLocation YulBlock -- Yul block
+  | IfWithLocation NodeLocation (Exp a) (Body a) (Body a) -- If statement
+  | ForWithLocation NodeLocation (Stmt a) (Exp a) (Stmt a) (Body a) -- for(init; cond; post) { body }
   deriving (Eq, Ord, Show, Data, Typeable)
 
+infix 4 :=
+
+pattern (:=) :: Exp a -> Exp a -> Stmt a
+pattern lhs := rhs <- AssignWithLocation _ lhs rhs
+  where
+    lhs := rhs = AssignWithLocation unlocatedNode lhs rhs
+
+pattern Let :: a -> Maybe Ty -> Maybe (Exp a) -> Stmt a
+pattern Let n ty value <- LetWithLocation _ n ty value
+  where
+    Let n ty value = LetWithLocation unlocatedNode n ty value
+
+pattern Block :: Body a -> Stmt a
+pattern Block body <- BlockWithLocation _ body
+  where
+    Block body = BlockWithLocation unlocatedNode body
+
+pattern StmtExp :: Exp a -> Stmt a
+pattern StmtExp exp <- StmtExpWithLocation _ exp
+  where
+    StmtExp exp = StmtExpWithLocation unlocatedNode exp
+
+pattern Return :: Exp a -> Stmt a
+pattern Return exp <- ReturnWithLocation _ exp
+  where
+    Return exp = ReturnWithLocation unlocatedNode exp
+
+pattern Match :: [Exp a] -> Equations a -> Stmt a
+pattern Match exps equations <- MatchWithLocation _ exps equations
+  where
+    Match exps equations = MatchWithLocation unlocatedNode exps equations
+
+pattern Asm :: YulBlock -> Stmt a
+pattern Asm block <- AsmWithLocation _ block
+  where
+    Asm block = AsmWithLocation unlocatedNode block
+
+pattern If :: Exp a -> Body a -> Body a -> Stmt a
+pattern If cond thenBody elseBody <- IfWithLocation _ cond thenBody elseBody
+  where
+    If cond thenBody elseBody = IfWithLocation unlocatedNode cond thenBody elseBody
+
+pattern For :: Stmt a -> Exp a -> Stmt a -> Body a -> Stmt a
+pattern For initStmt cond postStmt body <- ForWithLocation _ initStmt cond postStmt body
+  where
+    For initStmt cond postStmt body = ForWithLocation unlocatedNode initStmt cond postStmt body
+
+{-# COMPLETE (:=), Let, Block, StmtExp, Return, Match, Asm, If, For #-}
+
 type Body a = [Stmt a]
 
+locatedStmt :: SourceSpan -> Stmt a -> Stmt a
+locatedStmt sourceSpan (lhs := rhs) = AssignWithLocation (locatedNode sourceSpan) lhs rhs
+locatedStmt sourceSpan (Let n ty value) = LetWithLocation (locatedNode sourceSpan) n ty value
+locatedStmt sourceSpan (Block body) = BlockWithLocation (locatedNode sourceSpan) body
+locatedStmt sourceSpan (StmtExp exp) = StmtExpWithLocation (locatedNode sourceSpan) exp
+locatedStmt sourceSpan (Return exp) = ReturnWithLocation (locatedNode sourceSpan) exp
+locatedStmt sourceSpan (Match exps equations) = MatchWithLocation (locatedNode sourceSpan) exps equations
+locatedStmt sourceSpan (Asm block) = AsmWithLocation (locatedNode sourceSpan) block
+locatedStmt sourceSpan (If cond thenBody elseBody) = IfWithLocation (locatedNode sourceSpan) cond thenBody elseBody
+locatedStmt sourceSpan (For initStmt cond postStmt body) = ForWithLocation (locatedNode sourceSpan) initStmt cond postStmt body
+
+instance (HasSourceSpan a) => HasSourceSpan (Stmt a) where
+  sourceSpanOf (AssignWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (LetWithLocation location n ty value) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ty, sourceSpanOf value]
+  sourceSpanOf (BlockWithLocation location body) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf body]
+  sourceSpanOf (StmtExpWithLocation location exp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp]
+  sourceSpanOf (ReturnWithLocation location exp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp]
+  sourceSpanOf (MatchWithLocation location exps equations) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exps, sourceSpanOf equations]
+  sourceSpanOf (AsmWithLocation location _) =
+    sourceSpanOf location
+  sourceSpanOf (IfWithLocation location cond thenBody elseBody) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf cond, sourceSpanOf thenBody, sourceSpanOf elseBody]
+  sourceSpanOf (ForWithLocation location initStmt cond postStmt body) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf initStmt, sourceSpanOf cond, sourceSpanOf postStmt, sourceSpanOf body]
+
 data Param a
   = Typed a Ty
   | Untyped a
@@ -33,29 +118,151 @@ paramName :: Param a -> a
 paramName (Typed n _) = n
 paramName (Untyped n) = n
 
+instance (HasSourceSpan a) => HasSourceSpan (Param a) where
+  sourceSpanOf (Typed n ty) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf ty]
+  sourceSpanOf (Untyped n) =
+    sourceSpanOf n
+
 -- definition of the expression syntax
 
 data Exp a
-  = Var a -- variable
-  | Con a [Exp a] -- data type constructor
-  | FieldAccess (Maybe (Exp a)) a -- field access
-  | Lit Literal -- literal
-  | Call (Maybe (Exp a)) a [Exp a] -- function call
-  | Lam [Param a] (Body a) (Maybe Ty) -- lambda-abstraction
-  | TyExp (Exp a) Ty -- type annotated expression
-  | Cond (Exp a) (Exp a) (Exp a) -- conditional expression
-  | Indexed (Exp a) (Exp a) -- e1[e2]
+  = VarWithLocation NodeLocation a -- variable
+  | ConWithLocation NodeLocation a [Exp a] -- data type constructor
+  | FieldAccessWithLocation NodeLocation (Maybe (Exp a)) a -- field access
+  | LitWithLocation NodeLocation Literal -- literal
+  | CallWithLocation NodeLocation (Maybe (Exp a)) a [Exp a] -- function call
+  | LamWithLocation NodeLocation [Param a] (Body a) (Maybe Ty) -- lambda-abstraction
+  | TyExpWithLocation NodeLocation (Exp a) Ty -- type annotated expression
+  | CondWithLocation NodeLocation (Exp a) (Exp a) (Exp a) -- conditional expression
+  | IndexedWithLocation NodeLocation (Exp a) (Exp a) -- e1[e2]
   deriving (Eq, Ord, Show, Data, Typeable)
 
+pattern Var :: a -> Exp a
+pattern Var n <- VarWithLocation _ n
+  where
+    Var n = VarWithLocation unlocatedNode n
+
+pattern Con :: a -> [Exp a] -> Exp a
+pattern Con n es <- ConWithLocation _ n es
+  where
+    Con n es = ConWithLocation unlocatedNode n es
+
+pattern FieldAccess :: Maybe (Exp a) -> a -> Exp a
+pattern FieldAccess me n <- FieldAccessWithLocation _ me n
+  where
+    FieldAccess me n = FieldAccessWithLocation unlocatedNode me n
+
+pattern Lit :: Literal -> Exp a
+pattern Lit lit <- LitWithLocation _ lit
+  where
+    Lit lit = LitWithLocation unlocatedNode lit
+
+pattern Call :: Maybe (Exp a) -> a -> [Exp a] -> Exp a
+pattern Call me n es <- CallWithLocation _ me n es
+  where
+    Call me n es = CallWithLocation unlocatedNode me n es
+
+pattern Lam :: [Param a] -> Body a -> Maybe Ty -> Exp a
+pattern Lam ps body ty <- LamWithLocation _ ps body ty
+  where
+    Lam ps body ty = LamWithLocation unlocatedNode ps body ty
+
+pattern TyExp :: Exp a -> Ty -> Exp a
+pattern TyExp exp ty <- TyExpWithLocation _ exp ty
+  where
+    TyExp exp ty = TyExpWithLocation unlocatedNode exp ty
+
+pattern Cond :: Exp a -> Exp a -> Exp a -> Exp a
+pattern Cond cond thenExp elseExp <- CondWithLocation _ cond thenExp elseExp
+  where
+    Cond cond thenExp elseExp = CondWithLocation unlocatedNode cond thenExp elseExp
+
+pattern Indexed :: Exp a -> Exp a -> Exp a
+pattern Indexed lhs rhs <- IndexedWithLocation _ lhs rhs
+  where
+    Indexed lhs rhs = IndexedWithLocation unlocatedNode lhs rhs
+
+{-# COMPLETE Var, Con, FieldAccess, Lit, Call, Lam, TyExp, Cond, Indexed #-}
+
+locatedExp :: SourceSpan -> Exp a -> Exp a
+locatedExp sourceSpan (Var n) = VarWithLocation (locatedNode sourceSpan) n
+locatedExp sourceSpan (Con n es) = ConWithLocation (locatedNode sourceSpan) n es
+locatedExp sourceSpan (FieldAccess me n) = FieldAccessWithLocation (locatedNode sourceSpan) me n
+locatedExp sourceSpan (Lit lit) = LitWithLocation (locatedNode sourceSpan) lit
+locatedExp sourceSpan (Call me n es) = CallWithLocation (locatedNode sourceSpan) me n es
+locatedExp sourceSpan (Lam ps body ty) = LamWithLocation (locatedNode sourceSpan) ps body ty
+locatedExp sourceSpan (TyExp exp ty) = TyExpWithLocation (locatedNode sourceSpan) exp ty
+locatedExp sourceSpan (Cond cond thenExp elseExp) = CondWithLocation (locatedNode sourceSpan) cond thenExp elseExp
+locatedExp sourceSpan (Indexed lhs rhs) = IndexedWithLocation (locatedNode sourceSpan) lhs rhs
+
+instance (HasSourceSpan a) => HasSourceSpan (Exp a) where
+  sourceSpanOf (VarWithLocation location n) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n]
+  sourceSpanOf (ConWithLocation location n es) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf es]
+  sourceSpanOf (FieldAccessWithLocation location me n) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf me, sourceSpanOf n]
+  sourceSpanOf (LitWithLocation location _) =
+    sourceSpanOf location
+  sourceSpanOf (CallWithLocation location me n es) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf me, sourceSpanOf n, sourceSpanOf es]
+  sourceSpanOf (LamWithLocation location ps body ty) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf ps, sourceSpanOf body, sourceSpanOf ty]
+  sourceSpanOf (TyExpWithLocation location exp ty) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp, sourceSpanOf ty]
+  sourceSpanOf (CondWithLocation location cond thenExp elseExp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf cond, sourceSpanOf thenExp, sourceSpanOf elseExp]
+  sourceSpanOf (IndexedWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+
 -- pattern matching equations
 
 data Pat a
-  = PVar a
-  | PCon a [Pat a]
-  | PWildcard
-  | PLit Literal
+  = PVarWithLocation NodeLocation a
+  | PConWithLocation NodeLocation a [Pat a]
+  | PWildcardWithLocation NodeLocation
+  | PLitWithLocation NodeLocation Literal
   deriving (Eq, Ord, Show, Data, Typeable)
 
+pattern PVar :: a -> Pat a
+pattern PVar n <- PVarWithLocation _ n
+  where
+    PVar n = PVarWithLocation unlocatedNode n
+
+pattern PCon :: a -> [Pat a] -> Pat a
+pattern PCon n ps <- PConWithLocation _ n ps
+  where
+    PCon n ps = PConWithLocation unlocatedNode n ps
+
+pattern PWildcard :: Pat a
+pattern PWildcard <- PWildcardWithLocation _
+  where
+    PWildcard = PWildcardWithLocation unlocatedNode
+
+pattern PLit :: Literal -> Pat a
+pattern PLit lit <- PLitWithLocation _ lit
+  where
+    PLit lit = PLitWithLocation unlocatedNode lit
+
+{-# COMPLETE PVar, PCon, PWildcard, PLit #-}
+
+locatedPat :: SourceSpan -> Pat a -> Pat a
+locatedPat sourceSpan (PVar n) = PVarWithLocation (locatedNode sourceSpan) n
+locatedPat sourceSpan (PCon n ps) = PConWithLocation (locatedNode sourceSpan) n ps
+locatedPat sourceSpan PWildcard = PWildcardWithLocation (locatedNode sourceSpan)
+locatedPat sourceSpan (PLit lit) = PLitWithLocation (locatedNode sourceSpan) lit
+
+instance (HasSourceSpan a) => HasSourceSpan (Pat a) where
+  sourceSpanOf (PVarWithLocation location n) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n]
+  sourceSpanOf (PConWithLocation location n ps) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ps]
+  sourceSpanOf (PWildcardWithLocation location) =
+    sourceSpanOf location
+  sourceSpanOf (PLitWithLocation location _) =
+    sourceSpanOf location
+
 -- definition of literals
 
 data Literal
diff --git a/src/Solcore/Frontend/Syntax/SyntaxTree.hs b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
index 3104d6dce..70b0b3e40 100644
--- a/src/Solcore/Frontend/Syntax/SyntaxTree.hs
+++ b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
@@ -1,9 +1,14 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Solcore.Frontend.Syntax.SyntaxTree where
 
 import Data.Generics (Data, Typeable)
 import Data.List (union)
 import Data.List.NonEmpty
 import Language.Yul
+import Prelude hiding (exp)
+import Solcore.Diagnostics (SourceSpan)
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 
 -- compilation unit
@@ -127,15 +132,30 @@ data Constr
 -- type definition
 
 data Ty
-  = TyCon Name [Ty] -- type constructor
+  = TyConWithLocation NodeLocation Name [Ty] -- type constructor
   deriving (Eq, Ord, Show, Data, Typeable)
 
+pattern TyCon :: Name -> [Ty] -> Ty
+pattern TyCon n ts <- TyConWithLocation _ n ts
+  where
+    TyCon n ts = TyConWithLocation unlocatedNode n ts
+
+{-# COMPLETE TyCon #-}
+
 pattern (:->) :: Ty -> Ty -> Ty
 pattern (:->) t1 t2 = TyCon (Name "->") [t1, t2]
 
 tyName :: Ty -> Name
 tyName (TyCon n _) = n
 
+locatedTy :: SourceSpan -> Ty -> Ty
+locatedTy sourceSpan (TyCon n ts) =
+  TyConWithLocation (locatedNode sourceSpan) n ts
+
+instance HasSourceSpan Ty where
+  sourceSpanOf (TyConWithLocation location n ts) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ts]
+
 data Pred = InCls
   { predName :: Name,
     predMain :: Ty,
@@ -143,6 +163,10 @@ data Pred = InCls
   }
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance HasSourceSpan Pred where
+  sourceSpanOf (InCls n t ts) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf t, sourceSpanOf ts]
+
 tysFrom :: [Pred] -> [Ty]
 tysFrom = foldr go []
   where
@@ -235,63 +259,398 @@ type Equation = ([Pat], [Stmt])
 type Equations = [Equation]
 
 data Stmt
-  = Assign Exp Exp -- assignment
-  | StmtPlusEq Exp Exp -- e1 += e2
-  | StmtMinusEq Exp Exp -- e1 -= e2
-  | Let Name (Maybe Ty) (Maybe Exp) -- local variable
-  | Block Body -- lexical block
-  | StmtExp Exp -- expression level statements
-  | Return Exp -- return statements
-  | Match [Exp] Equations -- pattern matching
-  | Asm YulBlock -- Yul block
-  | If Exp Body Body -- If statement
-  | For Stmt Exp Stmt Body -- for(init; cond; post) { body }
-  deriving (Eq, Ord, Show, Data, Typeable)
+  = AssignWithLocation NodeLocation Exp Exp -- assignment
+  | StmtPlusEqWithLocation NodeLocation Exp Exp -- e1 += e2
+  | StmtMinusEqWithLocation NodeLocation Exp Exp -- e1 -= e2
+  | LetWithLocation NodeLocation Name (Maybe Ty) (Maybe Exp) -- local variable
+  | BlockWithLocation NodeLocation Body -- lexical block
+  | StmtExpWithLocation NodeLocation Exp -- expression level statements
+  | ReturnWithLocation NodeLocation Exp -- return statements
+  | MatchWithLocation NodeLocation [Exp] Equations -- pattern matching
+  | AsmWithLocation NodeLocation YulBlock -- Yul block
+  | IfWithLocation NodeLocation Exp Body Body -- If statement
+  | ForWithLocation NodeLocation Stmt Exp Stmt Body -- for(init; cond; post) { body }
+  deriving (Eq, Ord, Show, Data, Typeable)
+
+pattern Assign :: Exp -> Exp -> Stmt
+pattern Assign lhs rhs <- AssignWithLocation _ lhs rhs
+  where
+    Assign lhs rhs = AssignWithLocation unlocatedNode lhs rhs
+
+pattern StmtPlusEq :: Exp -> Exp -> Stmt
+pattern StmtPlusEq lhs rhs <- StmtPlusEqWithLocation _ lhs rhs
+  where
+    StmtPlusEq lhs rhs = StmtPlusEqWithLocation unlocatedNode lhs rhs
+
+pattern StmtMinusEq :: Exp -> Exp -> Stmt
+pattern StmtMinusEq lhs rhs <- StmtMinusEqWithLocation _ lhs rhs
+  where
+    StmtMinusEq lhs rhs = StmtMinusEqWithLocation unlocatedNode lhs rhs
+
+pattern Let :: Name -> Maybe Ty -> Maybe Exp -> Stmt
+pattern Let n ty value <- LetWithLocation _ n ty value
+  where
+    Let n ty value = LetWithLocation unlocatedNode n ty value
+
+pattern Block :: Body -> Stmt
+pattern Block body <- BlockWithLocation _ body
+  where
+    Block body = BlockWithLocation unlocatedNode body
+
+pattern StmtExp :: Exp -> Stmt
+pattern StmtExp exp <- StmtExpWithLocation _ exp
+  where
+    StmtExp exp = StmtExpWithLocation unlocatedNode exp
+
+pattern Return :: Exp -> Stmt
+pattern Return exp <- ReturnWithLocation _ exp
+  where
+    Return exp = ReturnWithLocation unlocatedNode exp
+
+pattern Match :: [Exp] -> Equations -> Stmt
+pattern Match exps equations <- MatchWithLocation _ exps equations
+  where
+    Match exps equations = MatchWithLocation unlocatedNode exps equations
+
+pattern Asm :: YulBlock -> Stmt
+pattern Asm block <- AsmWithLocation _ block
+  where
+    Asm block = AsmWithLocation unlocatedNode block
+
+pattern If :: Exp -> Body -> Body -> Stmt
+pattern If cond thenBody elseBody <- IfWithLocation _ cond thenBody elseBody
+  where
+    If cond thenBody elseBody = IfWithLocation unlocatedNode cond thenBody elseBody
+
+pattern For :: Stmt -> Exp -> Stmt -> Body -> Stmt
+pattern For initStmt cond postStmt body <- ForWithLocation _ initStmt cond postStmt body
+  where
+    For initStmt cond postStmt body = ForWithLocation unlocatedNode initStmt cond postStmt body
+
+{-# COMPLETE Assign, StmtPlusEq, StmtMinusEq, Let, Block, StmtExp, Return, Match, Asm, If, For #-}
 
 type Body = [Stmt]
 
+locatedStmt :: SourceSpan -> Stmt -> Stmt
+locatedStmt sourceSpan (Assign lhs rhs) = AssignWithLocation location lhs rhs
+  where
+    location = locatedNode sourceSpan
+locatedStmt sourceSpan (StmtPlusEq lhs rhs) = StmtPlusEqWithLocation location lhs rhs
+  where
+    location = locatedNode sourceSpan
+locatedStmt sourceSpan (StmtMinusEq lhs rhs) = StmtMinusEqWithLocation location lhs rhs
+  where
+    location = locatedNode sourceSpan
+locatedStmt sourceSpan (Let n ty value) = LetWithLocation location n ty value
+  where
+    location = locatedNode sourceSpan
+locatedStmt sourceSpan (Block body) = BlockWithLocation (locatedNode sourceSpan) body
+locatedStmt sourceSpan (StmtExp exp) = StmtExpWithLocation (locatedNode sourceSpan) exp
+locatedStmt sourceSpan (Return exp) = ReturnWithLocation (locatedNode sourceSpan) exp
+locatedStmt sourceSpan (Match exps equations) = MatchWithLocation (locatedNode sourceSpan) exps equations
+locatedStmt sourceSpan (Asm block) = AsmWithLocation (locatedNode sourceSpan) block
+locatedStmt sourceSpan (If cond thenBody elseBody) = IfWithLocation (locatedNode sourceSpan) cond thenBody elseBody
+locatedStmt sourceSpan (For initStmt cond postStmt body) = ForWithLocation (locatedNode sourceSpan) initStmt cond postStmt body
+
+instance HasSourceSpan Stmt where
+  sourceSpanOf (AssignWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (StmtPlusEqWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (StmtMinusEqWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (LetWithLocation location n ty value) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ty, sourceSpanOf value]
+  sourceSpanOf (BlockWithLocation location body) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf body]
+  sourceSpanOf (StmtExpWithLocation location exp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp]
+  sourceSpanOf (ReturnWithLocation location exp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp]
+  sourceSpanOf (MatchWithLocation location exps equations) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exps, sourceSpanOf equations]
+  sourceSpanOf (AsmWithLocation location _) =
+    sourceSpanOf location
+  sourceSpanOf (IfWithLocation location cond thenBody elseBody) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf cond, sourceSpanOf thenBody, sourceSpanOf elseBody]
+  sourceSpanOf (ForWithLocation location initStmt cond postStmt body) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf initStmt, sourceSpanOf cond, sourceSpanOf postStmt, sourceSpanOf body]
+
 data Param
   = Typed Name Ty
   | Untyped Name
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance HasSourceSpan Param where
+  sourceSpanOf (Typed n ty) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf ty]
+  sourceSpanOf (Untyped n) =
+    sourceSpanOf n
+
 -- expression syntax
 
 data Exp
-  = Lit Literal -- literal
-  | ExpName (Maybe Exp) Name [Exp] -- function call or constructor
-  | ExpVar (Maybe Exp) Name -- variables or field access
-  | ExpDotName Name [Exp] -- contextual constructor shorthand, e.g. .Some(1), .None
-  | Lam [Param] Body (Maybe Ty) -- lambda-abstraction
-  | TyExp Exp Ty -- type annotation expression
-  | ExpIndexed Exp Exp -- e1[e2]
-  | ExpPlus Exp Exp -- e1 + e2
-  | ExpMinus Exp Exp -- e1 - e2
-  | ExpTimes Exp Exp -- e1 * e2
-  | ExpDivide Exp Exp -- e1 / e2
-  | ExpModulo Exp Exp -- e1 % e2
-  | ExpLT Exp Exp -- e1 < e2
-  | ExpGT Exp Exp -- e1 > e2
-  | ExpLE Exp Exp -- e1 <= e2
-  | ExpGE Exp Exp -- e1 >= e2
-  | ExpEE Exp Exp -- e1 == e2
-  | ExpNE Exp Exp -- e1 != e2
-  | ExpLAnd Exp Exp -- e1 && e2
-  | ExpLOr Exp Exp -- e1 || e2
-  | ExpLNot Exp -- ! e
-  | ExpCond Exp Exp Exp -- if e1 then e2 else e3
-  | ExpAt Ty -- proxy sugar
-  deriving (Eq, Ord, Show, Data, Typeable)
+  = LitWithLocation NodeLocation Literal -- literal
+  | ExpNameWithLocation NodeLocation (Maybe Exp) Name [Exp] -- function call or constructor
+  | ExpVarWithLocation NodeLocation (Maybe Exp) Name -- variables or field access
+  | ExpDotNameWithLocation NodeLocation Name [Exp] -- contextual constructor shorthand, e.g. .Some(1), .None
+  | LamWithLocation NodeLocation [Param] Body (Maybe Ty) -- lambda-abstraction
+  | TyExpWithLocation NodeLocation Exp Ty -- type annotation expression
+  | ExpIndexedWithLocation NodeLocation Exp Exp -- e1[e2]
+  | ExpPlusWithLocation NodeLocation Exp Exp -- e1 + e2
+  | ExpMinusWithLocation NodeLocation Exp Exp -- e1 - e2
+  | ExpTimesWithLocation NodeLocation Exp Exp -- e1 * e2
+  | ExpDivideWithLocation NodeLocation Exp Exp -- e1 / e2
+  | ExpModuloWithLocation NodeLocation Exp Exp -- e1 % e2
+  | ExpLTWithLocation NodeLocation Exp Exp -- e1 < e2
+  | ExpGTWithLocation NodeLocation Exp Exp -- e1 > e2
+  | ExpLEWithLocation NodeLocation Exp Exp -- e1 <= e2
+  | ExpGEWithLocation NodeLocation Exp Exp -- e1 >= e2
+  | ExpEEWithLocation NodeLocation Exp Exp -- e1 == e2
+  | ExpNEWithLocation NodeLocation Exp Exp -- e1 != e2
+  | ExpLAndWithLocation NodeLocation Exp Exp -- e1 && e2
+  | ExpLOrWithLocation NodeLocation Exp Exp -- e1 || e2
+  | ExpLNotWithLocation NodeLocation Exp -- ! e
+  | ExpCondWithLocation NodeLocation Exp Exp Exp -- if e1 then e2 else e3
+  | ExpAtWithLocation NodeLocation Ty -- proxy sugar
+  deriving (Eq, Ord, Show, Data, Typeable)
+
+pattern Lit :: Literal -> Exp
+pattern Lit lit <- LitWithLocation _ lit
+  where
+    Lit lit = LitWithLocation unlocatedNode lit
+
+pattern ExpName :: Maybe Exp -> Name -> [Exp] -> Exp
+pattern ExpName me n es <- ExpNameWithLocation _ me n es
+  where
+    ExpName me n es = ExpNameWithLocation unlocatedNode me n es
+
+pattern ExpVar :: Maybe Exp -> Name -> Exp
+pattern ExpVar me n <- ExpVarWithLocation _ me n
+  where
+    ExpVar me n = ExpVarWithLocation unlocatedNode me n
+
+pattern ExpDotName :: Name -> [Exp] -> Exp
+pattern ExpDotName n es <- ExpDotNameWithLocation _ n es
+  where
+    ExpDotName n es = ExpDotNameWithLocation unlocatedNode n es
+
+pattern Lam :: [Param] -> Body -> Maybe Ty -> Exp
+pattern Lam ps body ty <- LamWithLocation _ ps body ty
+  where
+    Lam ps body ty = LamWithLocation unlocatedNode ps body ty
+
+pattern TyExp :: Exp -> Ty -> Exp
+pattern TyExp exp ty <- TyExpWithLocation _ exp ty
+  where
+    TyExp exp ty = TyExpWithLocation unlocatedNode exp ty
+
+pattern ExpIndexed :: Exp -> Exp -> Exp
+pattern ExpIndexed lhs rhs <- ExpIndexedWithLocation _ lhs rhs
+  where
+    ExpIndexed lhs rhs = ExpIndexedWithLocation unlocatedNode lhs rhs
+
+pattern ExpPlus :: Exp -> Exp -> Exp
+pattern ExpPlus lhs rhs <- ExpPlusWithLocation _ lhs rhs
+  where
+    ExpPlus lhs rhs = ExpPlusWithLocation unlocatedNode lhs rhs
+
+pattern ExpMinus :: Exp -> Exp -> Exp
+pattern ExpMinus lhs rhs <- ExpMinusWithLocation _ lhs rhs
+  where
+    ExpMinus lhs rhs = ExpMinusWithLocation unlocatedNode lhs rhs
+
+pattern ExpTimes :: Exp -> Exp -> Exp
+pattern ExpTimes lhs rhs <- ExpTimesWithLocation _ lhs rhs
+  where
+    ExpTimes lhs rhs = ExpTimesWithLocation unlocatedNode lhs rhs
+
+pattern ExpDivide :: Exp -> Exp -> Exp
+pattern ExpDivide lhs rhs <- ExpDivideWithLocation _ lhs rhs
+  where
+    ExpDivide lhs rhs = ExpDivideWithLocation unlocatedNode lhs rhs
+
+pattern ExpModulo :: Exp -> Exp -> Exp
+pattern ExpModulo lhs rhs <- ExpModuloWithLocation _ lhs rhs
+  where
+    ExpModulo lhs rhs = ExpModuloWithLocation unlocatedNode lhs rhs
+
+pattern ExpLT :: Exp -> Exp -> Exp
+pattern ExpLT lhs rhs <- ExpLTWithLocation _ lhs rhs
+  where
+    ExpLT lhs rhs = ExpLTWithLocation unlocatedNode lhs rhs
+
+pattern ExpGT :: Exp -> Exp -> Exp
+pattern ExpGT lhs rhs <- ExpGTWithLocation _ lhs rhs
+  where
+    ExpGT lhs rhs = ExpGTWithLocation unlocatedNode lhs rhs
+
+pattern ExpLE :: Exp -> Exp -> Exp
+pattern ExpLE lhs rhs <- ExpLEWithLocation _ lhs rhs
+  where
+    ExpLE lhs rhs = ExpLEWithLocation unlocatedNode lhs rhs
+
+pattern ExpGE :: Exp -> Exp -> Exp
+pattern ExpGE lhs rhs <- ExpGEWithLocation _ lhs rhs
+  where
+    ExpGE lhs rhs = ExpGEWithLocation unlocatedNode lhs rhs
+
+pattern ExpEE :: Exp -> Exp -> Exp
+pattern ExpEE lhs rhs <- ExpEEWithLocation _ lhs rhs
+  where
+    ExpEE lhs rhs = ExpEEWithLocation unlocatedNode lhs rhs
+
+pattern ExpNE :: Exp -> Exp -> Exp
+pattern ExpNE lhs rhs <- ExpNEWithLocation _ lhs rhs
+  where
+    ExpNE lhs rhs = ExpNEWithLocation unlocatedNode lhs rhs
+
+pattern ExpLAnd :: Exp -> Exp -> Exp
+pattern ExpLAnd lhs rhs <- ExpLAndWithLocation _ lhs rhs
+  where
+    ExpLAnd lhs rhs = ExpLAndWithLocation unlocatedNode lhs rhs
+
+pattern ExpLOr :: Exp -> Exp -> Exp
+pattern ExpLOr lhs rhs <- ExpLOrWithLocation _ lhs rhs
+  where
+    ExpLOr lhs rhs = ExpLOrWithLocation unlocatedNode lhs rhs
+
+pattern ExpLNot :: Exp -> Exp
+pattern ExpLNot exp <- ExpLNotWithLocation _ exp
+  where
+    ExpLNot exp = ExpLNotWithLocation unlocatedNode exp
+
+pattern ExpCond :: Exp -> Exp -> Exp -> Exp
+pattern ExpCond cond thenExp elseExp <- ExpCondWithLocation _ cond thenExp elseExp
+  where
+    ExpCond cond thenExp elseExp = ExpCondWithLocation unlocatedNode cond thenExp elseExp
+
+pattern ExpAt :: Ty -> Exp
+pattern ExpAt ty <- ExpAtWithLocation _ ty
+  where
+    ExpAt ty = ExpAtWithLocation unlocatedNode ty
+
+{-# COMPLETE Lit, ExpName, ExpVar, ExpDotName, Lam, TyExp, ExpIndexed, ExpPlus, ExpMinus, ExpTimes, ExpDivide, ExpModulo, ExpLT, ExpGT, ExpLE, ExpGE, ExpEE, ExpNE, ExpLAnd, ExpLOr, ExpLNot, ExpCond, ExpAt #-}
+
+locatedExp :: SourceSpan -> Exp -> Exp
+locatedExp sourceSpan (Lit lit) = LitWithLocation location lit
+  where
+    location = locatedNode sourceSpan
+locatedExp sourceSpan (ExpName me n es) = ExpNameWithLocation (locatedNode sourceSpan) me n es
+locatedExp sourceSpan (ExpVar me n) = ExpVarWithLocation (locatedNode sourceSpan) me n
+locatedExp sourceSpan (ExpDotName n es) = ExpDotNameWithLocation (locatedNode sourceSpan) n es
+locatedExp sourceSpan (Lam ps body ty) = LamWithLocation (locatedNode sourceSpan) ps body ty
+locatedExp sourceSpan (TyExp exp ty) = TyExpWithLocation (locatedNode sourceSpan) exp ty
+locatedExp sourceSpan (ExpIndexed lhs rhs) = ExpIndexedWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpPlus lhs rhs) = ExpPlusWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpMinus lhs rhs) = ExpMinusWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpTimes lhs rhs) = ExpTimesWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpDivide lhs rhs) = ExpDivideWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpModulo lhs rhs) = ExpModuloWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpLT lhs rhs) = ExpLTWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpGT lhs rhs) = ExpGTWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpLE lhs rhs) = ExpLEWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpGE lhs rhs) = ExpGEWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpEE lhs rhs) = ExpEEWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpNE lhs rhs) = ExpNEWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpLAnd lhs rhs) = ExpLAndWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpLOr lhs rhs) = ExpLOrWithLocation (locatedNode sourceSpan) lhs rhs
+locatedExp sourceSpan (ExpLNot exp) = ExpLNotWithLocation (locatedNode sourceSpan) exp
+locatedExp sourceSpan (ExpCond cond thenExp elseExp) = ExpCondWithLocation (locatedNode sourceSpan) cond thenExp elseExp
+locatedExp sourceSpan (ExpAt ty) = ExpAtWithLocation (locatedNode sourceSpan) ty
+
+instance HasSourceSpan Exp where
+  sourceSpanOf (LitWithLocation location _) = sourceSpanOf location
+  sourceSpanOf (ExpNameWithLocation location me n es) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf me, sourceSpanOf n, sourceSpanOf es]
+  sourceSpanOf (ExpVarWithLocation location me n) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf me, sourceSpanOf n]
+  sourceSpanOf (ExpDotNameWithLocation location n es) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf es]
+  sourceSpanOf (LamWithLocation location ps body ty) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf ps, sourceSpanOf body, sourceSpanOf ty]
+  sourceSpanOf (TyExpWithLocation location exp ty) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp, sourceSpanOf ty]
+  sourceSpanOf (ExpIndexedWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpPlusWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpMinusWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpTimesWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpDivideWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpModuloWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpLTWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpGTWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpLEWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpGEWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpEEWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpNEWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpLAndWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpLOrWithLocation location lhs rhs) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf lhs, sourceSpanOf rhs]
+  sourceSpanOf (ExpLNotWithLocation location exp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf exp]
+  sourceSpanOf (ExpCondWithLocation location cond thenExp elseExp) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf cond, sourceSpanOf thenExp, sourceSpanOf elseExp]
+  sourceSpanOf (ExpAtWithLocation location ty) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf ty]
 
 -- pattern matching equations
 
 data Pat
-  = Pat Name [Pat]
-  | PatDot Name [Pat]
-  | PWildcard
-  | PLit Literal
+  = PatWithLocation NodeLocation Name [Pat]
+  | PatDotWithLocation NodeLocation Name [Pat]
+  | PWildcardWithLocation NodeLocation
+  | PLitWithLocation NodeLocation Literal
   deriving (Eq, Ord, Show, Data, Typeable)
 
+pattern Pat :: Name -> [Pat] -> Pat
+pattern Pat n ps <- PatWithLocation _ n ps
+  where
+    Pat n ps = PatWithLocation unlocatedNode n ps
+
+pattern PatDot :: Name -> [Pat] -> Pat
+pattern PatDot n ps <- PatDotWithLocation _ n ps
+  where
+    PatDot n ps = PatDotWithLocation unlocatedNode n ps
+
+pattern PWildcard :: Pat
+pattern PWildcard <- PWildcardWithLocation _
+  where
+    PWildcard = PWildcardWithLocation unlocatedNode
+
+pattern PLit :: Literal -> Pat
+pattern PLit lit <- PLitWithLocation _ lit
+  where
+    PLit lit = PLitWithLocation unlocatedNode lit
+
+{-# COMPLETE Pat, PatDot, PWildcard, PLit #-}
+
+locatedPat :: SourceSpan -> Pat -> Pat
+locatedPat sourceSpan (Pat n ps) = PatWithLocation (locatedNode sourceSpan) n ps
+locatedPat sourceSpan (PatDot n ps) = PatDotWithLocation (locatedNode sourceSpan) n ps
+locatedPat sourceSpan PWildcard = PWildcardWithLocation (locatedNode sourceSpan)
+locatedPat sourceSpan (PLit lit) = PLitWithLocation (locatedNode sourceSpan) lit
+
+instance HasSourceSpan Pat where
+  sourceSpanOf (PatWithLocation location n ps) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ps]
+  sourceSpanOf (PatDotWithLocation location n ps) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ps]
+  sourceSpanOf (PWildcardWithLocation location) = sourceSpanOf location
+  sourceSpanOf (PLitWithLocation location _) = sourceSpanOf location
+
 -- definition of literals
 
 data Literal
diff --git a/src/Solcore/Frontend/Syntax/Ty.hs b/src/Solcore/Frontend/Syntax/Ty.hs
index c1ccbd088..a8b2beb57 100644
--- a/src/Solcore/Frontend/Syntax/Ty.hs
+++ b/src/Solcore/Frontend/Syntax/Ty.hs
@@ -1,7 +1,11 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Solcore.Frontend.Syntax.Ty where
 
 import Data.Generics (Data, Typeable)
 import Data.List
+import Solcore.Diagnostics (SourceSpan)
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 
 -- basic typing infrastructure
@@ -21,14 +25,37 @@ isBound _ = False
 
 data Ty
   = TyVar Tyvar -- type variable
-  | TyCon Name [Ty] -- type constructor
+  | TyConWithLocation NodeLocation Name [Ty] -- type constructor
   | Meta MetaTv -- meta type variable
   deriving (Eq, Ord, Show, Data, Typeable)
 
+pattern TyCon :: Name -> [Ty] -> Ty
+pattern TyCon n ts <- TyConWithLocation _ n ts
+  where
+    TyCon n ts = TyConWithLocation unlocatedNode n ts
+
+{-# COMPLETE TyVar, TyCon, Meta #-}
+
 newtype MetaTv
   = MetaTv {metaName :: Name}
   deriving (Eq, Ord, Show, Data, Typeable)
 
+locatedTy :: SourceSpan -> Ty -> Ty
+locatedTy sourceSpan (TyCon n ts) = TyConWithLocation (locatedNode sourceSpan) n ts
+locatedTy _ ty = ty
+
+instance HasSourceSpan Tyvar where
+  sourceSpanOf = sourceSpanOf . tyvarName
+
+instance HasSourceSpan MetaTv where
+  sourceSpanOf = sourceSpanOf . metaName
+
+instance HasSourceSpan Ty where
+  sourceSpanOf (TyVar tyvar) = sourceSpanOf tyvar
+  sourceSpanOf (TyConWithLocation location n ts) =
+    firstSourceSpan [sourceSpanOf location, sourceSpanOf n, sourceSpanOf ts]
+  sourceSpanOf (Meta metaTv) = sourceSpanOf metaTv
+
 tyconNames :: Ty -> [Name]
 tyconNames (TyCon n ts) =
   nub (n : concatMap tyconNames ts)
@@ -110,12 +137,22 @@ data Pred
   | Ty :~: Ty
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance HasSourceSpan Pred where
+  sourceSpanOf (InCls n t ts) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf t, sourceSpanOf ts]
+  sourceSpanOf (left :~: right) =
+    firstSourceSpan [sourceSpanOf left, sourceSpanOf right]
+
 -- qualified types
 
 data Qual t
   = [Pred] :=> t
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance (HasSourceSpan t) => HasSourceSpan (Qual t) where
+  sourceSpanOf (preds :=> t) =
+    firstSourceSpan [sourceSpanOf preds, sourceSpanOf t]
+
 infix 2 :=>
 
 -- type schemes
@@ -124,6 +161,10 @@ data Scheme
   = Forall [Tyvar] (Qual Ty)
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance HasSourceSpan Scheme where
+  sourceSpanOf (Forall tyvars qualTy) =
+    firstSourceSpan [sourceSpanOf tyvars, sourceSpanOf qualTy]
+
 monotype :: Ty -> Scheme
 monotype t = Forall [] ([] :=> t)
 
diff --git a/src/Solcore/Frontend/TypeInference/TcStmt.hs b/src/Solcore/Frontend/TypeInference/TcStmt.hs
index 98e075df4..914e8f39a 100644
--- a/src/Solcore/Frontend/TypeInference/TcStmt.hs
+++ b/src/Solcore/Frontend/TypeInference/TcStmt.hs
@@ -11,6 +11,7 @@ import Data.Maybe
 import Data.Set qualified as Set
 import GHC.Stack
 import Language.Yul
+import Solcore.Diagnostics (SourceSpan)
 import Solcore.Frontend.Pretty.ShortName
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
@@ -28,11 +29,35 @@ import Solcore.Primitives.Primitives
 
 type Infer f = f Name -> TcM (f Id, [Pred], Ty)
 
+locatedLike :: (HasSourceSpan source) => source -> (SourceSpan -> target -> target) -> target -> target
+locatedLike source locate target =
+  maybe target (`locate` target) (sourceSpanOf source)
+
+locatedInferResult ::
+  (HasSourceSpan source) =>
+  (SourceSpan -> node -> node) ->
+  source ->
+  (node, [Pred], Ty) ->
+  (node, [Pred], Ty)
+locatedInferResult locate source (node, preds, ty) =
+  (locatedLike source locate node, preds, ty)
+
+locatedPatResult ::
+  Pat Name ->
+  (Pat Id, Ty, [(Name, Scheme)]) ->
+  (Pat Id, Ty, [(Name, Scheme)])
+locatedPatResult source (pat, ty, context) =
+  (locatedLike source locatedPat pat, ty, context)
+
 tcStmt :: Infer Stmt
 tcStmt = tcStmtWithExpectedReturn Nothing
 
 tcStmtWithExpectedReturn :: Maybe Ty -> Infer Stmt
-tcStmtWithExpectedReturn _ e@(lhs := rhs) =
+tcStmtWithExpectedReturn mExpectedReturn stmt =
+  locatedInferResult locatedStmt stmt <$> tcStmtWithExpectedReturn' mExpectedReturn stmt
+
+tcStmtWithExpectedReturn' :: Maybe Ty -> Infer Stmt
+tcStmtWithExpectedReturn' _ e@(lhs := rhs) =
   do
     (lhs1, ps1, t1) <- tcExp lhs
     s0 <- getSubst
@@ -41,7 +66,7 @@ tcStmtWithExpectedReturn _ e@(lhs := rhs) =
     s <- unify t1 t2 `wrapError` e
     _ <- extSubst s
     pure (lhs1 := rhs1, apply s $ ps1 ++ ps2, unit)
-tcStmtWithExpectedReturn _ e@(Let n mt me) =
+tcStmtWithExpectedReturn' _ e@(Let n mt me) =
   do
     (me', psf, tf) <- case (mt, me) of
       (Just t, Just e1) -> do
@@ -63,31 +88,31 @@ tcStmtWithExpectedReturn _ e@(Let n mt me) =
     extEnv n (monotype tf)
     let e' = Let (Id n tf) (Just tf) me'
     withCurrentSubst (e', psf, unit)
-tcStmtWithExpectedReturn mExpectedReturn (Block body) =
+tcStmtWithExpectedReturn' mExpectedReturn (Block body) =
   withLocalCtx [] $ do
     (body', ps, t) <- tcBodyWithExpectedReturn mExpectedReturn body
     pure (Block body', ps, t)
-tcStmtWithExpectedReturn _ (StmtExp e) =
+tcStmtWithExpectedReturn' _ (StmtExp e) =
   do
     (e', ps', _) <- tcExp e
     pure (StmtExp e', ps', unit)
-tcStmtWithExpectedReturn mExpectedReturn (Return e) =
+tcStmtWithExpectedReturn' mExpectedReturn (Return e) =
   do
     (e', ps, t) <- tcExpWithExpected mExpectedReturn e
     pure (Return e', ps, t)
-tcStmtWithExpectedReturn mExpectedReturn (Match es eqns) =
+tcStmtWithExpectedReturn' mExpectedReturn (Match es eqns) =
   do
     (es', pss', ts') <- unzip3 <$> mapM tcExp es
     ensureVisiblePatternCoverage ts' eqns
     (eqns', pss1, resTy) <- tcEquationsWithExpectedReturn mExpectedReturn ts' eqns
     withCurrentSubst (Match es' eqns', concat (pss1 : pss'), resTy)
-tcStmtWithExpectedReturn _ (Asm yblk) =
+tcStmtWithExpectedReturn' _ (Asm yblk) =
   withLocalCtx yulPrimOps $ do
     (newBinds, t) <- tcYulBlock yblk
     let word' = monotype word
     mapM_ (flip extEnv word') newBinds
     pure (Asm yblk, [], t)
-tcStmtWithExpectedReturn mExpectedReturn s@(If e blk1 blk2) =
+tcStmtWithExpectedReturn' mExpectedReturn s@(If e blk1 blk2) =
   do
     (e', ps, t) <- tcExp e
     -- condition should have the boolean type
@@ -128,7 +153,7 @@ tcStmtWithExpectedReturn mExpectedReturn s@(If e blk1 blk2) =
                      )
         `wrapError` s
     withCurrentSubst (If e' blk1' blk2', ps3, t1)
-tcStmtWithExpectedReturn mExpectedReturn s@(For initStmt cond postStmt body) =
+tcStmtWithExpectedReturn' mExpectedReturn s@(For initStmt cond postStmt body) =
   withLocalEnv $ do
     (initStmt', psInit, _) <- tcStmtWithExpectedReturn Nothing initStmt
     (cond', psCond, condTy) <- tcExp cond
@@ -213,11 +238,15 @@ tcPats ts ps
       pure (ps', ts', concat ctxs)
 
 tcPat :: Ty -> Pat Name -> TcM (Pat Id, Ty, [(Name, Scheme)])
-tcPat t (PVar n) =
+tcPat t pat =
+  locatedPatResult pat <$> tcPat' t pat
+
+tcPat' :: Ty -> Pat Name -> TcM (Pat Id, Ty, [(Name, Scheme)])
+tcPat' t (PVar n) =
   do
     let v = PVar (Id n t)
     pure (v, t, [(n, monotype t)])
-tcPat t p@(PCon n ps) =
+tcPat' t p@(PCon n ps) =
   do
     n' <- resolvePatternConstructor n t `wrapError` p
     -- asking type from environment
@@ -248,9 +277,9 @@ tcPat t p@(PCon n ps) =
     -- building typing assumptions for introduced names
     let lctx' = map (\(boundName, t1) -> (boundName, apply s t1)) (concat lctxs)
     pure (PCon (Id n' tc) ps1, t', apply s lctx')
-tcPat t PWildcard =
+tcPat' t PWildcard =
   pure (PWildcard, t, [])
-tcPat t' (PLit l) =
+tcPat' t' (PLit l) =
   do
     t <- tcLit l
     s <- unify t t'
@@ -274,13 +303,17 @@ tcExp :: (HasCallStack) => Infer Exp
 tcExp = tcExpWithExpected Nothing
 
 tcExpWithExpected :: (HasCallStack) => Maybe Ty -> Exp Name -> TcM (Exp Id, [Pred], Ty)
-tcExpWithExpected _ (Lit l) =
+tcExpWithExpected mExpected expr =
+  locatedInferResult locatedExp expr <$> tcExpWithExpected' mExpected expr
+
+tcExpWithExpected' :: (HasCallStack) => Maybe Ty -> Exp Name -> TcM (Exp Id, [Pred], Ty)
+tcExpWithExpected' _ (Lit l) =
   do
     t <- tcLit l
     pure (Lit l, [], t)
-tcExpWithExpected _ (Var n) =
+tcExpWithExpected' _ e@(Var n) =
   do
-    s <- askEnv n `wrapError` (Var n)
+    s <- askEnv n `wrapError` e
     (ps :=> t) <- freshInst s
     noDesugarCalls <- getNoDesugarCalls
     if noDesugarCalls
@@ -291,7 +324,7 @@ tcExpWithExpected _ (Var n) =
         r <- lookupUniqueTy n
         p <- maybe (pure $ (Var (Id n t), t)) mkCon r
         withCurrentSubst (fst p, ps, snd p)
-tcExpWithExpected mExpected e@(Con n es) =
+tcExpWithExpected' mExpected e@(Con n es) =
   do
     expectedArgTys <- mapM (const freshTyVar) es
     n' <- resolveExpressionConstructor n expectedArgTys mExpected `wrapError` e
@@ -328,10 +361,10 @@ tcExpWithExpected mExpected e@(Con n es) =
     let ps' = concat (ps : pss)
         e1 = Con (Id n' t) es'
     withCurrentSubst (e1, ps', t')
-tcExpWithExpected _ e@(FieldAccess Nothing _) =
+tcExpWithExpected' _ e@(FieldAccess Nothing _) =
   -- = notImplementedS "tcExp" e
   throwError ("tcExp not implemented for: " ++ pretty e ++ "\n" ++ show e)
-tcExpWithExpected _ (FieldAccess (Just e) n) =
+tcExpWithExpected' _ (FieldAccess (Just e) n) =
   do
     -- inferring expression type
     (e', ps, t) <- tcExpWithExpected Nothing e
@@ -342,9 +375,9 @@ tcExpWithExpected _ (FieldAccess (Just e) n) =
     s <- askField tn n
     (ps' :=> t') <- freshInst s
     withCurrentSubst (FieldAccess (Just e') (Id n t'), ps ++ ps', t')
-tcExpWithExpected _ ex@(Call me n args) =
+tcExpWithExpected' _ ex@(Call me n args) =
   tcCall me n args `wrapError` ex
-tcExpWithExpected _ (Lam args bd _) =
+tcExpWithExpected' _ (Lam args bd _) =
   do
     (args', schs, ts') <- tcArgs args
     (bd', ps, t') <- withLocalCtx schs (tcBody bd)
@@ -361,14 +394,14 @@ tcExpWithExpected _ (Lam args bd _) =
       else do
         (exp1, t) <- closureConversion vs (apply s args') (apply s bd') ps1 ty
         withCurrentSubst (exp1, ps1, t)
-tcExpWithExpected _ e1@(TyExp e ty) =
+tcExpWithExpected' _ e1@(TyExp e ty) =
   do
     ty1 <- kindCheck ty `wrapError` e1
     (e', ps, ty') <- tcExpWithExpected (Just ty1) e
     s <- tcmMatch ty' ty1
     _ <- extSubst s
     withCurrentSubst (TyExp e' ty1, ps, ty1)
-tcExpWithExpected _ e@(Cond e1 e2 e3) =
+tcExpWithExpected' _ e@(Cond e1 e2 e3) =
   do
     (e1', ps1, t1) <- tcExpWithExpected Nothing e1 `wrapError` e
     (e2', ps2, t2) <- tcExpWithExpected Nothing e2 `wrapError` e
@@ -406,7 +439,7 @@ tcExpWithExpected _ e@(Cond e1 e2 e3) =
                      )
         `wrapError` e
     withCurrentSubst (Cond e1' e2' e3', ps1 ++ ps2 ++ ps3, t2)
-tcExpWithExpected _ e@(Indexed arrExp idx) =
+tcExpWithExpected' _ e@(Indexed arrExp idx) =
   do
     (arr', psArr, tArr) <- tcExp arrExp `wrapError` e
     (idx', psIdx, tIdx) <- tcExp idx `wrapError` e

From 45c4aca53adb759728a5fd4129254ca09756fcb2 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 27 May 2026 11:25:49 +0200
Subject: [PATCH 28/35] Carry structured compiler errors

---
 src/Solcore/Backend/Specialise.hs             |  3 +-
 src/Solcore/Diagnostics.hs                    | 50 +++++++++++
 src/Solcore/Frontend/Syntax/NameResolution.hs | 83 ++++++++---------
 .../Frontend/TypeInference/TcContract.hs      | 24 ++---
 .../Frontend/TypeInference/TcModule.hs        | 16 ++--
 src/Solcore/Frontend/TypeInference/TcMonad.hs | 43 +++++----
 src/Solcore/Frontend/TypeInference/TcSat.hs   |  7 +-
 src/Solcore/Frontend/TypeInference/TcStmt.hs  | 62 ++++++-------
 src/Solcore/Frontend/TypeInference/TcUnify.hs | 49 +++++-----
 src/Solcore/Pipeline/SolcorePipeline.hs       | 89 +++++++++++--------
 test/ModuleTypeCheckTests.hs                  |  7 +-
 11 files changed, 258 insertions(+), 175 deletions(-)

diff --git a/src/Solcore/Backend/Specialise.hs b/src/Solcore/Backend/Specialise.hs
index d7e5a69ed..62529f7ce 100644
--- a/src/Solcore/Backend/Specialise.hs
+++ b/src/Solcore/Backend/Specialise.hs
@@ -21,7 +21,6 @@ import Solcore.Frontend.Syntax hiding (decls, name)
 import Solcore.Frontend.TypeInference.Id (Id (..))
 import Solcore.Frontend.TypeInference.NameSupply
 import Solcore.Frontend.TypeInference.TcEnv (TcEnv (typeTable), TypeInfo (..))
-import Solcore.Frontend.TypeInference.TcUnify (typesDoNotUnify)
 import Solcore.Primitives.Primitives
 
 -- ** Specialisation state and monad
@@ -655,7 +654,7 @@ specmgu (TyCon n ts) (TyCon n' ts')
       specsolve (zip ts ts') mempty
 specmgu (TyVar v) t = varBind v t
 specmgu t (TyVar v) = varBind v t
-specmgu t1 t2 = typesDoNotUnify t1 t2
+specmgu t1 t2 = Left $ "types do not unify: " ++ pretty t1 ++ " and " ++ pretty t2
 
 varBind :: (MonadError String m) => Tyvar -> Ty -> m TVSubst
 varBind v t
diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 276eec413..26a440556 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -5,6 +5,7 @@ module Solcore.Diagnostics
     LabelStyle (..),
     Label (..),
     Diagnostic (..),
+    CompilerError (..),
     SourceId (..),
     SourceToken (..),
     SourceFile (..),
@@ -28,6 +29,13 @@ module Solcore.Diagnostics
     legacyDiagnostic,
     addDiagnosticNote,
     addDiagnosticHelp,
+    diagnosticCompilerError,
+    diagnosticsCompilerError,
+    legacyCompilerError,
+    compilerErrorDiagnostics,
+    compilerErrorText,
+    compilerErrorFromString,
+    mapCompilerErrorDiagnostics,
     encodeDiagnostic,
     decodeDiagnostic,
     diagnosticPrimarySpan,
@@ -91,6 +99,11 @@ data Diagnostic
   }
   deriving (Eq, Ord, Read, Show)
 
+data CompilerError
+  = CompilerDiagnostics [Diagnostic]
+  | CompilerLegacyError String
+  deriving (Eq, Ord, Show)
+
 newtype SourceId = SourceId FilePath
   deriving (Eq, Ord, Show)
 
@@ -298,6 +311,43 @@ addDiagnosticHelp :: String -> Diagnostic -> Diagnostic
 addDiagnosticHelp help diagnostic =
   diagnostic {diagnosticHelp = appendUnique help (diagnosticHelp diagnostic)}
 
+diagnosticCompilerError :: Diagnostic -> CompilerError
+diagnosticCompilerError diagnostic =
+  CompilerDiagnostics [diagnostic]
+
+diagnosticsCompilerError :: [Diagnostic] -> CompilerError
+diagnosticsCompilerError diagnostics =
+  CompilerDiagnostics diagnostics
+
+legacyCompilerError :: String -> CompilerError
+legacyCompilerError =
+  CompilerLegacyError
+
+compilerErrorDiagnostics :: CompilerError -> [Diagnostic]
+compilerErrorDiagnostics (CompilerDiagnostics diagnostics) = diagnostics
+compilerErrorDiagnostics (CompilerLegacyError message) = [legacyDiagnostic message]
+
+compilerErrorText :: CompilerError -> String
+compilerErrorText (CompilerDiagnostics diagnostics) =
+  unlines (map encodeDiagnostic diagnostics)
+compilerErrorText (CompilerLegacyError message) = message
+
+compilerErrorFromString :: String -> CompilerError
+compilerErrorFromString err =
+  case mapM decodeDiagnostic (filter (not . null) (lines err)) of
+    Just diagnostics
+      | not (null diagnostics) -> CompilerDiagnostics diagnostics
+    _ ->
+      case decodeDiagnostic err of
+        Just diagnostic -> CompilerDiagnostics [diagnostic]
+        Nothing -> CompilerLegacyError err
+
+mapCompilerErrorDiagnostics :: ([Diagnostic] -> [Diagnostic]) -> CompilerError -> CompilerError
+mapCompilerErrorDiagnostics f (CompilerDiagnostics diagnostics) =
+  CompilerDiagnostics (f diagnostics)
+mapCompilerErrorDiagnostics f (CompilerLegacyError message) =
+  CompilerDiagnostics (f [legacyDiagnostic message])
+
 appendUnique :: String -> [String] -> [String]
 appendUnique item items
   | null item = items
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 824a3d6f1..9ae409026 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -5,13 +5,13 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.State
-import Data.Generics (Data, everything, mkQ)
+import Data.Generics (Data, everything, extQ, mkQ)
 import Data.List ((\\))
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
 import Data.Monoid (First (..))
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (CompilerError (..), Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, diagnosticCompilerError)
 import Solcore.Frontend.Pretty.TreePretty
 import Solcore.Frontend.Syntax.Contract hiding (contracts, decls)
 import Solcore.Frontend.Syntax.Location
@@ -22,14 +22,14 @@ import Solcore.Frontend.Syntax.Ty
 
 -- name resolution
 
-nameResolution :: S.CompUnit -> IO (Either String (CompUnit Name))
+nameResolution :: S.CompUnit -> IO (Either CompilerError (CompUnit Name))
 nameResolution (S.CompUnit imps ds) =
   fmap fst <$> nameResolutionTopDeclSegments imps [ds]
 
 nameResolutionTopDeclSegments ::
   [S.Import] ->
   [[S.TopDecl]] ->
-  IO (Either String (CompUnit Name, [[TopDecl Name]]))
+  IO (Either CompilerError (CompUnit Name, [[TopDecl Name]]))
 nameResolutionTopDeclSegments imps segments =
   do
     let ds = concat segments
@@ -84,23 +84,23 @@ resolveExportSpec (S.ExportNameWithConstructors typeName ctorSelector) =
   ExportNameWithConstructors typeName (resolveConstructorSelector ctorSelector)
 resolveExportSpec (S.ExportModuleAll path) = ExportModuleAll (resolveModulePath path)
 
-validateDuplicateNamespacesInCompUnit :: S.CompUnit -> Either String ()
+validateDuplicateNamespacesInCompUnit :: S.CompUnit -> Either CompilerError ()
 validateDuplicateNamespacesInCompUnit (S.CompUnit _ ds) =
   validateDuplicateNamespaces ds
 
-validateDuplicateNamespacesInTopDeclSegments :: [[S.TopDecl]] -> Either String ()
+validateDuplicateNamespacesInTopDeclSegments :: [[S.TopDecl]] -> Either CompilerError ()
 validateDuplicateNamespacesInTopDeclSegments segments = do
   ensureNoDuplicateNames "type namespace" (concatMap topLevelTypeNames segments)
   ensureNoDuplicateNames "term namespace" (concatMap topLevelTermNames segments)
   mapM_ validateContractDuplicates [c | segment <- segments, S.TContr c <- segment]
 
-validateDuplicateNamespaces :: [S.TopDecl] -> Either String ()
+validateDuplicateNamespaces :: [S.TopDecl] -> Either CompilerError ()
 validateDuplicateNamespaces ds = do
   ensureNoDuplicateNames "type namespace" (topLevelTypeNames ds)
   ensureNoDuplicateNames "term namespace" (topLevelTermNames ds)
   mapM_ validateContractDuplicates [c | S.TContr c <- ds]
 
-validateContractDuplicates :: S.Contract -> Either String ()
+validateContractDuplicates :: S.Contract -> Either CompilerError ()
 validateContractDuplicates (S.Contract cname _ decls) = do
   let typeNames = [n | S.CDataDecl (S.DataTy n _ _) <- decls]
       termNames = contractTermNames decls
@@ -137,20 +137,22 @@ qualifiedConstructorName :: Name -> Name -> Name
 qualifiedConstructorName tyCon conName =
   qualifyName tyCon (constructorLeafName conName)
 
-ensureNoDuplicateNames :: String -> [Name] -> Either String ()
+ensureNoDuplicateNames :: String -> [Name] -> Either CompilerError ()
 ensureNoDuplicateNames ns = ensureNoDuplicateNamesIn "module" ns
 
-ensureNoDuplicateNamesIn :: String -> String -> [Name] -> Either String ()
+ensureNoDuplicateNamesIn :: String -> String -> [Name] -> Either CompilerError ()
 ensureNoDuplicateNamesIn ctx ns names =
   case duplicates of
     [] -> pure ()
     xs ->
       Left $
-        diagnosticString
-          "SC0108"
-          ("duplicate declarations in " ++ ns)
-          (("context: " ++ ctx) : map (\n -> "  " ++ pretty n) xs)
-          ["rename or remove the duplicate declaration"]
+        diagnosticCompilerError $
+          diagnosticValue
+            "SC0108"
+            ("duplicate declarations in " ++ ns)
+            []
+            (("context: " ++ ctx) : map (\n -> "  " ++ pretty n) xs)
+            ["rename or remove the duplicate declaration"]
   where
     counts :: Map Name Int
     counts = Map.fromListWith (+) [(n, 1) | n <- names]
@@ -974,9 +976,9 @@ addQualifiedModules _ env = env
 
 -- definition of a monad for name resolution
 
-type ResolveM a = StateT Env (ExceptT String IO) a
+type ResolveM a = StateT Env (ExceptT CompilerError IO) a
 
-runResolveM :: ResolveM a -> Env -> IO (Either String a)
+runResolveM :: ResolveM a -> Env -> IO (Either CompilerError a)
 runResolveM m env =
   do
     r <- runExceptT (runStateT m env)
@@ -1021,11 +1023,13 @@ wrapError m e =
   catchError m handler
   where
     handler msg = throwError (decorate msg)
-    decorate msg =
-      case decodeDiagnostic msg of
-        Just diagnostic ->
-          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) (addContextLabel e diagnostic))
-        Nothing -> msg ++ "\n - in:" ++ pretty e
+    decorate (CompilerDiagnostics diagnostics) =
+      CompilerDiagnostics $
+        map
+          (addDiagnosticNote ("in: " ++ pretty e) . addContextLabel e)
+          diagnostics
+    decorate (CompilerLegacyError msg) =
+      CompilerLegacyError (msg ++ "\n - in:" ++ pretty e)
 
 addContextLabel :: (Data b) => b -> Diagnostic -> Diagnostic
 addContextLabel context diagnostic
@@ -1058,8 +1062,11 @@ contextLabelMessage diagnostic =
 
 contextSourceSpan :: (Data a) => a -> Maybe SourceSpan
 contextSourceSpan value =
-  getFirst $ everything (<>) (mkQ (First Nothing) nameSpan) value
+  getFirst $ everything (<>) (mkQ (First Nothing) locationSpan `extQ` nameSpan) value
   where
+    locationSpan :: NodeLocation -> First SourceSpan
+    locationSpan = First . nodeLocationSpan
+
     nameSpan :: Name -> First SourceSpan
     nameSpan = First . nameSourceSpan
 
@@ -1199,23 +1206,19 @@ diagnosticErrorAtName code message identName label notes help =
 
 diagnosticErrorWithLabels :: String -> String -> [Label] -> [String] -> [String] -> ResolveM a
 diagnosticErrorWithLabels code message labels notes help =
-  throwError $ diagnosticStringWithLabels code message labels notes help
-
-diagnosticString :: String -> String -> [String] -> [String] -> String
-diagnosticString code message notes help =
-  diagnosticStringWithLabels code message [] notes help
-
-diagnosticStringWithLabels :: String -> String -> [Label] -> [String] -> [String] -> String
-diagnosticStringWithLabels code message labels notes help =
-  encodeDiagnostic
-    Diagnostic
-      { diagnosticSeverity = Error,
-        diagnosticCode = Just (DiagnosticCode code),
-        diagnosticMessage = message,
-        diagnosticLabels = labels,
-        diagnosticNotes = notes,
-        diagnosticHelp = help
-      }
+  throwError $ diagnosticCompilerError $ diagnosticValue code message labels notes help
+
+diagnosticValue :: String -> String -> [Label] -> [String] -> [String] -> Diagnostic
+diagnosticValue code message labels notes help =
+  Diagnostic
+    { diagnosticSeverity = Error,
+      diagnosticCode = Just (DiagnosticCode code),
+      diagnosticMessage = message,
+      diagnosticLabels = labels,
+      diagnosticNotes = notes,
+      diagnosticHelp = help
+    }
+
 
 primaryNameLabel :: String -> Name -> Maybe Label
 primaryNameLabel message identName =
diff --git a/src/Solcore/Frontend/TypeInference/TcContract.hs b/src/Solcore/Frontend/TypeInference/TcContract.hs
index 990cc2706..3b52e2cc0 100644
--- a/src/Solcore/Frontend/TypeInference/TcContract.hs
+++ b/src/Solcore/Frontend/TypeInference/TcContract.hs
@@ -1,7 +1,6 @@
 module Solcore.Frontend.TypeInference.TcContract where
 
 import Control.Monad
-import Control.Monad.Except
 import Control.Monad.State
 import Data.Generics hiding (Constr)
 import Data.List
@@ -9,6 +8,7 @@ import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
 import Data.Set qualified as Set
+import Solcore.Diagnostics (CompilerError)
 import Solcore.Frontend.Pretty.ShortName
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
@@ -40,7 +40,7 @@ typeInferTopDeclChecks ::
   [InstanceHead] ->
   [(Name, [Name])] ->
   [TopDeclCheck Name] ->
-  IO (Either String (CompUnit Id, TcEnv))
+  IO (Either CompilerError (CompUnit Id, TcEnv))
 typeInferTopDeclChecks opts imps trustedInstances partialTypes topDeclChecks =
   do
     r <-
@@ -77,7 +77,7 @@ expandTyM st (TyCon n ts) = do
       | length params == length ts' ->
           expandTyM st (insts (zip params ts') body)
       | otherwise ->
-          throwError $
+          tcmError $
             unlines
               [ "Type synonym arity mismatch for '" ++ pretty n ++ "':",
                 "  expected " ++ show (length params) ++ " argument(s)",
@@ -162,7 +162,7 @@ findCycle deps = go [] (map fst deps)
 
 recursiveSynonymError :: [Name] -> TcM a
 recursiveSynonymError cyclePath =
-  throwError $
+  tcmError $
     unlines
       [ "Recursive type synonym detected:",
         "  " ++ intercalate " -> " (map pretty cyclePath)
@@ -202,7 +202,7 @@ tcTopDecl (TFunDef fd) =
     fd' <- tcBindGroup [fd]
     case fd' of
       (fd1 : _) -> pure (TFunDef fd1)
-      _ -> throwError "Impossible! Empty binding group!"
+      _ -> tcmError "Impossible! Empty binding group!"
 tcTopDecl (TClassDef c) =
   TClassDef <$> tcClass c
 tcTopDecl (TInstDef is) =
@@ -306,7 +306,7 @@ tcDecl (CFunDecl d) =
     requireAnnotations d
     d' <- tcBindGroup [d]
     case d' of
-      [] -> throwError "Impossible! Empty function binding!"
+      [] -> tcmError "Impossible! Empty function binding!"
       (x : _) -> pure (CFunDecl x)
 tcDecl (CMutualDecl ds) =
   do
@@ -484,7 +484,7 @@ addClassMethod p@(InCls c _ _) sig@(Signature _ methodCtx f ps t) =
     extEnv qn sch
     pure ()
 addClassMethod p@(_ :~: _) (Signature _ _ n _ _) =
-  throwError $
+  tcmError $
     unlines
       [ "Invalid constraint:",
         pretty p,
@@ -497,7 +497,7 @@ addClassMethod p@(_ :~: _) (Signature _ _ n _ _) =
 signatureError :: Name -> Tyvar -> Signature Name -> Ty -> TcM ()
 signatureError n v (Signature _ methodCtx f _ _) t
   | null methodCtx =
-      throwError $
+      tcmError $
         unlines
           [ "Impossible! Class context is empty in function:",
             pretty f,
@@ -505,7 +505,7 @@ signatureError n v (Signature _ methodCtx f _ _) t
             pretty n
           ]
   | v `notElem` fv t =
-      throwError $
+      tcmError $
         unlines
           [ "Main class type variable",
             pretty v,
@@ -520,12 +520,12 @@ signatureError n v (Signature _ methodCtx f _ _) t
 
 duplicatedClassDecl :: Name -> TcM ()
 duplicatedClassDecl n =
-  throwError $ "Duplicated class definition:" ++ pretty n
+  tcmError $ "Duplicated class definition:" ++ pretty n
 
 duplicatedClassMethod :: Name -> TcM ()
 duplicatedClassMethod n =
-  throwError $ "Duplicated class method definition:" ++ pretty n
+  tcmError $ "Duplicated class method definition:" ++ pretty n
 
 invalidPragmaDecl :: [Pragma] -> TcM ()
 invalidPragmaDecl ps =
-  throwError $ unlines $ ["Invalid pragma definitions:"] ++ map pretty ps
+  tcmError $ unlines $ ["Invalid pragma definitions:"] ++ map pretty ps
diff --git a/src/Solcore/Frontend/TypeInference/TcModule.hs b/src/Solcore/Frontend/TypeInference/TcModule.hs
index 7e91ad838..59e3cf500 100644
--- a/src/Solcore/Frontend/TypeInference/TcModule.hs
+++ b/src/Solcore/Frontend/TypeInference/TcModule.hs
@@ -32,6 +32,7 @@ import Data.List (foldl')
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
+import Solcore.Diagnostics (CompilerError, compilerErrorFromString, legacyCompilerError)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Module.Loader
 import Solcore.Frontend.Syntax
@@ -91,17 +92,17 @@ data CheckedAssembly
 loadModuleLocalTypeCheckInput ::
   ModuleGraph ->
   Mod.ModuleId ->
-  IO (Either String ModuleResolvedTypeCheckInput)
+  IO (Either CompilerError ModuleResolvedTypeCheckInput)
 loadModuleLocalTypeCheckInput graph moduleId =
   loadResolvedModuleTypeCheckInput (moduleLocalTypeCheckSurface graph moduleId)
 
 loadResolvedModuleTypeCheckInput ::
   Either String ModuleTypeCheckSurface ->
-  IO (Either String ModuleResolvedTypeCheckInput)
+  IO (Either CompilerError ModuleResolvedTypeCheckInput)
 loadResolvedModuleTypeCheckInput input =
   case input of
     Left err ->
-      pure (Left err)
+      pure (Left (compilerErrorFromString err))
     Right surface -> do
       resolved <-
         nameResolutionTopDeclSegments
@@ -115,7 +116,7 @@ loadResolvedModuleTypeCheckInput input =
 mkModuleResolvedTypeCheckInput ::
   ModuleTypeCheckSurface ->
   (CompUnit Name, [[TopDecl Name]]) ->
-  Either String ModuleResolvedTypeCheckInput
+  Either CompilerError ModuleResolvedTypeCheckInput
 mkModuleResolvedTypeCheckInput surface (resolved, resolvedSegments) =
   case resolvedSegments of
     [resolvedQualifiedDecls, resolvedLocalDecls, resolvedImportedDecls] ->
@@ -133,13 +134,14 @@ mkModuleResolvedTypeCheckInput surface (resolved, resolvedSegments) =
           }
     _ ->
       Left $
-        "Internal error: expected 3 resolved module typecheck surface segments, got "
-          ++ show (length resolvedSegments)
+        legacyCompilerError $
+          "Internal error: expected 3 resolved module typecheck surface segments, got "
+            ++ show (length resolvedSegments)
 
 typeInferModuleLocals ::
   Option ->
   ModuleTypeCheckInput ->
-  IO (Either String (CompUnit Id, TcEnv))
+  IO (Either CompilerError (CompUnit Id, TcEnv))
 typeInferModuleLocals opts input =
   typeInferTopDeclChecks
     opts
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index 0506a8ce2..255ecf6f1 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -3,14 +3,14 @@ module Solcore.Frontend.TypeInference.TcMonad where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.State
-import Data.Generics (Data, everything, mkQ)
+import Data.Generics (Data, everything, extQ, mkQ)
 import Data.List
 import Data.List.NonEmpty qualified as N
 import Data.Map qualified as Map
 import Data.Maybe
 import Data.Monoid (First (..))
 import Data.Set qualified as Set
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, decodeDiagnostic, encodeDiagnostic)
+import Solcore.Diagnostics (CompilerError (..), Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, diagnosticCompilerError, legacyCompilerError)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -23,9 +23,9 @@ import Text.Printf
 
 -- definition of type inference monad infrastructure
 
-type TcM a = (StateT TcEnv (ExceptT String IO)) a
+type TcM a = (StateT TcEnv (ExceptT CompilerError IO)) a
 
-runTcM :: TcM a -> TcEnv -> IO (Either String (a, TcEnv))
+runTcM :: TcM a -> TcEnv -> IO (Either CompilerError (a, TcEnv))
 runTcM m env = runExceptT (runStateT m env)
 
 defaultM :: TcM a -> TcM (Maybe a)
@@ -166,7 +166,7 @@ matchTy t t' =
     extSubst s
 
 tcmMatch :: Ty -> Ty -> TcM Subst
-tcmMatch t u = catchError (match t u) throwError
+tcmMatch = match
 
 addFunctionName :: Name -> TcM ()
 addFunctionName n =
@@ -206,7 +206,7 @@ kindCheck t@(TyCon n ts) =
   do
     ti <- askTypeInfo n `wrapError` t
     unless (n == Name "pair" || arity ti == length ts) $
-      throwError $
+      tcmError $
         unlines
           [ "Invalid number of type arguments!",
             "Type "
@@ -356,7 +356,7 @@ askCurrentContract =
   do
     n <- gets contract
     maybe
-      (throwError "Impossible! Lacking current contract name!")
+      (tcmError "Impossible! Lacking current contract name!")
       pure
       n
 
@@ -502,7 +502,7 @@ checkSynonym (TySym n vs t) =
 
 duplicatedSynonymDecl :: Name -> TcM a
 duplicatedSynonymDecl n =
-  throwError $ unwords ["Duplicated type synonym definition:", pretty n]
+  tcmError $ unwords ["Duplicated type synonym definition:", pretty n]
 
 -- manipulating the instance environment
 
@@ -553,7 +553,7 @@ addDefaultInstance n inst =
       )
 
 maybeToTcM :: String -> Maybe a -> TcM a
-maybeToTcM s Nothing = throwError s
+maybeToTcM s Nothing = tcmError s
 maybeToTcM _ (Just x) = pure x
 
 -- checking coverage pragma
@@ -660,11 +660,13 @@ wrapError m e =
   catchError m handler
   where
     handler msg = throwError (decorate msg)
-    decorate msg =
-      case decodeDiagnostic msg of
-        Just diagnostic ->
-          encodeDiagnostic (addDiagnosticNote ("in: " ++ pretty e) (addContextLabel e diagnostic))
-        Nothing -> msg ++ "\n - in:" ++ pretty e
+    decorate (CompilerDiagnostics diagnostics) =
+      CompilerDiagnostics $
+        map
+          (addDiagnosticNote ("in: " ++ pretty e) . addContextLabel e)
+          diagnostics
+    decorate (CompilerLegacyError msg) =
+      CompilerLegacyError (msg ++ "\n - in:" ++ pretty e)
 
 addContextLabel :: (Data b) => b -> Diagnostic -> Diagnostic
 addContextLabel context diagnostic
@@ -699,13 +701,16 @@ contextLabelMessage diagnostic =
 
 contextSourceSpan :: (Data a) => a -> Maybe SourceSpan
 contextSourceSpan value =
-  getFirst $ everything (<>) (mkQ (First Nothing) nameSpan) value
+  getFirst $ everything (<>) (mkQ (First Nothing) locationSpan `extQ` nameSpan) value
   where
+    locationSpan :: NodeLocation -> First SourceSpan
+    locationSpan = First . nodeLocationSpan
+
     nameSpan :: Name -> First SourceSpan
     nameSpan = First . nameSourceSpan
 
 tcmMgu :: Ty -> Ty -> TcM Subst
-tcmMgu t u = catchError (mgu t u) tcmError
+tcmMgu = mgu
 
 -- error messages
 
@@ -713,7 +718,7 @@ tcmError :: String -> TcM a
 tcmError s = do
   verbose <- isVerbose
   when verbose dumpLogs
-  throwError s
+  throwError (legacyCompilerError s)
 
 undefinedName :: Name -> TcM a
 undefinedName n =
@@ -811,7 +816,7 @@ tcDiagnosticErrorAtName code message identName label notes help =
 tcDiagnosticErrorWithLabels :: String -> String -> [Label] -> [String] -> [String] -> TcM a
 tcDiagnosticErrorWithLabels code message labels notes help =
   throwError $
-    encodeDiagnostic
+    diagnosticCompilerError $
       Diagnostic
         { diagnosticSeverity = Error,
           diagnosticCode = Just (DiagnosticCode code),
@@ -838,7 +843,7 @@ typeAlreadyDefinedError d n =
     -- get type info
     di <- askTypeInfo n
     d' <- dataTyFromInfo n di `wrapError` d
-    throwError $
+    tcmError $
       unlines
         [ "Duplicated type definition for " ++ pretty n ++ ":",
           pretty d,
diff --git a/src/Solcore/Frontend/TypeInference/TcSat.hs b/src/Solcore/Frontend/TypeInference/TcSat.hs
index e303da807..214477958 100644
--- a/src/Solcore/Frontend/TypeInference/TcSat.hs
+++ b/src/Solcore/Frontend/TypeInference/TcSat.hs
@@ -1,7 +1,6 @@
 module Solcore.Frontend.TypeInference.TcSat where
 
 import Control.Monad
-import Control.Monad.Except
 import Data.Maybe
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax hiding (gen)
@@ -18,7 +17,7 @@ sat ps =
 
 satI :: Int -> [Pred] -> TcM [Subst]
 satI 0 p =
-  throwError $
+  tcmError $
     unwords
       [ "Could not deduce:",
         pretty p,
@@ -40,13 +39,13 @@ satOne n p = do
   -- rule Inst
   delta <- sats p
   when (null delta) $
-    throwError $
+    tcmError $
       unwords ["There is no instance to satisfy:", pretty p]
   foldM (step n p) [mempty] delta
 
 step :: Int -> Pred -> [Subst] -> (Subst, [Pred]) -> TcM [Subst]
 step 0 p _ _ =
-  throwError $
+  tcmError $
     unwords
       [ "Could not deduce:",
         pretty p,
diff --git a/src/Solcore/Frontend/TypeInference/TcStmt.hs b/src/Solcore/Frontend/TypeInference/TcStmt.hs
index 914e8f39a..56754fc29 100644
--- a/src/Solcore/Frontend/TypeInference/TcStmt.hs
+++ b/src/Solcore/Frontend/TypeInference/TcStmt.hs
@@ -206,7 +206,7 @@ ensureVisiblePatternCoverage scrutineeTys eqns =
         TyCon scrutineeTypeName _ -> do
           isPartial <- isPartialDataType scrutineeTypeName
           when (isPartial && not (hasCatchAllAt index eqns)) $
-            throwError $
+            tcmError $
               unlines
                 [ "Pattern match on type with hidden constructors requires a wildcard arm:",
                   pretty scrutineeTypeName
@@ -254,7 +254,7 @@ tcPat' t p@(PCon n ps) =
     (_ :=> tc) <- freshInst st
     let (argTys, resultTy) = splitTy tc
     when (length argTys /= length ps) $
-      throwError $
+      tcmError $
         unlines
           [ "Wrong number of pattern arguments for constructor:",
             pretty n',
@@ -363,7 +363,7 @@ tcExpWithExpected' mExpected e@(Con n es) =
     withCurrentSubst (e1, ps', t')
 tcExpWithExpected' _ e@(FieldAccess Nothing _) =
   -- = notImplementedS "tcExp" e
-  throwError ("tcExp not implemented for: " ++ pretty e ++ "\n" ++ show e)
+  tcmError ("tcExp not implemented for: " ++ pretty e ++ "\n" ++ show e)
 tcExpWithExpected' _ (FieldAccess (Just e) n) =
   do
     -- inferring expression type
@@ -809,7 +809,7 @@ checkPhantomMetaVars checkReturn n body rs ty = do
   let allPhantomMVs = nub (phantomMVs ++ escapedReturnMVs)
   unless (null allPhantomMVs) $ do
     let mvNames = intercalate ", " $ map (pretty . metaName) allPhantomMVs
-    throwError $
+    tcmError $
       unlines
         [ "Ambiguous type variable(s) " ++ mvNames ++ " in definition of " ++ pretty n ++ ".",
           "This typically occurs when a constructor has phantom type parameters.",
@@ -1020,7 +1020,7 @@ hasClosureType = any isClosureName . tyconNames
 
 invalidMemberType :: Name -> Ty -> Ty -> TcM a
 invalidMemberType n cls ins =
-  throwError $
+  tcmError $
     unlines
       [ "The instance method:",
         pretty n,
@@ -1034,7 +1034,7 @@ schemeFromSignature :: Signature Id -> TcM Scheme
 schemeFromSignature sig@(Signature vs ps _ args (Just rt)) =
   do
     unless (all isTyped args) $
-      throwError $
+      tcmError $
         unwords ["Invalid instance member signature:", pretty sig]
     pure $ Forall vs (ps :=> (funtype ts rt))
   where
@@ -1047,7 +1047,7 @@ schemeFromSignature sig@(Signature vs ps _ args (Just rt)) =
 
     ts = map extractType args
 schemeFromSignature sig =
-  throwError $
+  tcmError $
     unwords ["Invalid instance member signature (missing return type):", pretty sig]
 
 updateSignature :: [Tyvar] -> Name -> FunDef Id -> FunDef Id
@@ -1081,7 +1081,7 @@ checkCompleteInstDef n ns =
         mths' = map unqual mths
         remaining = mths' \\ ns
     when (not $ null remaining) do
-      throwError $
+      tcmError $
         unlines $
           [ "Incomplete definition for class:",
             pretty n,
@@ -1151,7 +1151,7 @@ maybeExpandSynonym (TyCon n ts) = do
       | ar == length ts' ->
           maybeExpandSynonym (insts (zip params ts') body)
       | otherwise ->
-          throwError $
+          tcmError $
             unlines
               [ "Type synonym arity mismatch for '" ++ pretty n ++ "':",
                 "  expected " ++ show ar ++ " argument(s)",
@@ -1185,7 +1185,7 @@ isTyVar _ = False
 checkBoundVariable :: [Pred] -> [Tyvar] -> TcM ()
 checkBoundVariable ps vs =
   unless (all (`elem` vs) (bv ps)) $ do
-    throwError "Bounded variable condition fails!"
+    tcmError "Bounded variable condition fails!"
 
 checkOverlap :: Pred -> [Inst] -> TcM ()
 checkOverlap _ [] = pure ()
@@ -1196,7 +1196,7 @@ checkOverlap p@(InCls _ t _) (i : is) =
       (_ :=> (InCls _ t' _)) ->
         case mgu t t' of
           Right _ ->
-            throwError
+            tcmError
               ( unlines
                   [ "Overlapping instances are not supported",
                     "instance:",
@@ -1219,7 +1219,7 @@ checkCoverage cn ts t =
         weakTvs = bv ts
         undetermined = weakTvs \\ strongTvs
     unless (null undetermined) $
-      throwError
+      tcmError
         ( unlines
             [ "Coverage condition fails for class:",
               pretty cn,
@@ -1258,7 +1258,7 @@ fullSignature :: Signature Name -> TcM ()
 fullSignature sig =
   unless
     (isFullyAnnotated sig)
-    (throwError $ unlines ["Class and instance methods must have complete type signatures:", pretty sig])
+    (tcmError $ unlines ["Class and instance methods must have complete type signatures:", pretty sig])
 
 requireAnnotations :: FunDef Name -> TcM ()
 requireAnnotations (FunDef sig _) =
@@ -1291,7 +1291,7 @@ checkMeasure ps c =
   if all smaller ps
     then return ()
     else
-      throwError $
+      tcmError $
         unlines
           [ "Instance ",
             pretty c,
@@ -1360,7 +1360,7 @@ tcBodyWithExpectedReturn mExpectedReturn [s] =
     (s', ps', t') <- tcStmtWithExpectedReturn mExpectedReturn s
     pure ([s'], ps', t')
 tcBodyWithExpectedReturn _ (Return _ : _) =
-  throwError "Illegal return statement"
+  tcmError "Illegal return statement"
 tcBodyWithExpectedReturn mExpectedReturn (s : ss) =
   do
     (s', ps', _) <- tcStmtWithExpectedReturn mExpectedReturn s
@@ -1436,7 +1436,7 @@ resolveDotExpressionConstructor dotName argTys mExpected = do
   candidates <- case mcandidates of
     Just xs -> pure xs
     Nothing ->
-      throwError $
+      tcmError $
         unlines
           [ "Cannot resolve shorthand constructor expression without expected constructor type:",
             pretty dotName
@@ -1444,14 +1444,14 @@ resolveDotExpressionConstructor dotName argTys mExpected = do
   valid <- filterM (\n -> constructorAcceptsArguments n argTys mExpected) (nub candidates)
   case valid of
     [] ->
-      throwError $
+      tcmError $
         unlines
           [ "No matching constructor for shorthand expression:",
             pretty dotName
           ]
     [n] -> pure n
     xs ->
-      throwError $
+      tcmError $
         unlines
           [ "Ambiguous shorthand constructor expression:",
             pretty dotName,
@@ -1498,21 +1498,21 @@ resolveDotPatternConstructor dotName expectedTy = do
   candidates <- case mcandidates of
     Just xs -> pure xs
     Nothing ->
-      throwError $
+      tcmError $
         unlines
           [ "Cannot resolve shorthand constructor pattern without expected constructor type:",
             pretty dotName
           ]
   case nub candidates of
     [] ->
-      throwError $
+      tcmError $
         unlines
           [ "No matching constructor for shorthand pattern:",
             pretty dotName
           ]
     [n] -> pure n
     xs ->
-      throwError $
+      tcmError $
         unlines
           [ "Ambiguous shorthand constructor pattern:",
             pretty dotName,
@@ -1560,7 +1560,7 @@ constructorLeafName n = n
 typeName :: Ty -> TcM Name
 typeName (TyCon n _) = pure n
 typeName t =
-  throwError $
+  tcmError $
     unlines
       [ "Expected type, but found:",
         pretty t
@@ -1749,7 +1749,7 @@ rename t =
 
 classArityError :: (Pretty a) => Name -> ClassInfo -> a -> TcM ()
 classArityError n cinfo v =
-  throwError $
+  tcmError $
     unlines
       [ "Type class " ++ pretty n,
         "requires " ++ show (classArity cinfo) ++ " weak parameter(s)",
@@ -1759,14 +1759,14 @@ classArityError n cinfo v =
 
 unboundTypeVars :: (Pretty a) => a -> [Tyvar] -> TcM b
 unboundTypeVars sig vs =
-  throwError $ unlines ["Type variables:", vs', "are unbound in:", pretty sig]
+  tcmError $ unlines ["Type variables:", vs', "are unbound in:", pretty sig]
   where
     vs' = unwords $ map pretty vs
 
 typeMatch :: Scheme -> Scheme -> TcM ()
 typeMatch t1 t2 =
   unless (t1 == t2) $
-    throwError $
+    tcmError $
       unwords
         [ "Types",
           pretty t1,
@@ -1777,13 +1777,13 @@ typeMatch t1 t2 =
 
 invalidYulType :: Name -> Ty -> TcM a
 invalidYulType (Name n) ty =
-  throwError $ unlines ["Yul values can only be of word type:", unwords [n, ":", pretty ty]]
+  tcmError $ unlines ["Yul values can only be of word type:", unwords [n, ":", pretty ty]]
 invalidYulType qn ty =
-  throwError $ unlines ["Yul values can only be of word type:", unwords [pretty qn, ":", pretty ty]]
+  tcmError $ unlines ["Yul values can only be of word type:", unwords [pretty qn, ":", pretty ty]]
 
 invalidMethodPred :: Pred -> FunDef Name -> TcM a
 invalidMethodPred p d =
-  throwError $
+  tcmError $
     unlines
       [ "Expected class predicate in instance head for method check:",
         pretty p,
@@ -1793,7 +1793,7 @@ invalidMethodPred p d =
 
 expectedFunction :: Ty -> TcM a
 expectedFunction t =
-  throwError $
+  tcmError $
     unlines
       [ "Expected function type. Found:",
         pretty t
@@ -1801,7 +1801,7 @@ expectedFunction t =
 
 wrongPatternNumber :: [Ty] -> [Pat Name] -> TcM a
 wrongPatternNumber qts ps =
-  throwError $
+  tcmError $
     unlines
       [ "Wrong number of patterns in:",
         unwords (map pretty ps),
@@ -1812,7 +1812,7 @@ wrongPatternNumber qts ps =
 
 duplicatedFunDef :: Name -> TcM ()
 duplicatedFunDef n =
-  throwError $ "Duplicated function definition:" ++ pretty n
+  tcmError $ "Duplicated function definition:" ++ pretty n
 
 entailmentError :: [Pred] -> [Pred] -> TcM ()
 entailmentError base nonentail =
diff --git a/src/Solcore/Frontend/TypeInference/TcUnify.hs b/src/Solcore/Frontend/TypeInference/TcUnify.hs
index a4c4b79a0..9fb2a8991 100644
--- a/src/Solcore/Frontend/TypeInference/TcUnify.hs
+++ b/src/Solcore/Frontend/TypeInference/TcUnify.hs
@@ -11,7 +11,7 @@ import Solcore.Frontend.TypeInference.TcSubst
 
 -- standard unification machinery
 
-varBind :: (MonadError String m) => MetaTv -> Ty -> m Subst
+varBind :: (MonadError CompilerError m) => MetaTv -> Ty -> m Subst
 varBind v t
   | t == Meta v = return mempty
   | v `elem` mv t = infiniteTyErr v t
@@ -25,7 +25,7 @@ isTyCon _ = False
 -- type matching
 
 class Match a where
-  match :: (MonadError String m) => a -> a -> m Subst
+  match :: (MonadError CompilerError m) => a -> a -> m Subst
 
 instance Match Ty where
   match (TyCon n ts) (TyCon n' ts')
@@ -52,9 +52,10 @@ instance (Pretty a, Match a) => Match [a] where
 instance Match Pred where
   match (InCls n t ts) (InCls n' t' ts')
     | n == n' = match (t : ts) (t' : ts')
-    | otherwise = throwError "Classes differ!"
+    | otherwise = throwError (legacyCompilerError "Classes differ!")
   match p1 p2 =
     throwError $
+      legacyCompilerError $
       unlines
         [ "Cannot match predicates:",
           pretty p1,
@@ -72,7 +73,7 @@ instance (HasType a, Match a) => Match (Qual a) where
 -- most general unifier
 
 class MGU a where
-  mgu :: (MonadError String m) => a -> a -> m Subst
+  mgu :: (MonadError CompilerError m) => a -> a -> m Subst
 
 instance (HasType a, MGU a, Pretty a) => MGU [a] where
   mgu ts1 ts2
@@ -99,8 +100,9 @@ instance MGU Pred where
   mgu p1@(InCls n t ts) p2@(InCls n' t' ts')
     | n == n' = mgu (t : ts) (t' : ts')
     | otherwise =
-        throwError $
-          unlines
+      throwError $
+        legacyCompilerError $
+        unlines
             [ "Cannot unify predicates:",
               pretty p1,
               "with",
@@ -110,6 +112,7 @@ instance MGU Pred where
     mgu [t1, t2] [t1', t2']
   mgu p1 p2 =
     throwError $
+      legacyCompilerError $
       unlines
         [ "Cannot unify predicates:",
           pretty p1,
@@ -123,7 +126,7 @@ instance (HasType a, MGU a) => MGU (Qual a) where
       s <- mgu (sort ps) (sort ps')
       mgu (apply s t) (apply s t')
 
-solve :: (MonadError String m, MGU a, HasType a) => [(a, a)] -> Subst -> m Subst
+solve :: (MonadError CompilerError m, MGU a, HasType a) => [(a, a)] -> Subst -> m Subst
 solve [] s = pure s
 solve ((t1, t2) : ts) s =
   do
@@ -131,10 +134,10 @@ solve ((t1, t2) : ts) s =
     s2 <- solve ts s1
     pure (s2 <> s1)
 
-unifyTypes :: (MonadError String m) => [Ty] -> [Ty] -> m Subst
+unifyTypes :: (MonadError CompilerError m) => [Ty] -> [Ty] -> m Subst
 unifyTypes ts ts' = solve (zip ts ts') mempty
 
-unifyAllTypes :: (MonadError String m) => [Ty] -> m Subst
+unifyAllTypes :: (MonadError CompilerError m) => [Ty] -> m Subst
 unifyAllTypes [] = pure mempty
 unifyAllTypes (t : ts) =
   do
@@ -144,7 +147,7 @@ unifyAllTypes (t : ts) =
 
 -- composition operator for matching
 
-merge :: (MonadError String m) => Subst -> Subst -> m Subst
+merge :: (MonadError CompilerError m) => Subst -> Subst -> m Subst
 merge s1@(Subst p1) s2@(Subst p2) =
   if agree
     then pure (Subst $ nub (p1 ++ p2))
@@ -160,17 +163,18 @@ merge s1@(Subst p1) s2@(Subst p2) =
         (dom p1 `intersect` dom p2)
     dom s = map fst s
 
-mergeError :: (MonadError String m) => [(Ty, Ty)] -> m a
-mergeError ts = throwError $ unlines $ "Cannot match types:" : ss
+mergeError :: (MonadError CompilerError m) => [(Ty, Ty)] -> m a
+mergeError ts = throwError $ legacyCompilerError $ unlines $ "Cannot match types:" : ss
   where
     ss = map go ts
     go (x, y) = pretty x ++ " with " ++ pretty y
 
 -- basic error messages
 
-infiniteTyErr :: (MonadError String m) => MetaTv -> Ty -> m a
+infiniteTyErr :: (MonadError CompilerError m) => MetaTv -> Ty -> m a
 infiniteTyErr v t =
   throwError $
+    legacyCompilerError $
     unwords
       [ "Cannot construct the infinite type:",
         pretty (metaName v),
@@ -178,13 +182,13 @@ infiniteTyErr v t =
         pretty t
       ]
 
-typesNotMatch :: (MonadError String m) => Ty -> Ty -> m a
+typesNotMatch :: (MonadError CompilerError m) => Ty -> Ty -> m a
 typesNotMatch t1 t2 =
   typeMismatchDiagnostic "types do not match" t1 t2
 
-typesMatchListErr :: (MonadError String m) => [String] -> [String] -> m a
+typesMatchListErr :: (MonadError CompilerError m) => [String] -> [String] -> m a
 typesMatchListErr ts ts' =
-  throwError (errMsg ts ts')
+  throwError (legacyCompilerError (errMsg ts ts'))
   where
     errMsg lhs rhs =
       unwords
@@ -194,9 +198,9 @@ typesMatchListErr ts ts' =
           prettys rhs
         ]
 
-typesMguListErr :: (MonadError String m, Pretty t) => [t] -> [t] -> m a
+typesMguListErr :: (MonadError CompilerError m, Pretty t) => [t] -> [t] -> m a
 typesMguListErr ts ts' =
-  throwError (errMsg ts ts')
+  throwError (legacyCompilerError (errMsg ts ts'))
   where
     errMsg lhs rhs =
       unwords
@@ -206,14 +210,14 @@ typesMguListErr ts ts' =
           prettys rhs
         ]
 
-typesDoNotUnify :: (MonadError String m) => Ty -> Ty -> m a
+typesDoNotUnify :: (MonadError CompilerError m) => Ty -> Ty -> m a
 typesDoNotUnify t1 t2 =
   typeMismatchDiagnostic "types do not unify" t1 t2
 
-typeMismatchDiagnostic :: (MonadError String m) => String -> Ty -> Ty -> m a
+typeMismatchDiagnostic :: (MonadError CompilerError m) => String -> Ty -> Ty -> m a
 typeMismatchDiagnostic message t1 t2 =
   throwError $
-    encodeDiagnostic
+    diagnosticCompilerError $
       Diagnostic
         { diagnosticSeverity = Error,
           diagnosticCode = Just (DiagnosticCode "SC0201"),
@@ -226,9 +230,10 @@ typeMismatchDiagnostic message t1 t2 =
           diagnosticHelp = []
         }
 
-boundVariablesErr :: (MonadError String m) => [Tyvar] -> m a
+boundVariablesErr :: (MonadError CompilerError m) => [Tyvar] -> m a
 boundVariablesErr ts =
   throwError $
+    legacyCompilerError $
     unwords $
       [ "Panic!",
         "The following bound variables where",
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 0f0be3e6c..b2545f52e 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -28,6 +28,7 @@ import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
 import Solcore.Diagnostics
   ( Diagnostic (..),
     DiagnosticCode (..),
+    CompilerError (..),
     Label (..),
     LabelStyle (..),
     Severity (..),
@@ -36,16 +37,16 @@ import Solcore.Diagnostics
     SourceSpan (..),
     addDiagnosticHelp,
     addDiagnosticNote,
-    decodeDiagnostic,
     diagnosticMessage,
     diagnosticPrimarySpan,
     defaultDiagnosticRenderOptions,
     emptySourceMap,
-    encodeDiagnostic,
+    compilerErrorDiagnostics,
+    compilerErrorFromString,
+    compilerErrorText,
     findTextSpansInSource,
     findTokenSpansInSource,
     insertSourceFile,
-    legacyDiagnostic,
     lookupSourceFile,
     makeSourceFile,
     renderDiagnostics,
@@ -118,21 +119,21 @@ compileWithDiagnostics opts = runExceptT $ do
     (validationImports, validationSegments) <-
       liftEitherDiagnostic sources (moduleValidationTopDeclSegments graph moduleId)
     _ <-
-      liftEitherDiagnostic
+      liftCompilerDiagnostic
         sources
-        ( first (decorateDiagnosticContext ("module validation failed for " ++ sourcePath)) $
+        ( first (decorateCompilerDiagnosticContext ("module validation failed for " ++ sourcePath)) $
             validateDuplicateNamespacesInTopDeclSegments validationSegments
         )
     _ <-
-      liftEitherDiagnosticIO
+      liftCompilerDiagnosticIO
         sources
-        ( first (decorateDiagnosticContext ("module validation failed for " ++ sourcePath))
+        ( first (decorateCompilerDiagnosticContext ("module validation failed for " ++ sourcePath))
             <$> nameResolutionTopDeclSegments validationImports validationSegments
         )
     pure ()
 
   checkedModules <-
-    liftEitherDiagnosticIO
+    liftCompilerDiagnosticIO
       sources
       ( timeItNamed "Typecheck modules" $
           runExceptT (typeCheckLoadedModules opts graph)
@@ -272,17 +273,37 @@ liftEitherDiagnosticIO sources action =
       Left err -> Left <$> compileDiagnosticErrorIO sources err
       Right value -> pure (Right value)
 
+liftCompilerDiagnostic :: SourceMap -> Either CompilerError a -> ExceptT CompileDiagnostics IO a
+liftCompilerDiagnostic sources =
+  ExceptT . pure . first (compileCompilerError sources)
+
+liftCompilerDiagnosticIO :: SourceMap -> IO (Either CompilerError a) -> ExceptT CompileDiagnostics IO a
+liftCompilerDiagnosticIO sources action =
+  ExceptT $ do
+    result <- action
+    case result of
+      Left err -> Left <$> compileCompilerErrorIO sources err
+      Right value -> pure (Right value)
+
 compileDiagnosticError :: SourceMap -> String -> CompileDiagnostics
 compileDiagnosticError sources err =
-  let diagnostics = diagnosticsFromError err
+  compileCompilerError sources (compilerErrorFromString err)
+
+compileDiagnosticErrorIO :: SourceMap -> String -> IO CompileDiagnostics
+compileDiagnosticErrorIO sources err =
+  compileCompilerErrorIO sources (compilerErrorFromString err)
+
+compileCompilerError :: SourceMap -> CompilerError -> CompileDiagnostics
+compileCompilerError sources err =
+  let diagnostics = compilerErrorDiagnostics err
    in CompileDiagnostics
         { compileDiagnosticSources = sources,
           compileDiagnosticMessages = map (enrichDiagnostic sources) diagnostics
         }
 
-compileDiagnosticErrorIO :: SourceMap -> String -> IO CompileDiagnostics
-compileDiagnosticErrorIO sources err = do
-  let diagnostics = diagnosticsFromError err
+compileCompilerErrorIO :: SourceMap -> CompilerError -> IO CompileDiagnostics
+compileCompilerErrorIO sources err = do
+  let diagnostics = compilerErrorDiagnostics err
   sources' <- ensureDiagnosticSources sources diagnostics
   pure
     CompileDiagnostics
@@ -291,14 +312,8 @@ compileDiagnosticErrorIO sources err = do
       }
 
 diagnosticsFromError :: String -> [Diagnostic]
-diagnosticsFromError err =
-  case mapM decodeDiagnostic (filter (not . null) (lines err)) of
-    Just diagnostics
-      | not (null diagnostics) -> diagnostics
-    _ ->
-      case decodeDiagnostic err of
-        Just diagnostic -> [diagnostic]
-        Nothing -> [legacyDiagnostic err]
+diagnosticsFromError =
+  compilerErrorDiagnostics . compilerErrorFromString
 
 enrichDiagnostic :: SourceMap -> Diagnostic -> Diagnostic
 enrichDiagnostic sources diagnostic
@@ -715,7 +730,7 @@ ensureSourcePath sources path
           pure (insertSourceFile (makeSourceFile path content) sources)
         else pure sources
 
-typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT String IO (Map Mod.ModuleId CheckedModule)
+typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT CompilerError IO (Map Mod.ModuleId CheckedModule)
 typeCheckLoadedModules opts graph =
   Map.fromList <$> mapM (typeCheckModuleFromGraph opts graph) (moduleOrder graph)
 
@@ -723,9 +738,9 @@ typeCheckModuleFromGraph ::
   Option ->
   ModuleGraph ->
   Mod.ModuleId ->
-  ExceptT String IO (Mod.ModuleId, CheckedModule)
+  ExceptT CompilerError IO (Mod.ModuleId, CheckedModule)
 typeCheckModuleFromGraph opts graph moduleId = do
-  sourcePath <- ExceptT $ pure (moduleSourcePath graph moduleId)
+  sourcePath <- ExceptT $ pure (first compilerErrorFromString (moduleSourcePath graph moduleId))
   resolvedInput <-
     ExceptT $
       first (moduleTypeCheckError sourcePath "input") <$> loadModuleLocalTypeCheckInput graph moduleId
@@ -755,7 +770,7 @@ typeCheckModuleFromGraph opts graph moduleId = do
 prepareModuleTypeCheckInput ::
   Option ->
   ModuleResolvedTypeCheckInput ->
-  ExceptT String IO ModuleTypeCheckInput
+  ExceptT CompilerError IO ModuleTypeCheckInput
 prepareModuleTypeCheckInput opts resolvedInput = do
   inferenceDecls <- prepareModuleInferenceDeclsForTypeInference opts resolvedInput
   pure (withPreparedModuleInferenceDecls resolvedInput inferenceDecls)
@@ -763,7 +778,7 @@ prepareModuleTypeCheckInput opts resolvedInput = do
 prepareModuleInferenceDeclsForTypeInference ::
   Option ->
   ModuleResolvedTypeCheckInput ->
-  ExceptT String IO [ModuleInferenceDecl]
+  ExceptT CompilerError IO [ModuleInferenceDecl]
 prepareModuleInferenceDeclsForTypeInference opts input =
   prepareInferenceDeclsForTypeInference
     opts
@@ -801,25 +816,28 @@ dumpModuleTypeInference opts sourcePath typed tcEnv =
     putStrLn ("> Elaborated tree for " ++ sourcePath ++ ":")
     putStrLn $ pretty typed
 
-moduleTypeCheckError :: FilePath -> String -> String -> String
+moduleTypeCheckError :: FilePath -> String -> CompilerError -> CompilerError
 moduleTypeCheckError sourcePath phase err =
-  decorateDiagnosticContext
+  decorateCompilerDiagnosticContext
     ("module typecheck failed for " ++ sourcePath ++ " (" ++ phase ++ ")")
     err
 
 decorateDiagnosticContext :: String -> String -> String
 decorateDiagnosticContext context err =
-  case decodeDiagnostic err of
-    Just diagnostic ->
-      encodeDiagnostic (addDiagnosticNote context diagnostic)
-    Nothing -> context ++ ":\n" ++ err
+  compilerErrorText (decorateCompilerDiagnosticContext context (compilerErrorFromString err))
+
+decorateCompilerDiagnosticContext :: String -> CompilerError -> CompilerError
+decorateCompilerDiagnosticContext context (CompilerDiagnostics diagnostics) =
+  CompilerDiagnostics (map (addDiagnosticNote context) diagnostics)
+decorateCompilerDiagnosticContext context (CompilerLegacyError err) =
+  CompilerLegacyError (context ++ ":\n" ++ err)
 
 prepareInferenceDeclsForTypeInference ::
   Option ->
   Bool ->
   [Import] ->
   [ModuleInferenceDecl] ->
-  ExceptT String IO [ModuleInferenceDecl]
+  ExceptT CompilerError IO [ModuleInferenceDecl]
 prepareInferenceDeclsForTypeInference opts emitOutput imps inferenceDecls = do
   let verbose = emitOutput && optVerbose opts
       noDesugarCalls = optNoDesugarCalls opts
@@ -851,9 +869,10 @@ prepareInferenceDeclsForTypeInference opts emitOutput imps inferenceDecls = do
   -- SCC analysis
   connected <-
     ExceptT $
-      timeItNamed "SCC           " $
-        runExceptT $
-          traverseModuleInferenceTopDecls (ExceptT . sccAnalysisTopDecls) dispatched
+      fmap (first compilerErrorFromString) $
+        timeItNamed "SCC           " $
+          runExceptT $
+            traverseModuleInferenceTopDecls (ExceptT . sccAnalysisTopDecls) dispatched
 
   liftIO $ when verbose $ do
     putStrLn "> SCC Analysis:"
diff --git a/test/ModuleTypeCheckTests.hs b/test/ModuleTypeCheckTests.hs
index 5b20d45f3..3ff98101b 100644
--- a/test/ModuleTypeCheckTests.hs
+++ b/test/ModuleTypeCheckTests.hs
@@ -5,6 +5,7 @@ where
 
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.TcModule
+import Solcore.Diagnostics (CompilerError, compilerErrorText)
 import Solcore.Pipeline.Options (noDesugarOpt)
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -57,12 +58,12 @@ moduleTypeCheckTests =
         assertLeft "local body should be checked" result
     ]
 
-assertRight :: String -> Either String a -> Assertion
+assertRight :: String -> Either CompilerError a -> Assertion
 assertRight _ (Right _) = pure ()
 assertRight label (Left err) =
-  assertFailure (label ++ ": unexpected failure:\n" ++ err)
+  assertFailure (label ++ ": unexpected failure:\n" ++ compilerErrorText err)
 
-assertLeft :: String -> Either String a -> Assertion
+assertLeft :: String -> Either CompilerError a -> Assertion
 assertLeft _ (Left _) = pure ()
 assertLeft label (Right _) =
   assertFailure (label ++ ": expected failure")

From 3a3002ec3906e88927d70c4e3b7032d87d929ba4 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Wed, 27 May 2026 12:56:28 +0200
Subject: [PATCH 29/35] Structure loader and import diagnostics

---
 src/Solcore/Frontend/Module/Loader.hs | 113 ++++++++++++++++++++------
 1 file changed, 86 insertions(+), 27 deletions(-)

diff --git a/src/Solcore/Frontend/Module/Loader.hs b/src/Solcore/Frontend/Module/Loader.hs
index 9a21e9b0f..f9e8f7df0 100644
--- a/src/Solcore/Frontend/Module/Loader.hs
+++ b/src/Solcore/Frontend/Module/Loader.hs
@@ -20,7 +20,7 @@ import Data.Map qualified as Map
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Severity (..), SourceFile, SourceMap, encodeDiagnostic, makeSourceFile, sourceMapFromFiles)
+import Solcore.Diagnostics (Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceFile, SourceMap, SourceSpan, combineSourceSpans, encodeDiagnostic, makeSourceFile, sourceMapFromFiles)
 import Solcore.Frontend.Module.Identity qualified as Mod
 import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
 import Solcore.Frontend.Syntax.Name
@@ -195,12 +195,18 @@ resolveModuleReference cfg currentModule currentSourcePath refKind modulePath =
 
 moduleReferenceDiagnostic :: String -> FilePath -> String -> ModulePath -> String -> String
 moduleReferenceDiagnostic code sourcePath refKind modulePath message =
-  loaderDiagnostic
+  loaderDiagnosticWithLabels
     code
     message
+    (maybe [] pure (primaryModulePathLabel (moduleReferenceLabelMessage code refKind) modulePath))
     [sourcePath, refKind ++ " " ++ Mod.modulePathDisplay modulePath]
     (moduleReferenceHelp code)
 
+moduleReferenceLabelMessage :: String -> String -> String
+moduleReferenceLabelMessage "SC0118" _ = "external library import"
+moduleReferenceLabelMessage "SC0109" _ = "module reference"
+moduleReferenceLabelMessage _ refKind = refKind ++ " path"
+
 moduleReferenceHelp :: String -> [String]
 moduleReferenceHelp "SC0118" = ["pass --external-lib NAME=PATH for external imports"]
 moduleReferenceHelp "SC0109" = ["check the module path or add the missing source file"]
@@ -546,11 +552,14 @@ ensureImportItemsExist graph importPairs = do
     ([], []) -> Right ()
     (selectedXs, hiddenXs) ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0110"
           "unknown import item"
-          ( (if null selectedXs then [] else "unknown selected imports:" : selectedXs)
-              ++ (if null hiddenXs then [] else "unknown hidden imports:" : hiddenXs)
+          ( primaryNameLabels "unknown import item" (map snd selectedXs)
+              ++ primaryNameLabels "unknown import item" (map snd hiddenXs)
+          )
+          ( (if null selectedXs then [] else "unknown selected imports:" : map (uncurry formatMissing) selectedXs)
+              ++ (if null hiddenXs then [] else "unknown hidden imports:" : map (uncurry formatMissing) hiddenXs)
           )
           ["check the imported module's exported names"]
   where
@@ -559,8 +568,8 @@ ensureImportItemsExist graph importPairs = do
       let missingSelected = filter (`notElem` available) (explicitSelectorNames items)
           missingHidden = filter (`notElem` available) (explicitHiddenNames items)
       pure
-        ( [formatMissing importPath n | n <- missingSelected],
-          [formatMissing importPath n | n <- missingHidden]
+        ( [(importPath, n) | n <- missingSelected],
+          [(importPath, n) | n <- missingHidden]
         )
     unknowns _ = pure ([], [])
 
@@ -865,9 +874,10 @@ selectRemoteExportRefs sourcePath exportPath (SelectExportItems items) available
         Nothing
           | shouldValidate ->
               Left $
-                loaderDiagnostic
+                loaderDiagnosticWithLabels
                   "SC0115"
                   "unknown re-exported constructor"
+                  (maybe [] pure (primaryNameLabel "unknown re-exported constructor" typeName))
                   [sourcePath, "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName]
                   ["re-export constructors provided by the target module"]
           | otherwise ->
@@ -876,9 +886,10 @@ selectRemoteExportRefs sourcePath exportPath (SelectExportItems items) available
           | shouldValidate,
             missingVisibleConstructors constructorSelector ref /= [] ->
               Left $
-                loaderDiagnostic
+                loaderDiagnosticWithLabels
                   "SC0115"
                   "unknown re-exported constructor"
+                  (primaryNameLabels "unknown re-exported constructor" (missingVisibleConstructors constructorSelector ref))
                   ( sourcePath
                       : [ "  " ++ Mod.modulePathDisplay exportPath ++ "." ++ show typeName ++ "." ++ show constructorName
                           | constructorName <- missingVisibleConstructors constructorSelector ref
@@ -1006,9 +1017,10 @@ ensureLocalExportExists sourcePath ds itemName
   | itemName `elem` availableExportNames ds = Right ()
   | otherwise =
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0113"
           "unknown export"
+          (maybe [] pure (primaryNameLabel "unknown export" itemName))
           [sourcePath, show itemName]
           ["export a name defined in this module or re-export it from another module"]
 
@@ -1017,9 +1029,10 @@ ensureLocalConstructorExportExists sourcePath topLevelDecls typeName constructor
   case findLocalDataType typeName topLevelDecls of
     Nothing ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0113"
           "unknown export"
+          (maybe [] pure (primaryNameLabel "unknown export" typeName))
           [sourcePath, show typeName]
           ["export a type defined in this module or re-export it from another module"]
     Just (DataTy _ _ constrs) ->
@@ -1043,9 +1056,10 @@ ensureConstructorSelectorExists sourcePath typeName (SelectConstructors construc
     [] -> Right ()
     xs ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0114"
           "unknown exported constructor"
+          (primaryNameLabels "unknown exported constructor" xs)
           (sourcePath : ["  " ++ show typeName ++ "." ++ show constructorName | constructorName <- xs])
           ["select constructors defined by the exported type"]
   where
@@ -1070,9 +1084,10 @@ ensureRemoteExportsExist sourcePath exportPath names availableNames =
     [] -> Right ()
     xs ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0115"
           "unknown re-exported name"
+          (primaryNameLabels "unknown re-exported name" xs)
           (sourcePath : [formatMissing exportPath missingName | missingName <- xs])
           ["re-export a name provided by the target module"]
   where
@@ -1888,10 +1903,12 @@ ensureNoAmbiguousSelectedImports graph importPairs = do
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Ambiguous selected imports:",
-            unlines (map formatAmbiguous xs)
-          ]
+        loaderDiagnosticWithLabels
+          "SC0120"
+          "ambiguous selected imports"
+          (primaryNameLabels "ambiguous selected import" (map fst xs))
+          (map formatAmbiguous xs)
+          ["use an explicit module qualifier or narrow the selected imports"]
   where
     selectedFromImport (ImportOnly modName selector, modulePath) = do
       names <- resolveSelectedImportItems graph modName modulePath selector
@@ -1920,10 +1937,12 @@ ensureNoModuleLookupConflicts graph unit importPairs =
     [] -> Right ()
     xs ->
       Left $
-        unlines
-          [ "Conflicting unqualified names:",
-            unlines (map (\n -> "  " ++ show n) xs)
-          ]
+        loaderDiagnosticWithLabels
+          "SC0121"
+          "conflicting unqualified names"
+          (primaryNameLabels "conflicting unqualified name" xs)
+          (map (\n -> "  " ++ show n) xs)
+          ["rename the local binding or use an import alias"]
   where
     localTermNames =
       uniqueNames (concatMap topDeclTermNames (topDeclsFrom unit))
@@ -1992,9 +2011,10 @@ ensureNoDuplicateModuleQualifiers (CompUnit imps _) =
     [] -> Right ()
     qs ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0116"
           "duplicate import qualifier"
+          (primaryNameLabels "duplicate import qualifier" qs)
           (map (\q -> "  " ++ show q) qs)
           ["use an explicit alias to disambiguate one of the imports"]
   where
@@ -2027,33 +2047,72 @@ ensureNoDuplicateSelectedItems (CompUnit imps _) =
     [] -> Right ()
     xs ->
       Left $
-        loaderDiagnostic
+        loaderDiagnosticWithLabels
           "SC0117"
           "duplicate name in selective import"
-          xs
+          (primaryNameLabels "duplicate selected import" (map snd xs))
+          (map (("  " ++) . fst) xs)
           ["list each selected or hidden name only once"]
   where
     duplicateItems (ImportOnly moduleName selector) =
-      [ "  " ++ Mod.modulePathDisplay moduleName ++ "." ++ show item
+      [ (Mod.modulePathDisplay moduleName ++ "." ++ show item, item)
         | item <- duplicateNames (explicitSelectorNames selector)
       ]
-        ++ [ "  " ++ Mod.modulePathDisplay moduleName ++ " hiding " ++ show item
+        ++ [ (Mod.modulePathDisplay moduleName ++ " hiding " ++ show item, item)
              | item <- duplicateNames (explicitHiddenNames selector)
            ]
     duplicateItems _ = []
 
 loaderDiagnostic :: String -> String -> [String] -> [String] -> String
 loaderDiagnostic code message notes help =
+  loaderDiagnosticWithLabels code message [] notes help
+
+loaderDiagnosticWithLabels :: String -> String -> [Label] -> [String] -> [String] -> String
+loaderDiagnosticWithLabels code message labels notes help =
   encodeDiagnostic
     Diagnostic
       { diagnosticSeverity = Error,
         diagnosticCode = Just (DiagnosticCode code),
         diagnosticMessage = message,
-        diagnosticLabels = [],
+        diagnosticLabels = labels,
         diagnosticNotes = notes,
         diagnosticHelp = help
       }
 
+primaryNameLabel :: String -> Name -> Maybe Label
+primaryNameLabel message identName = do
+  sourceSpan <- nameSourceSpan identName
+  pure
+    Label
+      { labelSpan = sourceSpan,
+        labelStyle = Primary,
+        labelMessage = Just message
+      }
+
+primaryNameLabels :: String -> [Name] -> [Label]
+primaryNameLabels message =
+  mapMaybe (primaryNameLabel message)
+
+primaryModulePathLabel :: String -> ModulePath -> Maybe Label
+primaryModulePathLabel message modulePath = do
+  sourceSpan <- modulePathSourceSpan modulePath
+  pure
+    Label
+      { labelSpan = sourceSpan,
+        labelStyle = Primary,
+        labelMessage = Just message
+      }
+
+modulePathSourceSpan :: ModulePath -> Maybe SourceSpan
+modulePathSourceSpan (ExternalPath libName pathName) =
+  case (nameSourceSpan libName, nameSourceSpan pathName) of
+    (Just left, Just right) -> Just (combineSourceSpans left right)
+    (Just left, Nothing) -> Just left
+    (Nothing, Just right) -> Just right
+    (Nothing, Nothing) -> Nothing
+modulePathSourceSpan modulePath =
+  nameSourceSpan (Mod.modulePathName modulePath)
+
 explicitSelectorNames :: ItemSelector -> [Name]
 explicitSelectorNames (SelectItems items _) =
   [itemName | SelectItem itemName <- items]

From dc62d2872c310a0ae6e0983dacf7cb4ca56d4958 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 08:03:47 +0200
Subject: [PATCH 30/35] Structure generic typecheck diagnostics

---
 src/Solcore/Frontend/TypeInference/TcMonad.hs |  22 +++-
 src/Solcore/Frontend/TypeInference/TcUnify.hs | 120 +++++++++---------
 src/Solcore/Pipeline/SolcorePipeline.hs       |   1 +
 test/DiagnosticCliTests.hs                    |  74 ++++++++++-
 4 files changed, 151 insertions(+), 66 deletions(-)

diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index 255ecf6f1..422309e30 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -10,7 +10,7 @@ import Data.Map qualified as Map
 import Data.Maybe
 import Data.Monoid (First (..))
 import Data.Set qualified as Set
-import Solcore.Diagnostics (CompilerError (..), Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, diagnosticCompilerError, legacyCompilerError)
+import Solcore.Diagnostics (CompilerError (..), Diagnostic (..), DiagnosticCode (..), Label (..), LabelStyle (..), Severity (..), SourceSpan, addDiagnosticNote, diagnosticCompilerError)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.Id
@@ -718,7 +718,25 @@ tcmError :: String -> TcM a
 tcmError s = do
   verbose <- isVerbose
   when verbose dumpLogs
-  throwError (legacyCompilerError s)
+  throwError (genericTypecheckError s)
+
+genericTypecheckError :: String -> CompilerError
+genericTypecheckError rawMessage =
+  diagnosticCompilerError $
+    Diagnostic
+      { diagnosticSeverity = Error,
+        diagnosticCode = Just (DiagnosticCode "SC0299"),
+        diagnosticMessage = message,
+        diagnosticLabels = [],
+        diagnosticNotes = notes,
+        diagnosticHelp = []
+      }
+  where
+    rawLines = dropWhile null (lines rawMessage)
+    (message, notes) =
+      case rawLines of
+        [] -> ("typecheck error", [])
+        firstLine : rest -> (firstLine, filter (not . null) rest)
 
 undefinedName :: Name -> TcM a
 undefinedName n =
diff --git a/src/Solcore/Frontend/TypeInference/TcUnify.hs b/src/Solcore/Frontend/TypeInference/TcUnify.hs
index 9fb2a8991..ce1733842 100644
--- a/src/Solcore/Frontend/TypeInference/TcUnify.hs
+++ b/src/Solcore/Frontend/TypeInference/TcUnify.hs
@@ -52,16 +52,18 @@ instance (Pretty a, Match a) => Match [a] where
 instance Match Pred where
   match (InCls n t ts) (InCls n' t' ts')
     | n == n' = match (t : ts) (t' : ts')
-    | otherwise = throwError (legacyCompilerError "Classes differ!")
+    | otherwise =
+        structuredUnifyError
+          "SC0210"
+          "classes do not match"
+          ["left class: " ++ pretty n, "right class: " ++ pretty n']
+          []
   match p1 p2 =
-    throwError $
-      legacyCompilerError $
-      unlines
-        [ "Cannot match predicates:",
-          pretty p1,
-          "with",
-          pretty p2
-        ]
+    structuredUnifyError
+      "SC0211"
+      "predicates do not match"
+      ["left predicate: " ++ pretty p1, "right predicate: " ++ pretty p2]
+      []
 
 instance (HasType a, Match a) => Match (Qual a) where
   match (ps :=> t) (ps' :=> t') =
@@ -100,25 +102,19 @@ instance MGU Pred where
   mgu p1@(InCls n t ts) p2@(InCls n' t' ts')
     | n == n' = mgu (t : ts) (t' : ts')
     | otherwise =
-      throwError $
-        legacyCompilerError $
-        unlines
-            [ "Cannot unify predicates:",
-              pretty p1,
-              "with",
-              pretty p2
-            ]
+        structuredUnifyError
+          "SC0212"
+          "predicates do not unify"
+          ["left predicate: " ++ pretty p1, "right predicate: " ++ pretty p2]
+          []
   mgu (t1 :~: t2) (t1' :~: t2') =
     mgu [t1, t2] [t1', t2']
   mgu p1 p2 =
-    throwError $
-      legacyCompilerError $
-      unlines
-        [ "Cannot unify predicates:",
-          pretty p1,
-          "with",
-          pretty p2
-        ]
+    structuredUnifyError
+      "SC0212"
+      "predicates do not unify"
+      ["left predicate: " ++ pretty p1, "right predicate: " ++ pretty p2]
+      []
 
 instance (HasType a, MGU a) => MGU (Qual a) where
   mgu (ps :=> t) (ps' :=> t') =
@@ -164,23 +160,25 @@ merge s1@(Subst p1) s2@(Subst p2) =
     dom s = map fst s
 
 mergeError :: (MonadError CompilerError m) => [(Ty, Ty)] -> m a
-mergeError ts = throwError $ legacyCompilerError $ unlines $ "Cannot match types:" : ss
+mergeError ts =
+  structuredUnifyError
+    "SC0213"
+    "substitutions assign incompatible types"
+    ss
+    []
   where
-    ss = map go ts
+    ss = map (("conflict: " ++) . go) ts
     go (x, y) = pretty x ++ " with " ++ pretty y
 
 -- basic error messages
 
 infiniteTyErr :: (MonadError CompilerError m) => MetaTv -> Ty -> m a
 infiniteTyErr v t =
-  throwError $
-    legacyCompilerError $
-    unwords
-      [ "Cannot construct the infinite type:",
-        pretty (metaName v),
-        "~",
-        pretty t
-      ]
+  structuredUnifyError
+    "SC0214"
+    "cannot construct infinite type"
+    ["meta variable: " ++ pretty (metaName v), "type: " ++ pretty t]
+    []
 
 typesNotMatch :: (MonadError CompilerError m) => Ty -> Ty -> m a
 typesNotMatch t1 t2 =
@@ -188,27 +186,19 @@ typesNotMatch t1 t2 =
 
 typesMatchListErr :: (MonadError CompilerError m) => [String] -> [String] -> m a
 typesMatchListErr ts ts' =
-  throwError (legacyCompilerError (errMsg ts ts'))
-  where
-    errMsg lhs rhs =
-      unwords
-        [ "Type lists do not match: (typesMatchListErr)\n",
-          prettys lhs,
-          "and",
-          prettys rhs
-        ]
+  structuredUnifyError
+    "SC0215"
+    "type lists do not match"
+    ["left types: " ++ prettys ts, "right types: " ++ prettys ts']
+    []
 
 typesMguListErr :: (MonadError CompilerError m, Pretty t) => [t] -> [t] -> m a
 typesMguListErr ts ts' =
-  throwError (legacyCompilerError (errMsg ts ts'))
-  where
-    errMsg lhs rhs =
-      unwords
-        [ "Type lists do not unify: (typesMguListErr)\n",
-          prettys lhs,
-          "and",
-          prettys rhs
-        ]
+  structuredUnifyError
+    "SC0216"
+    "type lists do not unify"
+    ["left types: " ++ prettys ts, "right types: " ++ prettys ts']
+    []
 
 typesDoNotUnify :: (MonadError CompilerError m) => Ty -> Ty -> m a
 typesDoNotUnify t1 t2 =
@@ -232,11 +222,21 @@ typeMismatchDiagnostic message t1 t2 =
 
 boundVariablesErr :: (MonadError CompilerError m) => [Tyvar] -> m a
 boundVariablesErr ts =
+  structuredUnifyError
+    "SC0217"
+    "bound variable escaped unification"
+    ["bound variables: " ++ prettys ts]
+    ["report this as a compiler bug if it is reachable from source code"]
+
+structuredUnifyError :: (MonadError CompilerError m) => String -> String -> [String] -> [String] -> m a
+structuredUnifyError code message notes help =
   throwError $
-    legacyCompilerError $
-    unwords $
-      [ "Panic!",
-        "The following bound variables where",
-        "found in unification / matching:"
-      ]
-        ++ map pretty ts
+    diagnosticCompilerError $
+      Diagnostic
+        { diagnosticSeverity = Error,
+          diagnosticCode = Just (DiagnosticCode code),
+          diagnosticMessage = message,
+          diagnosticLabels = [],
+          diagnosticNotes = notes,
+          diagnosticHelp = help
+        }
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index b2545f52e..a16a18277 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -597,6 +597,7 @@ primaryLabelMessage diagnostic =
     Just (DiagnosticCode "SC0207") -> "undefined class"
     Just (DiagnosticCode "SC0208") -> "undefined type synonym"
     Just (DiagnosticCode "SC0209") -> "type is not polymorphic enough"
+    Just (DiagnosticCode "SC0299") -> "diagnostic reported here"
     Just (DiagnosticCode "SC0301") -> "redundant clause"
     Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
     Just (DiagnosticCode "SC0109") -> "module reference"
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index cd55f0636..458c3d08e 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -68,17 +68,18 @@ diagnosticCliTests =
             "note: module typecheck failed for",
             "      <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
           ],
-      testCase "legacy typecheck error has fallback span" $
+      testCase "generic typecheck error has fallback span" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/missing-signature.solc", "--no-specialise"]
-          [ "error: module typecheck failed for <cwd>/test/diagnostics/missing-signature.solc (no desugaring):",
+          [ "error[SC0299]: Top-level function must have complete type annotations:",
             "  --> <cwd>/test/diagnostics/missing-signature.solc:1:10",
             "  |",
             "1 | function foo() {",
             "  |          ^^^ diagnostic reported here",
-            "note: Top-level function must have complete type annotations:",
             "note: function foo ()",
-            "note: Annotate every parameter (name : Type) and provide a return type (-> Type)."
+            "note: Annotate every parameter (name : Type) and provide a return type (-> Type).",
+            "note: module typecheck failed for",
+            "      <cwd>/test/diagnostics/missing-signature.solc (no desugaring)"
           ],
       testCase "polymorphic type error uses signature span" $
         expectFailure
@@ -102,6 +103,45 @@ diagnosticCliTests =
             "      <cwd>/test/diagnostics/not-polymorphic-enough.solc (no",
             "      desugaring)"
           ],
+      testCase "missing instance" $
+        expectFailure
+          ["--root", "test/examples/cases", "--file", "test/examples/cases/missing-instance.solc", "--no-specialise"]
+          [ "error[SC0299]: Cannot entail:",
+            "  --> <cwd>/test/examples/cases/missing-instance.solc:12:14",
+            "   |",
+            "12 |     function load(ptr:word) -> word {",
+            "   |              ^^^^ diagnostic reported here",
+            "note: word : Typedef (word)",
+            "note: using defined instances:",
+            "note: in: function load (ptr : word) -> word {",
+            "      return Typedef.abs(MemoryType.load(ptr) : word);",
+            "      }",
+            "note: in: instance word : MemoryType {",
+            "      function load (ptr : word) -> word {",
+            "      return Typedef.abs(MemoryType.load(ptr) : word);",
+            "      }",
+            "      }",
+            "note: module typecheck failed for",
+            "      <cwd>/test/examples/cases/missing-instance.solc (no",
+            "      desugaring)"
+          ],
+      testCase "dot shorthand constructor error" $
+        expectFailure
+          ["--root", "test/examples/cases", "--file", "test/examples/cases/dot-expression-unknown-fail.solc", "--no-specialise"]
+          [ "error[SC0299]: No matching constructor for shorthand expression:",
+            "  --> <cwd>/test/examples/cases/dot-expression-unknown-fail.solc:4:11",
+            "  |",
+            "4 |   return .Nope(1);",
+            "  |           ^^^^ diagnostic reported here",
+            "note: .Nope",
+            "note: in: .Nope(1)",
+            "note: in: function bad () -> Option {",
+            "      return .Nope(1);",
+            "      }",
+            "note: module typecheck failed for",
+            "      <cwd>/test/examples/cases/dot-expression-unknown-fail.solc (no",
+            "      desugaring)"
+          ],
       testCase "import error" $
         expectFailure
           ["--root", "test/imports", "--file", "test/imports/select_unknown.solc", "--no-specialise"]
@@ -126,6 +166,32 @@ diagnosticCliTests =
             "note: import @missing.math.api",
             "help: pass --external-lib NAME=PATH for external imports"
           ],
+      testCase "ambiguous selected import" $
+        expectFailure
+          ["--root", "test/imports", "--file", "test/imports/amb_main.solc", "--no-specialise"]
+          [ "error[SC0120]: ambiguous selected imports",
+            "  --> <cwd>/test/imports/amb_main.solc:2:14",
+            "  |",
+            "2 | import ambB.{pick};",
+            "  |              ^^^^ ambiguous selected import",
+            "note: pick imported from ambB, ambA",
+            "help: use an explicit module qualifier or narrow the selected imports"
+          ],
+      testCase "hidden constructor import" $
+        expectFailure
+          ["--root", "test/imports", "--file", "test/imports/hidden_ctor_expr_fail.solc", "--no-specialise"]
+          [ "error[SC0101]: undefined name: Err",
+            "  --> <cwd>/test/imports/hidden_ctor_expr_fail.solc:4:16",
+            "  |",
+            "4 |   return Token.Err(0);",
+            "  |                ^^^ unknown name",
+            "note: in: return Token.Err(0) ;",
+            "note: in: function main () -> Token {",
+            "      return Token.Err(0) ;",
+            "      }",
+            "note: module validation failed for",
+            "      <cwd>/test/imports/hidden_ctor_expr_fail.solc"
+          ],
       testCase "short output" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/undefined-name.solc", "--no-specialise", "--diagnostic-format", "short"]

From ef3208819c848e042553946ed8b54b3064d650db Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 10:27:32 +0200
Subject: [PATCH 31/35] Make syntax locations explicit

---
 sol-core.cabal                            |   1 +
 src/Solcore/Frontend/Syntax/Contract.hs   | 120 ++++++++++++++++++++++
 src/Solcore/Frontend/Syntax/Location.hs   |  37 ++++++-
 src/Solcore/Frontend/Syntax/SyntaxTree.hs | 117 +++++++++++++++++++++
 test/LocationTests.hs                     |  65 ++++++++++++
 test/Main.hs                              |   2 +
 6 files changed, 337 insertions(+), 5 deletions(-)
 create mode 100644 test/LocationTests.hs

diff --git a/sol-core.cabal b/sol-core.cabal
index d50ff5c9c..4d2989050 100644
--- a/sol-core.cabal
+++ b/sol-core.cabal
@@ -173,6 +173,7 @@ test-suite sol-core-tests
     DiagnosticCliTests
     DiagnosticTests
     HullCases
+    LocationTests
     MatchCompilerTests
     ModuleTypeCheckTests
 
diff --git a/src/Solcore/Frontend/Syntax/Contract.hs b/src/Solcore/Frontend/Syntax/Contract.hs
index 2694c09f3..d5ad59416 100644
--- a/src/Solcore/Frontend/Syntax/Contract.hs
+++ b/src/Solcore/Frontend/Syntax/Contract.hs
@@ -2,6 +2,7 @@ module Solcore.Frontend.Syntax.Contract where
 
 import Data.Generics (Data, Typeable)
 import Data.List.NonEmpty
+import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
 import Solcore.Frontend.Syntax.Stmt
 import Solcore.Frontend.Syntax.Ty
@@ -229,3 +230,122 @@ data ContractDecl a
   | CMutualDecl [ContractDecl a] -- used only after SCC analysis
   | CConstrDecl (Constructor a)
   deriving (Eq, Ord, Show, Data, Typeable)
+
+instance (HasSourceSpan a) => HasSourceSpan (CompUnit a) where
+  sourceSpanOf (CompUnit imps ds) =
+    firstSourceSpan [sourceSpanOf imps, sourceSpanOf ds]
+
+instance (HasSourceSpan a) => HasSourceSpan (TopDecl a) where
+  sourceSpanOf (TContr contractDef) = sourceSpanOf contractDef
+  sourceSpanOf (TFunDef funDef) = sourceSpanOf funDef
+  sourceSpanOf (TClassDef cls) = sourceSpanOf cls
+  sourceSpanOf (TInstDef inst) = sourceSpanOf inst
+  sourceSpanOf (TMutualDef mutualDecls) = sourceSpanOf mutualDecls
+  sourceSpanOf (TDataDef dataTy) = sourceSpanOf dataTy
+  sourceSpanOf (TSym tySym) = sourceSpanOf tySym
+  sourceSpanOf (TExportDecl exportDecl) = sourceSpanOf exportDecl
+  sourceSpanOf (TPragmaDecl pragma) = sourceSpanOf pragma
+
+instance HasSourceSpan Pragma where
+  sourceSpanOf (Pragma _ status) = sourceSpanOf status
+
+instance HasSourceSpan PragmaStatus where
+  sourceSpanOf Enabled = Nothing
+  sourceSpanOf DisableAll = Nothing
+  sourceSpanOf (DisableFor names) = sourceSpanOf (toList names)
+
+instance HasSourceSpan ModulePath where
+  sourceSpanOf (RelativePath n) = sourceSpanOf n
+  sourceSpanOf (LibraryPath n) = sourceSpanOf n
+  sourceSpanOf (ExternalPath libName modName) =
+    combineMaybeSourceSpans (sourceSpanOf libName) (sourceSpanOf modName)
+
+instance HasSourceSpan Export where
+  sourceSpanOf (ExportList specs) = sourceSpanOf specs
+  sourceSpanOf (ExportModule modulePath) = sourceSpanOf modulePath
+  sourceSpanOf (ExportModuleAs modulePath aliasName) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf aliasName]
+  sourceSpanOf (ExportItemsFrom modulePath selector) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf selector]
+
+instance HasSourceSpan ExportSpec where
+  sourceSpanOf (ExportName n) = sourceSpanOf n
+  sourceSpanOf (ExportNameWithConstructors typeName selector) =
+    firstSourceSpan [sourceSpanOf typeName, sourceSpanOf selector]
+  sourceSpanOf ExportAll = Nothing
+  sourceSpanOf (ExportModuleAll modulePath) = sourceSpanOf modulePath
+
+instance HasSourceSpan ConstructorSelector where
+  sourceSpanOf (SelectConstructors names) = sourceSpanOf names
+  sourceSpanOf SelectAllConstructors = Nothing
+
+instance HasSourceSpan ExportSelector where
+  sourceSpanOf (SelectExportItems items) = sourceSpanOf items
+
+instance HasSourceSpan ExportSelectorEntry where
+  sourceSpanOf SelectExportAllItems = Nothing
+  sourceSpanOf (SelectExportItem n) = sourceSpanOf n
+  sourceSpanOf (SelectExportConstructors typeName selector) =
+    firstSourceSpan [sourceSpanOf typeName, sourceSpanOf selector]
+
+instance HasSourceSpan Import where
+  sourceSpanOf (ImportModule modulePath) = sourceSpanOf modulePath
+  sourceSpanOf (ImportAlias modulePath aliasName) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf aliasName]
+  sourceSpanOf (ImportOnly modulePath items) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf items]
+
+instance HasSourceSpan ItemSelector where
+  sourceSpanOf (SelectItems items hidden) =
+    firstSourceSpan [sourceSpanOf items, sourceSpanOf hidden]
+
+instance HasSourceSpan ItemSelectorEntry where
+  sourceSpanOf SelectAllItems = Nothing
+  sourceSpanOf (SelectItem n) = sourceSpanOf n
+
+instance (HasSourceSpan a) => HasSourceSpan (Contract a) where
+  sourceSpanOf (Contract n tyVars contractDecls) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyVars, sourceSpanOf contractDecls]
+
+instance HasSourceSpan DataTy where
+  sourceSpanOf (DataTy n tyVars constrs) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyVars, sourceSpanOf constrs]
+
+instance HasSourceSpan Constr where
+  sourceSpanOf (Constr n tys) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tys]
+
+instance HasSourceSpan TySym where
+  sourceSpanOf (TySym n tyVars ty) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyVars, sourceSpanOf ty]
+
+instance (HasSourceSpan a) => HasSourceSpan (Constructor a) where
+  sourceSpanOf (Constructor params body) =
+    firstSourceSpan [sourceSpanOf params, sourceSpanOf body]
+
+instance (HasSourceSpan a) => HasSourceSpan (Class a) where
+  sourceSpanOf (Class boundVars context clsName params main signatures') =
+    firstSourceSpan [sourceSpanOf boundVars, sourceSpanOf context, sourceSpanOf clsName, sourceSpanOf params, sourceSpanOf main, sourceSpanOf signatures']
+
+instance (HasSourceSpan a) => HasSourceSpan (Signature a) where
+  sourceSpanOf (Signature vars context sig params returnTy) =
+    firstSourceSpan [sourceSpanOf vars, sourceSpanOf context, sourceSpanOf sig, sourceSpanOf params, sourceSpanOf returnTy]
+
+instance (HasSourceSpan a) => HasSourceSpan (Instance a) where
+  sourceSpanOf (Instance _ vars context clsName params main funs) =
+    firstSourceSpan [sourceSpanOf vars, sourceSpanOf context, sourceSpanOf clsName, sourceSpanOf params, sourceSpanOf main, sourceSpanOf funs]
+
+instance (HasSourceSpan a) => HasSourceSpan (Field a) where
+  sourceSpanOf (Field n ty initExp) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf ty, sourceSpanOf initExp]
+
+instance (HasSourceSpan a) => HasSourceSpan (FunDef a) where
+  sourceSpanOf (FunDef sig body) =
+    firstSourceSpan [sourceSpanOf sig, sourceSpanOf body]
+
+instance (HasSourceSpan a) => HasSourceSpan (ContractDecl a) where
+  sourceSpanOf (CDataDecl dataTy) = sourceSpanOf dataTy
+  sourceSpanOf (CFieldDecl field) = sourceSpanOf field
+  sourceSpanOf (CFunDecl funDef) = sourceSpanOf funDef
+  sourceSpanOf (CMutualDecl decls') = sourceSpanOf decls'
+  sourceSpanOf (CConstrDecl constructor) = sourceSpanOf constructor
diff --git a/src/Solcore/Frontend/Syntax/Location.hs b/src/Solcore/Frontend/Syntax/Location.hs
index b9ba548f3..25fabda7b 100644
--- a/src/Solcore/Frontend/Syntax/Location.hs
+++ b/src/Solcore/Frontend/Syntax/Location.hs
@@ -1,11 +1,16 @@
 module Solcore.Frontend.Syntax.Location where
 
 import Control.Applicative ((<|>))
-import Data.Generics (Data, Typeable)
+import Data.Generics (Data, Typeable, everything, mkQ)
 import Solcore.Diagnostics (SourceSpan, combineSourceSpans)
 
+data NodeOrigin
+  = SourceNode SourceSpan
+  | GeneratedNode
+  deriving (Show, Data, Typeable)
+
 newtype NodeLocation
-  = NodeLocation {nodeLocationSpan :: Maybe SourceSpan}
+  = NodeLocation {nodeLocationOrigin :: NodeOrigin}
   deriving (Show, Data, Typeable)
 
 instance Eq NodeLocation where
@@ -15,13 +20,35 @@ instance Ord NodeLocation where
   compare _ _ = EQ
 
 unlocatedNode :: NodeLocation
-unlocatedNode = NodeLocation Nothing
+unlocatedNode = generatedNode
+
+generatedNode :: NodeLocation
+generatedNode = NodeLocation GeneratedNode
 
 locatedNode :: SourceSpan -> NodeLocation
-locatedNode = NodeLocation . Just
+locatedNode = NodeLocation . SourceNode
 
 withNodeSourceSpan :: Maybe SourceSpan -> NodeLocation
-withNodeSourceSpan = NodeLocation
+withNodeSourceSpan Nothing = generatedNode
+withNodeSourceSpan (Just sourceSpan) = locatedNode sourceSpan
+
+nodeLocationSpan :: NodeLocation -> Maybe SourceSpan
+nodeLocationSpan (NodeLocation (SourceNode sourceSpan)) = Just sourceSpan
+nodeLocationSpan (NodeLocation GeneratedNode) = Nothing
+
+isSourceNodeLocation :: NodeLocation -> Bool
+isSourceNodeLocation (NodeLocation (SourceNode _)) = True
+isSourceNodeLocation (NodeLocation GeneratedNode) = False
+
+isGeneratedNodeLocation :: NodeLocation -> Bool
+isGeneratedNodeLocation = not . isSourceNodeLocation
+
+nodeLocationsOf :: (Data a) => a -> [NodeLocation]
+nodeLocationsOf =
+  everything (++) (mkQ [] nodeLocationList)
+  where
+    nodeLocationList :: NodeLocation -> [NodeLocation]
+    nodeLocationList location = [location]
 
 combineMaybeSourceSpans :: Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan
 combineMaybeSourceSpans Nothing right = right
diff --git a/src/Solcore/Frontend/Syntax/SyntaxTree.hs b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
index 70b0b3e40..9c29626ea 100644
--- a/src/Solcore/Frontend/Syntax/SyntaxTree.hs
+++ b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
@@ -252,6 +252,123 @@ data ContractDecl
   | CConstrDecl Constructor
   deriving (Eq, Ord, Show, Data, Typeable)
 
+instance HasSourceSpan CompUnit where
+  sourceSpanOf (CompUnit imps ds) =
+    firstSourceSpan [sourceSpanOf imps, sourceSpanOf ds]
+
+instance HasSourceSpan TopDecl where
+  sourceSpanOf (TContr contractDef) = sourceSpanOf contractDef
+  sourceSpanOf (TFunDef funDef) = sourceSpanOf funDef
+  sourceSpanOf (TClassDef cls) = sourceSpanOf cls
+  sourceSpanOf (TInstDef inst) = sourceSpanOf inst
+  sourceSpanOf (TDataDef dataTy) = sourceSpanOf dataTy
+  sourceSpanOf (TSym tySym) = sourceSpanOf tySym
+  sourceSpanOf (TExportDecl exportDecl) = sourceSpanOf exportDecl
+  sourceSpanOf (TPragmaDecl pragma) = sourceSpanOf pragma
+
+instance HasSourceSpan Pragma where
+  sourceSpanOf (Pragma _ status) = sourceSpanOf status
+
+instance HasSourceSpan PragmaStatus where
+  sourceSpanOf Enabled = Nothing
+  sourceSpanOf DisableAll = Nothing
+  sourceSpanOf (DisableFor names) = sourceSpanOf (toList names)
+
+instance HasSourceSpan ModulePath where
+  sourceSpanOf (RelativePath n) = sourceSpanOf n
+  sourceSpanOf (LibraryPath n) = sourceSpanOf n
+  sourceSpanOf (ExternalPath libName modName) =
+    combineMaybeSourceSpans (sourceSpanOf libName) (sourceSpanOf modName)
+
+instance HasSourceSpan Export where
+  sourceSpanOf (ExportList specs) = sourceSpanOf specs
+  sourceSpanOf (ExportModule modulePath) = sourceSpanOf modulePath
+  sourceSpanOf (ExportModuleAs modulePath aliasName) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf aliasName]
+  sourceSpanOf (ExportItemsFrom modulePath selector) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf selector]
+
+instance HasSourceSpan ExportSpec where
+  sourceSpanOf (ExportName n) = sourceSpanOf n
+  sourceSpanOf (ExportNameWithConstructors typeName selector) =
+    firstSourceSpan [sourceSpanOf typeName, sourceSpanOf selector]
+  sourceSpanOf ExportAll = Nothing
+  sourceSpanOf (ExportModuleAll modulePath) = sourceSpanOf modulePath
+
+instance HasSourceSpan ConstructorSelector where
+  sourceSpanOf (SelectConstructors names) = sourceSpanOf names
+  sourceSpanOf SelectAllConstructors = Nothing
+
+instance HasSourceSpan ExportSelector where
+  sourceSpanOf (SelectExportItems items) = sourceSpanOf items
+
+instance HasSourceSpan ExportSelectorEntry where
+  sourceSpanOf SelectExportAllItems = Nothing
+  sourceSpanOf (SelectExportItem n) = sourceSpanOf n
+  sourceSpanOf (SelectExportConstructors typeName selector) =
+    firstSourceSpan [sourceSpanOf typeName, sourceSpanOf selector]
+
+instance HasSourceSpan Import where
+  sourceSpanOf (ImportModule modulePath) = sourceSpanOf modulePath
+  sourceSpanOf (ImportAlias modulePath aliasName) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf aliasName]
+  sourceSpanOf (ImportOnly modulePath items) =
+    firstSourceSpan [sourceSpanOf modulePath, sourceSpanOf items]
+
+instance HasSourceSpan ItemSelector where
+  sourceSpanOf (SelectItems items hidden) =
+    firstSourceSpan [sourceSpanOf items, sourceSpanOf hidden]
+
+instance HasSourceSpan ItemSelectorEntry where
+  sourceSpanOf SelectAllItems = Nothing
+  sourceSpanOf (SelectItem n) = sourceSpanOf n
+
+instance HasSourceSpan Contract where
+  sourceSpanOf (Contract n tyParams' contractDecls) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyParams', sourceSpanOf contractDecls]
+
+instance HasSourceSpan DataTy where
+  sourceSpanOf (DataTy n tyParams' constrs) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyParams', sourceSpanOf constrs]
+
+instance HasSourceSpan Constr where
+  sourceSpanOf (Constr n tys) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tys]
+
+instance HasSourceSpan TySym where
+  sourceSpanOf (TySym n tyParams' ty) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf tyParams', sourceSpanOf ty]
+
+instance HasSourceSpan Constructor where
+  sourceSpanOf (Constructor params body) =
+    firstSourceSpan [sourceSpanOf params, sourceSpanOf body]
+
+instance HasSourceSpan Class where
+  sourceSpanOf (Class boundVars context clsName params main signatures') =
+    firstSourceSpan [sourceSpanOf boundVars, sourceSpanOf context, sourceSpanOf clsName, sourceSpanOf params, sourceSpanOf main, sourceSpanOf signatures']
+
+instance HasSourceSpan Signature where
+  sourceSpanOf (Signature vars context sig params retTy) =
+    firstSourceSpan [sourceSpanOf vars, sourceSpanOf context, sourceSpanOf sig, sourceSpanOf params, sourceSpanOf retTy]
+
+instance HasSourceSpan Instance where
+  sourceSpanOf (Instance _ vars context clsName params main funs) =
+    firstSourceSpan [sourceSpanOf vars, sourceSpanOf context, sourceSpanOf clsName, sourceSpanOf params, sourceSpanOf main, sourceSpanOf funs]
+
+instance HasSourceSpan Field where
+  sourceSpanOf (Field n ty initExp) =
+    firstSourceSpan [sourceSpanOf n, sourceSpanOf ty, sourceSpanOf initExp]
+
+instance HasSourceSpan FunDef where
+  sourceSpanOf (FunDef sig body) =
+    firstSourceSpan [sourceSpanOf sig, sourceSpanOf body]
+
+instance HasSourceSpan ContractDecl where
+  sourceSpanOf (CDataDecl dataTy) = sourceSpanOf dataTy
+  sourceSpanOf (CFieldDecl field) = sourceSpanOf field
+  sourceSpanOf (CFunDecl funDef) = sourceSpanOf funDef
+  sourceSpanOf (CConstrDecl constructor) = sourceSpanOf constructor
+
 -- definition of statements
 
 type Equation = ([Pat], [Stmt])
diff --git a/test/LocationTests.hs b/test/LocationTests.hs
new file mode 100644
index 000000000..cfdc39a93
--- /dev/null
+++ b/test/LocationTests.hs
@@ -0,0 +1,65 @@
+module LocationTests
+  ( locationTests,
+  )
+where
+
+import Solcore.Diagnostics (SourceSpan (..))
+import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
+import Solcore.Frontend.Syntax.Location
+import Solcore.Frontend.Syntax.SyntaxTree ()
+import Test.Tasty
+import Test.Tasty.HUnit
+
+locationTests :: TestTree
+locationTests =
+  testGroup
+    "Syntax locations"
+    [ testCase "parsed nodes carry source locations" test_parsedNodesCarrySourceLocations,
+      testCase "generated nodes are explicit" test_generatedNodesAreExplicit
+    ]
+
+test_parsedNodesCarrySourceLocations :: Assertion
+test_parsedNodesCarrySourceLocations = do
+  parsed <- parseCompUnitWithPath "location-invariant.solc" locatedSource
+  unit <-
+    case parsed of
+      Left err -> assertFailure err
+      Right cunit -> pure cunit
+  assertBool "compilation unit should have a source span" (hasSourceSpan unit)
+  assertBool "parser sample should exercise located AST nodes" (length (nodeLocationsOf unit) > 8)
+  assertEqual "generated node locations in parser output" [] (filter isGeneratedNodeLocation (nodeLocationsOf unit))
+
+test_generatedNodesAreExplicit :: Assertion
+test_generatedNodesAreExplicit = do
+  assertBool "unlocatedNode is generated" (isGeneratedNodeLocation unlocatedNode)
+  assertEqual "generated source span" Nothing (nodeLocationSpan unlocatedNode)
+  assertEqual "source node span" (Just sampleSpan) (nodeLocationSpan (locatedNode sampleSpan))
+
+hasSourceSpan :: (HasSourceSpan a) => a -> Bool
+hasSourceSpan =
+  maybe False (const True) . sourceSpanOf
+
+sampleSpan :: SourceSpan
+sampleSpan =
+  SourceSpan
+    { spanFile = "generated.solc",
+      spanStartByte = 0,
+      spanEndByte = 1,
+      spanStartLine = 1,
+      spanStartColumn = 1,
+      spanEndLine = 1,
+      spanEndColumn = 2
+    }
+
+locatedSource :: String
+locatedSource =
+  unlines
+    [ "data Bool = True | False;",
+      "function main(x : word) -> word {",
+      "  let y : word = x + 1;",
+      "  match Bool.True {",
+      "  | Bool.True => return y;",
+      "  | _ => return 0;",
+      "  }",
+      "}"
+    ]
diff --git a/test/Main.hs b/test/Main.hs
index 3c1340e68..71520fd7b 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,6 +4,7 @@ import Cases
 import DiagnosticCliTests
 import DiagnosticTests
 import HullCases
+import LocationTests
 import MatchCompilerTests
 import ModuleTypeCheckTests
 import Test.Tasty
@@ -22,6 +23,7 @@ tests =
       std,
       diagnosticCliTests,
       diagnosticTests,
+      locationTests,
       imports,
       moduleTypeCheckTests,
       dispatches,

From ba32ffa5bd76959d130ad36dd8e7863f0fe5a121 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 13:42:08 +0200
Subject: [PATCH 32/35] Split generic typecheck diagnostics

---
 .../Frontend/TypeInference/TcContract.hs      | 16 +++-
 src/Solcore/Frontend/TypeInference/TcMonad.hs | 95 +++++++++++++++++--
 .../Frontend/TypeInference/TcSimplify.hs      | 23 +----
 src/Solcore/Frontend/TypeInference/TcStmt.hs  | 84 ++++++++--------
 src/Solcore/Pipeline/SolcorePipeline.hs       | 10 ++
 test/DiagnosticCliTests.hs                    | 29 +++---
 6 files changed, 169 insertions(+), 88 deletions(-)

diff --git a/src/Solcore/Frontend/TypeInference/TcContract.hs b/src/Solcore/Frontend/TypeInference/TcContract.hs
index 3b52e2cc0..10c4a1fb6 100644
--- a/src/Solcore/Frontend/TypeInference/TcContract.hs
+++ b/src/Solcore/Frontend/TypeInference/TcContract.hs
@@ -520,11 +520,23 @@ signatureError n v (Signature _ methodCtx f _ _) t
 
 duplicatedClassDecl :: Name -> TcM ()
 duplicatedClassDecl n =
-  tcmError $ "Duplicated class definition:" ++ pretty n
+  tcDiagnosticErrorAtName
+    "SC0227"
+    ("duplicate class definition: " ++ pretty n)
+    n
+    "duplicate class"
+    []
+    ["rename or remove the duplicate class definition"]
 
 duplicatedClassMethod :: Name -> TcM ()
 duplicatedClassMethod n =
-  tcmError $ "Duplicated class method definition:" ++ pretty n
+  tcDiagnosticErrorAtName
+    "SC0228"
+    ("duplicate class method definition: " ++ pretty n)
+    n
+    "duplicate class method"
+    []
+    ["rename or remove the duplicate class method"]
 
 invalidPragmaDecl :: [Pragma] -> TcM ()
 invalidPragmaDecl ps =
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index 422309e30..d8381e97b 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -502,7 +502,13 @@ checkSynonym (TySym n vs t) =
 
 duplicatedSynonymDecl :: Name -> TcM a
 duplicatedSynonymDecl n =
-  tcmError $ unwords ["Duplicated type synonym definition:", pretty n]
+  tcDiagnosticErrorAtName
+    "SC0226"
+    ("duplicate type synonym definition: " ++ pretty n)
+    n
+    "duplicate type synonym"
+    []
+    ["rename or remove the duplicate type synonym"]
 
 -- manipulating the instance environment
 
@@ -697,6 +703,16 @@ contextLabelMessage diagnostic =
     Just (DiagnosticCode "SC0207") -> "undefined class"
     Just (DiagnosticCode "SC0208") -> "undefined type synonym"
     Just (DiagnosticCode "SC0209") -> "type is not polymorphic enough"
+    Just (DiagnosticCode "SC0220") -> "incomplete signature"
+    Just (DiagnosticCode "SC0221") -> "incomplete method signature"
+    Just (DiagnosticCode "SC0222") -> "return before end of block"
+    Just (DiagnosticCode "SC0223") -> "unsolved constraint"
+    Just (DiagnosticCode "SC0224") -> "shorthand constructor"
+    Just (DiagnosticCode "SC0225") -> "duplicate function"
+    Just (DiagnosticCode "SC0226") -> "duplicate type synonym"
+    Just (DiagnosticCode "SC0227") -> "duplicate class"
+    Just (DiagnosticCode "SC0228") -> "duplicate class method"
+    Just (DiagnosticCode "SC0229") -> "duplicate type"
     _ -> "diagnostic reported here"
 
 contextSourceSpan :: (Data a) => a -> Maybe SourceSpan
@@ -831,6 +847,10 @@ tcDiagnosticErrorAtName :: String -> String -> Name -> String -> [String] -> [St
 tcDiagnosticErrorAtName code message identName label notes help =
   tcDiagnosticErrorWithLabels code message (maybe [] pure (primaryNameLabel label identName)) notes help
 
+tcDiagnosticErrorAtSource :: (HasSourceSpan source) => String -> String -> source -> String -> [String] -> [String] -> TcM a
+tcDiagnosticErrorAtSource code message source label notes help =
+  tcDiagnosticErrorWithLabels code message (maybe [] pure (primarySourceLabel label source)) notes help
+
 tcDiagnosticErrorWithLabels :: String -> String -> [Label] -> [String] -> [String] -> TcM a
 tcDiagnosticErrorWithLabels code message labels notes help =
   throwError $
@@ -848,6 +868,17 @@ primaryNameLabel :: String -> Name -> Maybe Label
 primaryNameLabel message identName =
   do
     sourceSpan <- nameSourceSpan identName
+    pure
+      Label
+        { labelSpan = sourceSpan,
+        labelStyle = Primary,
+        labelMessage = Just message
+      }
+
+primarySourceLabel :: (HasSourceSpan source) => String -> source -> Maybe Label
+primarySourceLabel message source =
+  do
+    sourceSpan <- sourceSpanOf source
     pure
       Label
         { labelSpan = sourceSpan,
@@ -855,19 +886,67 @@ primaryNameLabel message identName =
           labelMessage = Just message
         }
 
+topLevelFunctionAnnotationError :: Signature Name -> TcM a
+topLevelFunctionAnnotationError sig =
+  tcDiagnosticErrorAtName
+    "SC0220"
+    "top-level function must have complete type annotations"
+    (sigName sig)
+    "incomplete signature"
+    ["signature: " ++ pretty sig]
+    ["annotate every parameter (name : Type) and provide a return type (-> Type)"]
+
+methodAnnotationError :: Signature Name -> TcM a
+methodAnnotationError sig =
+  tcDiagnosticErrorAtName
+    "SC0221"
+    "class and instance methods must have complete type signatures"
+    (sigName sig)
+    "incomplete method signature"
+    ["signature: " ++ pretty sig]
+    ["annotate every method parameter and provide a return type"]
+
+illegalReturnStatement :: Stmt Name -> TcM a
+illegalReturnStatement stmt =
+  tcDiagnosticErrorAtSource
+    "SC0222"
+    "illegal return statement"
+    stmt
+    "return before end of block"
+    ["return statements must be the final statement in a block"]
+    []
+
+cannotEntail :: Pred -> [String] -> TcM a
+cannotEntail predValue notes =
+  tcDiagnosticError
+    "SC0223"
+    ("cannot entail: " ++ pretty predValue)
+    notes
+    ["add a matching instance or strengthen the surrounding type context"]
+
+shorthandConstructorError :: String -> Name -> [String] -> TcM a
+shorthandConstructorError message constructorName notes =
+  tcDiagnosticErrorAtName
+    "SC0224"
+    message
+    constructorName
+    "shorthand constructor"
+    notes
+    ["use a constructor that is visible for the expected type"]
+
 typeAlreadyDefinedError :: DataTy -> Name -> TcM a
 typeAlreadyDefinedError d n =
   do
     -- get type info
     di <- askTypeInfo n
     d' <- dataTyFromInfo n di `wrapError` d
-    tcmError $
-      unlines
-        [ "Duplicated type definition for " ++ pretty n ++ ":",
-          pretty d,
-          "and",
-          pretty d'
-        ]
+    tcDiagnosticErrorAtName
+      "SC0229"
+      ("duplicate type definition: " ++ pretty n)
+      n
+      "duplicate type"
+      ["new definition: " ++ pretty d, "existing definition: " ++ pretty d']
+      ["rename or remove the duplicate type definition"]
 
 dataTyFromInfo :: Name -> TypeInfo -> TcM DataTy
 dataTyFromInfo n (TypeInfo _ cs _) =
diff --git a/src/Solcore/Frontend/TypeInference/TcSimplify.hs b/src/Solcore/Frontend/TypeInference/TcSimplify.hs
index 768f78faa..6839bf653 100644
--- a/src/Solcore/Frontend/TypeInference/TcSimplify.hs
+++ b/src/Solcore/Frontend/TypeInference/TcSimplify.hs
@@ -342,16 +342,8 @@ undefinedInstance p@(InCls n _ _) =
   do
     insts <- askInstEnv n
     insts' <- mapM fromANF insts
-    tcmError $
-      unlines $
-        [ "Cannot entail:",
-          f (pretty p),
-          "currently defined instances:"
-        ]
-          ++ map (f . pretty) insts'
-  where
-    f s = "   " ++ s
-undefinedInstance p = tcmError $ unwords ["Cannot entail: ", pretty p]
+    cannotEntail p ("currently defined instances:" : map pretty insts')
+undefinedInstance p = cannotEntail p []
 
 unsolvedError :: [Pred] -> TcM ()
 unsolvedError = mapM_ unsolvedPredError
@@ -361,12 +353,5 @@ unsolvedPredError p@(InCls n _ _) =
   do
     insts <- askInstEnv n
     insts' <- mapM fromANF insts
-    let s = unlines (map pretty insts')
-    tcmError $
-      unlines
-        [ "Cannot entail:",
-          pretty p,
-          "using defined instances:",
-          s
-        ]
-unsolvedPredError p = tcmError $ unwords ["Cannot entail:", pretty p]
+    cannotEntail p ("using defined instances:" : map pretty insts')
+unsolvedPredError p = cannotEntail p []
diff --git a/src/Solcore/Frontend/TypeInference/TcStmt.hs b/src/Solcore/Frontend/TypeInference/TcStmt.hs
index 56754fc29..20fcd8394 100644
--- a/src/Solcore/Frontend/TypeInference/TcStmt.hs
+++ b/src/Solcore/Frontend/TypeInference/TcStmt.hs
@@ -1258,17 +1258,11 @@ fullSignature :: Signature Name -> TcM ()
 fullSignature sig =
   unless
     (isFullyAnnotated sig)
-    (tcmError $ unlines ["Class and instance methods must have complete type signatures:", pretty sig])
+    (methodAnnotationError sig)
 
 requireAnnotations :: FunDef Name -> TcM ()
 requireAnnotations (FunDef sig _) =
-  unless (isFullyAnnotated sig) $
-    tcmError $
-      unlines
-        [ "Top-level function must have complete type annotations:",
-          "  " ++ pretty sig,
-          "Annotate every parameter (name : Type) and provide a return type (-> Type)."
-        ]
+  unless (isFullyAnnotated sig) (topLevelFunctionAnnotationError sig)
 
 isFullyAnnotated :: Signature Name -> Bool
 isFullyAnnotated (Signature _ _ _ ps rt) =
@@ -1359,8 +1353,8 @@ tcBodyWithExpectedReturn mExpectedReturn [s] =
   do
     (s', ps', t') <- tcStmtWithExpectedReturn mExpectedReturn s
     pure ([s'], ps', t')
-tcBodyWithExpectedReturn _ (Return _ : _) =
-  tcmError "Illegal return statement"
+tcBodyWithExpectedReturn _ (returnStmt@(Return _) : _) =
+  illegalReturnStatement returnStmt
 tcBodyWithExpectedReturn mExpectedReturn (s : ss) =
   do
     (s', ps', _) <- tcStmtWithExpectedReturn mExpectedReturn s
@@ -1436,28 +1430,25 @@ resolveDotExpressionConstructor dotName argTys mExpected = do
   candidates <- case mcandidates of
     Just xs -> pure xs
     Nothing ->
-      tcmError $
-        unlines
-          [ "Cannot resolve shorthand constructor expression without expected constructor type:",
-            pretty dotName
-          ]
+      shorthandConstructorError
+        "cannot resolve shorthand constructor expression without expected constructor type"
+        dotName
+        ["constructor: " ++ pretty dotName]
   valid <- filterM (\n -> constructorAcceptsArguments n argTys mExpected) (nub candidates)
   case valid of
     [] ->
-      tcmError $
-        unlines
-          [ "No matching constructor for shorthand expression:",
-            pretty dotName
-          ]
+      shorthandConstructorError
+        "no matching constructor for shorthand expression"
+        dotName
+        ["constructor: " ++ pretty dotName]
     [n] -> pure n
     xs ->
-      tcmError $
-        unlines
-          [ "Ambiguous shorthand constructor expression:",
-            pretty dotName,
-            "Candidates:",
-            unwords (map pretty xs)
-          ]
+      shorthandConstructorError
+        "ambiguous shorthand constructor expression"
+        dotName
+        [ "constructor: " ++ pretty dotName,
+          "candidates: " ++ unwords (map pretty xs)
+        ]
 
 constructorAcceptsArguments :: Name -> [Ty] -> Maybe Ty -> TcM Bool
 constructorAcceptsArguments n argTys mExpected = do
@@ -1498,27 +1489,24 @@ resolveDotPatternConstructor dotName expectedTy = do
   candidates <- case mcandidates of
     Just xs -> pure xs
     Nothing ->
-      tcmError $
-        unlines
-          [ "Cannot resolve shorthand constructor pattern without expected constructor type:",
-            pretty dotName
-          ]
+      shorthandConstructorError
+        "cannot resolve shorthand constructor pattern without expected constructor type"
+        dotName
+        ["constructor: " ++ pretty dotName]
   case nub candidates of
     [] ->
-      tcmError $
-        unlines
-          [ "No matching constructor for shorthand pattern:",
-            pretty dotName
-          ]
+      shorthandConstructorError
+        "no matching constructor for shorthand pattern"
+        dotName
+        ["constructor: " ++ pretty dotName]
     [n] -> pure n
     xs ->
-      tcmError $
-        unlines
-          [ "Ambiguous shorthand constructor pattern:",
-            pretty dotName,
-            "Candidates:",
-            unwords (map pretty xs)
-          ]
+      shorthandConstructorError
+        "ambiguous shorthand constructor pattern"
+        dotName
+        [ "constructor: " ++ pretty dotName,
+          "candidates: " ++ unwords (map pretty xs)
+        ]
 
 candidatesForDotPattern :: Name -> Ty -> TcM (Maybe [Name])
 candidatesForDotPattern dotName expectedTy = do
@@ -1812,7 +1800,13 @@ wrongPatternNumber qts ps =
 
 duplicatedFunDef :: Name -> TcM ()
 duplicatedFunDef n =
-  tcmError $ "Duplicated function definition:" ++ pretty n
+  tcDiagnosticErrorAtName
+    "SC0225"
+    ("duplicate function definition: " ++ pretty n)
+    n
+    "duplicate function"
+    []
+    ["rename or remove the duplicate function definition"]
 
 entailmentError :: [Pred] -> [Pred] -> TcM ()
 entailmentError base nonentail =
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index a16a18277..39906b13d 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -597,6 +597,16 @@ primaryLabelMessage diagnostic =
     Just (DiagnosticCode "SC0207") -> "undefined class"
     Just (DiagnosticCode "SC0208") -> "undefined type synonym"
     Just (DiagnosticCode "SC0209") -> "type is not polymorphic enough"
+    Just (DiagnosticCode "SC0220") -> "incomplete signature"
+    Just (DiagnosticCode "SC0221") -> "incomplete method signature"
+    Just (DiagnosticCode "SC0222") -> "return before end of block"
+    Just (DiagnosticCode "SC0223") -> "unsolved constraint"
+    Just (DiagnosticCode "SC0224") -> "shorthand constructor"
+    Just (DiagnosticCode "SC0225") -> "duplicate function"
+    Just (DiagnosticCode "SC0226") -> "duplicate type synonym"
+    Just (DiagnosticCode "SC0227") -> "duplicate class"
+    Just (DiagnosticCode "SC0228") -> "duplicate class method"
+    Just (DiagnosticCode "SC0229") -> "duplicate type"
     Just (DiagnosticCode "SC0299") -> "diagnostic reported here"
     Just (DiagnosticCode "SC0301") -> "redundant clause"
     Just (DiagnosticCode "SC0302") -> "non-exhaustive match"
diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index 458c3d08e..6506ca704 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -68,18 +68,18 @@ diagnosticCliTests =
             "note: module typecheck failed for",
             "      <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
           ],
-      testCase "generic typecheck error has fallback span" $
+      testCase "missing signature uses signature span" $
         expectFailure
           ["--root", "test/diagnostics", "--file", "test/diagnostics/missing-signature.solc", "--no-specialise"]
-          [ "error[SC0299]: Top-level function must have complete type annotations:",
+          [ "error[SC0220]: top-level function must have complete type annotations",
             "  --> <cwd>/test/diagnostics/missing-signature.solc:1:10",
             "  |",
             "1 | function foo() {",
-            "  |          ^^^ diagnostic reported here",
-            "note: function foo ()",
-            "note: Annotate every parameter (name : Type) and provide a return type (-> Type).",
+            "  |          ^^^ incomplete signature",
+            "note: signature: function foo ()",
             "note: module typecheck failed for",
-            "      <cwd>/test/diagnostics/missing-signature.solc (no desugaring)"
+            "      <cwd>/test/diagnostics/missing-signature.solc (no desugaring)",
+            "help: annotate every parameter (name : Type) and provide a return type (-> Type)"
           ],
       testCase "polymorphic type error uses signature span" $
         expectFailure
@@ -106,12 +106,11 @@ diagnosticCliTests =
       testCase "missing instance" $
         expectFailure
           ["--root", "test/examples/cases", "--file", "test/examples/cases/missing-instance.solc", "--no-specialise"]
-          [ "error[SC0299]: Cannot entail:",
+          [ "error[SC0223]: cannot entail: word : Typedef (word)",
             "  --> <cwd>/test/examples/cases/missing-instance.solc:12:14",
             "   |",
             "12 |     function load(ptr:word) -> word {",
-            "   |              ^^^^ diagnostic reported here",
-            "note: word : Typedef (word)",
+            "   |              ^^^^ unsolved constraint",
             "note: using defined instances:",
             "note: in: function load (ptr : word) -> word {",
             "      return Typedef.abs(MemoryType.load(ptr) : word);",
@@ -123,24 +122,26 @@ diagnosticCliTests =
             "      }",
             "note: module typecheck failed for",
             "      <cwd>/test/examples/cases/missing-instance.solc (no",
-            "      desugaring)"
+            "      desugaring)",
+            "help: add a matching instance or strengthen the surrounding type context"
           ],
       testCase "dot shorthand constructor error" $
         expectFailure
           ["--root", "test/examples/cases", "--file", "test/examples/cases/dot-expression-unknown-fail.solc", "--no-specialise"]
-          [ "error[SC0299]: No matching constructor for shorthand expression:",
+          [ "error[SC0224]: no matching constructor for shorthand expression",
             "  --> <cwd>/test/examples/cases/dot-expression-unknown-fail.solc:4:11",
             "  |",
             "4 |   return .Nope(1);",
-            "  |           ^^^^ diagnostic reported here",
-            "note: .Nope",
+            "  |           ^^^^ shorthand constructor",
+            "note: constructor: .Nope",
             "note: in: .Nope(1)",
             "note: in: function bad () -> Option {",
             "      return .Nope(1);",
             "      }",
             "note: module typecheck failed for",
             "      <cwd>/test/examples/cases/dot-expression-unknown-fail.solc (no",
-            "      desugaring)"
+            "      desugaring)",
+            "help: use a constructor that is visible for the expected type"
           ],
       testCase "import error" $
         expectFailure

From 5ff914bfe029fddeb77be6213f549c990d939613 Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 15:11:26 +0200
Subject: [PATCH 33/35] Preserve warning spans in diagnostics

---
 src/Solcore/Desugarer/DecisionTreeCompiler.hs | 62 +++++++++++++------
 src/Solcore/Frontend/TypeInference/Id.hs      |  3 +
 src/Solcore/Pipeline/SolcorePipeline.hs       | 45 --------------
 test/MatchCompilerTests.hs                    | 22 +++----
 4 files changed, 56 insertions(+), 76 deletions(-)

diff --git a/src/Solcore/Desugarer/DecisionTreeCompiler.hs b/src/Solcore/Desugarer/DecisionTreeCompiler.hs
index 1d2f4b02b..f7b9b9559 100644
--- a/src/Solcore/Desugarer/DecisionTreeCompiler.hs
+++ b/src/Solcore/Desugarer/DecisionTreeCompiler.hs
@@ -1,5 +1,6 @@
 module Solcore.Desugarer.DecisionTreeCompiler where
 
+import Control.Applicative ((<|>))
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
@@ -64,7 +65,7 @@ instance Compile (TopDecl Id) where
 instance Compile (Contract Id) where
   compile (Contract n vs ds) =
     Contract n vs
-      <$> local (\(te, ctx) -> (Map.union env' te, ctx ++ ["contract " ++ pretty n])) (compile ds)
+      <$> local (\(te, ctx, warnSpan) -> (Map.union env' te, ctx ++ ["contract " ++ pretty n], warnSpan)) (compile ds)
     where
       ds' = [d | (CDataDecl d) <- ds]
       env' = foldr addDataTyInfo Map.empty ds'
@@ -103,7 +104,7 @@ instance Compile (Stmt Id) where
     For <$> compile initStmt <*> compile cond <*> compile postStmt <*> compile body
   compile s@(Asm _) =
     pure s
-  compile (Match es eqns) = do
+  compile matchStmt@(Match es eqns) = withWarnSpan (sourceSpanOf matchStmt) $ do
     es' <- compile es
     eqns' <- mapM compileEqn eqns
     scrutTys <- mapM scrutineeType es'
@@ -144,7 +145,9 @@ compileMatrix ::
 compileMatrix tys _ [] _ = do
   pats <- mapM freshPat tys
   ctx <- askWarnCtx
-  unless (null pats) $ tell [NonExhaustive ctx pats]
+  unless (null pats) $ do
+    warnSpan <- askWarnSpan
+    tell [NonExhaustive ctx warnSpan pats]
   pure Fail
 compileMatrix _tys occs (firstRow : _restRows) ((firstBinds, firstAct) : _restBacts)
   | all isVarPat firstRow = do
@@ -234,7 +237,8 @@ buildConSwitch testOcc restOccs _testTy restTys matrix bacts headCons = do
                       pure (PCon k fieldPats : restWit)
                     [] -> mapM freshPat restTys
               ctx <- askWarnCtx
-              tell [NonExhaustive ctx witPats]
+              warnSpan <- askWarnSpan
+              tell [NonExhaustive ctx warnSpan witPats]
               pure (Just Fail)
             else Just <$> compileMatrix restTys restOccs defMat defBacts
 
@@ -257,7 +261,8 @@ buildLitSwitch testOcc restOccs testTy restTys matrix bacts headLits = do
         litWit <- freshPat testTy
         restWit <- mapM freshPat restTys
         ctx <- askWarnCtx
-        tell [NonExhaustive ctx (litWit : restWit)]
+        warnSpan <- askWarnSpan
+        tell [NonExhaustive ctx warnSpan (litWit : restWit)]
         pure (Just Fail)
       else Just <$> compileMatrix restTys restOccs defMat defBacts
   pure (LitSwitch testOcc branches mDefault)
@@ -378,24 +383,31 @@ litBranchToEqn occMap (lit, tree) = do
 type WarnCtx = [String]
 
 type CompilerM a =
-  ReaderT (TypeEnv, WarnCtx) (ExceptT String (WriterT [Warning] (StateT Int IO))) a
+  ReaderT (TypeEnv, WarnCtx, Maybe Diag.SourceSpan) (ExceptT String (WriterT [Warning] (StateT Int IO))) a
 
 runCompilerM :: TypeEnv -> CompilerM a -> IO (Either String (a, [Warning]))
 runCompilerM env m =
   do
-    ((r, ws), _) <- runStateT (runWriterT (runExceptT (runReaderT m (env, [])))) 0
+    ((r, ws), _) <- runStateT (runWriterT (runExceptT (runReaderT m (env, [], Nothing)))) 0
     case r of
       Left err -> pure $ Left err
       Right t -> pure $ Right (t, ws)
 
 askTypeEnv :: CompilerM TypeEnv
-askTypeEnv = asks fst
+askTypeEnv = asks (\(typeEnv, _, _) -> typeEnv)
 
 askWarnCtx :: CompilerM WarnCtx
-askWarnCtx = asks snd
+askWarnCtx = asks (\(_, warnCtx, _) -> warnCtx)
+
+askWarnSpan :: CompilerM (Maybe Diag.SourceSpan)
+askWarnSpan = asks (\(_, _, warnSpan) -> warnSpan)
 
 pushCtx :: String -> CompilerM a -> CompilerM a
-pushCtx s = local (\(te, ctx) -> (te, ctx ++ [s]))
+pushCtx s = local (\(te, ctx, warnSpan) -> (te, ctx ++ [s], warnSpan))
+
+withWarnSpan :: Maybe Diag.SourceSpan -> CompilerM a -> CompilerM a
+withWarnSpan sourceSpan =
+  local (\(te, ctx, currentSpan) -> (te, ctx, sourceSpan <|> currentSpan))
 
 lookupConInfo :: Name -> CompilerM ConInfo
 lookupConInfo k = do
@@ -700,7 +712,7 @@ checkRedundancy ctx tys matrix bacts = go [] (zip matrix bacts)
     go _ [] = pure ()
     go prefix ((row, (_, act)) : rest) = do
       useful <- isUseful tys prefix row
-      unless useful $ tell [RedundantClause ctx row act]
+      unless useful $ tell [RedundantClause ctx (sourceSpanOf row) row act]
       go (prefix ++ [row]) rest
 
 -- Maranget's U(P, q): returns True iff row q adds new coverage that no
@@ -800,20 +812,20 @@ inhabitsLitCol matrix ty restTys = do
 -- warnings
 
 data Warning
-  = RedundantClause WarnCtx PatternRow Action
-  | NonExhaustive WarnCtx [Pattern]
+  = RedundantClause WarnCtx (Maybe Diag.SourceSpan) PatternRow Action
+  | NonExhaustive WarnCtx (Maybe Diag.SourceSpan) [Pattern]
   deriving (Eq, Show)
 
 isNonExaustive :: Warning -> Bool
-isNonExaustive (NonExhaustive _ _) = True
+isNonExaustive (NonExhaustive _ _ _) = True
 isNonExaustive _ = False
 
 -- Pretty-print a warning
 
 showWarning :: Warning -> String
-showWarning (RedundantClause ctx row blk) =
+showWarning (RedundantClause ctx _ row blk) =
   unwords ["Warning: Clause ", "(", pretty (row, blk), ") is redundant.", showWarnCtx ctx]
-showWarning (NonExhaustive ctx pats) =
+showWarning (NonExhaustive ctx _ pats) =
   unwords ["Non-exhaustive pattern match. Missing case:", showRow $ nub pats, showWarnCtx ctx]
 
 showWarnCtx :: WarnCtx -> String
@@ -824,30 +836,40 @@ showRow :: [Pattern] -> String
 showRow = intercalate ", " . map pretty
 
 warningDiagnostic :: Warning -> Diag.Diagnostic
-warningDiagnostic (RedundantClause ctx row blk) =
+warningDiagnostic (RedundantClause ctx sourceSpan row blk) =
   Diag.Diagnostic
     { Diag.diagnosticSeverity = Diag.Warning,
       Diag.diagnosticCode = Just (Diag.DiagnosticCode "SC0301"),
       Diag.diagnosticMessage = "redundant pattern clause",
-      Diag.diagnosticLabels = [],
+      Diag.diagnosticLabels = warningLabels "redundant clause" sourceSpan,
       Diag.diagnosticNotes =
         [ "clause: " ++ pretty (row, blk)
         ]
           ++ warningContextNotes ctx,
       Diag.diagnosticHelp = ["remove this clause or make an earlier pattern more specific"]
     }
-warningDiagnostic (NonExhaustive ctx pats) =
+warningDiagnostic (NonExhaustive ctx sourceSpan pats) =
   Diag.Diagnostic
     { Diag.diagnosticSeverity = Diag.Warning,
       Diag.diagnosticCode = Just (Diag.DiagnosticCode "SC0302"),
       Diag.diagnosticMessage = "non-exhaustive pattern match",
-      Diag.diagnosticLabels = [],
+      Diag.diagnosticLabels = warningLabels "non-exhaustive match" sourceSpan,
       Diag.diagnosticNotes =
         ["missing case: " ++ showRow (nub pats)]
           ++ warningContextNotes ctx,
       Diag.diagnosticHelp = ["add a clause that covers the missing case"]
     }
 
+warningLabels :: String -> Maybe Diag.SourceSpan -> [Diag.Label]
+warningLabels _ Nothing = []
+warningLabels message (Just sourceSpan) =
+  [ Diag.Label
+      { Diag.labelSpan = sourceSpan,
+        Diag.labelStyle = Diag.Primary,
+        Diag.labelMessage = Just message
+      }
+  ]
+
 warningAsErrorDiagnostic :: Warning -> Diag.Diagnostic
 warningAsErrorDiagnostic warning =
   (warningDiagnostic warning)
diff --git a/src/Solcore/Frontend/TypeInference/Id.hs b/src/Solcore/Frontend/TypeInference/Id.hs
index 380477092..4fdb64a60 100644
--- a/src/Solcore/Frontend/TypeInference/Id.hs
+++ b/src/Solcore/Frontend/TypeInference/Id.hs
@@ -18,3 +18,6 @@ instance HasType Id where
   fv (Id _ t) = fv t
   mv (Id _ t) = mv t
   bv (Id _ t) = bv t
+
+instance HasSourceSpan Id where
+  sourceSpanOf = sourceSpanOf . idName
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 39906b13d..669badd18 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -401,7 +401,6 @@ diagnosticSearchTerms diagnostic =
           ]
           (diagnosticMessage diagnostic),
         typeMismatchTerms diagnostic,
-        warningSearchTerms diagnostic,
         unknownImportTerms diagnostic,
         moduleReferenceTerms diagnostic,
         duplicateSearchTerms diagnostic,
@@ -466,37 +465,6 @@ typeMismatchTerms diagnostic =
     inPrefix = "in: "
     isSmallNote note = length note <= 80 && '\n' `notElem` note
 
-warningSearchTerms :: Diagnostic -> [String]
-warningSearchTerms diagnostic =
-  case diagnosticCode diagnostic of
-    Just (DiagnosticCode "SC0301") ->
-      uniqueStrings (clauseSearchTerms diagnostic ++ matchContextTerms diagnostic)
-    Just (DiagnosticCode "SC0302") ->
-      uniqueStrings (matchContextTerms diagnostic)
-    _ -> []
-
-clauseSearchTerms :: Diagnostic -> [String]
-clauseSearchTerms diagnostic =
-  concatMap clauseTerms (diagnosticNotes diagnostic)
-  where
-    clauseTerms note = do
-      rest <- maybeToList (stripPrefix "clause: " note)
-      let clauseLine = takeWhile (/= '\n') rest
-          rowText =
-            trim $
-              takeWhile (/= '=') $
-                dropWhile (== '|') $
-                  trim (stripPrettyTypeAnnotations clauseLine)
-      rowText : splitCommaTerms rowText
-
-matchContextTerms :: Diagnostic -> [String]
-matchContextTerms diagnostic =
-  concatMap matchTerm (diagnosticNotes diagnostic)
-  where
-    matchTerm note
-      | "in: match" `isPrefixOf` note = ["match"]
-      | otherwise = []
-
 unknownImportTerms :: Diagnostic -> [String]
 unknownImportTerms diagnostic =
   concatMap itemTerms (allDiagnosticText diagnostic)
@@ -690,19 +658,6 @@ dropAt :: String -> String
 dropAt ('@' : rest) = rest
 dropAt path = path
 
-splitCommaTerms :: String -> [String]
-splitCommaTerms raw =
-  case break (== ',') raw of
-    (term, []) -> [trim term]
-    (term, _ : rest) -> trim term : splitCommaTerms rest
-
-stripPrettyTypeAnnotations :: String -> String
-stripPrettyTypeAnnotations [] = []
-stripPrettyTypeAnnotations ('<' : rest) =
-  stripPrettyTypeAnnotations (drop 1 (dropWhile (/= '>') rest))
-stripPrettyTypeAnnotations (c : rest) =
-  c : stripPrettyTypeAnnotations rest
-
 uniqueStrings :: [String] -> [String]
 uniqueStrings =
   nub . filter (not . null) . map trim
diff --git a/test/MatchCompilerTests.hs b/test/MatchCompilerTests.hs
index 0f61b005b..fb8863296 100644
--- a/test/MatchCompilerTests.hs
+++ b/test/MatchCompilerTests.hs
@@ -133,11 +133,11 @@ assertLeft label act = do
       assertFailure (label ++ ": expected error but got tree: " ++ show tree)
 
 isNonExh :: Warning -> Bool
-isNonExh (NonExhaustive _ _) = True
+isNonExh (NonExhaustive _ _ _) = True
 isNonExh _ = False
 
 isRedundant :: Warning -> Bool
-isRedundant (RedundantClause _ _ _) = True
+isRedundant (RedundantClause _ _ _ _) = True
 isRedundant _ = False
 
 branchNames :: [(Id, [Pattern], DecisionTree)] -> [String]
@@ -298,7 +298,7 @@ test_redundantVarRow_emitsRedundantClause =
       case tree of
         Leaf _ _ -> pure ()
         _ -> assertFailure ("expected Leaf for all-var first row, got: " ++ show tree)
-      let redundantActs = [act | RedundantClause _ _ act <- warns]
+      let redundantActs = [act | RedundantClause _ _ _ act <- warns]
       assertBool "True clause must be warned as unreachable" (actionB `elem` redundantActs)
       assertBool "False clause must be warned as unreachable" (actionC `elem` redundantActs)
       assertBool "first all-var row must not be warned as redundant" (actionA `notElem` redundantActs)
@@ -583,7 +583,7 @@ test_allVar_first_shadows_nonexhaustive_rest =
       case tree of
         Leaf _ _ -> pure ()
         _ -> assertFailure ("expected Leaf, got: " ++ show tree)
-      let redundantActs = [act | RedundantClause _ _ act <- warns]
+      let redundantActs = [act | RedundantClause _ _ _ act <- warns]
       assertBool "True clause must be warned as unreachable" (actionB `elem` redundantActs)
       assertBool "first all-var row must not be warned" (actionA `notElem` redundantActs)
 
@@ -607,7 +607,7 @@ test_twoCol_noFalsePositive_partialOverlap =
           [actionA, actionB, actionC]
       )
     $ \_ warns -> do
-      let redundantActs = [act | RedundantClause _ _ act <- warns]
+      let redundantActs = [act | RedundantClause _ _ _ act <- warns]
       assertBool "row 1 (w,True) must NOT be warned as redundant" (actionB `notElem` redundantActs)
       assertBool "row 2 (a,b) must NOT be warned as redundant" (actionC `notElem` redundantActs)
       assertBool "no RedundantClause warnings at all" (null redundantActs)
@@ -631,7 +631,7 @@ test_twoCol_genuinelyRedundant_thirdRow =
           [actionA, actionB, actionC]
       )
     $ \_ warns -> do
-      let redundantActs = [act | RedundantClause _ _ act <- warns]
+      let redundantActs = [act | RedundantClause _ _ _ act <- warns]
       assertBool "row 2 (z,True) must be warned as redundant" (actionC `elem` redundantActs)
       assertBool "row 0 must not be warned" (actionA `notElem` redundantActs)
       assertBool "row 1 must not be warned" (actionB `notElem` redundantActs)
@@ -650,7 +650,7 @@ test_singleCol_duplicateRow_warned =
           [actionA, actionB, actionC]
       )
     $ \_ warns -> do
-      let redundantActs = [act | RedundantClause _ _ act <- warns]
+      let redundantActs = [act | RedundantClause _ _ _ act <- warns]
       assertBool "second True must be warned as redundant" (actionB `elem` redundantActs)
       assertBool "False must not be warned as redundant" (actionC `notElem` redundantActs)
       assertBool "first True must not be warned" (actionA `notElem` redundantActs)
@@ -674,7 +674,7 @@ test_twoCol_con_nonExh_witness_has_both_columns =
           [actionA]
       )
     $ \_ warns -> do
-      let nonExhPats = [pats | NonExhaustive _ pats <- warns]
+      let nonExhPats = [pats | NonExhaustive _ _ pats <- warns]
       case nonExhPats of
         [] -> assertFailure "expected a NonExhaustive warning"
         (pats : _) -> do
@@ -707,7 +707,7 @@ test_twoCol_lit_nonExh_witness_has_both_columns =
           [actionA]
       )
     $ \_ warns -> do
-      let nonExhPats = [pats | NonExhaustive _ pats <- warns]
+      let nonExhPats = [pats | NonExhaustive _ _ pats <- warns]
       case nonExhPats of
         [] -> assertFailure "expected a NonExhaustive warning"
         (pats : _) ->
@@ -817,7 +817,7 @@ test_nonExh_polyEnv_missingNil_witness_is_Nil =
           [actionA]
       )
     $ \_ warns -> do
-      let nonExhPats = [pats | NonExhaustive _ pats <- warns]
+      let nonExhPats = [pats | NonExhaustive _ _ pats <- warns]
       case nonExhPats of
         [] -> assertFailure "expected a NonExhaustive warning"
         (pats : _) -> case pats of
@@ -848,7 +848,7 @@ test_nonExh_polyEnv_missingCons_witness_is_Cons =
           [actionA]
       )
     $ \_ warns -> do
-      let nonExhPats = [pats | NonExhaustive _ pats <- warns]
+      let nonExhPats = [pats | NonExhaustive _ _ pats <- warns]
       case nonExhPats of
         [] -> assertFailure "expected a NonExhaustive warning"
         (pats : _) -> case pats of

From 68e400873f39a854245483a04e7d9c171a22d5fa Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 17:21:55 +0200
Subject: [PATCH 34/35] Test location preservation across passes

---
 src/Solcore/Diagnostics.hs                    |   2 +-
 src/Solcore/Frontend/Syntax/NameResolution.hs | 447 +++++++++---------
 src/Solcore/Frontend/Syntax/Stmt.hs           |   2 +-
 src/Solcore/Frontend/Syntax/SyntaxTree.hs     |   2 +-
 src/Solcore/Frontend/TypeInference/TcMonad.hs |   6 +-
 src/Solcore/Pipeline/SolcorePipeline.hs       |  14 +-
 test/LocationTests.hs                         | 126 ++++-
 test/ModuleTypeCheckTests.hs                  |   2 +-
 8 files changed, 360 insertions(+), 241 deletions(-)

diff --git a/src/Solcore/Diagnostics.hs b/src/Solcore/Diagnostics.hs
index 26a440556..7c8341bc0 100644
--- a/src/Solcore/Diagnostics.hs
+++ b/src/Solcore/Diagnostics.hs
@@ -252,7 +252,7 @@ findTextSpansInSource source needle
           spanStartColumn = column,
           spanEndLine = lineNo,
           spanEndColumn = column + needleLen
-      }
+        }
 
 combineSourceSpans :: SourceSpan -> SourceSpan -> SourceSpan
 combineSourceSpans left right
diff --git a/src/Solcore/Frontend/Syntax/NameResolution.hs b/src/Solcore/Frontend/Syntax/NameResolution.hs
index 9ae409026..033461f72 100644
--- a/src/Solcore/Frontend/Syntax/NameResolution.hs
+++ b/src/Solcore/Frontend/Syntax/NameResolution.hs
@@ -528,252 +528,252 @@ instance Resolve S.Exp where
 resolveExp :: S.Exp -> ResolveM (Exp Name)
 resolveExp (S.Lit l) = Lit <$> resolve l
 resolveExp e@(S.ExpDotName n es) =
-    Con (dotConstructorMarker n) <$> resolve es `wrapError` e
+  Con (dotConstructorMarker n) <$> resolve es `wrapError` e
 resolveExp e@(S.Lam ps bd mt) =
-    withLocalCtx $ do
-      ps' <- resolve ps `wrapError` e
-      mt' <- resolve mt `wrapError` e
-      let args = map paramName ps'
-      mapM_ addParameter args
-      bd' <- resolve bd `wrapError` e
-      pure (Lam ps' bd' mt')
+  withLocalCtx $ do
+    ps' <- resolve ps `wrapError` e
+    mt' <- resolve mt `wrapError` e
+    let args = map paramName ps'
+    mapM_ addParameter args
+    bd' <- resolve bd `wrapError` e
+    pure (Lam ps' bd' mt')
 resolveExp (S.TyExp e t) =
-    TyExp <$> resolve e <*> resolve t
+  TyExp <$> resolve e <*> resolve t
 resolveExp c@(S.ExpVar me n) =
-    do
-      me' <- resolve me `wrapError` c
-      dt <- lookupName n
-      case (me', dt) of
-        -- local variables
-        (_, Just TLocalVar) -> pure (Var n)
-        -- function parameters
-        (_, Just TParameter) -> pure (Var n)
-        -- field access
-        (Nothing, Just TField) ->
-          pure (FieldAccess Nothing n)
-        -- function reference
-        (_, Just TFunction) -> do
-          dt1 <- gets (Map.lookup n . fieldEnv)
-          case dt1 of
-            Just TField -> pure (FieldAccess Nothing n)
-            _ -> pure (Var n)
-        -- data constructor
-        (Nothing, Just TDataCon) -> do
-          if isPrimitiveConstructor n
-            then pure (Con n [])
-            else case splitQualifiedName n of
-              Just (qualifier, conName) ->
-                Con <$> resolveQualifiedConstructorName qualifier conName <*> pure []
-              Nothing -> unqualifiedConstructorError n
-        (Just (Var d), Just TDataCon) ->
-          Con <$> resolveQualifiedConstructorName d n <*> pure []
-        (Just (Var d), Just TTyCon) -> do
-          let qn = qualifyName d n
-          qdt <- lookupName qn
-          case qdt of
-            Just TFunction -> pure (Var qn)
-            Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
-            Just TTyCon -> pure (Var qn)
-            Just TModule -> pure (Var qn)
-            _ -> undefinedName n
-        -- class name
-        (_, Just TClass) -> pure (Var n)
-        -- type constructor used as a constructor qualifier
-        (Nothing, Just TTyCon) -> do
-          sameName <- isSameNameConstructor n
-          if sameName
-            then Con <$> resolveSameNameConstructorName n <*> pure []
-            else pure (Var n)
-        -- imported module qualifier name
-        (_, Just TModule) -> pure (Var n)
-        -- module-qualified function or constructor reference
-        (Just (Var d), Nothing) -> do
-          let qn = qualifyName d n
-          qdt <- lookupName qn
-          case qdt of
-            Just TFunction -> pure (Var qn)
-            Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
-            Just TTyCon -> pure (Var qn)
-            Just TModule -> pure (Var qn)
-            _ -> do
-              let fallback = qualifyName (constructorLeafName d) n
-              fdt <- lookupName fallback
-              case fdt of
-                Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
-                _ -> undefinedName n
-        _ -> do
-          sameName <- isSameNameConstructor n
-          if sameName
-            then Con <$> resolveSameNameConstructorName n <*> pure []
-            else do
-              hasQualified <- hasQualifiedConstructorLeaf n
-              if hasQualified
-                then unqualifiedConstructorError n
-                else undefinedName n
+  do
+    me' <- resolve me `wrapError` c
+    dt <- lookupName n
+    case (me', dt) of
+      -- local variables
+      (_, Just TLocalVar) -> pure (Var n)
+      -- function parameters
+      (_, Just TParameter) -> pure (Var n)
+      -- field access
+      (Nothing, Just TField) ->
+        pure (FieldAccess Nothing n)
+      -- function reference
+      (_, Just TFunction) -> do
+        dt1 <- gets (Map.lookup n . fieldEnv)
+        case dt1 of
+          Just TField -> pure (FieldAccess Nothing n)
+          _ -> pure (Var n)
+      -- data constructor
+      (Nothing, Just TDataCon) -> do
+        if isPrimitiveConstructor n
+          then pure (Con n [])
+          else case splitQualifiedName n of
+            Just (qualifier, conName) ->
+              Con <$> resolveQualifiedConstructorName qualifier conName <*> pure []
+            Nothing -> unqualifiedConstructorError n
+      (Just (Var d), Just TDataCon) ->
+        Con <$> resolveQualifiedConstructorName d n <*> pure []
+      (Just (Var d), Just TTyCon) -> do
+        let qn = qualifyName d n
+        qdt <- lookupName qn
+        case qdt of
+          Just TFunction -> pure (Var qn)
+          Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
+          Just TTyCon -> pure (Var qn)
+          Just TModule -> pure (Var qn)
+          _ -> undefinedName n
+      -- class name
+      (_, Just TClass) -> pure (Var n)
+      -- type constructor used as a constructor qualifier
+      (Nothing, Just TTyCon) -> do
+        sameName <- isSameNameConstructor n
+        if sameName
+          then Con <$> resolveSameNameConstructorName n <*> pure []
+          else pure (Var n)
+      -- imported module qualifier name
+      (_, Just TModule) -> pure (Var n)
+      -- module-qualified function or constructor reference
+      (Just (Var d), Nothing) -> do
+        let qn = qualifyName d n
+        qdt <- lookupName qn
+        case qdt of
+          Just TFunction -> pure (Var qn)
+          Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
+          Just TTyCon -> pure (Var qn)
+          Just TModule -> pure (Var qn)
+          _ -> do
+            let fallback = qualifyName (constructorLeafName d) n
+            fdt <- lookupName fallback
+            case fdt of
+              Just TDataCon -> Con <$> resolveQualifiedConstructorName d n <*> pure []
+              _ -> undefinedName n
+      _ -> do
+        sameName <- isSameNameConstructor n
+        if sameName
+          then Con <$> resolveSameNameConstructorName n <*> pure []
+          else do
+            hasQualified <- hasQualifiedConstructorLeaf n
+            if hasQualified
+              then unqualifiedConstructorError n
+              else undefinedName n
 resolveExp x@(S.ExpName me n es) =
-    do
-      me' <- resolve me `wrapError` x
-      es' <- resolve es `wrapError` x
-      dt <- lookupName n
-      case (me', dt) of
-        -- normal function call
-        (Nothing, Just TFunction) ->
-          pure (Call Nothing n es')
-        (Nothing, Just TTyCon) -> do
-          sameName <- isSameNameConstructor n
-          if sameName
-            then Con <$> resolveSameNameConstructorName n <*> pure es'
-            else undefinedName n
-        -- data constructors
-        (Nothing, Just TDataCon) -> do
-          if isPrimitiveConstructor n
-            then pure (Con n es')
-            else case splitQualifiedName n of
-              Just (qualifier, conName) ->
-                Con <$> resolveQualifiedConstructorName qualifier conName <*> pure es'
-              Nothing -> unqualifiedConstructorError n
-        (Just (Var d), Just TDataCon) ->
-          Con <$> resolveQualifiedConstructorName d n <*> pure es'
-        (Just (Var c), Just TTyCon) -> do
-          let qn = qualifyName c n
-          qdt <- lookupName qn
-          case qdt of
-            Just TFunction -> pure (Call Nothing qn es')
-            Just TDataCon -> Con <$> resolveQualifiedConstructorName c n <*> pure es'
-            _ -> undefinedName n
-        -- class functions
-        (Just (Var c), Just TFunction) -> do
-          ct <- lookupName c
-          let qn = qualifyName c n
-          case ct of
-            Just TClass ->
-              pure (Call Nothing qn es')
-            Just TModule -> do
-              cf <- lookupName qn
-              case cf of
-                Just TFunction -> pure (Call Nothing qn es')
-                Just TDataCon -> Con <$> resolveQualifiedConstructorName c n <*> pure es'
-                _ -> undefinedName n
-            _ -> undefinedName c
-        (Just (Var c), Nothing) -> do
-          ct <- lookupName c
-          let qn = qualifyName c n
-          cf <- lookupName qn
-          case (ct, cf) of
-            (Just TClass, Just TFunction) ->
-              pure (Call Nothing qn es')
-            (_, Just TFunction) ->
-              pure (Call Nothing qn es')
-            (_, Just TDataCon) ->
-              Con <$> resolveQualifiedConstructorName c n <*> pure es'
-            _ -> do
-              let fallback = qualifyName (constructorLeafName c) n
-              fdt <- lookupName fallback
-              case fdt of
-                Just TDataCon ->
-                  Con <$> resolveQualifiedConstructorName c n <*> pure es'
-                _ -> undefinedName n
-        (Just (Var c), Just TTyVar) -> do
-          let qn = qualifyName c n
-          cf <- gets (Map.lookup qn . scopeEnv)
-          case cf of
-            Just TFunction -> pure (Call Nothing qn es')
-            _ -> undefinedName n
-        -- variables
-        (_, Just TLocalVar) ->
-          pure (Call Nothing n es')
-        (_, Just TParameter) ->
-          pure (Call Nothing n es')
-        -- error
-        _ -> do
-          sameName <- isSameNameConstructor n
-          if sameName
-            then Con <$> resolveSameNameConstructorName n <*> pure es'
-            else do
-              hasQualified <- hasQualifiedConstructorLeaf n
-              if hasQualified
-                then unqualifiedConstructorError n
-                else undefinedName n
+  do
+    me' <- resolve me `wrapError` x
+    es' <- resolve es `wrapError` x
+    dt <- lookupName n
+    case (me', dt) of
+      -- normal function call
+      (Nothing, Just TFunction) ->
+        pure (Call Nothing n es')
+      (Nothing, Just TTyCon) -> do
+        sameName <- isSameNameConstructor n
+        if sameName
+          then Con <$> resolveSameNameConstructorName n <*> pure es'
+          else undefinedName n
+      -- data constructors
+      (Nothing, Just TDataCon) -> do
+        if isPrimitiveConstructor n
+          then pure (Con n es')
+          else case splitQualifiedName n of
+            Just (qualifier, conName) ->
+              Con <$> resolveQualifiedConstructorName qualifier conName <*> pure es'
+            Nothing -> unqualifiedConstructorError n
+      (Just (Var d), Just TDataCon) ->
+        Con <$> resolveQualifiedConstructorName d n <*> pure es'
+      (Just (Var c), Just TTyCon) -> do
+        let qn = qualifyName c n
+        qdt <- lookupName qn
+        case qdt of
+          Just TFunction -> pure (Call Nothing qn es')
+          Just TDataCon -> Con <$> resolveQualifiedConstructorName c n <*> pure es'
+          _ -> undefinedName n
+      -- class functions
+      (Just (Var c), Just TFunction) -> do
+        ct <- lookupName c
+        let qn = qualifyName c n
+        case ct of
+          Just TClass ->
+            pure (Call Nothing qn es')
+          Just TModule -> do
+            cf <- lookupName qn
+            case cf of
+              Just TFunction -> pure (Call Nothing qn es')
+              Just TDataCon -> Con <$> resolveQualifiedConstructorName c n <*> pure es'
+              _ -> undefinedName n
+          _ -> undefinedName c
+      (Just (Var c), Nothing) -> do
+        ct <- lookupName c
+        let qn = qualifyName c n
+        cf <- lookupName qn
+        case (ct, cf) of
+          (Just TClass, Just TFunction) ->
+            pure (Call Nothing qn es')
+          (_, Just TFunction) ->
+            pure (Call Nothing qn es')
+          (_, Just TDataCon) ->
+            Con <$> resolveQualifiedConstructorName c n <*> pure es'
+          _ -> do
+            let fallback = qualifyName (constructorLeafName c) n
+            fdt <- lookupName fallback
+            case fdt of
+              Just TDataCon ->
+                Con <$> resolveQualifiedConstructorName c n <*> pure es'
+              _ -> undefinedName n
+      (Just (Var c), Just TTyVar) -> do
+        let qn = qualifyName c n
+        cf <- gets (Map.lookup qn . scopeEnv)
+        case cf of
+          Just TFunction -> pure (Call Nothing qn es')
+          _ -> undefinedName n
+      -- variables
+      (_, Just TLocalVar) ->
+        pure (Call Nothing n es')
+      (_, Just TParameter) ->
+        pure (Call Nothing n es')
+      -- error
+      _ -> do
+        sameName <- isSameNameConstructor n
+        if sameName
+          then Con <$> resolveSameNameConstructorName n <*> pure es'
+          else do
+            hasQualified <- hasQualifiedConstructorLeaf n
+            if hasQualified
+              then unqualifiedConstructorError n
+              else undefinedName n
 resolveExp c@(S.ExpPlus e1 e2) =
-    do
-      e1' <- resolve e1 `wrapError` c
-      e2' <- resolve e2 `wrapError` c
-      let fun = QualName (Name "Add") "add"
-      pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpMinus e1 e2) =
-    do
-      e1' <- resolve e1 `wrapError` c
-      e2' <- resolve e2 `wrapError` c
-      let fun = QualName (Name "Sub") "sub"
-      pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpTimes e1 e2) =
-    do
-      e1' <- resolve e1 `wrapError` c
-      e2' <- resolve e2 `wrapError` c
-      let fun = QualName (Name "Mul") "mul"
-      pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpDivide e1 e2) =
-    do
-      e1' <- resolve e1 `wrapError` c
-      e2' <- resolve e2 `wrapError` c
-      let fun = QualName (Name "Div") "div"
-      pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpModulo e1 e2) =
-    do
-      e1' <- resolve e1 `wrapError` c
-      e2' <- resolve e2 `wrapError` c
-      let fun = QualName (Name "Mod") "mod"
-      pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpIndexed array idx) = do
-    arr' <- resolve array `wrapError` c
-    idx' <- resolve idx `wrapError` c
-    pure $ Indexed arr' idx'
-resolveExp c@(S.ExpLT e1 e2) = do
+  do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "lt") [e1', e2']
-resolveExp c@(S.ExpGT e1 e2) = do
+    let fun = QualName (Name "Add") "add"
+    pure $ Call Nothing fun [e1', e2']
+resolveExp c@(S.ExpMinus e1 e2) =
+  do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
-    let fun = QualName (Name "Ord") "gt"
+    let fun = QualName (Name "Sub") "sub"
     pure $ Call Nothing fun [e1', e2']
-resolveExp c@(S.ExpLE e1 e2) = do
+resolveExp c@(S.ExpTimes e1 e2) =
+  do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "le") [e1', e2']
-resolveExp c@(S.ExpGE e1 e2) = do
+    let fun = QualName (Name "Mul") "mul"
+    pure $ Call Nothing fun [e1', e2']
+resolveExp c@(S.ExpDivide e1 e2) =
+  do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "ge") [e1', e2']
-resolveExp c@(S.ExpEE e1 e2) = do
+    let fun = QualName (Name "Div") "div"
+    pure $ Call Nothing fun [e1', e2']
+resolveExp c@(S.ExpModulo e1 e2) =
+  do
     e1' <- resolve e1 `wrapError` c
     e2' <- resolve e2 `wrapError` c
-    let fun = QualName (Name "Eq") "eq"
+    let fun = QualName (Name "Mod") "mod"
     pure $ Call Nothing fun [e1', e2']
+resolveExp c@(S.ExpIndexed array idx) = do
+  arr' <- resolve array `wrapError` c
+  idx' <- resolve idx `wrapError` c
+  pure $ Indexed arr' idx'
+resolveExp c@(S.ExpLT e1 e2) = do
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "lt") [e1', e2']
+resolveExp c@(S.ExpGT e1 e2) = do
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  let fun = QualName (Name "Ord") "gt"
+  pure $ Call Nothing fun [e1', e2']
+resolveExp c@(S.ExpLE e1 e2) = do
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "le") [e1', e2']
+resolveExp c@(S.ExpGE e1 e2) = do
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "ge") [e1', e2']
+resolveExp c@(S.ExpEE e1 e2) = do
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  let fun = QualName (Name "Eq") "eq"
+  pure $ Call Nothing fun [e1', e2']
 resolveExp c@(S.ExpNE e1 e2) = do
-    e1' <- resolve e1 `wrapError` c
-    e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "ne") [e1', e2']
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "ne") [e1', e2']
 resolveExp c@(S.ExpLAnd e1 e2) = do
-    e1' <- resolve e1 `wrapError` c
-    e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "and") [e1', e2']
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "and") [e1', e2']
 resolveExp c@(S.ExpLOr e1 e2) = do
-    e1' <- resolve e1 `wrapError` c
-    e2' <- resolve e2 `wrapError` c
-    pure $ Call Nothing (Name "or") [e1', e2']
+  e1' <- resolve e1 `wrapError` c
+  e2' <- resolve e2 `wrapError` c
+  pure $ Call Nothing (Name "or") [e1', e2']
 resolveExp c@(S.ExpLNot e) = do
-    e' <- resolve e `wrapError` c
-    pure $ Call Nothing (Name "not") [e']
+  e' <- resolve e `wrapError` c
+  pure $ Call Nothing (Name "not") [e']
 resolveExp (S.ExpCond e1 e2 e3) =
-    Cond <$> resolve e1 <*> resolve e2 <*> resolve e3
+  Cond <$> resolve e1 <*> resolve e2 <*> resolve e3
 resolveExp (S.ExpAt t) = do
-    t' <- resolve t
-    pure
-      ( TyExp
-          (Con (Name "Proxy") [])
-          (TyCon (Name "Proxy") [t'])
-      )
+  t' <- resolve t
+  pure
+    ( TyExp
+        (Con (Name "Proxy") [])
+        (TyCon (Name "Proxy") [t'])
+    )
 
 instance Resolve S.Literal where
   type Result S.Literal = Literal
@@ -1219,7 +1219,6 @@ diagnosticValue code message labels notes help =
       diagnosticHelp = help
     }
 
-
 primaryNameLabel :: String -> Name -> Maybe Label
 primaryNameLabel message identName =
   do
diff --git a/src/Solcore/Frontend/Syntax/Stmt.hs b/src/Solcore/Frontend/Syntax/Stmt.hs
index 2da689c1f..eda3d48ee 100644
--- a/src/Solcore/Frontend/Syntax/Stmt.hs
+++ b/src/Solcore/Frontend/Syntax/Stmt.hs
@@ -4,10 +4,10 @@ module Solcore.Frontend.Syntax.Stmt where
 
 import Data.Generics (Data, Typeable)
 import Language.Yul
-import Prelude hiding (exp)
 import Solcore.Diagnostics (SourceSpan)
 import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Ty
+import Prelude hiding (exp)
 
 -- definition of statements
 
diff --git a/src/Solcore/Frontend/Syntax/SyntaxTree.hs b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
index 9c29626ea..8d0d7923b 100644
--- a/src/Solcore/Frontend/Syntax/SyntaxTree.hs
+++ b/src/Solcore/Frontend/Syntax/SyntaxTree.hs
@@ -6,10 +6,10 @@ import Data.Generics (Data, Typeable)
 import Data.List (union)
 import Data.List.NonEmpty
 import Language.Yul
-import Prelude hiding (exp)
 import Solcore.Diagnostics (SourceSpan)
 import Solcore.Frontend.Syntax.Location
 import Solcore.Frontend.Syntax.Name
+import Prelude hiding (exp)
 
 -- compilation unit
 
diff --git a/src/Solcore/Frontend/TypeInference/TcMonad.hs b/src/Solcore/Frontend/TypeInference/TcMonad.hs
index d8381e97b..a473f4261 100644
--- a/src/Solcore/Frontend/TypeInference/TcMonad.hs
+++ b/src/Solcore/Frontend/TypeInference/TcMonad.hs
@@ -871,9 +871,9 @@ primaryNameLabel message identName =
     pure
       Label
         { labelSpan = sourceSpan,
-        labelStyle = Primary,
-        labelMessage = Just message
-      }
+          labelStyle = Primary,
+          labelMessage = Just message
+        }
 
 primarySourceLabel :: (HasSourceSpan source) => String -> source -> Maybe Label
 primarySourceLabel message source =
diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs
index 669badd18..bb335d4a0 100644
--- a/src/Solcore/Pipeline/SolcorePipeline.hs
+++ b/src/Solcore/Pipeline/SolcorePipeline.hs
@@ -1,7 +1,7 @@
 module Solcore.Pipeline.SolcorePipeline where
 
-import Control.Monad
 import Control.Applicative ((<|>))
+import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Data.Bifunctor (first)
@@ -26,9 +26,9 @@ import Solcore.Desugarer.IndirectCall (indirectCallTopDecls)
 import Solcore.Desugarer.ReplaceFunTypeArgs
 import Solcore.Desugarer.ReplaceWildcard (replaceWildcardTopDecls)
 import Solcore.Diagnostics
-  ( Diagnostic (..),
+  ( CompilerError (..),
+    Diagnostic (..),
     DiagnosticCode (..),
-    CompilerError (..),
     Label (..),
     LabelStyle (..),
     Severity (..),
@@ -37,13 +37,13 @@ import Solcore.Diagnostics
     SourceSpan (..),
     addDiagnosticHelp,
     addDiagnosticNote,
-    diagnosticMessage,
-    diagnosticPrimarySpan,
-    defaultDiagnosticRenderOptions,
-    emptySourceMap,
     compilerErrorDiagnostics,
     compilerErrorFromString,
     compilerErrorText,
+    defaultDiagnosticRenderOptions,
+    diagnosticMessage,
+    diagnosticPrimarySpan,
+    emptySourceMap,
     findTextSpansInSource,
     findTokenSpansInSource,
     insertSourceFile,
diff --git a/test/LocationTests.hs b/test/LocationTests.hs
index cfdc39a93..3691b9b50 100644
--- a/test/LocationTests.hs
+++ b/test/LocationTests.hs
@@ -3,10 +3,18 @@ module LocationTests
   )
 where
 
-import Solcore.Diagnostics (SourceSpan (..))
+import Data.Generics (Data, everything, mkQ)
+import Data.Maybe (mapMaybe)
+import Data.Set qualified as Set
+import Solcore.Diagnostics (CompilerError, SourceSpan (..), compilerErrorText)
 import Solcore.Frontend.Parser.SolcoreParser (parseCompUnitWithPath)
+import Solcore.Frontend.Syntax qualified as Typed
 import Solcore.Frontend.Syntax.Location
-import Solcore.Frontend.Syntax.SyntaxTree ()
+import Solcore.Frontend.Syntax.NameResolution (nameResolution)
+import Solcore.Frontend.Syntax.SyntaxTree qualified as Parsed
+import Solcore.Frontend.TypeInference.SccAnalysis (sccAnalysis)
+import Solcore.Frontend.TypeInference.TcModule
+import Solcore.Pipeline.Options (noDesugarOpt)
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -15,7 +23,10 @@ locationTests =
   testGroup
     "Syntax locations"
     [ testCase "parsed nodes carry source locations" test_parsedNodesCarrySourceLocations,
-      testCase "generated nodes are explicit" test_generatedNodesAreExplicit
+      testCase "generated nodes are explicit" test_generatedNodesAreExplicit,
+      testCase "name resolution preserves source locations" test_nameResolutionPreservesSourceLocations,
+      testCase "SCC analysis preserves source locations" test_sccAnalysisPreservesSourceLocations,
+      testCase "type inference preserves source locations" test_typeInferencePreservesSourceLocations
     ]
 
 test_parsedNodesCarrySourceLocations :: Assertion
@@ -35,10 +46,97 @@ test_generatedNodesAreExplicit = do
   assertEqual "generated source span" Nothing (nodeLocationSpan unlocatedNode)
   assertEqual "source node span" (Just sampleSpan) (nodeLocationSpan (locatedNode sampleSpan))
 
+test_nameResolutionPreservesSourceLocations :: Assertion
+test_nameResolutionPreservesSourceLocations = do
+  parsed <- parseUnit "location-name-resolution.solc" transformSource
+  resolved <- assertCompilerRight "name resolution" (nameResolution parsed)
+  assertSpansPreserved "name resolution" parsed resolved
+  assertNoGeneratedNodeLocations "name resolution" resolved
+
+test_sccAnalysisPreservesSourceLocations :: Assertion
+test_sccAnalysisPreservesSourceLocations = do
+  parsed <- parseUnit "location-scc.solc" mutualSource
+  resolved <- assertCompilerRight "name resolution" (nameResolution parsed)
+  grouped <- assertEitherRight "SCC analysis" =<< sccAnalysis resolved
+  assertBool "SCC analysis should create a mutual group" (any isMutualDecl (Typed.contracts grouped))
+  assertSpansPreserved "SCC analysis" resolved grouped
+  assertNoGeneratedNodeLocations "SCC analysis" grouped
+
+test_typeInferencePreservesSourceLocations :: Assertion
+test_typeInferencePreservesSourceLocations = do
+  parsed <- parseUnit "location-type-inference.solc" transformSource
+  resolved <- assertCompilerRight "name resolution" (nameResolution parsed)
+  (typedUnit, _) <-
+    assertCompilerRight
+      "type inference"
+      (typeInferModuleLocals noDesugarOpt (moduleInputFromUnit resolved))
+  assertSpansPreserved "type inference" resolved typedUnit
+
 hasSourceSpan :: (HasSourceSpan a) => a -> Bool
 hasSourceSpan =
   maybe False (const True) . sourceSpanOf
 
+parseUnit :: FilePath -> String -> IO Parsed.CompUnit
+parseUnit path source = do
+  parsed <- parseCompUnitWithPath path source
+  case parsed of
+    Left err -> assertFailure err
+    Right cunit -> pure cunit
+
+assertCompilerRight :: String -> IO (Either CompilerError a) -> IO a
+assertCompilerRight label action = do
+  result <- action
+  case result of
+    Left err -> assertFailure (label ++ " failed:\n" ++ compilerErrorText err)
+    Right value -> pure value
+
+assertEitherRight :: String -> Either String a -> IO a
+assertEitherRight label result =
+  case result of
+    Left err -> assertFailure (label ++ " failed:\n" ++ err)
+    Right value -> pure value
+
+assertSpansPreserved :: (Data source, Data target) => String -> source -> target -> Assertion
+assertSpansPreserved label source target = do
+  let sourceSpans = Set.fromList (sourceSpansOf source)
+      targetSpans = Set.fromList (sourceSpansOf target)
+      introduced = Set.toList (targetSpans `Set.difference` sourceSpans)
+  assertBool (label ++ " should keep source spans") (not (Set.null targetSpans))
+  assertEqual (label ++ " introduced non-input source spans") [] introduced
+
+assertNoGeneratedNodeLocations :: (Data a) => String -> a -> Assertion
+assertNoGeneratedNodeLocations label value =
+  assertEqual
+    (label ++ " generated node locations")
+    []
+    (filter isGeneratedNodeLocation (nodeLocationsOf value))
+
+sourceSpansOf :: (Data a) => a -> [SourceSpan]
+sourceSpansOf value =
+  mapMaybe nodeLocationSpan (nodeLocationsOf value)
+    ++ everything (++) (mkQ [] nameSpan) value
+  where
+    nameSpan :: Typed.Name -> [SourceSpan]
+    nameSpan name = maybe [] pure (sourceSpanOf name)
+
+moduleInputFromUnit :: Typed.CompUnit Typed.Name -> ModuleTypeCheckInput
+moduleInputFromUnit unit =
+  withPreparedModuleInferenceDecls resolvedInput (moduleInitialInferenceDecls resolvedInput)
+  where
+    resolvedInput =
+      ModuleResolvedTypeCheckInput
+        { moduleResolvedInputImports = Typed.imports unit,
+          moduleResolvedInputQualifiedDecls = [],
+          moduleResolvedInputLocalDecls = Typed.contracts unit,
+          moduleResolvedInputImportedDecls = [],
+          moduleResolvedInputTrustedInstanceHeads = [],
+          moduleResolvedInputPartialImportedTypes = []
+        }
+
+isMutualDecl :: Typed.TopDecl a -> Bool
+isMutualDecl (Typed.TMutualDef _) = True
+isMutualDecl _ = False
+
 sampleSpan :: SourceSpan
 sampleSpan =
   SourceSpan
@@ -63,3 +161,25 @@ locatedSource =
       "  }",
       "}"
     ]
+
+transformSource :: String
+transformSource =
+  unlines
+    [ "function id(x : word) -> word {",
+      "  return x;",
+      "}",
+      "function passthrough(y : word) -> word {",
+      "  return id(y);",
+      "}"
+    ]
+
+mutualSource :: String
+mutualSource =
+  unlines
+    [ "function first(x : word) -> word {",
+      "  return second(x);",
+      "}",
+      "function second(x : word) -> word {",
+      "  return first(x);",
+      "}"
+    ]
diff --git a/test/ModuleTypeCheckTests.hs b/test/ModuleTypeCheckTests.hs
index 3ff98101b..3c9f9ad1e 100644
--- a/test/ModuleTypeCheckTests.hs
+++ b/test/ModuleTypeCheckTests.hs
@@ -3,9 +3,9 @@ module ModuleTypeCheckTests
   )
 where
 
+import Solcore.Diagnostics (CompilerError, compilerErrorText)
 import Solcore.Frontend.Syntax
 import Solcore.Frontend.TypeInference.TcModule
-import Solcore.Diagnostics (CompilerError, compilerErrorText)
 import Solcore.Pipeline.Options (noDesugarOpt)
 import Test.Tasty
 import Test.Tasty.HUnit

From b994f00073da07d58a2acbc0ee862ccdbcd74b5b Mon Sep 17 00:00:00 2001
From: Yoshitomo Nakanishi <yurayura.rounin.3@gmail.com>
Date: Thu, 28 May 2026 17:58:41 +0200
Subject: [PATCH 35/35] Stabilize diagnostic CLI snapshots under Nix

---
 test/DiagnosticCliTests.hs | 66 +++++++++++++++++++++++++-------------
 1 file changed, 44 insertions(+), 22 deletions(-)

diff --git a/test/DiagnosticCliTests.hs b/test/DiagnosticCliTests.hs
index 6506ca704..faaed2adf 100644
--- a/test/DiagnosticCliTests.hs
+++ b/test/DiagnosticCliTests.hs
@@ -1,8 +1,10 @@
 module DiagnosticCliTests where
 
 import Data.List (isSuffixOf, stripPrefix)
-import System.Directory (getCurrentDirectory)
+import System.Directory (doesFileExist, findExecutable, getCurrentDirectory)
+import System.Environment (lookupEnv)
 import System.Exit (ExitCode (..))
+import System.FilePath ((</>))
 import System.Process (readProcessWithExitCode)
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -32,8 +34,7 @@ diagnosticCliTests =
             "note: in: function main () -> word {",
             "      return missing ;",
             "      }",
-            "note: module validation failed for",
-            "      <cwd>/test/diagnostics/undefined-name.solc"
+            "note: module validation failed for <cwd>/test/diagnostics/undefined-name.solc"
           ],
       testCase "duplicate definition" $
         expectFailure
@@ -47,8 +48,7 @@ diagnosticCliTests =
             "  |          ^^^ duplicate definition",
             "note: context: module",
             "note: foo",
-            "note: module validation failed for",
-            "      <cwd>/test/diagnostics/duplicate-definition.solc",
+            "note: module validation failed for <cwd>/test/diagnostics/duplicate-definition.solc",
             "help: rename or remove the duplicate declaration"
           ],
       testCase "type mismatch" $
@@ -65,8 +65,7 @@ diagnosticCliTests =
             "note: in: function main () -> word {",
             "      return true;",
             "      }",
-            "note: module typecheck failed for",
-            "      <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
+            "note: module typecheck failed for <cwd>/test/diagnostics/type-mismatch.solc (no desugaring)"
           ],
       testCase "missing signature uses signature span" $
         expectFailure
@@ -77,8 +76,7 @@ diagnosticCliTests =
             "1 | function foo() {",
             "  |          ^^^ incomplete signature",
             "note: signature: function foo ()",
-            "note: module typecheck failed for",
-            "      <cwd>/test/diagnostics/missing-signature.solc (no desugaring)",
+            "note: module typecheck failed for <cwd>/test/diagnostics/missing-signature.solc (no desugaring)",
             "help: annotate every parameter (name : Type) and provide a return type (-> Type)"
           ],
       testCase "polymorphic type error uses signature span" $
@@ -99,9 +97,7 @@ diagnosticCliTests =
             "      }",
             "      return result;",
             "      }",
-            "note: module typecheck failed for",
-            "      <cwd>/test/diagnostics/not-polymorphic-enough.solc (no",
-            "      desugaring)"
+            "note: module typecheck failed for <cwd>/test/diagnostics/not-polymorphic-enough.solc (no desugaring)"
           ],
       testCase "missing instance" $
         expectFailure
@@ -120,9 +116,7 @@ diagnosticCliTests =
             "      return Typedef.abs(MemoryType.load(ptr) : word);",
             "      }",
             "      }",
-            "note: module typecheck failed for",
-            "      <cwd>/test/examples/cases/missing-instance.solc (no",
-            "      desugaring)",
+            "note: module typecheck failed for <cwd>/test/examples/cases/missing-instance.solc (no desugaring)",
             "help: add a matching instance or strengthen the surrounding type context"
           ],
       testCase "dot shorthand constructor error" $
@@ -138,9 +132,7 @@ diagnosticCliTests =
             "note: in: function bad () -> Option {",
             "      return .Nope(1);",
             "      }",
-            "note: module typecheck failed for",
-            "      <cwd>/test/examples/cases/dot-expression-unknown-fail.solc (no",
-            "      desugaring)",
+            "note: module typecheck failed for <cwd>/test/examples/cases/dot-expression-unknown-fail.solc (no desugaring)",
             "help: use a constructor that is visible for the expected type"
           ],
       testCase "import error" $
@@ -190,8 +182,7 @@ diagnosticCliTests =
             "note: in: function main () -> Token {",
             "      return Token.Err(0) ;",
             "      }",
-            "note: module validation failed for",
-            "      <cwd>/test/imports/hidden_ctor_expr_fail.solc"
+            "note: module validation failed for <cwd>/test/imports/hidden_ctor_expr_fail.solc"
           ],
       testCase "short output" $
         expectFailure
@@ -213,7 +204,8 @@ diagnosticCliTests =
 
 expectSuccess :: [String] -> [String] -> Assertion
 expectSuccess args expectedLines = do
-  (exitCode, stdout, stderr) <- readProcessWithExitCode "sol-core" args ""
+  exe <- solCoreExecutable
+  (exitCode, stdout, stderr) <- readProcessWithExitCode exe (stableDiagnosticArgs args) ""
   assertEqual "exit code" ExitSuccess exitCode
   assertEqual "stderr" "" stderr
   cwd <- normalizePath <$> getCurrentDirectory
@@ -221,12 +213,42 @@ expectSuccess args expectedLines = do
 
 expectFailure :: [String] -> [String] -> Assertion
 expectFailure args expectedLines = do
-  (exitCode, stdout, stderr) <- readProcessWithExitCode "sol-core" args ""
+  exe <- solCoreExecutable
+  (exitCode, stdout, stderr) <- readProcessWithExitCode exe (stableDiagnosticArgs args) ""
   assertEqual "exit code" (ExitFailure 1) exitCode
   assertEqual "stderr" "" stderr
   cwd <- normalizePath <$> getCurrentDirectory
   assertEqual "stdout" (unlinesNoTrailing expectedLines) (stripFinalNewline (normalizeOutput cwd stdout))
 
+solCoreExecutable :: IO FilePath
+solCoreExecutable = do
+  envExe <- lookupEnv "SOL_CORE_EXE"
+  pathExe <- findExecutable "sol-core"
+  cwd <- getCurrentDirectory
+  found <-
+    firstExisting
+      ( maybeToList envExe
+          ++ maybeToList pathExe
+          ++ [cwd </> "dist" </> "build" </> "sol-core" </> "sol-core"]
+      )
+  case found of
+    Just exe -> pure exe
+    Nothing -> assertFailure "could not find sol-core executable"
+
+stableDiagnosticArgs :: [String] -> [String]
+stableDiagnosticArgs args =
+  args ++ ["--diagnostic-width", "240"]
+
+firstExisting :: [FilePath] -> IO (Maybe FilePath)
+firstExisting [] = pure Nothing
+firstExisting (path : paths) = do
+  exists <- doesFileExist path
+  if exists then pure (Just path) else firstExisting paths
+
+maybeToList :: Maybe a -> [a]
+maybeToList Nothing = []
+maybeToList (Just value) = [value]
+
 redundantWarningsSnapshot :: [String]
 redundantWarningsSnapshot =
   [ "warning[SC0301]: redundant pattern clause",