Add option to specify Core transformations to internal core-eval

anoma · Dec 14, 2022 · 78fbd25 · 78fbd25
1 parent d091322
commit 78fbd25
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 16 deletions.
diff --git a/app/Commands/Dev/Core/Read/Options.hs b/app/Commands/Dev/Core/Read/Options.hs
@@ -3,7 +3,7 @@ module Commands.Dev.Core.Read.Options where
 import Commands.Dev.Core.Eval.Options qualified as Eval
 import CommonOptions
 import Evaluator qualified
-import Juvix.Compiler.Core.Data.TransformationId.Parser
+import Juvix.Compiler.Core.Data.TransformationId
 import Juvix.Compiler.Core.Pretty.Options qualified as Core
 
 data CoreReadOptions = CoreReadOptions
@@ -51,18 +51,6 @@ parseCoreReadOptions = do
       ( long "eval"
           <> help "evaluate after the transformation"
       )
-  _coreReadTransformations <-
-    option
-      (eitherReader parseTransf)
-      ( long "transforms"
-          <> short 't'
-          <> value mempty
-          <> metavar "[Transform]"
-          <> completer (mkCompleter (return . completionsString))
-          <> help "hint: use autocomplete"
-      )
+  _coreReadTransformations <- optTransformationIds
   _coreReadInputFile <- parseInputJuvixCoreFile
   pure CoreReadOptions {..}
-  where
-    parseTransf :: String -> Either String [TransformationId]
-    parseTransf = mapLeft unpack . parseTransformations . pack
diff --git a/app/Commands/Dev/Internal/CoreEval.hs b/app/Commands/Dev/Internal/CoreEval.hs
@@ -5,9 +5,11 @@ import Commands.Dev.Internal.CoreEval.Options
 import Data.HashMap.Strict qualified as HashMap
 import Evaluator
 import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Transformation qualified as Core
 import Juvix.Compiler.Core.Translation
 
 runCommand :: Members '[Embed IO, App] r => InternalCoreEvalOptions -> Sem r ()
 runCommand localOpts = do
   tab <- (^. coreResultTable) <$> runPipeline (localOpts ^. internalCoreEvalInputFile) upToCore
-  forM_ ((tab ^. infoMain) >>= ((tab ^. identContext) HashMap.!?)) (evalAndPrint localOpts tab)
+  let tab' = Core.applyTransformations (project localOpts ^. internalCoreEvalTransformations) tab
+  forM_ ((tab' ^. infoMain) >>= ((tab' ^. identContext) HashMap.!?)) (evalAndPrint localOpts tab')
diff --git a/app/Commands/Dev/Internal/CoreEval/Options.hs b/app/Commands/Dev/Internal/CoreEval/Options.hs
@@ -2,10 +2,12 @@ module Commands.Dev.Internal.CoreEval.Options where
 
 import CommonOptions
 import Evaluator qualified as Eval
+import Juvix.Compiler.Core.Data.TransformationId
 import Juvix.Compiler.Core.Pretty.Options qualified as Core
 
 data InternalCoreEvalOptions = InternalCoreEvalOptions
-  { _internalCoreEvalShowDeBruijn :: Bool,
+  { _internalCoreEvalTransformations :: [TransformationId],
+    _internalCoreEvalShowDeBruijn :: Bool,
     _internalCoreEvalNoIO :: Bool,
     _internalCoreEvalInputFile :: Path
   }
@@ -28,6 +30,7 @@ instance CanonicalProjection InternalCoreEvalOptions Eval.EvalOptions where
 
 parseInternalCoreEval :: Parser InternalCoreEvalOptions
 parseInternalCoreEval = do
+  _internalCoreEvalTransformations <- optTransformationIds
   _internalCoreEvalShowDeBruijn <-
     switch
       ( long "show-de-bruijn"

diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs
@@ -7,6 +7,7 @@ module CommonOptions
 where
 
 import Control.Exception qualified as GHC
+import Juvix.Compiler.Core.Data.TransformationId.Parser
 import Juvix.Prelude
 import Options.Applicative
 import System.Process
@@ -194,3 +195,18 @@ optDeBruijn =
     ( long "show-de-bruijn"
         <> help "Show variable de Bruijn indices"
     )
+
+optTransformationIds :: Parser [TransformationId]
+optTransformationIds =
+  option
+    (eitherReader parseTransf)
+    ( long "transforms"
+        <> short 't'
+        <> value mempty
+        <> metavar "[Transform]"
+        <> completer (mkCompleter (return . completionsString))
+        <> help "hint: use autocomplete"
+    )
+  where
+    parseTransf :: String -> Either String [TransformationId]
+    parseTransf = mapLeft unpack . parseTransformations . pack