Aliasing (#2301)

- Closes #2188.

This pr introduces a new syntactical statement for defining aliases:
```
syntax alias newName := oldName;
```
where `oldName` can be any name in the expression namespace. Fixity and
module aliases are not supported at the moment.

- The `newName` does not inherit the fixity of `oldName`. We have agreed
that the goal is to inherit the fixity of `oldName` except if `newName`
has a fixity statement, but this will be done in a separate pr as it
requires #2310.

app/Commands/Repl.hs

@@ -277,7 +277,7 @@ printDocumentation = replParseIdentifiers >=> printIdentifiers
 
         printIdentifier :: Concrete.ScopedIden -> Repl ()
         printIdentifier s = do
-          let n = s ^. Concrete.scopedIden . Scoped.nameId
+          let n = s ^. Concrete.scopedIdenFinal . Scoped.nameId
           mdoc <- case getNameKind s of
             KNameAxiom -> getDocAxiom n
             KNameInductive -> getDocInductive n
@@ -286,6 +286,7 @@ printDocumentation = replParseIdentifiers >=> printIdentifiers
             KNameConstructor -> getDocConstructor n
             KNameLocalModule -> impossible
             KNameTopModule -> impossible
+            KNameAlias -> impossible
             KNameFixity -> impossible
           printDoc mdoc
           where
@@ -334,7 +335,7 @@ printDefinition = replParseIdentifiers >=> printIdentifiers
 
         printIdentifier :: Concrete.ScopedIden -> Repl ()
         printIdentifier s =
-          let n = s ^. Concrete.scopedIden . Scoped.nameId
+          let n = s ^. Concrete.scopedIdenFinal . Scoped.nameId
            in case getNameKind s of
                 KNameAxiom -> printAxiom n
                 KNameInductive -> printInductive n
@@ -344,6 +345,7 @@ printDefinition = replParseIdentifiers >=> printIdentifiers
                 KNameLocalModule -> impossible
                 KNameTopModule -> impossible
                 KNameFixity -> impossible
+                KNameAlias -> impossible
           where
             printLocation :: HasLoc s => s -> Repl ()
             printLocation def = do

src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs

@@ -293,6 +293,7 @@ putTag ann x = case ann of
               S.KNameLocal -> "ju-var"
               S.KNameAxiom -> "ju-axiom"
               S.KNameLocalModule -> "ju-var"
+              S.KNameAlias -> "ju-var"
               S.KNameTopModule -> "ju-var"
               S.KNameFixity -> "ju-fixity"
           )

src/Juvix/Compiler/Concrete/Data/Highlight.hs

@@ -67,14 +67,14 @@ goFaceName n = do
   return (WithLoc (getLoc n) (PropertyFace f))
 
 goGotoProperty :: AName -> WithLoc PropertyGoto
-goGotoProperty (AName n) = WithLoc (getLoc n) PropertyGoto {..}
+goGotoProperty n = WithLoc (getLoc n) PropertyGoto {..}
   where
-    _gotoPos = n ^. nameDefined . intervalStart
-    _gotoFile = n ^. nameDefined . intervalFile
+    _gotoPos = n ^. anameDefinedLoc . intervalStart
+    _gotoFile = n ^. anameDefinedLoc . intervalFile
 
 goDocProperty :: Scoped.DocTable -> Internal.TypesTable -> AName -> Maybe (WithLoc PropertyDoc)
-goDocProperty doctbl tbl a@(AName n) = do
-  let ty :: Maybe Internal.Expression = tbl ^. at (n ^. nameId)
-  d <- ppDocDefault a ty (doctbl ^. at (n ^. nameId))
+goDocProperty doctbl tbl a = do
+  let ty :: Maybe Internal.Expression = tbl ^. at (a ^. anameDocId)
+  d <- ppDocDefault a ty (doctbl ^. at (a ^. anameDocId))
   let (_docText, _docSExp) = renderEmacs (layoutPretty defaultLayoutOptions d)
