merge-queue: embarking main (f2b750c) and #327 together

primer/src/Primer/App.hs

@@ -208,7 +208,7 @@ importModules ms = do
 
 -- | Get all type definitions from all modules (including imports)
 allTypes :: Prog -> [TypeDef]
-allTypes = moduleTypes . progModule
+allTypes p = foldMap moduleTypes $ progModule p : progImports p
 
 -- | Get all definitions from all modules (including imports)
 allDefs :: Prog -> Map ID Def

primer/test/Tests/Eval.hs

@@ -13,6 +13,7 @@ import Primer.App (
   EvalReq (EvalReq, evalReqExpr, evalReqRedex),
   EvalResp (EvalResp, evalRespExpr),
   Prog (progModule),
+  boolDef,
   handleEvalRequest,
   importModules,
   newEmptyApp,
@@ -25,6 +26,7 @@ import Primer.Core (
   ID (ID),
   Type,
   Type',
+  TypeDef (TypeDefAST),
   defID,
   getID,
   _exprMeta,
@@ -50,6 +52,7 @@ import Primer.Eval (
   tryReduceExpr,
   tryReduceType,
  )
+import Primer.Module (Module (Module, moduleDefs, moduleTypes))
 import Primer.Name (Name)
 import Primer.Zipper (target)
 import Protolude.Partial (fromJust)
@@ -833,6 +836,28 @@ unit_eval_modules =
         Left err -> assertFailure $ show err
         Right assertion -> assertion
 
+-- Test that handleEvalRequest will reduce case analysis on imported types
+unit_eval_modules_scrutinize_imported_type :: Assertion
+unit_eval_modules_scrutinize_imported_type =
+  let test = do
+        importModules [m]
+        foo <- case_ (con "True") [branch "True" [] $ con "False", branch "False" [] $ con "True"]
+        EvalResp{evalRespExpr = e} <-
+          handleEvalRequest
+            EvalReq{evalReqExpr = foo, evalReqRedex = getID foo}
+        expect <- con "False"
+        pure $ e ~= expect
+      a = newEmptyApp
+   in case fst $ runAppTestM (ID $ appIdCounter a) a test of
+        Left err -> assertFailure $ show err
+        Right assertion -> assertion
+  where
+    m =
+      Module
+        { moduleTypes = [TypeDefAST boolDef]
+        , moduleDefs = mempty
+        }
+
 -- * Misc helpers
 
 -- | Like '@?=' but specifically for expressions.

primer/test/Tests/EvalFull.hs

@@ -19,6 +19,7 @@ import Primer.App (
   EvalFullReq (EvalFullReq, evalFullCxtDir, evalFullMaxSteps, evalFullReqExpr),
   EvalFullResp (EvalFullRespNormal, EvalFullRespTimedOut),
   Prog (progModule),
+  boolDef,
   defaultTypeDefs,
   handleEvalFullRequest,
   importModules,
@@ -28,6 +29,7 @@ import Primer.Core
 import Primer.Core.DSL
 import Primer.Core.Utils (forgetIDs, forgetTypeIDs, generateIDs, generateTypeIDs)
 import Primer.EvalFull
+import Primer.Module (Module (Module, moduleDefs, moduleTypes))
 import Primer.Name
 import Primer.Primitives (allPrimDefs)
 import Primer.Typecheck (
@@ -936,6 +938,30 @@ unit_eval_full_modules =
         Left err -> assertFailure $ show err
         Right assertion -> assertion
 
+-- Test that handleEvalFullRequest will reduce case analysis of imported types
+unit_eval_full_modules_scrutinize_imported_type :: Assertion
+unit_eval_full_modules_scrutinize_imported_type =
+  let test = do
+        importModules [m]
+        foo <- case_ (con "True") [branch "True" [] $ con "False", branch "False" [] $ con "True"]
+        resp <-
+          handleEvalFullRequest
+            EvalFullReq{evalFullReqExpr = foo, evalFullCxtDir = Chk, evalFullMaxSteps = 2}
+        expect <- con "False"
+        pure $ case resp of
+          EvalFullRespTimedOut _ -> assertFailure "EvalFull timed out"
+          EvalFullRespNormal e -> e ~= expect
+      a = newEmptyApp
+   in case fst $ runAppTestM (ID $ appIdCounter a) a test of
+        Left err -> assertFailure $ show err
+        Right assertion -> assertion
+  where
+    m =
+      Module
+        { moduleTypes = [TypeDefAST boolDef]
+        , moduleDefs = mempty
+        }
+
 -- * Utilities
 
 evalFullTest :: ID -> M.Map Name TypeDef -> M.Map ID Def -> TerminationBound -> Dir -> Expr -> Either EvalFullError Expr