parallel execution (#305): INTERNAL flag, improve test

AshleyYakeley · Aug 11, 2024 · fe22103 · fe22103
1 parent 4d47aac
commit fe22103
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 9 deletions.
diff --git 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
@@ -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
@@ -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
         ]