From 41cdf5e56aad888e665a65bf0521e3c653bdc6f2 Mon Sep 17 00:00:00 2001 From: Eve Date: Tue, 28 Jan 2025 01:01:13 +0100 Subject: [PATCH] Load prelude in repl --- src/compiler/api/GF/Compile/Repl.hs | 41 ++++++++++++++++++----------- src/compiler/gf-repl.hs | 2 +- 2 files changed, 26 insertions(+), 17 deletions(-) diff --git a/src/compiler/api/GF/Compile/Repl.hs b/src/compiler/api/GF/Compile/Repl.hs index ec7edf339..f3b748361 100644 --- a/src/compiler/api/GF/Compile/Repl.hs +++ b/src/compiler/api/GF/Compile/Repl.hs @@ -2,18 +2,20 @@ module GF.Compile.Repl (ReplOpts(..), defaultReplOpts, replOptDescrs, getReplOpts, runRepl, runRepl') where -import Control.Monad (unless, forM_) +import Control.Monad (unless, forM_, foldM) import Control.Monad.IO.Class (MonadIO) -import Data.Char (isSpace) import qualified Data.ByteString.Char8 as BS +import Data.Char (isSpace) +import Data.Function ((&)) +import Data.Functor ((<&>)) import qualified Data.Map as Map -import System.Console.GetOpt (getOpt, ArgOrder(RequireOrder), OptDescr(..), ArgDescr(..)) +import System.Console.GetOpt (ArgOrder(RequireOrder), OptDescr(..), ArgDescr(..), getOpt, usageInfo) import System.Console.Haskeline (InputT, Settings(..), noCompletion, runInputT, getInputLine, outputStrLn) import System.Directory (getAppUserDataDirectory) import GF.Compile (batchCompile) -import GF.Compile.Compute.Concrete (Globals(Gl), normalFlatForm) +import GF.Compile.Compute.Concrete (Globals(Gl), stdPredef, normalFlatForm) import GF.Compile.Rename (renameSourceTerm) import GF.Compile.TypeCheck.ConcreteNew (inferLType) import GF.Data.ErrM (Err(..)) @@ -37,6 +39,7 @@ import GF.Grammar.Printer (TermPrintQual(Unqualified), ppTerm) import GF.Infra.CheckM (Check, runCheck) import GF.Infra.Ident (moduleNameS) import GF.Infra.Option (noOptions) +import GF.Infra.UseIO (justModuleName) import GF.Text.Pretty (render) data ReplOpts = ReplOpts @@ -47,17 +50,23 @@ data ReplOpts = ReplOpts defaultReplOpts :: ReplOpts defaultReplOpts = ReplOpts False [] -replOptDescrs :: [OptDescr (ReplOpts -> ReplOpts)] -replOptDescrs = - [ Option [] ["no-prelude"] (NoArg $ \o -> o { noPrelude = True }) "Don't load the prelude." - ] +type Errs a = Either [String] a +type ReplOptsOp = ReplOpts -> Errs ReplOpts -getReplOpts :: [String] -> Either [String] ReplOpts +replOptDescrs :: [OptDescr ReplOptsOp] +replOptDescrs = + [ Option ['h'] ["help"] (NoArg $ \o -> Left [usageInfo "gfci" replOptDescrs]) "Display help." + , Option [] ["no-prelude"] (flag $ \o -> o { noPrelude = True }) "Don't load the prelude." + ] + where + flag f = NoArg $ \o -> pure (f o) + +getReplOpts :: [String] -> Errs ReplOpts getReplOpts args = case errs of - [] -> Right $ (foldr ($) defaultReplOpts flags) { inputFiles = inputFiles } + [] -> foldM (&) defaultReplOpts flags <&> \o -> o { inputFiles = inputFiles } _ -> Left errs where - (flags, inputFiles, errs) = getOpt RequireOrder [] args + (flags, inputFiles, errs) = getOpt RequireOrder replOptDescrs args execCheck :: MonadIO m => Check a -> (a -> InputT m ()) -> InputT m () execCheck c k = case runCheck c of @@ -110,12 +119,12 @@ runRepl' gl@(Gl g _) = do runRepl :: ReplOpts -> IO () runRepl (ReplOpts noPrelude inputFiles) = do -- TODO accept an ngf grammar - -- TODO load prelude - (g0, opens) <- case inputFiles of + let toLoad = if noPrelude then inputFiles else "prelude/Predef.gfo" : inputFiles + (g0, opens) <- case toLoad of [] -> pure (mGrammar [], []) _ -> do - (_, (pModName, g0)) <- batchCompile noOptions Nothing inputFiles - pure (g0, [OSimple pModName]) + (_, (_, g0)) <- batchCompile noOptions Nothing toLoad + pure (g0, OSimple . moduleNameS . justModuleName <$> toLoad) let modInfo = ModInfo { mtype = MTResource @@ -129,4 +138,4 @@ runRepl (ReplOpts noPrelude inputFiles) = do , mseqs = Nothing , jments = Map.empty } - runRepl' (Gl (prependModule g0 (replModName, modInfo)) Map.empty) + runRepl' (Gl (prependModule g0 (replModName, modInfo)) (if noPrelude then Map.empty else stdPredef)) diff --git a/src/compiler/gf-repl.hs b/src/compiler/gf-repl.hs index 7152a212c..5b890fa9e 100644 --- a/src/compiler/gf-repl.hs +++ b/src/compiler/gf-repl.hs @@ -8,5 +8,5 @@ main = do setLocaleEncoding utf8 args <- getArgs case getReplOpts args of - Left errs -> mapM_ print errs + Left errs -> mapM_ putStrLn errs Right opts -> runRepl opts