-  return (WithLoc (getLoc n) PropertyDoc {..})
+  return (WithLoc (getLoc a) PropertyDoc {..})

src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs

@@ -16,6 +16,7 @@ nameKindFace = \case
   KNameLocalModule -> Just FaceModule
   KNameAxiom -> Just FaceAxiom
   KNameLocal -> Nothing
+  KNameAlias -> Nothing
   KNameFixity -> Nothing
 
 fromCodeAnn :: CodeAnn -> Maybe EmacsProperty

src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs

@@ -16,6 +16,7 @@ data InfoTableBuilder m a where
   RegisterInductive :: InductiveDef 'Scoped -> InfoTableBuilder m ()
   RegisterFunctionDef :: FunctionDef 'Scoped -> InfoTableBuilder m ()
   RegisterName :: HasLoc c => S.Name' c -> InfoTableBuilder m ()
+  RegisterScopedIden :: ScopedIden -> InfoTableBuilder m ()
   RegisterModule :: Module 'Scoped 'ModuleTop -> InfoTableBuilder m ()
   RegisterFixity :: FixityDef -> InfoTableBuilder m ()
   RegisterPrecedence :: S.NameId -> S.NameId -> InfoTableBuilder m ()
@@ -57,7 +58,8 @@ toState = reinterpret $ \case
      in do
           modify (set (infoFunctions . at ref) (Just info))
           registerDoc (f ^. signName . nameId) j
-  RegisterName n -> modify (over highlightNames (cons (S.AName n)))
+  RegisterName n -> modify (over highlightNames (cons (S.anameFromName n)))
+  RegisterScopedIden n -> modify (over highlightNames (cons (anameFromScopedIden n)))
   RegisterModule m -> do
     let j = m ^. moduleDoc
     modify (over infoModules (HashMap.insert (m ^. modulePath) m))
@@ -84,3 +86,13 @@ runInfoTableBuilder tab = runState tab . toState
 
 ignoreInfoTableBuilder :: Members '[HighlightBuilder] r => Sem (InfoTableBuilder ': r) a -> Sem r a
 ignoreInfoTableBuilder = evalState emptyInfoTable . toState
+
+anameFromScopedIden :: ScopedIden -> AName
+anameFromScopedIden s =
+  AName
+    { _anameLoc = getLoc s,
+      _anameKind = getNameKind s,
+      _anameDocId = s ^. scopedIdenFinal . nameId,
+      _anameDefinedLoc = s ^. scopedIdenName . nameDefined,
+      _anameVerbatim = s ^. scopedIdenName . nameVerbatim
+    }

src/Juvix/Compiler/Concrete/Data/NameSpace.hs

@@ -20,6 +20,7 @@ $(genSingletons [''NameSpace])
 type NameKindNameSpace :: NameKind -> NameSpace
 type family NameKindNameSpace s = res where
   NameKindNameSpace 'KNameLocal = 'NameSpaceSymbols
+  NameKindNameSpace 'KNameAlias = 'NameSpaceSymbols
   NameKindNameSpace 'KNameConstructor = 'NameSpaceSymbols
   NameKindNameSpace 'KNameInductive = 'NameSpaceSymbols
   NameKindNameSpace 'KNameFunction = 'NameSpaceSymbols

src/Juvix/Compiler/Concrete/Data/Scope.hs

@@ -16,7 +16,7 @@ import Juvix.Prelude
 nsEntry :: forall ns. SingI ns => Lens' (NameSpaceEntryType ns) (S.Name' ())
 nsEntry = case sing :: SNameSpace ns of
   SNameSpaceModules -> moduleEntry
-  SNameSpaceSymbols -> symbolEntry
+  SNameSpaceSymbols -> preSymbolName
   SNameSpaceFixities -> fixityEntry
 
 mkModuleRef' :: SingI t => ModuleRef'' 'S.NotConcrete t -> ModuleRef' 'S.NotConcrete

src/Juvix/Compiler/Concrete/Data/Scope/Base.hs

