Improve handling of location information for different objs (#263)

* Add loc for literal and refactor a bit

* w.i.p making symbol a synonym for WithLoc Text

* Finish with symbol

* Update standard library

juvix-stdlib

@@ -1 +1 @@
-Subproject commit 223a87038bef8381423dda8824db18ea47b49c4e
+Subproject commit dd73f5d7838041ef9b4c307a385bda415283b280

src/Juvix/Prelude.hs

@@ -3,6 +3,7 @@ module Juvix.Prelude
     module Juvix.Prelude.Error,
     module Juvix.Prelude.Files,
     module Juvix.Prelude.Lens,
+    module Juvix.Prelude.Loc,
   )
 where
 
@@ -10,3 +11,4 @@ import Juvix.Prelude.Base
 import Juvix.Prelude.Error
 import Juvix.Prelude.Files
 import Juvix.Prelude.Lens
+import Juvix.Prelude.Loc

src/Juvix/Prelude/Error.hs

@@ -2,14 +2,12 @@
 -- Control.Exception
 module Juvix.Prelude.Error
   ( module Juvix.Prelude.Error,
-    module Juvix.Syntax.Concrete.Loc,
     module Juvix.Prelude.Error.GenericError,
   )
 where
 
 import Juvix.Prelude.Base
 import Juvix.Prelude.Error.GenericError
-import Juvix.Syntax.Concrete.Loc
 
 data JuvixError
   = forall a. (ToGenericError a, Typeable a) => JuvixError a

src/Juvix/Prelude/Error/GenericError.hs

@@ -4,8 +4,8 @@ module Juvix.Prelude.Error.GenericError
 where
 
 import Juvix.Prelude.Base
+import Juvix.Prelude.Loc
 import Juvix.Prelude.Pretty
-import Juvix.Syntax.Concrete.Loc
 import Prettyprinter.Render.Terminal qualified as Ansi
 import Prettyprinter.Render.Text
 import System.Console.ANSI qualified as Ansi

src/Juvix/Prelude/Files/Error.hs

@@ -2,6 +2,7 @@ module Juvix.Prelude.Files.Error where
 
 import Juvix.Prelude.Base
 import Juvix.Prelude.Error
+import Juvix.Prelude.Loc
 import Juvix.Prelude.Pretty
 
 data FilesErrorCause = StdlibConflict

src/Juvix/Prelude/Loc.hs

@@ -1,4 +1,4 @@
-module Juvix.Syntax.Concrete.Loc where
+module Juvix.Prelude.Loc where
 
 import Juvix.Prelude.Base
 import Prettyprinter
@@ -71,29 +71,10 @@ getLocSpan = foldr1 (<>) . fmap getLoc
 instance Semigroup Interval where
   Interval f s e <> Interval _f s' e' = Interval f (min s s') (max e e')
 
-data WithLoc a = WithLoc
-  { _withLocInt :: Interval,
-    _withLocParam :: a
-  }
-  deriving stock (Show)
-
 makeLenses ''Interval
 makeLenses ''FileLoc
 makeLenses ''Loc
 makeLenses ''Pos
-makeLenses ''WithLoc
-
-instance HasLoc (WithLoc a) where
-  getLoc = (^. withLocInt)
-
-instance Eq a => Eq (WithLoc a) where
-  (==) = (==) `on` (^. withLocParam)
-
-instance Ord a => Ord (WithLoc a) where
-  compare = compare `on` (^. withLocParam)
-
-instance Functor WithLoc where
-  fmap = over withLocParam
 
 singletonInterval :: Loc -> Interval
 singletonInterval l =

src/Juvix/Syntax/Abstract/Language.hs

@@ -3,6 +3,7 @@ module Juvix.Syntax.Abstract.Language
     module Juvix.Syntax.Concrete.Language,
     module Juvix.Syntax.Hole,
     module Juvix.Syntax.Concrete.Builtins,
+    module Juvix.Syntax.Concrete.Literal,
     module Juvix.Syntax.Usage,
     module Juvix.Syntax.Universe,
     module Juvix.Syntax.Abstract.Name,
