From 3ccb3749345fdf92665f56f401d73f6ffc884da7 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Fri, 26 Jan 2024 12:54:34 +0100 Subject: [PATCH] options for read --- app/Commands/Dev/Core/FromConcrete/Options.hs | 2 +- app/Commands/Dev/Core/Read/Options.hs | 8 +++--- app/Commands/Dev/Repl/Options.hs | 2 +- app/Commands/Dev/Tree/Read.hs | 18 +++++++++++- app/Commands/Dev/Tree/Read/Options.hs | 19 +++++++++++-- app/CommonOptions.hs | 28 +++++++++++++++---- 6 files changed, 62 insertions(+), 15 deletions(-) diff --git a/app/Commands/Dev/Core/FromConcrete/Options.hs b/app/Commands/Dev/Core/FromConcrete/Options.hs index 12120757a3..e123f07861 100644 --- a/app/Commands/Dev/Core/FromConcrete/Options.hs +++ b/app/Commands/Dev/Core/FromConcrete/Options.hs @@ -41,7 +41,7 @@ instance CanonicalProjection CoreFromConcreteOptions Eval.EvalOptions where parseCoreFromConcreteOptions :: Parser CoreFromConcreteOptions parseCoreFromConcreteOptions = do - _coreFromConcreteTransformations <- optTransformationIds + _coreFromConcreteTransformations <- optCoreTransformationIds _coreFromConcreteShowDeBruijn <- optDeBruijn _coreFromConcreteShowIdentIds <- optIdentIds _coreFromConcreteShowArgsNum <- optArgsNum diff --git a/app/Commands/Dev/Core/Read/Options.hs b/app/Commands/Dev/Core/Read/Options.hs index 465f3372c6..a40a947a29 100644 --- a/app/Commands/Dev/Core/Read/Options.hs +++ b/app/Commands/Dev/Core/Read/Options.hs @@ -58,18 +58,18 @@ parseCoreReadOptions = do _coreReadNoPrint <- switch ( long "no-print" - <> help "do not print the transformed code" + <> help "Do not print the transformed code" ) _coreReadEval <- switch ( long "eval" - <> help "evaluate after the transformation" + <> help "Evaluate after the transformation" ) _coreReadNormalize <- switch ( long "normalize" - <> help "normalize after the transformation" + <> help "Normalize after the transformation" ) - _coreReadTransformations <- optTransformationIds + _coreReadTransformations <- optCoreTransformationIds _coreReadInputFile <- parseInputFile FileExtJuvixCore pure CoreReadOptions {..} diff --git a/app/Commands/Dev/Repl/Options.hs b/app/Commands/Dev/Repl/Options.hs index 6f922cf21d..ec4ea41734 100644 --- a/app/Commands/Dev/Repl/Options.hs +++ b/app/Commands/Dev/Repl/Options.hs @@ -10,7 +10,7 @@ parseDevRepl = do _replIsDev = True _replInputFile <- optional (parseInputFile FileExtJuvix) _replTransformations <- do - ts <- optTransformationIds + ts <- optCoreTransformationIds pure $ if | null ts -> toStoredTransformations diff --git a/app/Commands/Dev/Tree/Read.hs b/app/Commands/Dev/Tree/Read.hs index 3ad8424960..eddbe6b02d 100644 --- a/app/Commands/Dev/Tree/Read.hs +++ b/app/Commands/Dev/Tree/Read.hs @@ -2,8 +2,11 @@ module Commands.Dev.Tree.Read where import Commands.Base import Commands.Dev.Tree.Read.Options +import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree import Juvix.Compiler.Tree.Pretty qualified as Tree +import Juvix.Compiler.Tree.Transformation qualified as Tree import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree +import TreeEvaluator qualified as Eval runCommand :: forall r. (Members '[Embed IO, App] r) => TreeReadOptions -> Sem r () runCommand opts = do @@ -11,7 +14,20 @@ runCommand opts = do s <- readFile (toFilePath afile) case Tree.runParser (toFilePath afile) s of Left err -> exitJuvixError (JuvixError err) - Right tab -> renderStdOut (Tree.ppOutDefault tab tab) + Right tab -> do + tab' <- Tree.applyTransformations (project opts ^. treeReadTransformations) tab + unless (project opts ^. treeReadNoPrint) $ + renderStdOut (Tree.ppOutDefault tab' tab') + doEval tab' where file :: AppPath File file = opts ^. treeReadInputFile + + doEval :: Tree.InfoTable -> Sem r () + doEval tab' + | project opts ^. treeReadEval = do + putStrLn "--------------------------------" + putStrLn "| Eval |" + putStrLn "--------------------------------" + Eval.evalTree tab' + | otherwise = return () diff --git a/app/Commands/Dev/Tree/Read/Options.hs b/app/Commands/Dev/Tree/Read/Options.hs index 9c6e76c1d8..babdc0267c 100644 --- a/app/Commands/Dev/Tree/Read/Options.hs +++ b/app/Commands/Dev/Tree/Read/Options.hs @@ -1,9 +1,13 @@ module Commands.Dev.Tree.Read.Options where import CommonOptions +import Juvix.Compiler.Tree.Data.TransformationId -newtype TreeReadOptions = TreeReadOptions - { _treeReadInputFile :: AppPath File +data TreeReadOptions = TreeReadOptions + { _treeReadTransformations :: [TransformationId], + _treeReadEval :: Bool, + _treeReadNoPrint :: Bool, + _treeReadInputFile :: AppPath File } deriving stock (Data) @@ -11,5 +15,16 @@ makeLenses ''TreeReadOptions parseTreeReadOptions :: Parser TreeReadOptions parseTreeReadOptions = do + _treeReadNoPrint <- + switch + ( long "no-print" + <> help "Do not print the transformed code" + ) + _treeReadEval <- + switch + ( long "eval" + <> help "Evaluate after the transformation" + ) + _treeReadTransformations <- optTreeTransformationIds _treeReadInputFile <- parseInputFile FileExtJuvixTree pure TreeReadOptions {..} diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index 34431460d3..cd4e4ec57d 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -8,7 +8,8 @@ where import Control.Exception qualified as GHC import Data.List.NonEmpty qualified as NonEmpty -import Juvix.Compiler.Core.Data.TransformationId.Parser +import Juvix.Compiler.Core.Data.TransformationId.Parser qualified as Core +import Juvix.Compiler.Tree.Data.TransformationId.Parser qualified as Tree import Juvix.Data.FileExt import Juvix.Prelude import Options.Applicative @@ -216,17 +217,32 @@ optNoDisambiguate = <> help "Don't disambiguate the names of bound variables" ) -optTransformationIds :: Parser [TransformationId] -optTransformationIds = +optCoreTransformationIds :: Parser [Core.TransformationId] +optCoreTransformationIds = option (eitherReader parseTransf) ( long "transforms" <> short 't' <> value [] <> metavar "[Transform]" - <> completer (mkCompleter (return . completionsString)) + <> completer (mkCompleter (return . Core.completionsString)) <> help "hint: use autocomplete" ) where - parseTransf :: String -> Either String [TransformationId] - parseTransf = mapLeft unpack . parseTransformations . pack + parseTransf :: String -> Either String [Core.TransformationId] + parseTransf = mapLeft unpack . Core.parseTransformations . pack + +optTreeTransformationIds :: Parser [Tree.TransformationId] +optTreeTransformationIds = + option + (eitherReader parseTransf) + ( long "transforms" + <> short 't' + <> value [] + <> metavar "[Transform]" + <> completer (mkCompleter (return . Tree.completionsString)) + <> help "hint: use autocomplete" + ) + where + parseTransf :: String -> Either String [Tree.TransformationId] + parseTransf = mapLeft unpack . Tree.parseTransformations . pack