@@ -59,6 +59,7 @@ data ScoperState = ScoperState
     -- | Local and top modules
     _scoperModules :: HashMap S.ModuleNameId (ModuleRef' 'S.NotConcrete),
     _scoperScope :: HashMap TopModulePath Scope,
+    _scoperAlias :: HashMap S.NameId PreSymbolEntry,
     _scoperSignatures :: HashMap S.NameId NameSignature,
     -- | Indexed by the inductive type. This is used for record updates
     _scoperRecordFields :: HashMap S.NameId RecordInfo,

src/Juvix/Compiler/Concrete/Data/ScopedName.hs

@@ -79,7 +79,27 @@ data Name' n = Name'
   }
   deriving stock (Show)
 
+-- | For highlighting
+data AName = AName
+  { _anameLoc :: Interval,
+    _anameDefinedLoc :: Interval,
+    _anameKind :: NameKind,
+    _anameDocId :: NameId,
+    _anameVerbatim :: Text
+  }
+
 makeLenses ''Name'
+makeLenses ''AName
+
+anameFromName :: HasLoc c => Name' c -> AName
+anameFromName n =
+  AName
+    { _anameLoc = getLoc n,
+      _anameDefinedLoc = n ^. nameDefined,
+      _anameKind = getNameKind n,
+      _anameDocId = n ^. nameId,
+      _anameVerbatim = n ^. nameVerbatim
+    }
 
 instance HasNameKind (Name' n) where
   getNameKind = (^. nameKind)
@@ -90,16 +110,11 @@ instance (HasLoc n) => HasLoc (Name' n) where
 instance (Pretty a) => Pretty (Name' a) where
   pretty = pretty . (^. nameConcrete)
 
-data AName = forall c.
-  (HasLoc c) =>
-  AName
-  {_aName :: Name' c}
-
 instance HasLoc AName where
-  getLoc (AName c) = getLoc c
+  getLoc = (^. anameLoc)
 
 instance HasNameKind AName where
-  getNameKind (AName c) = getNameKind c
+  getNameKind = (^. anameKind)
 
 hasFixity :: Name' s -> Bool
 hasFixity n = isJust (n ^. nameFixity)

src/Juvix/Compiler/Concrete/Extra.hs

@@ -87,6 +87,7 @@ groupStatements = \case
       (StatementSyntax (SyntaxFixity _), _) -> False
       (StatementSyntax (SyntaxOperator o), s) -> definesSymbol (o ^. opSymbol) s
       (StatementSyntax (SyntaxIterator i), s) -> definesSymbol (i ^. iterSymbol) s
+      (StatementSyntax (SyntaxAlias {}), _) -> False
       (StatementImport _, StatementImport _) -> True
       (StatementImport i, StatementOpenModule o) -> case sing :: SStage s of
         SParsed -> True
@@ -140,12 +141,12 @@ recordNameSignatureByIndex = IntMap.fromList . (^.. recordNames . each . to swap
 
 getExpressionAtomIden :: ExpressionAtom 'Scoped -> Maybe S.Name
 getExpressionAtomIden = \case
-  AtomIdentifier nm -> Just (nm ^. scopedIden)
+  AtomIdentifier nm -> Just (nm ^. scopedIdenName)
   _ -> Nothing
 
 getPatternAtomIden :: PatternAtom 'Scoped -> Maybe S.Name
 getPatternAtomIden = \case
   PatternAtomIden i -> case i of
-    PatternScopedConstructor c -> Just c
+    PatternScopedConstructor c -> Just (c ^. scopedIdenName)
     _ -> Nothing
   _ -> Nothing

src/Juvix/Compiler/Concrete/Keywords.hs

@@ -18,6 +18,8 @@ import Juvix.Data.Keyword.All
     delimParenR,
     delimSemicolon,
     -- keywords
+
+    kwAlias,
     kwAs,
     kwAssign,
     kwAt,
@@ -94,5 +96,6 @@ nonKeywords =
     kwEq,
     kwFixity,
     kwOperator,
+    kwAlias,
     kwIterator
   ]