@@ -14,7 +15,8 @@ where
 import Juvix.Prelude
 import Juvix.Syntax.Abstract.Name
 import Juvix.Syntax.Concrete.Builtins
-import Juvix.Syntax.Concrete.Language (BackendItem, ForeignBlock (..), LiteralLoc (..), symbolLoc)
+import Juvix.Syntax.Concrete.Language (BackendItem, ForeignBlock (..), symbolLoc)
+import Juvix.Syntax.Concrete.Literal
 import Juvix.Syntax.Hole
 import Juvix.Syntax.IsImplicit
 import Juvix.Syntax.Universe

src/Juvix/Syntax/Concrete/Language.hs

@@ -5,9 +5,9 @@ module Juvix.Syntax.Concrete.Language
     module Juvix.Syntax.Concrete.Name,
     module Juvix.Syntax.Concrete.Scoped.NameRef,
     module Juvix.Syntax.Concrete.Builtins,
-    module Juvix.Syntax.Concrete.Loc,
+    module Juvix.Syntax.Loc,
+    module Juvix.Syntax.Concrete.Literal,
     module Juvix.Syntax.Hole,
-    module Juvix.Syntax.Concrete.LiteralLoc,
     module Juvix.Syntax.IsImplicit,
     module Juvix.Syntax.Backends,
     module Juvix.Syntax.ForeignBlock,
@@ -27,8 +27,7 @@ import Juvix.Prelude hiding (show)
 import Juvix.Syntax.Backends
 import Juvix.Syntax.Concrete.Builtins
 import Juvix.Syntax.Concrete.Language.Stage
-import Juvix.Syntax.Concrete.LiteralLoc
-import Juvix.Syntax.Concrete.Loc
+import Juvix.Syntax.Concrete.Literal
 import Juvix.Syntax.Concrete.ModuleIsTop
 import Juvix.Syntax.Concrete.Name
 import Juvix.Syntax.Concrete.PublicAnn
@@ -41,6 +40,7 @@ import Juvix.Syntax.Fixity
 import Juvix.Syntax.ForeignBlock
 import Juvix.Syntax.Hole
 import Juvix.Syntax.IsImplicit
+import Juvix.Syntax.Loc
 import Juvix.Syntax.Universe
 import Juvix.Syntax.Usage
 import Juvix.Syntax.Wildcard

src/Juvix/Syntax/Concrete/Lexer.hs

@@ -7,6 +7,7 @@ import Juvix.Prelude
 import Juvix.Syntax.Concrete.Base hiding (Pos, space)
 import Juvix.Syntax.Concrete.Base qualified as P
 import Juvix.Syntax.Concrete.Parser.InfoTableBuilder
+import Juvix.Syntax.Loc
 import Text.Megaparsec.Char.Lexer qualified as L
 
 type OperatorSym = Text
