Add exit code at the end

Author: Ailrun

src/LambdaComp/AM/Eval.hs

@@ -20,6 +20,7 @@ import Data.Maybe                 (mapMaybe, maybeToList)
 import Data.Tuple                 (swap)
 import Data.Vector                (Vector)
 import Data.Vector                qualified as Vector
+import System.Exit                (ExitCode (ExitFailure, ExitSuccess))
 import System.IO                  (Handle, hPrint)
 
 import LambdaComp.AM.Syntax
@@ -32,9 +33,13 @@ data Item where
   ItThunk  :: !Ident -> !(Vector Item) -> Item
   deriving stock Show
 
-topEval :: Handle -> [CodeSection] -> IO Item
-topEval out cs = returnReg <$> runMachine evalData evalState
+topEval :: Handle -> [CodeSection] -> IO ExitCode
+topEval out cs = toExitCode . returnReg <$> runMachine evalData evalState
   where
+    toExitCode (ItInt 0) = ExitSuccess
+    toExitCode (ItInt n) = ExitFailure n
+    toExitCode _         = error "Compiler bug: TypeError in AM evaluation!"
+
     evalData = foldr insertCodeSection (Map.empty, ([], out)) cs
     evalState =
       EvalState

src/LambdaComp/Driver.hs

@@ -60,7 +60,7 @@ mainFuncWithOptions outH (Options inputFp backend phase mayFp) = (<* hFlush outH
         DirectCBackend -> do
           cCode <- getCCode
           runWithFp (const $ genAndExeCExe outH cCode) mayFp
-        AMBackend      -> getAMTm >>= lift . topEval outH >>= pHPrintNoColor outH
+        AMBackend      -> getAMTm >>= exitCodeToExceptT . topEval outH
 
 handleElabError :: Handle -> Either ElaborationError a -> ExceptT Int IO a
 handleElabError outH (Left elabErr) = lift (hPutStrLn outH "Elab") >> pHPrintNoColor outH elabErr >> throwError 1

test/Main.hs

@@ -3,9 +3,11 @@ module Main (main) where
 import Control.Monad        (void)
 import Data.ByteString.Lazy qualified as LBS
 import Data.Int             (Int64)
+import Data.Maybe           (fromMaybe)
+import GHC.IO.Exception     (ExitCode (ExitFailure))
 import System.Directory     (makeAbsolute)
 import System.FilePath      (takeFileName, (<.>), (</>))
-import System.IO            (Handle, hClose)
+import System.IO            (Handle, hClose, hPrint)
 import System.IO.Temp       (withSystemTempFile)
 import System.Timeout       (timeout)
 import Test.Tasty
@@ -94,8 +96,9 @@ amExecutionTests allExamples =
   $ executionOfExample "am" (makeAMOptions Run) <$> allExamples
 
 executionOfExample :: String -> (FilePath -> Options) -> String -> TestTree
-executionOfExample tag = goldenOf (Just 10000) ("execution" <.> tag <.> "out") $ \handle ->
-  timeout 300000 . mainFuncWithOptions handle
+executionOfExample tag = goldenOf (Just 10000) ("execution" <.> tag <.> "out") $ \handle opt -> do
+  exitCode <- timeoutWithExitCode 300000 $ mainFuncWithOptions handle opt
+  hPrint handle exitCode
 
 goldenOf :: Maybe Int64 -> String -> (Handle -> Options -> IO a) -> (FilePath -> Options) -> String -> TestTree
 goldenOf maySize tag f optionBuilder s =
@@ -125,3 +128,8 @@ getExampleDir = makeAbsolute "examples"
 
 gitDiff :: FilePath -> FilePath -> [String]
 gitDiff ref new = ["git", "diff", ref, new]
+
+timeoutWithExitCode :: Int -> IO ExitCode -> IO ExitCode
+timeoutWithExitCode n = fmap (fromMaybe timeOutExitCode) . timeout n
+  where
+    timeOutExitCode = ExitFailure 124

test/golden/Constant.lc.execution.am.out

@@ -1,2 +1,2 @@
 5
-ItInt 0
+ExitSuccess

test/golden/Constant.lc.execution.c.out

@@ -1 +1,2 @@
 5
+ExitSuccess

test/golden/Fib10.lc.execution.am.out

@@ -20,4 +20,4 @@
 34
 10
 55
-ItInt 0
+ExitSuccess

test/golden/Fib10.lc.execution.c.out

@@ -20,3 +20,4 @@
 34
 10
 55
+ExitSuccess

test/golden/Fib100.lc.execution.am.out

@@ -200,4 +200,4 @@
 -2437933049959450366
 100
 3736710778780434371
-ItInt 0
+ExitSuccess

test/golden/Fib100.lc.execution.c.out

@@ -200,3 +200,4 @@
 -889489150
 100
 -980107325
+ExitSuccess

test/golden/MultiTopOrder.lc.execution.am.out

@@ -1,4 +1,4 @@
 5
 4
 3
-ItInt 0
+ExitSuccess