[typecheck] Add the definition loc to microjuvix names

This is used in type errors

src/MiniJuvix/Syntax/MicroJuvix/Error/Pretty/Base.hs

@@ -18,6 +18,9 @@ indent' = indent 2
 prettyT :: Text -> Doc Eann
 prettyT = pretty
 
+highlight :: Doc Eann -> Doc Eann
+highlight = annotate Highlight
+
 class PrettyError e where
   ppError :: e -> Doc Eann
 
@@ -58,8 +61,12 @@ instance PrettyError ExpectedFunctionType where
     <> line <> indent' (ppCode (e ^. expectedFunctionTypeType))
 
 instance PrettyError TooManyPatterns where
-  ppError e = "Type error in the definition of" <+> ppCode (e ^. tooManyPatternsClause . clauseName) <> "."
-    <> line <> "The function clause:"
+  ppError e = "Type error near" <+> highlight (pretty (name ^. nameDefined))
+    <> line <> "In in the definition of" <+> ppCode name <+> "the function clause:"
     <> line <> indent' (ppCode (e ^. tooManyPatternsClause))
     <> line <> "matches too many patterns. It should match the following types:"
     <> line <> indent' (hsep (ppCode <$> (e ^. tooManyPatternsTypes)))
+
+    where
+      name :: Name
+      name =  (e ^. tooManyPatternsClause . clauseName)

src/MiniJuvix/Syntax/MicroJuvix/Language.hs

@@ -11,6 +11,7 @@ import MiniJuvix.Syntax.ForeignBlock
 import MiniJuvix.Syntax.Backends
 import MiniJuvix.Syntax.Concrete.Scoped.Name (NameId (..))
 import MiniJuvix.Syntax.Concrete.Scoped.Name.NameKind
+import qualified MiniJuvix.Syntax.Concrete.Language as C
 import MiniJuvix.Syntax.Concrete.Literal
 import MiniJuvix.Syntax.Fixity
 import Prettyprinter
@@ -28,8 +29,8 @@ type InductiveName = Name
 data Name = Name
   { _nameText :: Text,
     _nameId :: NameId,
-    _nameKind :: NameKind
-    -- TODO: Add Location here so we can print out line numbers
+    _nameKind :: NameKind,
+    _nameDefined :: C.Interval
   }
   deriving stock (Show)
 

src/MiniJuvix/Translation/AbstractToMicroJuvix.hs

@@ -24,8 +24,9 @@ goSymbol :: S.Symbol -> Name
 goSymbol s =
   Name
     { _nameText = S.symbolText s,
-      _nameId = S._nameId s,
-      _nameKind = getNameKind s }
+      _nameId = s ^. S.nameId,
+      _nameKind = getNameKind s,
+      _nameDefined = s ^. S.nameDefined}
 
 unsupported :: Text -> a
 unsupported thing = error ("Abstract to MicroJuvix: Not yet supported: " <> thing)