@@ -141,7 +142,6 @@ allKeywords :: Members '[Reader ParserParams, InfoTableBuilder] r => [ParsecS r
 allKeywords =
   [ kwAssignment,
     kwAxiom,
-    -- kwBuiltin, -- no need to be a reserved keyword
     kwColon,
     kwColonOmega,
     kwColonOne,

src/Juvix/Syntax/Concrete/Literal.hs

@@ -2,8 +2,11 @@ module Juvix.Syntax.Concrete.Literal where
 
 import Juvix.Prelude
 import Juvix.Syntax.Fixity
+import Juvix.Syntax.Loc
 import Prettyprinter
 
+type LiteralLoc = WithLoc Literal
+
 data Literal
   = LitString Text
   | LitInteger Integer

src/Juvix/Syntax/Concrete/LiteralLoc.hs

@@ -1,34 +0,0 @@
-module Juvix.Syntax.Concrete.LiteralLoc
-  ( module Juvix.Syntax.Concrete.LiteralLoc,
-    module Juvix.Syntax.Concrete.Literal,
-  )
-where
-
-import Juvix.Prelude
-import Juvix.Prelude.Pretty
-import Juvix.Syntax.Concrete.Literal
-import Juvix.Syntax.Fixity
-
-data LiteralLoc = LiteralLoc
-  { _literalLocLiteral :: Literal,
-    _literalLocLoc :: Interval
-  }
-  deriving stock (Show, Generic)
-
-makeLenses ''LiteralLoc
-
-instance Hashable LiteralLoc
-
-instance HasAtomicity LiteralLoc where
-  atomicity = atomicity . (^. literalLocLiteral)
-
-instance Pretty LiteralLoc where
-  pretty = pretty . (^. literalLocLiteral)
-
-instance Eq LiteralLoc where
-  l1 == l2 = l1 ^. literalLocLiteral == l2 ^. literalLocLiteral
-
-instance HasLoc LiteralLoc where
-  getLoc = (^. literalLocLoc)
-
-deriving stock instance Ord LiteralLoc

src/Juvix/Syntax/Concrete/Name.hs

@@ -2,30 +2,15 @@ module Juvix.Syntax.Concrete.Name where
 
 import Data.List.NonEmpty.Extra qualified as NonEmpty
 import Juvix.Prelude
-import Prettyprinter
+import Juvix.Syntax.Loc
 
-data Symbol = Symbol
-  { _symbolText :: Text,
-    _symbolLoc :: Interval
-  }
-  deriving stock (Show)
+type Symbol = WithLoc Text
 
-makeLenses ''Symbol
+symbolText :: Lens' Symbol Text
+symbolText = withLocParam
 
-instance Pretty Symbol where
-  pretty = pretty . (^. symbolText)
-
-instance Eq Symbol where
-  (==) = (==) `on` (^. symbolText)
-
-instance Ord Symbol where
-  compare = compare `on` (^. symbolText)
-
-instance HasLoc Symbol where
-  getLoc = (^. symbolLoc)
-
-instance Hashable Symbol where
-  hashWithSalt i s = hashWithSalt i (s ^. symbolText)
+symbolLoc :: Lens' Symbol Interval
+symbolLoc = withLocInt
 
 data Name
   = NameQualified QualifiedName
@@ -90,12 +75,10 @@ topModulePathToFilePath' ext root mp = normalise absPath
       Nothing -> root </> relFilePath
       Just e -> root </> relFilePath <.> e
     toPath :: Symbol -> FilePath
-    toPath Symbol {..} = unpack _symbolText
+    toPath s = unpack (s ^. withLocParam)
 
 topModulePathToDottedPath :: IsString s => TopModulePath -> s
 topModulePathToDottedPath (TopModulePath l r) =
-  fromText $ mconcat $ intersperse "." $ map fromSymbol $ l ++ [r]
-  where
-    fromSymbol Symbol {..} = _symbolText
+  fromText $ mconcat $ intersperse "." $ map (^. symbolText) $ l ++ [r]
 
 instance Hashable TopModulePath

src/Juvix/Syntax/Concrete/Parser.hs

@@ -76,10 +76,10 @@ topStatement = top statement
 --------------------------------------------------------------------------------
 
 symbol :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r Symbol
-symbol = uncurry Symbol <$> identifierL
+symbol = uncurry (flip WithLoc) <$> identifierL
 
 dottedSymbol :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (NonEmpty Symbol)
-dottedSymbol = fmap (uncurry Symbol) <$> dottedIdentifier
+dottedSymbol = fmap (uncurry (flip WithLoc)) <$> dottedIdentifier
 
 name :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r Name
 name = do
@@ -262,12 +262,12 @@ hole = snd <$> interval kwHole
 literalInteger :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r LiteralLoc
 literalInteger = do
   (x, loc) <- integer
-  return (LiteralLoc (LitInteger x) loc)
+  return (WithLoc loc (LitInteger x))
 
 literalString :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r LiteralLoc
 literalString = do
   (x, loc) <- string
-  return (LiteralLoc (LitString x) loc)
+  return (WithLoc loc (LitString x))
 
 literal :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r LiteralLoc
 literal = do

src/Juvix/Syntax/Concrete/Parser/InfoTableBuilder.hs

@@ -11,9 +11,10 @@ module Juvix.Syntax.Concrete.Parser.InfoTableBuilder
 where
 
 import Juvix.Prelude
-import Juvix.Syntax.Concrete.LiteralLoc
+import Juvix.Syntax.Concrete.Literal
 import Juvix.Syntax.Concrete.Parser.InfoTable
 import Juvix.Syntax.Concrete.Parser.ParsedItem
+import Juvix.Syntax.Loc
 
 data InfoTableBuilder m a where
   RegisterItem :: ParsedItem -> InfoTableBuilder m ()
@@ -46,7 +47,7 @@ registerLiteral l =
           _parsedTag = tag
         }
   where
