Renaming

app/Commands/Format.hs

@@ -3,6 +3,7 @@ module Commands.Format where
 import Commands.Base
 import Commands.Format.Options
 import Data.Text qualified as Text
+import Juvix.Compiler.Concrete.Pretty.Options
 import Juvix.Compiler.Pipeline.Driver (processModule)
 import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.Base
 import Juvix.Compiler.Pipeline.ModuleInfoCache
@@ -51,7 +52,7 @@ targetFromOptions opts = do
 -- | Formats the project on the root
 formatProject ::
   forall r.
-  (Members '[App, EmbedIO, TaggedLock, Files, Output FormattedFileInfo] r) =>
+  (Members '[App, EmbedIO, Reader Options, TaggedLock, Files, Output FormattedFileInfo] r) =>
   Sem r FormatResult
 formatProject = runPipelineOptions . runPipelineSetup $ do
   pkg <- askPackage
@@ -69,7 +70,11 @@ runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock, Files] r) => Format
 runCommand opts = do
   target <- targetFromOptions opts
   runOutputSem (renderFormattedOutput target opts) . runScopeFileApp $ do
-    res <- case target of
+    let printOpts =
+          defaultOptions
+            { _optRenames = maybe [] pure (opts ^. formatRename)
+            }
+    res <- runReader printOpts $ case target of
       TargetFile p -> format p
       TargetProject -> formatProject
       TargetStdin -> do

app/Commands/Format/Options.hs

@@ -1,9 +1,15 @@
-module Commands.Format.Options where
+module Commands.Format.Options
+  ( module Commands.Format.Options,
+    module Juvix.Compiler.Concrete.Data.Rename,
+  )
+where
 
 import CommonOptions
+import Juvix.Compiler.Concrete.Data.Rename
 
 data FormatOptions = FormatOptions
   { _formatInput :: Maybe (AppPath FileOrDir),
+    _formatRename :: Maybe Rename,
     _formatCheck :: Bool,
     _formatInPlace :: Bool
   }
@@ -26,6 +32,7 @@ parseInputFileOrDir = do
 parseFormat :: Parser FormatOptions
 parseFormat = do
   _formatInput <- optional parseInputFileOrDir
+  _formatRename <- optional parseOptRename
   _formatCheck <-
     switch
       ( long "check"

app/CommonOptions.hs

@@ -11,6 +11,7 @@ import Control.Exception qualified as GHC
 import Data.List.NonEmpty qualified as NonEmpty
 import GHC.Conc
 import Juvix.Compiler.Casm.Data.TransformationId.Parser qualified as Casm
+import Juvix.Compiler.Concrete.Data.Rename
 import Juvix.Compiler.Concrete.Translation.ImportScanner
 import Juvix.Compiler.Core.Data.TransformationId.Parser qualified as Core
 import Juvix.Compiler.Pipeline.EntryPoint
@@ -101,6 +102,15 @@ parseGenericInputFile = do
       )
   pure AppPath {_pathIsInput = True, ..}
 
+parseOptRename :: Parser Rename
+parseOptRename =
+  option
+    renameOpt
+    ( long "dev-rename"
+        <> metavar "RENAME_SPEC"
+        <> help "Rename an identifier while formatting"
+    )
+
 parseGenericOutputFile :: Parser (AppPath File)
 parseGenericOutputFile = do
   _pathPath <-
@@ -136,6 +146,12 @@ somePreFileOrDirOpt = mkPrepath <$> str
 somePreFileOpt :: ReadM (Prepath File)
 somePreFileOpt = mkPrepath <$> str
 
+renameOpt :: ReadM Rename
+renameOpt = eitherReader aux
+  where
+    aux :: String -> Either String Rename
+    aux = mapLeft unpack . parseRename . pack
+
 someFileOpt :: ReadM (SomeBase File)
 someFileOpt = eitherReader aux
   where

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

