🧩 [consolidate]: concatM helper.

src/Module.purs

@@ -9,7 +9,7 @@ import Control.Monad.Error.Class (liftEither, throwError)
 import Control.Monad.Except (class MonadError)
 import Data.Either (Either(..))
 import Data.HTTP.Method (Method(..))
-import Data.List (List(..), foldl, (:))
+import Data.List (List(..), (:))
 import Data.Newtype (class Newtype)
 import Data.Set (empty)
 import Data.Traversable (traverse)
@@ -26,7 +26,7 @@ import Parsing (runParser)
 import Primitive.Defs (primitives)
 import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
-import Util (type (×), mapLeft, (×))
+import Util (type (×), concatM, mapLeft, (×))
 import Util.Parse (SParser)
 import Val (Env, ProgCxt(..), ProgCxt2(..), (<+>))
 
@@ -64,25 +64,30 @@ loadModule file (ProgCxt r@{ mods, γ }) = do
    γ' <- eval_module γ mod empty
    pure $ ProgCxt r { mods = mod : mods, γ = γ <+> γ' }
 
-loadModule2 :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
-loadModule2 file (ProgCxt2 r@{ mods }) = do
-   src <- loadFile (Folder "fluid/lib") file
-   mod <- parse src module_ >>= desugarModuleFwd
-   pure $ ProgCxt2 r{ mods = mod : mods }
-
 defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt Vertex)
 defaultImports = do
    γ <- traverse alloc primitives
    loadModule (File "prelude") (ProgCxt { mods: Nil, datasets: Nil, γ })
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
+loadModule2 :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
+loadModule2 file (ProgCxt2 r@{ mods }) = do
+   src <- loadFile (Folder "fluid/lib") file
+   mod <- parse src module_ >>= desugarModuleFwd
+   pure $ ProgCxt2 r{ mods = mod : mods }
+
 defaultImports2 :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt2 Unit)
 defaultImports2 =
    loadModule2 (File "prelude") (ProgCxt2 { mods: Nil, datasets: Nil })
       >>= loadModule2 (File "graphics")
       >>= loadModule2 (File "convolution")
 
+loadDataset ::  forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
+loadDataset file (ProgCxt2 r@{ datasets }) = do
+   dataset <- parseProgram (Folder "fluid") file >>= desug
+   pure $ ProgCxt2 r{ datasets = dataset : datasets }
+
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
    (g × n) × progCxt <- runWithGraphAllocT (G.empty × 0) defaultImports
@@ -101,4 +106,4 @@ openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
 eval_progCxt :: forall m. MonadGraphAlloc m => ProgCxt2 Vertex -> m (Env Vertex)
 eval_progCxt (ProgCxt2 { mods }) =
    traverse alloc primitives
-      >>= foldl (>=>) pure (mods <#> \mod γ' -> eval_module γ' mod empty)
+      >>= concatM (mods <#> \mod γ' -> eval_module γ' mod empty)

src/Util.purs

@@ -9,6 +9,7 @@ import Control.Monad.Except (Except, ExceptT(..), runExceptT)
 import Control.MonadPlus (class MonadPlus, empty)
 import Data.Array ((!!), updateAt)
 import Data.Either (Either(..))
+import Data.Foldable (class Foldable, foldr)
 import Data.Identity (Identity(..))
 import Data.List (List(..), (:), intercalate)
 import Data.List.NonEmpty (NonEmptyList(..))
@@ -170,3 +171,7 @@ infixr 6 type WithTypeLeft as <×|
 infixr 6 WithTypeLeft as <×|
 
 derive instance Functor f => Functor (t <×| f)
+
+-- Haven't found this yet in PureScript
+concatM :: forall f m a. Foldable f => Monad m => f (a -> m a) -> a -> m a
+concatM = foldr (>=>) pure

test/Many.purs

@@ -17,9 +17,9 @@ many specs iter = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
       gconfig <- openDefaultImports
-      expr <- open (File file)
+      e <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
+         testWithSetup file e gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
       pure $ averageRows rows
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
@@ -29,9 +29,9 @@ bwdMany specs iter = zip (specs <#> _.file) (specs <#> bwdOne)
    bwdOne { file, file_expect, δv, fwd_expect } = do
       gconfig <- openDefaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
-      expr <- open (folder <> File file)
+      e <- open (folder <> File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { δv, fwd_expect, bwd_expect }
+         testWithSetup file e gconfig { δv, fwd_expect, bwd_expect }
       pure $ averageRows rows
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
@@ -40,9 +40,9 @@ withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
    withDatasetOne { dataset, file } = do
       -- TODO: make progCxt consistent with addition of xv
       gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      expr <- open (File file)
+      e <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
+         testWithSetup file e gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
             { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows