diff --git a/src/Module.purs b/src/Module.purs index 6ffbb49b0..278fba354 100644 --- a/src/Module.purs +++ b/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,12 +64,6 @@ 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 @@ -77,12 +71,23 @@ defaultImports = do >>= 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) diff --git a/src/Util.purs b/src/Util.purs index 6d43dfae6..c50e6e56c 100644 --- a/src/Util.purs +++ b/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 diff --git a/test/Many.purs b/test/Many.purs index 62b0d00c2..82d7c2d88 100644 --- a/test/Many.purs +++ b/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