@@ -0,0 +1,124 @@
+module Juvix.Compiler.Concrete.Data.Rename where
+
+import Juvix.Compiler.Concrete.Data.ScopedName
+import Juvix.Compiler.Concrete.Translation.FromSource.Lexer qualified as L
+import Juvix.Compiler.Concrete.Translation.FromSource.ParserResultBuilder (ParserResultBuilder, ignoreParserResultBuilder)
+import Juvix.Data.Keyword.All qualified as Kw
+import Juvix.Data.TopModulePathKey
+import Juvix.Extra.Strings qualified as Str
+import Juvix.Prelude.Base
+import Juvix.Prelude.Parsing
+import Juvix.Prelude.Pretty
+
+data RenameCondition = RenameCondition
+  { _renamePackageName :: Maybe Text,
+    _renameModulePath :: Maybe TopModulePathKey,
+    _renameOldName :: Text
+  }
+  deriving stock (Show, Eq, Ord, Generic, Data)
+
+data Rename = Rename
+  { _renameCondition :: RenameCondition,
+    _renameNewName :: Text
+  }
+  deriving stock (Show, Eq, Ord, Generic, Data)
+
+makeLenses ''Rename
+makeLenses ''RenameCondition
+
+instance Hashable RenameCondition
+
+instance Hashable Rename
+
+applyRename :: Name' n -> Rename -> Maybe Text
+applyRename n r
+  | checkRenameCondition (r ^. renameCondition) n = Just (r ^. renameNewName)
+  | otherwise = Nothing
+
+checkRenameCondition :: RenameCondition -> Name' n -> Bool
+checkRenameCondition RenameCondition {..} n =
+  checkEq _renameModulePath (modId ^. moduleIdPath)
+    && checkEq _renamePackageName (modId ^. moduleIdPackage)
+    && checkEq (Just _renameOldName) (n ^. nameVerbatim)
+  where
+    modId :: ModuleId
+    modId = n ^. nameId . nameIdModuleId
+
+    checkEq :: (Eq a) => Maybe a -> a -> Bool
+    checkEq mt1 t2 = case mt1 of
+      Nothing -> True
+      Just t1 -> t1 == t2
+
+instance Pretty RenameCondition where
+  pretty RenameCondition {..} =
+    helper _renamePackageName
+      <> pretty Kw.delimSemicolon
+      <> helper _renameModulePath
+      <> pretty Kw.delimSemicolon
+      <> pretty _renameOldName
+    where
+      helper :: (Pretty str) => Maybe str -> Doc a
+      helper = maybe Str.underscore pretty
+
+instance Pretty Rename where
+  pretty Rename {..} =
+    pretty _renameCondition
+      <> " "
+      <> pretty Kw.kwMapsTo
+      <> " "
+      <> pretty _renameNewName
+
+{--| Rename syntax:
+<packageName>;<modulePath>;<oldname> -> <newname>
+
+Examples:
+stdlib;Stdlib.Function;if -> ite
+_;Stdlib.Function;if -> ite
+
+note that the space before '->' is mandatory because - is not a reserved symbol.
+
+It should be that:
+forall r :: Rename. parseRename (prettyText r) == r
+--}
+
+parseRename :: Text -> Either Text Rename
+parseRename = parseHelperSem parser (run . ignoreParserResultBuilder)
+  where
+    parser :: forall r. (Members '[ParserResultBuilder] r) => ParsecS r Rename
+    parser = do
+      L.whiteSpace
+      _renamePackageName <- optionalHelper L.identifier
+      L.kw Kw.delimSemicolon
+      _renameModulePath <- optionalHelper pmodulePath
+      L.kw Kw.delimSemicolon
+      _renameOldName <- L.identifier
+      L.kw Kw.kwMapsTo
+      _renameNewName <- L.identifier
+      eof
+      let _renameCondition =
+            RenameCondition
+              { _renamePackageName,
+                _renameModulePath,
+                _renameOldName
+              }
+      return
+        Rename
+          { _renameCondition,
+            _renameNewName
+          }
+      where
+        pmodulePath :: ParsecS r TopModulePathKey
+        pmodulePath =
+          nonEmptyToTopModulePathKey
+            . fmap fst
+            <$> L.dottedIdentifier
+
+        optionalHelper :: ParsecS r a -> ParsecS r (Maybe a)
+        optionalHelper p =
+          chunk Str.underscore $> Nothing
+            <|> Just <$> p
+
+tt :: Text -> IO ()
+tt t = case parseRename t of
+  Left err -> putStrLn err
+  Right x -> putStrLn (prettyText x)

src/Juvix/Compiler/Concrete/Pretty/Options.hs

@@ -1,10 +1,16 @@
-module Juvix.Compiler.Concrete.Pretty.Options where
+module Juvix.Compiler.Concrete.Pretty.Options
+  ( module Juvix.Compiler.Concrete.Pretty.Options,
+    module Juvix.Compiler.Concrete.Data.Rename,
+  )
+where
 
+import Juvix.Compiler.Concrete.Data.Rename
 import Juvix.Prelude
 
 data Options = Options
   { _optShowNameIds :: Bool,
     _optInJudocBlock :: Bool,
+    _optRenames :: [Rename],
     _optPrintPragmas :: Bool
   }
 
@@ -13,6 +19,7 @@ defaultOptions =
   Options
     { _optShowNameIds = False,
       _optInJudocBlock = False,
+      _optRenames = [],
       _optPrintPragmas = True
     }
 
@@ -21,6 +28,7 @@ traceOptions =
   Options
     { _optShowNameIds = True,
       _optInJudocBlock = False,
+      _optRenames = [],
       _optPrintPragmas = True
     }
 

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -39,7 +39,9 @@ import Juvix.Prelude.Pretty qualified as P
 --- * the body of a `Top` iterator,
 --- * the else branch body of a `Top` if expression,
 --- * the last branch body of a `Top` case expresssion.
-data IsTop = Top | NotTop
+data IsTop
+  = Top
+  | NotTop
 
 type PrettyPrintingMaybe a = forall r. (Members '[ExactPrint, Reader Options] r) => a -> Maybe (Sem r ())
 
@@ -60,11 +62,10 @@ instance PrettyPrint KeywordRef where
   ppCode p =
     morphemeM
       (getLoc p)
-      ( annotated (C.kwTypeAnn (p ^. keywordRefKeyword . keywordType))
-          . noLoc
-          . pretty
-          $ p
-      )
+      . annotated (C.kwTypeAnn (p ^. keywordRefKeyword . keywordType))
+      . noLoc
+      . pretty
+      $ p
 
 docNoComments :: (PrettyPrint c) => Options -> c -> Doc Ann
 docNoComments = docHelper Nothing
@@ -467,8 +468,13 @@ instance PrettyPrint TopModulePath where
 
 instance (PrettyPrint n) => PrettyPrint (S.Name' n) where
   ppCode :: forall r. (Members '[ExactPrint, Reader Options] r) => S.Name' n -> Sem r ()
-  ppCode S.Name' {..} = do
-    let nameConcrete' = region (C.annotateKind _nameKind) (ppCode _nameConcrete)
+  ppCode [email protected]' {..} = do
+    renames <- asks (^. optRenames)
+    -- TODO qualified names are not currently handled properly
+    let renameText :: Maybe (Doc Ann) = pretty <$> firstJust (applyRename sn) renames
+        nameConcrete' =
+          region (C.annotateKind _nameKind) $
+            maybe (ppCode _nameConcrete) noLoc renameText
     annSRef (withNameIdSuffix _nameId nameConcrete')
     where
       annSRef :: Sem r () -> Sem r ()

src/Juvix/Compiler/Concrete/Translation/FromSource/ParserResultBuilder.hs

@@ -75,6 +75,15 @@ execParserResultBuilder ::
   Sem r ParserState
 execParserResultBuilder s = fmap fst . runParserResultBuilder s
 
+ignoreParserResultBuilder ::
+  Sem (ParserResultBuilder ': r) a ->
+  Sem r a
+ignoreParserResultBuilder =
+  interpret $ \case
+    RegisterImport {} -> return ()
+    RegisterItem {} -> return ()
+    RegisterSpaceSpan {} -> return ()
+
 runParserResultBuilder ::
   (Member HighlightBuilder r) =>
   ParserState ->

src/Juvix/Formatter.hs

@@ -4,7 +4,8 @@ module Juvix.Formatter where
 
 import Juvix.Compiler.Concrete.Data.Highlight.Input (ignoreHighlightBuilder)
 import Juvix.Compiler.Concrete.Language
-import Juvix.Compiler.Concrete.Print (ppOutDefault)
+import Juvix.Compiler.Concrete.Pretty.Options
+import Juvix.Compiler.Concrete.Print (ppOut)
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping (ScoperResult, getModuleId, scopeCheck)
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromSource (ParserResult, fromSource)
@@ -67,7 +68,7 @@ instance Monoid FormatResult where
 -- contents of the file.
 format ::
   forall r.
-  (Members '[ScopeEff, Files, Output FormattedFileInfo] r) =>
+  (Members '[ScopeEff, Reader Options, Files, Output FormattedFileInfo] r) =>
   Path Abs File ->
   Sem r FormatResult
 format p = do
@@ -108,6 +109,7 @@ formatModuleInfo ::
   ( Members
       '[ PathResolver,
          Error JuvixError,
+         Reader Options,
          Files,
          Reader Package
        ]
@@ -145,7 +147,7 @@ formatModuleInfo node moduleInfo =
         forcesField sourceCodeOriginal
 
 formatPath ::
-  (Members '[Reader OriginalSource, ScopeEff] r) =>
+  (Members '[Reader Options, Reader OriginalSource, ScopeEff] r) =>
   Path Abs File ->
   Sem r Text
 formatPath p = do
@@ -154,7 +156,7 @@ formatPath p = do
 
 formatStdin ::
   forall r.
-  (Members '[Reader EntryPoint, ScopeEff, Files, Output FormattedFileInfo] r) =>
+  (Members '[Reader EntryPoint, Reader Options, ScopeEff, Files, Output FormattedFileInfo] r) =>
   Sem r FormatResult
 formatStdin = do
   entry <- ask
@@ -189,16 +191,20 @@ formatResultSourceCode filepath src = do
 formatScoperResult' ::
   Bool -> Text -> Scoper.ScoperResult -> Text
 formatScoperResult' forceFormat original sres =
-  run . runReader original $ formatScoperResult forceFormat sres
+  run
+    . runReader original
+    . runReader defaultOptions
+    $ formatScoperResult forceFormat sres
 
 formatScoperResult ::
-  (Members '[Reader OriginalSource] r) =>
+  (Members '[Reader Options, Reader OriginalSource] r) =>
   Bool ->
   Scoper.ScoperResult ->
   Sem r Text
 formatScoperResult forceFormat res = do
+  opts :: Options <- ask
   let comments = Scoper.getScoperResultComments res
-      formattedTxt = toPlainTextTrim (ppOutDefault comments (res ^. Scoper.resultModule))
+      formattedTxt = toPlainTextTrim (ppOut opts comments (res ^. Scoper.resultModule))
   runFailDefault formattedTxt $ do
     pragmas <- failMaybe (res ^. Scoper.mainModule . modulePragmas)
     PragmaFormat {..} <- failMaybe (pragmas ^. withLocParam . withSourceValue . pragmasFormat)