From fe2210390ec72f28a7773c7a5e76cf03ab475420 Mon Sep 17 00:00:00 2001
From: Ashley Yakeley <ashley@semantic.org>
Date: Sun, 11 Aug 2024 14:09:13 -0700
Subject: [PATCH] parallel execution (#305): INTERNAL flag, improve test

---
 Pinafore/pinafore-app/app/main/Run.hs                | 12 +++++++++---
 Pinafore/pinafore-app/test/script/parallel           |  7 ++++---
 .../lib/Pinafore/Language/Library/Debug.hs           |  7 ++++---
 3 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/Pinafore/pinafore-app/app/main/Run.hs b/Pinafore/pinafore-app/app/main/Run.hs
index 16fa233d..10963f48 100644
--- a/Pinafore/pinafore-app/app/main/Run.hs
+++ b/Pinafore/pinafore-app/app/main/Run.hs
@@ -9,11 +9,17 @@ import Pinafore.Main
 import Shapes
 import System.Environment
 
+parallelExecutionINTERNAL :: Bool
+parallelExecutionINTERNAL = True
+
 setup :: IO ()
 setup = do
-    -- use all processors
-    np <- getNumProcessors
-    setNumCapabilities np
+    if parallelExecutionINTERNAL
+        then do
+            np <- getNumProcessors
+            -- use all processors
+            setNumCapabilities np
+        else return ()
 
 runFiles :: Foldable t => (StorageModelOptions, ModuleOptions) -> Bool -> t (FilePath, [String]) -> IO ()
 runFiles (smopts, modopts) fNoRun scripts = do
diff --git a/Pinafore/pinafore-app/test/script/parallel b/Pinafore/pinafore-app/test/script/parallel
index 1859f7a2..3fd22f02 100644
--- a/Pinafore/pinafore-app/test/script/parallel
+++ b/Pinafore/pinafore-app/test/script/parallel
@@ -1,15 +1,16 @@
 #!/usr/bin/pinafore
 # for issue #305
 let
-    taskCount = 15;
-    computeIters = 20;
+    taskCount = 32;
+    computeIters = 400000;
 in
 for_ (range 1 taskCount) $ fn t => do
     outputLn.Env $ "starting #" <>.Text show t;
     async.Task. $
         for_ (arithList 1 0 Nothing) $ fn i =>
         outputLn.Env $
+        let e = longCompute.Debug computeIters $ i * taskCount + t in
         with Text. in
-            "#" <> show t <> " (" <> show i <> "): " <> show (anchor.Entity $ longCompute.Debug computeIters $ i * taskCount + t);
+        "#" <> show t <> " (" <> show i <> "): " <> show (anchor.Entity e);
     outputLn.Env $ "started #" <>.Text show t;
 end
diff --git a/Pinafore/pinafore-language/lib/Pinafore/Language/Library/Debug.hs b/Pinafore/pinafore-language/lib/Pinafore/Language/Library/Debug.hs
index 9cf59264..661a490f 100644
--- a/Pinafore/pinafore-language/lib/Pinafore/Language/Library/Debug.hs
+++ b/Pinafore/pinafore-language/lib/Pinafore/Language/Library/Debug.hs
@@ -24,7 +24,9 @@ compute e = MkEntity $ hashToAnchor $ \s -> pure $ s e
 
 longCompute :: Integer -> Entity -> Entity
 longCompute 0 e = e
-longCompute n e = longCompute (pred n) $ compute e
+longCompute n e = let
+    e' = compute e
+    in seq e' $ longCompute (pred n) e'
 
 debugLibSection :: LibraryStuff context
 debugLibSection =
@@ -36,6 +38,5 @@ debugLibSection =
         , valBDS "checkEntity" "debugCheckEntity" debugCheckEntity
         , valBDS "literalLength" "Byte length of a Literal" debugLiteralLength
         , valBDS "literalIsEmbedded" "Is this Literal embeddable in an Entity?" debugLiteralIsEmbedded
-        , valBDS "longCompute" "`longCompute n x` iterates BLAKE3 `n * 1000` times on `x`" $ \n ->
-              longCompute (n * 1000)
+        , valBDS "longCompute" "`longCompute n x` iterates BLAKE3 `n` times on `x`" longCompute
         ]