JuvixReg interpreter (#2635)

* Closes #2577 
* Adds the `juvix dev reg run file.jvr` command.
* Adds interpreter tests.

app/Commands/Dev/Reg.hs

@@ -3,7 +3,9 @@ module Commands.Dev.Reg where
 import Commands.Base
 import Commands.Dev.Reg.Options
 import Commands.Dev.Reg.Read as Read
+import Commands.Dev.Reg.Run as Run
 
 runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => RegCommand -> Sem r ()
 runCommand = \case
+  Run opts -> Run.runCommand opts
   Read opts -> Read.runCommand opts

app/Commands/Dev/Reg/Options.hs

@@ -1,22 +1,34 @@
 module Commands.Dev.Reg.Options where
 
 import Commands.Dev.Reg.Read.Options
+import Commands.Dev.Reg.Run.Options
 import CommonOptions
 
-newtype RegCommand
-  = Read RegReadOptions
+data RegCommand
+  = Run RegRunOptions
+  | Read RegReadOptions
   deriving stock (Data)
 
 parseRegCommand :: Parser RegCommand
 parseRegCommand =
   hsubparser $
     mconcat
-      [ commandRead
+      [ commandRun,
+        commandRead
       ]
   where
+    commandRun :: Mod CommandFields RegCommand
+    commandRun = command "run" runInfo
+
     commandRead :: Mod CommandFields RegCommand
     commandRead = command "read" readInfo
 
+    runInfo :: ParserInfo RegCommand
+    runInfo =
+      info
+        (Run <$> parseRegRunOptions)
+        (progDesc "Run a JuvixReg file")
+
     readInfo :: ParserInfo RegCommand
     readInfo =
       info

app/Commands/Dev/Reg/Run.hs

@@ -0,0 +1,17 @@
+module Commands.Dev.Reg.Run where
+
+import Commands.Base
+import Commands.Dev.Reg.Run.Options
+import Juvix.Compiler.Reg.Translation.FromSource qualified as Reg
+import RegInterpreter
+
+runCommand :: forall r. (Members '[Embed IO, App] r) => RegRunOptions -> Sem r ()
+runCommand opts = do
+  afile :: Path Abs File <- fromAppPathFile file
+  s <- readFile (toFilePath afile)
+  case Reg.runParser (toFilePath afile) s of
+    Left err -> exitJuvixError (JuvixError err)
+    Right tab -> runReg tab
+  where
+    file :: AppPath File
+    file = opts ^. regRunInputFile

app/Commands/Dev/Reg/Run/Options.hs

@@ -0,0 +1,15 @@
+module Commands.Dev.Reg.Run.Options where
+
+import CommonOptions
+
+newtype RegRunOptions = RegRunOptions
+  { _regRunInputFile :: AppPath File
+  }
+  deriving stock (Data)
+
+makeLenses ''RegRunOptions
+
+parseRegRunOptions :: Parser RegRunOptions
+parseRegRunOptions = do
+  _regRunInputFile <- parseInputFile FileExtJuvixReg
+  pure RegRunOptions {..}

app/RegInterpreter.hs

@@ -0,0 +1,29 @@
+module RegInterpreter where
+
+import App
+import CommonOptions
+import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg
+import Juvix.Compiler.Reg.Interpreter qualified as Reg
+import Juvix.Compiler.Reg.Pretty qualified as Reg
+
+runReg :: forall r. (Members '[Embed IO, App] r) => Reg.InfoTable -> Sem r ()
+runReg tab =
+  case tab ^. Reg.infoMainFunction of
+    Just sym -> do
+      r <- doRun tab (Reg.lookupFunInfo tab sym)
+      case r of
+        Left err ->
+          exitJuvixError (JuvixError err)
+        Right Reg.ValVoid ->
+          return ()
+        Right val -> do
+          renderStdOut (Reg.ppOut (Reg.defaultOptions tab) val)
+          putStrLn ""
+    Nothing ->
+      exitMsg (ExitFailure 1) "no 'main' function"
+  where
+    doRun ::
+      Reg.InfoTable ->
+      Reg.FunctionInfo ->
+      Sem r (Either Reg.RegError Reg.Val)
+    doRun tab' funInfo = runError $ Reg.runFunctionIO stdin stdout tab' [] funInfo

src/Juvix/Compiler/Reg/Error.hs

@@ -0,0 +1,43 @@
+module Juvix.Compiler.Reg.Error where
+
+import Juvix.Compiler.Reg.Language
+import Juvix.Data.PPOutput
+import Text.Show
+
+data RegError = RegError
+  { _regErrorLoc :: Maybe Location,
+    _regErrorMsg :: Text
+  }
+
+makeLenses ''RegError
+
+instance ToGenericError RegError where
+  genericError :: (Member (Reader GenericOptions) r) => RegError -> Sem r GenericError
+  genericError e = ask >>= generr
+    where
+      generr :: GenericOptions -> Sem r GenericError
+      generr _ =
+        return
+          GenericError
+            { _genericErrorLoc = i,
+              _genericErrorMessage = ppOutput msg,
+              _genericErrorIntervals = [i]
+            }
+        where
+          i = getLoc e
+          msg = pretty (e ^. regErrorMsg)
+
+instance Pretty RegError where
+  pretty RegError {..} = pretty _regErrorMsg
+
+instance Show RegError where
+  show RegError {..} = fromText _regErrorMsg
+
+instance HasLoc RegError where
+  getLoc RegError {..} = fromMaybe defaultLoc _regErrorLoc
+    where
+      defaultLoc :: Interval
+      defaultLoc = singletonInterval (mkInitialLoc sourcePath)
+
+      sourcePath :: Path Abs File
+      sourcePath = $(mkAbsFile "/<reg>")