1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-15 10:03:22 +03:00
juvix/app/Commands/Repl.hs
Jan Mas Rovira 491f7f7508
Update ci to use ormolu 0.5.3.0 and reformat project (#2313)
Updates ormolu to 0.5.3.0 and formats the project
2023-08-25 17:37:23 +01:00

644 lines
24 KiB
Haskell

{-# LANGUAGE QuasiQuotes #-}
module Commands.Repl where
import Commands.Base hiding
( command,
)
import Commands.Repl.Base
import Commands.Repl.Options
import Control.Exception (throwIO)
import Control.Monad.Except qualified as Except
import Control.Monad.Reader qualified as Reader
import Control.Monad.State.Strict qualified as State
import Control.Monad.Trans.Class (lift)
import Data.String.Interpolate (i, __i)
import Evaluator
import Juvix.Compiler.Concrete.Data.InfoTable qualified as Scoped
import Juvix.Compiler.Concrete.Data.Scope (scopePath)
import Juvix.Compiler.Concrete.Data.ScopedName (absTopModulePath)
import Juvix.Compiler.Concrete.Data.ScopedName qualified as Scoped
import Juvix.Compiler.Concrete.Language qualified as Concrete
import Juvix.Compiler.Concrete.Pretty qualified as Concrete
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver (runPathResolver)
import Juvix.Compiler.Core qualified as Core
import Juvix.Compiler.Core.Extra.Value
import Juvix.Compiler.Core.Info qualified as Info
import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info
import Juvix.Compiler.Core.Pretty qualified as Core
import Juvix.Compiler.Core.Transformation qualified as Core
import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames)
import Juvix.Compiler.Internal.Language qualified as Internal
import Juvix.Compiler.Internal.Pretty qualified as Internal
import Juvix.Compiler.Pipeline.Repl
import Juvix.Compiler.Pipeline.Setup (entrySetup)
import Juvix.Data.Error.GenericError qualified as Error
import Juvix.Data.NameKind
import Juvix.Extra.Paths
import Juvix.Extra.Stdlib
import Juvix.Extra.Version
import Juvix.Prelude.Pretty
import Juvix.Prelude.Pretty qualified as P
import System.Console.ANSI qualified as Ansi
import System.Console.Haskeline
import System.Console.Repline
import System.Console.Repline qualified as Repline
printHelpTxt :: ReplOptions -> Repl ()
printHelpTxt opts = do
liftIO $ do
putStrLn normalCmds
let isDev = opts ^. replIsDev
when isDev (putStrLn devCmds)
where
normalCmds :: Text
normalCmds =
[__i|
EXPRESSION Evaluate an expression in the context of the currently loaded module
:help Print help text and describe options
:load FILE Load a file into the REPL
:reload Reload the currently loaded file
:type EXPRESSION Infer the type of an expression
:def IDENTIFIER Print the definition of the identifier
:doc IDENTIFIER Print the documentation of the identifier
:core EXPRESSION Translate the expression to JuvixCore
:multiline Start a multi-line input. Submit with <Ctrl-D>
:root Print the current project root
:version Display the Juvix version
:quit Exit the REPL
|]
devCmds :: Text
devCmds =
[__i|
:dev DEV CMD Command reserved for debugging
|]
replDefaultLoc :: Interval
replDefaultLoc = singletonInterval (mkInitialLoc replPath)
replFromJust :: Repl a -> Maybe a -> Repl a
replFromJust err = maybe err return
replFromEither :: Either JuvixError a -> Repl a
replFromEither = either (lift . Except.throwError) return
replGetContext :: Repl ReplContext
replGetContext = State.gets (^. replStateContext) >>= replFromJust noFileLoadedErr
replError :: AnsiText -> Repl a
replError msg =
lift
. Except.throwError
. JuvixError
$ GenericError
{ _genericErrorLoc = replDefaultLoc,
_genericErrorMessage = msg,
_genericErrorIntervals = [replDefaultLoc]
}
noFileLoadedErr :: Repl a
noFileLoadedErr = replError (mkAnsiText @Text "No file loaded. Load a file using the `:load FILE` command.")
welcomeMsg :: (MonadIO m) => m ()
welcomeMsg = liftIO (putStrLn [i|Juvix REPL version #{versionTag}: https://juvix.org. Run :help for help|])
multilineCmd :: String
multilineCmd = "multiline"
quit :: String -> Repl ()
quit _ = liftIO (throwIO Interrupt)
loadEntryPoint :: EntryPoint -> Repl ()
loadEntryPoint ep = do
artif <- liftIO (corePipelineIO' ep)
let newCtx =
ReplContext
{ _replContextArtifacts = artif,
_replContextEntryPoint = ep
}
State.modify (set replStateContext (Just newCtx))
let epPath :: Maybe (Path Abs File) = ep ^? entryPointModulePaths . _head
whenJust epPath $ \path -> liftIO (putStrLn [i|OK loaded: #{toFilePath path}|])
reloadFile :: String -> Repl ()
reloadFile _ = replGetContext >>= loadEntryPoint . (^. replContextEntryPoint)
pSomeFile :: String -> Prepath File
pSomeFile = mkPrepath
loadFile :: Prepath File -> Repl ()
loadFile f = do
entryPoint <- getReplEntryPointFromPrepath f
loadEntryPoint entryPoint
loadDefaultPrelude :: Repl ()
loadDefaultPrelude = whenJustM defaultPreludeEntryPoint $ \e -> do
root <- Reader.asks (^. replRoots . rootsRootDir)
-- The following is needed to ensure that the default location of the
-- standard library exists
void
. liftIO
. runM
. runFilesIO
. runError @Text
. runReader e
. runPathResolver root
$ entrySetup
loadEntryPoint e
getReplEntryPoint :: (Roots -> a -> GlobalOptions -> IO EntryPoint) -> a -> Repl EntryPoint
getReplEntryPoint f inputFile = do
roots <- Reader.asks (^. replRoots)
gopts <- State.gets (^. replStateGlobalOptions)
liftIO (set entryPointSymbolPruningMode KeepAll <$> f roots inputFile gopts)
getReplEntryPointFromPrepath :: Prepath File -> Repl EntryPoint
getReplEntryPointFromPrepath = getReplEntryPoint entryPointFromGlobalOptionsPre
getReplEntryPointFromPath :: Path Abs File -> Repl EntryPoint
getReplEntryPointFromPath = getReplEntryPoint entryPointFromGlobalOptions
displayVersion :: String -> Repl ()
displayVersion _ = liftIO (putStrLn versionTag)
replCommand :: ReplOptions -> String -> Repl ()
replCommand opts input = catchAll $ do
ctx <- replGetContext
let tab = ctx ^. replContextArtifacts . artifactCoreTable
evalRes <- compileThenEval ctx input
whenJust evalRes $ \n ->
if
| Info.member Info.kNoDisplayInfo (Core.getInfo n) -> return ()
| opts ^. replPrintValues ->
renderOutLn (Core.ppOut opts (toValue tab n))
| otherwise -> renderOutLn (Core.ppOut opts n)
where
compileThenEval :: ReplContext -> String -> Repl (Maybe Core.Node)
compileThenEval ctx s = compileString >>= mapM eval
where
artif :: Artifacts
artif = ctx ^. replContextArtifacts
eval :: Core.Node -> Repl Core.Node
eval n = do
ep <- getReplEntryPointFromPrepath (mkPrepath (toFilePath replPath))
let shouldDisambiguate :: Bool
shouldDisambiguate = not (opts ^. replNoDisambiguate)
(artif', n') <-
replFromEither
. run
. runReader ep
. runError @JuvixError
. runState artif
. runTransformations shouldDisambiguate (opts ^. replTransformations)
$ n
liftIO (doEvalIO' artif' n') >>= replFromEither
doEvalIO' :: Artifacts -> Core.Node -> IO (Either JuvixError Core.Node)
doEvalIO' artif' n =
mapLeft (JuvixError @Core.CoreError)
<$> doEvalIO False replDefaultLoc (artif' ^. artifactCoreTable) n
compileString :: Repl (Maybe Core.Node)
compileString = do
(artifacts, res) <- liftIO $ compileReplInputIO' ctx (strip (pack s))
res' <- replFromEither res
State.modify (over (replStateContext . _Just) (set replContextArtifacts artifacts))
return res'
core :: String -> Repl ()
core input = do
ctx <- replGetContext
opts <- Reader.asks (^. replOptions)
compileRes <- liftIO (compileReplInputIO' ctx (strip (pack input))) >>= replFromEither . snd
whenJust compileRes (renderOutLn . Core.ppOut opts)
dev :: String -> Repl ()
dev input = do
ctx <- replGetContext
if
| input == scoperStateCmd -> do
renderOutLn (Concrete.ppTrace (ctx ^. replContextArtifacts . artifactScoperState))
| otherwise ->
renderOutLn
( "Unrecognized command "
<> input
<> "\nAvailable commands: "
<> unwords cmds
)
where
cmds :: [String]
cmds = [scoperStateCmd]
scoperStateCmd :: String
scoperStateCmd = "scoperState"
ppConcrete :: (Concrete.PrettyPrint a) => a -> Repl AnsiText
ppConcrete a = do
gopts <- State.gets (^. replStateGlobalOptions)
let popts :: GenericOptions = project' gopts
return (Concrete.ppOut popts a)
printConcrete :: (Concrete.PrettyPrint a) => a -> Repl ()
printConcrete = ppConcrete >=> renderOut
printConcreteLn :: (Concrete.PrettyPrint a) => a -> Repl ()
printConcreteLn = ppConcrete >=> renderOutLn
replParseIdentifiers :: String -> Repl (NonEmpty Concrete.ScopedIden)
replParseIdentifiers input =
replExpressionUpToScopedAtoms (strip (pack input))
>>= getIdentifiers
where
getIdentifiers :: Concrete.ExpressionAtoms 'Concrete.Scoped -> Repl (NonEmpty Concrete.ScopedIden)
getIdentifiers as = mapM getIdentifier (as ^. Concrete.expressionAtoms)
where
getIdentifier :: Concrete.ExpressionAtom 'Concrete.Scoped -> Repl (Concrete.ScopedIden)
getIdentifier = \case
Concrete.AtomIdentifier a -> return a
Concrete.AtomParens p
| Concrete.ExpressionIdentifier a <- p -> return a
| Concrete.ExpressionParensIdentifier a <- p -> return a
_ -> err
where
err :: Repl a
err = replError (mkAnsiText @Text ":def expects one or more identifiers")
printDocumentation :: String -> Repl ()
printDocumentation = replParseIdentifiers >=> printIdentifiers
where
printIdentifiers :: NonEmpty Concrete.ScopedIden -> Repl ()
printIdentifiers (d :| ds) = do
printIdentifier d
whenJust (nonEmpty ds) $ \ds' -> replNewline >> printIdentifiers ds'
where
getInfoTable :: Repl Scoped.InfoTable
getInfoTable = (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
printIdentifier :: Concrete.ScopedIden -> Repl ()
printIdentifier s = do
let n = s ^. Concrete.scopedIdenFinal . Scoped.nameId
mdoc <- case getNameKind s of
KNameAxiom -> getDocAxiom n
KNameInductive -> getDocInductive n
KNameLocal -> return Nothing
KNameFunction -> getDocFunction n
KNameConstructor -> getDocConstructor n
KNameLocalModule -> impossible
KNameTopModule -> impossible
KNameAlias -> impossible
KNameFixity -> impossible
printDoc mdoc
where
printDoc :: Maybe (Concrete.Judoc 'Concrete.Scoped) -> Repl ()
printDoc = \case
Nothing -> do
s' <- ppConcrete s
renderOut (mkAnsiText @Text "No documentation available for ")
renderOutLn s'
Just ju -> printConcrete ju
getDocFunction :: Scoped.NameId -> Repl (Maybe (Concrete.Judoc 'Concrete.Scoped))
getDocFunction fun = do
tbl :: Scoped.InfoTable <- getInfoTable
let def :: Scoped.FunctionInfo = tbl ^?! Scoped.infoFunctions . at fun . _Just
return (def ^. Scoped.functionInfoDoc)
getDocInductive :: Scoped.NameId -> Repl (Maybe (Concrete.Judoc 'Concrete.Scoped))
getDocInductive ind = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let def :: Concrete.InductiveDef 'Concrete.Scoped = tbl ^?! Scoped.infoInductives . at ind . _Just . Scoped.inductiveInfoDef
return (def ^. Concrete.inductiveDoc)
getDocAxiom :: Scoped.NameId -> Repl (Maybe (Concrete.Judoc 'Concrete.Scoped))
getDocAxiom ax = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let def :: Concrete.AxiomDef 'Concrete.Scoped = tbl ^?! Scoped.infoAxioms . at ax . _Just . Scoped.axiomInfoDef
return (def ^. Concrete.axiomDoc)
getDocConstructor :: Scoped.NameId -> Repl (Maybe (Concrete.Judoc 'Concrete.Scoped))
getDocConstructor c = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let def :: Scoped.ConstructorInfo = tbl ^?! Scoped.infoConstructors . at c . _Just
return (def ^. Scoped.constructorInfoDef . Concrete.constructorDoc)
printDefinition :: String -> Repl ()
printDefinition = replParseIdentifiers >=> printIdentifiers
where
printIdentifiers :: NonEmpty Concrete.ScopedIden -> Repl ()
printIdentifiers (d :| ds) = do
printIdentifier d
whenJust (nonEmpty ds) $ \ds' -> replNewline >> printIdentifiers ds'
where
getInfoTable :: Repl Scoped.InfoTable
getInfoTable = (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
printIdentifier :: Concrete.ScopedIden -> Repl ()
printIdentifier s =
let n = s ^. Concrete.scopedIdenFinal . Scoped.nameId
in case getNameKind s of
KNameAxiom -> printAxiom n
KNameInductive -> printInductive n
KNameLocal -> return ()
KNameFunction -> printFunction n
KNameConstructor -> printConstructor n
KNameLocalModule -> impossible
KNameTopModule -> impossible
KNameFixity -> impossible
KNameAlias -> impossible
where
printLocation :: (HasLoc s) => s -> Repl ()
printLocation def = do
s' <- ppConcrete s
let txt :: Text = " is " <> prettyText (nameKindWithArticle (getNameKind s)) <> " defined at " <> prettyText (getLoc def)
renderOutLn (s' <> mkAnsiText txt)
printFunction :: Scoped.NameId -> Repl ()
printFunction fun = do
tbl :: Scoped.InfoTable <- getInfoTable
let def :: Scoped.FunctionInfo = tbl ^?! Scoped.infoFunctions . at fun . _Just
printLocation def
printConcreteLn def
printInductive :: Scoped.NameId -> Repl ()
printInductive ind = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let def :: Concrete.InductiveDef 'Concrete.Scoped = tbl ^?! Scoped.infoInductives . at ind . _Just . Scoped.inductiveInfoDef
printLocation def
printConcreteLn def
printAxiom :: Scoped.NameId -> Repl ()
printAxiom ax = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let def :: Concrete.AxiomDef 'Concrete.Scoped = tbl ^?! Scoped.infoAxioms . at ax . _Just . Scoped.axiomInfoDef
printLocation def
printConcreteLn def
printConstructor :: Scoped.NameId -> Repl ()
printConstructor c = do
tbl :: Scoped.InfoTable <- (^. replContextArtifacts . artifactScopeTable) <$> replGetContext
let ind :: Scoped.Symbol = tbl ^?! Scoped.infoConstructors . at c . _Just . Scoped.constructorInfoTypeName
printInductive (ind ^. Scoped.nameId)
inferType :: String -> Repl ()
inferType input = do
gopts <- State.gets (^. replStateGlobalOptions)
n <- replExpressionUpToTyped (strip (pack input))
renderOutLn (Internal.ppOut (project' @GenericOptions gopts) (n ^. Internal.typedType))
replCommands :: ReplOptions -> [(String, String -> Repl ())]
replCommands opts = catchable ++ nonCatchable
where
nonCatchable :: [(String, String -> Repl ())]
nonCatchable =
[ ("quit", quit)
]
catchable :: [(String, String -> Repl ())]
catchable =
map
(second (catchAll .))
[ ("help", const (printHelpTxt opts)),
-- `multiline` is included here for auto-completion purposes only.
-- `repline`'s `multilineCommand` logic overrides this no-op.
(multilineCmd, const (return ())),
("load", loadFile . pSomeFile),
("reload", reloadFile),
("root", printRoot),
("def", printDefinition),
("doc", printDocumentation),
("type", inferType),
("version", displayVersion),
("core", core),
("dev", dev)
]
catchAll :: Repl () -> Repl ()
catchAll = Repline.dontCrash . catchJuvixError
where
catchJuvixError :: Repl () -> Repl ()
catchJuvixError (HaskelineT m) = HaskelineT (mapInputT_ catchErrorS m)
where
catchErrorS :: ReplS () -> ReplS ()
catchErrorS = (`Except.catchError` printErrorS)
defaultMatcher :: [(String, CompletionFunc ReplS)]
defaultMatcher = [(":load", fileCompleter)]
optsCompleter :: WordCompleter ReplS
optsCompleter n = do
opts <- Reader.asks (^. replOptions)
let names = (":" <>) . fst <$> replCommands opts
return (filter (isPrefixOf n) names)
replBanner :: MultiLine -> Repl String
replBanner = \case
MultiLine -> return "... "
SingleLine -> do
mmodulePath <-
State.gets
( ^?
replStateContext
. _Just
. replContextArtifacts
. artifactMainModuleScope
. _Just
. scopePath
. absTopModulePath
)
return $ case mmodulePath of
Just path -> [i|#{unpack (P.prettyText path)}> |]
Nothing -> "juvix> "
replPrefix :: Maybe Char
replPrefix = Just ':'
replMultilineCommand :: Maybe String
replMultilineCommand = Just multilineCmd
replInitialiser :: Repl ()
replInitialiser = do
gopts <- State.gets (^. replStateGlobalOptions)
opts <- Reader.asks (^. replOptions)
welcomeMsg
unless
(opts ^. replNoPrelude || gopts ^. globalNoStdlib)
(maybe loadDefaultPrelude (loadFile . (^. pathPath)) (opts ^. replInputFile))
replFinaliser :: Repl ExitDecision
replFinaliser = return Exit
replTabComplete :: CompleterStyle ReplS
replTabComplete = Prefix (wordCompleter optsCompleter) defaultMatcher
printRoot :: String -> Repl ()
printRoot _ = do
r <- State.gets (^. replStateRoots . rootsRootDir)
liftIO $ putStrLn (pack (toFilePath r))
runCommand :: (Members '[Embed IO, App] r) => ReplOptions -> Sem r ()
runCommand opts = do
roots <- askRoots
let replAction :: ReplS ()
replAction = do
evalReplOpts
ReplOpts
{ prefix = replPrefix,
multilineCommand = replMultilineCommand,
initialiser = replInitialiser,
finaliser = replFinaliser,
tabComplete = replTabComplete,
command = replCommand opts,
options = replCommands opts,
banner = replBanner
}
globalOptions <- askGlobalOptions
let env =
ReplEnv
{ _replRoots = roots,
_replOptions = opts
}
iniState =
ReplState
{ _replStateRoots = roots,
_replStateContext = Nothing,
_replStateGlobalOptions = globalOptions
}
e <-
embed
. Except.runExceptT
. (`State.evalStateT` iniState)
. (`Reader.runReaderT` env)
$ replAction
case e of
Left {} -> error "impossible: uncaught exception"
Right () -> return ()
-- | If the package contains the stdlib as a dependency, loads the Prelude
defaultPreludeEntryPoint :: Repl (Maybe EntryPoint)
defaultPreludeEntryPoint = do
roots <- State.gets (^. replStateRoots)
let buildDir = roots ^. rootsBuildDir
root = roots ^. rootsRootDir
pkg = roots ^. rootsPackage
mstdlibPath <- liftIO (runM (runFilesIO (packageStdlib root buildDir (pkg ^. packageDependencies))))
case mstdlibPath of
Just stdlibPath ->
Just . set entryPointResolverRoot stdlibPath
<$> getReplEntryPointFromPath (stdlibPath <//> preludePath)
Nothing -> return Nothing
replMakeAbsolute :: SomeBase b -> Repl (Path Abs b)
replMakeAbsolute = \case
Abs p -> return p
Rel r -> do
invokeDir <- State.gets (^. replStateRoots . rootsInvokeDir)
return (invokeDir <//> r)
replExpressionUpToScopedAtoms :: Text -> Repl (Concrete.ExpressionAtoms 'Concrete.Scoped)
replExpressionUpToScopedAtoms txt = do
ctx <- replGetContext
x <-
liftIO
. runM
. runError
. evalState (ctx ^. replContextArtifacts)
. runReader (ctx ^. replContextEntryPoint)
$ expressionUpToAtomsScoped replPath txt
replFromEither x
replExpressionUpToTyped :: Text -> Repl Internal.TypedExpression
replExpressionUpToTyped txt = do
ctx <- replGetContext
x <-
liftIO
. runM
. runError
. evalState (ctx ^. replContextArtifacts)
. runReader (ctx ^. replContextEntryPoint)
$ expressionUpToTyped replPath txt
replFromEither x
compileReplInputIO' :: ReplContext -> Text -> IO (Artifacts, (Either JuvixError (Maybe Core.Node)))
compileReplInputIO' ctx txt =
runM
. runState (ctx ^. replContextArtifacts)
. runReader (ctx ^. replContextEntryPoint)
$ do
r <- compileReplInputIO replPath txt
return (extractNode <$> r)
where
extractNode :: ReplPipelineResult -> Maybe Core.Node
extractNode = \case
ReplPipelineResultNode n -> Just n
ReplPipelineResultImport {} -> Nothing
ReplPipelineResultOpenImport {} -> Nothing
render' :: (P.HasAnsiBackend a, P.HasTextBackend a) => a -> Repl ()
render' t = do
opts <- State.gets (^. replStateGlobalOptions)
hasAnsi <- liftIO (Ansi.hSupportsANSIColor stdout)
liftIO (P.renderIO (not (opts ^. globalNoColors) && hasAnsi) t)
replNewline :: Repl ()
replNewline = liftIO (putStrLn "")
renderOut :: (P.HasAnsiBackend a, P.HasTextBackend a) => a -> Repl ()
renderOut = render'
renderOutLn :: (P.HasAnsiBackend a, P.HasTextBackend a) => a -> Repl ()
renderOutLn t = renderOut t >> replNewline
printErrorS :: JuvixError -> ReplS ()
printErrorS e = do
opts <- State.gets (^. replStateGlobalOptions)
hasAnsi <- liftIO (Ansi.hSupportsANSIColor stderr)
liftIO $ hPutStrLn stderr $ run (runReader (project' @GenericOptions opts) (Error.render (not (opts ^. globalNoColors) && hasAnsi) False e))
runTransformations ::
forall r.
(Members '[State Artifacts, Error JuvixError, Reader EntryPoint] r) =>
Bool ->
[Core.TransformationId] ->
Core.Node ->
Sem r Core.Node
runTransformations shouldDisambiguate ts n = runCoreInfoTableBuilderArtifacts $ do
sym <- addNode n
applyTransforms shouldDisambiguate ts
getNode sym
where
addNode :: Core.Node -> Sem (Core.InfoTableBuilder ': r) Core.Symbol
addNode node = do
sym <- Core.freshSymbol
Core.registerIdentNode sym node
-- `n` will get filtered out by the transformations unless it has a
-- corresponding entry in `infoIdentifiers`
tab <- Core.getInfoTable
let name = Core.freshIdentName tab "_repl"
idenInfo =
Core.IdentifierInfo
{ _identifierName = name,
_identifierSymbol = sym,
_identifierLocation = Nothing,
_identifierArgsNum = 0,
_identifierType = Core.mkDynamic',
_identifierIsExported = False,
_identifierBuiltin = Nothing,
_identifierPragmas = mempty,
_identifierArgNames = []
}
Core.registerIdent name idenInfo
return sym
applyTransforms :: Bool -> [Core.TransformationId] -> Sem (Core.InfoTableBuilder ': r) ()
applyTransforms shouldDisambiguate' ts' = do
tab <- Core.getInfoTable
tab' <- mapReader Core.fromEntryPoint $ Core.applyTransformations ts' tab
let tab'' =
if
| shouldDisambiguate' -> disambiguateNames tab'
| otherwise -> tab'
Core.setInfoTable tab''
getNode :: Core.Symbol -> Sem (Core.InfoTableBuilder ': r) Core.Node
getNode sym = fromMaybe impossible . flip Core.lookupIdentifierNode' sym <$> Core.getInfoTable