From 32314d621aeb864afe7338b43a5a1a754d9177c3 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Fri, 29 Sep 2023 15:47:57 +0100
Subject: [PATCH 01/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Inline=20?=
 =?UTF-8?q?=CE=B1'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index a43965ed0..0b7bc983f 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -126,8 +126,7 @@ eval γ (Dictionary α ees) αs = do
 eval γ (Constr α c es) αs = do
    checkArity c (length es)
    vs <- traverse (flip (eval γ) αs) es
-   α' <- new (insert α αs)
-   pure $ V.Constr α' c vs
+   V.Constr <$> new (insert α αs) <@> c <@> vs
 eval γ (Matrix α e (x × y) e') αs = do
    v <- eval γ e' αs
    let (i' × β) × (j' × β') = fst (intPair.match v)

From 6f35eb7bf025199628d6f1ac1712a0151de58c03 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sat, 30 Sep 2023 08:21:02 +0100
Subject: [PATCH 02/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Simplify?=
 =?UTF-8?q?=20openDatasetAs.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs |  2 +-
 src/Module.purs    |  6 +++---
 test/Many.purs     | 11 +++++------
 3 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 0b7bc983f..d13af67a3 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -188,7 +188,7 @@ graphGC
    -> Raw Expr
    -> m (GraphEval g)
 graphGC { g, n, γα } e = do
-   (g' × _) × eα × vα <- do
+   (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) $ do
          eα <- alloc e
          vα <- eval γα eα S.empty
diff --git a/src/Module.purs b/src/Module.purs
index 842204f9c..ad22821d8 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -78,10 +78,10 @@ openDefaultImports = do
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
 openDatasetAs file x { g, n, γα } = do
    s <- parseProgram (Folder "fluid") file
-   (g' × n') × (γα' × xv) <-
+   (g' × n') × xv <-
       runWithGraphAllocT (g × n) do
          e <- desug s
          eα <- alloc e
          vα <- eval γα eα empty
-         pure (γα × D.singleton x vα)
-   pure ({ g: g', n: n', γα: γα' } × xv)
+         pure (D.singleton x vα)
+   pure ({ g: g', n: n', γα } × xv)
diff --git a/test/Many.purs b/test/Many.purs
index f01fdcc7f..f614f00c5 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -16,10 +16,10 @@ many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many fxs iter = zip names affs
    where
    affs = fxs <#> \{ file, fwd_expect } -> do
-      default <- openDefaultImports
+      gconfig <- openDefaultImports
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr default { δv: identity, fwd_expect, bwd_expect: mempty }
+         testWithSetup file expr gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
       pure $ averageRows rows
    names = map _.file fxs
 
@@ -28,11 +28,11 @@ bwdMany fxs iter = zip names affs
    where
    folder = File "slicing/"
    affs = fxs <#> \{ file, file_expect, δv, fwd_expect } -> do
-      default <- openDefaultImports
+      gconfig <- openDefaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
       expr <- open (folder <> File file)
       rows <- replicateM iter $
-         testWithSetup file expr default { δv, fwd_expect, bwd_expect }
+         testWithSetup file expr gconfig { δv, fwd_expect, bwd_expect }
       pure $ averageRows rows
    names = map _.file fxs
 
@@ -40,8 +40,7 @@ withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff Benc
 withDatasetMany fxs iter = zip names affs
    where
    affs = fxs <#> \{ dataset, file } -> do
-      default <- openDefaultImports
-      { g, n, γα } × xv <- openDatasetAs (File dataset) "data" default
+      { g, n, γα } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
       let loadedData = { g, n, γα: γα <+> xv }
       expr <- open (File file)
       rows <- replicateM iter $

From ce259246a80e61842bf01c0f31000b2d0c9994a2 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 05:55:02 +0100
Subject: [PATCH 03/57] =?UTF-8?q?=F0=9F=A7=A9=20[remove-unused]:=20fast-ve?=
 =?UTF-8?q?ct.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 spago.dhall | 1 -
 1 file changed, 1 deletion(-)

diff --git a/spago.dhall b/spago.dhall
index 5cabf820a..650afd297 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -16,7 +16,6 @@ You can edit this file as you like.
   , "either"
   , "exceptions"
   , "exists"
-  , "fast-vect"
   , "foldable-traversable"
   , "foreign-object"
   , "heterogeneous"

From 9382d295931e61b3753f4651223364435f975a89 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 06:06:30 +0100
Subject: [PATCH 04/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Remove=20?=
 =?UTF-8?q?unnecessary=20'successful'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 8f7d81479..e18eb78d7 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -74,7 +74,7 @@ type SplitDefs a =
    }
 
 -- Decompose as above.
-splitDefs :: forall a. Ann a => Env a -> S.Expr a -> MayFail (SplitDefs a)
+splitDefs :: forall a m. Ann a => MonadError Error m => Env a -> S.Expr a -> m (SplitDefs a)
 splitDefs γ0 s' = do
    let defs × s = unsafePartial $ unpack s'
    γ <- desugarModuleFwd (S.Module (singleton defs)) >>= flip (eval_module γ0) bot
@@ -198,13 +198,13 @@ loadFig spec@{ file } = do
    let
       γ0 = botOf <$> γα0
       xv0 = botOf <$> xv
-   open file <#> \s' -> successful $ do
-      let s0 = botOf s'
-      { γ: γ1, s } <- splitDefs (γ0 <+> xv0) s0
-      e <- desug s
-      let γ0γ = γ0 <+> xv0 <+> γ1
-      t × v <- eval γ0γ e bot
-      pure { spec, γ0, γ: γ0 <+> γ1, s0, s, e, t, v }
+   s' <- open file
+   let s0 = botOf s'
+   { γ: γ1, s } <- splitDefs (γ0 <+> xv0) s0
+   e <- desug s
+   let γ0γ = γ0 <+> xv0 <+> γ1
+   t × v <- eval γ0γ e bot
+   pure { spec, γ0, γ: γ0 <+> γ1, s0, s, e, t, v }
 
 loadLinkFig :: forall m. MonadAff m => MonadError Error m => LinkFigSpec -> m LinkFig
 loadLinkFig spec@{ file1, file2, dataFile, x } = do
@@ -220,7 +220,7 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       xv0 = botOf <$> xv
       s1 = botOf s1'
       s2 = botOf s2'
-   dataFile' <- loadFile (Folder "fluid/example/linking") (dataFile) -- use surface expression instead
+   dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- use surface expression instead
    e1 × e2 <- (×) <$> desug s1 <*> desug s2
    t1 × v1 <- eval (γ0 <+> xv0) e1 bot
    t2 × v2 <- eval (γ0 <+> xv0) e2 bot

From 23405f806e326dbe9bb869b5138f73085b79a918 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 06:21:30 +0100
Subject: [PATCH 05/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Conditional?=
 =?UTF-8?q?=20logging;=20disable=20for=20now.=20Trace=20difference=20betwe?=
 =?UTF-8?q?en=20sinks=20and=20'inputs'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Util/Select.purs |  2 +-
 src/DataType.purs        |  2 +-
 src/Eval.purs            |  4 ++--
 src/EvalBwd.purs         |  2 +-
 src/EvalGraph.purs       | 15 +++++++++------
 src/Parse.purs           |  4 ++--
 src/Val.purs             |  2 +-
 test/Util.purs           | 28 ++++++++++++++--------------
 8 files changed, 31 insertions(+), 28 deletions(-)

diff --git a/src/App/Util/Select.purs b/src/App/Util/Select.purs
index 26f834dce..749d19e1c 100644
--- a/src/App/Util/Select.purs
+++ b/src/App/Util/Select.purs
@@ -32,7 +32,7 @@ constrArg :: Ctr -> Int -> Endo (Selector Val)
 constrArg c n δv = unsafePartial $ case _ of
    Constr α c' us | c == c' ->
       let
-         us' = definitely' $ do
+         us' = definitely' do
             u1 <- us !! n
             updateAt n (δv u1) us
       in
diff --git a/src/DataType.purs b/src/DataType.purs
index 863b562cc..8deeaa900 100644
--- a/src/DataType.purs
+++ b/src/DataType.purs
@@ -68,7 +68,7 @@ instance DataTypeFor (Set Ctr) where
 
 -- Sets must be non-empty, but this is a more convenient signature.
 consistentWith :: forall m. MonadError Error m => Set Ctr -> Set Ctr -> m Unit
-consistentWith cs cs' = void $ do
+consistentWith cs cs' = void do
    d <- dataTypeFor cs'
    d' <- dataTypeFor cs'
    with ("constructors of " <> show d' <> " do not include " <> (show (S.map showCtr cs))) (d ≞ d')
diff --git a/src/Eval.purs b/src/Eval.purs
index 73a08089c..e282ad413 100644
--- a/src/Eval.purs
+++ b/src/Eval.purs
@@ -129,9 +129,9 @@ eval γ (Matrix α e (x × y) e') α' = do
    let (i' × β) × (j' × β') = fst (intPair.match v)
    check (i' × j' >= 1 × 1) ("array must be at least (" <> show (1 × 1) <> "); got (" <> show (i' × j') <> ")")
    tss × vss <- unzipToArray <$> ((<$>) unzipToArray) <$>
-      ( sequence $ do
+      ( sequence do
            i <- range 1 i'
-           singleton $ sequence $ do
+           singleton $ sequence do
               j <- range 1 j'
               let γ' = D.singleton x (V.Int β i) `disjointUnion` (D.singleton y (V.Int β' j))
               singleton (eval (γ <+> γ') e α')
diff --git a/src/EvalBwd.purs b/src/EvalBwd.purs
index d53ee8b1b..6d3fb16c4 100644
--- a/src/EvalBwd.purs
+++ b/src/EvalBwd.purs
@@ -145,7 +145,7 @@ evalBwd' (V.Constr α _ vs) (T.Constr c ts) =
 evalBwd' (V.Matrix α (MatrixRep (vss × (_ × βi) × (_ × βj)))) (T.Matrix tss (x × y) (i' × j') t') =
    (γ ∨ γ') × Matrix α e (x × y) e' × (α ∨ α' ∨ α'')
    where
-   NonEmptyList ijs = nonEmpty $ do
+   NonEmptyList ijs = nonEmpty do
       i <- range 1 i'
       j <- range 1 j'
       L.singleton (i × j)
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index d13af67a3..0346ce318 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -9,17 +9,19 @@ module EvalGraph
    ) where
 
 import Prelude hiding (apply, add)
+
 import Bindings (varAnon)
 import Control.Monad.Error.Class (class MonadError)
 import Data.Array (range, singleton) as A
 import Data.Either (Either(..))
 import Data.Exists (runExists)
-import Data.List (List(..), length, snoc, unzip, zip, (:))
+import Data.List (List(..), foldMap, length, snoc, unzip, zip, (:))
 import Data.Set (Set, empty, insert, intersection, singleton, union)
 import Data.Set as S
 import Data.Traversable (sequence, traverse)
 import Data.Tuple (fst)
 import DataType (checkArity, arity, consistentWith, dataTypeFor, showCtr)
+import Debug (trace)
 import Dict (disjointUnion, fromFoldable, empty, get, keys, lookup, singleton) as D
 import Effect.Exception (Error)
 import Expr (Cont(..), Elim(..), Expr(..), VarDef(..), RecDefs, Module(..), fv, asExpr)
@@ -133,9 +135,9 @@ eval γ (Matrix α e (x × y) e') αs = do
    check
       (i' × j' >= 1 × 1)
       ("array must be at least (" <> show (1 × 1) <> "); got (" <> show (i' × j') <> ")")
-   vss <- sequence $ do
+   vss <- sequence do
       i <- A.range 1 i'
-      A.singleton $ sequence $ do
+      A.singleton $ sequence do
          j <- A.range 1 j'
          let γ' = D.singleton x (V.Int β i) `D.disjointUnion` (D.singleton y (V.Int β' j))
          A.singleton (eval (γ <+> γ') e αs)
@@ -189,12 +191,13 @@ graphGC
    -> m (GraphEval g)
 graphGC { g, n, γα } e = do
    (g' × _) × eα × vα <-
-      runWithGraphAllocT (g × n) $ do
+      runWithGraphAllocT (g × n) do
          eα <- alloc e
          vα <- eval γα eα S.empty
          pure (eα × vα)
    let
-      -- TODO: want (vertices eα `union` foldMap vertices γα) rather than sinks g' here?
+      dom = vertices eα `union` foldMap vertices γα
       fwd αs = G.vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = G.vertices (bwdSlice αs g') `intersection` sinks g'
-   pure { gc: GC { fwd, bwd }, γα, eα, g: g', vα }
+   trace (show $ sinks g' `S.difference` dom) \_ ->
+      pure { gc: GC { fwd, bwd }, γα, eα, g: g', vα }
diff --git a/src/Parse.purs b/src/Parse.purs
index dcacee07b..4c5d6a8d3 100644
--- a/src/Parse.purs
+++ b/src/Parse.purs
@@ -222,7 +222,7 @@ simplePattern pattern' =
 
    pair :: SParser Pattern
    pair =
-      token.parens $ do
+      token.parens do
          π <- pattern' <* token.comma
          π' <- pattern'
          pure $ PConstr cPair (π : π' : Nil)
@@ -288,7 +288,7 @@ expr_ = fix $ appChain >>> buildExprParser ([ backtickOp ] `cons` operators bina
    -- Pushing this to front of operator table to give it higher precedence than any other binary op.
    -- (Reasonable approximation to Haskell, where backticked functions have default precedence 9.)
    backtickOp :: Operator Identity String (Raw Expr)
-   backtickOp = flip Infix AssocLeft $ do
+   backtickOp = flip Infix AssocLeft do
       x <- between backtick backtick ident
       pure (\e e' -> BinaryApp e x e')
 
diff --git a/src/Val.purs b/src/Val.purs
index a8c7e94f0..bf9e7c74a 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -108,7 +108,7 @@ type Array2 a = Array (Array a)
 
 matrixGet :: forall a m. MonadThrow Error m => Int -> Int -> MatrixRep a -> m (Val a)
 matrixGet i j (MatrixRep (vss × _ × _)) =
-   orElse "Index out of bounds" $ do
+   orElse "Index out of bounds" do
       us <- vss !! (i - 1)
       us !! (j - 1)
 
diff --git a/test/Util.purs b/test/Util.purs
index 3a716319f..38c78739b 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -15,7 +15,6 @@ import Data.List.Lazy (List, length)
 import Data.Set (subset)
 import Data.String (null)
 import DataType (dataTypeFor, typeName)
-import Debug (trace)
 import Desug (desugGC)
 import Effect.Aff (Aff)
 import Effect.Class.Console (log)
@@ -44,11 +43,14 @@ type TestConfig =
    , bwd_expect :: String
    }
 
+logging :: Boolean
+logging = false
+
 -- fwd_expect: prettyprinted value after bwd then fwd round-trip
 testWithSetup ∷ String -> SE.Expr Unit → GraphConfig GraphImpl → TestConfig → Aff BenchRow
 testWithSetup _name s gconfig tconfig =
    liftEither =<<
-      ( runExceptT $ do
+      ( runExceptT do
            testParse s
            trRow <- testTrace s gconfig tconfig
            grRow <- testGraph s gconfig tconfig
@@ -59,11 +61,10 @@ testParse :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
 testParse s = do
    let src = prettyP s
    s' <- parse src program
-   trace ("Non-Annotated:\n" <> src) \_ ->
-      unless (eq (erase s) (erase s')) do
-         log ("SRC\n" <> show (erase s))
-         log ("NEW\n" <> show (erase s'))
-         lift $ fail "not equal"
+   unless (eq (erase s) (erase s')) do
+      log ("SRC\n" <> show (erase s))
+      log ("NEW\n" <> show (erase s'))
+      lift $ fail "not equal"
 
 testTrace :: Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> MayFailT Aff TraceRow
 testTrace s { γα } { δv, bwd_expect, fwd_expect } = do
@@ -90,13 +91,12 @@ testTrace s { γα } { δv, bwd_expect, fwd_expect } = do
    t_fwd2 <- preciseTime
 
    lift do
-      unless (isGraphical v) $
-         log (prettyP v𝔹)
       -- | Check backward selections
       unless (null bwd_expect) $
          checkPretty "Trace-based source selection" bwd_expect s𝔹
       -- | Check round-trip selections
-      unless (isGraphical v) $
+      unless (isGraphical v) do
+         when logging $ log (prettyP v𝔹)
          checkPretty "Trace-based value" fwd_expect v𝔹
 
    pure { tEval: tdiff t_eval1 t_eval2, tBwd: tdiff t_bwd1 t_bwd2, tFwd: tdiff t_fwd1 t_fwd2 }
@@ -169,7 +169,7 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } = do
       αs_out `shouldSatisfy "fwd ⚬ bwd round-tripping property"`
          (flip subset αs_out')
       -- | To avoid unused variables when benchmarking
-      unless false do
+      when logging do
          log (prettyP e𝔹_dual)
          log (prettyP e𝔹_all)
          log (prettyP v𝔹_dual)
@@ -216,9 +216,9 @@ shouldSatisfy msg v pred =
       fail (show v <> " doesn't satisfy predicate: " <> msg)
 
 averageRows :: List BenchRow -> BenchRow
-averageRows rows = averagedTr
+averageRows rows = average summed
    where
    runs = toNumber $ length rows
-
    summed = foldl sumRow zeroRow rows
-   averagedTr = (\(BenchRow tr gr) -> BenchRow (hmap (\num -> num `div` runs) tr) (hmap (\num -> num `div` runs) gr)) $ summed
+   average (BenchRow tr gr) =
+      BenchRow (hmap (\num -> num `div` runs) tr) (hmap (\num -> num `div` runs) gr)

From ca0839c0afb66edf03df585f81ae8a7d51c6be5a Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 06:23:54 +0100
Subject: [PATCH 06/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Conditional?=
 =?UTF-8?q?=20logging;=20disable=20for=20now.=20Trace=20difference=20betwe?=
 =?UTF-8?q?en=20sinks=20and=20'inputs'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 0346ce318..3f4283629 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -199,5 +199,5 @@ graphGC { g, n, γα } e = do
       dom = vertices eα `union` foldMap vertices γα
       fwd αs = G.vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = G.vertices (bwdSlice αs g') `intersection` sinks g'
-   trace (show $ sinks g' `S.difference` dom) \_ ->
+   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
       pure { gc: GC { fwd, bwd }, γα, eα, g: g', vα }

From d0985f82cd29951f3d5b2a0478aa3f3af8eda4b5 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 06:42:39 +0100
Subject: [PATCH 07/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Add=20edges?=
 =?UTF-8?q?=20from=20closures=20to=20lambda=20expressions=20(in=20core=20l?=
 =?UTF-8?q?anguage),=20but=20drop=20in=20surface=20language.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Desug.purs       |  4 ++--
 src/Desugarable.purs |  4 ++--
 src/Eval.purs        |  4 ++--
 src/EvalBwd.purs     |  2 +-
 src/EvalGraph.purs   |  4 ++--
 src/Expr.purs        | 10 ++++----
 src/Pretty.purs      |  2 +-
 src/SExpr.purs       | 56 ++++++++++++++++++++++----------------------
 8 files changed, 43 insertions(+), 43 deletions(-)

diff --git a/src/Desug.purs b/src/Desug.purs
index 440d92d76..b2421c5b2 100644
--- a/src/Desug.purs
+++ b/src/Desug.purs
@@ -7,14 +7,14 @@ import Desugarable (desug, desugBwd)
 import Effect.Exception (Error)
 import Expr (Expr)
 import GaloisConnection (GaloisConnection(..))
-import Lattice (class BoundedJoinSemilattice, Raw)
+import Lattice (class BoundedLattice, Raw)
 import SExpr (Expr) as S
 import Util (successful)
 
 desugGC
    :: forall a m
     . MonadError Error m
-   => BoundedJoinSemilattice a
+   => BoundedLattice a
    => Raw S.Expr
    -> m (GaloisConnection (S.Expr a) (Expr a))
 desugGC s0 = do
diff --git a/src/Desugarable.purs b/src/Desugarable.purs
index 0985db412..7c51a9e1e 100644
--- a/src/Desugarable.purs
+++ b/src/Desugarable.purs
@@ -4,8 +4,8 @@ import Prelude
 
 import Control.Monad.Error.Class (class MonadError)
 import Effect.Exception (Error)
-import Lattice (Raw, class JoinSemilattice, class BoundedJoinSemilattice)
+import Lattice (class BoundedJoinSemilattice, class BoundedLattice, Raw)
 
 class (Functor s, Functor e) <= Desugarable s e | s -> e where
-   desug :: forall a m. MonadError Error m => JoinSemilattice a => s a -> m (e a)
+   desug :: forall a m. MonadError Error m => BoundedLattice a => s a -> m (e a)
    desugBwd :: forall a. BoundedJoinSemilattice a => e a -> Raw s -> s a
diff --git a/src/Eval.purs b/src/Eval.purs
index e282ad413..00b451970 100644
--- a/src/Eval.purs
+++ b/src/Eval.purs
@@ -140,8 +140,8 @@ eval γ (Matrix α e (x × y) e') α' = do
    where
    unzipToArray :: forall b c. List (b × c) -> Array b × Array c
    unzipToArray = unzip >>> bimap A.fromFoldable A.fromFoldable
-eval γ (Lambda σ) α =
-   pure $ T.Const × V.Fun α (V.Closure (γ `restrict` fv σ) empty σ)
+eval γ (Lambda α σ) α' =
+   pure $ T.Const × V.Fun (α ∧ α') (V.Closure (γ `restrict` fv σ) empty σ)
 eval γ (Project e x) α = do
    t × v <- eval γ e α
    case v of
diff --git a/src/EvalBwd.purs b/src/EvalBwd.purs
index 6d3fb16c4..d1d57da1e 100644
--- a/src/EvalBwd.purs
+++ b/src/EvalBwd.purs
@@ -118,7 +118,7 @@ evalBwd' v (T.Op op) = D.singleton op v × Op op × bot
 evalBwd' (V.Str α str) T.Const = empty × Str α str × α
 evalBwd' (V.Int α n) T.Const = empty × Int α n × α
 evalBwd' (V.Float α n) T.Const = empty × Float α n × α
-evalBwd' (V.Fun α (V.Closure γ _ σ)) T.Const = γ × Lambda σ × α
+evalBwd' (V.Fun α (V.Closure γ _ σ)) T.Const = γ × Lambda α σ × α
 evalBwd' (V.Record α xvs) (T.Record xts) =
    foldr (∨) empty (xγeαs <#> fst)
       × Record α (xγeαs <#> (fst <<< snd))
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 3f4283629..8e6e06d44 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -142,8 +142,8 @@ eval γ (Matrix α e (x × y) e') αs = do
          let γ' = D.singleton x (V.Int β i) `D.disjointUnion` (D.singleton y (V.Int β' j))
          A.singleton (eval (γ <+> γ') e αs)
    V.Matrix <$> new (insert α αs) <@> MatrixRep (vss × (i' × β) × (j' × β'))
-eval γ (Lambda σ) αs =
-   V.Fun <$> new αs <@> V.Closure (γ `restrict` fv σ) D.empty σ
+eval γ (Lambda α σ) αs =
+   V.Fun <$> new (insert α αs) <@> V.Closure (γ `restrict` fv σ) D.empty σ
 eval γ (Project e x) αs = do
    v <- eval γ e αs
    case v of
diff --git a/src/Expr.purs b/src/Expr.purs
index 20342c3ae..81019d7ef 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -28,7 +28,7 @@ data Expr a
    | Dictionary a (List (Pair (Expr a))) -- constructor name Dict borks (import of same name)
    | Constr a Ctr (List (Expr a))
    | Matrix a (Expr a) (Var × Var) (Expr a)
-   | Lambda (Elim a)
+   | Lambda a (Elim a)
    | Project (Expr a) Var
    | App (Expr a) (Expr a)
    | Let (VarDef a) (Expr a)
@@ -73,7 +73,7 @@ instance FV (Expr a) where
    fv (Dictionary _ ees) = unions ((unions <<< (fv # both) <<< toTuple) <$> ees)
    fv (Constr _ _ es) = unions (fv <$> es)
    fv (Matrix _ e1 _ e2) = union (fv e1) (fv e2)
-   fv (Lambda σ) = fv σ
+   fv (Lambda _ σ) = fv σ
    fv (Project e _) = fv e
    fv (App e1 e2) = fv e1 `union` fv e2
    fv (Let def e) = fv def `union` (fv e `difference` bv def)
@@ -145,7 +145,7 @@ instance Apply Expr where
    apply (Constr fα c fes) (Constr α c' es) = Constr (fα α) (c ≜ c') (zipWith (<*>) fes es)
    apply (Matrix fα fe1 (x × y) fe2) (Matrix α e1 (x' × y') e2) =
       Matrix (fα α) (fe1 <*> e1) ((x ≜ x') × (y ≜ y')) (fe2 <*> e2)
-   apply (Lambda fσ) (Lambda σ) = Lambda (fσ <*> σ)
+   apply (Lambda fα fσ) (Lambda α σ) = Lambda (fα α) (fσ <*> σ)
    apply (Project fe x) (Project e _) = Project (fe <*> e) x
    apply (App fe1 fe2) (App e1 e2) = App (fe1 <*> e1) (fe2 <*> e2)
    apply (Let (VarDef fσ fe1) fe2) (Let (VarDef σ e1) e2) = Let (VarDef (fσ <*> σ) (fe1 <*> e1)) (fe2 <*> e2)
@@ -223,7 +223,7 @@ instance JoinSemilattice a => JoinSemilattice (Expr a) where
    maybeJoin (Constr α c es) (Constr α' c' es') = Constr (α ∨ α') <$> (c ≞ c') <*> maybeJoin es es'
    maybeJoin (Matrix α e1 (x × y) e2) (Matrix α' e1' (x' × y') e2') =
       Matrix (α ∨ α') <$> maybeJoin e1 e1' <*> ((x ≞ x') `lift2 (×)` (y ≞ y')) <*> maybeJoin e2 e2'
-   maybeJoin (Lambda σ) (Lambda σ') = Lambda <$> maybeJoin σ σ'
+   maybeJoin (Lambda α σ) (Lambda α' σ') = Lambda (α ∨ α') <$> maybeJoin σ σ'
    maybeJoin (Project e x) (Project e' x') = Project <$> maybeJoin e e' <*> (x ≞ x')
    maybeJoin (App e1 e2) (App e1' e2') = App <$> maybeJoin e1 e1' <*> maybeJoin e2 e2'
    maybeJoin (Let def e) (Let def' e') = Let <$> maybeJoin def def' <*> maybeJoin e e'
@@ -243,7 +243,7 @@ instance BoundedJoinSemilattice a => Expandable (Expr a) (Raw Expr) where
    expand (Constr α c es) (Constr _ c' es') = Constr α (c ≜ c') (expand es es')
    expand (Matrix α e1 (x × y) e2) (Matrix _ e1' (x' × y') e2') =
       Matrix α (expand e1 e1') ((x ≜ x') × (y ≜ y')) (expand e2 e2')
-   expand (Lambda σ) (Lambda σ') = Lambda (expand σ σ')
+   expand (Lambda α σ) (Lambda _ σ') = Lambda α (expand σ σ')
    expand (Project e x) (Project e' x') = Project (expand e e') (x ≜ x')
    expand (App e1 e2) (App e1' e2') = App (expand e1 e1') (expand e2 e2')
    expand (Let def e) (Let def' e') = Let (expand def def') (expand e e')
diff --git a/src/Pretty.purs b/src/Pretty.purs
index 71fc14e0f..1b54cd826 100644
--- a/src/Pretty.purs
+++ b/src/Pretty.purs
@@ -376,7 +376,7 @@ instance Highlightable a => Pretty (E.Expr a) where
    pretty (E.Dictionary α ees) = prettyDict pretty α (ees <#> toTuple)
    pretty (E.Constr α c es) = prettyConstr α c es
    pretty (E.Matrix α e1 (i × j) e2) = (highlightIf α (prettyMatrix e1 i j e2))
-   pretty (E.Lambda σ) = hcat [ text str.fun, pretty σ ]
+   pretty (E.Lambda _ σ) = hcat [ text str.fun, pretty σ ]
    pretty (E.Op op) = parens (text op)
    pretty (E.Let (E.VarDef σ e) e') = atop (hcat [ text str.let_, pretty σ, text str.equals, pretty e, text str.in_ ])
       (pretty e')
diff --git a/src/SExpr.purs b/src/SExpr.purs
index 63ce20df0..3aba057f3 100644
--- a/src/SExpr.purs
+++ b/src/SExpr.purs
@@ -26,7 +26,7 @@ import Dict (fromFoldable, singleton) as D
 import Effect.Exception (Error)
 import Expr (Cont(..), Elim(..), asElim, asExpr)
 import Expr (Expr(..), Module(..), RecDefs, VarDef(..)) as E
-import Lattice (class JoinSemilattice, (∨), bot, definedJoin, maybeJoin, class BoundedJoinSemilattice, Raw)
+import Lattice (class BoundedJoinSemilattice, class BoundedLattice, class JoinSemilattice, Raw, bot, definedJoin, maybeJoin, top, (∨))
 import Partial.Unsafe (unsafePartial)
 import Util (type (+), type (×), Endo, absurd, error, successful, unimplemented, (×))
 import Util.Pair (Pair(..))
@@ -144,7 +144,7 @@ instance Desugarable Clauses Elim where
    desug = clausesFwd
    desugBwd = clausesBwd
 
-desugarModuleFwd :: forall a m. MonadError Error m => JoinSemilattice a => Module a -> m (E.Module a)
+desugarModuleFwd :: forall a m. MonadError Error m => BoundedLattice a => Module a -> m (E.Module a)
 desugarModuleFwd = moduleFwd
 
 -- helpers
@@ -158,7 +158,7 @@ elimBool :: forall a. Cont a -> Cont a -> Elim a
 elimBool κ κ' = ElimConstr (D.fromFoldable [ cTrue × κ, cFalse × κ' ])
 
 -- Module. Surface language supports "blocks" of variable declarations; core does not. Currently no backward.
-moduleFwd :: forall a m. MonadError Error m => JoinSemilattice a => Module a -> m (E.Module a)
+moduleFwd :: forall a m. MonadError Error m => BoundedLattice a => Module a -> m (E.Module a)
 moduleFwd (Module ds) = E.Module <$> traverse varDefOrRecDefsFwd (join (flatten <$> ds))
    where
    varDefOrRecDefsFwd :: VarDef a + RecDefs a -> m (E.VarDef a + E.RecDefs a)
@@ -169,11 +169,11 @@ moduleFwd (Module ds) = E.Module <$> traverse varDefOrRecDefsFwd (join (flatten
    flatten (Left ds') = Left <$> toList ds'
    flatten (Right δ) = pure (Right δ)
 
-varDefFwd :: forall a m. MonadError Error m => JoinSemilattice a => VarDef a -> m (E.VarDef a)
+varDefFwd :: forall a m. MonadError Error m => BoundedLattice a => VarDef a -> m (E.VarDef a)
 varDefFwd (VarDef π s) = E.VarDef <$> pattContFwd π (ContNone :: Cont a) <*> desug s
 
 -- VarDefs
-varDefsFwd :: forall a m. MonadError Error m => JoinSemilattice a => VarDefs a × Expr a -> m (E.Expr a)
+varDefsFwd :: forall a m. MonadError Error m => BoundedLattice a => VarDefs a × Expr a -> m (E.Expr a)
 varDefsFwd (NonEmptyList (d :| Nil) × s) =
    E.Let <$> varDefFwd d <*> desug s
 varDefsFwd (NonEmptyList (d :| d' : ds) × s) =
@@ -191,7 +191,7 @@ varDefsBwd _ (NonEmptyList (_ :| _) × _) = error absurd
 
 -- RecDefs
 -- In the formalism, "group by name" is part of the syntax.
-recDefsFwd :: forall a m. MonadError Error m => JoinSemilattice a => RecDefs a -> m (E.RecDefs a)
+recDefsFwd :: forall a m. MonadError Error m => BoundedLattice a => RecDefs a -> m (E.RecDefs a)
 recDefsFwd xcs = D.fromFoldable <$> traverse recDefFwd xcss
    where
    xcss = map RecDef (groupBy (eq `on` fst) xcs) :: NonEmptyList (RecDef a)
@@ -210,14 +210,14 @@ recDefsBwd ρ xcs = join (go (groupBy (eq `on` fst) xcs))
          NonEmptyList (unwrap (recDefBwd (x ↦ get x ρ) (RecDef xcs1)) :| xcss')
 
 -- RecDef
-recDefFwd :: forall a m. MonadError Error m => JoinSemilattice a => RecDef a -> m (Bind (Elim a))
+recDefFwd :: forall a m. MonadError Error m => BoundedLattice a => RecDef a -> m (Bind (Elim a))
 recDefFwd xcs = (fst (head (unwrap xcs)) ↦ _) <$> clausesFwd (Clauses (snd <$> unwrap xcs))
 
 recDefBwd :: forall a. BoundedJoinSemilattice a => Bind (Elim a) -> Raw RecDef -> RecDef a
 recDefBwd (x ↦ σ) (RecDef bs) = RecDef ((x × _) <$> unwrap (clausesBwd σ (Clauses (snd <$> bs))))
 
 -- Expr
-exprFwd :: forall a m. MonadError Error m => JoinSemilattice a => Expr a -> m (E.Expr a)
+exprFwd :: forall a m. BoundedLattice a => MonadError Error m => JoinSemilattice a => Expr a -> m (E.Expr a)
 exprFwd (Var x) = pure (E.Var x)
 exprFwd (Op op) = pure (E.Op op)
 exprFwd (Int α n) = pure (E.Int α n)
@@ -227,14 +227,14 @@ exprFwd (Constr α c ss) = E.Constr α c <$> traverse desug ss
 exprFwd (Record α xss) = E.Record α <$> D.fromFoldable <$> traverse (traverse desug) xss
 exprFwd (Dictionary α sss) = E.Dictionary α <$> traverse (traverse desug) sss
 exprFwd (Matrix α s (x × y) s') = E.Matrix α <$> desug s <@> x × y <*> desug s'
-exprFwd (Lambda bs) = E.Lambda <$> clausesFwd bs
+exprFwd (Lambda bs) = E.Lambda top <$> clausesFwd bs
 exprFwd (Project s x) = E.Project <$> desug s <@> x
 exprFwd (App s1 s2) = E.App <$> desug s1 <*> desug s2
 exprFwd (BinaryApp s1 op s2) = E.App <$> (E.App (E.Op op) <$> desug s1) <*> desug s2
 exprFwd (MatchAs s bs) =
-   E.App <$> (E.Lambda <$> clausesFwd (Clauses (Clause <$> first singleton <$> bs))) <*> desug s
+   E.App <$> (E.Lambda top <$> clausesFwd (Clauses (Clause <$> first singleton <$> bs))) <*> desug s
 exprFwd (IfElse s1 s2 s3) =
-   E.App <$> (E.Lambda <$> (elimBool <$> (ContExpr <$> desug s2) <*> (ContExpr <$> desug s3))) <*> desug s1
+   E.App <$> (E.Lambda top <$> (elimBool <$> (ContExpr <$> desug s2) <*> (ContExpr <$> desug s3))) <*> desug s1
 exprFwd (ListEmpty α) = pure (enil α)
 exprFwd (ListNonEmpty α s l) = econs α <$> desug s <*> desug l
 exprFwd (ListEnum s1 s2) = E.App <$> ((E.App (E.Var "enumFromTo")) <$> desug s1) <*> desug s2
@@ -255,15 +255,15 @@ exprBwd (E.Dictionary α ees) (Dictionary _ sss) =
    Dictionary α (zipWith (\(Pair e e') (Pair s s') -> Pair (desugBwd e s) (desugBwd e' s')) ees sss)
 exprBwd (E.Matrix α e1 _ e2) (Matrix _ s1 (x × y) s2) =
    Matrix α (desugBwd e1 s1) (x × y) (desugBwd e2 s2)
-exprBwd (E.Lambda σ) (Lambda bs) = Lambda (clausesBwd σ bs)
+exprBwd (E.Lambda _ σ) (Lambda bs) = Lambda (clausesBwd σ bs)
 exprBwd (E.Project e _) (Project s x) = Project (desugBwd e s) x
 exprBwd (E.App e1 e2) (App s1 s2) = App (desugBwd e1 s1) (desugBwd e2 s2)
 exprBwd (E.App (E.App (E.Op _) e1) e2) (BinaryApp s1 op s2) =
    BinaryApp (desugBwd e1 s1) op (desugBwd e2 s2)
-exprBwd (E.App (E.Lambda σ) e) (MatchAs s bs) =
+exprBwd (E.App (E.Lambda _ σ) e) (MatchAs s bs) =
    MatchAs (desugBwd e s)
       (first head <$> unwrap <$> unwrap (clausesBwd σ (Clauses (Clause <$> first NE.singleton <$> bs))))
-exprBwd (E.App (E.Lambda (ElimConstr m)) e1) (IfElse s1 s2 s3) =
+exprBwd (E.App (E.Lambda _ (ElimConstr m)) e1) (IfElse s1 s2 s3) =
    IfElse (desugBwd e1 s1)
       (desugBwd (asExpr (get cTrue m)) s2)
       (desugBwd (asExpr (get cFalse m)) s3)
@@ -279,7 +279,7 @@ exprBwd (E.LetRec xσs e) (LetRec xcs s) = LetRec (recDefsBwd xσs xcs) (desugBw
 exprBwd _ _ = error absurd
 
 -- ListRest
-listRestFwd :: forall a m. MonadError Error m => JoinSemilattice a => ListRest a -> m (E.Expr a)
+listRestFwd :: forall a m. MonadError Error m => BoundedLattice a => ListRest a -> m (E.Expr a)
 listRestFwd (End α) = pure (enil α)
 listRestFwd (Next α s l) = econs α <$> desug s <*> desug l
 
@@ -290,20 +290,20 @@ listRestBwd (E.Constr α _ (e1 : e2 : Nil)) (Next _ s l) =
 listRestBwd _ _ = error absurd
 
 -- List Qualifier × Expr
-listCompFwd :: forall a m. MonadError Error m => JoinSemilattice a => a × List (Qualifier a) × Expr a -> m (E.Expr a)
+listCompFwd :: forall a m. MonadError Error m => BoundedLattice a => a × List (Qualifier a) × Expr a -> m (E.Expr a)
 listCompFwd (α × Nil × s) =
    econs α <$> desug s <@> enil α
 listCompFwd (α × (Guard s : qs) × s') = do
    e <- listCompFwd (α × qs × s')
-   E.App (E.Lambda (elimBool (ContExpr e) (ContExpr (enil α)))) <$> desug s
+   E.App (E.Lambda α (elimBool (ContExpr e) (ContExpr (enil α)))) <$> desug s
 listCompFwd (α × (Declaration (VarDef π s) : qs) × s') = do
    e <- ContExpr <$> listCompFwd (α × qs × s')
    σ <- pattContFwd π e
-   E.App (E.Lambda σ) <$> desug s
+   E.App (E.Lambda α σ) <$> desug s
 listCompFwd (α × (Generator p s : qs) × s') = do
    e <- ContExpr <$> listCompFwd (α × qs × s')
    σ <- pattContFwd p e
-   E.App (E.App (E.Var "concatMap") (E.Lambda (asElim (orElseFwd (ContElim σ) α)))) <$> desug s
+   E.App (E.App (E.Var "concatMap") (E.Lambda α (asElim (orElseFwd (ContElim σ) α)))) <$> desug s
 
 listCompBwd
    :: forall a
@@ -313,17 +313,17 @@ listCompBwd
    -> a × List (Qualifier a) × Expr a
 listCompBwd (E.Constr α2 c (e : E.Constr α1 c' Nil : Nil)) (Nil × s) | c == cCons && c' == cNil =
    (α1 ∨ α2) × Nil × desugBwd e s
-listCompBwd (E.App (E.Lambda (ElimConstr m)) e) ((Guard s0 : qs) × s) =
+listCompBwd (E.App (E.Lambda α' (ElimConstr m)) e) ((Guard s0 : qs) × s) =
    case listCompBwd (asExpr (get cTrue m)) (qs × s) × asExpr (get cFalse m) of
-      (α × qs' × s') × E.Constr β c Nil | c == cNil -> (α ∨ β) × (Guard (desugBwd e s0) : qs') × s'
+      (α × qs' × s') × E.Constr β c Nil | c == cNil -> (α ∨ α' ∨ β) × (Guard (desugBwd e s0) : qs') × s'
       _ -> error absurd
-listCompBwd (E.App (E.Lambda σ) e) ((Declaration (VarDef π s0) : qs) × s) =
+listCompBwd (E.App (E.Lambda α' σ) e) ((Declaration (VarDef π s0) : qs) × s) =
    case listCompBwd (asExpr (pattContBwd π σ)) (qs × s) of
-      α × qs' × s' -> α × (Declaration (VarDef π (desugBwd e s0)) : qs') × s'
-listCompBwd (E.App (E.App (E.Var "concatMap") (E.Lambda σ)) e) ((Generator p s0 : qs) × s) =
+      α × qs' × s' -> (α ∨ α') × (Declaration (VarDef π (desugBwd e s0)) : qs') × s'
+listCompBwd (E.App (E.App (E.Var "concatMap") (E.Lambda α' σ)) e) ((Generator p s0 : qs) × s) =
    case orElseBwd (ContElim σ) (Left p : Nil) of
       σ' × β -> case listCompBwd (asExpr (pattContBwd p (asElim σ'))) (qs × s) of
-         α × qs' × s' -> (α ∨ β) × (Generator p (desugBwd e s0) : qs') × s'
+         α × qs' × s' -> (α ∨ α' ∨ β) × (Generator p (desugBwd e s0) : qs') × s'
 listCompBwd _ _ = error absurd
 
 -- Pattern × Cont
@@ -367,7 +367,7 @@ pattArgsBwd (Left p : πs) σ = pattArgsBwd πs (pattContBwd p (asElim σ))
 pattArgsBwd (Right o : πs) σ = pattArgsBwd πs (pattCont_ListRest_Bwd (asElim σ) o)
 
 -- Clauses
-clausesFwd :: forall a m. MonadError Error m => JoinSemilattice a => Clauses a -> m (Elim a)
+clausesFwd :: forall a m. BoundedLattice a => MonadError Error m => JoinSemilattice a => Clauses a -> m (Elim a)
 clausesFwd (Clauses bs) = do
    NonEmptyList (σ :| σs) <- traverse pattsExprFwd (unwrap <$> bs)
    foldM maybeJoin σ σs
@@ -375,7 +375,7 @@ clausesFwd (Clauses bs) = do
    pattsExprFwd :: NonEmptyList Pattern × Expr a -> m (Elim a)
    pattsExprFwd (NonEmptyList (p :| Nil) × s) = (ContExpr <$> desug s) >>= pattContFwd p
    pattsExprFwd (NonEmptyList (p :| p' : ps) × s) =
-      pattContFwd p =<< ContExpr <$> E.Lambda <$> pattsExprFwd (NonEmptyList (p' :| ps) × s)
+      pattContFwd p =<< ContExpr <$> E.Lambda top <$> pattsExprFwd (NonEmptyList (p' :| ps) × s)
 
 clausesBwd :: forall a. BoundedJoinSemilattice a => Elim a -> Raw Clauses -> Clauses a
 clausesBwd σ (Clauses bs) = Clauses (clauseBwd <$> bs)
@@ -387,7 +387,7 @@ clausesBwd σ (Clauses bs) = Clauses (clauseBwd <$> bs)
    pattsExprBwd (NonEmptyList (p :| Nil) × s) σ' = desugBwd (asExpr (pattContBwd p σ')) s
    pattsExprBwd (NonEmptyList (p :| p' : ps) × s) σ' = next (asExpr (pattContBwd p σ'))
       where
-      next (E.Lambda τ) = pattsExprBwd (NonEmptyList (p' :| ps) × s) τ
+      next (E.Lambda _ τ) = pattsExprBwd (NonEmptyList (p' :| ps) × s) τ
       next _ = error absurd
 
 -- orElse

From d16e23ca87c3c66970057f942383c5ad2f7f33c9 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 06:44:40 +0100
Subject: [PATCH 08/57] =?UTF-8?q?=F0=9F=A7=A9=20[doc]=20:=20Fix=20ContNone?=
 =?UTF-8?q?.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Expr.purs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Expr.purs b/src/Expr.purs
index 81019d7ef..88f864330 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -28,7 +28,7 @@ data Expr a
    | Dictionary a (List (Pair (Expr a))) -- constructor name Dict borks (import of same name)
    | Constr a Ctr (List (Expr a))
    | Matrix a (Expr a) (Var × Var) (Expr a)
-   | Lambda a (Elim a)
+   | Lambda a (Elim a) -- deviate from POPL paper by having closures depend on lambdas
    | Project (Expr a) Var
    | App (Expr a) (Expr a)
    | Let (VarDef a) (Expr a)
@@ -45,9 +45,9 @@ data Elim a
 
 -- Continuation of an eliminator branch.
 data Cont a
-   = ContNone
-   | -- null continuation, used in let bindings/module variable bindings
-     ContExpr (Expr a)
+   = -- null continuation, used in let bindings/module variable bindings
+     ContNone
+   | ContExpr (Expr a)
    | ContElim (Elim a)
 
 asElim :: forall a. Cont a -> Elim a

From a5d47b374b8de3e78e60238be28fcb26ffd26375 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 07:22:27 +0100
Subject: [PATCH 09/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Add=20links?=
 =?UTF-8?q?=20from=20(recursive)=20closures=20to=20originating=20letrecs.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Eval.purs      |  6 +++---
 src/EvalBwd.purs   |  2 +-
 src/EvalGraph.purs |  6 +++---
 src/Expr.purs      | 13 +++++++------
 src/Module.purs    |  4 +---
 src/Pretty.purs    |  2 +-
 src/SExpr.purs     |  4 ++--
 test/Many.purs     |  4 ++--
 8 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/src/Eval.purs b/src/Eval.purs
index 00b451970..a80081d59 100644
--- a/src/Eval.purs
+++ b/src/Eval.purs
@@ -157,9 +157,9 @@ eval γ (Let (VarDef σ e) e') α = do
    γ' × _ × α' × w <- match v σ -- terminal meta-type of eliminator is meta-unit
    t' × v' <- eval (γ <+> γ') e' α' -- (α ∧ α') for consistency with functions? (similarly for module defs)
    pure $ T.Let (T.VarDef w t) t' × v'
-eval γ (LetRec ρ e) α = do
-   let γ' = closeDefs γ ρ α
-   t × v <- eval (γ <+> γ') e α
+eval γ (LetRec α ρ e) α' = do
+   let γ' = closeDefs γ ρ (α ∧ α')
+   t × v <- eval (γ <+> γ') e (α ∧ α')
    pure $ T.LetRec (erase <$> ρ) t × v
 
 eval_module :: forall a m. MonadError Error m => Ann a => Env a -> Module a -> a -> m (Env a)
diff --git a/src/EvalBwd.purs b/src/EvalBwd.purs
index d1d57da1e..fe7ebfc9a 100644
--- a/src/EvalBwd.purs
+++ b/src/EvalBwd.purs
@@ -188,7 +188,7 @@ evalBwd' v (T.Let (T.VarDef w t1) t2) =
    v' × σ = matchBwd γ2 ContNone α2 w
    γ1' × e1 × α1 = evalBwd' v' t1
 evalBwd' v (T.LetRec ρ t) =
-   (γ1 ∨ γ1') × LetRec ρ' e × (α ∨ α')
+   (γ1 ∨ γ1') × LetRec (α ∨ α') ρ' e × (α ∨ α')
    where
    γ1γ2 × e × α = evalBwd' v t
    γ1 × γ2 = append_inv (S.fromFoldable $ keys ρ) γ1γ2
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 8e6e06d44..b8f8f18bc 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -157,9 +157,9 @@ eval γ (Let (VarDef σ e) e') αs = do
    v <- eval γ e αs
    γ' × _ × αs' <- match v σ -- terminal meta-type of eliminator is meta-unit
    eval (γ <+> γ') e' αs' -- (αs ∧ αs') for consistency with functions? (similarly for module defs)
-eval γ (LetRec ρ e) αs = do
-   γ' <- closeDefs γ ρ αs
-   eval (γ <+> γ') e αs
+eval γ (LetRec α ρ e) αs = do
+   γ' <- closeDefs γ ρ (insert α αs)
+   eval (γ <+> γ') e (insert α αs)
 
 eval_module :: forall m. MonadGraphAlloc m => Env Vertex -> Module Vertex -> Set Vertex -> m (Env Vertex)
 eval_module γ = go D.empty
diff --git a/src/Expr.purs b/src/Expr.purs
index 88f864330..4b487c878 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -18,6 +18,7 @@ import Lattice (class BoundedJoinSemilattice, class Expandable, class JoinSemila
 import Util (type (+), type (×), both, error, throw, (×), (≜), (≞))
 import Util.Pair (Pair, toTuple)
 
+-- Deviate from POPL paper by having closures depend on originating lambda or letrec
 data Expr a
    = Var Var
    | Op Var
@@ -28,11 +29,11 @@ data Expr a
    | Dictionary a (List (Pair (Expr a))) -- constructor name Dict borks (import of same name)
    | Constr a Ctr (List (Expr a))
    | Matrix a (Expr a) (Var × Var) (Expr a)
-   | Lambda a (Elim a) -- deviate from POPL paper by having closures depend on lambdas
+   | Lambda a (Elim a)
    | Project (Expr a) Var
    | App (Expr a) (Expr a)
    | Let (VarDef a) (Expr a)
-   | LetRec (RecDefs a) (Expr a)
+   | LetRec a (RecDefs a) (Expr a)
 
 -- eliminator here is a singleton with null terminal continuation
 data VarDef a = VarDef (Elim a) (Expr a)
@@ -77,7 +78,7 @@ instance FV (Expr a) where
    fv (Project e _) = fv e
    fv (App e1 e2) = fv e1 `union` fv e2
    fv (Let def e) = fv def `union` (fv e `difference` bv def)
-   fv (LetRec ρ e) = unions (fv <$> ρ) `union` fv e
+   fv (LetRec _ ρ e) = unions (fv <$> ρ) `union` fv e
 
 instance FV (Elim a) where
    fv (ElimVar x κ) = fv κ `difference` singleton x
@@ -149,7 +150,7 @@ instance Apply Expr where
    apply (Project fe x) (Project e _) = Project (fe <*> e) x
    apply (App fe1 fe2) (App e1 e2) = App (fe1 <*> e1) (fe2 <*> e2)
    apply (Let (VarDef fσ fe1) fe2) (Let (VarDef σ e1) e2) = Let (VarDef (fσ <*> σ) (fe1 <*> e1)) (fe2 <*> e2)
-   apply (LetRec fρ fe) (LetRec ρ e) = LetRec (D.apply2 fρ ρ) (fe <*> e)
+   apply (LetRec fα fρ fe) (LetRec α ρ e) = LetRec (fα α) (D.apply2 fρ ρ) (fe <*> e)
    apply _ _ = error "Apply Expr: shape mismatch"
 
 instance Apply Elim where
@@ -227,7 +228,7 @@ instance JoinSemilattice a => JoinSemilattice (Expr a) where
    maybeJoin (Project e x) (Project e' x') = Project <$> maybeJoin e e' <*> (x ≞ x')
    maybeJoin (App e1 e2) (App e1' e2') = App <$> maybeJoin e1 e1' <*> maybeJoin e2 e2'
    maybeJoin (Let def e) (Let def' e') = Let <$> maybeJoin def def' <*> maybeJoin e e'
-   maybeJoin (LetRec ρ e) (LetRec ρ' e') = LetRec <$> maybeJoin ρ ρ' <*> maybeJoin e e'
+   maybeJoin (LetRec α ρ e) (LetRec α' ρ' e') = LetRec (α ∨ α') <$> maybeJoin ρ ρ' <*> maybeJoin e e'
    maybeJoin _ _ = throw "Incompatible expressions"
 
    join e = definedJoin e
@@ -247,5 +248,5 @@ instance BoundedJoinSemilattice a => Expandable (Expr a) (Raw Expr) where
    expand (Project e x) (Project e' x') = Project (expand e e') (x ≜ x')
    expand (App e1 e2) (App e1' e2') = App (expand e1 e1') (expand e2 e2')
    expand (Let def e) (Let def' e') = Let (expand def def') (expand e e')
-   expand (LetRec ρ e) (LetRec ρ' e') = LetRec (expand ρ ρ') (expand e e')
+   expand (LetRec α ρ e) (LetRec _ ρ' e') = LetRec α (expand ρ ρ') (expand e e')
    expand _ _ = error "Incompatible expressions"
diff --git a/src/Module.purs b/src/Module.purs
index ad22821d8..dcb1f5cc8 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -68,7 +68,6 @@ defaultImports = do
    γα <- traverse alloc primitives
    loadModule (File "prelude") γα >>= loadModule (File "graphics") >>= loadModule (File "convolution")
 
--- | Evaluates default imports from empty initial graph config
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
    (g × n) × γα <- runWithGraphAllocT (G.empty × 0) defaultImports
@@ -82,6 +81,5 @@ openDatasetAs file x { g, n, γα } = do
       runWithGraphAllocT (g × n) do
          e <- desug s
          eα <- alloc e
-         vα <- eval γα eα empty
-         pure (D.singleton x vα)
+         D.singleton x <$> eval γα eα empty
    pure ({ g: g', n: n', γα } × xv)
diff --git a/src/Pretty.purs b/src/Pretty.purs
index 1b54cd826..cb46c74a1 100644
--- a/src/Pretty.purs
+++ b/src/Pretty.purs
@@ -380,7 +380,7 @@ instance Highlightable a => Pretty (E.Expr a) where
    pretty (E.Op op) = parens (text op)
    pretty (E.Let (E.VarDef σ e) e') = atop (hcat [ text str.let_, pretty σ, text str.equals, pretty e, text str.in_ ])
       (pretty e')
-   pretty (E.LetRec δ e) = atop (hcat [ text str.let_, pretty δ, text str.in_ ]) (pretty e)
+   pretty (E.LetRec _ δ e) = atop (hcat [ text str.let_, pretty δ, text str.in_ ]) (pretty e)
    pretty (E.Project e x) = pretty e .<>. text str.dot .<>. pretty x
    pretty (E.App e e') = hcat [ pretty e, pretty e' ]
 
diff --git a/src/SExpr.purs b/src/SExpr.purs
index 3aba057f3..496e1c5d7 100644
--- a/src/SExpr.purs
+++ b/src/SExpr.purs
@@ -240,7 +240,7 @@ exprFwd (ListNonEmpty α s l) = econs α <$> desug s <*> desug l
 exprFwd (ListEnum s1 s2) = E.App <$> ((E.App (E.Var "enumFromTo")) <$> desug s1) <*> desug s2
 exprFwd (ListComp α s qs) = listCompFwd (α × qs × s)
 exprFwd (Let ds s) = varDefsFwd (ds × s)
-exprFwd (LetRec xcs s) = E.LetRec <$> recDefsFwd xcs <*> desug s
+exprFwd (LetRec xcs s) = E.LetRec top <$> recDefsFwd xcs <*> desug s
 
 exprBwd :: forall a. BoundedJoinSemilattice a => E.Expr a -> Raw Expr -> Expr a
 exprBwd (E.Var _) (Var x) = Var x
@@ -275,7 +275,7 @@ exprBwd (E.App (E.App (E.Var "enumFromTo") e1) e2) (ListEnum s1 s2) =
 exprBwd e (ListComp _ s qs) =
    let α × qs' × s' = listCompBwd e (qs × s) in ListComp α s' qs'
 exprBwd (E.Let d e) (Let ds s) = uncurry Let (varDefsBwd (E.Let d e) (ds × s))
-exprBwd (E.LetRec xσs e) (LetRec xcs s) = LetRec (recDefsBwd xσs xcs) (desugBwd e s)
+exprBwd (E.LetRec _ xσs e) (LetRec xcs s) = LetRec (recDefsBwd xσs xcs) (desugBwd e s)
 exprBwd _ _ = error absurd
 
 -- ListRest
diff --git a/test/Many.purs b/test/Many.purs
index f614f00c5..55e07c088 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -41,10 +41,10 @@ withDatasetMany fxs iter = zip names affs
    where
    affs = fxs <#> \{ dataset, file } -> do
       { g, n, γα } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      let loadedData = { g, n, γα: γα <+> xv }
+      let gconfig = { g, n, γα: γα <+> xv }
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr loadedData { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+         testWithSetup file expr gconfig { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
    names = fxs <#> _.file
 

From 106a0423949ed9acd1d75fc4eecbec2ab1f57759 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Sun, 1 Oct 2023 07:34:26 +0100
Subject: [PATCH 10/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Cleanup.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 24 ++++++++++--------------
 1 file changed, 10 insertions(+), 14 deletions(-)

diff --git a/test/Many.purs b/test/Many.purs
index 55e07c088..546d414ea 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -13,46 +13,42 @@ import Util (type (×), (×), successful)
 import Val ((<+>))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
-many fxs iter = zip names affs
+many specs iter = zip (specs <#> _.file) (specs <#> one)
    where
-   affs = fxs <#> \{ file, fwd_expect } -> do
+   one { file, fwd_expect } = do
       gconfig <- openDefaultImports
       expr <- open (File file)
       rows <- replicateM iter $
          testWithSetup file expr gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
       pure $ averageRows rows
-   names = map _.file fxs
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
-bwdMany fxs iter = zip names affs
+bwdMany specs iter = zip (specs <#> _.file) (specs <#> bwdOne)
    where
    folder = File "slicing/"
-   affs = fxs <#> \{ file, file_expect, δv, fwd_expect } -> do
+   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)
       rows <- replicateM iter $
          testWithSetup file expr gconfig { δv, fwd_expect, bwd_expect }
       pure $ averageRows rows
-   names = map _.file fxs
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
-withDatasetMany fxs iter = zip names affs
+withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
    where
-   affs = fxs <#> \{ dataset, file } -> do
+   withDatasetOne { dataset, file } = do
       { g, n, γα } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      let gconfig = { g, n, γα: γα <+> xv }
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+         testWithSetup file expr { g, n, γα: γα <+> xv } { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
-   names = fxs <#> _.file
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
-linkMany fxs = zip names affs
+linkMany specs = zip (specs <#> name) (specs <#> linkOne)
    where
-   names = fxs <#> \spec -> "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
-   affs = fxs <#> \{ spec, δv1, v2_expect } -> do
+   name spec = "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
+   linkOne { spec, δv1, v2_expect } = do
       { γ0, γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
       let { v': v2' } = successful $ linkResult spec.x γ0 γ e1 e2 t1 t2 (δv1 v1)
       checkPretty "Linked output" v2_expect v2'

From ba6659ba8f154d5046194bdf9cc7627bbba88290 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Mon, 2 Oct 2023 17:08:28 +0200
Subject: [PATCH 11/57] =?UTF-8?q?=F0=9F=A7=A9=20[add-unused]:=20Explicit?=
 =?UTF-8?q?=20notion=20of=20ProgCxt.=20Vertices=20type=20class.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs         |  8 ++++----
 src/EvalGraph.purs       | 21 ++++++++++-----------
 src/Graph.purs           | 19 +++++++++++++++----
 src/Graph/GraphImpl.purs |  6 ++++--
 src/Graph/Slice.purs     |  9 ---------
 src/Module.purs          | 28 ++++++++++++++++------------
 src/Val.purs             |  5 ++++-
 test/Many.purs           |  6 ++++--
 test/Util.purs           | 12 +++++-------
 9 files changed, 62 insertions(+), 52 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index e18eb78d7..a5c3104f3 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -193,10 +193,10 @@ linkResult x γ0 γ e1 e2 t1 _ v1 = do
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
    -- TODO: not every example should run with this dataset.
-   { γα: γα0 } × xv :: GraphConfig GraphImpl × _ <-
+   { progCxt } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/linking/renewables") "data"
    let
-      γ0 = botOf <$> γα0
+      γ0 = botOf <$> progCxt.γ
       xv0 = botOf <$> xv
    s' <- open file
    let s0 = botOf s'
@@ -212,11 +212,11 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
    -- the views share an ambient environment γ0 as well as dataset
-   { γα } × xv :: GraphConfig GraphImpl × _ <-
+   { progCxt } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
-      γ0 = botOf <$> γα
+      γ0 = botOf <$> progCxt.γ
       xv0 = botOf <$> xv
       s1 = botOf s1'
       s2 = botOf s2'
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index b8f8f18bc..54f004ec2 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -26,22 +26,21 @@ import Dict (disjointUnion, fromFoldable, empty, get, keys, lookup, singleton) a
 import Effect.Exception (Error)
 import Expr (Cont(..), Elim(..), Expr(..), VarDef(..), RecDefs, Module(..), fv, asExpr)
 import GaloisConnection (GaloisConnection(..))
-import Graph (class Graph, Vertex, sinks)
-import Graph (vertices) as G
+import Graph (class Graph, Vertex, sinks, vertices)
 import Graph.GraphWriter (class MonadGraphAlloc, alloc, new, runWithGraphAllocT)
-import Graph.Slice (bwdSlice, fwdSlice, vertices)
+import Graph.Slice (bwdSlice, fwdSlice)
 import Lattice (Raw)
 import Pretty (prettyP)
 import Primitive (string, intPair)
 import Util (type (×), check, error, orElse, successful, throw, with, (×))
 import Util.Pair (unzip) as P
-import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), Val, for, lookup', restrict, (<+>))
+import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgramCxt, Val, for, lookup', restrict, (<+>))
 import Val (Val(..), Fun(..)) as V
 
 type GraphConfig g =
    { g :: g
    , n :: Int
-   , γα :: Env Vertex
+   , progCxt :: ProgramCxt Vertex
    }
 
 {-# Matching #-}
@@ -189,15 +188,15 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, γα } e = do
+graphGC { g, n, progCxt } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
-         vα <- eval γα eα S.empty
+         vα <- eval progCxt.γ eα S.empty
          pure (eα × vα)
    let
-      dom = vertices eα `union` foldMap vertices γα
-      fwd αs = G.vertices (fwdSlice αs g') `intersection` vertices vα
-      bwd αs = G.vertices (bwdSlice αs g') `intersection` sinks g'
+      dom = vertices eα `union` foldMap vertices progCxt.γ
+      fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
+      bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
-      pure { gc: GC { fwd, bwd }, γα, eα, g: g', vα }
+      pure { gc: GC { fwd, bwd }, γα: progCxt.γ, eα, g: g', vα }
diff --git a/src/Graph.purs b/src/Graph.purs
index 5d19edd69..778fd4342 100644
--- a/src/Graph.purs
+++ b/src/Graph.purs
@@ -6,14 +6,14 @@ import Data.Foldable (class Foldable)
 import Data.List (List, concat)
 import Data.List (fromFoldable) as L
 import Data.Newtype (class Newtype)
-import Data.Set (Set)
-import Data.Set (map) as S
+import Data.Set (Set, member, singleton, unions)
+import Data.Set (empty, map) as S
 import Util (Endo, (×), type (×))
 
 type Edge = Vertex × Vertex
 
 -- | "Static" graphs, optimised for lookup and building from (key, value) pairs.
-class Semigroup g <= Graph g where
+class (Vertices g, Semigroup g) <= Graph g where
    -- | Whether g contains a given vertex.
    elem :: Vertex -> g -> Boolean
    -- | outN and iN satisfy
@@ -23,7 +23,6 @@ class Semigroup g <= Graph g where
 
    -- | Number of vertices in g.
    size :: g -> Int
-   vertices :: g -> Set Vertex
 
    sources :: g -> Set Vertex
    sinks :: g -> Set Vertex
@@ -36,6 +35,18 @@ class Semigroup g <= Graph g where
 
 newtype Vertex = Vertex String
 
+class Vertices a where
+   vertices :: a -> Set Vertex
+
+instance (Apply f, Foldable f) => Vertices (f Vertex) where
+   vertices vα = selectαs (const true <$> vα) vα
+
+selectαs :: forall f. Apply f => Foldable f => f Boolean -> f Vertex -> Set Vertex
+selectαs v𝔹 vα = unions ((if _ then singleton else const S.empty) <$> v𝔹 <*> vα)
+
+select𝔹s :: forall f. Functor f => f Vertex -> Set Vertex -> f Boolean
+select𝔹s vα αs = (_ `member` αs) <$> vα
+
 outEdges' :: forall g. Graph g => g -> Vertex -> List Edge
 outEdges' g α = L.fromFoldable $ S.map (α × _) (outN g α)
 
diff --git a/src/Graph/GraphImpl.purs b/src/Graph/GraphImpl.purs
index 74252f904..8e84f17f8 100644
--- a/src/Graph/GraphImpl.purs
+++ b/src/Graph/GraphImpl.purs
@@ -21,7 +21,7 @@ import Dict as D
 import Foreign.Object (runST)
 import Foreign.Object.ST (STObject)
 import Foreign.Object.ST as OST
-import Graph (class Graph, Vertex(..), op, outN)
+import Graph (class Graph, class Vertices, Vertex(..), op, outN)
 import Util (type (×), (×), definitely)
 
 -- Maintain out neighbours and in neighbours as separate adjacency maps with a common domain.
@@ -38,7 +38,6 @@ instance Graph GraphImpl where
    inN g = outN (op g)
    elem α (GraphImpl g) = isJust (D.lookup (unwrap α) g.out)
    size (GraphImpl g) = D.size g.out
-   vertices (GraphImpl g) = S.fromFoldable $ S.map Vertex $ D.keys g.out
    sinks (GraphImpl g) = sinks' g.out
    sources (GraphImpl g) = sinks' g.in
    op (GraphImpl g) = GraphImpl { out: g.in, in: g.out }
@@ -48,6 +47,9 @@ instance Graph GraphImpl where
       where
       α_αs' = L.fromFoldable α_αs -- doesn't seem to adversely affect performance
 
+instance Vertices GraphImpl where
+   vertices (GraphImpl g) = S.fromFoldable $ S.map Vertex $ D.keys g.out
+
 -- Naive implementation based on Dict.filter fails with stack overflow on graphs with ~20k vertices.
 -- This is better but still slow if there are thousands of sinks.
 sinks' :: AdjMap -> Set Vertex
diff --git a/src/Graph/Slice.purs b/src/Graph/Slice.purs
index 99200ff77..f349d576c 100644
--- a/src/Graph/Slice.purs
+++ b/src/Graph/Slice.purs
@@ -59,12 +59,3 @@ fwdSliceDual αs0 g0 = bwdSlice αs0 (op g0)
 fwdSliceAsDeMorgan :: forall g. Graph g => Set Vertex -> g -> g
 fwdSliceAsDeMorgan αs0 g0 =
    bwdSlice (sinks g0 `difference` αs0) (op g0)
-
-vertices :: forall f. Apply f => Foldable f => f Vertex -> Set Vertex
-vertices vα = selectαs (const true <$> vα) vα
-
-selectαs :: forall f. Apply f => Foldable f => f Boolean -> f Vertex -> Set Vertex
-selectαs v𝔹 vα = unions ((if _ then singleton else const empty) <$> v𝔹 <*> vα)
-
-select𝔹s :: forall f. Functor f => f Vertex -> Set Vertex -> f Boolean
-select𝔹s vα αs = (_ `member` αs) <$> vα
diff --git a/src/Module.purs b/src/Module.purs
index dcb1f5cc8..87610e83f 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -9,6 +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(..), (:))
 import Data.Newtype (class Newtype)
 import Data.Set (empty)
 import Data.Traversable (traverse)
@@ -28,7 +29,7 @@ import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
 import Util (type (×), mapLeft, (×))
 import Util.Parse (SParser)
-import Val (Env, (<+>))
+import Val (Env, ProgramCxt, (<+>))
 
 -- Mainly serve as documentation
 newtype File = File String
@@ -57,29 +58,32 @@ parseProgram folder file =
 open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")
 
-loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> Env Vertex -> m (Env Vertex)
-loadModule file γ = do
+loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgramCxt Vertex -> m (ProgramCxt Vertex)
+loadModule file { mods, γ } = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverseModule (const fresh)
-   eval_module γ mod empty <#> (γ <+> _)
+   γ' <- eval_module γ mod empty
+   pure $ { mods: mod : mods, γ: γ <+> γ' }
 
-defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (Env Vertex)
+defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgramCxt Vertex)
 defaultImports = do
-   γα <- traverse alloc primitives
-   loadModule (File "prelude") γα >>= loadModule (File "graphics") >>= loadModule (File "convolution")
+   γ <- traverse alloc primitives
+   loadModule (File "prelude") { mods: Nil, γ }
+      >>= loadModule (File "graphics")
+      >>= loadModule (File "convolution")
 
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
-   (g × n) × γα <- runWithGraphAllocT (G.empty × 0) defaultImports
-   pure { g, n, γα }
+   (g × n) × progCxt <- runWithGraphAllocT (G.empty × 0) defaultImports
+   pure { g, n, progCxt }
 
 -- | Evaluate dataset in context of existing graph config
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
-openDatasetAs file x { g, n, γα } = do
+openDatasetAs file x { g, n, progCxt } = do
    s <- parseProgram (Folder "fluid") file
    (g' × n') × xv <-
       runWithGraphAllocT (g × n) do
          e <- desug s
          eα <- alloc e
-         D.singleton x <$> eval γα eα empty
-   pure ({ g: g', n: n', γα } × xv)
+         D.singleton x <$> eval progCxt.γ eα empty
+   pure ({ g: g', n: n', progCxt } × xv)
diff --git a/src/Val.purs b/src/Val.purs
index bf9e7c74a..27349337a 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -17,7 +17,7 @@ import DataType (Ctr)
 import Dict (Dict, get)
 import Dict (apply2, intersectionWith) as D
 import Effect.Exception (Error)
-import Expr (Elim, RecDefs, fv)
+import Expr (Elim, Module, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
 import Graph (Vertex(..))
@@ -71,6 +71,9 @@ type Env a = Dict (Val a)
 lookup' :: forall a m. MonadThrow Error m => Var -> Dict a -> m a
 lookup' x γ = lookup x γ # orElse ("variable " <> x <> " not found")
 
+-- Bunch of loaded modules.
+type ProgramCxt a = { mods :: List (Module a), γ :: Env a }
+
 -- Want a monoid instance but needs a newtype
 append :: forall a. Env a -> Endo (Env a)
 append = unionWith (const identity)
diff --git a/test/Many.purs b/test/Many.purs
index 546d414ea..f6a1b042f 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -38,10 +38,12 @@ withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff Benc
 withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
    where
    withDatasetOne { dataset, file } = do
-      { g, n, γα } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
+      -- TODO: make progCxt consistent with addition of xv
+      gconfig@{ progCxt: { γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr { g, n, γα: γα <+> xv } { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+         testWithSetup file expr gconfig { progCxt { γ = γ <+> xv } }
+            { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
diff --git a/test/Util.purs b/test/Util.purs
index 38c78739b..cec4a6f0c 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -21,11 +21,9 @@ import Effect.Class.Console (log)
 import Effect.Exception (Error)
 import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
-import Graph (sinks)
-import Graph (vertices) as G
+import Graph (selectαs, select𝔹s, sinks, vertices)
 import Graph.GraphImpl (GraphImpl)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
-import Graph.Slice (selectαs, select𝔹s, vertices)
 import GaloisConnection (GaloisConnection(..))
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
@@ -67,7 +65,7 @@ testParse s = do
       lift $ fail "not equal"
 
 testTrace :: Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> MayFailT Aff TraceRow
-testTrace s { γα } { δv, bwd_expect, fwd_expect } = do
+testTrace s { progCxt } { δv, bwd_expect, fwd_expect } = do
    -- | Desugaring Galois connections for Unit and Boolean type selections
    GC desug <- desugGC s
    GC desug𝔹 <- desugGC s
@@ -75,7 +73,7 @@ testTrace s { γα } { δv, bwd_expect, fwd_expect } = do
    -- | Eval
    let e = desug.fwd s
    t_eval1 <- preciseTime
-   { gc: GC eval, v } <- traceGC (erase <$> γα) e
+   { gc: GC eval, v } <- traceGC (erase <$> progCxt.γ) e
    t_eval2 <- preciseTime
 
    -- | Backward
@@ -148,14 +146,14 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } = do
    t_fwdDual1 <- preciseTime
    let
       gfwd_dual = G.fwdSliceDual αs_in g
-      v𝔹_dual = select𝔹s vα (G.vertices gfwd_dual)
+      v𝔹_dual = select𝔹s vα (vertices gfwd_dual)
    t_fwdDual2 <- preciseTime
 
    -- | Forward (round-tripping) using De Morgan dual
    t_fwdAsDeMorgan1 <- preciseTime
    let
       gfwd_demorgan = G.fwdSliceDeMorgan αs_in g
-      v𝔹_demorgan = select𝔹s vα (G.vertices gfwd_demorgan) <#> not
+      v𝔹_demorgan = select𝔹s vα (vertices gfwd_demorgan) <#> not
    t_fwdAsDeMorgan2 <- preciseTime
 
    lift do

From 48f71b55b424d8602975c065039f263b30f07a53 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Mon, 2 Oct 2023 17:26:07 +0200
Subject: [PATCH 12/57] =?UTF-8?q?=F0=9F=A7=A9=20[unconsolidate]:=20Newtype?=
 =?UTF-8?q?=20gunk=20for=20ProgCxt.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs     | 12 ++++++------
 src/EvalGraph.purs   | 12 ++++++------
 src/Graph/Slice.purs |  3 +--
 src/Module.purs      | 16 ++++++++--------
 src/Val.purs         |  5 ++++-
 test/Many.purs       |  6 +++---
 test/Util.purs       |  6 +++---
 7 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index a5c3104f3..e475b4787 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -39,7 +39,7 @@ import SExpr (Expr(..), Module(..), RecDefs, VarDefs) as S
 import SExpr (desugarModuleFwd)
 import Trace (Trace)
 import Util (MayFail, type (×), type (+), (×), absurd, error, orElse, successful)
-import Val (class Ann, Env, Val(..), append_inv, (<+>))
+import Val (class Ann, Env, ProgCxt(..), Val(..), append_inv, (<+>))
 import Web.Event.EventTarget (eventListener)
 
 data View
@@ -193,10 +193,10 @@ linkResult x γ0 γ e1 e2 t1 _ v1 = do
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
    -- TODO: not every example should run with this dataset.
-   { progCxt } × xv :: GraphConfig GraphImpl × _ <-
+   { progCxt: ProgCxt { γ } } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/linking/renewables") "data"
    let
-      γ0 = botOf <$> progCxt.γ
+      γ0 = botOf <$> γ
       xv0 = botOf <$> xv
    s' <- open file
    let s0 = botOf s'
@@ -211,12 +211,12 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
    let
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
-   -- the views share an ambient environment γ0 as well as dataset
-   { progCxt } × xv :: GraphConfig GraphImpl × _ <-
+   -- views share an ambient environment γ0 as well as dataset
+   { progCxt: ProgCxt { γ } } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
-      γ0 = botOf <$> progCxt.γ
+      γ0 = botOf <$> γ
       xv0 = botOf <$> xv
       s1 = botOf s1'
       s2 = botOf s2'
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 54f004ec2..b39ec3913 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -34,13 +34,13 @@ import Pretty (prettyP)
 import Primitive (string, intPair)
 import Util (type (×), check, error, orElse, successful, throw, with, (×))
 import Util.Pair (unzip) as P
-import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgramCxt, Val, for, lookup', restrict, (<+>))
+import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgCxt(..), Val, for, lookup', restrict, (<+>))
 import Val (Val(..), Fun(..)) as V
 
 type GraphConfig g =
    { g :: g
    , n :: Int
-   , progCxt :: ProgramCxt Vertex
+   , progCxt :: ProgCxt Vertex
    }
 
 {-# Matching #-}
@@ -188,15 +188,15 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, progCxt } e = do
+graphGC { g, n, progCxt: ProgCxt { γ } } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
-         vα <- eval progCxt.γ eα S.empty
+         vα <- eval γ eα S.empty
          pure (eα × vα)
    let
-      dom = vertices eα `union` foldMap vertices progCxt.γ
+      dom = vertices eα `union` foldMap vertices γ
       fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
-      pure { gc: GC { fwd, bwd }, γα: progCxt.γ, eα, g: g', vα }
+      pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }
diff --git a/src/Graph/Slice.purs b/src/Graph/Slice.purs
index f349d576c..0ed959026 100644
--- a/src/Graph/Slice.purs
+++ b/src/Graph/Slice.purs
@@ -3,13 +3,12 @@ module Graph.Slice where
 import Prelude hiding (add)
 
 import Control.Monad.Rec.Class (Step(..), tailRecM)
-import Data.Foldable (class Foldable)
 import Data.List (List(..), (:))
 import Data.List as L
 import Data.Map (Map)
 import Data.Map (insert, empty, lookup, delete) as M
 import Data.Maybe (maybe)
-import Data.Set (Set, empty, insert, member, singleton, unions, difference)
+import Data.Set (Set, empty, insert, singleton, difference)
 import Data.Tuple (fst)
 import Graph (class Graph, Edge, Vertex, inEdges, inEdges', outN, sinks, op)
 import Graph.GraphWriter (WithGraph, extend, runWithGraph)
diff --git a/src/Module.purs b/src/Module.purs
index 87610e83f..27ea5e37a 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -29,7 +29,7 @@ import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
 import Util (type (×), mapLeft, (×))
 import Util.Parse (SParser)
-import Val (Env, ProgramCxt, (<+>))
+import Val (Env, ProgCxt(..), (<+>))
 
 -- Mainly serve as documentation
 newtype File = File String
@@ -58,17 +58,17 @@ parseProgram folder file =
 open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")
 
-loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgramCxt Vertex -> m (ProgramCxt Vertex)
-loadModule file { mods, γ } = do
+loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
+loadModule file (ProgCxt { mods, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverseModule (const fresh)
    γ' <- eval_module γ mod empty
-   pure $ { mods: mod : mods, γ: γ <+> γ' }
+   pure $ ProgCxt { mods: mod : mods, γ: γ <+> γ' }
 
-defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgramCxt Vertex)
+defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt Vertex)
 defaultImports = do
    γ <- traverse alloc primitives
-   loadModule (File "prelude") { mods: Nil, γ }
+   loadModule (File "prelude") (ProgCxt { mods: Nil, γ })
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
@@ -79,11 +79,11 @@ openDefaultImports = do
 
 -- | Evaluate dataset in context of existing graph config
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
-openDatasetAs file x { g, n, progCxt } = do
+openDatasetAs file x { g, n, progCxt: progCxt@(ProgCxt { γ }) } = do
    s <- parseProgram (Folder "fluid") file
    (g' × n') × xv <-
       runWithGraphAllocT (g × n) do
          e <- desug s
          eα <- alloc e
-         D.singleton x <$> eval progCxt.γ eα empty
+         D.singleton x <$> eval γ eα empty
    pure ({ g: g', n: n', progCxt } × xv)
diff --git a/src/Val.purs b/src/Val.purs
index 27349337a..a300c88ee 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -11,6 +11,7 @@ import Data.Bitraversable (bitraverse)
 import Data.Exists (Exists)
 import Data.Foldable (class Foldable, foldl, foldrDefault, foldMapDefaultL)
 import Data.List (List(..), (:), zipWith)
+import Data.Newtype (class Newtype)
 import Data.Set (Set, empty, fromFoldable, intersection, member, singleton, toUnfoldable, union)
 import Data.Traversable (class Traversable, sequenceDefault, traverse)
 import DataType (Ctr)
@@ -72,7 +73,9 @@ lookup' :: forall a m. MonadThrow Error m => Var -> Dict a -> m a
 lookup' x γ = lookup x γ # orElse ("variable " <> x <> " not found")
 
 -- Bunch of loaded modules.
-type ProgramCxt a = { mods :: List (Module a), γ :: Env a }
+newtype ProgCxt a = ProgCxt { mods :: List (Module a), γ :: Env a }
+
+derive instance Newtype (ProgCxt a) _
 
 -- Want a monoid instance but needs a newtype
 append :: forall a. Env a -> Endo (Env a)
diff --git a/test/Many.purs b/test/Many.purs
index f6a1b042f..290348ed0 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -10,7 +10,7 @@ import Effect.Aff (Aff)
 import Module (File(..), Folder(..), loadFile, open, openDatasetAs, openDefaultImports)
 import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, averageRows, checkPretty, testWithSetup)
 import Util (type (×), (×), successful)
-import Val ((<+>))
+import Val (ProgCxt(..), (<+>))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many specs iter = zip (specs <#> _.file) (specs <#> one)
@@ -39,10 +39,10 @@ withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
    where
    withDatasetOne { dataset, file } = do
       -- TODO: make progCxt consistent with addition of xv
-      gconfig@{ progCxt: { γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
+      gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { progCxt { γ = γ <+> xv } }
+         testWithSetup file expr gconfig { progCxt = ProgCxt r{ γ = γ <+> xv } }
             { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
 
diff --git a/test/Util.purs b/test/Util.purs
index cec4a6f0c..68f9726f0 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -33,7 +33,7 @@ import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
 import Util (MayFailT, successful, (×))
-import Val (Val(..), class Ann)
+import Val (class Ann, ProgCxt(..), Val(..))
 
 type TestConfig =
    { δv :: Selector Val
@@ -65,7 +65,7 @@ testParse s = do
       lift $ fail "not equal"
 
 testTrace :: Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> MayFailT Aff TraceRow
-testTrace s { progCxt } { δv, bwd_expect, fwd_expect } = do
+testTrace s { progCxt: ProgCxt { γ } } { δv, bwd_expect, fwd_expect } = do
    -- | Desugaring Galois connections for Unit and Boolean type selections
    GC desug <- desugGC s
    GC desug𝔹 <- desugGC s
@@ -73,7 +73,7 @@ testTrace s { progCxt } { δv, bwd_expect, fwd_expect } = do
    -- | Eval
    let e = desug.fwd s
    t_eval1 <- preciseTime
-   { gc: GC eval, v } <- traceGC (erase <$> progCxt.γ) e
+   { gc: GC eval, v } <- traceGC (erase <$> γ) e
    t_eval2 <- preciseTime
 
    -- | Backward

From 701f8bce4735930d60249c67f1fd11aec36f7dd6 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Mon, 2 Oct 2023 17:26:27 +0200
Subject: [PATCH 13/57] =?UTF-8?q?=F0=9F=A7=A9=20[layout]?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Many.purs b/test/Many.purs
index 290348ed0..c4ff5c1f6 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -42,7 +42,7 @@ withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
       gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
       expr <- open (File file)
       rows <- replicateM iter $
-         testWithSetup file expr gconfig { progCxt = ProgCxt r{ γ = γ <+> xv } }
+         testWithSetup file expr gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
             { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
 

From e1170700f80cfef84b3f6231f57d829e914d4de6 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:11:49 +0200
Subject: [PATCH 14/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Remove=20?=
 =?UTF-8?q?unnecessary=20'successful'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 2 +-
 test/Many.purs   | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index e475b4787..ae31767fa 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -179,7 +179,7 @@ figViews { spec: { xs }, γ0, γ, e, t, v } δv = do
    views <- valViews γ0γ xs
    pure $ view "output" v' × views
 
-linkResult :: Var -> Env 𝔹 -> Env 𝔹 -> Expr 𝔹 -> Expr 𝔹 -> Trace -> Trace -> Val 𝔹 -> MayFail LinkResult
+linkResult :: forall m. MonadError Error m => Var -> Env 𝔹 -> Env 𝔹 -> Expr 𝔹 -> Expr 𝔹 -> Trace -> Trace -> Val 𝔹 -> m LinkResult
 linkResult x γ0 γ e1 e2 t1 _ v1 = do
    let
       γ0γ × _ = evalBwd (erase <$> (γ0 <+> γ)) (erase e1) v1 t1
diff --git a/test/Many.purs b/test/Many.purs
index c4ff5c1f6..62b0d00c2 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -9,7 +9,7 @@ import Data.List.Lazy (replicateM)
 import Effect.Aff (Aff)
 import Module (File(..), Folder(..), loadFile, open, openDatasetAs, openDefaultImports)
 import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, averageRows, checkPretty, testWithSetup)
-import Util (type (×), (×), successful)
+import Util (type (×), (×))
 import Val (ProgCxt(..), (<+>))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
@@ -52,5 +52,5 @@ linkMany specs = zip (specs <#> name) (specs <#> linkOne)
    name spec = "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
    linkOne { spec, δv1, v2_expect } = do
       { γ0, γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
-      let { v': v2' } = successful $ linkResult spec.x γ0 γ e1 e2 t1 t2 (δv1 v1)
+      { v': v2' } <- linkResult spec.x γ0 γ e1 e2 t1 t2 (δv1 v1)
       checkPretty "Linked output" v2_expect v2'

From f767fc49df8c506631925aa5e30e6dfc99f84b37 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:21:22 +0200
Subject: [PATCH 15/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Monoid=20?=
 =?UTF-8?q?instance=20for=20BenchRow.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Benchmark/Util.purs | 60 ++++++++++++++++++++--------------------
 test/Util.purs           |  8 ++----
 2 files changed, 33 insertions(+), 35 deletions(-)

diff --git a/test/Benchmark/Util.purs b/test/Benchmark/Util.purs
index 36f94f50c..c931b2071 100644
--- a/test/Benchmark/Util.purs
+++ b/test/Benchmark/Util.purs
@@ -54,39 +54,39 @@ instance Show BenchAcc where
 rowShow :: String × BenchRow -> String
 rowShow (str × row) = str <> "," <> show row
 
-zeroRow :: BenchRow
-zeroRow =
-   BenchRow { tEval: 0.0, tBwd: 0.0, tFwd: 0.0 }
+instance Semigroup BenchRow where
+   append (BenchRow trRow1 gRow1) (BenchRow trRow2 gRow2) =
+      BenchRow
+         { tEval: trRow1.tEval + trRow2.tEval
+         , tBwd: trRow1.tBwd + trRow2.tBwd
+         , tFwd: trRow1.tFwd + trRow2.tFwd
+         }
+         { tEval: gRow1.tEval + gRow2.tEval
+         , tBwd: gRow1.tBwd + gRow2.tBwd
+         , tBwdDual: gRow1.tBwdDual + gRow2.tBwdDual
+         , tBwdAll: gRow1.tBwdAll + gRow2.tBwdAll
+         , tFwd: gRow1.tFwd + gRow2.tFwd
+         , tFwdDual: gRow1.tFwdDual + gRow2.tFwdDual
+         , tFwdAsDemorgan: gRow1.tFwdAsDemorgan + gRow2.tFwdAsDemorgan
+         }
+
+instance Monoid BenchRow where
+   mempty = BenchRow
+      { tEval: 0.0, tBwd: 0.0, tFwd: 0.0 }
       { tEval: 0.0, tBwd: 0.0, tBwdDual: 0.0, tBwdAll: 0.0, tFwd: 0.0, tFwdDual: 0.0, tFwdAsDemorgan: 0.0 }
 
-sumRow :: BenchRow -> BenchRow -> BenchRow
-sumRow (BenchRow trRow1 gRow1) (BenchRow trRow2 gRow2) =
-   BenchRow
-      { tEval: trRow1.tEval + trRow2.tEval
-      , tBwd: trRow1.tBwd + trRow2.tBwd
-      , tFwd: trRow1.tFwd + trRow2.tFwd
-      }
-      { tEval: gRow1.tEval + gRow2.tEval
-      , tBwd: gRow1.tBwd + gRow2.tBwd
-      , tBwdDual: gRow1.tBwdDual + gRow2.tBwdDual
-      , tBwdAll: gRow1.tBwdAll + gRow2.tBwdAll
-      , tFwd: gRow1.tFwd + gRow2.tFwd
-      , tFwdDual: gRow1.tFwdDual + gRow2.tFwdDual
-      , tFwdAsDemorgan: gRow1.tFwdAsDemorgan + gRow2.tFwdAsDemorgan
-      }
-
 instance Show BenchRow where
-   show (BenchRow trRow grRow) = fold $ intersperse ","
-      [ show trRow.tEval
-      , show trRow.tBwd
-      , show trRow.tFwd
-      , show grRow.tEval
-      , show grRow.tBwd
-      , show grRow.tBwdDual
-      , show grRow.tBwdAll
-      , show grRow.tFwd
-      , show grRow.tFwdDual
-      , show grRow.tFwdAsDemorgan
+   show (BenchRow trRow grRow) = fold $ intersperse "," $ (_ <#> show)
+      [ trRow.tEval
+      , trRow.tBwd
+      , trRow.tFwd
+      , grRow.tEval
+      , grRow.tBwd
+      , grRow.tBwdDual
+      , grRow.tBwdAll
+      , grRow.tFwd
+      , grRow.tFwdDual
+      , grRow.tFwdAsDemorgan
       ]
 
 now :: forall m. MonadEffect m => m JSDate
diff --git a/test/Util.purs b/test/Util.purs
index 68f9726f0..d9fd4b834 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -4,7 +4,7 @@ import Prelude hiding (absurd)
 
 import App.Fig (LinkFigSpec)
 import App.Util (Selector)
-import Benchmark.Util (BenchRow(..), GraphRow, TraceRow, zeroRow, sumRow, preciseTime, tdiff)
+import Benchmark.Util (BenchRow(..), GraphRow, TraceRow, preciseTime, tdiff)
 import Control.Monad.Error.Class (class MonadThrow, liftEither)
 import Control.Monad.Except (runExceptT)
 import Control.Monad.Trans.Class (lift)
@@ -214,9 +214,7 @@ shouldSatisfy msg v pred =
       fail (show v <> " doesn't satisfy predicate: " <> msg)
 
 averageRows :: List BenchRow -> BenchRow
-averageRows rows = average summed
+averageRows rows = average $ foldl (<>) mempty rows
    where
    runs = toNumber $ length rows
-   summed = foldl sumRow zeroRow rows
-   average (BenchRow tr gr) =
-      BenchRow (hmap (\num -> num `div` runs) tr) (hmap (\num -> num `div` runs) gr)
+   average (BenchRow tr gr) = BenchRow (hmap (_ `div` runs) tr) (hmap (_ `div` runs) gr)

From 4fc38b307bfe788fae2b56e94772cf9d731e311c Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:23:28 +0200
Subject: [PATCH 16/57] =?UTF-8?q?=F0=9F=A7=A9=20[remove-unused]:=20JSDate.?=
 =?UTF-8?q?now.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Benchmark/Util.purs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/test/Benchmark/Util.purs b/test/Benchmark/Util.purs
index c931b2071..ba597b8b7 100644
--- a/test/Benchmark/Util.purs
+++ b/test/Benchmark/Util.purs
@@ -5,8 +5,6 @@ import Prelude
 import Control.Monad.Writer (WriterT, runWriterT)
 import Data.Array (intersperse)
 import Data.Foldable (fold)
-import Data.JSDate (JSDate)
-import Data.JSDate (now) as JSDate
 import Effect.Class (class MonadEffect, liftEffect)
 import Test.Spec.Microtime (microtime)
 import Util (type (×), (×))
@@ -49,7 +47,7 @@ type GraphRow =
 instance Show BenchAcc where
    show (BenchAcc rows) =
       "Test-Name, Trace-Eval, Trace-Bwd, Trace-Fwd, Graph-Eval, Graph-Bwd, Graph-BwdDual, Graph-BwdAll, Graph-Fwd, Graph-FwdDual, Graph-FwdAsDeMorgan\n"
-         <> (fold $ intersperse "\n" (map rowShow rows))
+         <> (fold $ intersperse "\n" $ rowShow <$> rows)
 
 rowShow :: String × BenchRow -> String
 rowShow (str × row) = str <> "," <> show row
@@ -89,11 +87,8 @@ instance Show BenchRow where
       , grRow.tFwdAsDemorgan
       ]
 
-now :: forall m. MonadEffect m => m JSDate
-now = liftEffect JSDate.now
-
 tdiff :: Number -> Number -> Number
 tdiff x y = sub y x
 
 preciseTime :: forall m. MonadEffect m => m Number
-preciseTime = liftEffect microtime
\ No newline at end of file
+preciseTime = liftEffect microtime

From 1e7eb20e10579c1e7cd8670bead76cdc3e00269d Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:24:03 +0200
Subject: [PATCH 17/57] =?UTF-8?q?=F0=9F=A7=A9=20[layout]?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Util.purs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/test/Util.purs b/test/Util.purs
index d9fd4b834..55342373c 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -172,7 +172,15 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } = do
          log (prettyP e𝔹_all)
          log (prettyP v𝔹_dual)
 
-   pure { tEval: tdiff t_eval1 t_eval2, tBwd: tdiff t_bwd1 t_bwd2, tBwdDual: tdiff t_bwdDual1 t_bwdDual2, tBwdAll: tdiff t_bwdAll1 t_bwdAll2, tFwd: tdiff t_fwd1 t_fwd2, tFwdDual: tdiff t_fwdDual1 t_fwdDual2, tFwdAsDemorgan: tdiff t_fwdAsDeMorgan1 t_fwdAsDeMorgan2 }
+   pure
+      { tEval: tdiff t_eval1 t_eval2
+      , tBwd: tdiff t_bwd1 t_bwd2
+      , tBwdDual: tdiff t_bwdDual1 t_bwdDual2
+      , tBwdAll: tdiff t_bwdAll1 t_bwdAll2
+      , tFwd: tdiff t_fwd1 t_fwd2
+      , tFwdDual: tdiff t_fwdDual1 t_fwdDual2
+      , tFwdAsDemorgan: tdiff t_fwdAsDeMorgan1 t_fwdAsDeMorgan2
+      }
 
 type TestSpec =
    { file :: String

From e465c3a43240da4d3e0588d37be345647b031f52 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:29:04 +0200
Subject: [PATCH 18/57] =?UTF-8?q?=F0=9F=A7=A9=20[layout]?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SExpr.purs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/SExpr.purs b/src/SExpr.purs
index 496e1c5d7..f6864a791 100644
--- a/src/SExpr.purs
+++ b/src/SExpr.purs
@@ -429,12 +429,10 @@ orElseBwd _ _ = error absurd
 -- all synthesised branches, returning the original singleton branch for c, plus join of annotations on the
 -- empty lists used for bodies of synthesised branches.
 unlessFwd :: forall a. Ctr × Cont a -> a -> Dict (Cont a)
-unlessFwd (c × κ) α =
-   let
-      defaultBranch c' = c' × applyN (ContElim <<< ElimVar varAnon) (successful (arity c')) (ContExpr (enil α))
-      cκs = defaultBranch <$> ((ctrs (successful (dataTypeFor c)) # S.toUnfoldable) \\ L.singleton c)
-   in
-      D.fromFoldable ((c × κ) : cκs)
+unlessFwd (c × κ) α = D.fromFoldable ((c × κ) : cκs)
+   where
+   defaultBranch c' = c' × applyN (ContElim <<< ElimVar varAnon) (successful (arity c')) (ContExpr (enil α))
+   cκs = defaultBranch <$> ((ctrs (successful (dataTypeFor c)) # S.toUnfoldable) \\ L.singleton c)
 
 unlessBwd :: forall a. BoundedJoinSemilattice a => Dict (Cont a) -> Ctr -> Cont a × a
 unlessBwd m c =

From a8f115f843c329ce926d78233584ef324b1820c8 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 08:32:44 +0200
Subject: [PATCH 19/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20More=20pu?=
 =?UTF-8?q?rging=20of=20'successful'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index ae31767fa..b71ca9732 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -38,7 +38,7 @@ import Primitive (matrixRep) as P
 import SExpr (Expr(..), Module(..), RecDefs, VarDefs) as S
 import SExpr (desugarModuleFwd)
 import Trace (Trace)
-import Util (MayFail, type (×), type (+), (×), absurd, error, orElse, successful)
+import Util (type (×), type (+), (×), absurd, error, orElse)
 import Val (class Ann, Env, ProgCxt(..), Val(..), append_inv, (<+>))
 import Web.Event.EventTarget (eventListener)
 
@@ -133,16 +133,15 @@ type LinkResult =
 drawLinkFig :: LinkFig -> EditorView -> EditorView -> EditorView -> Selector Val + Selector Val -> Effect Unit
 drawLinkFig fig@{ spec: { x, divId }, γ0, γ, s1, s2, e1, e2, t1, t2, v1, v2, dataFile } ed1 ed2 ed3 δv = do
    log $ "Redrawing " <> divId
-   let
-      v1' × v2' × δv1 × δv2 × v0 = successful case δv of
-         Left δv1 -> do
-            let v1' = δv1 v1
-            { v', v0' } <- linkResult x γ0 γ e1 e2 t1 t2 v1'
-            pure $ v1' × v' × const v1' × identity × v0'
-         Right δv2 -> do
-            let v2' = δv2 v2
-            { v', v0' } <- linkResult x γ0 γ e2 e1 t2 t1 v2'
-            pure $ v' × v2' × identity × const v2' × v0'
+   v1' × v2' × δv1 × δv2 × v0 <- case δv of
+      Left δv1 -> do
+         let v1' = δv1 v1
+         { v', v0' } <- linkResult x γ0 γ e1 e2 t1 t2 v1'
+         pure $ v1' × v' × const v1' × identity × v0'
+      Right δv2 -> do
+         let v2' = δv2 v2
+         { v', v0' } <- linkResult x γ0 γ e2 e1 t2 t1 v2'
+         pure $ v' × v2' × identity × const v2' × v0'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Left $ δv1 >>> selector)) 2 $ view "left view" v1'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Right $ δv2 >>> selector)) 0 $ view "right view" v2'
    drawView divId doNothing 1 $ view "common data" v0
@@ -158,20 +157,20 @@ drawCode ed s = do
 drawFig :: Fig -> EditorView -> Selector Val -> Effect Unit
 drawFig fig@{ spec: { divId }, s0 } ed δv = do
    log $ "Redrawing " <> divId
-   let v_view × views = successful $ figViews fig δv
+   v_view × views <- figViews fig δv
    sequence_ $
       uncurry (drawView divId doNothing) <$> zip (range 0 (length views - 1)) views
    drawView divId (\selector -> drawFig fig ed (δv >>> selector)) (length views) v_view
    drawCode ed $ prettyP s0
 
-varView :: Var -> Env 𝔹 -> MayFail View
+varView :: forall m. MonadError Error m => Var -> Env 𝔹 -> m View
 varView x γ = view x <$> (lookup x γ # orElse absurd)
 
-valViews :: Env 𝔹 -> Array Var -> MayFail (Array View)
+valViews :: forall m. MonadError Error m => Env 𝔹 -> Array Var -> m (Array View)
 valViews γ xs = sequence (flip varView γ <$> xs)
 
 -- For an output selection, views of corresponding input selections and output after round-trip.
-figViews :: Fig -> Selector Val -> MayFail (View × Array View)
+figViews :: forall m. MonadError Error m => Fig -> Selector Val -> m (View × Array View)
 figViews { spec: { xs }, γ0, γ, e, t, v } δv = do
    let
       γ0γ × e' × α = evalBwd (erase <$> (γ0 <+> γ)) (erase e) (δv v) t

From 92a34014f34ef35250c98e59a4321a55a39c210a Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 09:00:27 +0200
Subject: [PATCH 20/57] =?UTF-8?q?=E2=9D=97=20[incomplete]:=20Apply=20boile?=
 =?UTF-8?q?rplate=20for=20Module,=20ProgCxt.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs |  4 ++--
 src/Expr.purs      | 14 +++++++++++++-
 src/Val.purs       |  9 +++++++--
 3 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index b39ec3913..73396e827 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -188,14 +188,14 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, progCxt: ProgCxt { γ } } e = do
+graphGC { g, n, progCxt: progCxt@(ProgCxt { γ }) } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
          vα <- eval γ eα S.empty
          pure (eα × vα)
    let
-      dom = vertices eα `union` foldMap vertices γ
+      dom = vertices progCxt `union` foldMap vertices γ
       fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
diff --git a/src/Expr.purs b/src/Expr.purs
index 4b487c878..b41a5c18d 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -7,6 +7,7 @@ import Control.Apply (lift2)
 import Data.Either (Either(..))
 import Data.Foldable (class Foldable)
 import Data.List (List(..), (:), zipWith)
+import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set, difference, empty, singleton, union, unions)
 import Data.Set (fromFoldable) as S
 import Data.Traversable (class Traversable, traverse)
@@ -59,7 +60,7 @@ asExpr :: forall a. Cont a -> Expr a
 asExpr (ContExpr e) = e
 asExpr _ = error "Expression expected"
 
-data Module a = Module (List (VarDef a + RecDefs a))
+newtype Module a = Module (List (VarDef a + RecDefs a))
 
 class FV a where
    fv :: a -> Set Var
@@ -128,6 +129,7 @@ derive instance Traversable Elim
 derive instance Functor Expr
 derive instance Foldable Expr
 derive instance Traversable Expr
+derive instance Newtype (Module a) _
 derive instance Functor Module
 
 derive instance Eq a => Eq (Expr a)
@@ -135,6 +137,7 @@ derive instance Eq a => Eq (VarDef a)
 derive instance Eq a => Eq (Elim a)
 derive instance Eq a => Eq (Cont a)
 
+-- For terms of a fixed shape.
 instance Apply Expr where
    apply (Var x) (Var x') = Var (x ≜ x')
    apply (Op op) (Op _) = Op op
@@ -165,6 +168,15 @@ instance Apply Cont where
    apply (ContElim fσ) (ContElim σ) = ContElim (fσ <*> σ)
    apply _ _ = error "Apply Cont: shape mismatch"
 
+-- Apply instance of Either inappropriate here as doesn't assume fixed shape.
+instance Apply Module where
+   apply (Module Nil) (Module Nil) = Module Nil
+   apply (Module (Left fdef : fdefs)) (Module (Left def : defs)) =
+      Module (?_ : unwrap (apply (Module fdefs) (Module defs)))
+   apply (Module (Right fdef : fdefs)) (Module (Right def : defs)) =
+      Module (?_ : unwrap (apply (Module fdefs) (Module defs)))
+   apply _ _ = error "Apply Module: shape mismatch"
+
 -- Can we make this 'traverse' by relaxing m to Applicative?
 traverseModule :: forall m a b. Monad m => (a -> m b) -> Module a -> m (Module b)
 traverseModule _ (Module Nil) = pure (Module Nil)
diff --git a/src/Val.purs b/src/Val.purs
index a300c88ee..f4ed18ee9 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -5,7 +5,7 @@ import Prelude hiding (absurd, append)
 import Bindings (Var)
 import Control.Apply (lift2)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow)
-import Data.Array ((!!))
+import Data.Array (foldMap, (!!))
 import Data.Array (zipWith) as A
 import Data.Bitraversable (bitraverse)
 import Data.Exists (Exists)
@@ -21,7 +21,7 @@ import Effect.Exception (Error)
 import Expr (Elim, Module, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
-import Graph (Vertex(..))
+import Graph (class Vertices, Vertex(..), vertices)
 import Graph.GraphWriter (class MonadGraphAlloc)
 import Lattice (class BoundedJoinSemilattice, class BoundedLattice, class Expandable, class JoinSemilattice, class Neg, Raw, definedJoin, expand, maybeJoin, neg, (∨))
 import Util (type (×), Endo, error, orElse, throw, unsafeUpdateAt, (!), (×), (≜), (≞))
@@ -145,6 +145,7 @@ instance Highlightable Vertex where
 derive instance Functor DictRep
 derive instance Functor MatrixRep
 derive instance Functor Val
+derive instance Functor ProgCxt
 derive instance Foldable Val
 derive instance Traversable Val
 derive instance Functor Fun
@@ -176,6 +177,10 @@ instance Apply MatrixRep where
    apply (MatrixRep (fvss × (n × fnα) × (m × fmα))) (MatrixRep (vss × (n' × nα) × (m' × mα))) =
       MatrixRep $ (A.zipWith (A.zipWith (<*>)) fvss vss) × ((n ≜ n') × fnα nα) × ((m ≜ m') × fmα mα)
 
+instance Apply ProgCxt where
+   apply (ProgCxt { mods: fmods, γ: fγ }) (ProgCxt { mods, γ }) =
+      ProgCxt $ { mods: zipWith (<*>) fmods mods, γ: D.apply2 fγ γ }
+
 instance Foldable DictRep where
    foldl f acc (DictRep d) = foldl (\acc' (a × v) -> foldl f (acc' `f` a) v) acc d
    foldr f = foldrDefault f

From 738bfd758f415fafbd7f167fa537b3db2b1662a5 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 09:24:38 +0200
Subject: [PATCH 21/57] =?UTF-8?q?=E2=9D=97=20[modify]:=20Foldable=20boiler?=
 =?UTF-8?q?plate=20for=20Module;=20roll=20out=20vertices=20for=20ProgCxt?=
 =?UTF-8?q?=20in=20graphGC=20(annoyingly=20doesn't=20seem=20to=20affect=20?=
 =?UTF-8?q?'unbound'=20vertices).?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs |  4 ++--
 src/Expr.purs      | 17 ++++++++++++++---
 src/Val.purs       | 12 +++++++++---
 3 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 73396e827..2156b51bb 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -15,7 +15,7 @@ import Control.Monad.Error.Class (class MonadError)
 import Data.Array (range, singleton) as A
 import Data.Either (Either(..))
 import Data.Exists (runExists)
-import Data.List (List(..), foldMap, length, snoc, unzip, zip, (:))
+import Data.List (List(..), length, snoc, unzip, zip, (:))
 import Data.Set (Set, empty, insert, intersection, singleton, union)
 import Data.Set as S
 import Data.Traversable (sequence, traverse)
@@ -195,7 +195,7 @@ graphGC { g, n, progCxt: progCxt@(ProgCxt { γ }) } e = do
          vα <- eval γ eα S.empty
          pure (eα × vα)
    let
-      dom = vertices progCxt `union` foldMap vertices γ
+      dom = vertices progCxt `union` vertices eα
       fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
diff --git a/src/Expr.purs b/src/Expr.purs
index b41a5c18d..a83cfa223 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -5,7 +5,7 @@ import Prelude hiding (absurd, top)
 import Bindings (Var)
 import Control.Apply (lift2)
 import Data.Either (Either(..))
-import Data.Foldable (class Foldable)
+import Data.Foldable (class Foldable, foldl, foldrDefault, foldMapDefaultL)
 import Data.List (List(..), (:), zipWith)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set, difference, empty, singleton, union, unions)
@@ -168,15 +168,26 @@ instance Apply Cont where
    apply (ContElim fσ) (ContElim σ) = ContElim (fσ <*> σ)
    apply _ _ = error "Apply Cont: shape mismatch"
 
+instance Apply VarDef where
+   apply (VarDef fσ fe) (VarDef σ e) = VarDef (fσ <*> σ) (fe <*> e)
+
 -- Apply instance of Either inappropriate here as doesn't assume fixed shape.
 instance Apply Module where
    apply (Module Nil) (Module Nil) = Module Nil
    apply (Module (Left fdef : fdefs)) (Module (Left def : defs)) =
-      Module (?_ : unwrap (apply (Module fdefs) (Module defs)))
+      Module (Left (fdef <*> def) : unwrap (apply (Module fdefs) (Module defs)))
    apply (Module (Right fdef : fdefs)) (Module (Right def : defs)) =
-      Module (?_ : unwrap (apply (Module fdefs) (Module defs)))
+      Module (Right (D.apply2 fdef def) : unwrap (apply (Module fdefs) (Module defs)))
    apply _ _ = error "Apply Module: shape mismatch"
 
+instance Foldable Module where
+   foldl _ acc (Module Nil) = acc
+   foldl f acc (Module (Left def : defs)) = foldl (foldl (foldl (foldl f))) (foldl f acc def) defs
+   foldl f acc (Module (Right def : defs)) = foldl (foldl (foldl (foldl f))) (foldl (foldl f) acc def) defs
+
+   foldr f = foldrDefault f
+   foldMap f = foldMapDefaultL f
+
 -- Can we make this 'traverse' by relaxing m to Applicative?
 traverseModule :: forall m a b. Monad m => (a -> m b) -> Module a -> m (Module b)
 traverseModule _ (Module Nil) = pure (Module Nil)
diff --git a/src/Val.purs b/src/Val.purs
index f4ed18ee9..316af6a62 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -5,7 +5,7 @@ import Prelude hiding (absurd, append)
 import Bindings (Var)
 import Control.Apply (lift2)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow)
-import Data.Array (foldMap, (!!))
+import Data.Array ((!!))
 import Data.Array (zipWith) as A
 import Data.Bitraversable (bitraverse)
 import Data.Exists (Exists)
@@ -21,7 +21,7 @@ import Effect.Exception (Error)
 import Expr (Elim, Module, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
-import Graph (class Vertices, Vertex(..), vertices)
+import Graph (Vertex(..))
 import Graph.GraphWriter (class MonadGraphAlloc)
 import Lattice (class BoundedJoinSemilattice, class BoundedLattice, class Expandable, class JoinSemilattice, class Neg, Raw, definedJoin, expand, maybeJoin, neg, (∨))
 import Util (type (×), Endo, error, orElse, throw, unsafeUpdateAt, (!), (×), (≜), (≞))
@@ -171,6 +171,7 @@ instance Apply Fun where
 
 instance Apply DictRep where
    apply (DictRep fxvs) (DictRep xvs) =
+      -- Restrict to equal domains?
       DictRep $ D.intersectionWith (\(fα × fv) (α × v) -> fα α × (fv <*> v)) fxvs xvs
 
 instance Apply MatrixRep where
@@ -179,7 +180,7 @@ instance Apply MatrixRep where
 
 instance Apply ProgCxt where
    apply (ProgCxt { mods: fmods, γ: fγ }) (ProgCxt { mods, γ }) =
-      ProgCxt $ { mods: zipWith (<*>) fmods mods, γ: D.apply2 fγ γ }
+      ProgCxt $ { mods: fmods `zipWith (<*>)` mods, γ: D.apply2 fγ γ }
 
 instance Foldable DictRep where
    foldl f acc (DictRep d) = foldl (\acc' (a × v) -> foldl f (acc' `f` a) v) acc d
@@ -202,6 +203,11 @@ instance Traversable MatrixRep where
          m
    sequence = sequenceDefault
 
+instance Foldable ProgCxt where
+   foldl f acc (ProgCxt { mods, γ }) = foldl (foldl f) (foldl (foldl f) acc γ) mods
+   foldr f = foldrDefault f
+   foldMap f = foldMapDefaultL f
+
 instance JoinSemilattice a => JoinSemilattice (DictRep a) where
    maybeJoin (DictRep svs) (DictRep svs') = DictRep <$> maybeJoin svs svs'
    join v = definedJoin v

From ca0d4f53194dd3cabc3e439beb959976c2e186b1 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 09:45:47 +0200
Subject: [PATCH 22/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20More=20ef?=
 =?UTF-8?q?ficient=20implementation=20of=20generic=20'vertices'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 spago.dhall    | 1 -
 src/Expr.purs  | 2 +-
 src/Graph.purs | 6 +++---
 src/Val.purs   | 4 ++--
 4 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/spago.dhall b/spago.dhall
index 650afd297..b9582b6fa 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -22,7 +22,6 @@ You can edit this file as you like.
   , "http-methods"
   , "identity"
   , "integers"
-  , "js-date"
   , "lists"
   , "maybe"
   , "newtype"
diff --git a/src/Expr.purs b/src/Expr.purs
index a83cfa223..ac7c5a2df 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -171,7 +171,7 @@ instance Apply Cont where
 instance Apply VarDef where
    apply (VarDef fσ fe) (VarDef σ e) = VarDef (fσ <*> σ) (fe <*> e)
 
--- Apply instance of Either inappropriate here as doesn't assume fixed shape.
+-- Apply instance for Either no good here as doesn't assume fixed shape.
 instance Apply Module where
    apply (Module Nil) (Module Nil) = Module Nil
    apply (Module (Left fdef : fdefs)) (Module (Left def : defs)) =
diff --git a/src/Graph.purs b/src/Graph.purs
index 778fd4342..eb5903624 100644
--- a/src/Graph.purs
+++ b/src/Graph.purs
@@ -12,7 +12,7 @@ import Util (Endo, (×), type (×))
 
 type Edge = Vertex × Vertex
 
--- | "Static" graphs, optimised for lookup and building from (key, value) pairs.
+-- | Immutable graphs, optimised for lookup and building from (key, value) pairs.
 class (Vertices g, Semigroup g) <= Graph g where
    -- | Whether g contains a given vertex.
    elem :: Vertex -> g -> Boolean
@@ -27,7 +27,7 @@ class (Vertices g, Semigroup g) <= Graph g where
    sources :: g -> Set Vertex
    sinks :: g -> Set Vertex
 
-   -- |   op (op g) = g
+   -- | op (op g) = g
    op :: Endo g
 
    empty :: g
@@ -39,7 +39,7 @@ class Vertices a where
    vertices :: a -> Set Vertex
 
 instance (Apply f, Foldable f) => Vertices (f Vertex) where
-   vertices vα = selectαs (const true <$> vα) vα
+   vertices vα = unions (singleton <$> vα)
 
 selectαs :: forall f. Apply f => Foldable f => f Boolean -> f Vertex -> Set Vertex
 selectαs v𝔹 vα = unions ((if _ then singleton else const S.empty) <$> v𝔹 <*> vα)
diff --git a/src/Val.purs b/src/Val.purs
index 316af6a62..0e0f1dc67 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -169,9 +169,9 @@ instance Apply Fun where
    apply (PartialConstr c fvs) (PartialConstr c' vs) = PartialConstr (c ≜ c') (zipWith (<*>) fvs vs)
    apply _ _ = error "Apply Fun: shape mismatch"
 
+-- Should require equal domains?
 instance Apply DictRep where
    apply (DictRep fxvs) (DictRep xvs) =
-      -- Restrict to equal domains?
       DictRep $ D.intersectionWith (\(fα × fv) (α × v) -> fα α × (fv <*> v)) fxvs xvs
 
 instance Apply MatrixRep where
@@ -180,7 +180,7 @@ instance Apply MatrixRep where
 
 instance Apply ProgCxt where
    apply (ProgCxt { mods: fmods, γ: fγ }) (ProgCxt { mods, γ }) =
-      ProgCxt $ { mods: fmods `zipWith (<*>)` mods, γ: D.apply2 fγ γ }
+      ProgCxt { mods: fmods `zipWith (<*>)` mods, γ: D.apply2 fγ γ }
 
 instance Foldable DictRep where
    foldl f acc (DictRep d) = foldl (\acc' (a × v) -> foldl f (acc' `f` a) v) acc d

From f54b8e1eb3f4d4b02c2d39248b468408e7b43c8f Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 09:51:46 +0200
Subject: [PATCH 23/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20..which?=
 =?UTF-8?q?=20only=20needs=20Foldable,=20not=20Apply.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Expr.purs  | 6 ++++--
 src/Graph.purs | 2 +-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Expr.purs b/src/Expr.purs
index ac7c5a2df..544ae97f8 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -182,8 +182,10 @@ instance Apply Module where
 
 instance Foldable Module where
    foldl _ acc (Module Nil) = acc
-   foldl f acc (Module (Left def : defs)) = foldl (foldl (foldl (foldl f))) (foldl f acc def) defs
-   foldl f acc (Module (Right def : defs)) = foldl (foldl (foldl (foldl f))) (foldl (foldl f) acc def) defs
+   foldl f acc (Module (Left def : defs)) =
+      foldl (foldl (foldl (foldl f))) (foldl f acc def) defs
+   foldl f acc (Module (Right def : defs)) =
+      foldl (foldl (foldl (foldl f))) (foldl (foldl f) acc def) defs
 
    foldr f = foldrDefault f
    foldMap f = foldMapDefaultL f
diff --git a/src/Graph.purs b/src/Graph.purs
index eb5903624..2a66fce91 100644
--- a/src/Graph.purs
+++ b/src/Graph.purs
@@ -38,7 +38,7 @@ newtype Vertex = Vertex String
 class Vertices a where
    vertices :: a -> Set Vertex
 
-instance (Apply f, Foldable f) => Vertices (f Vertex) where
+instance (Functor f, Foldable f) => Vertices (f Vertex) where
    vertices vα = unions (singleton <$> vα)
 
 selectαs :: forall f. Apply f => Foldable f => f Boolean -> f Vertex -> Set Vertex

From 10b46cde809c9ac655a71fc1fe8e48783162741f Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 12:34:12 +0200
Subject: [PATCH 24/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Explicitly?=
 =?UTF-8?q?=20track=20datasets.=20But=20that=20doesn't=20change=20'unbound?=
 =?UTF-8?q?=20sinks'=20either.=20Maybe=20my=20thinking=20is=20wrong=20here?=
 =?UTF-8?q?..?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs |  2 +-
 src/Module.purs  | 16 ++++++++--------
 src/Val.purs     | 18 +++++++++++++-----
 3 files changed, 22 insertions(+), 14 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index b71ca9732..6b2ac01bf 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -210,7 +210,7 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
    let
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
-   -- views share an ambient environment γ0 as well as dataset
+   -- views share ambient environment γ as well as dataset
    { progCxt: ProgCxt { γ } } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
    s1' × s2' <- (×) <$> open name1 <*> open name2
diff --git a/src/Module.purs b/src/Module.purs
index 27ea5e37a..ed9555bcf 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -59,16 +59,16 @@ open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")
 
 loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
-loadModule file (ProgCxt { mods, γ }) = do
+loadModule file (ProgCxt r@{ mods, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverseModule (const fresh)
    γ' <- eval_module γ mod empty
-   pure $ ProgCxt { mods: mod : mods, γ: γ <+> γ' }
+   pure $ ProgCxt 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, γ })
+   loadModule (File "prelude") (ProgCxt { mods: Nil, datasets: Nil, γ })
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
@@ -79,11 +79,11 @@ openDefaultImports = do
 
 -- | Evaluate dataset in context of existing graph config
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
-openDatasetAs file x { g, n, progCxt: progCxt@(ProgCxt { γ }) } = do
+openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
    s <- parseProgram (Folder "fluid") file
-   (g' × n') × xv <-
+   (g' × n') × xv × progCxt <-
       runWithGraphAllocT (g × n) do
-         e <- desug s
-         eα <- alloc e
-         D.singleton x <$> eval γ eα empty
+         eα <- desug s >>= alloc
+         v <- eval γ eα empty
+         pure $ D.singleton x v × ProgCxt (r{ datasets = eα : datasets })
    pure ({ g: g', n: n', progCxt } × xv)
diff --git a/src/Val.purs b/src/Val.purs
index 0e0f1dc67..264b192e3 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -18,7 +18,7 @@ import DataType (Ctr)
 import Dict (Dict, get)
 import Dict (apply2, intersectionWith) as D
 import Effect.Exception (Error)
-import Expr (Elim, Module, RecDefs, fv)
+import Expr (Elim, Expr, Module, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
 import Graph (Vertex(..))
@@ -72,8 +72,12 @@ type Env a = Dict (Val a)
 lookup' :: forall a m. MonadThrow Error m => Var -> Dict a -> m a
 lookup' x γ = lookup x γ # orElse ("variable " <> x <> " not found")
 
--- Bunch of loaded modules.
-newtype ProgCxt a = ProgCxt { mods :: List (Module a), γ :: Env a }
+-- Bunch of loaded modules and datasets, reflecting current somewhat ad hoc approach.
+newtype ProgCxt a = ProgCxt
+   { mods :: List (Module a)
+   , datasets :: List (Expr a)
+   , γ :: Env a
+   }
 
 derive instance Newtype (ProgCxt a) _
 
@@ -179,8 +183,12 @@ instance Apply MatrixRep where
       MatrixRep $ (A.zipWith (A.zipWith (<*>)) fvss vss) × ((n ≜ n') × fnα nα) × ((m ≜ m') × fmα mα)
 
 instance Apply ProgCxt where
-   apply (ProgCxt { mods: fmods, γ: fγ }) (ProgCxt { mods, γ }) =
-      ProgCxt { mods: fmods `zipWith (<*>)` mods, γ: D.apply2 fγ γ }
+   apply (ProgCxt { mods: fmods, datasets: fdatasets, γ: fγ }) (ProgCxt { mods, datasets, γ }) =
+      ProgCxt
+         { mods: fmods `zipWith (<*>)` mods
+         , datasets: fdatasets `zipWith (<*>)` datasets
+         , γ: D.apply2 fγ γ
+         }
 
 instance Foldable DictRep where
    foldl f acc (DictRep d) = foldl (\acc' (a × v) -> foldl f (acc' `f` a) v) acc d

From 81088b542578f746e5f0aca8cc97ab4340268205 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 13:00:54 +0200
Subject: [PATCH 25/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20traverseM?=
 =?UTF-8?q?odule=20doesn't=20need=20Monad.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Expr.purs | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/src/Expr.purs b/src/Expr.purs
index 544ae97f8..29e8e24ac 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -190,17 +190,12 @@ instance Foldable Module where
    foldr f = foldrDefault f
    foldMap f = foldMapDefaultL f
 
--- Can we make this 'traverse' by relaxing m to Applicative?
-traverseModule :: forall m a b. Monad m => (a -> m b) -> Module a -> m (Module b)
+traverseModule :: forall m a b. Applicative m => (a -> m b) -> Module a -> m (Module b)
 traverseModule _ (Module Nil) = pure (Module Nil)
-traverseModule f (Module (Left (VarDef σ e) : ds)) = do
-   d <- traverse f (VarDef σ e)
-   Module ds' <- traverseModule f (Module ds)
-   pure (Module (Left d : ds'))
-traverseModule f (Module (Right ρ : ds)) = do
-   ρ' <- traverse (traverse f) ρ
-   Module ds' <- traverseModule f (Module ds)
-   pure (Module (Right ρ' : ds'))
+traverseModule f (Module (Left def : ds)) =
+   Module <$> ((Left <$> traverse f def) `lift2 (:)` (unwrap <$> traverseModule f (Module ds)))
+traverseModule f (Module (Right ρ : ds)) =
+   Module <$> ((Right <$> traverse (traverse f) ρ) `lift2 (:)` (unwrap <$> traverseModule f (Module ds)))
 
 instance JoinSemilattice a => JoinSemilattice (Elim a) where
    maybeJoin (ElimVar x κ) (ElimVar x' κ') = ElimVar <$> (x ≞ x') <*> maybeJoin κ κ'

From 0ddc7e07eb6594a2d106bade4507b0a1af08cff3 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 13:03:04 +0200
Subject: [PATCH 26/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20traverseM?=
 =?UTF-8?q?odule=20is=20just=20traverse.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Expr.purs   | 16 +++++++++-------
 src/Module.purs |  3 +--
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/Expr.purs b/src/Expr.purs
index 29e8e24ac..8269e569b 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -10,7 +10,7 @@ import Data.List (List(..), (:), zipWith)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set, difference, empty, singleton, union, unions)
 import Data.Set (fromFoldable) as S
-import Data.Traversable (class Traversable, traverse)
+import Data.Traversable (class Traversable, sequenceDefault, traverse)
 import Data.Tuple (snd)
 import DataType (Ctr, consistentWith)
 import Dict (Dict, keys, asSingletonMap)
@@ -190,12 +190,14 @@ instance Foldable Module where
    foldr f = foldrDefault f
    foldMap f = foldMapDefaultL f
 
-traverseModule :: forall m a b. Applicative m => (a -> m b) -> Module a -> m (Module b)
-traverseModule _ (Module Nil) = pure (Module Nil)
-traverseModule f (Module (Left def : ds)) =
-   Module <$> ((Left <$> traverse f def) `lift2 (:)` (unwrap <$> traverseModule f (Module ds)))
-traverseModule f (Module (Right ρ : ds)) =
-   Module <$> ((Right <$> traverse (traverse f) ρ) `lift2 (:)` (unwrap <$> traverseModule f (Module ds)))
+instance Traversable Module where
+   traverse _ (Module Nil) = pure (Module Nil)
+   traverse f (Module (Left def : ds)) =
+      Module <$> ((Left <$> traverse f def) `lift2 (:)` (unwrap <$> traverse f (Module ds)))
+   traverse f (Module (Right ρ : ds)) =
+      Module <$> ((Right <$> traverse (traverse f) ρ) `lift2 (:)` (unwrap <$> traverse f (Module ds)))
+
+   sequence = sequenceDefault
 
 instance JoinSemilattice a => JoinSemilattice (Elim a) where
    maybeJoin (ElimVar x κ) (ElimVar x' κ') = ElimVar <$> (x ≞ x') <*> maybeJoin κ κ'
diff --git a/src/Module.purs b/src/Module.purs
index ed9555bcf..0bfb046e0 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -18,7 +18,6 @@ import Dict (singleton) as D
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error, error)
 import EvalGraph (GraphConfig, eval, eval_module)
-import Expr (traverseModule)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
 import Graph.GraphWriter (class MonadGraphAlloc, alloc, fresh, runWithGraphAllocT)
@@ -61,7 +60,7 @@ open = parseProgram (Folder "fluid/example")
 loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
 loadModule file (ProgCxt r@{ mods, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
-   mod <- parse src module_ >>= desugarModuleFwd >>= traverseModule (const fresh)
+   mod <- parse src module_ >>= desugarModuleFwd >>= traverse (const fresh)
    γ' <- eval_module γ mod empty
    pure $ ProgCxt r{ mods = mod : mods, γ = γ <+> γ' }
 

From 34ec3e3e51e95e1de41344e309b1d4922bd75f06 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 13:10:19 +0200
Subject: [PATCH 27/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Comment=20ve?=
 =?UTF-8?q?rtex=20query=20for=20the=20time=20being.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 2156b51bb..57f28fb7d 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -21,7 +21,6 @@ import Data.Set as S
 import Data.Traversable (sequence, traverse)
 import Data.Tuple (fst)
 import DataType (checkArity, arity, consistentWith, dataTypeFor, showCtr)
-import Debug (trace)
 import Dict (disjointUnion, fromFoldable, empty, get, keys, lookup, singleton) as D
 import Effect.Exception (Error)
 import Expr (Cont(..), Elim(..), Expr(..), VarDef(..), RecDefs, Module(..), fv, asExpr)
@@ -188,15 +187,15 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, progCxt: progCxt@(ProgCxt { γ }) } e = do
+graphGC { g, n, progCxt: ProgCxt { γ } } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
          vα <- eval γ eα S.empty
          pure (eα × vα)
    let
-      dom = vertices progCxt `union` vertices eα
+--      dom = vertices progCxt `union` vertices eα
       fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
-   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
-      pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }
+--   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
+   pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }

From 930fa35ee83ac2a6968ce12c44b7397b8b35457c Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 13:49:36 +0200
Subject: [PATCH 28/57] =?UTF-8?q?=F0=9F=A7=A9=20[add-unused]:=20Start=20on?=
 =?UTF-8?q?=20eval=5Fprog.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs |  4 ++--
 src/Module.purs    | 11 ++++++++---
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 57f28fb7d..c577dcb75 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -194,8 +194,8 @@ graphGC { g, n, progCxt: ProgCxt { γ } } e = do
          vα <- eval γ eα S.empty
          pure (eα × vα)
    let
---      dom = vertices progCxt `union` vertices eα
+      --      dom = vertices progCxt `union` vertices eα
       fwd αs = vertices (fwdSlice αs g') `intersection` vertices vα
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
---   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
+   --   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
    pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }
diff --git a/src/Module.purs b/src/Module.purs
index 0bfb046e0..cc404aefa 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(..), (:))
+import Data.List (List(..), foldl, (:))
 import Data.Newtype (class Newtype)
 import Data.Set (empty)
 import Data.Traversable (traverse)
@@ -62,7 +62,7 @@ loadModule file (ProgCxt r@{ mods, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverse (const fresh)
    γ' <- eval_module γ mod empty
-   pure $ ProgCxt r{ mods = mod : mods, γ = γ <+> γ' }
+   pure $ ProgCxt r { mods = mod : mods, γ = γ <+> γ' }
 
 defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt Vertex)
 defaultImports = do
@@ -84,5 +84,10 @@ openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
       runWithGraphAllocT (g × n) do
          eα <- desug s >>= alloc
          v <- eval γ eα empty
-         pure $ D.singleton x v × ProgCxt (r{ datasets = eα : datasets })
+         pure $ D.singleton x v × ProgCxt (r { datasets = eα : datasets })
    pure ({ g: g', n: n', progCxt } × xv)
+
+eval_progCxt :: forall m. MonadGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
+eval_progCxt (ProgCxt { mods }) =
+   traverse alloc primitives
+      >>= foldl (>=>) pure (mods <#> \mod γ' -> eval_module γ' mod empty)

From 53fcaf2e94698887b2023b2ede6100b8bbc3f9c4 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:04:08 +0200
Subject: [PATCH 29/57] =?UTF-8?q?=F0=9F=A7=A9=20[add-unused]:=20Start=20on?=
 =?UTF-8?q?=20version=20of=20loadModule=20etc=20that=20don't=20allocate=20?=
 =?UTF-8?q?or=20evaluate.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs | 19 +++++++++++++++----
 src/Val.purs    |  5 +++++
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index cc404aefa..6ffbb49b0 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -28,7 +28,7 @@ import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
 import Util (type (×), mapLeft, (×))
 import Util.Parse (SParser)
-import Val (Env, ProgCxt(..), (<+>))
+import Val (Env, ProgCxt(..), ProgCxt2(..), (<+>))
 
 -- Mainly serve as documentation
 newtype File = File String
@@ -64,6 +64,12 @@ 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
@@ -71,12 +77,17 @@ defaultImports = do
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
+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")
+
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
    (g × n) × progCxt <- runWithGraphAllocT (G.empty × 0) defaultImports
    pure { g, n, progCxt }
 
--- | Evaluate dataset in context of existing graph config
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
 openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
    s <- parseProgram (Folder "fluid") file
@@ -87,7 +98,7 @@ openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
          pure $ D.singleton x v × ProgCxt (r { datasets = eα : datasets })
    pure ({ g: g', n: n', progCxt } × xv)
 
-eval_progCxt :: forall m. MonadGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
-eval_progCxt (ProgCxt { mods }) =
+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)
diff --git a/src/Val.purs b/src/Val.purs
index 264b192e3..726db1266 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -79,6 +79,11 @@ newtype ProgCxt a = ProgCxt
    , γ :: Env a
    }
 
+newtype ProgCxt2 a = ProgCxt2
+   { mods :: List (Module a)
+   , datasets :: List (Expr a)
+   }
+
 derive instance Newtype (ProgCxt a) _
 
 -- Want a monoid instance but needs a newtype

From 28ac3e538caeaf776cce54e7fff26e072982e395 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:20:51 +0200
Subject: [PATCH 30/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20concatM?=
 =?UTF-8?q?=20helper.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs | 23 ++++++++++++++---------
 src/Util.purs   |  5 +++++
 test/Many.purs  | 12 ++++++------
 3 files changed, 25 insertions(+), 15 deletions(-)

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
 

From b7e7852ffb414443e33e65d4fa976900aaf0a39f Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:25:24 +0200
Subject: [PATCH 31/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20e=20->=20s.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/test/Many.purs b/test/Many.purs
index 82d7c2d88..50a34669c 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -13,36 +13,36 @@ import Util (type (×), (×))
 import Val (ProgCxt(..), (<+>))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
-many specs iter = zip (specs <#> _.file) (specs <#> one)
+many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
       gconfig <- openDefaultImports
-      e <- open (File file)
-      rows <- replicateM iter $
-         testWithSetup file e gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
+      s <- open (File file)
+      rows <- replicateM n $
+         testWithSetup file s gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
       pure $ averageRows rows
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
-bwdMany specs iter = zip (specs <#> _.file) (specs <#> bwdOne)
+bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
    where
    folder = File "slicing/"
    bwdOne { file, file_expect, δv, fwd_expect } = do
       gconfig <- openDefaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
-      e <- open (folder <> File file)
-      rows <- replicateM iter $
-         testWithSetup file e gconfig { δv, fwd_expect, bwd_expect }
+      s <- open (folder <> File file)
+      rows <- replicateM n $
+         testWithSetup file s gconfig { δv, fwd_expect, bwd_expect }
       pure $ averageRows rows
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
-withDatasetMany specs iter = zip (specs <#> _.file) (specs <#> withDatasetOne)
+withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
    where
    withDatasetOne { dataset, file } = do
       -- TODO: make progCxt consistent with addition of xv
       gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      e <- open (File file)
-      rows <- replicateM iter $
-         testWithSetup file e gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
+      s <- open (File file)
+      rows <- replicateM n $
+         testWithSetup file s gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
             { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
       pure $ averageRows rows
 

From 9b6891d7b5c2577183d1a94b2558059a998b621c Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:31:31 +0200
Subject: [PATCH 32/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20testParse=20->?=
 =?UTF-8?q?=20testPretty.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Util.purs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test/Util.purs b/test/Util.purs
index 55342373c..b47d5b9f0 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -49,14 +49,14 @@ testWithSetup ∷ String -> SE.Expr Unit → GraphConfig GraphImpl → TestConfi
 testWithSetup _name s gconfig tconfig =
    liftEither =<<
       ( runExceptT do
-           testParse s
+           testPretty s
            trRow <- testTrace s gconfig tconfig
            grRow <- testGraph s gconfig tconfig
            pure $ BenchRow trRow grRow
       )
 
-testParse :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
-testParse s = do
+testPretty :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
+testPretty s = do
    let src = prettyP s
    s' <- parse src program
    unless (eq (erase s) (erase s')) do

From 8cc054772fd120f01e3d1ab29dca27099d1b232d Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:37:41 +0200
Subject: [PATCH 33/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Push=20repli?=
 =?UTF-8?q?cateM=20and=20averageRows=20into=20testWithSetup.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 17 +++++------------
 test/Util.purs | 27 ++++++++++++++-------------
 2 files changed, 19 insertions(+), 25 deletions(-)

diff --git a/test/Many.purs b/test/Many.purs
index 50a34669c..763ece257 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -5,10 +5,9 @@ import Prelude
 import App.Fig (linkResult, loadLinkFig)
 import Benchmark.Util (BenchRow)
 import Data.Array (zip)
-import Data.List.Lazy (replicateM)
 import Effect.Aff (Aff)
 import Module (File(..), Folder(..), loadFile, open, openDatasetAs, openDefaultImports)
-import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, averageRows, checkPretty, testWithSetup)
+import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
 import Util (type (×), (×))
 import Val (ProgCxt(..), (<+>))
 
@@ -18,9 +17,7 @@ many specs n = zip (specs <#> _.file) (specs <#> one)
    one { file, fwd_expect } = do
       gconfig <- openDefaultImports
       s <- open (File file)
-      rows <- replicateM n $
-         testWithSetup file s gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
-      pure $ averageRows rows
+      testWithSetup n file s gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
 bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
@@ -30,9 +27,7 @@ bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
       gconfig <- openDefaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
       s <- open (folder <> File file)
-      rows <- replicateM n $
-         testWithSetup file s gconfig { δv, fwd_expect, bwd_expect }
-      pure $ averageRows rows
+      testWithSetup n file s gconfig { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
@@ -41,10 +36,8 @@ withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
       -- TODO: make progCxt consistent with addition of xv
       gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
       s <- open (File file)
-      rows <- replicateM n $
-         testWithSetup file s gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
-            { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
-      pure $ averageRows rows
+      testWithSetup n file s gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
+         { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
 linkMany specs = zip (specs <#> name) (specs <#> linkOne)
diff --git a/test/Util.purs b/test/Util.purs
index b47d5b9f0..a60534fc8 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -11,7 +11,7 @@ import Control.Monad.Trans.Class (lift)
 import Data.Foldable (foldl)
 import Data.Int (toNumber)
 import Data.List (elem)
-import Data.List.Lazy (List, length)
+import Data.List.Lazy (List, length, replicateM)
 import Data.Set (subset)
 import Data.String (null)
 import DataType (dataTypeFor, typeName)
@@ -21,10 +21,10 @@ import Effect.Class.Console (log)
 import Effect.Exception (Error)
 import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
+import GaloisConnection (GaloisConnection(..))
 import Graph (selectαs, select𝔹s, sinks, vertices)
 import Graph.GraphImpl (GraphImpl)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
-import GaloisConnection (GaloisConnection(..))
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
 import Module (parse)
@@ -37,23 +37,24 @@ import Val (class Ann, ProgCxt(..), Val(..))
 
 type TestConfig =
    { δv :: Selector Val
-   , fwd_expect :: String
+   , fwd_expect :: String -- prettyprinted value after bwd then fwd round-trip
    , bwd_expect :: String
    }
 
 logging :: Boolean
 logging = false
 
--- fwd_expect: prettyprinted value after bwd then fwd round-trip
-testWithSetup ∷ String -> SE.Expr Unit → GraphConfig GraphImpl → TestConfig → Aff BenchRow
-testWithSetup _name s gconfig tconfig =
-   liftEither =<<
-      ( runExceptT do
-           testPretty s
-           trRow <- testTrace s gconfig tconfig
-           grRow <- testGraph s gconfig tconfig
-           pure $ BenchRow trRow grRow
-      )
+testWithSetup ∷ Int -> String -> SE.Expr Unit → GraphConfig GraphImpl → TestConfig → Aff BenchRow
+testWithSetup n _ s gconfig tconfig =
+   liftEither =<< test
+   where
+   test = runExceptT do
+      testPretty s
+      rows <- replicateM n $ do
+         trRow <- testTrace s gconfig tconfig
+         grRow <- testGraph s gconfig tconfig
+         pure $ BenchRow trRow grRow
+      pure $ averageRows rows
 
 testPretty :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
 testPretty s = do

From 475ac5e2c0c61af7e4beeb3b7cd97f5da4fd7b2d Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:43:11 +0200
Subject: [PATCH 34/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Push=20'o?=
 =?UTF-8?q?pen=20file'=20into=20testWithSetup.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs          |  6 +++---
 test/Benchmark/Util.purs |  7 -------
 test/Many.purs           | 11 ++++-------
 test/Util.purs           |  7 ++++---
 4 files changed, 11 insertions(+), 20 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index 278fba354..19e000797 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -75,7 +75,7 @@ loadModule2 :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt2 Uni
 loadModule2 file (ProgCxt2 r@{ mods }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd
-   pure $ ProgCxt2 r{ mods = mod : mods }
+   pure $ ProgCxt2 r { mods = mod : mods }
 
 defaultImports2 :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt2 Unit)
 defaultImports2 =
@@ -83,10 +83,10 @@ defaultImports2 =
       >>= loadModule2 (File "graphics")
       >>= loadModule2 (File "convolution")
 
-loadDataset ::  forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
+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 }
+   pure $ ProgCxt2 r { datasets = dataset : datasets }
 
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
diff --git a/test/Benchmark/Util.purs b/test/Benchmark/Util.purs
index ba597b8b7..699a8d285 100644
--- a/test/Benchmark/Util.purs
+++ b/test/Benchmark/Util.purs
@@ -9,13 +9,6 @@ import Effect.Class (class MonadEffect, liftEffect)
 import Test.Spec.Microtime (microtime)
 import Util (type (×), (×))
 
-newtype File = File String
-newtype Folder = Folder String
-
-derive newtype instance Show File
-derive newtype instance Semigroup File
-derive newtype instance Monoid File
-
 data BenchRow = BenchRow TraceRow GraphRow
 
 newtype BenchAcc = BenchAcc (Array (String × BenchRow))
diff --git a/test/Many.purs b/test/Many.purs
index 763ece257..f9c9adea7 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -6,7 +6,7 @@ import App.Fig (linkResult, loadLinkFig)
 import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
-import Module (File(..), Folder(..), loadFile, open, openDatasetAs, openDefaultImports)
+import Module (File(..), Folder(..), loadFile, openDatasetAs, openDefaultImports)
 import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
 import Util (type (×), (×))
 import Val (ProgCxt(..), (<+>))
@@ -16,8 +16,7 @@ many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
       gconfig <- openDefaultImports
-      s <- open (File file)
-      testWithSetup n file s gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
+      testWithSetup n (File file) gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
 bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
@@ -26,8 +25,7 @@ bwdMany specs n = 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)
-      s <- open (folder <> File file)
-      testWithSetup n file s gconfig { δv, fwd_expect, bwd_expect }
+      testWithSetup n (folder <> File file) gconfig { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
@@ -35,8 +33,7 @@ withDatasetMany specs n = 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"
-      s <- open (File file)
-      testWithSetup n file s gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
+      testWithSetup n (File file) gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
          { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
diff --git a/test/Util.purs b/test/Util.purs
index a60534fc8..11bde10f4 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -27,7 +27,7 @@ import Graph.GraphImpl (GraphImpl)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
-import Module (parse)
+import Module (File, open, parse)
 import Parse (program)
 import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
@@ -44,11 +44,12 @@ type TestConfig =
 logging :: Boolean
 logging = false
 
-testWithSetup ∷ Int -> String -> SE.Expr Unit → GraphConfig GraphImpl → TestConfig → Aff BenchRow
-testWithSetup n _ s gconfig tconfig =
+testWithSetup ∷ Int -> File -> GraphConfig GraphImpl -> TestConfig -> Aff BenchRow
+testWithSetup n file gconfig tconfig = do
    liftEither =<< test
    where
    test = runExceptT do
+      s <- open file
       testPretty s
       rows <- replicateM n $ do
          trRow <- testTrace s gconfig tconfig

From af4ba64282abd7fa866f27b1ff287c0aea88312a Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 15:58:31 +0200
Subject: [PATCH 35/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20MonadGraph=20-?=
 =?UTF-8?q?>=20MonadWithGraph=20for=20consistency.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/EvalGraph.purs         | 14 +++++++-------
 src/Graph/GraphWriter.purs | 38 +++++++++++++++++++-------------------
 src/Module.purs            | 14 +++++++-------
 src/Val.purs               |  4 ++--
 4 files changed, 35 insertions(+), 35 deletions(-)

diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index c577dcb75..f36758657 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -26,7 +26,7 @@ import Effect.Exception (Error)
 import Expr (Cont(..), Elim(..), Expr(..), VarDef(..), RecDefs, Module(..), fv, asExpr)
 import GaloisConnection (GaloisConnection(..))
 import Graph (class Graph, Vertex, sinks, vertices)
-import Graph.GraphWriter (class MonadGraphAlloc, alloc, new, runWithGraphAllocT)
+import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, new, runWithGraphAllocT)
 import Graph.Slice (bwdSlice, fwdSlice)
 import Lattice (Raw)
 import Pretty (prettyP)
@@ -46,7 +46,7 @@ type GraphConfig g =
 patternMismatch :: String -> String -> String
 patternMismatch s s' = "Pattern mismatch: found " <> s <> ", expected " <> s'
 
-match :: forall m. MonadGraphAlloc m => Val Vertex -> Elim Vertex -> m (Env Vertex × Cont Vertex × Set Vertex)
+match :: forall m. MonadWithGraphAlloc m => Val Vertex -> Elim Vertex -> m (Env Vertex × Cont Vertex × Set Vertex)
 match v (ElimVar x κ)
    | x == varAnon = pure (D.empty × κ × empty)
    | otherwise = pure (D.singleton x v × κ × empty)
@@ -66,7 +66,7 @@ match (V.Record α xvs) (ElimRecord xs κ) = do
    pure $ γ × κ' × (insert α αs)
 match v (ElimRecord xs _) = throw (patternMismatch (prettyP v) (show xs))
 
-matchMany :: forall m. MonadGraphAlloc m => List (Val Vertex) -> Cont Vertex -> m (Env Vertex × Cont Vertex × Set Vertex)
+matchMany :: forall m. MonadWithGraphAlloc m => List (Val Vertex) -> Cont Vertex -> m (Env Vertex × Cont Vertex × Set Vertex)
 matchMany Nil κ = pure (D.empty × κ × empty)
 matchMany (v : vs) (ContElim σ) = do
    γ × κ × αs <- match v σ
@@ -76,7 +76,7 @@ matchMany (_ : vs) (ContExpr _) = throw $
    show (length vs + 1) <> " extra argument(s) to constructor/record; did you forget parentheses in lambda pattern?"
 matchMany _ _ = error "absurd"
 
-closeDefs :: forall m. MonadGraphAlloc m => Env Vertex -> RecDefs Vertex -> Set Vertex -> m (Env Vertex)
+closeDefs :: forall m. MonadWithGraphAlloc m => Env Vertex -> RecDefs Vertex -> Set Vertex -> m (Env Vertex)
 closeDefs γ ρ αs =
    flip traverse ρ \σ ->
       let
@@ -85,7 +85,7 @@ closeDefs γ ρ αs =
          V.Fun <$> new αs <@> V.Closure (γ `restrict` (fv ρ' `union` fv σ)) ρ' σ
 
 {-# Evaluation #-}
-apply :: forall m. MonadGraphAlloc m => Val Vertex -> Val Vertex -> m (Val Vertex)
+apply :: forall m. MonadWithGraphAlloc m => Val Vertex -> Val Vertex -> m (Val Vertex)
 apply (V.Fun α (V.Closure γ1 ρ σ)) v = do
    γ2 <- closeDefs γ1 ρ (singleton α)
    γ3 × κ × αs <- match v σ
@@ -108,7 +108,7 @@ apply (V.Fun α (V.PartialConstr c vs)) v = do
    n = successful (arity c)
 apply _ v = throw $ "Found " <> prettyP v <> ", expected function"
 
-eval :: forall m. MonadGraphAlloc m => Env Vertex -> Expr Vertex -> Set Vertex -> m (Val Vertex)
+eval :: forall m. MonadWithGraphAlloc m => Env Vertex -> Expr Vertex -> Set Vertex -> m (Val Vertex)
 eval γ (Var x) _ = lookup' x γ
 eval γ (Op op) _ = lookup' op γ
 eval _ (Int α n) αs = V.Int <$> new (insert α αs) <@> n
@@ -159,7 +159,7 @@ eval γ (LetRec α ρ e) αs = do
    γ' <- closeDefs γ ρ (insert α αs)
    eval (γ <+> γ') e (insert α αs)
 
-eval_module :: forall m. MonadGraphAlloc m => Env Vertex -> Module Vertex -> Set Vertex -> m (Env Vertex)
+eval_module :: forall m. MonadWithGraphAlloc m => Env Vertex -> Module Vertex -> Set Vertex -> m (Env Vertex)
 eval_module γ = go D.empty
    where
    go :: Env Vertex -> Module Vertex -> Set Vertex -> m (Env Vertex)
diff --git a/src/Graph/GraphWriter.purs b/src/Graph/GraphWriter.purs
index ed351750b..0281912ca 100644
--- a/src/Graph/GraphWriter.purs
+++ b/src/Graph/GraphWriter.purs
@@ -1,18 +1,18 @@
 module Graph.GraphWriter
    ( AdjMapEntries
-   , WithAllocT
+   , AllocT
    , WithGraphAllocT
    , WithGraph
    , WithGraphT
    , class MonadAlloc
-   , class MonadGraphAlloc
-   , class MonadGraph
+   , class MonadWithGraphAlloc
+   , class MonadWithGraph
    , alloc
    , extend
    , fresh
    , new
-   , runWithAlloc
-   , runWithAllocT
+   , runAlloc
+   , runAllocT
    , runWithGraph
    , runWithGraphT
    , runWithGraphAllocT
@@ -34,7 +34,7 @@ import Effect.Exception (Error)
 import Graph (Vertex(..), class Graph, fromFoldable)
 import Util (type (×), (×))
 
-class Monad m <= MonadGraph m where
+class Monad m <= MonadWithGraph m where
    -- Extend graph with existing vertex pointing to set of existing vertices.
    extend :: Vertex -> Set Vertex -> m Unit
 
@@ -43,45 +43,45 @@ class Monad m <= MonadAlloc m where
 
 -- Fix exceptions at Error, the type of JavaScript exceptions, because Aff requires Error, and
 -- I can't see a way to convert MonadError Error m (for example) to MonadError Error m.
-class (MonadAlloc m, MonadError Error m, MonadGraph m) <= MonadGraphAlloc m where
+class (MonadAlloc m, MonadError Error m, MonadWithGraph m) <= MonadWithGraphAlloc m where
    -- Extend with a freshly allocated vertex.
    new :: Set Vertex -> m Vertex
 
 -- List of adjacency map entries to serve as a fromFoldable input.
 type AdjMapEntries = List (Vertex × Set Vertex)
-type WithAllocT m = StateT Int m
-type WithAlloc = WithAllocT Identity
-type WithGraphAllocT m = WithAllocT (WithGraphT m)
+type AllocT m = StateT Int m
+type Alloc = AllocT Identity
+type WithGraphAllocT m = AllocT (WithGraphT m)
 type WithGraphT = StateT AdjMapEntries
 type WithGraph = WithGraphT Identity
 
-instance Monad m => MonadAlloc (WithAllocT m) where
+instance Monad m => MonadAlloc (AllocT m) where
    fresh = do
       n <- modify $ (+) 1
       pure (Vertex $ show n)
 
-instance MonadError Error m => MonadGraphAlloc (WithGraphAllocT m) where
+instance MonadError Error m => MonadWithGraphAlloc (WithGraphAllocT m) where
    new αs = do
       α <- fresh
       extend α αs
       pure α
 
-instance Monad m => MonadGraph (WithGraphT m) where
+instance Monad m => MonadWithGraph (WithGraphT m) where
    extend α αs =
       void $ modify_ $ (:) (α × αs)
 
-instance Monad m => MonadGraph (WithGraphAllocT m) where
+instance Monad m => MonadWithGraph (WithGraphAllocT m) where
    extend α = lift <<< extend α
 
 alloc :: forall m t a. MonadAlloc m => Traversable t => t a -> m (t Vertex)
 alloc = traverse (const fresh)
 
 -- TODO: make synonymous with runStateT/runState?
-runWithAllocT :: forall m a. Monad m => Int -> WithAllocT m a -> m (Int × a)
-runWithAllocT n c = runStateT c n <#> swap
+runAllocT :: forall m a. Monad m => Int -> AllocT m a -> m (Int × a)
+runAllocT n c = runStateT c n <#> swap
 
-runWithAlloc :: forall a. Int -> WithAlloc a -> Int × a
-runWithAlloc n = runWithAllocT n >>> unwrap
+runAlloc :: forall a. Int -> Alloc a -> Int × a
+runAlloc n = runAllocT n >>> unwrap
 
 runWithGraphT :: forall g m a. Monad m => Graph g => WithGraphT m a -> m (g × a)
 runWithGraphT c = runStateT c Nil <#> swap <#> first fromFoldable
@@ -91,5 +91,5 @@ runWithGraph = runWithGraphT >>> unwrap
 
 runWithGraphAllocT :: forall g m a. Monad m => Graph g => g × Int -> WithGraphAllocT m a -> m ((g × Int) × a)
 runWithGraphAllocT (g × n) m = do
-   (n' × a) × g_adds <- runStateT (runWithAllocT n m) Nil
+   (n' × a) × g_adds <- runStateT (runAllocT n m) Nil
    pure $ ((g <> fromFoldable g_adds) × n') × a
diff --git a/src/Module.purs b/src/Module.purs
index 19e000797..f83214a56 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -20,7 +20,7 @@ import Effect.Exception (Error, error)
 import EvalGraph (GraphConfig, eval, eval_module)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
-import Graph.GraphWriter (class MonadGraphAlloc, alloc, fresh, runWithGraphAllocT)
+import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, fresh, runWithGraphAllocT)
 import Parse (module_, program)
 import Parsing (runParser)
 import Primitive.Defs (primitives)
@@ -57,33 +57,33 @@ parseProgram folder file =
 open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")
 
-loadModule :: forall m. MonadAff m => MonadGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
+loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
 loadModule file (ProgCxt r@{ mods, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverse (const fresh)
    γ' <- eval_module γ mod empty
    pure $ ProgCxt r { mods = mod : mods, γ = γ <+> γ' }
 
-defaultImports :: forall m. MonadAff m => MonadGraphAlloc m => m (ProgCxt Vertex)
+defaultImports :: forall m. MonadAff m => MonadWithGraphAlloc 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 :: forall m. MonadAff m => MonadWithGraphAlloc 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 :: forall m. MonadAff m => MonadWithGraphAlloc 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 :: forall m. MonadAff m => MonadWithGraphAlloc 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 }
@@ -103,7 +103,7 @@ openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
          pure $ D.singleton x v × ProgCxt (r { datasets = eα : datasets })
    pure ({ g: g', n: n', progCxt } × xv)
 
-eval_progCxt :: forall m. MonadGraphAlloc m => ProgCxt2 Vertex -> m (Env Vertex)
+eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt2 Vertex -> m (Env Vertex)
 eval_progCxt (ProgCxt2 { mods }) =
    traverse alloc primitives
       >>= concatM (mods <#> \mod γ' -> eval_module γ' mod empty)
diff --git a/src/Val.purs b/src/Val.purs
index 726db1266..9d8004133 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -22,7 +22,7 @@ import Expr (Elim, Expr, Module, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
 import Graph (Vertex(..))
-import Graph.GraphWriter (class MonadGraphAlloc)
+import Graph.GraphWriter (class MonadWithGraphAlloc)
 import Lattice (class BoundedJoinSemilattice, class BoundedLattice, class Expandable, class JoinSemilattice, class Neg, Raw, definedJoin, expand, maybeJoin, neg, (∨))
 import Util (type (×), Endo, error, orElse, throw, unsafeUpdateAt, (!), (×), (≜), (≞))
 import Util.Pretty (Doc, beside, text)
@@ -55,7 +55,7 @@ instance (Ann a, BoundedLattice b) => Ann (a × b)
 -- similar to an isomorphism lens with complement t
 type OpFwd t = forall a m. Ann a => MonadError Error m => List (Val a) -> m (t × Val a)
 type OpBwd t = forall a. Ann a => t × Val a -> List (Val a)
-type OpGraph = forall m. MonadGraphAlloc m => MonadError Error m => List (Val Vertex) -> m (Val Vertex)
+type OpGraph = forall m. MonadWithGraphAlloc m => MonadError Error m => List (Val Vertex) -> m (Val Vertex)
 
 data ForeignOp' t = ForeignOp'
    { arity :: Int

From 26929598df892fadf6bf9fbbc55e0f1af5c8bc70 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 16:07:16 +0200
Subject: [PATCH 36/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20testTrace?=
 =?UTF-8?q?=20doesn't=20need=20full=20graph=20config.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Util.purs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/test/Util.purs b/test/Util.purs
index 11bde10f4..b192e019f 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -12,6 +12,7 @@ import Data.Foldable (foldl)
 import Data.Int (toNumber)
 import Data.List (elem)
 import Data.List.Lazy (List, length, replicateM)
+import Data.Newtype (unwrap)
 import Data.Set (subset)
 import Data.String (null)
 import DataType (dataTypeFor, typeName)
@@ -22,7 +23,7 @@ import Effect.Exception (Error)
 import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
 import GaloisConnection (GaloisConnection(..))
-import Graph (selectαs, select𝔹s, sinks, vertices)
+import Graph (Vertex, selectαs, select𝔹s, sinks, vertices)
 import Graph.GraphImpl (GraphImpl)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
 import Heterogeneous.Mapping (hmap)
@@ -33,7 +34,7 @@ import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
 import Util (MayFailT, successful, (×))
-import Val (class Ann, ProgCxt(..), Val(..))
+import Val (class Ann, Val(..), Env)
 
 type TestConfig =
    { δv :: Selector Val
@@ -52,7 +53,7 @@ testWithSetup n file gconfig tconfig = do
       s <- open file
       testPretty s
       rows <- replicateM n $ do
-         trRow <- testTrace s gconfig tconfig
+         trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
          grRow <- testGraph s gconfig tconfig
          pure $ BenchRow trRow grRow
       pure $ averageRows rows
@@ -66,8 +67,8 @@ testPretty s = do
       log ("NEW\n" <> show (erase s'))
       lift $ fail "not equal"
 
-testTrace :: Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> MayFailT Aff TraceRow
-testTrace s { progCxt: ProgCxt { γ } } { δv, bwd_expect, fwd_expect } = do
+testTrace :: Raw SE.Expr -> Env Vertex -> TestConfig -> MayFailT Aff TraceRow
+testTrace s γ { δv, bwd_expect, fwd_expect } = do
    -- | Desugaring Galois connections for Unit and Boolean type selections
    GC desug <- desugGC s
    GC desug𝔹 <- desugGC s

From 2d5a411ed2e38c9b905cb0e66fee0ca8b3ed4987 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 16:11:07 +0200
Subject: [PATCH 37/57] =?UTF-8?q?=E2=9D=97=20[incomplete]:=20Start=20on=20?=
 =?UTF-8?q?version=20of=20testWithSetup=20that=20takes=20a=20ProgCxt.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Util.purs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/test/Util.purs b/test/Util.purs
index b192e019f..191f2a42b 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -33,8 +33,8 @@ import Parse (program)
 import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
-import Util (MayFailT, successful, (×))
-import Val (class Ann, Val(..), Env)
+import Util (MayFailT, successful, (×), type (+))
+import Val (class Ann, Env, ProgCxt2, Val(..))
 
 type TestConfig =
    { δv :: Selector Val
@@ -58,6 +58,20 @@ testWithSetup n file gconfig tconfig = do
          pure $ BenchRow trRow grRow
       pure $ averageRows rows
 
+testWithSetup2 ∷ Int -> File -> ProgCxt2 Unit -> TestConfig -> Aff BenchRow
+testWithSetup2 n file progCxt tconfig = do
+   liftEither =<< test
+   where
+   test :: forall m. Aff (Error + BenchRow)
+   test = runExceptT do
+      s <- open file
+      testPretty s
+      rows <- replicateM n $ do
+         trRow <- testTrace s ?_ tconfig
+         grRow <- testGraph s ?_ tconfig
+         pure $ BenchRow trRow grRow
+      pure $ averageRows rows
+
 testPretty :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
 testPretty s = do
    let src = prettyP s

From 1cc92d4ebf3928b190624517c81a6f4e53d13160 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 16:57:36 +0200
Subject: [PATCH 38/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20ProgCxt2=20-?=
 =?UTF-8?q?>=20ProgCxt,=20ProgCxt=20->=20ProgCxtEval=20and=20factor=20latt?=
 =?UTF-8?q?er=20through=20former.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs   |  6 +++---
 src/EvalGraph.purs |  8 ++++----
 src/Module.purs    | 46 ++++++++++++++++++++++++----------------------
 src/Val.purs       | 18 +++++++++---------
 test/Many.purs     |  6 +++---
 test/Util.purs     | 34 ++++++++++++++++++++--------------
 6 files changed, 63 insertions(+), 55 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 6b2ac01bf..25598fc71 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -39,7 +39,7 @@ import SExpr (Expr(..), Module(..), RecDefs, VarDefs) as S
 import SExpr (desugarModuleFwd)
 import Trace (Trace)
 import Util (type (×), type (+), (×), absurd, error, orElse)
-import Val (class Ann, Env, ProgCxt(..), Val(..), append_inv, (<+>))
+import Val (class Ann, Env, ProgCxtEval(..), Val(..), append_inv, (<+>))
 import Web.Event.EventTarget (eventListener)
 
 data View
@@ -192,7 +192,7 @@ linkResult x γ0 γ e1 e2 t1 _ v1 = do
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
    -- TODO: not every example should run with this dataset.
-   { progCxt: ProgCxt { γ } } × xv :: GraphConfig GraphImpl × _ <-
+   { progCxt: ProgCxtEval { γ } } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/linking/renewables") "data"
    let
       γ0 = botOf <$> γ
@@ -211,7 +211,7 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
    -- views share ambient environment γ as well as dataset
-   { progCxt: ProgCxt { γ } } × xv :: GraphConfig GraphImpl × _ <-
+   { progCxt: ProgCxtEval { γ } } × xv :: GraphConfig GraphImpl × _ <-
       openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index f36758657..17ddc67ae 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -33,13 +33,13 @@ import Pretty (prettyP)
 import Primitive (string, intPair)
 import Util (type (×), check, error, orElse, successful, throw, with, (×))
 import Util.Pair (unzip) as P
-import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgCxt(..), Val, for, lookup', restrict, (<+>))
-import Val (Val(..), Fun(..)) as V
+import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgCxtEval(..), Val, for, lookup', restrict, (<+>))
+import Val (Fun(..), Val(..)) as V
 
 type GraphConfig g =
    { g :: g
    , n :: Int
-   , progCxt :: ProgCxt Vertex
+   , progCxt :: ProgCxtEval Vertex
    }
 
 {-# Matching #-}
@@ -187,7 +187,7 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, progCxt: ProgCxt { γ } } e = do
+graphGC { g, n, progCxt: ProgCxtEval { γ } } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
diff --git a/src/Module.purs b/src/Module.purs
index f83214a56..2743316a3 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Affjax.ResponseFormat (string)
 import Affjax.Web (defaultRequest, printError, request)
+import Ann (Raw)
 import Bindings (Var)
 import Control.Monad.Error.Class (liftEither, throwError)
 import Control.Monad.Except (class MonadError)
@@ -16,7 +17,8 @@ import Data.Traversable (traverse)
 import Desugarable (desug)
 import Dict (singleton) as D
 import Effect.Aff.Class (class MonadAff, liftAff)
-import Effect.Exception (Error, error)
+import Effect.Exception (Error)
+import Effect.Exception (error) as E
 import EvalGraph (GraphConfig, eval, eval_module)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
@@ -26,9 +28,9 @@ import Parsing (runParser)
 import Primitive.Defs (primitives)
 import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
-import Util (type (×), concatM, mapLeft, (×))
+import Util (type (×), (×), concatM, mapLeft)
 import Util.Parse (SParser)
-import Val (Env, ProgCxt(..), ProgCxt2(..), (<+>))
+import Val (Env, ProgCxt(..), ProgCxtEval(..), (<+>))
 
 -- Mainly serve as documentation
 newtype File = File String
@@ -44,11 +46,11 @@ loadFile (Folder folder) (File file) = do
    let url = "./" <> folder <> "/" <> file <> ".fld"
    result <- liftAff $ request (defaultRequest { url = url, method = Left GET, responseFormat = string })
    case result of
-      Left err -> throwError $ error $ printError err
+      Left err -> throwError $ E.error $ printError err
       Right response -> pure response.body
 
 parse :: forall a m. MonadError Error m => String -> SParser a -> m a
-parse src = liftEither <<< mapLeft (error <<< show) <<< runParser src
+parse src = liftEither <<< mapLeft (E.error <<< show) <<< runParser src
 
 parseProgram :: forall m. MonadAff m => MonadError Error m => Folder -> File -> m (S.Expr Unit)
 parseProgram folder file =
@@ -57,36 +59,36 @@ parseProgram folder file =
 open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")
 
-loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxt Vertex -> m (ProgCxt Vertex)
-loadModule file (ProgCxt r@{ mods, γ }) = do
+loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxtEval Vertex -> m (ProgCxtEval Vertex)
+loadModule file (ProgCxtEval r@{ progCxt: ProgCxt r'@{ mods }, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd >>= traverse (const fresh)
    γ' <- eval_module γ mod empty
-   pure $ ProgCxt r { mods = mod : mods, γ = γ <+> γ' }
+   pure $ ProgCxtEval r { progCxt = ProgCxt r' { mods = mod : mods }, γ = γ <+> γ' }
 
-defaultImports :: forall m. MonadAff m => MonadWithGraphAlloc m => m (ProgCxt Vertex)
+defaultImports :: forall m. MonadAff m => MonadWithGraphAlloc m => m (ProgCxtEval Vertex)
 defaultImports = do
    γ <- traverse alloc primitives
-   loadModule (File "prelude") (ProgCxt { mods: Nil, datasets: Nil, γ })
+   loadModule (File "prelude") (ProgCxtEval { progCxt: ProgCxt { mods: Nil, datasets: Nil }, γ })
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
-loadModule2 :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
-loadModule2 file (ProgCxt2 r@{ mods }) = do
+loadModule2 :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (Raw ProgCxt)
+loadModule2 file (ProgCxt r@{ mods }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd
-   pure $ ProgCxt2 r { mods = mod : mods }
+   pure $ ProgCxt r { mods = mod : mods }
 
-defaultImports2 :: forall m. MonadAff m => MonadWithGraphAlloc m => m (ProgCxt2 Unit)
+defaultImports2 :: forall m. MonadAff m => MonadWithGraphAlloc m => m (Raw ProgCxt)
 defaultImports2 =
-   loadModule2 (File "prelude") (ProgCxt2 { mods: Nil, datasets: Nil })
+   loadModule2 (File "prelude") (ProgCxt { mods: Nil, datasets: Nil })
       >>= loadModule2 (File "graphics")
       >>= loadModule2 (File "convolution")
 
-loadDataset :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxt2 Unit -> m (ProgCxt2 Unit)
-loadDataset file (ProgCxt2 r@{ datasets }) = do
+loadDataset :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (ProgCxt Unit)
+loadDataset file (ProgCxt r@{ datasets }) = do
    dataset <- parseProgram (Folder "fluid") file >>= desug
-   pure $ ProgCxt2 r { datasets = dataset : datasets }
+   pure $ ProgCxt r { datasets = dataset : datasets }
 
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
@@ -94,16 +96,16 @@ openDefaultImports = do
    pure { g, n, progCxt }
 
 openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
-openDatasetAs file x { g, n, progCxt: ProgCxt r@{ γ, datasets } } = do
+openDatasetAs file x { g, n, progCxt: ProgCxtEval r@{ progCxt: ProgCxt r'@{ datasets }, γ } } = do
    s <- parseProgram (Folder "fluid") file
    (g' × n') × xv × progCxt <-
       runWithGraphAllocT (g × n) do
          eα <- desug s >>= alloc
          v <- eval γ eα empty
-         pure $ D.singleton x v × ProgCxt (r { datasets = eα : datasets })
+         pure $ D.singleton x v × ProgCxtEval (r { progCxt = ProgCxt (r' { datasets = eα : datasets }) })
    pure ({ g: g', n: n', progCxt } × xv)
 
-eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt2 Vertex -> m (Env Vertex)
-eval_progCxt (ProgCxt2 { mods }) =
+eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
+eval_progCxt (ProgCxt { mods }) = do
    traverse alloc primitives
       >>= concatM (mods <#> \mod γ' -> eval_module γ' mod empty)
diff --git a/src/Val.purs b/src/Val.purs
index 9d8004133..e91d98c60 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -73,19 +73,16 @@ lookup' :: forall a m. MonadThrow Error m => Var -> Dict a -> m a
 lookup' x γ = lookup x γ # orElse ("variable " <> x <> " not found")
 
 -- Bunch of loaded modules and datasets, reflecting current somewhat ad hoc approach.
-newtype ProgCxt a = ProgCxt
-   { mods :: List (Module a)
-   , datasets :: List (Expr a)
+newtype ProgCxtEval a = ProgCxtEval
+   { progCxt :: ProgCxt a
    , γ :: Env a
    }
 
-newtype ProgCxt2 a = ProgCxt2
+newtype ProgCxt a = ProgCxt
    { mods :: List (Module a)
    , datasets :: List (Expr a)
    }
 
-derive instance Newtype (ProgCxt a) _
-
 -- Want a monoid instance but needs a newtype
 append :: forall a. Env a -> Endo (Env a)
 append = unionWith (const identity)
@@ -154,7 +151,11 @@ instance Highlightable Vertex where
 derive instance Functor DictRep
 derive instance Functor MatrixRep
 derive instance Functor Val
+derive instance Newtype (ProgCxt a) _
 derive instance Functor ProgCxt
+derive instance Newtype (ProgCxtEval a) _
+derive instance Functor ProgCxtEval
+derive instance Traversable ProgCxt
 derive instance Foldable Val
 derive instance Traversable Val
 derive instance Functor Fun
@@ -188,11 +189,10 @@ instance Apply MatrixRep where
       MatrixRep $ (A.zipWith (A.zipWith (<*>)) fvss vss) × ((n ≜ n') × fnα nα) × ((m ≜ m') × fmα mα)
 
 instance Apply ProgCxt where
-   apply (ProgCxt { mods: fmods, datasets: fdatasets, γ: fγ }) (ProgCxt { mods, datasets, γ }) =
+   apply (ProgCxt { mods: fmods, datasets: fdatasets }) (ProgCxt { mods, datasets }) =
       ProgCxt
          { mods: fmods `zipWith (<*>)` mods
          , datasets: fdatasets `zipWith (<*>)` datasets
-         , γ: D.apply2 fγ γ
          }
 
 instance Foldable DictRep where
@@ -217,7 +217,7 @@ instance Traversable MatrixRep where
    sequence = sequenceDefault
 
 instance Foldable ProgCxt where
-   foldl f acc (ProgCxt { mods, γ }) = foldl (foldl f) (foldl (foldl f) acc γ) mods
+   foldl f acc (ProgCxt { mods }) = foldl (foldl f) acc mods
    foldr f = foldrDefault f
    foldMap f = foldMapDefaultL f
 
diff --git a/test/Many.purs b/test/Many.purs
index f9c9adea7..d86e31a0f 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -9,7 +9,7 @@ import Effect.Aff (Aff)
 import Module (File(..), Folder(..), loadFile, openDatasetAs, openDefaultImports)
 import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
 import Util (type (×), (×))
-import Val (ProgCxt(..), (<+>))
+import Val (ProgCxtEval(..), (<+>))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many specs n = zip (specs <#> _.file) (specs <#> one)
@@ -32,8 +32,8 @@ withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
    where
    withDatasetOne { dataset, file } = do
       -- TODO: make progCxt consistent with addition of xv
-      gconfig@{ progCxt: ProgCxt r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      testWithSetup n (File file) gconfig { progCxt = ProgCxt r { γ = γ <+> xv } }
+      gconfig@{ progCxt: ProgCxtEval r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
+      testWithSetup n (File file) gconfig { progCxt = ProgCxtEval r { γ = γ <+> xv } }
          { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
diff --git a/test/Util.purs b/test/Util.purs
index 191f2a42b..1405716ae 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -24,17 +24,19 @@ import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
 import GaloisConnection (GaloisConnection(..))
 import Graph (Vertex, selectαs, select𝔹s, sinks, vertices)
+import Graph (empty) as G
 import Graph.GraphImpl (GraphImpl)
+import Graph.GraphWriter (alloc, runWithGraphAllocT)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
-import Module (File, open, parse)
+import Module (File, eval_progCxt, open, parse)
 import Parse (program)
 import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
 import Util (MayFailT, successful, (×), type (+))
-import Val (class Ann, Env, ProgCxt2, Val(..))
+import Val (class Ann, Env, ProgCxt, ProgCxtEval(..), Val(..))
 
 type TestConfig =
    { δv :: Selector Val
@@ -58,19 +60,23 @@ testWithSetup n file gconfig tconfig = do
          pure $ BenchRow trRow grRow
       pure $ averageRows rows
 
-testWithSetup2 ∷ Int -> File -> ProgCxt2 Unit -> TestConfig -> Aff BenchRow
-testWithSetup2 n file progCxt tconfig = do
+testWithSetup2 ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
+testWithSetup2 m file progCxt tconfig = do
+   (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
+      progCxt' <- alloc progCxt
+      γ <- eval_progCxt progCxt'
+      pure $ ProgCxtEval { progCxt: progCxt', γ }
+   let
+      test :: Aff (Error + BenchRow)
+      test = runExceptT do
+         s <- open file
+         testPretty s
+         rows <- replicateM m $ do
+            trRow <- testTrace s ((unwrap progCxt').γ) tconfig
+            grRow <- testGraph s { g, n, progCxt: progCxt' } tconfig
+            pure $ BenchRow trRow grRow
+         pure $ averageRows rows
    liftEither =<< test
-   where
-   test :: forall m. Aff (Error + BenchRow)
-   test = runExceptT do
-      s <- open file
-      testPretty s
-      rows <- replicateM n $ do
-         trRow <- testTrace s ?_ tconfig
-         grRow <- testGraph s ?_ tconfig
-         pure $ BenchRow trRow grRow
-      pure $ averageRows rows
 
 testPretty :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
 testPretty s = do

From ec2b77917485457ab7aa9bb5b9611b4c8675c477 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 17:21:08 +0200
Subject: [PATCH 39/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Partial=20ro?=
 =?UTF-8?q?ll=20out=20of=20new=20design.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs | 14 ++++++++++----
 src/Val.purs    |  2 +-
 test/Main.purs  | 10 +---------
 test/Many.purs  |  8 ++++----
 4 files changed, 16 insertions(+), 18 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index 2743316a3..6ff552be0 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -10,7 +10,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(..), (:))
+import Data.List (List(..), reverse, (:))
 import Data.Newtype (class Newtype)
 import Data.Set (empty)
 import Data.Traversable (traverse)
@@ -20,6 +20,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error)
 import Effect.Exception (error) as E
 import EvalGraph (GraphConfig, eval, eval_module)
+import Expr (Module)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
 import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, fresh, runWithGraphAllocT)
@@ -73,13 +74,13 @@ defaultImports = do
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
-loadModule2 :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (Raw ProgCxt)
+loadModule2 :: forall m. MonadAff m => MonadError Error m => File -> Raw ProgCxt -> m (Raw ProgCxt)
 loadModule2 file (ProgCxt r@{ mods }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src module_ >>= desugarModuleFwd
    pure $ ProgCxt r { mods = mod : mods }
 
-defaultImports2 :: forall m. MonadAff m => MonadWithGraphAlloc m => m (Raw ProgCxt)
+defaultImports2 :: forall m. MonadAff m => MonadError Error m => m (Raw ProgCxt)
 defaultImports2 =
    loadModule2 (File "prelude") (ProgCxt { mods: Nil, datasets: Nil })
       >>= loadModule2 (File "graphics")
@@ -108,4 +109,9 @@ openDatasetAs file x { g, n, progCxt: ProgCxtEval r@{ progCxt: ProgCxt r'@{ data
 eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
 eval_progCxt (ProgCxt { mods }) = do
    traverse alloc primitives
-      >>= concatM (mods <#> \mod γ' -> eval_module γ' mod empty)
+      >>= concatM (reverse mods <#> addDefs)
+   where
+   addDefs :: Module Vertex -> Env Vertex -> m (Env Vertex)
+   addDefs mod γ = do
+      γ' <- eval_module γ mod empty
+      pure $ γ <+> γ'
diff --git a/src/Val.purs b/src/Val.purs
index e91d98c60..d34850cc4 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -79,7 +79,7 @@ newtype ProgCxtEval a = ProgCxtEval
    }
 
 newtype ProgCxt a = ProgCxt
-   { mods :: List (Module a)
+   { mods :: List (Module a) -- in reverse order
    , datasets :: List (Expr a)
    }
 
diff --git a/test/Main.purs b/test/Main.purs
index bc30a4a5b..c844464a7 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -1,12 +1,4 @@
-module Test.Main
-   ( main
-   , test_bwd
-   , test_desugaring
-   , test_graphics
-   --  , test_linking
-   , test_misc
-   --  , test_scratchpad
-   ) where
+module Test.Main where
 
 import Prelude hiding (add)
 
diff --git a/test/Many.purs b/test/Many.purs
index d86e31a0f..cf233eddc 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -6,8 +6,8 @@ import App.Fig (linkResult, loadLinkFig)
 import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
-import Module (File(..), Folder(..), loadFile, openDatasetAs, openDefaultImports)
-import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
+import Module (File(..), Folder(..), defaultImports2, loadFile, openDatasetAs, openDefaultImports)
+import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup, testWithSetup2)
 import Util (type (×), (×))
 import Val (ProgCxtEval(..), (<+>))
 
@@ -15,8 +15,8 @@ many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
-      gconfig <- openDefaultImports
-      testWithSetup n (File file) gconfig { δv: identity, fwd_expect, bwd_expect: mempty }
+      progCxt <- defaultImports2
+      testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
 bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)

From a6882a63182361b75ed3be370e529c4cb229f389 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Tue, 3 Oct 2023 17:23:03 +0200
Subject: [PATCH 40/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Further=20ro?=
 =?UTF-8?q?llout.=20Bit=20of=20work=20to=20do=20tomorrow=20to=20handle=20d?=
 =?UTF-8?q?ata=20sets=20properly.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/Many.purs b/test/Many.purs
index cf233eddc..d1c27235a 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -23,9 +23,9 @@ bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
    where
    folder = File "slicing/"
    bwdOne { file, file_expect, δv, fwd_expect } = do
-      gconfig <- openDefaultImports
+      progCxt <- defaultImports2
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
-      testWithSetup n (folder <> File file) gconfig { δv, fwd_expect, bwd_expect }
+      testWithSetup2 n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)

From 53021e952c5468e3b9e96e72c9986ca01c77dbc9 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 07:55:05 +0200
Subject: [PATCH 41/57] =?UTF-8?q?=F0=9F=A7=A9=20[remove-unused]:=20loadFig?=
 =?UTF-8?q?=20doesn't=20need=20to=20load=20'renewables'=20data=20set.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 25598fc71..223ed57b8 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -191,17 +191,13 @@ linkResult x γ0 γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   -- TODO: not every example should run with this dataset.
-   { progCxt: ProgCxtEval { γ } } × xv :: GraphConfig GraphImpl × _ <-
-      openDefaultImports >>= openDatasetAs (File "example/linking/renewables") "data"
-   let
-      γ0 = botOf <$> γ
-      xv0 = botOf <$> xv
+   { progCxt: ProgCxtEval { γ } } :: GraphConfig GraphImpl <- openDefaultImports
+   let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
-   { γ: γ1, s } <- splitDefs (γ0 <+> xv0) s0
+   { γ: γ1, s } <- splitDefs γ0 s0
    e <- desug s
-   let γ0γ = γ0 <+> xv0 <+> γ1
+   let γ0γ = γ0 <+> γ1
    t × v <- eval γ0γ e bot
    pure { spec, γ0, γ: γ0 <+> γ1, s0, s, e, t, v }
 

From 5ba939a7d92612de30bc082dcfab201d04b07a42 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 08:06:01 +0200
Subject: [PATCH 42/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Should=20be?=
 =?UTF-8?q?=20possible=20just=20to=20pass=20linkResult=20a=20composite=20e?=
 =?UTF-8?q?nvironment=20rather=20than=20separate=20env=20for=20dataset=20b?=
 =?UTF-8?q?inding.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 223ed57b8..7d7b3442c 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -182,11 +182,11 @@ linkResult :: forall m. MonadError Error m => Var -> Env 𝔹 -> Env 𝔹 -> Exp
 linkResult x γ0 γ e1 e2 t1 _ v1 = do
    let
       γ0γ × _ = evalBwd (erase <$> (γ0 <+> γ)) (erase e1) v1 t1
-      _ × γ' = append_inv (S.singleton x) γ0γ
+      γ0' × γ' = append_inv (S.singleton x) γ0γ
    v0' <- lookup x γ' # orElse absurd
    -- make γ0 and e2 fully available; γ0 was previously too big to operate on, so we use
    -- (topOf γ0) combined with negation of the dataset environment slice
-   _ × v2' <- eval (neg ((botOf <$> γ0) <+> γ')) (topOf e2) true
+   _ × v2' <- eval (neg ((botOf <$> γ0') <+> γ')) (topOf e2) true
    pure { v': neg v2', v0' }
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig

From 3896f11d61ea3f60610c3dc436a1350293ebba84 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 08:07:53 +0200
Subject: [PATCH 43/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20=CE=B30=CE=B3?=
 =?UTF-8?q?=20->=20=CE=B30=CE=B3'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 7d7b3442c..5f157f58e 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -181,8 +181,8 @@ figViews { spec: { xs }, γ0, γ, e, t, v } δv = do
 linkResult :: forall m. MonadError Error m => Var -> Env 𝔹 -> Env 𝔹 -> Expr 𝔹 -> Expr 𝔹 -> Trace -> Trace -> Val 𝔹 -> m LinkResult
 linkResult x γ0 γ e1 e2 t1 _ v1 = do
    let
-      γ0γ × _ = evalBwd (erase <$> (γ0 <+> γ)) (erase e1) v1 t1
-      γ0' × γ' = append_inv (S.singleton x) γ0γ
+      γ0γ' × _ = evalBwd (erase <$> (γ0 <+> γ)) (erase e1) v1 t1
+      γ0' × γ' = append_inv (S.singleton x) γ0γ'
    v0' <- lookup x γ' # orElse absurd
    -- make γ0 and e2 fully available; γ0 was previously too big to operate on, so we use
    -- (topOf γ0) combined with negation of the dataset environment slice

From 680523167b1e125c4469de6603ff77bd59a63edc Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 08:12:08 +0200
Subject: [PATCH 44/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Just=20pass?=
 =?UTF-8?q?=20linkResult=20a=20composite=20environment=20rather=20than=20s?=
 =?UTF-8?q?eparate=20env=20for=20dataset=20binding.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 17 ++++++++---------
 test/Many.purs   |  4 ++--
 2 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 5f157f58e..7375d4efe 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -111,8 +111,7 @@ type LinkFigSpec =
 
 type LinkFig =
    { spec :: LinkFigSpec
-   , γ0 :: Env 𝔹 -- ambient environment (default imports)
-   , γ :: Env 𝔹 -- local env (loaded dataset)
+   , γ0γ :: Env 𝔹 -- prog context environment (modules + dataset)
    , s1 :: S.Expr 𝔹
    , s2 :: S.Expr 𝔹
    , e1 :: Expr 𝔹
@@ -131,16 +130,16 @@ type LinkResult =
    }
 
 drawLinkFig :: LinkFig -> EditorView -> EditorView -> EditorView -> Selector Val + Selector Val -> Effect Unit
-drawLinkFig fig@{ spec: { x, divId }, γ0, γ, s1, s2, e1, e2, t1, t2, v1, v2, dataFile } ed1 ed2 ed3 δv = do
+drawLinkFig fig@{ spec: { x, divId }, γ0γ, s1, s2, e1, e2, t1, t2, v1, v2, dataFile } ed1 ed2 ed3 δv = do
    log $ "Redrawing " <> divId
    v1' × v2' × δv1 × δv2 × v0 <- case δv of
       Left δv1 -> do
          let v1' = δv1 v1
-         { v', v0' } <- linkResult x γ0 γ e1 e2 t1 t2 v1'
+         { v', v0' } <- linkResult x γ0γ e1 e2 t1 t2 v1'
          pure $ v1' × v' × const v1' × identity × v0'
       Right δv2 -> do
          let v2' = δv2 v2
-         { v', v0' } <- linkResult x γ0 γ e2 e1 t2 t1 v2'
+         { v', v0' } <- linkResult x γ0γ e2 e1 t2 t1 v2'
          pure $ v' × v2' × identity × const v2' × v0'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Left $ δv1 >>> selector)) 2 $ view "left view" v1'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Right $ δv2 >>> selector)) 0 $ view "right view" v2'
@@ -178,10 +177,10 @@ figViews { spec: { xs }, γ0, γ, e, t, v } δv = do
    views <- valViews γ0γ xs
    pure $ view "output" v' × views
 
-linkResult :: forall m. MonadError Error m => Var -> Env 𝔹 -> Env 𝔹 -> Expr 𝔹 -> Expr 𝔹 -> Trace -> Trace -> Val 𝔹 -> m LinkResult
-linkResult x γ0 γ e1 e2 t1 _ v1 = do
+linkResult :: forall m. MonadError Error m => Var -> Env 𝔹 -> Expr 𝔹 -> Expr 𝔹 -> Trace -> Trace -> Val 𝔹 -> m LinkResult
+linkResult x γ0γ e1 e2 t1 _ v1 = do
    let
-      γ0γ' × _ = evalBwd (erase <$> (γ0 <+> γ)) (erase e1) v1 t1
+      γ0γ' × _ = evalBwd (erase <$> γ0γ) (erase e1) v1 t1
       γ0' × γ' = append_inv (S.singleton x) γ0γ'
    v0' <- lookup x γ' # orElse absurd
    -- make γ0 and e2 fully available; γ0 was previously too big to operate on, so we use
@@ -220,4 +219,4 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
    t1 × v1 <- eval (γ0 <+> xv0) e1 bot
    t2 × v2 <- eval (γ0 <+> xv0) e2 bot
    let v0 = get x xv0
-   pure { spec, γ0, γ: xv0, s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }
+   pure { spec, γ0γ: γ0 <+> xv0, s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }
diff --git a/test/Many.purs b/test/Many.purs
index d1c27235a..cc3645fca 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -41,6 +41,6 @@ linkMany specs = zip (specs <#> name) (specs <#> linkOne)
    where
    name spec = "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
    linkOne { spec, δv1, v2_expect } = do
-      { γ0, γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
-      { v': v2' } <- linkResult spec.x γ0 γ e1 e2 t1 t2 (δv1 v1)
+      { γ0γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
+      { v': v2' } <- linkResult spec.x γ0γ e1 e2 t1 t2 (δv1 v1)
       checkPretty "Linked output" v2_expect v2'

From 41142282f36aa9e8f305894b37be72b538e006d4 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 08:16:03 +0200
Subject: [PATCH 45/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20=CE=B30=CE=B3?=
 =?UTF-8?q?=20->=20=CE=B3'.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 15 ++++++++-------
 test/Many.purs   |  4 ++--
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 7375d4efe..8cce1b272 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -111,7 +111,7 @@ type LinkFigSpec =
 
 type LinkFig =
    { spec :: LinkFigSpec
-   , γ0γ :: Env 𝔹 -- prog context environment (modules + dataset)
+   , γ :: Env 𝔹 -- prog context environment (modules + dataset)
    , s1 :: S.Expr 𝔹
    , s2 :: S.Expr 𝔹
    , e1 :: Expr 𝔹
@@ -130,16 +130,16 @@ type LinkResult =
    }
 
 drawLinkFig :: LinkFig -> EditorView -> EditorView -> EditorView -> Selector Val + Selector Val -> Effect Unit
-drawLinkFig fig@{ spec: { x, divId }, γ0γ, s1, s2, e1, e2, t1, t2, v1, v2, dataFile } ed1 ed2 ed3 δv = do
+drawLinkFig fig@{ spec: { x, divId }, γ, s1, s2, e1, e2, t1, t2, v1, v2, dataFile } ed1 ed2 ed3 δv = do
    log $ "Redrawing " <> divId
    v1' × v2' × δv1 × δv2 × v0 <- case δv of
       Left δv1 -> do
          let v1' = δv1 v1
-         { v', v0' } <- linkResult x γ0γ e1 e2 t1 t2 v1'
+         { v', v0' } <- linkResult x γ e1 e2 t1 t2 v1'
          pure $ v1' × v' × const v1' × identity × v0'
       Right δv2 -> do
          let v2' = δv2 v2
-         { v', v0' } <- linkResult x γ0γ e2 e1 t2 t1 v2'
+         { v', v0' } <- linkResult x γ e2 e1 t2 t1 v2'
          pure $ v' × v2' × identity × const v2' × v0'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Left $ δv1 >>> selector)) 2 $ view "left view" v1'
    drawView divId (\selector -> drawLinkFig fig ed1 ed2 ed3 (Right $ δv2 >>> selector)) 0 $ view "right view" v2'
@@ -212,11 +212,12 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
    let
       γ0 = botOf <$> γ
       xv0 = botOf <$> xv
+      γ' = γ0 <+> xv0
       s1 = botOf s1'
       s2 = botOf s2'
    dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- use surface expression instead
    e1 × e2 <- (×) <$> desug s1 <*> desug s2
-   t1 × v1 <- eval (γ0 <+> xv0) e1 bot
-   t2 × v2 <- eval (γ0 <+> xv0) e2 bot
+   t1 × v1 <- eval γ' e1 bot
+   t2 × v2 <- eval γ' e2 bot
    let v0 = get x xv0
-   pure { spec, γ0γ: γ0 <+> xv0, s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }
+   pure { spec, γ: γ', s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }
diff --git a/test/Many.purs b/test/Many.purs
index cc3645fca..d687fdea2 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -41,6 +41,6 @@ linkMany specs = zip (specs <#> name) (specs <#> linkOne)
    where
    name spec = "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
    linkOne { spec, δv1, v2_expect } = do
-      { γ0γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
-      { v': v2' } <- linkResult spec.x γ0γ e1 e2 t1 t2 (δv1 v1)
+      { γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
+      { v': v2' } <- linkResult spec.x γ e1 e2 t1 t2 (δv1 v1)
       checkPretty "Linked output" v2_expect v2'

From 8376f00e171c154772e83ee0f764e3c9169ae0d6 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 08:54:05 +0200
Subject: [PATCH 46/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Clean=20u?=
 =?UTF-8?q?p=20monad=20gunk=20in=20Test.Util.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs |   8 ++++
 test/Util.purs  | 107 +++++++++++++++++++++---------------------------
 2 files changed, 54 insertions(+), 61 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index 6ff552be0..72a915a39 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -115,3 +115,11 @@ eval_progCxt (ProgCxt { mods }) = do
    addDefs mod γ = do
       γ' <- eval_module γ mod empty
       pure $ γ <+> γ'
+
+blah :: forall m g. Graph g => MonadError Error m => ProgCxt Unit -> m (GraphConfig g)
+blah progCxt = do
+   (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
+         progCxt' <- alloc progCxt
+         γ <- eval_progCxt progCxt'
+         pure $ ProgCxtEval { progCxt: progCxt', γ }
+   pure { g, n, progCxt: progCxt' }
diff --git a/test/Util.purs b/test/Util.purs
index 1405716ae..d413c4df6 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -5,9 +5,7 @@ import Prelude hiding (absurd)
 import App.Fig (LinkFigSpec)
 import App.Util (Selector)
 import Benchmark.Util (BenchRow(..), GraphRow, TraceRow, preciseTime, tdiff)
-import Control.Monad.Error.Class (class MonadThrow, liftEither)
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans.Class (lift)
+import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Data.Foldable (foldl)
 import Data.Int (toNumber)
 import Data.List (elem)
@@ -18,25 +16,24 @@ import Data.String (null)
 import DataType (dataTypeFor, typeName)
 import Desug (desugGC)
 import Effect.Aff (Aff)
+import Effect.Aff.Class (class MonadAff)
 import Effect.Class.Console (log)
 import Effect.Exception (Error)
 import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
 import GaloisConnection (GaloisConnection(..))
 import Graph (Vertex, selectαs, select𝔹s, sinks, vertices)
-import Graph (empty) as G
 import Graph.GraphImpl (GraphImpl)
-import Graph.GraphWriter (alloc, runWithGraphAllocT)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
-import Module (File, eval_progCxt, open, parse)
+import Module (File, blah, open, parse)
 import Parse (program)
 import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
-import Util (MayFailT, successful, (×), type (+))
-import Val (class Ann, Env, ProgCxt, ProgCxtEval(..), Val(..))
+import Util (successful, (×))
+import Val (class Ann, Env, ProgCxt, Val(..))
 
 type TestConfig =
    { δv :: Selector Val
@@ -49,45 +46,35 @@ logging = false
 
 testWithSetup ∷ Int -> File -> GraphConfig GraphImpl -> TestConfig -> Aff BenchRow
 testWithSetup n file gconfig tconfig = do
-   liftEither =<< test
-   where
-   test = runExceptT do
-      s <- open file
-      testPretty s
-      rows <- replicateM n $ do
-         trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
-         grRow <- testGraph s gconfig tconfig
-         pure $ BenchRow trRow grRow
-      pure $ averageRows rows
+   s <- open file
+   testPretty s
+   rows <- replicateM n $ do
+      trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
+      grRow <- testGraph s gconfig tconfig
+      pure $ BenchRow trRow grRow
+   pure $ averageRows rows
 
 testWithSetup2 ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
 testWithSetup2 m file progCxt tconfig = do
-   (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
-      progCxt' <- alloc progCxt
-      γ <- eval_progCxt progCxt'
-      pure $ ProgCxtEval { progCxt: progCxt', γ }
-   let
-      test :: Aff (Error + BenchRow)
-      test = runExceptT do
-         s <- open file
-         testPretty s
-         rows <- replicateM m $ do
-            trRow <- testTrace s ((unwrap progCxt').γ) tconfig
-            grRow <- testGraph s { g, n, progCxt: progCxt' } tconfig
-            pure $ BenchRow trRow grRow
-         pure $ averageRows rows
-   liftEither =<< test
-
-testPretty :: forall a. Ann a => SE.Expr a -> MayFailT Aff Unit
+   gconfig <- blah progCxt
+   s <- open file
+   testPretty s
+   rows <- replicateM m $ do
+      trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
+      grRow <- testGraph s gconfig tconfig
+      pure $ BenchRow trRow grRow
+   pure $ averageRows rows
+
+testPretty :: forall m a. MonadAff m => MonadError Error m => Ann a => SE.Expr a -> m Unit
 testPretty s = do
    let src = prettyP s
    s' <- parse src program
    unless (eq (erase s) (erase s')) do
       log ("SRC\n" <> show (erase s))
       log ("NEW\n" <> show (erase s'))
-      lift $ fail "not equal"
+      fail "not equal"
 
-testTrace :: Raw SE.Expr -> Env Vertex -> TestConfig -> MayFailT Aff TraceRow
+testTrace :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> Env Vertex -> TestConfig -> m TraceRow
 testTrace s γ { δv, bwd_expect, fwd_expect } = do
    -- | Desugaring Galois connections for Unit and Boolean type selections
    GC desug <- desugGC s
@@ -111,18 +98,17 @@ testTrace s γ { δv, bwd_expect, fwd_expect } = do
    let v𝔹 = eval.fwd (γ𝔹 × e𝔹' × top)
    t_fwd2 <- preciseTime
 
-   lift do
-      -- | Check backward selections
-      unless (null bwd_expect) $
-         checkPretty "Trace-based source selection" bwd_expect s𝔹
-      -- | Check round-trip selections
-      unless (isGraphical v) do
-         when logging $ log (prettyP v𝔹)
-         checkPretty "Trace-based value" fwd_expect v𝔹
+   -- | Check backward selections
+   unless (null bwd_expect) $
+      checkPretty "Trace-based source selection" bwd_expect s𝔹
+   -- | Check round-trip selections
+   unless (isGraphical v) do
+      when logging $ log (prettyP v𝔹)
+      checkPretty "Trace-based value" fwd_expect v𝔹
 
    pure { tEval: tdiff t_eval1 t_eval2, tBwd: tdiff t_bwd1 t_bwd2, tFwd: tdiff t_fwd1 t_fwd2 }
 
-testGraph :: Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> MayFailT Aff GraphRow
+testGraph :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> m GraphRow
 testGraph s gconfig { δv, bwd_expect, fwd_expect } = do
    -- | Desugaring Galois connections for Unit and Boolean type selections
    GC desug <- desugGC s
@@ -179,21 +165,20 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } = do
       v𝔹_demorgan = select𝔹s vα (vertices gfwd_demorgan) <#> not
    t_fwdAsDeMorgan2 <- preciseTime
 
-   lift do
-      -- | Check backward selections
-      unless (null bwd_expect) do
-         checkPretty "Graph-based source selection" bwd_expect s𝔹
-      -- | Check round-trip selections
-      unless (isGraphical v𝔹) do
-         checkPretty "Graph-based value" fwd_expect v𝔹
-         checkPretty "Graph-based value (De Morgan)" fwd_expect v𝔹_demorgan
-      αs_out `shouldSatisfy "fwd ⚬ bwd round-tripping property"`
-         (flip subset αs_out')
-      -- | To avoid unused variables when benchmarking
-      when logging do
-         log (prettyP e𝔹_dual)
-         log (prettyP e𝔹_all)
-         log (prettyP v𝔹_dual)
+   -- | Check backward selections
+   unless (null bwd_expect) do
+      checkPretty "Graph-based source selection" bwd_expect s𝔹
+   -- | Check round-trip selections
+   unless (isGraphical v𝔹) do
+      checkPretty "Graph-based value" fwd_expect v𝔹
+      checkPretty "Graph-based value (De Morgan)" fwd_expect v𝔹_demorgan
+   αs_out `shouldSatisfy "fwd ⚬ bwd round-tripping property"`
+      (flip subset αs_out')
+   -- | To avoid unused variables when benchmarking
+   when logging do
+      log (prettyP e𝔹_dual)
+      log (prettyP e𝔹_all)
+      log (prettyP v𝔹_dual)
 
    pure
       { tEval: tdiff t_eval1 t_eval2

From b2dfffff6e967b58257a997233aebc290b2cf1c2 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 09:38:19 +0200
Subject: [PATCH 47/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Make=20cl?=
 =?UTF-8?q?earer=20relationship=20between=20old=20version=20of=20testWithS?=
 =?UTF-8?q?etup=20and=20new.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs |  6 +++---
 test/Util.purs  | 10 ++--------
 2 files changed, 5 insertions(+), 11 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index 72a915a39..cf4767396 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -119,7 +119,7 @@ eval_progCxt (ProgCxt { mods }) = do
 blah :: forall m g. Graph g => MonadError Error m => ProgCxt Unit -> m (GraphConfig g)
 blah progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
-         progCxt' <- alloc progCxt
-         γ <- eval_progCxt progCxt'
-         pure $ ProgCxtEval { progCxt: progCxt', γ }
+      progCxt' <- alloc progCxt
+      γ <- eval_progCxt progCxt'
+      pure $ ProgCxtEval { progCxt: progCxt', γ }
    pure { g, n, progCxt: progCxt' }
diff --git a/test/Util.purs b/test/Util.purs
index d413c4df6..61cb6c870 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -55,15 +55,9 @@ testWithSetup n file gconfig tconfig = do
    pure $ averageRows rows
 
 testWithSetup2 ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
-testWithSetup2 m file progCxt tconfig = do
+testWithSetup2 n file progCxt tconfig = do
    gconfig <- blah progCxt
-   s <- open file
-   testPretty s
-   rows <- replicateM m $ do
-      trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
-      grRow <- testGraph s gconfig tconfig
-      pure $ BenchRow trRow grRow
-   pure $ averageRows rows
+   testWithSetup n file gconfig tconfig
 
 testPretty :: forall m a. MonadAff m => MonadError Error m => Ann a => SE.Expr a -> m Unit
 testPretty s = do

From 54b429a8c4aac21a02ac9e9fb385c2947459a02a Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 09:43:07 +0200
Subject: [PATCH 48/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Remove=20one?=
 =?UTF-8?q?=20use=20of=20old=20openDefaultImports.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 4 ++--
 src/Module.purs  | 8 ++++----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 8cce1b272..24f5ba484 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -31,7 +31,7 @@ import Expr (Expr)
 import Foreign.Object (lookup)
 import Graph.GraphImpl (GraphImpl)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
-import Module (File(..), Folder(..), loadFile, open, openDatasetAs, openDefaultImports)
+import Module (File(..), Folder(..), blah, defaultImports2, loadFile, open, openDatasetAs, openDefaultImports)
 import Partial.Unsafe (unsafePartial)
 import Pretty (prettyP)
 import Primitive (matrixRep) as P
@@ -190,7 +190,7 @@ linkResult x γ0γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   { progCxt: ProgCxtEval { γ } } :: GraphConfig GraphImpl <- openDefaultImports
+   { progCxt: ProgCxtEval { γ } } :: GraphConfig GraphImpl <- defaultImports2 >>= blah
    let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
diff --git a/src/Module.purs b/src/Module.purs
index cf4767396..5187c0fba 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -53,11 +53,11 @@ loadFile (Folder folder) (File file) = do
 parse :: forall a m. MonadError Error m => String -> SParser a -> m a
 parse src = liftEither <<< mapLeft (E.error <<< show) <<< runParser src
 
-parseProgram :: forall m. MonadAff m => MonadError Error m => Folder -> File -> m (S.Expr Unit)
+parseProgram :: forall m. MonadAff m => MonadError Error m => Folder -> File -> m (Raw S.Expr)
 parseProgram folder file =
    loadFile folder file >>= flip parse program
 
-open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
+open :: forall m. MonadAff m => MonadError Error m => File -> m (Raw S.Expr)
 open = parseProgram (Folder "fluid/example")
 
 loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxtEval Vertex -> m (ProgCxtEval Vertex)
@@ -86,7 +86,7 @@ defaultImports2 =
       >>= loadModule2 (File "graphics")
       >>= loadModule2 (File "convolution")
 
-loadDataset :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (ProgCxt Unit)
+loadDataset :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (Raw ProgCxt)
 loadDataset file (ProgCxt r@{ datasets }) = do
    dataset <- parseProgram (Folder "fluid") file >>= desug
    pure $ ProgCxt r { datasets = dataset : datasets }
@@ -116,7 +116,7 @@ eval_progCxt (ProgCxt { mods }) = do
       γ' <- eval_module γ mod empty
       pure $ γ <+> γ'
 
-blah :: forall m g. Graph g => MonadError Error m => ProgCxt Unit -> m (GraphConfig g)
+blah :: forall m g. Graph g => MonadError Error m => Raw ProgCxt -> m (GraphConfig g)
 blah progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
       progCxt' <- alloc progCxt

From e28cdff73f74f2ad1dd7884d7f7ead7bda30847e Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Wed, 4 Oct 2023 10:33:46 +0200
Subject: [PATCH 49/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20loadLinkF?=
 =?UTF-8?q?ig.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 24f5ba484..08a440323 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -210,14 +210,12 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
-      γ0 = botOf <$> γ
-      xv0 = botOf <$> xv
-      γ' = γ0 <+> xv0
+      γ0 = botOf <$> (γ <+> xv)
       s1 = botOf s1'
       s2 = botOf s2'
    dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- use surface expression instead
    e1 × e2 <- (×) <$> desug s1 <*> desug s2
-   t1 × v1 <- eval γ' e1 bot
-   t2 × v2 <- eval γ' e2 bot
-   let v0 = get x xv0
-   pure { spec, γ: γ', s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }
+   t1 × v1 <- eval γ0 e1 bot
+   t2 × v2 <- eval γ0 e2 bot
+   let v0 = get x γ0
+   pure { spec, γ: γ0, s1, s2, e1, e2, t1, t2, v1, v2, v0, dataFile: dataFile' }

From 8134a4891db7a91b769b45b8d0813101a2c921b4 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 08:13:00 +0200
Subject: [PATCH 50/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Migrate?=
 =?UTF-8?q?=20withDatasetMany=20to=20new=20progCxt=20machinery.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Module.purs | 46 ++++++++++++++++++++++++++--------------------
 src/Val.purs    |  7 ++++---
 test/Many.purs  | 25 +++++++++++--------------
 3 files changed, 41 insertions(+), 37 deletions(-)

diff --git a/src/Module.purs b/src/Module.purs
index 5187c0fba..cbcba6bd4 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -5,7 +5,7 @@ import Prelude
 import Affjax.ResponseFormat (string)
 import Affjax.Web (defaultRequest, printError, request)
 import Ann (Raw)
-import Bindings (Var)
+import Bindings (Bind, Var, (↦))
 import Control.Monad.Error.Class (liftEither, throwError)
 import Control.Monad.Except (class MonadError)
 import Data.Either (Either(..))
@@ -20,11 +20,11 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error)
 import Effect.Exception (error) as E
 import EvalGraph (GraphConfig, eval, eval_module)
-import Expr (Module)
+import Expr (Expr, Module)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
 import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, fresh, runWithGraphAllocT)
-import Parse (module_, program)
+import Parse (module_, program) as P
 import Parsing (runParser)
 import Primitive.Defs (primitives)
 import SExpr (Expr) as S
@@ -55,7 +55,7 @@ parse src = liftEither <<< mapLeft (E.error <<< show) <<< runParser src
 
 parseProgram :: forall m. MonadAff m => MonadError Error m => Folder -> File -> m (Raw S.Expr)
 parseProgram folder file =
-   loadFile folder file >>= flip parse program
+   loadFile folder file >>= flip parse P.program
 
 open :: forall m. MonadAff m => MonadError Error m => File -> m (Raw S.Expr)
 open = parseProgram (Folder "fluid/example")
@@ -63,7 +63,7 @@ open = parseProgram (Folder "fluid/example")
 loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxtEval Vertex -> m (ProgCxtEval Vertex)
 loadModule file (ProgCxtEval r@{ progCxt: ProgCxt r'@{ mods }, γ }) = do
    src <- loadFile (Folder "fluid/lib") file
-   mod <- parse src module_ >>= desugarModuleFwd >>= traverse (const fresh)
+   mod <- parse src P.module_ >>= desugarModuleFwd >>= traverse (const fresh)
    γ' <- eval_module γ mod empty
    pure $ ProgCxtEval r { progCxt = ProgCxt r' { mods = mod : mods }, γ = γ <+> γ' }
 
@@ -74,22 +74,23 @@ defaultImports = do
       >>= loadModule (File "graphics")
       >>= loadModule (File "convolution")
 
-loadModule2 :: forall m. MonadAff m => MonadError Error m => File -> Raw ProgCxt -> m (Raw ProgCxt)
-loadModule2 file (ProgCxt r@{ mods }) = do
+module_ :: forall m. MonadAff m => MonadError Error m => File -> Raw ProgCxt -> m (Raw ProgCxt)
+module_ file (ProgCxt r@{ mods }) = do
    src <- loadFile (Folder "fluid/lib") file
-   mod <- parse src module_ >>= desugarModuleFwd
+   mod <- parse src P.module_ >>= desugarModuleFwd
    pure $ ProgCxt r { mods = mod : mods }
 
 defaultImports2 :: forall m. MonadAff m => MonadError Error m => m (Raw ProgCxt)
 defaultImports2 =
-   loadModule2 (File "prelude") (ProgCxt { mods: Nil, datasets: Nil })
-      >>= loadModule2 (File "graphics")
-      >>= loadModule2 (File "convolution")
+   pure (ProgCxt { mods: Nil, datasets: Nil })
+      >>= module_ (File "prelude")
+      >>= module_ (File "graphics")
+      >>= module_ (File "convolution")
 
-loadDataset :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> Raw ProgCxt -> m (Raw ProgCxt)
-loadDataset file (ProgCxt r@{ datasets }) = do
-   dataset <- parseProgram (Folder "fluid") file >>= desug
-   pure $ ProgCxt r { datasets = dataset : datasets }
+datasetAs :: forall m. MonadAff m => MonadError Error m => File -> Var -> Raw ProgCxt -> m (Raw ProgCxt)
+datasetAs file x (ProgCxt r@{ datasets }) = do
+   eα <- parseProgram (Folder "fluid") file >>= desug
+   pure $ ProgCxt r { datasets = x ↦ eα : datasets }
 
 openDefaultImports :: forall m g. MonadAff m => MonadError Error m => Graph g => m (GraphConfig g)
 openDefaultImports = do
@@ -103,19 +104,24 @@ openDatasetAs file x { g, n, progCxt: ProgCxtEval r@{ progCxt: ProgCxt r'@{ data
       runWithGraphAllocT (g × n) do
          eα <- desug s >>= alloc
          v <- eval γ eα empty
-         pure $ D.singleton x v × ProgCxtEval (r { progCxt = ProgCxt (r' { datasets = eα : datasets }) })
+         pure $ D.singleton x v × ProgCxtEval (r { progCxt = ProgCxt (r' { datasets = x ↦ eα : datasets }) })
    pure ({ g: g', n: n', progCxt } × xv)
 
 eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
-eval_progCxt (ProgCxt { mods }) = do
+eval_progCxt (ProgCxt { mods, datasets }) =
    traverse alloc primitives
-      >>= concatM (reverse mods <#> addDefs)
+      >>= concatM ((reverse mods <#> addModule) <> (reverse datasets <#> addDataset))
    where
-   addDefs :: Module Vertex -> Env Vertex -> m (Env Vertex)
-   addDefs mod γ = do
+   addModule :: Module Vertex -> Env Vertex -> m (Env Vertex)
+   addModule mod γ = do
       γ' <- eval_module γ mod empty
       pure $ γ <+> γ'
 
+   addDataset :: Bind (Expr Vertex) -> Env Vertex -> m (Env Vertex)
+   addDataset (x ↦ e) γ = do
+      v <- eval γ e empty
+      pure $ γ <+> D.singleton x v
+
 blah :: forall m g. Graph g => MonadError Error m => Raw ProgCxt -> m (GraphConfig g)
 blah progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
diff --git a/src/Val.purs b/src/Val.purs
index d34850cc4..23831ca8d 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -2,7 +2,7 @@ module Val where
 
 import Prelude hiding (absurd, append)
 
-import Bindings (Var)
+import Bindings (Bind, Var)
 import Control.Apply (lift2)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Data.Array ((!!))
@@ -12,6 +12,7 @@ import Data.Exists (Exists)
 import Data.Foldable (class Foldable, foldl, foldrDefault, foldMapDefaultL)
 import Data.List (List(..), (:), zipWith)
 import Data.Newtype (class Newtype)
+import Data.Profunctor.Strong (second)
 import Data.Set (Set, empty, fromFoldable, intersection, member, singleton, toUnfoldable, union)
 import Data.Traversable (class Traversable, sequenceDefault, traverse)
 import DataType (Ctr)
@@ -80,7 +81,7 @@ newtype ProgCxtEval a = ProgCxtEval
 
 newtype ProgCxt a = ProgCxt
    { mods :: List (Module a) -- in reverse order
-   , datasets :: List (Expr a)
+   , datasets :: List (Bind (Expr a))
    }
 
 -- Want a monoid instance but needs a newtype
@@ -192,7 +193,7 @@ instance Apply ProgCxt where
    apply (ProgCxt { mods: fmods, datasets: fdatasets }) (ProgCxt { mods, datasets }) =
       ProgCxt
          { mods: fmods `zipWith (<*>)` mods
-         , datasets: fdatasets `zipWith (<*>)` datasets
+         , datasets: (second (<*>) <$> fdatasets) `zipWith (<*>)` datasets
          }
 
 instance Foldable DictRep where
diff --git a/test/Many.purs b/test/Many.purs
index d687fdea2..94d46b9d3 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -6,10 +6,9 @@ import App.Fig (linkResult, loadLinkFig)
 import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
-import Module (File(..), Folder(..), defaultImports2, loadFile, openDatasetAs, openDefaultImports)
-import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup, testWithSetup2)
-import Util (type (×), (×))
-import Val (ProgCxtEval(..), (<+>))
+import Module (File(..), Folder(..), datasetAs, defaultImports2, loadFile)
+import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup2)
+import Util (type (×))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many specs n = zip (specs <#> _.file) (specs <#> one)
@@ -19,28 +18,26 @@ many specs n = zip (specs <#> _.file) (specs <#> one)
       testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
-bwdMany specs n = zip (specs <#> _.file) (specs <#> bwdOne)
+bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
    folder = File "slicing/"
-   bwdOne { file, file_expect, δv, fwd_expect } = do
+   one { file, file_expect, δv, fwd_expect } = do
       progCxt <- defaultImports2
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
       testWithSetup2 n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
-withDatasetMany specs n = zip (specs <#> _.file) (specs <#> withDatasetOne)
+withDatasetMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
-   withDatasetOne { dataset, file } = do
-      -- TODO: make progCxt consistent with addition of xv
-      gconfig@{ progCxt: ProgCxtEval r@{ γ } } × xv <- openDefaultImports >>= openDatasetAs (File dataset) "data"
-      testWithSetup n (File file) gconfig { progCxt = ProgCxtEval r { γ = γ <+> xv } }
-         { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+   one { dataset, file } = do
+      progCxt <- defaultImports2 >>= datasetAs (File dataset) "data"
+      testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
-linkMany specs = zip (specs <#> name) (specs <#> linkOne)
+linkMany specs = zip (specs <#> name) (specs <#> one)
    where
    name spec = "linking/" <> show spec.spec.file1 <> "<->" <> show spec.spec.file2
-   linkOne { spec, δv1, v2_expect } = do
+   one { spec, δv1, v2_expect } = do
       { γ, e1, e2, t1, t2, v1 } <- loadLinkFig spec
       { v': v2' } <- linkResult spec.x γ e1 e2 t1 t2 (δv1 v1)
       checkPretty "Linked output" v2_expect v2'

From 57ee0b475f461aa7657d9d2760004e93cdc1fe52 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 08:22:14 +0200
Subject: [PATCH 51/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Fully=20m?=
 =?UTF-8?q?igrate=20to=20ProgCxt.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 11 ++++-------
 src/Module.purs  |  3 ++-
 2 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 08a440323..c6e3a7919 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -26,12 +26,10 @@ import Effect.Console (log)
 import Effect.Exception (Error)
 import Eval (eval, eval_module)
 import EvalBwd (evalBwd)
-import EvalGraph (GraphConfig)
 import Expr (Expr)
 import Foreign.Object (lookup)
-import Graph.GraphImpl (GraphImpl)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
-import Module (File(..), Folder(..), blah, defaultImports2, loadFile, open, openDatasetAs, openDefaultImports)
+import Module (File(..), Folder(..), blah, datasetAs, defaultImports2, loadFile, open)
 import Partial.Unsafe (unsafePartial)
 import Pretty (prettyP)
 import Primitive (matrixRep) as P
@@ -190,7 +188,7 @@ linkResult x γ0γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   { progCxt: ProgCxtEval { γ } } :: GraphConfig GraphImpl <- defaultImports2 >>= blah
+   { progCxt: ProgCxtEval { γ } } <- defaultImports2 >>= blah
    let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
@@ -206,11 +204,10 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
    -- views share ambient environment γ as well as dataset
-   { progCxt: ProgCxtEval { γ } } × xv :: GraphConfig GraphImpl × _ <-
-      openDefaultImports >>= openDatasetAs (File "example/" <> dir <> dataFile) x
+   { progCxt: ProgCxtEval { γ } } <- defaultImports2 >>= datasetAs (File "example/" <> dir <> dataFile) x >>= blah
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
-      γ0 = botOf <$> (γ <+> xv)
+      γ0 = botOf <$> γ
       s1 = botOf s1'
       s2 = botOf s2'
    dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- use surface expression instead
diff --git a/src/Module.purs b/src/Module.purs
index cbcba6bd4..b86e283eb 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -23,6 +23,7 @@ import EvalGraph (GraphConfig, eval, eval_module)
 import Expr (Expr, Module)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
+import Graph.GraphImpl (GraphImpl)
 import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, fresh, runWithGraphAllocT)
 import Parse (module_, program) as P
 import Parsing (runParser)
@@ -122,7 +123,7 @@ eval_progCxt (ProgCxt { mods, datasets }) =
       v <- eval γ e empty
       pure $ γ <+> D.singleton x v
 
-blah :: forall m g. Graph g => MonadError Error m => Raw ProgCxt -> m (GraphConfig g)
+blah :: forall m. MonadError Error m => Raw ProgCxt -> m (GraphConfig GraphImpl)
 blah progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
       progCxt' <- alloc progCxt

From 2a4699bad562997246ad3e7b75cc8e9e909e90a6 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 08:24:56 +0200
Subject: [PATCH 52/57] =?UTF-8?q?=F0=9F=A7=A9=20[remove-unused]:=20Old=20i?=
 =?UTF-8?q?mplementation.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs |  6 +++---
 src/Module.purs  | 39 +++++----------------------------------
 test/Many.purs   |  8 ++++----
 3 files changed, 12 insertions(+), 41 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index c6e3a7919..dc2ff4797 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -29,7 +29,7 @@ import EvalBwd (evalBwd)
 import Expr (Expr)
 import Foreign.Object (lookup)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
-import Module (File(..), Folder(..), blah, datasetAs, defaultImports2, loadFile, open)
+import Module (File(..), Folder(..), blah, datasetAs, defaultImports, loadFile, open)
 import Partial.Unsafe (unsafePartial)
 import Pretty (prettyP)
 import Primitive (matrixRep) as P
@@ -188,7 +188,7 @@ linkResult x γ0γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   { progCxt: ProgCxtEval { γ } } <- defaultImports2 >>= blah
+   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= blah
    let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
@@ -204,7 +204,7 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
    -- views share ambient environment γ as well as dataset
-   { progCxt: ProgCxtEval { γ } } <- defaultImports2 >>= datasetAs (File "example/" <> dir <> dataFile) x >>= blah
+   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= datasetAs (File "example/" <> dir <> dataFile) x >>= blah
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
       γ0 = botOf <$> γ
diff --git a/src/Module.purs b/src/Module.purs
index b86e283eb..67eae1f66 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -21,16 +21,16 @@ import Effect.Exception (Error)
 import Effect.Exception (error) as E
 import EvalGraph (GraphConfig, eval, eval_module)
 import Expr (Expr, Module)
-import Graph (class Graph, Vertex)
+import Graph (Vertex)
 import Graph (empty) as G
 import Graph.GraphImpl (GraphImpl)
-import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, fresh, runWithGraphAllocT)
+import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, runWithGraphAllocT)
 import Parse (module_, program) as P
 import Parsing (runParser)
 import Primitive.Defs (primitives)
 import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
-import Util (type (×), (×), concatM, mapLeft)
+import Util ((×), concatM, mapLeft)
 import Util.Parse (SParser)
 import Val (Env, ProgCxt(..), ProgCxtEval(..), (<+>))
 
@@ -61,28 +61,14 @@ parseProgram folder file =
 open :: forall m. MonadAff m => MonadError Error m => File -> m (Raw S.Expr)
 open = parseProgram (Folder "fluid/example")
 
-loadModule :: forall m. MonadAff m => MonadWithGraphAlloc m => File -> ProgCxtEval Vertex -> m (ProgCxtEval Vertex)
-loadModule file (ProgCxtEval r@{ progCxt: ProgCxt r'@{ mods }, γ }) = do
-   src <- loadFile (Folder "fluid/lib") file
-   mod <- parse src P.module_ >>= desugarModuleFwd >>= traverse (const fresh)
-   γ' <- eval_module γ mod empty
-   pure $ ProgCxtEval r { progCxt = ProgCxt r' { mods = mod : mods }, γ = γ <+> γ' }
-
-defaultImports :: forall m. MonadAff m => MonadWithGraphAlloc m => m (ProgCxtEval Vertex)
-defaultImports = do
-   γ <- traverse alloc primitives
-   loadModule (File "prelude") (ProgCxtEval { progCxt: ProgCxt { mods: Nil, datasets: Nil }, γ })
-      >>= loadModule (File "graphics")
-      >>= loadModule (File "convolution")
-
 module_ :: forall m. MonadAff m => MonadError Error m => File -> Raw ProgCxt -> m (Raw ProgCxt)
 module_ file (ProgCxt r@{ mods }) = do
    src <- loadFile (Folder "fluid/lib") file
    mod <- parse src P.module_ >>= desugarModuleFwd
    pure $ ProgCxt r { mods = mod : mods }
 
-defaultImports2 :: forall m. MonadAff m => MonadError Error m => m (Raw ProgCxt)
-defaultImports2 =
+defaultImports :: forall m. MonadAff m => MonadError Error m => m (Raw ProgCxt)
+defaultImports =
    pure (ProgCxt { mods: Nil, datasets: Nil })
       >>= module_ (File "prelude")
       >>= module_ (File "graphics")
@@ -93,21 +79,6 @@ datasetAs file x (ProgCxt r@{ datasets }) = do
    eα <- parseProgram (Folder "fluid") file >>= desug
    pure $ ProgCxt r { datasets = x ↦ eα : 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
-   pure { g, n, progCxt }
-
-openDatasetAs :: forall m g. MonadAff m => MonadError Error m => Graph g => File -> Var -> GraphConfig g -> m (GraphConfig g × Env Vertex)
-openDatasetAs file x { g, n, progCxt: ProgCxtEval r@{ progCxt: ProgCxt r'@{ datasets }, γ } } = do
-   s <- parseProgram (Folder "fluid") file
-   (g' × n') × xv × progCxt <-
-      runWithGraphAllocT (g × n) do
-         eα <- desug s >>= alloc
-         v <- eval γ eα empty
-         pure $ D.singleton x v × ProgCxtEval (r { progCxt = ProgCxt (r' { datasets = x ↦ eα : datasets }) })
-   pure ({ g: g', n: n', progCxt } × xv)
-
 eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
 eval_progCxt (ProgCxt { mods, datasets }) =
    traverse alloc primitives
diff --git a/test/Many.purs b/test/Many.purs
index 94d46b9d3..4bfaec19d 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -6,7 +6,7 @@ import App.Fig (linkResult, loadLinkFig)
 import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
-import Module (File(..), Folder(..), datasetAs, defaultImports2, loadFile)
+import Module (File(..), Folder(..), datasetAs, defaultImports, loadFile)
 import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup2)
 import Util (type (×))
 
@@ -14,7 +14,7 @@ many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
 many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
-      progCxt <- defaultImports2
+      progCxt <- defaultImports
       testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
@@ -22,7 +22,7 @@ bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
    folder = File "slicing/"
    one { file, file_expect, δv, fwd_expect } = do
-      progCxt <- defaultImports2
+      progCxt <- defaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
       testWithSetup2 n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
 
@@ -30,7 +30,7 @@ withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff Benc
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { dataset, file } = do
-      progCxt <- defaultImports2 >>= datasetAs (File dataset) "data"
+      progCxt <- defaultImports >>= datasetAs (File dataset) "data"
       testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)

From ec028badb5e5133215bb9f4b40bf904fe568ca4c Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 08:45:27 +0200
Subject: [PATCH 53/57] =?UTF-8?q?=F0=9F=A7=A9=20[move]:=20ProgCxt=20->=20E?=
 =?UTF-8?q?xpr;=20ProgCxtEval=20->=20GraphEval.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs   |  3 ++-
 src/EvalGraph.purs | 39 ++++++++++++++++++++++++++++++++++-----
 src/Expr.purs      | 24 +++++++++++++++++++++++-
 src/Module.purs    | 34 ++++++++--------------------------
 src/Val.purs       | 28 ----------------------------
 test/Util.purs     |  3 ++-
 6 files changed, 69 insertions(+), 62 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index dc2ff4797..cd0704ab7 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -26,6 +26,7 @@ import Effect.Console (log)
 import Effect.Exception (Error)
 import Eval (eval, eval_module)
 import EvalBwd (evalBwd)
+import EvalGraph (ProgCxtEval(..))
 import Expr (Expr)
 import Foreign.Object (lookup)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
@@ -37,7 +38,7 @@ import SExpr (Expr(..), Module(..), RecDefs, VarDefs) as S
 import SExpr (desugarModuleFwd)
 import Trace (Trace)
 import Util (type (×), type (+), (×), absurd, error, orElse)
-import Val (class Ann, Env, ProgCxtEval(..), Val(..), append_inv, (<+>))
+import Val (class Ann, Env, Val(..), append_inv, (<+>))
 import Web.Event.EventTarget (eventListener)
 
 data View
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 17ddc67ae..7d0bf5deb 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -1,8 +1,10 @@
 module EvalGraph
    ( GraphConfig
+   , ProgCxtEval(..)
    , apply
    , eval
    , eval_module
+   , eval_progCxt
    , graphGC
    , match
    , patternMismatch
@@ -10,12 +12,13 @@ module EvalGraph
 
 import Prelude hiding (apply, add)
 
-import Bindings (varAnon)
+import Bindings (Bind, (↦), varAnon)
 import Control.Monad.Error.Class (class MonadError)
 import Data.Array (range, singleton) as A
 import Data.Either (Either(..))
 import Data.Exists (runExists)
-import Data.List (List(..), length, snoc, unzip, zip, (:))
+import Data.List (List(..), length, reverse, snoc, unzip, zip, (:))
+import Data.Newtype (class Newtype)
 import Data.Set (Set, empty, insert, intersection, singleton, union)
 import Data.Set as S
 import Data.Traversable (sequence, traverse)
@@ -23,7 +26,7 @@ import Data.Tuple (fst)
 import DataType (checkArity, arity, consistentWith, dataTypeFor, showCtr)
 import Dict (disjointUnion, fromFoldable, empty, get, keys, lookup, singleton) as D
 import Effect.Exception (Error)
-import Expr (Cont(..), Elim(..), Expr(..), VarDef(..), RecDefs, Module(..), fv, asExpr)
+import Expr (Cont(..), Elim(..), Expr(..), Module(..), ProgCxt(..), RecDefs, VarDef(..), asExpr, fv)
 import GaloisConnection (GaloisConnection(..))
 import Graph (class Graph, Vertex, sinks, vertices)
 import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, new, runWithGraphAllocT)
@@ -31,11 +34,17 @@ import Graph.Slice (bwdSlice, fwdSlice)
 import Lattice (Raw)
 import Pretty (prettyP)
 import Primitive (string, intPair)
-import Util (type (×), check, error, orElse, successful, throw, with, (×))
+import Util (type (×), check, concatM, error, orElse, successful, throw, with, (×))
 import Util.Pair (unzip) as P
-import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), ProgCxtEval(..), Val, for, lookup', restrict, (<+>))
+import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), Val, for, lookup', restrict, (<+>))
 import Val (Fun(..), Val(..)) as V
 
+-- Combine these two in some way?
+newtype ProgCxtEval a = ProgCxtEval
+   { progCxt :: ProgCxt a
+   , γ :: Env a
+   }
+
 type GraphConfig g =
    { g :: g
    , n :: Int
@@ -172,6 +181,20 @@ eval_module γ = go D.empty
       γ'' <- closeDefs (γ <+> γ') ρ αs
       go (γ' <+> γ'') (Module ds) αs
 
+eval_progCxt :: forall m. MonadWithGraphAlloc m => Env Vertex -> ProgCxt Vertex -> m (Env Vertex)
+eval_progCxt primitives (ProgCxt { mods, datasets }) =
+   flip concatM primitives ((reverse mods <#> addModule) <> (reverse datasets <#> addDataset))
+   where
+   addModule :: Module Vertex -> Env Vertex -> m (Env Vertex)
+   addModule mod γ = do
+      γ' <- eval_module γ mod empty
+      pure $ γ <+> γ'
+
+   addDataset :: Bind (Expr Vertex) -> Env Vertex -> m (Env Vertex)
+   addDataset (x ↦ e) γ = do
+      v <- eval γ e empty
+      pure $ γ <+> D.singleton x v
+
 type GraphEval g =
    { gc :: GaloisConnection (Set Vertex) (Set Vertex)
    , γα :: Env Vertex
@@ -199,3 +222,9 @@ graphGC { g, n, progCxt: ProgCxtEval { γ } } e = do
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    --   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
    pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }
+
+-- ======================
+-- boilerplate
+-- ======================
+derive instance Newtype (ProgCxtEval a) _
+derive instance Functor ProgCxtEval
diff --git a/src/Expr.purs b/src/Expr.purs
index 8269e569b..a7fce7fee 100644
--- a/src/Expr.purs
+++ b/src/Expr.purs
@@ -2,12 +2,13 @@ module Expr where
 
 import Prelude hiding (absurd, top)
 
-import Bindings (Var)
+import Bindings (Bind, Var)
 import Control.Apply (lift2)
 import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldl, foldrDefault, foldMapDefaultL)
 import Data.List (List(..), (:), zipWith)
 import Data.Newtype (class Newtype, unwrap)
+import Data.Profunctor.Strong (second)
 import Data.Set (Set, difference, empty, singleton, union, unions)
 import Data.Set (fromFoldable) as S
 import Data.Traversable (class Traversable, sequenceDefault, traverse)
@@ -62,6 +63,12 @@ asExpr _ = error "Expression expected"
 
 newtype Module a = Module (List (VarDef a + RecDefs a))
 
+-- Bunch of loaded modules (and datasets, reflecting current ad hoc approach to that).
+newtype ProgCxt a = ProgCxt
+   { mods :: List (Module a) -- in reverse order
+   , datasets :: List (Bind (Expr a))
+   }
+
 class FV a where
    fv :: a -> Set Var
 
@@ -131,6 +138,9 @@ derive instance Foldable Expr
 derive instance Traversable Expr
 derive instance Newtype (Module a) _
 derive instance Functor Module
+derive instance Newtype (ProgCxt a) _
+derive instance Functor ProgCxt
+derive instance Traversable ProgCxt
 
 derive instance Eq a => Eq (Expr a)
 derive instance Eq a => Eq (VarDef a)
@@ -199,6 +209,18 @@ instance Traversable Module where
 
    sequence = sequenceDefault
 
+instance Apply ProgCxt where
+   apply (ProgCxt { mods: fmods, datasets: fdatasets }) (ProgCxt { mods, datasets }) =
+      ProgCxt
+         { mods: fmods `zipWith (<*>)` mods
+         , datasets: (second (<*>) <$> fdatasets) `zipWith (<*>)` datasets
+         }
+
+instance Foldable ProgCxt where
+   foldl f acc (ProgCxt { mods }) = foldl (foldl f) acc mods
+   foldr f = foldrDefault f
+   foldMap f = foldMapDefaultL f
+
 instance JoinSemilattice a => JoinSemilattice (Elim a) where
    maybeJoin (ElimVar x κ) (ElimVar x' κ') = ElimVar <$> (x ≞ x') <*> maybeJoin κ κ'
    maybeJoin (ElimConstr cκs) (ElimConstr cκs') =
diff --git a/src/Module.purs b/src/Module.purs
index 67eae1f66..e25505ba0 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -5,34 +5,30 @@ import Prelude
 import Affjax.ResponseFormat (string)
 import Affjax.Web (defaultRequest, printError, request)
 import Ann (Raw)
-import Bindings (Bind, Var, (↦))
+import Bindings (Var, (↦))
 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(..), reverse, (:))
+import Data.List (List(..), (:))
 import Data.Newtype (class Newtype)
-import Data.Set (empty)
 import Data.Traversable (traverse)
 import Desugarable (desug)
-import Dict (singleton) as D
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error)
 import Effect.Exception (error) as E
-import EvalGraph (GraphConfig, eval, eval_module)
-import Expr (Expr, Module)
-import Graph (Vertex)
+import EvalGraph (GraphConfig, ProgCxtEval(..), eval_progCxt)
+import Expr (ProgCxt(..))
 import Graph (empty) as G
 import Graph.GraphImpl (GraphImpl)
-import Graph.GraphWriter (class MonadWithGraphAlloc, alloc, runWithGraphAllocT)
+import Graph.GraphWriter (alloc, runWithGraphAllocT)
 import Parse (module_, program) as P
 import Parsing (runParser)
 import Primitive.Defs (primitives)
 import SExpr (Expr) as S
 import SExpr (desugarModuleFwd)
-import Util ((×), concatM, mapLeft)
+import Util ((×), mapLeft)
 import Util.Parse (SParser)
-import Val (Env, ProgCxt(..), ProgCxtEval(..), (<+>))
 
 -- Mainly serve as documentation
 newtype File = File String
@@ -79,25 +75,11 @@ datasetAs file x (ProgCxt r@{ datasets }) = do
    eα <- parseProgram (Folder "fluid") file >>= desug
    pure $ ProgCxt r { datasets = x ↦ eα : datasets }
 
-eval_progCxt :: forall m. MonadWithGraphAlloc m => ProgCxt Vertex -> m (Env Vertex)
-eval_progCxt (ProgCxt { mods, datasets }) =
-   traverse alloc primitives
-      >>= concatM ((reverse mods <#> addModule) <> (reverse datasets <#> addDataset))
-   where
-   addModule :: Module Vertex -> Env Vertex -> m (Env Vertex)
-   addModule mod γ = do
-      γ' <- eval_module γ mod empty
-      pure $ γ <+> γ'
-
-   addDataset :: Bind (Expr Vertex) -> Env Vertex -> m (Env Vertex)
-   addDataset (x ↦ e) γ = do
-      v <- eval γ e empty
-      pure $ γ <+> D.singleton x v
-
 blah :: forall m. MonadError Error m => Raw ProgCxt -> m (GraphConfig GraphImpl)
 blah progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
       progCxt' <- alloc progCxt
-      γ <- eval_progCxt progCxt'
+      primitives' <- traverse alloc primitives
+      γ <- eval_progCxt primitives' progCxt'
       pure $ ProgCxtEval { progCxt: progCxt', γ }
    pure { g, n, progCxt: progCxt' }
diff --git a/src/Val.purs b/src/Val.purs
index 23831ca8d..e7dd6043b 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -73,17 +73,6 @@ type Env a = Dict (Val a)
 lookup' :: forall a m. MonadThrow Error m => Var -> Dict a -> m a
 lookup' x γ = lookup x γ # orElse ("variable " <> x <> " not found")
 
--- Bunch of loaded modules and datasets, reflecting current somewhat ad hoc approach.
-newtype ProgCxtEval a = ProgCxtEval
-   { progCxt :: ProgCxt a
-   , γ :: Env a
-   }
-
-newtype ProgCxt a = ProgCxt
-   { mods :: List (Module a) -- in reverse order
-   , datasets :: List (Bind (Expr a))
-   }
-
 -- Want a monoid instance but needs a newtype
 append :: forall a. Env a -> Endo (Env a)
 append = unionWith (const identity)
@@ -152,11 +141,6 @@ instance Highlightable Vertex where
 derive instance Functor DictRep
 derive instance Functor MatrixRep
 derive instance Functor Val
-derive instance Newtype (ProgCxt a) _
-derive instance Functor ProgCxt
-derive instance Newtype (ProgCxtEval a) _
-derive instance Functor ProgCxtEval
-derive instance Traversable ProgCxt
 derive instance Foldable Val
 derive instance Traversable Val
 derive instance Functor Fun
@@ -189,13 +173,6 @@ instance Apply MatrixRep where
    apply (MatrixRep (fvss × (n × fnα) × (m × fmα))) (MatrixRep (vss × (n' × nα) × (m' × mα))) =
       MatrixRep $ (A.zipWith (A.zipWith (<*>)) fvss vss) × ((n ≜ n') × fnα nα) × ((m ≜ m') × fmα mα)
 
-instance Apply ProgCxt where
-   apply (ProgCxt { mods: fmods, datasets: fdatasets }) (ProgCxt { mods, datasets }) =
-      ProgCxt
-         { mods: fmods `zipWith (<*>)` mods
-         , datasets: (second (<*>) <$> fdatasets) `zipWith (<*>)` datasets
-         }
-
 instance Foldable DictRep where
    foldl f acc (DictRep d) = foldl (\acc' (a × v) -> foldl f (acc' `f` a) v) acc d
    foldr f = foldrDefault f
@@ -217,11 +194,6 @@ instance Traversable MatrixRep where
          m
    sequence = sequenceDefault
 
-instance Foldable ProgCxt where
-   foldl f acc (ProgCxt { mods }) = foldl (foldl f) acc mods
-   foldr f = foldrDefault f
-   foldMap f = foldMapDefaultL f
-
 instance JoinSemilattice a => JoinSemilattice (DictRep a) where
    maybeJoin (DictRep svs) (DictRep svs') = DictRep <$> maybeJoin svs svs'
    join v = definedJoin v
diff --git a/test/Util.purs b/test/Util.purs
index 61cb6c870..754a01b77 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -21,6 +21,7 @@ import Effect.Class.Console (log)
 import Effect.Exception (Error)
 import EvalBwd (traceGC)
 import EvalGraph (GraphConfig, graphGC)
+import Expr (ProgCxt)
 import GaloisConnection (GaloisConnection(..))
 import Graph (Vertex, selectαs, select𝔹s, sinks, vertices)
 import Graph.GraphImpl (GraphImpl)
@@ -33,7 +34,7 @@ import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
 import Test.Spec.Assertions (fail)
 import Util (successful, (×))
-import Val (class Ann, Env, ProgCxt, Val(..))
+import Val (class Ann, Env, Val(..))
 
 type TestConfig =
    { δv :: Selector Val

From 456819b7f1c95d5eade441662ec8593467c1aaed Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 08:52:18 +0200
Subject: [PATCH 54/57] =?UTF-8?q?=F0=9F=A7=A9=20[refactor]:=20Remove=20old?=
 =?UTF-8?q?=20testWithSetup;=20blah=20->=20initialConfig.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs | 10 +++++-----
 src/Module.purs  |  4 ++--
 test/Many.purs   |  8 ++++----
 test/Util.purs   | 12 ++++--------
 4 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index cd0704ab7..2b5026291 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -30,7 +30,7 @@ import EvalGraph (ProgCxtEval(..))
 import Expr (Expr)
 import Foreign.Object (lookup)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
-import Module (File(..), Folder(..), blah, datasetAs, defaultImports, loadFile, open)
+import Module (File(..), Folder(..), initialConfig, datasetAs, defaultImports, loadFile, open)
 import Partial.Unsafe (unsafePartial)
 import Pretty (prettyP)
 import Primitive (matrixRep) as P
@@ -189,7 +189,7 @@ linkResult x γ0γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= blah
+   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= initialConfig
    let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
@@ -204,14 +204,14 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
    let
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
-   -- views share ambient environment γ as well as dataset
-   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= datasetAs (File "example/" <> dir <> dataFile) x >>= blah
+   -- views share ambient environment γ
+   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= datasetAs (File "example/" <> dir <> dataFile) x >>= initialConfig
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
       γ0 = botOf <$> γ
       s1 = botOf s1'
       s2 = botOf s2'
-   dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- use surface expression instead
+   dataFile' <- loadFile (Folder "fluid/example/linking") dataFile -- TODO: use surface expression instead
    e1 × e2 <- (×) <$> desug s1 <*> desug s2
    t1 × v1 <- eval γ0 e1 bot
    t2 × v2 <- eval γ0 e2 bot
diff --git a/src/Module.purs b/src/Module.purs
index e25505ba0..227ea59f2 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -75,8 +75,8 @@ datasetAs file x (ProgCxt r@{ datasets }) = do
    eα <- parseProgram (Folder "fluid") file >>= desug
    pure $ ProgCxt r { datasets = x ↦ eα : datasets }
 
-blah :: forall m. MonadError Error m => Raw ProgCxt -> m (GraphConfig GraphImpl)
-blah progCxt = do
+initialConfig :: forall m. MonadError Error m => Raw ProgCxt -> m (GraphConfig GraphImpl)
+initialConfig progCxt = do
    (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
       progCxt' <- alloc progCxt
       primitives' <- traverse alloc primitives
diff --git a/test/Many.purs b/test/Many.purs
index 4bfaec19d..56f5bb329 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -7,7 +7,7 @@ import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
 import Module (File(..), Folder(..), datasetAs, defaultImports, loadFile)
-import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup2)
+import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
 import Util (type (×))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
@@ -15,7 +15,7 @@ many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
       progCxt <- defaultImports
-      testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
+      testWithSetup n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
 bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
@@ -24,14 +24,14 @@ bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
    one { file, file_expect, δv, fwd_expect } = do
       progCxt <- defaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
-      testWithSetup2 n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
+      testWithSetup n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { dataset, file } = do
       progCxt <- defaultImports >>= datasetAs (File dataset) "data"
-      testWithSetup2 n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+      testWithSetup n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
 linkMany specs = zip (specs <#> name) (specs <#> one)
diff --git a/test/Util.purs b/test/Util.purs
index 754a01b77..0cc5b89f6 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -28,7 +28,7 @@ import Graph.GraphImpl (GraphImpl)
 import Graph.Slice (bwdSliceDual, fwdSliceDual, fwdSliceDeMorgan) as G
 import Heterogeneous.Mapping (hmap)
 import Lattice (Raw, botOf, erase)
-import Module (File, blah, open, parse)
+import Module (File, initialConfig, open, parse)
 import Parse (program)
 import Pretty (class Pretty, prettyP)
 import SExpr (Expr) as SE
@@ -45,8 +45,9 @@ type TestConfig =
 logging :: Boolean
 logging = false
 
-testWithSetup ∷ Int -> File -> GraphConfig GraphImpl -> TestConfig -> Aff BenchRow
-testWithSetup n file gconfig tconfig = do
+testWithSetup ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
+testWithSetup n file progCxt tconfig = do
+   gconfig <- initialConfig progCxt
    s <- open file
    testPretty s
    rows <- replicateM n $ do
@@ -55,11 +56,6 @@ testWithSetup n file gconfig tconfig = do
       pure $ BenchRow trRow grRow
    pure $ averageRows rows
 
-testWithSetup2 ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
-testWithSetup2 n file progCxt tconfig = do
-   gconfig <- blah progCxt
-   testWithSetup n file gconfig tconfig
-
 testPretty :: forall m a. MonadAff m => MonadError Error m => Ann a => SE.Expr a -> m Unit
 testPretty s = do
    let src = prettyP s

From fccff33f68d2c86e2ba7adcd6a8c1ff7f1a8af2a Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 09:03:35 +0200
Subject: [PATCH 55/57] =?UTF-8?q?=F0=9F=A7=A9=20[consolidate]:=20Merge=20P?=
 =?UTF-8?q?rogCxtEval=20and=20GraphConfig.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/App/Fig.purs   |  5 ++---
 src/EvalGraph.purs | 21 ++++-----------------
 src/Module.purs    |  8 ++++----
 test/Util.purs     |  3 +--
 4 files changed, 11 insertions(+), 26 deletions(-)

diff --git a/src/App/Fig.purs b/src/App/Fig.purs
index 2b5026291..3110ddf16 100644
--- a/src/App/Fig.purs
+++ b/src/App/Fig.purs
@@ -26,7 +26,6 @@ import Effect.Console (log)
 import Effect.Exception (Error)
 import Eval (eval, eval_module)
 import EvalBwd (evalBwd)
-import EvalGraph (ProgCxtEval(..))
 import Expr (Expr)
 import Foreign.Object (lookup)
 import Lattice (𝔹, bot, botOf, erase, neg, topOf)
@@ -189,7 +188,7 @@ linkResult x γ0γ e1 e2 t1 _ v1 = do
 
 loadFig :: forall m. MonadAff m => MonadError Error m => FigSpec -> m Fig
 loadFig spec@{ file } = do
-   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= initialConfig
+   { γ } <- defaultImports >>= initialConfig
    let γ0 = botOf <$> γ
    s' <- open file
    let s0 = botOf s'
@@ -205,7 +204,7 @@ loadLinkFig spec@{ file1, file2, dataFile, x } = do
       dir = File "linking/"
       name1 × name2 = (dir <> file1) × (dir <> file2)
    -- views share ambient environment γ
-   { progCxt: ProgCxtEval { γ } } <- defaultImports >>= datasetAs (File "example/" <> dir <> dataFile) x >>= initialConfig
+   { γ } <- defaultImports >>= datasetAs (File "example/" <> dir <> dataFile) x >>= initialConfig
    s1' × s2' <- (×) <$> open name1 <*> open name2
    let
       γ0 = botOf <$> γ
diff --git a/src/EvalGraph.purs b/src/EvalGraph.purs
index 7d0bf5deb..bc5fc4bf7 100644
--- a/src/EvalGraph.purs
+++ b/src/EvalGraph.purs
@@ -1,6 +1,5 @@
 module EvalGraph
    ( GraphConfig
-   , ProgCxtEval(..)
    , apply
    , eval
    , eval_module
@@ -18,7 +17,6 @@ import Data.Array (range, singleton) as A
 import Data.Either (Either(..))
 import Data.Exists (runExists)
 import Data.List (List(..), length, reverse, snoc, unzip, zip, (:))
-import Data.Newtype (class Newtype)
 import Data.Set (Set, empty, insert, intersection, singleton, union)
 import Data.Set as S
 import Data.Traversable (sequence, traverse)
@@ -39,16 +37,11 @@ import Util.Pair (unzip) as P
 import Val (DictRep(..), Env, ForeignOp'(..), MatrixRep(..), Val, for, lookup', restrict, (<+>))
 import Val (Fun(..), Val(..)) as V
 
--- Combine these two in some way?
-newtype ProgCxtEval a = ProgCxtEval
-   { progCxt :: ProgCxt a
-   , γ :: Env a
-   }
-
 type GraphConfig g =
-   { g :: g
+   { progCxt :: ProgCxt Vertex
+   , g :: g
    , n :: Int
-   , progCxt :: ProgCxtEval Vertex
+   , γ :: Env Vertex
    }
 
 {-# Matching #-}
@@ -210,7 +203,7 @@ graphGC
    => GraphConfig g
    -> Raw Expr
    -> m (GraphEval g)
-graphGC { g, n, progCxt: ProgCxtEval { γ } } e = do
+graphGC { g, n, γ } e = do
    (g' × _) × eα × vα <-
       runWithGraphAllocT (g × n) do
          eα <- alloc e
@@ -222,9 +215,3 @@ graphGC { g, n, progCxt: ProgCxtEval { γ } } e = do
       bwd αs = vertices (bwdSlice αs g') `intersection` sinks g'
    --   trace (show (S.size $ sinks g' `S.difference` dom) <> " sinks not in inputs.") \_ ->
    pure { gc: GC { fwd, bwd }, γα: γ, eα, g: g', vα }
-
--- ======================
--- boilerplate
--- ======================
-derive instance Newtype (ProgCxtEval a) _
-derive instance Functor ProgCxtEval
diff --git a/src/Module.purs b/src/Module.purs
index 227ea59f2..353fd945e 100644
--- a/src/Module.purs
+++ b/src/Module.purs
@@ -17,7 +17,7 @@ import Desugarable (desug)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error)
 import Effect.Exception (error) as E
-import EvalGraph (GraphConfig, ProgCxtEval(..), eval_progCxt)
+import EvalGraph (GraphConfig, eval_progCxt)
 import Expr (ProgCxt(..))
 import Graph (empty) as G
 import Graph.GraphImpl (GraphImpl)
@@ -77,9 +77,9 @@ datasetAs file x (ProgCxt r@{ datasets }) = do
 
 initialConfig :: forall m. MonadError Error m => Raw ProgCxt -> m (GraphConfig GraphImpl)
 initialConfig progCxt = do
-   (g × n) × progCxt' <- runWithGraphAllocT (G.empty × 0) do
+   (g × n) × progCxt' × γ <- runWithGraphAllocT (G.empty × 0) do
       progCxt' <- alloc progCxt
       primitives' <- traverse alloc primitives
       γ <- eval_progCxt primitives' progCxt'
-      pure $ ProgCxtEval { progCxt: progCxt', γ }
-   pure { g, n, progCxt: progCxt' }
+      pure (progCxt' × γ)
+   pure { g, n, progCxt: progCxt', γ }
diff --git a/test/Util.purs b/test/Util.purs
index 0cc5b89f6..e61d90d16 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -10,7 +10,6 @@ import Data.Foldable (foldl)
 import Data.Int (toNumber)
 import Data.List (elem)
 import Data.List.Lazy (List, length, replicateM)
-import Data.Newtype (unwrap)
 import Data.Set (subset)
 import Data.String (null)
 import DataType (dataTypeFor, typeName)
@@ -51,7 +50,7 @@ testWithSetup n file progCxt tconfig = do
    s <- open file
    testPretty s
    rows <- replicateM n $ do
-      trRow <- testTrace s (unwrap gconfig.progCxt).γ tconfig
+      trRow <- testTrace s gconfig.γ tconfig
       grRow <- testGraph s gconfig tconfig
       pure $ BenchRow trRow grRow
    pure $ averageRows rows

From f6d8079851f7a885d4a20c954b76665de0d1adbf Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 09:08:01 +0200
Subject: [PATCH 56/57] =?UTF-8?q?=F0=9F=A7=A9=20[rename]:=20testWithSetup?=
 =?UTF-8?q?=20->=20test.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/Many.purs | 8 ++++----
 test/Util.purs | 4 ++--
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/test/Many.purs b/test/Many.purs
index 56f5bb329..0d9ab601f 100644
--- a/test/Many.purs
+++ b/test/Many.purs
@@ -7,7 +7,7 @@ import Benchmark.Util (BenchRow)
 import Data.Array (zip)
 import Effect.Aff (Aff)
 import Module (File(..), Folder(..), datasetAs, defaultImports, loadFile)
-import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, testWithSetup)
+import Test.Util (TestBwdSpec, TestLinkSpec, TestSpec, TestWithDatasetSpec, checkPretty, test)
 import Util (type (×))
 
 many :: Array TestSpec -> Int -> Array (String × Aff BenchRow)
@@ -15,7 +15,7 @@ many specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { file, fwd_expect } = do
       progCxt <- defaultImports
-      testWithSetup n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
+      test n (File file) progCxt { δv: identity, fwd_expect, bwd_expect: mempty }
 
 bwdMany :: Array TestBwdSpec -> Int -> Array (String × Aff BenchRow)
 bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
@@ -24,14 +24,14 @@ bwdMany specs n = zip (specs <#> _.file) (specs <#> one)
    one { file, file_expect, δv, fwd_expect } = do
       progCxt <- defaultImports
       bwd_expect <- loadFile (Folder "fluid/example") (folder <> File file_expect)
-      testWithSetup n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
+      test n (folder <> File file) progCxt { δv, fwd_expect, bwd_expect }
 
 withDatasetMany :: Array TestWithDatasetSpec -> Int -> Array (String × Aff BenchRow)
 withDatasetMany specs n = zip (specs <#> _.file) (specs <#> one)
    where
    one { dataset, file } = do
       progCxt <- defaultImports >>= datasetAs (File dataset) "data"
-      testWithSetup n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
+      test n (File file) progCxt { δv: identity, fwd_expect: mempty, bwd_expect: mempty }
 
 linkMany :: Array TestLinkSpec -> Array (String × Aff Unit)
 linkMany specs = zip (specs <#> name) (specs <#> one)
diff --git a/test/Util.purs b/test/Util.purs
index e61d90d16..fef60e74f 100644
--- a/test/Util.purs
+++ b/test/Util.purs
@@ -44,8 +44,8 @@ type TestConfig =
 logging :: Boolean
 logging = false
 
-testWithSetup ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
-testWithSetup n file progCxt tconfig = do
+test ∷ Int -> File -> ProgCxt Unit -> TestConfig -> Aff BenchRow
+test n file progCxt tconfig = do
    gconfig <- initialConfig progCxt
    s <- open file
    testPretty s

From 35dcd243cfd8a2ee26c38a2a24766038e44123b4 Mon Sep 17 00:00:00 2001
From: Roly Perera <roly.perera@dynamicaspects.org>
Date: Thu, 5 Oct 2023 09:11:28 +0200
Subject: [PATCH 57/57] =?UTF-8?q?=F0=9F=A7=A9=20[remove-unused]:=20Imports?=
 =?UTF-8?q?.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Val.purs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/Val.purs b/src/Val.purs
index e7dd6043b..ee1b96307 100644
--- a/src/Val.purs
+++ b/src/Val.purs
@@ -2,7 +2,7 @@ module Val where
 
 import Prelude hiding (absurd, append)
 
-import Bindings (Bind, Var)
+import Bindings (Var)
 import Control.Apply (lift2)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Data.Array ((!!))
@@ -11,15 +11,13 @@ import Data.Bitraversable (bitraverse)
 import Data.Exists (Exists)
 import Data.Foldable (class Foldable, foldl, foldrDefault, foldMapDefaultL)
 import Data.List (List(..), (:), zipWith)
-import Data.Newtype (class Newtype)
-import Data.Profunctor.Strong (second)
 import Data.Set (Set, empty, fromFoldable, intersection, member, singleton, toUnfoldable, union)
 import Data.Traversable (class Traversable, sequenceDefault, traverse)
 import DataType (Ctr)
 import Dict (Dict, get)
 import Dict (apply2, intersectionWith) as D
 import Effect.Exception (Error)
-import Expr (Elim, Expr, Module, RecDefs, fv)
+import Expr (Elim, RecDefs, fv)
 import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
 import Graph (Vertex(..))