-    tag = case l ^. literalLocLiteral of
+    tag = case l ^. withLocParam of
       LitString {} -> ParsedTagLiteralString
       LitInteger {} -> ParsedTagLiteralInt
     loc = getLoc l

src/Juvix/Syntax/Concrete/Scoped/Pretty/Base.hs

@@ -468,9 +468,6 @@ instance PrettyCode TopModulePath where
   ppCode TopModulePath {..} =
     dotted <$> mapM ppSymbol (_modulePathDir ++ [_modulePathName])
 
-instance PrettyCode Symbol where
-  ppCode = return . pretty . (^. symbolText)
-
 instance PrettyCode Name where
   ppCode n = case n of
     NameUnqualified s -> ppSymbol s
@@ -678,6 +675,9 @@ ppPatternAtom = case sing :: SStage s of
   SParsed -> ppCodeAtom
   SScoped -> ppCodeAtom
 
+instance PrettyCode Text where
+  ppCode = return . pretty
+
 instance PrettyCode InfixApplication where
   ppCode i@InfixApplication {..} = do
     infixAppLeft' <- ppLeftExpression (getFixity i) _infixAppLeft
@@ -702,9 +702,6 @@ instance PrettyCode Literal where
     LitInteger n -> return $ annotate AnnLiteralInteger (pretty n)
     LitString s -> return $ ppStringLit s
 
-instance PrettyCode LiteralLoc where
-  ppCode l = ppCode (l ^. literalLocLiteral)
-
 instance PrettyCode AxiomRef where
   ppCode a = ppCode (a ^. axiomRefName)
 

src/Juvix/Syntax/Fixity.hs

@@ -1,6 +1,6 @@
 module Juvix.Syntax.Fixity where
 
-import Juvix.Prelude
+import Juvix.Prelude.Base
 
 data Precedence
   = PrecMinusOmega

src/Juvix/Syntax/Loc.hs

@@ -0,0 +1,34 @@
+module Juvix.Syntax.Loc where
+
+import Juvix.Prelude
+import Juvix.Prelude.Pretty
+import Juvix.Syntax.Fixity
+
+data WithLoc a = WithLoc
+  { _withLocInt :: Interval,
+    _withLocParam :: a
+  }
+  deriving stock (Show)
+
+makeLenses ''WithLoc
+
+instance HasLoc (WithLoc a) where
+  getLoc = (^. withLocInt)
+
+instance HasAtomicity a => HasAtomicity (WithLoc a) where
+  atomicity (WithLoc _ a) = atomicity a
+
+instance Hashable a => Hashable (WithLoc a) where
+  hashWithSalt a (WithLoc _ p) = hashWithSalt a p
+
+instance Eq a => Eq (WithLoc a) where
+  (==) = (==) `on` (^. withLocParam)
+
+instance Ord a => Ord (WithLoc a) where
+  compare = compare `on` (^. withLocParam)
+
+instance Functor WithLoc where
+  fmap = over withLocParam
+
+instance Pretty a => Pretty (WithLoc a) where
+  pretty (WithLoc _ a) = pretty a

src/Juvix/Syntax/MicroJuvix/Language.hs

