🧩 [unconsolidate]: Newtype gunk for ProgCxt.

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'

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α }

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)

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)

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)

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
 

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,15 +65,15 @@ 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
 
    -- | 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