@@ -1,12 +1,12 @@
 module Juvix.Syntax.MicroJuvix.Language
   ( module Juvix.Syntax.MicroJuvix.Language,
     module Juvix.Syntax.Abstract.Name,
-    module Juvix.Syntax.Concrete.Loc,
+    module Juvix.Syntax.Loc,
     module Juvix.Syntax.IsImplicit,
+    module Juvix.Syntax.Concrete.Literal,
     module Juvix.Syntax.Universe,
     module Juvix.Syntax.Hole,
     module Juvix.Syntax.Wildcard,
-    module Juvix.Syntax.Concrete.LiteralLoc,
     module Juvix.Syntax.Concrete.Builtins,
   )
 where
@@ -14,11 +14,11 @@ where
 import Juvix.Prelude
 import Juvix.Syntax.Abstract.Name
 import Juvix.Syntax.Concrete.Builtins
-import Juvix.Syntax.Concrete.LiteralLoc
-import Juvix.Syntax.Concrete.Loc
+import Juvix.Syntax.Concrete.Literal
 import Juvix.Syntax.ForeignBlock
 import Juvix.Syntax.Hole
 import Juvix.Syntax.IsImplicit
+import Juvix.Syntax.Loc
 import Juvix.Syntax.Universe hiding (smallUniverse)
 import Juvix.Syntax.Wildcard
 
@@ -200,10 +200,13 @@ instance HasLoc FunctionParameter where
 instance HasLoc Function where
   getLoc (Function l r) = getLoc l <> getLoc r
 
+instance HasLoc Application where
+  getLoc (Application l r _) = getLoc l <> getLoc r
+
 instance HasLoc Expression where
   getLoc = \case
     ExpressionIden i -> getLoc i
-    ExpressionApplication a -> getLoc (a ^. appLeft)
+    ExpressionApplication a -> getLoc a
     ExpressionLiteral l -> getLoc l
     ExpressionHole h -> getLoc h
     ExpressionUniverse u -> getLoc u

src/Juvix/Syntax/MiniHaskell/Pretty/Base.hs

@@ -8,8 +8,9 @@ where
 import Juvix.Internal.Strings qualified as Str
 import Juvix.Prelude
 import Juvix.Prelude.Pretty qualified as PP
-import Juvix.Syntax.Concrete.LiteralLoc
+import Juvix.Syntax.Concrete.Literal
 import Juvix.Syntax.Fixity
+import Juvix.Syntax.Loc
 import Juvix.Syntax.MiniHaskell.Language
 import Juvix.Syntax.MiniHaskell.Pretty.Ann
 import Juvix.Syntax.MiniHaskell.Pretty.Options
@@ -41,7 +42,7 @@ instance PrettyCode Expression where
     ExpressionIden i -> ppCode i
     ExpressionApplication a -> ppCode a
     ExpressionVerbatim c -> return (pretty c)
-    ExpressionLiteral l -> ppCode l
+    ExpressionLiteral l -> ppCode (l ^. withLocParam)
 
 keyword :: Text -> Doc Ann
 keyword = annotate AnnKeyword . pretty
@@ -150,9 +151,6 @@ instance PrettyCode Literal where
     LitInteger n -> return $ annotate AnnLiteralInteger (pretty n)
     LitString s -> return $ ppStringLit s
 
-instance PrettyCode LiteralLoc where
-  ppCode = ppCode . (^. literalLocLiteral)
-
 doubleQuotes :: Doc Ann -> Doc Ann
 doubleQuotes = enclose kwDQuote kwDQuote
 

src/Juvix/Translation/MonoJuvixToMiniC.hs

@@ -397,7 +397,7 @@ goApplication a = do
       Mono.ExpressionLiteral {} -> impossible
 
 goLiteral :: C.LiteralLoc -> Literal
-goLiteral C.LiteralLoc {..} = case _literalLocLiteral of
+goLiteral l = case l ^. C.withLocParam of
   C.LitString s -> LiteralString s
   C.LitInteger i -> LiteralInt i