From 04c52ac58f4acfe600c8d6326c309cfbfbc5dd04 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Mon, 19 Aug 2024 14:04:11 +0100
Subject: [PATCH 001/182] Add "hoping" variables

---
 brat/Brat/Eval.hs         |  8 +++++++-
 brat/Brat/Syntax/Value.hs | 10 +++++++++-
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 3e9d64ab..9c6ee95e 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -91,6 +91,10 @@ semVar _ (VPar end) = req (ELup end) >>= \case
     -- (Ok to) keep going (because we don't put recursive definitions in the store).
     Just v -> sem S0 v
     Nothing -> pure $ SApp (SPar end) B0
+-- Same logic as VPar
+semVar _ (VHop end) = req (ELup end) >>= \case
+    Just v -> sem S0 v
+    Nothing -> pure $ SApp (SHop end) B0
 
 apply :: Val Z -> [Val Z] -> Checking (Val Z)
 apply f args = do
@@ -131,6 +135,7 @@ quoteCTy lvy my ga (ins :->> outs) = quoteRo my ga ins lvy >>= \case
 -- first number is next Lvl to use in Value
 --         require every Lvl in Sem is < n (converted by n - 1 - lvl), else must fail at runtime
 quoteVar :: Ny n -> SVar -> VVar n
+quoteVar _ (SHop end) = VHop end
 quoteVar _ (SPar end) = VPar end -- no need to chase, done in semVar
 quoteVar ny (SLvl lvl) = VInx $ helper ny $ (ny2int ny) - 1 - lvl
  where
@@ -184,7 +189,7 @@ kindEq (TypeFor m xs) (TypeFor m' ys) | m == m' = kindListEq xs ys
 kindEq k k' = Left . TypeErr $ "Unequal kinds " ++ show k ++ " and " ++ show k'
 
 kindOf :: VVar Z -> Checking TypeKind
-kindOf (VPar e) = req (TypeOf e) >>= \case
+kindOf v | Just e <- isGlobal v = req (TypeOf e) >>= \case
   EndType Braty (Left k) -> pure k
   EndType my ty -> typeErr $ "End " ++ show e ++ " isn't a kind, it's type is " ++ case my of
     Braty -> show ty
@@ -240,6 +245,7 @@ eqWorker tm (lvy :* kz) (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
     _ -> err $ InternalError "quote gave a surprising result"
  where
   svKind (VPar e) = kindOf (VPar e)
+  svKind (VHop e) = kindOf (VHop e)
   svKind (VInx n) = pure $ proj kz n
 eqWorker tm lvkz (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
   req (TLup (m, c)) >>= \case
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index e3bfcb46..d85e30c1 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -138,12 +138,19 @@ type Semz = Stack Z Sem
 
 data VVar :: N -> Type where
   VPar :: End -> VVar n  -- Has to be declared in the Store (for equality testing)
+  VHop :: End -> VVar n  -- A meta we "Hope" we can solve to make things go
   VInx :: Inx n -> VVar n
 
 deriving instance Show (VVar n)
 
+isGlobal :: VVar n -> Maybe End
+isGlobal (VPar e) = Just e
+isGlobal (VHop e) = Just e
+isGlobal _ = Nothing
+
 instance Eq (VVar n) where
   (VPar e0) == (VPar e1) = e0 == e1
+  (VHop e0) == (VHop e1) = e0 == e1
   (VInx _) == (VInx _) = error "tried to compare VInxs"
   _ == _ = False
 
@@ -157,7 +164,7 @@ data Val :: N -> Type where
   VApp :: VVar n -> Bwd (Val n) -> Val n
   VSum :: MODEY m => Modey m -> [Some (Ro m n)] -> Val n -- (Hugr-like) Sum types
 
-data SVar = SPar End | SLvl Int
+data SVar = SPar End | SHop End | SLvl Int
  deriving (Show, Eq)
 
 -- Semantic value, used internally by normalization; contains Lvl's but no Inx's
@@ -510,6 +517,7 @@ instance DeBruijn VVar where
   changeVar (ParToInx a _) (VInx v) = VInx (injInn a v)
   changeVar (Thinning th) (VInx v) = VInx (inxThin v th)
   changeVar _ (VPar e) = VPar e
+  changeVar _ (VHop e) = VHop e
 
 
 instance DeBruijn Val where

From 3a1d6fec3edac509b2aafbd9869a26493fc25097 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Mon, 19 Aug 2024 17:05:53 +0100
Subject: [PATCH 002/182] Expand Free monad with Define and Yield

---
 brat/Brat/Checker/Helpers.hs       |  6 +--
 brat/Brat/Checker/Monad.hs         | 46 ++++++++++++-----
 brat/Brat/Checker/SolvePatterns.hs |  6 +--
 brat/Control/Monad/Freer.hs        | 80 ++++++++++++++++++++++++++++--
 4 files changed, 117 insertions(+), 21 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 49d7cd04..914a5cee 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -37,7 +37,7 @@ import Bwd
 import Hasochism
 import Util (log2)
 
-import Control.Monad.Freer (req, Free(Ret))
+import Control.Monad.Freer
 import Control.Arrow ((***))
 import Data.List (intercalate)
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
@@ -293,10 +293,10 @@ valueToBinder Braty = Right
 valueToBinder Kerny = id
 
 defineSrc :: Src -> Val Z -> Checking ()
-defineSrc src v = req (Define (ExEnd (end src)) v)
+defineSrc src v = Define (ExEnd (end src)) v (const (Ret ()))
 
 defineTgt :: Tgt -> Val Z -> Checking ()
-defineTgt tgt v = req (Define (InEnd (end tgt)) v)
+defineTgt tgt v = Define (InEnd (end tgt)) v (const (Ret ()))
 
 declareSrc :: Src -> Modey m -> BinderType m -> Checking ()
 declareSrc src my ty = req (Declare (ExEnd (end src)) my ty)
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 7c0bd731..732bb575 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -18,6 +18,7 @@ import Control.Monad.Freer
 import Control.Monad.Fail ()
 import Data.List (intercalate)
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 -- import Debug.Trace
 
@@ -58,6 +59,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , aliasTable :: M.Map UserName Alias
                    }
 
+-- Commands for synchronous operations
 data CheckingSig ty where
   Fresh   :: String -> CheckingSig Name
   -- Run a sub-process on a new namespace-level
@@ -89,7 +91,6 @@ data CheckingSig ty where
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
-  Define  :: End -> Val Z -> CheckingSig ()
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
@@ -251,17 +252,6 @@ handler (Req s k) ctx g ns
                        (ctx { store =
                               st { typeMap = M.insert end (EndType my bty) m }
                             }) g ns
-      Define end v ->
-        let st@Store{typeMap=tm, valueMap=vm} = store ctx
-        in case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
-          Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
-          Nothing -> case M.lookup end tm of
-            Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
-            Just _ -> -- TODO can we check the value is of the kind declared?
-              handler (k ())
-                (ctx { store =
-                    st { valueMap = M.insert end v vm }
-                }) g ns
       -- TODO: Use the kind argument for partially applied constructors
       TLup key -> do
         let args = M.lookup key (typeConstructors ctx)
@@ -280,6 +270,38 @@ handler (Req s k) ctx g ns
         args <- maybeToRight (Err (Just fc) $ TyConNotFound (show tycon) (show vcon)) $
                 M.lookup tycon tbl
         handler (k args) ctx g ns
+handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
+  case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
+      Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
+      Nothing -> case M.lookup end tm of
+        Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
+        -- TODO can we check the value is of the kind declared?
+        Just _ -> let news = News (M.singleton end (howStuck v)) in
+          handler (k news)
+            (ctx { store =
+                st { valueMap = M.insert end v vm }
+            }) g ns
+
+howStuck :: Val n -> Stuck
+howStuck (VApp (VHop e) _) = AwaitingAny (S.singleton e)
+howStuck (VLam bod) = howStuck bod
+howStuck (VCon _ _) = Unstuck
+howStuck (VFun _ _) = Unstuck
+howStuck (VSum _ _) = Unstuck
+-- Numbers are likely to cause problems.
+-- Whether they are stuck or not depends on the question we're asking!
+howStuck (VNum (NumValue 0 gro)) = howStuckGro gro
+ where
+  howStuckGro Constant0 = Unstuck
+  howStuckGro (StrictMonoFun f) = howStuckSM f
+
+  howStuckSM (StrictMono 0 mono) = howStuckMono mono
+  howStuckSM _ = AwaitingAny mempty
+
+  howStuckMono (Full sm) = howStuckSM sm
+  howStuckMono (Linear (VHop e)) = AwaitingAny (S.singleton e)
+  howStuckMono (Linear _) = AwaitingAny mempty
+howStuck _ = AwaitingAny mempty
 
 type Checking = Free CheckingSig
 
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 272915a3..087e47d2 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -191,7 +191,7 @@ unify l k r = do
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)
-  req (Define e val)
+  Define e val (const (Ret ()))
 
 
 -- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
@@ -318,7 +318,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
                                              (RPr ("out", TNat) R0)
     wire (NamedPort out "numerator", TNat, lhs)
     wire (const2, TNat, rhs)
-    req $ Define (toEnd out) (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
+    defineSrc (NamedPort out "") (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
     pure half
 
 
@@ -335,7 +335,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
                                              (RPr ("out", TNat) R0)
     wire (NamedPort out "", TNat, lhs)
     wire (const1, TNat, rhs)
-    req $ Define (ExEnd out) (VNum (nPlus 1 (nVar (VPar (toEnd pred)))))
+    defineSrc (NamedPort out "") (VNum (nPlus 1 (nVar (VPar (toEnd pred)))))
     pure (nVar (VPar (toEnd pred)))
 
 patVal :: ValPat -> [End] -> (Val Z, [End])
diff --git a/brat/Control/Monad/Freer.hs b/brat/Control/Monad/Freer.hs
index ebb1e310..8dedc5e4 100644
--- a/brat/Control/Monad/Freer.hs
+++ b/brat/Control/Monad/Freer.hs
@@ -1,24 +1,98 @@
-module Control.Monad.Freer (Free(..), req) where
+module Control.Monad.Freer where
+
+import Brat.Syntax.Port (End)
+import Brat.Syntax.Value (Val)
+import Hasochism (N(..))
 
 import Control.Monad ((>=>))
 import Data.Kind (Type)
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+-- A mapping of metavars to metavars, for a single problem:
+--  * e -> Unstuck means e has been solved
+--  * e -> Awaiting es means the problem's been transferred
+--  * e not in news means no change to e
+newtype News = News (M.Map End Stuck)
+
+updateEnd :: News -> End -> Stuck
+updateEnd (News m) e = case M.lookup e m of
+  Nothing ->  AwaitingAny (S.singleton e)
+  Just s -> s
+
+-- The RHS of the operation is the newer news
+-- Invariant: The domains of these Newses are disjoint
+instance Semigroup News where
+  (News m1) <> n2@(News m2) = News (m2 `M.union` (M.map (/// n2) m1))
+
+instance Monoid News where
+  mempty = News M.empty
+
+data Stuck
+ = Unstuck
+ | AwaitingAny (S.Set End)
+ deriving Show
+
+instance Semigroup Stuck where
+  (AwaitingAny es1) <> (AwaitingAny es2) = AwaitingAny (S.union es1 es2)
+  _ <> _ = Unstuck
+
+instance Monoid Stuck where
+  mempty = AwaitingAny S.empty
 
 data Free (sig :: Type -> Type) (v :: Type) where
   Ret :: v -> Free sig v
   Req ::  sig t -> (t -> Free sig v) -> Free sig v
+  Define :: End -> Val Z -> (News -> Free sig v) -> Free sig v
+  Yield :: Stuck -> (News -> Free sig v) -> Free sig v
 
 instance Functor (Free sig) where
   fmap f (Ret v) = Ret (f v)
   fmap f (Req sig k) = Req sig (fmap f . k)
+  fmap f (Define e v k) = Define e v (fmap f . k)
+  fmap f (Yield st k) = Yield st (fmap f . k)
+
+class NewsWatcher t where
+  (///) :: t -> News -> t
+
+instance NewsWatcher Stuck where
+  Unstuck /// _ = Unstuck
+  (AwaitingAny es) /// n = foldMap (updateEnd n) es
+
+instance NewsWatcher (News -> t) where
+  f /// n = f . (n <>)
+
+instance NewsWatcher (Free sig v) where
+  Ret v /// _ = Ret v
+  Req sig k /// n = Req sig $ \v -> k v /// n
+  Define e v k /// n = Define e v (k /// n)
+  Yield st k /// n = Yield (st /// n) (k /// n)
 
 instance Applicative (Free sig) where
   pure = Ret
-  (Ret f) <*> ma = fmap f ma
-  (Req sig k) <*> ma = Req sig ((<*> ma) . k)
+
+  -- Left biased scheduling of commands:
+  -- First, get rid of Yield Unstuck
+  Yield Unstuck k <*> a = k mempty <*> a
+  f <*> Yield Unstuck k = f <*> k mempty
+
+  -- Make progress on the left
+  Ret f <*> ma = fmap f ma
+  Req sig k <*> ma = Req sig ((<*> ma) . k)
+  Define e v k1 <*> ma = Define e v $ \n -> (k1 n) <*> (ma /// n)
+
+  -- What happens when Yield is on the left
+  y <*> Ret v = fmap ($ v) y
+  y <*> Req sig k = Req sig $ \v -> y <*> k v
+  y1@(Yield st1 _) <*> y2@(Yield st2 _) = Yield (st1 <> st2) $
+    \n -> (y1 /// n) <*> (y2 /// n)
+  y <*> Define e v k = Define e v $ \n -> (y /// n) <*> k n
 
 instance Monad (Free sig) where
   Ret v >>= k = k v
   Req r j >>= k = Req r (j >=> k)
+  Define e v k1 >>= k2 = Define e v (k1 >=> k2)
+  Yield st k1 >>= k2 = Yield st (k1 >=> k2)
 
 req :: sig t -> Free sig t
 req s = Req s Ret

From bf6cfcf57ff6c057e7cafd7bd53d133290eb6444 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 10:49:27 +0100
Subject: [PATCH 003/182] Add Define/Yield cases to handler functions

---
 brat/Brat/Checker/Monad.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 732bb575..f2256d12 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -98,6 +98,8 @@ localAlias con@(name, alias) (Req (ALup u) k)
   | u == name = localAlias con $ k (Just alias)
 localAlias con (Req (InLvl str c) k) = Req (InLvl str (localAlias con c)) (localAlias con . k)
 localAlias con (Req r k) = Req r (localAlias con . k)
+localAlias con (Define v e k) = Define v e (localAlias con . k)
+localAlias con (Yield st k) = Yield st (localAlias con . k)
 
 localFC :: FC -> Checking v -> Checking v
 localFC _ (Ret v) = Ret v
@@ -105,6 +107,9 @@ localFC f (Req AskFC k) = localFC f (k f)
 localFC f (Req (Throw (e@Err{fc=Nothing})) k) = localFC f (Req (Throw (e{fc=Just f})) k)
 localFC f (Req (InLvl str c) k) = Req (InLvl str (localFC f c)) (localFC f . k)
 localFC f (Req r k) = Req r (localFC f . k)
+localFC f (Define v e k) = Define v e (localFC f . k)
+localFC f (Yield st k) = Yield st (localFC f . k)
+
 
 localEnv :: (?my :: Modey m) => Env (EnvData m) -> Checking v -> Checking v
 localEnv = case ?my of
@@ -119,6 +124,8 @@ localVEnv ext (Req AskVEnv k) = do env <- req AskVEnv
                                    localVEnv ext (k (env { locals = M.union ext (locals env) }))
 localVEnv ext (Req (InLvl str c) k) = Req (InLvl str (localVEnv ext c)) (localVEnv ext . k)
 localVEnv ext (Req r k) = Req r (localVEnv ext . k)
+localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
+localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
 
 -- runs a computation, but intercepts uses of outer *locals* variables and redirects
 -- them to use new outports of the specified node (expected to be a Source).
@@ -137,12 +144,16 @@ captureOuterLocals c = do
   helper (avail, captured) (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
     helper (avail, M.insert x new captured) (k j)
   helper state (Req r k) = Req r (helper state . k)
+  helper state (Define e v k) = Define e v (helper state . k)
+  helper state (Yield st k) = Yield st (helper state . k)
 
 wrapError :: (Error -> Error) -> Checking v -> Checking v
 wrapError _ (Ret v) = Ret v
 wrapError f (Req (Throw e) k) = Req (Throw (f e)) k
 wrapError f (Req (InLvl str c) k) = Req (InLvl str (wrapError f c)) (wrapError f . k)
 wrapError f (Req r k) = Req r (wrapError f . k)
+wrapError f (Define v e k) = Define v e (wrapError f . k)
+wrapError f (Yield st k) = Yield st (wrapError f . k)
 
 throwLeft :: Either ErrorMsg a -> Checking a
 throwLeft (Right x) = pure x
@@ -204,11 +215,15 @@ localKVar env (Req KDone k) = case [ x | (x,(One,_)) <- M.assocs env ] of
                                               ,"haven't been used"
                                               ]
 localKVar env (Req r k) = Req r (localKVar env . k)
+localKVar env (Define e v k) = Define e v (localKVar env . k)
+localKVar env (Yield st k) = Yield st (localKVar env . k)
 
 catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
 catchErr (Ret t) = Ret (Right t)
 catchErr (Req (Throw e) _) = pure $ Left e
 catchErr (Req r k) = Req r (catchErr . k)
+catchErr (Define e v k) = Define e v (catchErr . k)
+catchErr (Yield st k) = Yield st (catchErr . k)
 
 handler :: Free CheckingSig v
         -> Context
@@ -284,6 +299,7 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
 
 howStuck :: Val n -> Stuck
 howStuck (VApp (VHop e) _) = AwaitingAny (S.singleton e)
+howStuck (VApp (VPar e) _) = AwaitingAny (S.singleton e)
 howStuck (VLam bod) = howStuck bod
 howStuck (VCon _ _) = Unstuck
 howStuck (VFun _ _) = Unstuck
@@ -333,6 +349,8 @@ suppressHoles :: Checking a -> Checking a
 suppressHoles (Ret x) = Ret x
 suppressHoles (Req (LogHole _) k) = suppressHoles (k ())
 suppressHoles (Req c k) = Req c (suppressHoles . k)
+suppressHoles (Define v e k) = Define v e (suppressHoles . k)
+suppressHoles (Yield st k) = Yield st (suppressHoles . k)
 
 -- Run a computation without doing any graph generation
 suppressGraph :: Checking a -> Checking a
@@ -340,3 +358,5 @@ suppressGraph (Ret x) = Ret x
 suppressGraph (Req (AddNode _ _) k) = suppressGraph (k ())
 suppressGraph (Req (Wire _) k) = suppressGraph (k ())
 suppressGraph (Req c k) = Req c (suppressGraph . k)
+suppressGraph (Define v e k) = Define v e (suppressGraph . k)
+suppressGraph (Yield st k) = Yield st (suppressGraph . k)

From a6f00ddc19bf994eb693b97b654fb3f3f3e827e2 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 10:56:52 +0100
Subject: [PATCH 004/182] Handle Yield in toplevel handler

---
 brat/Brat/Checker/Monad.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index f2256d12..965bd683 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -296,6 +296,8 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
             (ctx { store =
                 st { valueMap = M.insert end v vm }
             }) g ns
+handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
+handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]
 
 howStuck :: Val n -> Stuck
 howStuck (VApp (VHop e) _) = AwaitingAny (S.singleton e)

From 4204c50647b7020e8489651c016665727ee5d871 Mon Sep 17 00:00:00 2001
From: Mark Koch <mark.koch@quantinuum.com>
Date: Tue, 20 Aug 2024 11:00:12 +0100
Subject: [PATCH 005/182] Add bang parsing

---
 brat/Brat/Elaborator.hs      | 1 +
 brat/Brat/Lexer/Flat.hs      | 1 +
 brat/Brat/Lexer/Token.hs     | 2 ++
 brat/Brat/Parser.hs          | 1 +
 brat/Brat/Syntax/Concrete.hs | 1 +
 brat/Brat/Syntax/Core.hs     | 2 ++
 brat/Brat/Syntax/Raw.hs      | 3 +++
 7 files changed, 11 insertions(+)

diff --git a/brat/Brat/Elaborator.hs b/brat/Brat/Elaborator.hs
index d8220009..e894b28d 100644
--- a/brat/Brat/Elaborator.hs
+++ b/brat/Brat/Elaborator.hs
@@ -90,6 +90,7 @@ elaborate (WC fc x) = do
 
 elaborate' :: Flat -> Either Error SomeRaw'
 elaborate' (FVar x) = pure $ SomeRaw' (RVar x)
+elaborate' FHope = pure $ SomeRaw' RHope
 elaborate' (FArith op a b) = do
   (SomeRaw a) <- elaborate a
   (SomeRaw b) <- elaborate b
diff --git a/brat/Brat/Lexer/Flat.hs b/brat/Brat/Lexer/Flat.hs
index 92736307..447cd784 100644
--- a/brat/Brat/Lexer/Flat.hs
+++ b/brat/Brat/Lexer/Flat.hs
@@ -86,6 +86,7 @@ tok = (   try (char '(' $> LParen)
       <|> try (string "-" $> Minus)
       <|> try (string "$" $> Dollar)
       <|> try (string "|" $> Pipe)
+      <|> try (string "!" $> Bang)
       <|> try (K <$> try keyword)
       <|> try qualified
       <|> Ident <$> ident
diff --git a/brat/Brat/Lexer/Token.hs b/brat/Brat/Lexer/Token.hs
index 95acff34..8aa3e14f 100644
--- a/brat/Brat/Lexer/Token.hs
+++ b/brat/Brat/Lexer/Token.hs
@@ -42,6 +42,7 @@ data Tok
  | Dollar
  | Underscore
  | Pipe
+ | Bang
  | Cons
  | Snoc
  | ConcatEqEven
@@ -86,6 +87,7 @@ instance Show Tok where
   show Dollar = "$"
   show Underscore = "_"
   show Pipe = "|"
+  show Bang = "!"
   show Cons = ",-"
   show Snoc = "-,"
   show ConcatEqEven = "=,="
diff --git a/brat/Brat/Parser.hs b/brat/Brat/Parser.hs
index f75ac70b..196daa02 100644
--- a/brat/Brat/Parser.hs
+++ b/brat/Brat/Parser.hs
@@ -498,6 +498,7 @@ expr' p = choice $ (try . getParser <$> enumFrom p) ++ [atomExpr]
               <|> try (match DotDot $> FPass)
               <|> var
               <|> match Underscore $> FUnderscore
+              <|> match Bang $> FHope
 
 
 cnoun :: Parser Flat -> Parser (WC (Raw 'Chk 'Noun))
diff --git a/brat/Brat/Syntax/Concrete.hs b/brat/Brat/Syntax/Concrete.hs
index ba3ae36a..459dfd8d 100644
--- a/brat/Brat/Syntax/Concrete.hs
+++ b/brat/Brat/Syntax/Concrete.hs
@@ -22,6 +22,7 @@ type FEnv = ([FDecl], [RawAlias])
 
 data Flat
  = FVar UserName
+ | FHope
  | FApp (WC Flat) (WC Flat)
  | FJuxt (WC Flat) (WC Flat)
  | FThunk (WC Flat)
diff --git a/brat/Brat/Syntax/Core.hs b/brat/Brat/Syntax/Core.hs
index e6169b81..195cd875 100644
--- a/brat/Brat/Syntax/Core.hs
+++ b/brat/Brat/Syntax/Core.hs
@@ -48,6 +48,7 @@ data Term :: Dir -> Kind -> Type where
   Forget   :: WC (Term d KVerb) -> Term d UVerb
   Pull     :: [PortName] -> WC (Term Chk k) -> Term Chk k
   Var      :: UserName -> Term Syn Noun  -- Look up in noun (value) env
+  Hope     :: Term Chk Noun
   Arith    :: ArithOp -> WC (Term Chk Noun) -> WC (Term Chk Noun) -> Term Chk Noun
   -- Type annotations (annotating a term with its outputs)
   (:::)    :: WC (Term Chk Noun) -> [Output] -> Term Syn Noun
@@ -106,6 +107,7 @@ instance Show (Term d k) where
     showList ps = concatMap (++":") ps
 
   show (Var x) = show x
+  show Hope = "!"
   -- Nested applications should be bracketed too, hence 4 instead of 3
   show (fun :$: arg) = bracket PApp fun ++ ('(' : show arg ++ ")")
   show (tm ::: ty) = bracket PAnn tm ++ " :: " ++ show ty
diff --git a/brat/Brat/Syntax/Raw.hs b/brat/Brat/Syntax/Raw.hs
index 5b34f73d..f80e5775 100644
--- a/brat/Brat/Syntax/Raw.hs
+++ b/brat/Brat/Syntax/Raw.hs
@@ -70,6 +70,7 @@ data Raw :: Dir -> Kind -> Type where
   RForget   :: WC (Raw d KVerb) -> Raw d UVerb
   RPull     :: [PortName] -> WC (Raw Chk k) -> Raw Chk k
   RVar      :: UserName -> Raw Syn Noun
+  RHope     :: Raw Chk Noun
   RArith    :: ArithOp -> WC (Raw Chk Noun) -> WC (Raw Chk Noun) -> Raw Chk Noun
   (:::::)   :: WC (Raw Chk Noun) -> [RawIO] -> Raw Syn Noun
   (::-::)   :: WC (Raw Syn k) -> WC (Raw d UVerb) -> Raw d k -- vertical juxtaposition (diagrammatic composition)
@@ -98,6 +99,7 @@ instance Show (Raw d k) where
     = unwords ["let", show abs, "=", show xs, "in", show body]
   show (RNHole name) = '?':name
   show (RVHole name) = '?':name
+  show RHope = "!"
   show (RSimple tm) = show tm
   show RPass = show "pass"
   show REmpty = "()"
@@ -193,6 +195,7 @@ instance (Kindable k) => Desugarable (Raw d k) where
   -- TODO: holes need to know their arity for type checking
   desugar' (RNHole strName) = NHole . (strName,) <$> freshM strName
   desugar' (RVHole strName) = VHole . (strName,) <$> freshM strName
+  desugar' RHope = pure Hope
   desugar' RPass = pure Pass
   desugar' (RSimple simp) = pure $ Simple simp
   desugar' REmpty = pure Empty

From 3b8fdc1af3a284c4e56f5762fbdca2fb51fc37e7 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 11:41:51 +0100
Subject: [PATCH 006/182] Turn on ApplicativeDo

---
 brat/Brat/Checker.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index ae5611a6..e8afe427 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ApplicativeDo #-}
+
 module Brat.Checker (checkBody
                     ,check
                     ,run
@@ -252,7 +254,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
           solve ?my >>=
           (solToEnv . snd)
         (((), synthOuts), ((), ())) <- localEnv env $ check body ((), ())
-	pure synthOuts
+        pure synthOuts
 
       sig <- mkSig usedOvers synthOuts
       patOuts <- checkClauses sig usedOvers ((fst c, WC (fcOf body) (Emb body)) :| cs)
@@ -521,12 +523,13 @@ checkClause my fnName cty clause = modily my $ do
     (tests, sol) <- localFC (fcOf (lhs clause)) $ solve my problem
     -- The solution gives us the variables bound by the patterns.
     -- We turn them into a row
-    Some (patEz :* patRo) <- mkArgRo my S0 ((\(n, (src, ty)) -> (NamedPort (toEnd src) n, ty)) <$> sol)
-    -- Also make a row for the refined outputs (shifted by the pattern environment)
-    Some (_ :* outRo) <- mkArgRo my patEz (first (fmap toEnd) <$> unders)
-    let match = TestMatchData my $ MatchSequence overs tests (snd <$> sol)
-    let vars = fst <$> sol
-    pure (vars, match, patRo :->> outRo)
+    mkArgRo my S0 ((\(n, (src, ty)) -> (NamedPort (toEnd src) n, ty)) <$> sol) >>= \case
+      -- Also make a row for the refined outputs (shifted by the pattern environment)
+      Some (patEz :* patRo) -> mkArgRo my patEz (first (fmap toEnd) <$> unders) >>= \case
+        Some (_ :* outRo) -> do
+          let match = TestMatchData my $ MatchSequence overs tests (snd <$> sol)
+          let vars = fst <$> sol
+          pure (vars, match, patRo :->> outRo)
 
   -- Now actually make a box for the RHS and check it
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do

From 8f904bce192ed4595045eacdae546282cb0f2075 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 11:42:08 +0100
Subject: [PATCH 007/182] Add some dummy code for typechecking !

---
 brat/Brat/Checker.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index e8afe427..13ccd9ca 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -487,6 +487,15 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = do
                                      R0 (RPr ("value", vty) R0)
       wire (dangling, vty, hungry)
       pure (((), ()), ((), unders))
+check' Hope ((), ((tgt, ty):_unders)) = case (?my, ty) of
+  (Braty, Left k) -> do
+    (_, [], [(src,_)], _) <- anext "hope" Hypo (S0, Some (Zy :* S0)) R0 (REx ("hope", k) R0)
+    wire (src, kindType k, tgt)
+    -- TODO: write the end down somewhere
+    defineTgt tgt (VApp (VHop (end src)) B0)
+    pure (((), ()), ((), unders))
+  (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
+  (Kerny, _) -> typeErr "Won't infer kernel typed !"
 check' tm _ = error $ "check' " ++ show tm
 
 

From 8b852a23c679a78a4f1c4005455eb492e36b21d6 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 11:42:46 +0100
Subject: [PATCH 008/182] Revert "Add "hoping" variables"

This reverts commit 04c52ac58f4acfe600c8d6326c309cfbfbc5dd04.
---
 brat/Brat/Eval.hs         |  8 +-------
 brat/Brat/Syntax/Value.hs | 10 +---------
 2 files changed, 2 insertions(+), 16 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 9c6ee95e..3e9d64ab 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -91,10 +91,6 @@ semVar _ (VPar end) = req (ELup end) >>= \case
     -- (Ok to) keep going (because we don't put recursive definitions in the store).
     Just v -> sem S0 v
     Nothing -> pure $ SApp (SPar end) B0
--- Same logic as VPar
-semVar _ (VHop end) = req (ELup end) >>= \case
-    Just v -> sem S0 v
-    Nothing -> pure $ SApp (SHop end) B0
 
 apply :: Val Z -> [Val Z] -> Checking (Val Z)
 apply f args = do
@@ -135,7 +131,6 @@ quoteCTy lvy my ga (ins :->> outs) = quoteRo my ga ins lvy >>= \case
 -- first number is next Lvl to use in Value
 --         require every Lvl in Sem is < n (converted by n - 1 - lvl), else must fail at runtime
 quoteVar :: Ny n -> SVar -> VVar n
-quoteVar _ (SHop end) = VHop end
 quoteVar _ (SPar end) = VPar end -- no need to chase, done in semVar
 quoteVar ny (SLvl lvl) = VInx $ helper ny $ (ny2int ny) - 1 - lvl
  where
@@ -189,7 +184,7 @@ kindEq (TypeFor m xs) (TypeFor m' ys) | m == m' = kindListEq xs ys
 kindEq k k' = Left . TypeErr $ "Unequal kinds " ++ show k ++ " and " ++ show k'
 
 kindOf :: VVar Z -> Checking TypeKind
-kindOf v | Just e <- isGlobal v = req (TypeOf e) >>= \case
+kindOf (VPar e) = req (TypeOf e) >>= \case
   EndType Braty (Left k) -> pure k
   EndType my ty -> typeErr $ "End " ++ show e ++ " isn't a kind, it's type is " ++ case my of
     Braty -> show ty
@@ -245,7 +240,6 @@ eqWorker tm (lvy :* kz) (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
     _ -> err $ InternalError "quote gave a surprising result"
  where
   svKind (VPar e) = kindOf (VPar e)
-  svKind (VHop e) = kindOf (VHop e)
   svKind (VInx n) = pure $ proj kz n
 eqWorker tm lvkz (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
   req (TLup (m, c)) >>= \case
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index d85e30c1..e3bfcb46 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -138,19 +138,12 @@ type Semz = Stack Z Sem
 
 data VVar :: N -> Type where
   VPar :: End -> VVar n  -- Has to be declared in the Store (for equality testing)
-  VHop :: End -> VVar n  -- A meta we "Hope" we can solve to make things go
   VInx :: Inx n -> VVar n
 
 deriving instance Show (VVar n)
 
-isGlobal :: VVar n -> Maybe End
-isGlobal (VPar e) = Just e
-isGlobal (VHop e) = Just e
-isGlobal _ = Nothing
-
 instance Eq (VVar n) where
   (VPar e0) == (VPar e1) = e0 == e1
-  (VHop e0) == (VHop e1) = e0 == e1
   (VInx _) == (VInx _) = error "tried to compare VInxs"
   _ == _ = False
 
@@ -164,7 +157,7 @@ data Val :: N -> Type where
   VApp :: VVar n -> Bwd (Val n) -> Val n
   VSum :: MODEY m => Modey m -> [Some (Ro m n)] -> Val n -- (Hugr-like) Sum types
 
-data SVar = SPar End | SHop End | SLvl Int
+data SVar = SPar End | SLvl Int
  deriving (Show, Eq)
 
 -- Semantic value, used internally by normalization; contains Lvl's but no Inx's
@@ -517,7 +510,6 @@ instance DeBruijn VVar where
   changeVar (ParToInx a _) (VInx v) = VInx (injInn a v)
   changeVar (Thinning th) (VInx v) = VInx (inxThin v th)
   changeVar _ (VPar e) = VPar e
-  changeVar _ (VHop e) = VHop e
 
 
 instance DeBruijn Val where

From 77b92fe50aebbdcf77458aa72ad5eff693b4267d Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:34:02 +0100
Subject: [PATCH 009/182] Some parallelisation

---
 brat/Brat/Checker.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 13ccd9ca..e665f39e 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -130,9 +130,11 @@ checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
             -> [(Tgt, BinderType m)] -- Actual
             -> Checking [(Src, BinderType m)]
 checkInputs _ overs [] = pure overs
-checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do
-  wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
+checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ (
+  (wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u)
+  *>
   checkInputs tm overs unders
+ )
  where
   addRowContext :: Show (BinderType m)
               => Modey m
@@ -150,9 +152,11 @@ checkOutputs :: (CheckConstraints m k, ?my :: Modey m)
              -> [(Src, BinderType m)] -- Actual
              -> Checking [(Tgt, BinderType m)]
 checkOutputs _ unders [] = pure unders
-checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do
-  wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
+checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ (
+  (wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u)
+  *>
   checkOutputs tm unders overs
+ )
  where
   addRowContext :: Show (BinderType m)
               => Modey m

From 3a1288d91af592c047d57858992c9fc82da3304f Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:34:35 +0100
Subject: [PATCH 010/182] Add hope set to monad

---
 brat/Brat/Checker.hs       | 11 +++++------
 brat/Brat/Checker/Monad.hs | 11 +++++++++--
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index e665f39e..bcd637c1 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -19,6 +19,7 @@ import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
+import qualified Data.Set as S
 import Data.Type.Equality ((:~:)(..))
 import Prelude hiding (filter)
 
@@ -491,12 +492,9 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = do
                                      R0 (RPr ("value", vty) R0)
       wire (dangling, vty, hungry)
       pure (((), ()), ((), unders))
-check' Hope ((), ((tgt, ty):_unders)) = case (?my, ty) of
-  (Braty, Left k) -> do
-    (_, [], [(src,_)], _) <- anext "hope" Hypo (S0, Some (Zy :* S0)) R0 (REx ("hope", k) R0)
-    wire (src, kindType k, tgt)
-    -- TODO: write the end down somewhere
-    defineTgt tgt (VApp (VHop (end src)) B0)
+check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
+  (Braty, Left _k) -> do
+    req (ANewHope (toEnd tgt))
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
@@ -965,5 +963,6 @@ run ve initStore ns m =
                 , kconstructors = kernelConstructors
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
+                , hopeSet = S.empty
                 } in
     (\(a,ctx,(holes, graph),ns) -> (a, (holes, store ctx, graph, ns))) <$> handler m ctx mempty ns
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 965bd683..54b1b61c 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -57,6 +57,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , kconstructors :: ConstructorMap Kernel
                    , typeConstructors :: M.Map (Mode, UserName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map UserName Alias
+                   , hopeSet :: S.Set End
                    }
 
 -- Commands for synchronous operations
@@ -91,6 +92,8 @@ data CheckingSig ty where
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
+  ANewHope :: End -> CheckingSig ()
+  HopeSet :: CheckingSig (S.Set End)
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
@@ -285,6 +288,10 @@ handler (Req s k) ctx g ns
         args <- maybeToRight (Err (Just fc) $ TyConNotFound (show tycon) (show vcon)) $
                 M.lookup tycon tbl
         handler (k args) ctx g ns
+
+      ANewHope e -> handler (k ()) (ctx { hopeSet = S.insert e (hopeSet ctx) }) g ns
+
+      HopeSet -> handler (k (hopeSet ctx)) ctx g ns
 handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
   case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
@@ -293,8 +300,8 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
         -- TODO can we check the value is of the kind declared?
         Just _ -> let news = News (M.singleton end (howStuck v)) in
           handler (k news)
-            (ctx { store =
-                st { valueMap = M.insert end v vm }
+            (ctx { store = st { valueMap = M.insert end v vm },
+                hopeSet = S.delete end (hopeSet ctx)
             }) g ns
 handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
 handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]

From b979c707e03b844e4f9bc11a6fb478b26cf7e258 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:35:29 +0100
Subject: [PATCH 011/182] Move occur check logic to Eval

---
 brat/Brat/Checker/SolvePatterns.hs | 35 ------------------------------
 brat/Brat/Eval.hs                  | 35 ++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 35 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 087e47d2..5733b450 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -194,41 +194,6 @@ instantiateMeta e val = do
   Define e val (const (Ret ()))
 
 
--- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
--- We can have bogus failures here because we're not normalising under lambdas
--- N.B. the value argument is normalised.
-doesntOccur :: End -> Val n -> Either ErrorMsg ()
-doesntOccur e (VNum nv) = case getNumVar nv of
-  Just e' -> collision e e'
-  _ -> pure ()
- where
-  getNumVar :: NumVal (VVar n) -> Maybe End
-  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear v -> case v of
-      VPar e -> Just e
-      _ -> Nothing
-    Full sm -> getNumVar (numValue sm)
-  getNumVar _ = Nothing
-doesntOccur e (VApp var args) = case var of
-  VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
-  _ -> pure ()
-doesntOccur e (VCon _ args) = traverse_ (doesntOccur e) args
-doesntOccur e (VLam body) = doesntOccur e body
-doesntOccur e (VFun my (ins :->> outs)) = case my of
-  Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
-  Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
-doesntOccur e (VSum my rows) = traverse_ (\(Some ro) -> doesntOccurRo my e ro) rows
-
-collision :: End -> End -> Either ErrorMsg ()
-collision e v | e == v = Left . UnificationError $
-                         show e ++ " is cyclic"
-              | otherwise = pure ()
-
-doesntOccurRo :: Modey m -> End -> Ro m i j -> Either ErrorMsg ()
-doesntOccurRo _ _ R0 = pure ()
-doesntOccurRo my e (RPr (_, ty) ro) = doesntOccur e ty *> doesntOccurRo my e ro
-doesntOccurRo Braty e (REx _ ro) = doesntOccurRo Braty e ro
-
 unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 3e9d64ab..602ed9b1 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -299,3 +299,38 @@ eqTests tm lvkz = go
     Left e -> pure $ Left e
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "
                    ++ show us ++ "\n  " ++ show vs
+
+-- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
+-- We can have bogus failures here because we're not normalising under lambdas
+-- N.B. the value argument is normalised.
+doesntOccur :: End -> Val n -> Either ErrorMsg ()
+doesntOccur e (VNum nv) = case getNumVar nv of
+  Just e' -> collision e e'
+  _ -> pure ()
+ where
+  getNumVar :: NumVal (VVar n) -> Maybe End
+  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
+    Linear v -> case v of
+      VPar e -> Just e
+      _ -> Nothing
+    Full sm -> getNumVar (numValue sm)
+  getNumVar _ = Nothing
+doesntOccur e (VApp var args) = case var of
+  VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
+  _ -> pure ()
+doesntOccur e (VCon _ args) = traverse_ (doesntOccur e) args
+doesntOccur e (VLam body) = doesntOccur e body
+doesntOccur e (VFun my (ins :->> outs)) = case my of
+  Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
+  Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
+doesntOccur e (VSum my rows) = traverse_ (\(Some ro) -> doesntOccurRo my e ro) rows
+
+collision :: End -> End -> Either ErrorMsg ()
+collision e v | e == v = Left . UnificationError $
+                         show e ++ " is cyclic"
+              | otherwise = pure ()
+
+doesntOccurRo :: Modey m -> End -> Ro m i j -> Either ErrorMsg ()
+doesntOccurRo _ _ R0 = pure ()
+doesntOccurRo my e (RPr (_, ty) ro) = doesntOccur e ty *> doesntOccurRo my e ro
+doesntOccurRo Braty e (REx _ ro) = doesntOccurRo Braty e ro

From a197fb2bca6c753431cf1a486f791415a16207e4 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:35:52 +0100
Subject: [PATCH 012/182] misc changes

---
 brat/Brat/Checker/Helpers.hs | 7 +++++--
 brat/Brat/Checker/Monad.hs   | 3 +--
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 914a5cee..1464c18c 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -292,11 +292,14 @@ valueToBinder :: Modey m -> Val Z -> BinderType m
 valueToBinder Braty = Right
 valueToBinder Kerny = id
 
+defineEnd :: End -> Val Z -> Checking ()
+defineEnd e v = Define e v (const (Ret ()))
+
 defineSrc :: Src -> Val Z -> Checking ()
-defineSrc src v = Define (ExEnd (end src)) v (const (Ret ()))
+defineSrc src v = defineEnd (ExEnd (end src)) v
 
 defineTgt :: Tgt -> Val Z -> Checking ()
-defineTgt tgt v = Define (InEnd (end tgt)) v (const (Ret ()))
+defineTgt tgt v = defineEnd (InEnd (end tgt)) v
 
 declareSrc :: Src -> Modey m -> BinderType m -> Checking ()
 declareSrc src my ty = req (Declare (ExEnd (end src)) my ty)
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 54b1b61c..af79b89a 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -307,7 +307,6 @@ handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
 handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]
 
 howStuck :: Val n -> Stuck
-howStuck (VApp (VHop e) _) = AwaitingAny (S.singleton e)
 howStuck (VApp (VPar e) _) = AwaitingAny (S.singleton e)
 howStuck (VLam bod) = howStuck bod
 howStuck (VCon _ _) = Unstuck
@@ -324,7 +323,7 @@ howStuck (VNum (NumValue 0 gro)) = howStuckGro gro
   howStuckSM _ = AwaitingAny mempty
 
   howStuckMono (Full sm) = howStuckSM sm
-  howStuckMono (Linear (VHop e)) = AwaitingAny (S.singleton e)
+  howStuckMono (Linear (VPar e)) = AwaitingAny (S.singleton e) -- ALAN was VHop
   howStuckMono (Linear _) = AwaitingAny mempty
 howStuck _ = AwaitingAny mempty
 

From b115f84a7388d42e399fd397c2741fd16e7b5790 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:36:00 +0100
Subject: [PATCH 013/182] [broken] update eqworker

---
 brat/Brat/Eval.hs | 63 +++++++++++++++++++++++++++++------------------
 1 file changed, 39 insertions(+), 24 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 602ed9b1..e6b7afdd 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -219,50 +219,64 @@ dropRight = second (\_ -> ())
 
 eqWorker :: String              -- for error message
          -> (Ny :* Stack Z TypeKind) lv -- next Level & kinds for existing Levels
+         -> S.Set End           -- The hope set
          -> TypeKind            -- kind of both Sem's
          -> Sem                 -- expected
          -> Sem                 -- actual
          -> Checking (Either ErrorMsg ())
-eqWorker tm (lvy :* kz) (TypeFor m ((_, k):ks)) exp act = do
+eqWorker tm (lvy :* kz) hopeSet (TypeFor m ((_, k):ks)) exp act = do
   -- Higher kind
   let xz = B0 :< semLvl lvy
   exp <- applySem exp xz
   act <- applySem act xz
-  eqWorker tm (Sy lvy :* (kz :<< k)) (TypeFor m ks) exp act
+  eqWorker tm (Sy lvy :* (kz :<< k)) hopeSet (TypeFor m ks) exp act
 -- Nothing else is higher kinded
-eqWorker tm _ Nat exp act = pure $
+-- Hack: We should be able to cope when the stack of levels isn't empty
+eqWorker tm (Zy :* S0) hopeSet (SApp (SPar e) B0) act | S.member e hopeSet = do
+  v <- quote Zy act
+  case doesntOccur e v of
+    Left msg -> case v of
+      VApp (VPar e') B0 | e == e' -> pure (Right ())
+      -- TODO: Not all occurrences are toxic. The end could be in an argument
+      -- to a hoping variable which isn't used.
+      -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
+      _ -> pure $ Left msg
+    Right () -> defineEnd e v $> Right ()
+  
+eqWorker tm _ hopeSet Nat exp act = pure $
   if getNum exp == getNum act then Right () else Left $
     TypeMismatch tm (show exp) (show act)
-eqWorker tm (lvy :* kz) (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
+eqWorker tm (lvy :* kz) hopeSet (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
   svKind (quoteVar lvy f) >>= \case
-    TypeFor m' ks | m == m' -> eqTests tm (lvy :* kz) (snd <$> ks) (args <>> []) (args' <>> [])
+    TypeFor m' ks | m == m' -> eqTests tm (lvy :* kz) hopeSet (snd <$> ks) (args <>> []) (args' <>> [])
       -- pattern should always match
     _ -> err $ InternalError "quote gave a surprising result"
  where
   svKind (VPar e) = kindOf (VPar e)
   svKind (VInx n) = pure $ proj kz n
-eqWorker tm lvkz (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
+eqWorker tm lvkz hopeSet (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
   req (TLup (m, c)) >>= \case
-        Just ks -> eqTests tm lvkz (snd <$> ks) args args'
+        Just ks -> eqTests tm lvkz hopeSet (snd <$> ks) args args'
         Nothing -> pure . Left . TypeErr $ "Type constructor " ++ show c
                         ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
-eqWorker tm lvkz (Star []) (SFun m0 stk0 (ins0 :->> outs0)) (SFun m1 stk1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
-  eqRowTest m0 tm lvkz (stk0,ins0) (stk1,ins1) >>= \case
+eqWorker tm lvkz hopeSet (Star []) (SFun m0 stk0 (ins0 :->> outs0)) (SFun m1 stk1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
+  eqRowTest m0 tm lvkz hopeSet (stk0,ins0) (stk1,ins1) >>= \case
     Left msg -> pure (Left msg)
     Right (Some lvkz, stk0, stk1) -> eqRowTest m0 tm lvkz (stk0, outs0) (stk1, outs1) <&> dropRight
-eqWorker tm lvkz (TypeFor _ []) (SSum m0 stk0 rs0) (SSum m1 stk1 rs1)
+eqWorker tm lvkz hopeSet (TypeFor _ []) (SSum m0 stk0 rs0) (SSum m1 stk1 rs1)
   | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
       Nothing -> pure (Left (TypeErr "Mismatched sum lengths"))
       Just rs -> traverse eqVariant rs <&> sequence_
  where
   eqVariant (Some r0, Some r1) = eqRowTest m0 tm lvkz (stk0,r0) (stk1,r1) <&> dropRight
-eqWorker tm _ _ v0 v1 = pure . Left $ TypeMismatch tm (show v0) (show v1)
+eqWorker tm _ _ _ v0 v1 = pure . Left $ TypeMismatch tm (show v0) (show v1)
 
 -- Type rows have bot0,bot1 dangling de Bruijn indices, which we instantiate with
 -- de Bruijn levels. As we go under binders in these rows, we add to the scope's
 -- environments, which we return at the end for eqCType.
 eqRowTest :: Modey m
           -> String -- The term we complain about in errors
+          -> S.Set End      -- the hope set
           -> (Ny :* Stack Z TypeKind) lv -- Next available level, the kinds of existing levels
           -> (Stack Z Sem bot0, Ro m bot0 top0)
           -> (Stack Z Sem bot1, Ro m bot1 top1)
@@ -270,31 +284,32 @@ eqRowTest :: Modey m
                                        ,Stack Z Sem top0
                                        ,Stack Z Sem top1
                                        ))
-eqRowTest _ _ lvkz (stk0, R0) (stk1, R0) = pure $ Right (Some lvkz, stk0, stk1)
-eqRowTest m tm lvkz (stk0, RPr (_, ty0) r0) (stk1, RPr (_, ty1) r1) = do
+eqRowTest _ _ _ lvkz (stk0, R0) (stk1, R0) = pure $ Right (Some lvkz, stk0, stk1)
+eqRowTest m tm hopeSet lvkz (stk0, RPr (_, ty0) r0) (stk1, RPr (_, ty1) r1) = do
   let k = case m of
         Braty -> Star []
         Kerny -> Dollar []
-  ty0 <- sem stk0 ty0
-  ty1 <- sem stk1 ty1
-  eqWorker tm lvkz k ty0 ty1 >>= \case
-    Left msg -> pure $ Left msg
-    Right () -> eqRowTest m tm lvkz (stk0, r0) (stk1, r1)
-eqRowTest m tm (lvy :* kz) (stk0, REx (_, k0) r0) (stk1, REx (_, k1) r1) =
+  let headTest = do
+        (ty0,ty1) <- (,) <$> sem stk0 ty0 <*> sem stk1 ty1
+        eqWorker tm hopeSet lvkz k ty0 ty1
+  (first,rest) <- (,) <$> headTest <*> eqRowTest m tm hopeSet lvkz (stk0, r0) (stk1, r1)
+  throwLeft first
+  pure rest
+eqRowTest m tm hopeSet (lvy :* kz) (stk0, REx (_, k0) r0) (stk1, REx (_, k1) r1) =
   case kindEq k0 k1 of
       Left msg -> pure $ Left msg
       Right () -> do
         let l = semLvl lvy
-        eqRowTest m tm (Sy lvy :* (kz :<< k0)) (stk0 :<< l, r0) (stk1 :<< l, r1)
-eqRowTest m tm _ exp act = modily m $ pure . Left $ TypeMismatch tm (show exp) (show act)
+        eqRowTest m tm hopeSet (Sy lvy :* (kz :<< k0)) (stk0 :<< l, r0) (stk1 :<< l, r1)
+eqRowTest m tm _ _ exp act = modily m $ pure . Left $ TypeMismatch tm (show exp) (show act)
 
-eqTests :: String -> (Ny :* Stack Z TypeKind) n -> [TypeKind] -> [Sem] -> [Sem] -> Checking (Either ErrorMsg ())
+eqTests :: String -> (Ny :* Stack Z TypeKind) n -> S.Set End -> [TypeKind] -> [Sem] -> [Sem] -> Checking (Either ErrorMsg ())
   -- note alternative - traverse zip3/zip_same_len*2 + currying
   -- to get [Either ErrorMsg ()], then sequenceA -> Either ErrorMsg [()]
-eqTests tm lvkz = go
+eqTests tm lvkz hopeSet = go
  where
   go [] [] [] = pure (Right ())
-  go (k:ks) (u:us) (v:vs) = eqWorker tm lvkz k u v >>= \case
+  go (k:ks) (u:us) (v:vs) = eqWorker tm lvkz hopeSet k u v >>= \case
     Right () -> go ks us vs
     Left e -> pure $ Left e
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "

From ce1d1cf3bad2452390417a3bdc8fbc02b10df678 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 14:52:08 +0100
Subject: [PATCH 014/182] Revert "[broken] update eqworker"

This reverts commit b115f84a7388d42e399fd397c2741fd16e7b5790.
---
 brat/Brat/Eval.hs | 63 ++++++++++++++++++-----------------------------
 1 file changed, 24 insertions(+), 39 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index e6b7afdd..602ed9b1 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -219,64 +219,50 @@ dropRight = second (\_ -> ())
 
 eqWorker :: String              -- for error message
          -> (Ny :* Stack Z TypeKind) lv -- next Level & kinds for existing Levels
-         -> S.Set End           -- The hope set
          -> TypeKind            -- kind of both Sem's
          -> Sem                 -- expected
          -> Sem                 -- actual
          -> Checking (Either ErrorMsg ())
-eqWorker tm (lvy :* kz) hopeSet (TypeFor m ((_, k):ks)) exp act = do
+eqWorker tm (lvy :* kz) (TypeFor m ((_, k):ks)) exp act = do
   -- Higher kind
   let xz = B0 :< semLvl lvy
   exp <- applySem exp xz
   act <- applySem act xz
-  eqWorker tm (Sy lvy :* (kz :<< k)) hopeSet (TypeFor m ks) exp act
+  eqWorker tm (Sy lvy :* (kz :<< k)) (TypeFor m ks) exp act
 -- Nothing else is higher kinded
--- Hack: We should be able to cope when the stack of levels isn't empty
-eqWorker tm (Zy :* S0) hopeSet (SApp (SPar e) B0) act | S.member e hopeSet = do
-  v <- quote Zy act
-  case doesntOccur e v of
-    Left msg -> case v of
-      VApp (VPar e') B0 | e == e' -> pure (Right ())
-      -- TODO: Not all occurrences are toxic. The end could be in an argument
-      -- to a hoping variable which isn't used.
-      -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
-      _ -> pure $ Left msg
-    Right () -> defineEnd e v $> Right ()
-  
-eqWorker tm _ hopeSet Nat exp act = pure $
+eqWorker tm _ Nat exp act = pure $
   if getNum exp == getNum act then Right () else Left $
     TypeMismatch tm (show exp) (show act)
-eqWorker tm (lvy :* kz) hopeSet (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
+eqWorker tm (lvy :* kz) (TypeFor m []) (SApp f args) (SApp f' args') | f == f' =
   svKind (quoteVar lvy f) >>= \case
-    TypeFor m' ks | m == m' -> eqTests tm (lvy :* kz) hopeSet (snd <$> ks) (args <>> []) (args' <>> [])
+    TypeFor m' ks | m == m' -> eqTests tm (lvy :* kz) (snd <$> ks) (args <>> []) (args' <>> [])
       -- pattern should always match
     _ -> err $ InternalError "quote gave a surprising result"
  where
   svKind (VPar e) = kindOf (VPar e)
   svKind (VInx n) = pure $ proj kz n
-eqWorker tm lvkz hopeSet (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
+eqWorker tm lvkz (TypeFor m []) (SCon c args) (SCon c' args') | c == c' =
   req (TLup (m, c)) >>= \case
-        Just ks -> eqTests tm lvkz hopeSet (snd <$> ks) args args'
+        Just ks -> eqTests tm lvkz (snd <$> ks) args args'
         Nothing -> pure . Left . TypeErr $ "Type constructor " ++ show c
                         ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
-eqWorker tm lvkz hopeSet (Star []) (SFun m0 stk0 (ins0 :->> outs0)) (SFun m1 stk1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
-  eqRowTest m0 tm lvkz hopeSet (stk0,ins0) (stk1,ins1) >>= \case
+eqWorker tm lvkz (Star []) (SFun m0 stk0 (ins0 :->> outs0)) (SFun m1 stk1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
+  eqRowTest m0 tm lvkz (stk0,ins0) (stk1,ins1) >>= \case
     Left msg -> pure (Left msg)
     Right (Some lvkz, stk0, stk1) -> eqRowTest m0 tm lvkz (stk0, outs0) (stk1, outs1) <&> dropRight
-eqWorker tm lvkz hopeSet (TypeFor _ []) (SSum m0 stk0 rs0) (SSum m1 stk1 rs1)
+eqWorker tm lvkz (TypeFor _ []) (SSum m0 stk0 rs0) (SSum m1 stk1 rs1)
   | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
       Nothing -> pure (Left (TypeErr "Mismatched sum lengths"))
       Just rs -> traverse eqVariant rs <&> sequence_
  where
   eqVariant (Some r0, Some r1) = eqRowTest m0 tm lvkz (stk0,r0) (stk1,r1) <&> dropRight
-eqWorker tm _ _ _ v0 v1 = pure . Left $ TypeMismatch tm (show v0) (show v1)
+eqWorker tm _ _ v0 v1 = pure . Left $ TypeMismatch tm (show v0) (show v1)
 
 -- Type rows have bot0,bot1 dangling de Bruijn indices, which we instantiate with
 -- de Bruijn levels. As we go under binders in these rows, we add to the scope's
 -- environments, which we return at the end for eqCType.
 eqRowTest :: Modey m
           -> String -- The term we complain about in errors
-          -> S.Set End      -- the hope set
           -> (Ny :* Stack Z TypeKind) lv -- Next available level, the kinds of existing levels
           -> (Stack Z Sem bot0, Ro m bot0 top0)
           -> (Stack Z Sem bot1, Ro m bot1 top1)
@@ -284,32 +270,31 @@ eqRowTest :: Modey m
                                        ,Stack Z Sem top0
                                        ,Stack Z Sem top1
                                        ))
-eqRowTest _ _ _ lvkz (stk0, R0) (stk1, R0) = pure $ Right (Some lvkz, stk0, stk1)
-eqRowTest m tm hopeSet lvkz (stk0, RPr (_, ty0) r0) (stk1, RPr (_, ty1) r1) = do
+eqRowTest _ _ lvkz (stk0, R0) (stk1, R0) = pure $ Right (Some lvkz, stk0, stk1)
+eqRowTest m tm lvkz (stk0, RPr (_, ty0) r0) (stk1, RPr (_, ty1) r1) = do
   let k = case m of
         Braty -> Star []
         Kerny -> Dollar []
-  let headTest = do
-        (ty0,ty1) <- (,) <$> sem stk0 ty0 <*> sem stk1 ty1
-        eqWorker tm hopeSet lvkz k ty0 ty1
-  (first,rest) <- (,) <$> headTest <*> eqRowTest m tm hopeSet lvkz (stk0, r0) (stk1, r1)
-  throwLeft first
-  pure rest
-eqRowTest m tm hopeSet (lvy :* kz) (stk0, REx (_, k0) r0) (stk1, REx (_, k1) r1) =
+  ty0 <- sem stk0 ty0
+  ty1 <- sem stk1 ty1
+  eqWorker tm lvkz k ty0 ty1 >>= \case
+    Left msg -> pure $ Left msg
+    Right () -> eqRowTest m tm lvkz (stk0, r0) (stk1, r1)
+eqRowTest m tm (lvy :* kz) (stk0, REx (_, k0) r0) (stk1, REx (_, k1) r1) =
   case kindEq k0 k1 of
       Left msg -> pure $ Left msg
       Right () -> do
         let l = semLvl lvy
-        eqRowTest m tm hopeSet (Sy lvy :* (kz :<< k0)) (stk0 :<< l, r0) (stk1 :<< l, r1)
-eqRowTest m tm _ _ exp act = modily m $ pure . Left $ TypeMismatch tm (show exp) (show act)
+        eqRowTest m tm (Sy lvy :* (kz :<< k0)) (stk0 :<< l, r0) (stk1 :<< l, r1)
+eqRowTest m tm _ exp act = modily m $ pure . Left $ TypeMismatch tm (show exp) (show act)
 
-eqTests :: String -> (Ny :* Stack Z TypeKind) n -> S.Set End -> [TypeKind] -> [Sem] -> [Sem] -> Checking (Either ErrorMsg ())
+eqTests :: String -> (Ny :* Stack Z TypeKind) n -> [TypeKind] -> [Sem] -> [Sem] -> Checking (Either ErrorMsg ())
   -- note alternative - traverse zip3/zip_same_len*2 + currying
   -- to get [Either ErrorMsg ()], then sequenceA -> Either ErrorMsg [()]
-eqTests tm lvkz hopeSet = go
+eqTests tm lvkz = go
  where
   go [] [] [] = pure (Right ())
-  go (k:ks) (u:us) (v:vs) = eqWorker tm lvkz hopeSet k u v >>= \case
+  go (k:ks) (u:us) (v:vs) = eqWorker tm lvkz k u v >>= \case
     Right () -> go ks us vs
     Left e -> pure $ Left e
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "

From c064466bd566004888b7f11fb79760daf8462bb3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 20 Aug 2024 17:15:46 +0100
Subject: [PATCH 015/182] Add !,! test

---
 brat/examples/infer.brat | 3 +++
 1 file changed, 3 insertions(+)
 create mode 100644 brat/examples/infer.brat

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
new file mode 100644
index 00000000..db7b558d
--- /dev/null
+++ b/brat/examples/infer.brat
@@ -0,0 +1,3 @@
+map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
+map(_, _, _, []) = []
+map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)

From b33f1008f46e656f76237ebd18162c42a970a247 Mon Sep 17 00:00:00 2001
From: Mark Koch <mark.koch@quantinuum.com>
Date: Tue, 20 Aug 2024 17:18:42 +0100
Subject: [PATCH 016/182] Rewrite typeEq

---
 brat/Brat/Checker.hs               |   9 +-
 brat/Brat/Checker/Helpers.hs       |   5 +-
 brat/Brat/Checker/Monad.hs         |   3 +
 brat/Brat/Checker/SolvePatterns.hs |   1 -
 brat/Brat/Eval.hs                  | 134 ++++++++++++++++++++++++++---
 5 files changed, 133 insertions(+), 19 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index bcd637c1..02c68948 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -7,6 +7,7 @@ module Brat.Checker (checkBody
                     ,kindCheckAnnotation
                     ,kindCheckRow
                     ,tensor
+                    ,CheckConstraints
                     ) where
 
 import Control.Arrow (first)
@@ -116,13 +117,13 @@ checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ do
   let ot = binderToValue Braty o
   let ut = binderToValue Braty u
   if outputs
-    then typeEq (show tm) (Star []) ot ut
-    else typeEq (show tm) (Star []) ut ot
+    then typeEq (show tm) (Zy :* S0 :* S0) (Star []) ot ut
+    else typeEq (show tm) (Zy :* S0 :* S0) (Star []) ut ot
   wire (dangling, ot, hungry)
 checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ do
   if outputs
-    then typeEq (show tm) (Dollar []) ot ut
-    else typeEq (show tm) (Dollar []) ut ot
+    then typeEq (show tm) (Zy :* S0 :* S0) (Dollar []) ot ut
+    else typeEq (show tm) (Zy :* S0 :* S0) (Dollar []) ut ot
   wire (dangling, ot, hungry)
 
 checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 1464c18c..65a8eb8e 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -20,7 +20,7 @@ module Brat.Checker.Helpers {-(pullPortsRow, pullPortsSig
                             ,evalSrcRow, evalTgtRow
                             )-} where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows)
+import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType)
@@ -292,9 +292,6 @@ valueToBinder :: Modey m -> Val Z -> BinderType m
 valueToBinder Braty = Right
 valueToBinder Kerny = id
 
-defineEnd :: End -> Val Z -> Checking ()
-defineEnd e v = Define e v (const (Ret ()))
-
 defineSrc :: Src -> Val Z -> Checking ()
 defineSrc src v = defineEnd (ExEnd (end src)) v
 
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index af79b89a..3a87b222 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -368,3 +368,6 @@ suppressGraph (Req (Wire _) k) = suppressGraph (k ())
 suppressGraph (Req c k) = Req c (suppressGraph . k)
 suppressGraph (Define v e k) = Define v e (suppressGraph . k)
 suppressGraph (Yield st k) = Yield st (suppressGraph . k)
+
+defineEnd :: End -> Val Z -> Checking ()
+defineEnd e v = Define e v (const (Ret ()))
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 5733b450..dd1c777e 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -19,7 +19,6 @@ import Hasochism
 
 import Control.Monad (unless)
 import Data.Bifunctor (first)
-import Data.Foldable (traverse_)
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Data.Type.Equality ((:~:)(..), testEquality)
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 602ed9b1..1270699f 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -6,6 +6,7 @@ module Brat.Eval (EvMode(..)
                  ,apply
                  ,eval
                  ,sem
+                 ,doesntOccur
                  ,evalCTy
                  ,eqTest
                  ,kindEq
@@ -20,7 +21,7 @@ import Brat.Error (ErrorMsg(..))
 import Brat.Syntax.Value
 import Brat.Syntax.Common
 import Brat.UserName (plain)
-import Control.Monad.Freer (req)
+import Control.Monad.Freer
 import Bwd
 import Hasochism
 import Util (zip_same_length)
@@ -28,7 +29,9 @@ import Util (zip_same_length)
 import Data.Bifunctor (second)
 import Data.Functor
 import Data.Kind (Type)
+import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
+import Data.Foldable (traverse_)
 
 kindType :: TypeKind -> Val Z
 kindType Nat = TNat
@@ -191,14 +194,127 @@ kindOf (VPar e) = req (TypeOf e) >>= \case
     Kerny -> show ty
 kindOf (VInx n) = case n of {}
 
--- We should have made sure that the two values share the given kind
+-- Demand that two things are equal, we're allowed to solve variables in the
+-- hope set to make this true.
+-- Raises a user error if the vals cannot be made equal.
 typeEq :: String -- String representation of the term for error reporting
-   -> TypeKind -- The kind we're comparing at
-   -> Val Z -- Expected
-   -> Val Z -- Actual
-   -> Checking ()
-typeEq str k exp act = eqTest str k exp act >>= throwLeft
+       -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+       -> TypeKind -- The kind we're comparing at
+       -> Val n -- Expected
+       -> Val n -- Actual
+       -> Checking ()
+typeEq str stuff@(_ny :* _ks :* sems) k exp act = do
+  hopes <- req HopeSet
+  exp <- sem sems exp
+  act <- sem sems act
+  typeEqEta str stuff hopes k exp act
+
+-- Presumes that the hope set and the two `Sem`s are up to date.
+typeEqEta :: String -- String representation of the term for error reporting
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+          -> S.Set End -- The hope set
+          -> TypeKind -- The kind we're comparing at
+          -> Sem -- Expected
+          -> Sem -- Actual
+          -> Checking ()
+typeEqEta tm (lvy :* kz :* sems) hopeSet (TypeFor m ((_, k):ks)) exp act = do
+  -- Higher kinded things
+  let nextSem = semLvl lvy
+  let xz = B0 :< nextSem
+  exp <- applySem exp xz
+  act <- applySem act xz
+  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) hopeSet (TypeFor m ks) exp act
+-- Not higher kinded - check for flex terms
+-- (We don't solve under binders for now, so we only consider Zy here)
+-- "easy" flex cases
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet _ (SApp (SPar e) B0) act
+  | S.member e hopeSet = solveHope e act
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet _ exp (SApp (SPar e) B0)
+  | S.member e hopeSet = solveHope e exp
+typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
+  exp <- quote ny exp
+  act <- quote ny act
+  case [e | (VApp (VPar e) _) <- [exp,act], S.member e hopeSet] of
+    [] -> typeEqRigid tm stuff k exp act
+    es -> do
+      Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
+
+-- This will update the hopeSet, potentially invalidating things that have been eval'd
+-- The Sem is closed, for now.
+solveHope :: End -> Sem -> Checking ()
+solveHope e v = quote Zy v >>= \v -> case doesntOccur e v of
+  Right () -> Define e v (const (pure ()))
+  Left msg -> case v of
+    VApp (VPar e') B0 | e == e' -> pure ()
+    -- TODO: Not all occurrences are toxic. The end could be in an argument
+    -- to a hoping variable which isn't used.
+    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
+    _ -> err msg
+
+typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
+typeEqs _ _ [] [] [] = pure ()
+typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq tm stuff k exp act
+typeEqs _ _ _ _ _ = typeErr "arity mismatch"
+
+kindForMode :: Modey m -> TypeKind
+kindForMode Braty = Star []
+kindForMode Kerny = Dollar []
+
+typeEqRow :: forall m lv top0 top1. Modey m
+          -> String -- The term we complain about in errors
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) lv -- Next available level, the kinds of existing levels
+          -> Ro m lv top0
+          -> Ro m lv top1
+          -> Checking (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
+                            :* 
+                            (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
+                      )
+typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)))
+typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEq tm stuff (kindForMode m) ty1 ty2 *> typeEqRow m tm stuff ro1 ro2
+typeEqRow m tm (ny :* kz :* semz) (REx (_,k1) ro1) (REx (_,k2) ro2) | k1 == k2 = typeEqRow m tm (Sy ny :* (kz :<< k1) :* (semz :<< semLvl ny)) ro1 ro2
+typeEqRow _ _ _ _ _ = typeErr "Mismatched rows"
+
+-- Calls to typeEqRigid *must* start with rigid types to ensure termination
+typeEqRigid :: String -- String representation of the term for error reporting
+            -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+            -> TypeKind -- The kind we're comparing at
+            -> Val n -- Expected
+            -> Val n -- Actual
+            -> Checking ()
+typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
+  -- TODO: What if there's hope in the numbers?
+  exp <- sem semz exp
+  act <- sem semz act
+  if getNum exp == getNum act
+  then pure ()
+  else err $ TypeMismatch tm (show exp) (show act)
+typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
+  svKind f >>= \case
+    TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
+      -- pattern should always match
+    _ -> err $ InternalError "quote gave a surprising result"
+ where
+  svKind (VPar e) = kindOf (VPar e)
+  svKind (VInx n) = pure $ proj kz n
+typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
+  req (TLup (m, c)) >>= \case
+        Just ks -> typeEqs tm lvkz (snd <$> ks) args args'
+        Nothing -> err $ TypeErr $ "Type constructor " ++ show c
+                        ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
+typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
+  typeEqRow m0 tm lvkz ins0 ins1 >>= \case
+    Some (lvkz :* (Refl :* Refl)) -> () <$ typeEqRow m0 tm lvkz outs0 outs1
+typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
+  | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
+      Nothing -> typeErr "Mismatched sum lengths"
+      Just rs -> () <$ traverse eqVariant rs
+ where
+  eqVariant (Some r0, Some r1) = () <$ typeEqRow m0 tm lvkz r0 r1
+typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
+
 
+-------- for SolvePatterns usage: not allowed to solve hopes,
+-- and if pattern insoluble, it's not a type error (it's a "pattern match case unreachable")
 eqTest :: String -- String representation of the term for error reporting
        -> TypeKind -- The kind we're comparing at
        -> Val Z -- Expected
@@ -272,9 +388,7 @@ eqRowTest :: Modey m
                                        ))
 eqRowTest _ _ lvkz (stk0, R0) (stk1, R0) = pure $ Right (Some lvkz, stk0, stk1)
 eqRowTest m tm lvkz (stk0, RPr (_, ty0) r0) (stk1, RPr (_, ty1) r1) = do
-  let k = case m of
-        Braty -> Star []
-        Kerny -> Dollar []
+  let k = kindForMode m
   ty0 <- sem stk0 ty0
   ty1 <- sem stk1 ty1
   eqWorker tm lvkz k ty0 ty1 >>= \case

From c093cedd0ad18b8ed9f081e0eb4123a11089bba3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 21 Aug 2024 10:59:20 +0100
Subject: [PATCH 017/182] feat: Solve numbers that are just variables

---
 brat/Brat/Eval.hs        | 21 ++++++++++++++-------
 brat/examples/infer.brat |  4 ++++
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 1270699f..e50ecf06 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -209,6 +209,10 @@ typeEq str stuff@(_ny :* _ks :* sems) k exp act = do
   act <- sem sems act
   typeEqEta str stuff hopes k exp act
 
+isNumVar :: Sem -> Maybe SVar
+isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
+isNumVar _ = Nothing
+
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
@@ -227,10 +231,13 @@ typeEqEta tm (lvy :* kz :* sems) hopeSet (TypeFor m ((_, k):ks)) exp act = do
 -- Not higher kinded - check for flex terms
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- "easy" flex cases
-typeEqEta _tm (Zy :* _ks :* _sems) hopeSet _ (SApp (SPar e) B0) act
-  | S.member e hopeSet = solveHope e act
-typeEqEta _tm (Zy :* _ks :* _sems) hopeSet _ exp (SApp (SPar e) B0)
-  | S.member e hopeSet = solveHope e exp
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k (SApp (SPar e) B0) act
+  | S.member e hopeSet = solveHope k e act
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k exp (SApp (SPar e) B0)
+  | S.member e hopeSet = solveHope k e exp
+typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
+  | Just (SPar e) <- isNumVar exp, S.member e hopeSet = solveHope Nat e act
+  | Just (SPar e) <- isNumVar act, S.member e hopeSet = solveHope Nat e exp
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
@@ -241,8 +248,8 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
 
 -- This will update the hopeSet, potentially invalidating things that have been eval'd
 -- The Sem is closed, for now.
-solveHope :: End -> Sem -> Checking ()
-solveHope e v = quote Zy v >>= \v -> case doesntOccur e v of
+solveHope :: TypeKind -> End -> Sem -> Checking ()
+solveHope _k e v = quote Zy v >>= \v -> case doesntOccur e v of
   Right () -> Define e v (const (pure ()))
   Left msg -> case v of
     VApp (VPar e') B0 | e == e' -> pure ()
@@ -266,7 +273,7 @@ typeEqRow :: forall m lv top0 top1. Modey m
           -> Ro m lv top0
           -> Ro m lv top1
           -> Checking (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
-                            :* 
+                            :*
                             (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
                       )
 typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)))
diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index db7b558d..dacdb0a7 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -1,3 +1,7 @@
 map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
 map(_, _, _, []) = []
 map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
+
+mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
+mapVec(_, _, _, _, []) = []
+mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)

From 7986539d75d165995c3dd1e91f3dd30e827a5470 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 11:08:15 +0100
Subject: [PATCH 018/182] typeEqRow returns sub-problems

---
 brat/Brat/Eval.hs | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index e50ecf06..b8c665a3 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -267,19 +267,19 @@ kindForMode :: Modey m -> TypeKind
 kindForMode Braty = Star []
 kindForMode Kerny = Dollar []
 
-typeEqRow :: forall m lv top0 top1. Modey m
+typeEqRow :: Modey m
           -> String -- The term we complain about in errors
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) lv -- Next available level, the kinds of existing levels
           -> Ro m lv top0
           -> Ro m lv top1
-          -> Checking (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
-                            :*
-                            (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
-                      )
-typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)))
-typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEq tm stuff (kindForMode m) ty1 ty2 *> typeEqRow m tm stuff ro1 ro2
+          -> Either ErrorMsg (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
+                                   :* (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
+                             ,[Checking ()] -- subproblems to run in parallel
+                             )
+typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)), [])
+typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEqRow m tm stuff ro1 ro2 <&> \(res, probs) -> (res, (typeEq tm stuff (kindForMode m) ty1 ty2):probs)
 typeEqRow m tm (ny :* kz :* semz) (REx (_,k1) ro1) (REx (_,k2) ro2) | k1 == k2 = typeEqRow m tm (Sy ny :* (kz :<< k1) :* (semz :<< semLvl ny)) ro1 ro2
-typeEqRow _ _ _ _ _ = typeErr "Mismatched rows"
+typeEqRow _ _ _ _ _ = Left $ TypeErr "Mismatched rows"
 
 -- Calls to typeEqRigid *must* start with rigid types to ensure termination
 typeEqRigid :: String -- String representation of the term for error reporting
@@ -308,15 +308,16 @@ typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
         Just ks -> typeEqs tm lvkz (snd <$> ks) args args'
         Nothing -> err $ TypeErr $ "Type constructor " ++ show c
                         ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
-typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 =
-  typeEqRow m0 tm lvkz ins0 ins1 >>= \case
-    Some (lvkz :* (Refl :* Refl)) -> () <$ typeEqRow m0 tm lvkz outs0 outs1
+typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 = do
+  probs :: [Checking ()] <- throwLeft $ typeEqRow m0 tm lvkz ins0 ins1 >>= \case -- this is in Either ErrorMsg
+        (Some (lvkz :* (Refl :* Refl)), ps1) -> typeEqRow m0 tm lvkz outs0 outs1 <&> (ps1++) . snd
+  sequence_ probs
 typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
   | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
       Nothing -> typeErr "Mismatched sum lengths"
-      Just rs -> () <$ traverse eqVariant rs
+      Just rs -> traverse eqVariant rs >>= (sequence_ . concat)
  where
-  eqVariant (Some r0, Some r1) = () <$ typeEqRow m0 tm lvkz r0 r1
+  eqVariant (Some r0, Some r1) = throwLeft $ (snd <$> typeEqRow m0 tm lvkz r0 r1)
 typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
 
 

From 7afa2c4afc2be98a822291013ae1500b63b02827 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 11:22:35 +0100
Subject: [PATCH 019/182] sequence_ -> traverse_ id

---
 brat/Brat/Eval.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index b8c665a3..adf52d8a 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -311,11 +311,11 @@ typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
 typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 = do
   probs :: [Checking ()] <- throwLeft $ typeEqRow m0 tm lvkz ins0 ins1 >>= \case -- this is in Either ErrorMsg
         (Some (lvkz :* (Refl :* Refl)), ps1) -> typeEqRow m0 tm lvkz outs0 outs1 <&> (ps1++) . snd
-  sequence_ probs
+  traverse_ id probs -- uses Applicative (unlike sequence_ which uses Monad), hence parallelized
 typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
   | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
       Nothing -> typeErr "Mismatched sum lengths"
-      Just rs -> traverse eqVariant rs >>= (sequence_ . concat)
+      Just rs -> traverse eqVariant rs >>= (traverse_ id . concat)
  where
   eqVariant (Some r0, Some r1) = throwLeft $ (snd <$> typeEqRow m0 tm lvkz r0 r1)
 typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)

From 265a5b637dbe6aaadde7a0dcef907b7d9b13391d Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 21 Aug 2024 12:33:08 +0100
Subject: [PATCH 020/182] [broken] Build things to wire into solved hopes

---
 brat/Brat/Checker.hs            |   1 +
 brat/Brat/Checker/Helpers.hs    |  10 ++
 brat/Brat/Checker/Monad.hs      |   1 +
 brat/Brat/Checker/SolveHoles.hs | 204 ++++++++++++++++++++++++++++++++
 brat/Brat/Checker/Types.hs      |   5 +
 brat/Brat/Eval.hs               | 138 ++-------------------
 brat/brat.cabal                 |   1 +
 brat/test/Test/Substitution.hs  |   2 +-
 8 files changed, 230 insertions(+), 132 deletions(-)
 create mode 100644 brat/Brat/Checker/SolveHoles.hs

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 02c68948..22224fbc 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -27,6 +27,7 @@ import Prelude hiding (filter)
 import Brat.Checker.Helpers
 import Brat.Checker.Monad
 import Brat.Checker.Quantity
+import Brat.Checker.SolveHoles (typeEq)
 import Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
 import Brat.Checker.Types
 import Brat.Constructors
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 65a8eb8e..63172f7f 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -410,3 +410,13 @@ runArith (NumValue upl grol) Pow (NumValue upr gror)
  -- 2^(2^k * upr) + 2^(2^k * upr) * (full(2^(k + k') * mono))
  = pure $ NumValue (upl ^ upr) (StrictMonoFun (StrictMono (l * upr) (Full (StrictMono (k + k') mono))))
 runArith _ _ _ = Nothing
+
+buildArithOp :: ArithOp -> Checking ((Tgt, Tgt), Src)
+buildArithOp op = do
+  (_, [(lhs,_), (rhs,_)], [(out,_)], _) <- next "" (ArithNode op) (S0, Some (Zy :* S0)) (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0)) (RPr ("value", TNat) R0)
+  pure ((lhs, rhs), out)
+
+buildConst :: SimpleTerm -> Val Z -> Checking Src
+buildConst tm ty = do
+  (_, _, [(out,_)], _) <- next "" (Const tm) (S0, Some (Zy :* S0)) R0 (RPr ("value", ty) R0)
+  pure out
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 3a87b222..a78c40ba 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -57,6 +57,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , kconstructors :: ConstructorMap Kernel
                    , typeConstructors :: M.Map (Mode, UserName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map UserName Alias
+                   -- All the ends here should be targets
                    , hopeSet :: S.Set End
                    }
 
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
new file mode 100644
index 00000000..6bbc2e74
--- /dev/null
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -0,0 +1,204 @@
+module Brat.Checker.SolveHoles (typeEq) where
+
+import Brat.Checker.Monad
+import Brat.Checker.Types (kindForMode)
+import Brat.Checker.Helpers (buildArithOp, buildConst)
+import Brat.Error (ErrorMsg(..))
+import Brat.Eval
+import Brat.Syntax.Common
+import Brat.Syntax.Simple (SimpleTerm(..))
+import Brat.Syntax.Value
+import Control.Monad.Freer
+import Bwd
+import Hasochism
+import Util (zip_same_length)
+
+import Data.Foldable (traverse_)
+import Data.Functor
+import qualified Data.Set as S
+import Data.Type.Equality (TestEquality(..), (:~:)(..))
+
+import Brat.Naming
+
+-- Demand that two things are equal, we're allowed to solve variables in the
+-- hope set to make this true.
+-- Raises a user error if the vals cannot be made equal.
+typeEq :: String -- String representation of the term for error reporting
+       -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+       -> TypeKind -- The kind we're comparing at
+       -> Val n -- Expected
+       -> Val n -- Actual
+       -> Checking ()
+typeEq str stuff@(_ny :* _ks :* sems) k exp act = do
+  hopes <- req HopeSet
+  exp <- sem sems exp
+  act <- sem sems act
+  typeEqEta str stuff hopes k exp act
+
+isNumVar :: Sem -> Maybe SVar
+isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
+isNumVar _ = Nothing
+
+-- Presumes that the hope set and the two `Sem`s are up to date.
+typeEqEta :: String -- String representation of the term for error reporting
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+          -> S.Set End -- The hope set
+          -> TypeKind -- The kind we're comparing at
+          -> Sem -- Expected
+          -> Sem -- Actual
+          -> Checking ()
+typeEqEta tm (lvy :* kz :* sems) hopeSet (TypeFor m ((_, k):ks)) exp act = do
+  -- Higher kinded things
+  let nextSem = semLvl lvy
+  let xz = B0 :< nextSem
+  exp <- applySem exp xz
+  act <- applySem act xz
+  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) hopeSet (TypeFor m ks) exp act
+-- Not higher kinded - check for flex terms
+-- (We don't solve under binders for now, so we only consider Zy here)
+-- "easy" flex cases
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k (SApp (SPar e) B0) act
+  | S.member e hopeSet = solveHope k e act
+typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k exp (SApp (SPar e) B0)
+  | S.member e hopeSet = solveHope k e exp
+typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
+  | Just (SPar e) <- isNumVar exp, S.member e hopeSet = solveHope Nat e act
+  | Just (SPar e) <- isNumVar act, S.member e hopeSet = solveHope Nat e exp
+typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
+  exp <- quote ny exp
+  act <- quote ny act
+  case [e | (VApp (VPar e) _) <- [exp,act], S.member e hopeSet] of
+    [] -> typeEqRigid tm stuff k exp act
+    es -> do
+      Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
+
+-- This will update the hopeSet, potentially invalidating things that have been eval'd
+-- The Sem is closed, for now.
+-- TODO: This needs to update the BRAT graph with the solution.
+solveHope :: TypeKind -> End -> Sem -> Checking ()
+solveHope k e v = quote Zy v >>= \v -> case doesntOccur e v of
+  Right () -> Define e v $ \_ -> do
+    dangling <- case (k, v) of
+      (Nat, VNum v) -> buildNatVal v
+      (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
+      _ -> buildConst Unit TUnit
+    let InEnd i = e
+    req $ Wire (end dangling, kindType k, i)
+    pure ()
+  Left msg -> case v of
+    VApp (VPar e') B0 | e == e' -> pure ()
+    -- TODO: Not all occurrences are toxic. The end could be in an argument
+    -- to a hoping variable which isn't used.
+    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
+    _ -> err msg
+
+typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
+typeEqs _ _ [] [] [] = pure ()
+typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq tm stuff k exp act
+typeEqs _ _ _ _ _ = typeErr "arity mismatch"
+
+typeEqRow :: Modey m
+          -> String -- The term we complain about in errors
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) lv -- Next available level, the kinds of existing levels
+          -> Ro m lv top0
+          -> Ro m lv top1
+          -> Either ErrorMsg (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
+                                   :* (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
+                             ,[Checking ()] -- subproblems to run in parallel
+                             )
+typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)), [])
+typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEqRow m tm stuff ro1 ro2 <&> \(res, probs) -> (res, (typeEq tm stuff (kindForMode m) ty1 ty2):probs)
+typeEqRow m tm (ny :* kz :* semz) (REx (_,k1) ro1) (REx (_,k2) ro2) | k1 == k2 = typeEqRow m tm (Sy ny :* (kz :<< k1) :* (semz :<< semLvl ny)) ro1 ro2
+typeEqRow _ _ _ _ _ = Left $ TypeErr "Mismatched rows"
+
+-- Calls to typeEqRigid *must* start with rigid types to ensure termination
+typeEqRigid :: String -- String representation of the term for error reporting
+            -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+            -> TypeKind -- The kind we're comparing at
+            -> Val n -- Expected
+            -> Val n -- Actual
+            -> Checking ()
+typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
+  -- TODO: What if there's hope in the numbers?
+  exp <- sem semz exp
+  act <- sem semz act
+  if getNum exp == getNum act
+  then pure ()
+  else err $ TypeMismatch tm (show exp) (show act)
+typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
+  svKind f >>= \case
+    TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
+      -- pattern should always match
+    _ -> err $ InternalError "quote gave a surprising result"
+ where
+  svKind (VPar e) = kindOf (VPar e)
+  svKind (VInx n) = pure $ proj kz n
+typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
+  req (TLup (m, c)) >>= \case
+        Just ks -> typeEqs tm lvkz (snd <$> ks) args args'
+        Nothing -> err $ TypeErr $ "Type constructor " ++ show c
+                        ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
+typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 = do
+  probs :: [Checking ()] <- throwLeft $ typeEqRow m0 tm lvkz ins0 ins1 >>= \case -- this is in Either ErrorMsg
+        (Some (lvkz :* (Refl :* Refl)), ps1) -> typeEqRow m0 tm lvkz outs0 outs1 <&> (ps1++) . snd
+  traverse_ id probs -- uses Applicative (unlike sequence_ which uses Monad), hence parallelized
+typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
+  | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
+      Nothing -> typeErr "Mismatched sum lengths"
+      Just rs -> traverse eqVariant rs >>= (traverse_ id . concat)
+ where
+  eqVariant (Some r0, Some r1) = throwLeft $ (snd <$> typeEqRow m0 tm lvkz r0 r1)
+typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
+
+buildNatVal :: NumVal (VVar Z) -> Checking Src
+buildNatVal _nv@(NumValue n gro) = case n of
+  0 -> buildGro gro
+  n -> do
+    nDangling <- buildNum n
+    ((lhs,rhs),out) <- buildArithOp Add
+    src <- buildGro gro
+    wire (nDangling, TNat, lhs)
+    wire (src, TNat, rhs)
+    pure out
+ where
+  wire :: (Src, Val Z, Tgt) -> Checking ()
+  wire (src, ty, tgt) = req $ Wire (end src, ty, end tgt)
+
+  buildNum :: Integer -> Checking Src
+  buildNum n = buildConst (Num (fromIntegral n)) TNat
+
+  buildGro :: Fun00 (VVar Z) -> Checking Src
+  buildGro Constant0 = buildNum 0
+  buildGro (StrictMonoFun sm) = buildSM sm
+
+  buildSM :: StrictMono (VVar Z) -> Checking Src
+  buildSM (StrictMono k mono) = do
+    -- Calculate 2^k as `factor`
+    two <- buildNum 2
+    kDangling <- buildNum k
+    ((lhs,rhs),factor) <- buildArithOp Pow
+    wire (two, TNat, lhs)
+    wire (kDangling, TNat, rhs)
+    -- Multiply mono by 2^k
+    ((lhs,rhs),out) <- buildArithOp Mul
+    monoDangling <- buildMono mono
+    wire (factor, TNat, lhs)
+    wire (monoDangling, TNat, rhs)
+    pure out
+
+  buildMono :: Monotone (VVar Z) -> Checking Src
+  buildMono (Linear (VPar (ExEnd e))) = pure $ NamedPort e "numval"
+  buildMono (Full sm) = do
+    -- Calculate 2^n as `outPlus1`
+    two <- buildNum 2
+    dangling <- buildSM sm
+    ((lhs,rhs),outPlus1) <- buildArithOp Pow
+    wire (two, TNat, lhs)
+    wire (dangling, TNat, rhs)
+    -- Then subtract 1
+    one <- buildNum 1
+    ((lhs,rhs),out) <- buildArithOp Sub
+    wire (outPlus1, TNat, lhs)
+    wire (one, TNat, rhs)
+    pure out
+  buildMono _ = pure (NamedPort (Ex (MkName [("",-1)]) 0) "")--err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
diff --git a/brat/Brat/Checker/Types.hs b/brat/Brat/Checker/Types.hs
index e2ff5594..2428c83f 100644
--- a/brat/Brat/Checker/Types.hs
+++ b/brat/Brat/Checker/Types.hs
@@ -9,6 +9,7 @@ module Brat.Checker.Types (Overs, Unders
                           ,emptyEnv
                           ,TypedHole(..), HoleTag(..), HoleData(..)
                           ,initStore
+                          ,kindForMode
                           ) where
 
 import Brat.Checker.Quantity
@@ -111,3 +112,7 @@ initStore = Store M.empty M.empty
 
 instance Semigroup Store where
   (Store ks vs) <> (Store ks' vs') = Store (ks <> ks') (vs <> vs')
+
+kindForMode :: Modey m -> TypeKind
+kindForMode Braty = Star []
+kindForMode Kerny = Dollar []
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index adf52d8a..2bea55d5 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -4,22 +4,26 @@ module Brat.Eval (EvMode(..)
                  ,ValPat(..)
                  ,NumPat(..)
                  ,apply
+                 ,applySem
                  ,eval
                  ,sem
+                 ,semLvl
                  ,doesntOccur
                  ,evalCTy
                  ,eqTest
+                 ,getNum
                  ,kindEq
+                 ,kindOf
                  ,kindType
                  ,numVal
-                 ,typeEq
+                 ,quote
                  ) where
 
 import Brat.Checker.Monad
-import Brat.Checker.Types (EndType(..))
+import Brat.Checker.Types (EndType(..), kindForMode)
 import Brat.Error (ErrorMsg(..))
-import Brat.Syntax.Value
 import Brat.Syntax.Common
+import Brat.Syntax.Value
 import Brat.UserName (plain)
 import Control.Monad.Freer
 import Bwd
@@ -29,7 +33,6 @@ import Util (zip_same_length)
 import Data.Bifunctor (second)
 import Data.Functor
 import Data.Kind (Type)
-import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import Data.Foldable (traverse_)
 
@@ -194,133 +197,6 @@ kindOf (VPar e) = req (TypeOf e) >>= \case
     Kerny -> show ty
 kindOf (VInx n) = case n of {}
 
--- Demand that two things are equal, we're allowed to solve variables in the
--- hope set to make this true.
--- Raises a user error if the vals cannot be made equal.
-typeEq :: String -- String representation of the term for error reporting
-       -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-       -> TypeKind -- The kind we're comparing at
-       -> Val n -- Expected
-       -> Val n -- Actual
-       -> Checking ()
-typeEq str stuff@(_ny :* _ks :* sems) k exp act = do
-  hopes <- req HopeSet
-  exp <- sem sems exp
-  act <- sem sems act
-  typeEqEta str stuff hopes k exp act
-
-isNumVar :: Sem -> Maybe SVar
-isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
-isNumVar _ = Nothing
-
--- Presumes that the hope set and the two `Sem`s are up to date.
-typeEqEta :: String -- String representation of the term for error reporting
-          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-          -> S.Set End -- The hope set
-          -> TypeKind -- The kind we're comparing at
-          -> Sem -- Expected
-          -> Sem -- Actual
-          -> Checking ()
-typeEqEta tm (lvy :* kz :* sems) hopeSet (TypeFor m ((_, k):ks)) exp act = do
-  -- Higher kinded things
-  let nextSem = semLvl lvy
-  let xz = B0 :< nextSem
-  exp <- applySem exp xz
-  act <- applySem act xz
-  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) hopeSet (TypeFor m ks) exp act
--- Not higher kinded - check for flex terms
--- (We don't solve under binders for now, so we only consider Zy here)
--- "easy" flex cases
-typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k (SApp (SPar e) B0) act
-  | S.member e hopeSet = solveHope k e act
-typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k exp (SApp (SPar e) B0)
-  | S.member e hopeSet = solveHope k e exp
-typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
-  | Just (SPar e) <- isNumVar exp, S.member e hopeSet = solveHope Nat e act
-  | Just (SPar e) <- isNumVar act, S.member e hopeSet = solveHope Nat e exp
-typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
-  exp <- quote ny exp
-  act <- quote ny act
-  case [e | (VApp (VPar e) _) <- [exp,act], S.member e hopeSet] of
-    [] -> typeEqRigid tm stuff k exp act
-    es -> do
-      Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
-
--- This will update the hopeSet, potentially invalidating things that have been eval'd
--- The Sem is closed, for now.
-solveHope :: TypeKind -> End -> Sem -> Checking ()
-solveHope _k e v = quote Zy v >>= \v -> case doesntOccur e v of
-  Right () -> Define e v (const (pure ()))
-  Left msg -> case v of
-    VApp (VPar e') B0 | e == e' -> pure ()
-    -- TODO: Not all occurrences are toxic. The end could be in an argument
-    -- to a hoping variable which isn't used.
-    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
-    _ -> err msg
-
-typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
-typeEqs _ _ [] [] [] = pure ()
-typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq tm stuff k exp act
-typeEqs _ _ _ _ _ = typeErr "arity mismatch"
-
-kindForMode :: Modey m -> TypeKind
-kindForMode Braty = Star []
-kindForMode Kerny = Dollar []
-
-typeEqRow :: Modey m
-          -> String -- The term we complain about in errors
-          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) lv -- Next available level, the kinds of existing levels
-          -> Ro m lv top0
-          -> Ro m lv top1
-          -> Either ErrorMsg (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
-                                   :* (((:~:) top0) :* ((:~:) top1))) -- Proofs both input rows have same length (quantified over by Some)
-                             ,[Checking ()] -- subproblems to run in parallel
-                             )
-typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)), [])
-typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEqRow m tm stuff ro1 ro2 <&> \(res, probs) -> (res, (typeEq tm stuff (kindForMode m) ty1 ty2):probs)
-typeEqRow m tm (ny :* kz :* semz) (REx (_,k1) ro1) (REx (_,k2) ro2) | k1 == k2 = typeEqRow m tm (Sy ny :* (kz :<< k1) :* (semz :<< semLvl ny)) ro1 ro2
-typeEqRow _ _ _ _ _ = Left $ TypeErr "Mismatched rows"
-
--- Calls to typeEqRigid *must* start with rigid types to ensure termination
-typeEqRigid :: String -- String representation of the term for error reporting
-            -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-            -> TypeKind -- The kind we're comparing at
-            -> Val n -- Expected
-            -> Val n -- Actual
-            -> Checking ()
-typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
-  -- TODO: What if there's hope in the numbers?
-  exp <- sem semz exp
-  act <- sem semz act
-  if getNum exp == getNum act
-  then pure ()
-  else err $ TypeMismatch tm (show exp) (show act)
-typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
-  svKind f >>= \case
-    TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
-      -- pattern should always match
-    _ -> err $ InternalError "quote gave a surprising result"
- where
-  svKind (VPar e) = kindOf (VPar e)
-  svKind (VInx n) = pure $ proj kz n
-typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
-  req (TLup (m, c)) >>= \case
-        Just ks -> typeEqs tm lvkz (snd <$> ks) args args'
-        Nothing -> err $ TypeErr $ "Type constructor " ++ show c
-                        ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
-typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 = do
-  probs :: [Checking ()] <- throwLeft $ typeEqRow m0 tm lvkz ins0 ins1 >>= \case -- this is in Either ErrorMsg
-        (Some (lvkz :* (Refl :* Refl)), ps1) -> typeEqRow m0 tm lvkz outs0 outs1 <&> (ps1++) . snd
-  traverse_ id probs -- uses Applicative (unlike sequence_ which uses Monad), hence parallelized
-typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
-  | Just Refl <- testEquality m0 m1 = case zip_same_length rs0 rs1 of
-      Nothing -> typeErr "Mismatched sum lengths"
-      Just rs -> traverse eqVariant rs >>= (traverse_ id . concat)
- where
-  eqVariant (Some r0, Some r1) = throwLeft $ (snd <$> typeEqRow m0 tm lvkz r0 r1)
-typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
-
-
 -------- for SolvePatterns usage: not allowed to solve hopes,
 -- and if pattern insoluble, it's not a type error (it's a "pattern match case unreachable")
 eqTest :: String -- String representation of the term for error reporting
diff --git a/brat/brat.cabal b/brat/brat.cabal
index 001c2bde..e091d751 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -66,6 +66,7 @@ library
                        Brat.Checker.Helpers,
                        Brat.Checker.Helpers.Nodes,
                        Brat.Checker.Monad,
+                       Brat.Checker.SolveHoles,
                        Brat.Checker.SolvePatterns,
                        Brat.Checker.Types,
                        Brat.Compile.Hugr,
diff --git a/brat/test/Test/Substitution.hs b/brat/test/Test/Substitution.hs
index d9c41aac..75640638 100644
--- a/brat/test/Test/Substitution.hs
+++ b/brat/test/Test/Substitution.hs
@@ -1,9 +1,9 @@
 module Test.Substitution where
 
 import Brat.Checker.Monad
+import Brat.Checker.SolveHoles
 import Brat.Checker.Types
 import Brat.Error
-import Brat.Eval (typeEq)
 import Brat.Naming
 import Brat.Syntax.Common
 import Brat.Syntax.Value

From 2a360b6c27d905a5546d14a8e7fa44037c0df923 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 21 Aug 2024 12:50:45 +0100
Subject: [PATCH 021/182] Don't hide that error

---
 brat/Brat/Checker/SolveHoles.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 6bbc2e74..775664cb 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -18,8 +18,6 @@ import Data.Functor
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
-import Brat.Naming
-
 -- Demand that two things are equal, we're allowed to solve variables in the
 -- hope set to make this true.
 -- Raises a user error if the vals cannot be made equal.
@@ -151,7 +149,7 @@ typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
 typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
 
 buildNatVal :: NumVal (VVar Z) -> Checking Src
-buildNatVal _nv@(NumValue n gro) = case n of
+buildNatVal nv@(NumValue n gro) = case n of
   0 -> buildGro gro
   n -> do
     nDangling <- buildNum n
@@ -201,4 +199,4 @@ buildNatVal _nv@(NumValue n gro) = case n of
     wire (outPlus1, TNat, lhs)
     wire (one, TNat, rhs)
     pure out
-  buildMono _ = pure (NamedPort (Ex (MkName [("",-1)]) 0) "")--err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
+  buildMono _ = err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv

From 6be252b401135f13598520296421ff22bad865c9 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 09:38:42 +0100
Subject: [PATCH 022/182] Fix typechecking for infer example

---
 brat/Brat/Checker/SolvePatterns.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index dd1c777e..cf62e7cb 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -103,6 +103,7 @@ solve my ((src, PCon c abs):p) = do
         (tests, sol) <- solve my p
         pure ((src, PrimLitTest (Num 0)):tests, sol)
       _ -> case M.lookup c natConstructors of
+        -- This `relationToInner` is very sus - it doesn't do any wiring!
         Just (Just _, relationToInner) -> do
           (node, [], kids@[(dangling, _)], _) <- next "unpacked_nat" Hypo (S0, Some (Zy :* S0))
             R0 -- we don't need to wire the src in; we just need the inner stuff
@@ -140,13 +141,17 @@ solveConstructor :: EvMode m
                              )
 solveConstructor my src (c, abs) ty p = do
   (CArgs pats _ patRo argRo, (tycon, tyargs)) <- lookupConstructor my c ty
-  (_, _, _, stuff) <- next "type_args" Hypo (S0, Some (Zy :* S0)) patRo R0
+  -- Create a row of hypothetical kinds which contextualise the arguments to the
+  -- constructor.
+  (_, _, _, stuff) <- next "type_args" Hypo (S0, Some (Zy :* S0)) R0 patRo
   (node, _, patArgWires, _) <- let ?my = my in anext "val_args" Hypo stuff R0 argRo
   trackM ("Constructor " ++ show c ++ "; type " ++ show ty)
   case (snd stuff) of
     Some (_ :* patEnds) -> do
       trackM (show pats)
       trackM (show patEnds)
+      -- Match the patterns for `c` against the ends of the Hypo node, to
+      -- produce the terms that we're interested in
       let (lhss, leftovers) = patVals pats (stkList patEnds)
       unless (null leftovers) $ error "There's a bug in the constructor table"
       tyArgKinds <- tlup (Brat, tycon)
@@ -193,6 +198,7 @@ instantiateMeta e val = do
   Define e val (const (Ret ()))
 
 
+-- Need to keep track of which way we're solving - which side is known/unknown
 unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)

From 646f6f9011ece60ac2aaf74218bc837721200db7 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 11:26:36 +0100
Subject: [PATCH 023/182] feat: Complain when we have remaining Nat-kinded
 holes

---
 brat/Brat/Checker.hs                            | 17 ++++++++++++++---
 brat/Brat/Error.hs                              |  8 +++++---
 brat/test/golden/error/remaining-nat-hopes.brat |  8 ++++++++
 .../error/remaining-nat-hopes.brat.golden       |  5 +++++
 4 files changed, 32 insertions(+), 6 deletions(-)
 create mode 100644 brat/test/golden/error/remaining-nat-hopes.brat
 create mode 100644 brat/test/golden/error/remaining-nat-hopes.brat.golden

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 22224fbc..c91e4ce3 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -957,7 +957,7 @@ run :: VEnv
     -> Namespace
     -> Checking a
     -> Either Error (a, ([TypedHole], Store, Graph, Namespace))
-run ve initStore ns m =
+run ve initStore ns m = do
   let ctx = Ctx { globalVEnv = ve
                 , store = initStore
                 -- TODO: fill with default constructors
@@ -966,5 +966,16 @@ run ve initStore ns m =
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
                 , hopeSet = S.empty
-                } in
-    (\(a,ctx,(holes, graph),ns) -> (a, (holes, store ctx, graph, ns))) <$> handler m ctx mempty ns
+                }
+  (a,ctx,(holes, graph),ns) <- handler m ctx mempty ns
+  let tyMap = typeMap $ store ctx
+  -- If the hopeSet has any remaining holes with kind Nat, we need to abort.
+  -- Even though we didn't need them for typechecking problems, our runtime
+  -- behaviour depends on the values of the holes, which we can't account for.
+  case S.toList $ S.filter (isNatKinded tyMap) (hopeSet ctx) of
+    [] -> pure (a, (holes, store ctx, graph, ns))
+    hs -> Left $ Err Nothing (RemainingNatHopes (show <$> hs))
+ where
+  isNatKinded tyMap e = case tyMap M.! e of
+    EndType Braty (Left Nat) -> True
+    _ -> False
diff --git a/brat/Brat/Error.hs b/brat/Brat/Error.hs
index 869c5002..c14aefb2 100644
--- a/brat/Brat/Error.hs
+++ b/brat/Brat/Error.hs
@@ -80,6 +80,7 @@ data ErrorMsg
  | WrongModeForType String
  -- TODO: Add file context here
  | CompilingHoles [String]
+ | RemainingNatHopes [String]
 
 instance Show ErrorMsg where
   show (TypeErr x) = "Type error: " ++ x
@@ -161,9 +162,10 @@ instance Show ErrorMsg where
   -- TODO: Make all of these use existing errors
   show (UnificationError str) = "Unification error: " ++ str
   show UnreachableBranch = "Branch cannot be reached"
-  show (CompilingHoles hs) = unlines ("Can't compile file with remaining holes": indent hs)
-   where
-    indent = fmap ("  " ++)
+  show (CompilingHoles hs) = unlines ("Can't compile file with remaining holes":indent hs)
+  show (RemainingNatHopes hs) = unlines ("Expected to work out values for these holes:":indent (indent hs))
+
+indent = fmap ("  " ++)
 
 data Error = Err { fc  :: Maybe FC
                  , msg :: ErrorMsg
diff --git a/brat/test/golden/error/remaining-nat-hopes.brat b/brat/test/golden/error/remaining-nat-hopes.brat
new file mode 100644
index 00000000..e61eac34
--- /dev/null
+++ b/brat/test/golden/error/remaining-nat-hopes.brat
@@ -0,0 +1,8 @@
+show(n :: #) -> []
+show(_) = []
+
+read([]) -> n :: #
+read([]) = 42
+
+bad :: []
+bad = let _ = read([]) in show(!)
diff --git a/brat/test/golden/error/remaining-nat-hopes.brat.golden b/brat/test/golden/error/remaining-nat-hopes.brat.golden
new file mode 100644
index 00000000..4c8a9796
--- /dev/null
+++ b/brat/test/golden/error/remaining-nat-hopes.brat.golden
@@ -0,0 +1,5 @@
+Error in test/golden/error/remaining-nat-hopes.brat:
+  Expected to work out values for these holes:
+    In checking_check_defs_1_bad_2__2 0
+
+

From c2c8bbeb70003db1a62e7772d472435a087f035b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 11:38:54 +0100
Subject: [PATCH 024/182] Incude file context in hopeSet

---
 brat/Brat/Checker.hs                              | 12 +++++++-----
 brat/Brat/Checker/Monad.hs                        | 14 ++++++++------
 brat/Brat/Checker/SolveHoles.hs                   | 15 ++++++++-------
 brat/Brat/Syntax/Common.hs                        |  2 +-
 .../golden/error/remaining-nat-hopes.brat.golden  |  5 ++++-
 5 files changed, 28 insertions(+), 20 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index c91e4ce3..e046a63b 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -20,7 +20,6 @@ import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
-import qualified Data.Set as S
 import Data.Type.Equality ((:~:)(..))
 import Prelude hiding (filter)
 
@@ -496,7 +495,8 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = do
       pure (((), ()), ((), unders))
 check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
   (Braty, Left _k) -> do
-    req (ANewHope (toEnd tgt))
+    fc <- req AskFC
+    req (ANewHope (toEnd tgt, fc))
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
@@ -965,16 +965,18 @@ run ve initStore ns m = do
                 , kconstructors = kernelConstructors
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
-                , hopeSet = S.empty
+                , hopeSet = M.empty
                 }
   (a,ctx,(holes, graph),ns) <- handler m ctx mempty ns
   let tyMap = typeMap $ store ctx
   -- If the hopeSet has any remaining holes with kind Nat, we need to abort.
   -- Even though we didn't need them for typechecking problems, our runtime
   -- behaviour depends on the values of the holes, which we can't account for.
-  case S.toList $ S.filter (isNatKinded tyMap) (hopeSet ctx) of
+  case M.toList $ M.filterWithKey (\e _ -> isNatKinded tyMap e) (hopeSet ctx) of
     [] -> pure (a, (holes, store ctx, graph, ns))
-    hs -> Left $ Err Nothing (RemainingNatHopes (show <$> hs))
+    -- Just use the FC of the first hole while we don't have the capacity to
+    -- show multiple error locations
+    hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
  where
   isNatKinded tyMap e = case tyMap M.! e of
     EndType Braty (Left Nat) -> True
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index a78c40ba..28f4faed 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -51,6 +51,8 @@ data CtxEnv = CtxEnv
   , locals :: VEnv
   }
 
+type HopeSet = M.Map End FC
+
 data Context = Ctx { globalVEnv :: VEnv
                    , store :: Store
                    , constructors :: ConstructorMap Brat
@@ -58,7 +60,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , typeConstructors :: M.Map (Mode, UserName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map UserName Alias
                    -- All the ends here should be targets
-                   , hopeSet :: S.Set End
+                   , hopeSet :: HopeSet
                    }
 
 -- Commands for synchronous operations
@@ -93,8 +95,8 @@ data CheckingSig ty where
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
-  ANewHope :: End -> CheckingSig ()
-  HopeSet :: CheckingSig (S.Set End)
+  ANewHope :: (End, FC) -> CheckingSig ()
+  AskHopeSet :: CheckingSig HopeSet
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
@@ -290,9 +292,9 @@ handler (Req s k) ctx g ns
                 M.lookup tycon tbl
         handler (k args) ctx g ns
 
-      ANewHope e -> handler (k ()) (ctx { hopeSet = S.insert e (hopeSet ctx) }) g ns
+      ANewHope (e, fc) -> handler (k ()) (ctx { hopeSet = M.insert e fc (hopeSet ctx) }) g ns
 
-      HopeSet -> handler (k (hopeSet ctx)) ctx g ns
+      AskHopeSet -> handler (k (hopeSet ctx)) ctx g ns
 handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
   case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
@@ -302,7 +304,7 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
         Just _ -> let news = News (M.singleton end (howStuck v)) in
           handler (k news)
             (ctx { store = st { valueMap = M.insert end v vm },
-                hopeSet = S.delete end (hopeSet ctx)
+                hopeSet = M.delete end (hopeSet ctx)
             }) g ns
 handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
 handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 775664cb..da517825 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -15,6 +15,7 @@ import Util (zip_same_length)
 
 import Data.Foldable (traverse_)
 import Data.Functor
+import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
@@ -28,7 +29,7 @@ typeEq :: String -- String representation of the term for error reporting
        -> Val n -- Actual
        -> Checking ()
 typeEq str stuff@(_ny :* _ks :* sems) k exp act = do
-  hopes <- req HopeSet
+  hopes <- req AskHopeSet
   exp <- sem sems exp
   act <- sem sems act
   typeEqEta str stuff hopes k exp act
@@ -40,7 +41,7 @@ isNumVar _ = Nothing
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-          -> S.Set End -- The hope set
+          -> HopeSet -- The hope set
           -> TypeKind -- The kind we're comparing at
           -> Sem -- Expected
           -> Sem -- Actual
@@ -56,16 +57,16 @@ typeEqEta tm (lvy :* kz :* sems) hopeSet (TypeFor m ((_, k):ks)) exp act = do
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- "easy" flex cases
 typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k (SApp (SPar e) B0) act
-  | S.member e hopeSet = solveHope k e act
+  | M.member e hopeSet = solveHope k e act
 typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k exp (SApp (SPar e) B0)
-  | S.member e hopeSet = solveHope k e exp
+  | M.member e hopeSet = solveHope k e exp
 typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
-  | Just (SPar e) <- isNumVar exp, S.member e hopeSet = solveHope Nat e act
-  | Just (SPar e) <- isNumVar act, S.member e hopeSet = solveHope Nat e exp
+  | Just (SPar e) <- isNumVar exp, M.member e hopeSet = solveHope Nat e act
+  | Just (SPar e) <- isNumVar act, M.member e hopeSet = solveHope Nat e exp
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  case [e | (VApp (VPar e) _) <- [exp,act], S.member e hopeSet] of
+  case [e | (VApp (VPar e) _) <- [exp,act], M.member e hopeSet] of
     [] -> typeEqRigid tm stuff k exp act
     es -> do
       Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
diff --git a/brat/Brat/Syntax/Common.hs b/brat/Brat/Syntax/Common.hs
index 2b08edb1..c02d793e 100644
--- a/brat/Brat/Syntax/Common.hs
+++ b/brat/Brat/Syntax/Common.hs
@@ -110,7 +110,7 @@ instance Eq ty => Eq (TypeRowElem ty) where
   Anon ty == Anon ty' = ty == ty'
 
 data TypeKind = TypeFor Mode [(PortName, TypeKind)] | Nat | Row
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 pattern Star, Dollar :: [(PortName, TypeKind)] -> TypeKind
 pattern Star ks = TypeFor Brat ks
diff --git a/brat/test/golden/error/remaining-nat-hopes.brat.golden b/brat/test/golden/error/remaining-nat-hopes.brat.golden
index 4c8a9796..013e8b6c 100644
--- a/brat/test/golden/error/remaining-nat-hopes.brat.golden
+++ b/brat/test/golden/error/remaining-nat-hopes.brat.golden
@@ -1,4 +1,7 @@
-Error in test/golden/error/remaining-nat-hopes.brat:
+Error in test/golden/error/remaining-nat-hopes.brat@FC {start = Pos {line = 8, col = 31}, end = Pos {line = 8, col = 34}}:
+bad = let _ = read([]) in show(!)
+                              ^^^
+
   Expected to work out values for these holes:
     In checking_check_defs_1_bad_2__2 0
 

From 3765a8a0e548d7e9c0a9ddbe6baca9b0e83e04d1 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 13:28:59 +0100
Subject: [PATCH 025/182] Allow comparing VInx

---
 brat/Brat/Syntax/Value.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index e3bfcb46..e4dcef64 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -51,6 +51,8 @@ data Inx :: N -> Type where
   VZ :: Inx (S n)
   VS :: Inx n -> Inx (S n)
 
+deriving instance Eq (Inx n)
+
 instance Show (Inx n) where
   show = show . toNat
    where
@@ -58,6 +60,7 @@ instance Show (Inx n) where
     toNat VZ = 0
     toNat (VS n) = 1 + (toNat n)
 
+
 data AddR :: N -> N -> N -> Type where
   AddZ :: Ny out -> AddR out Z out
   AddS :: AddR out inn tot -> AddR out (S inn) (S tot)
@@ -144,7 +147,7 @@ deriving instance Show (VVar n)
 
 instance Eq (VVar n) where
   (VPar e0) == (VPar e1) = e0 == e1
-  (VInx _) == (VInx _) = error "tried to compare VInxs"
+  (VInx i) == (VInx i') = i == i'
   _ == _ = False
 
 -- More syntactic, called "Term" elsewhere in literature (not in BRAT)

From a22531bf0aafed3055b0d0e622824102dcc278f3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 17:16:02 +0100
Subject: [PATCH 026/182] Rewrite dynamic num refinements to work on srcs and
 tgts

---
 brat/Brat/Checker/SolveHoles.hs    |  46 ++++++++++--
 brat/Brat/Checker/SolvePatterns.hs | 117 +++++++++++++++++++----------
 2 files changed, 114 insertions(+), 49 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index da517825..72a69b29 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,10 +1,11 @@
-module Brat.Checker.SolveHoles (typeEq) where
+module Brat.Checker.SolveHoles (typeEq, buildNatVal, buildNum, invertNatVal) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
-import Brat.Checker.Helpers (buildArithOp, buildConst)
+import Brat.Checker.Helpers (buildArithOp, buildConst, next)
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
+import Brat.Graph (NodeType(..))
 import Brat.Syntax.Common
 import Brat.Syntax.Simple (SimpleTerm(..))
 import Brat.Syntax.Value
@@ -149,6 +150,13 @@ typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
   eqVariant (Some r0, Some r1) = throwLeft $ (snd <$> typeEqRow m0 tm lvkz r0 r1)
 typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
 
+wire :: (Src, Val Z, Tgt) -> Checking ()
+wire (src, ty, tgt) = req $ Wire (end src, ty, end tgt)
+
+buildNum :: Integer -> Checking Src
+buildNum n = buildConst (Num (fromIntegral n)) TNat
+
+
 buildNatVal :: NumVal (VVar Z) -> Checking Src
 buildNatVal nv@(NumValue n gro) = case n of
   0 -> buildGro gro
@@ -160,12 +168,6 @@ buildNatVal nv@(NumValue n gro) = case n of
     wire (src, TNat, rhs)
     pure out
  where
-  wire :: (Src, Val Z, Tgt) -> Checking ()
-  wire (src, ty, tgt) = req $ Wire (end src, ty, end tgt)
-
-  buildNum :: Integer -> Checking Src
-  buildNum n = buildConst (Num (fromIntegral n)) TNat
-
   buildGro :: Fun00 (VVar Z) -> Checking Src
   buildGro Constant0 = buildNum 0
   buildGro (StrictMonoFun sm) = buildSM sm
@@ -201,3 +203,31 @@ buildNatVal nv@(NumValue n gro) = case n of
     wire (one, TNat, rhs)
     pure out
   buildMono _ = err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
+
+invertNatVal :: Src -> NumVal a -> Checking Src
+invertNatVal src (NumValue up gro) = case up of
+  0 -> invertGro src gro
+  _ -> do
+    ((lhs,rhs),out) <- buildArithOp Sub
+    upSrc <- buildNum up
+    wire (src, TNat, lhs)
+    wire (upSrc, TNat, rhs)
+    invertGro out gro
+ where
+  invertGro _ Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
+  invertGro src (StrictMonoFun sm) = invertSM src sm
+
+  invertSM src (StrictMono k mono) = case k of
+    0 -> invertMono src mono
+    _ -> do
+      divisor <- buildNum (2 ^ k)
+      ((lhs,rhs),out) <- buildArithOp Div
+      wire (src, TNat, lhs)
+      wire (divisor, TNat, rhs)
+      invertMono out mono
+
+  invertMono src (Linear _) = pure src
+  invertMono src (Full sm) = do
+    (_, [(llufTgt,_)], [(llufSrc,_)], _) <- next "luff" (Prim ("BRAT","lluf")) (S0, Some (Zy :* S0)) (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+    wire (src, TNat, llufTgt)
+    invertSM llufSrc sm
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index cf62e7cb..c2b1af9c 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -2,6 +2,7 @@ module Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
 
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
+import Brat.Checker.SolveHoles (buildNatVal, buildNum, invertNatVal)
 import Brat.Checker.Types (EndType(..))
 import Brat.Constructors
 import Brat.Constructors.Patterns
@@ -192,13 +193,44 @@ unify l k r = do
       --       the whole `Problem`.
       (l, r, _) -> err . UnificationError $ "Can't unify " ++ show l ++ " with " ++ show r
 
+-- Solve a metavariable statically - don't do anything dynamic
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)
   Define e val (const (Ret ()))
 
+-- Make the dynamic wiring for a metavariable. This only needs to happen for
+-- numbers because they have nontrivial runtime behaviour.
+computeMeta :: End -> NumVal (VVar Z) -> Checking ()
+computeMeta e nv = case (e, vars nv) of
+ (ExEnd src,  [VPar (InEnd tgt)]) -> do
+   src <- invertNatVal (NamedPort src "") nv
+   wire (src, TNat, NamedPort tgt "")
+
+ -- Both targets, we need to create the thing that they both derive from
+ (InEnd tgt1, [VPar (InEnd tgt2)]) -> do
+   (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
+                                         (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+   defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
+   defineTgt (NamedPort tgt2 "") (VNum (nVar (VPar (toEnd idSrc))))
+   wire (idSrc, TNat, NamedPort tgt2 "")
+   let nv' = fmap (const (VPar (toEnd idSrc))) nv
+   src1 <- buildNatVal nv
+   wire (src1, TNat, NamedPort tgt1 "")
+
+ -- RHS is constant or Src, wire it into tgt
+ (InEnd tgt,  _) -> do
+   src <- buildNatVal nv
+   wire (src, TNat, NamedPort tgt "")
+
+ -- do nothing
+ _ -> pure ()
+ where
+  vars :: NumVal a -> [a]
+  vars = foldMap pure
 
 -- Need to keep track of which way we're solving - which side is known/unknown
+-- Things which are dynamically unknown must be Tgts - information flows from Srcs
 unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
@@ -216,10 +248,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsMono (Linear v) num = case v of
-    VPar e -> instantiateMeta e (VNum num)
-    _ -> case num of -- our only hope is to instantiate the RHS
-      NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar (ExEnd e))))) -> instantiateMeta (toEnd e) (VNum (nVar v))
-      _ -> err . UnificationError $ "Couldn't instantiate variable " ++ show v
+    VPar e -> instantiateMeta e (VNum num) *> computeMeta e num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
@@ -231,6 +260,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
     Linear (VPar e) -> instantiateMeta e (VNum (nConstant 0))
+                    *> computeMeta e (nConstant 0)
     Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
     _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
   demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
@@ -240,9 +270,21 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
-  demandSucc (StrictMono k (Linear (VPar (ExEnd out)))) = do
-    y <- mkPred out
+  demandSucc sm@(StrictMono k (Linear (VPar (ExEnd x)))) = do
+    ySrc <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
+    let y = nVar (VPar (toEnd ySrc))
+    instantiateMeta (ExEnd x) (VNum (nPlus 1 y))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
+
+  demandSucc sm@(StrictMono k (Linear (VPar (InEnd x)))) = do
+    one <- buildNum 1
+    ((lhs,rhs),out) <- buildArithOp Add
+    wire (one, TNat, rhs)
+    wire (out, TNat, NamedPort x "")
+    let y = nVar (VPar (toEnd lhs))
+    instantiateMeta (InEnd x) (VNum (nPlus 1 y))
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
+
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
@@ -261,53 +303,46 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
-        half <- mkHalf out
+        half <- invertNatVal (NamedPort out "") (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear ()))))
+        instantiateMeta (ExEnd out) (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
-      Linear _ -> err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+      Linear (VPar (InEnd tgt)) -> do
+        twoSrc <- buildNum 2
+        ((halfTgt,twoTgt),outSrc) <- buildArithOp Mul
+        wire (twoSrc, TNat, twoTgt)
+        wire (outSrc, TNat, NamedPort tgt "")
+        let half = nVar (VPar (toEnd halfTgt))
+        instantiateMeta (InEnd tgt) (VNum (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
 
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar (ExEnd out)) -> mkPred out >>= demandEven
-      Linear _ -> err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+      Linear (VPar (ExEnd out)) -> do
+        -- compute (/2) . (-1)
+        halfSrc <- invertNatVal (NamedPort out "") (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear ()))))
+        instantiateMeta (ExEnd out) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))))
+        pure (nVar (VPar (toEnd halfSrc)))
+      Linear (VPar (InEnd tgt)) -> do
+        oneSrc <- buildNum 1
+        ((flooredHalfTgt, oneTgt), addOut) <- buildArithOp Add
+        wire (oneSrc, TNat, oneTgt)
+        twoSrc <- buildNum 2
+        ((lhsTgt, twoTgt), out) <- buildArithOp Mul
+        wire (addOut, TNat, lhsTgt)
+        wire (twoSrc, TNat, twoTgt)
+        wire (out, TNat, NamedPort tgt "")
+        instantiateMeta (InEnd tgt) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd flooredHalfTgt))))))
+        pure (nVar (VPar (toEnd flooredHalfTgt)))
+
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
       Full sm -> nFull <$> demandSucc sm
     oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
 
-  -- Add dynamic logic to compute half of a variable.
-  mkHalf :: OutPort -> Checking Src
-  mkHalf out = do
-    (_, [], [(const2,_)], _) <- next "const2" (Const (Num 2)) (S0, Some (Zy :* S0))
-                                R0
-                                (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(half,_)], _) <- next "div2" (ArithNode Div) (S0, Some (Zy :* S0))
-                                             (RPr ("left", TNat) (RPr ("right", TNat) R0))
-                                             (RPr ("out", TNat) R0)
-    wire (NamedPort out "numerator", TNat, lhs)
-    wire (const2, TNat, rhs)
-    defineSrc (NamedPort out "") (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
-    pure half
-
-
-  -- Add dynamic logic to compute the predecessor of a variable, and return that
-  -- predecessor.
-  -- The variable must be a non-zero nat!!
-  mkPred :: OutPort -> Checking (NumVal (VVar Z))
-  mkPred out = do
-    (_, [], [(const1,_)], _) <- next "const1" (Const (Num 1)) (S0, Some (Zy :* S0))
-                                R0
-                                (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(pred,_)], _) <- next "minus1" (ArithNode Sub) (S0, Some (Zy :* S0))
-                                             (RPr ("left", TNat) (RPr ("right", TNat) R0))
-                                             (RPr ("out", TNat) R0)
-    wire (NamedPort out "", TNat, lhs)
-    wire (const1, TNat, rhs)
-    defineSrc (NamedPort out "") (VNum (nPlus 1 (nVar (VPar (toEnd pred)))))
-    pure (nVar (VPar (toEnd pred)))
-
+-- The variable must be a non-zero nat!!
 patVal :: ValPat -> [End] -> (Val Z, [End])
 -- Nat variables will only be found in a `NumPat`, not a `ValPat`
 patVal VPVar (e:es) = (VApp (VPar e) B0, es)

From af75834ad05719c274ee404704fca66441d785ab Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 18:16:42 +0100
Subject: [PATCH 027/182] Fix demandEven logic

---
 brat/Brat/Checker/SolvePatterns.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index c2b1af9c..90b485ff 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -326,14 +326,16 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         instantiateMeta (ExEnd out) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))))
         pure (nVar (VPar (toEnd halfSrc)))
       Linear (VPar (InEnd tgt)) -> do
-        oneSrc <- buildNum 1
-        ((flooredHalfTgt, oneTgt), addOut) <- buildArithOp Add
-        wire (oneSrc, TNat, oneTgt)
         twoSrc <- buildNum 2
-        ((lhsTgt, twoTgt), out) <- buildArithOp Mul
-        wire (addOut, TNat, lhsTgt)
+        ((flooredHalfTgt, twoTgt), doubleSrc) <- buildArithOp Mul
         wire (twoSrc, TNat, twoTgt)
-        wire (out, TNat, NamedPort tgt "")
+
+        oneSrc <- buildNum 1
+        ((doubleTgt, oneTgt), addOut) <- buildArithOp Add
+        wire (oneSrc, TNat, oneTgt)
+        wire (doubleSrc, TNat, doubleTgt)
+        wire (addOut, TNat, NamedPort tgt "")
+
         instantiateMeta (InEnd tgt) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd flooredHalfTgt))))))
         pure (nVar (VPar (toEnd flooredHalfTgt)))
 

From 283ccaec110b4b10d2f9200f3d46e596285fd8ef Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 22 Aug 2024 18:17:04 +0100
Subject: [PATCH 028/182] Flip that hypo node back around

---
 brat/Brat/Checker/SolvePatterns.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 90b485ff..d1f8a8fd 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -144,7 +144,8 @@ solveConstructor my src (c, abs) ty p = do
   (CArgs pats _ patRo argRo, (tycon, tyargs)) <- lookupConstructor my c ty
   -- Create a row of hypothetical kinds which contextualise the arguments to the
   -- constructor.
-  (_, _, _, stuff) <- next "type_args" Hypo (S0, Some (Zy :* S0)) R0 patRo
+  -- These need to be Tgts because we don't know how to compute them dynamically/
+  (_, _, _, stuff) <- next "type_args" Hypo (S0, Some (Zy :* S0)) patRo R0
   (node, _, patArgWires, _) <- let ?my = my in anext "val_args" Hypo stuff R0 argRo
   trackM ("Constructor " ++ show c ++ "; type " ++ show ty)
   case (snd stuff) of

From 0da9554178c01d8aea5c77c1cc831c05afbb17ca Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Fri, 23 Aug 2024 15:51:42 +0100
Subject: [PATCH 029/182] Rewrite computeMeta to do definition as well

---
 brat/Brat/Checker/SolvePatterns.hs | 48 +++++++++++++++++++-----------
 1 file changed, 30 insertions(+), 18 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index d1f8a8fd..b3117684 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -195,18 +195,30 @@ unify l k r = do
       (l, r, _) -> err . UnificationError $ "Can't unify " ++ show l ++ " with " ++ show r
 
 -- Solve a metavariable statically - don't do anything dynamic
+-- Once a metavariable is solved, we expect to not see it again in a normal form.
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)
   Define e val (const (Ret ()))
 
--- Make the dynamic wiring for a metavariable. This only needs to happen for
+-- solve a Nat kinded metavariable. Unline `instantiateMeta`, this function also
+-- makes the dynamic wiring for a metavariable. This only needs to happen for
 -- numbers because they have nontrivial runtime behaviour.
-computeMeta :: End -> NumVal (VVar Z) -> Checking ()
-computeMeta e nv = case (e, vars nv) of
+--
+-- We assume that the caller has done the occurs check and rules out trivial equations.
+solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
+solveNumMeta e nv = case (e, vars nv) of
+ -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd tgt)]) -> do
-   src <- invertNatVal (NamedPort src "") nv
-   wire (src, TNat, NamedPort tgt "")
+   -- Compute the value of the `tgt` variable from the known `src` value by invering nv
+   tgtSrc <- invertNatVal (NamedPort src "") nv
+   -- If `nv` is *just* a variable, invertNatVal will return `src`. We need to
+   -- catch this because defining x := x will cause eval to loop.
+   unless (ExEnd src == toEnd tgtSrc) (defineSrc src (VNum (const (VPar (ExEnd tgtSrc)) <$> nv)))
+   defineTgt (InEnd tgt) (VNum (nVar tgtSrc))
+   wire (tgtSrc, TNat, NamedPort tgt "")
+
+ (ExEnd src, _) -> defineSrc src nv
 
  -- Both targets, we need to create the thing that they both derive from
  (InEnd tgt1, [VPar (InEnd tgt2)]) -> do
@@ -216,16 +228,16 @@ computeMeta e nv = case (e, vars nv) of
    defineTgt (NamedPort tgt2 "") (VNum (nVar (VPar (toEnd idSrc))))
    wire (idSrc, TNat, NamedPort tgt2 "")
    let nv' = fmap (const (VPar (toEnd idSrc))) nv
-   src1 <- buildNatVal nv
+   src1 <- buildNatVal nv'
+   defineTgt tgt1 (VNum nv')
    wire (src1, TNat, NamedPort tgt1 "")
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
    src <- buildNatVal nv
+   defineTgt tgt nv
    wire (src, TNat, NamedPort tgt "")
 
- -- do nothing
- _ -> pure ()
  where
   vars :: NumVal a -> [a]
   vars = foldMap pure
@@ -248,8 +260,9 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     lhsStrictMono (StrictMono (n - 1) mono) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear v) num = case v of
-    VPar e -> instantiateMeta e (VNum num) *> computeMeta e num
+  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
+  lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
+                                  solveNumMeta e num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
@@ -260,8 +273,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (VPar e) -> instantiateMeta e (VNum (nConstant 0))
-                    *> computeMeta e (nConstant 0)
+    Linear (VPar e) -> solveNumMeta e (nConstant 0)
     Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
     _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
   demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
@@ -274,7 +286,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   demandSucc sm@(StrictMono k (Linear (VPar (ExEnd x)))) = do
     ySrc <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
     let y = nVar (VPar (toEnd ySrc))
-    instantiateMeta (ExEnd x) (VNum (nPlus 1 y))
+    solveNumMeta (ExEnd x) (nPlus 1 y)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
 
   demandSucc sm@(StrictMono k (Linear (VPar (InEnd x)))) = do
@@ -283,7 +295,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     wire (one, TNat, rhs)
     wire (out, TNat, NamedPort x "")
     let y = nVar (VPar (toEnd lhs))
-    instantiateMeta (InEnd x) (VNum (nPlus 1 y))
+    solveNumMeta (InEnd x) (nPlus 1 y)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
 
   --   2^k * full(n + 1)
@@ -305,7 +317,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
         half <- invertNatVal (NamedPort out "") (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear ()))))
-        instantiateMeta (ExEnd out) (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
+        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd half))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
       Linear (VPar (InEnd tgt)) -> do
         twoSrc <- buildNum 2
@@ -313,7 +325,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         wire (twoSrc, TNat, twoTgt)
         wire (outSrc, TNat, NamedPort tgt "")
         let half = nVar (VPar (toEnd halfTgt))
-        instantiateMeta (InEnd tgt) (VNum (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
+        solveNumMeta (InEnd tgt) (n2PowTimes 1 (nVar (VPar (toEnd halfTgt))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
@@ -324,7 +336,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
       Linear (VPar (ExEnd out)) -> do
         -- compute (/2) . (-1)
         halfSrc <- invertNatVal (NamedPort out "") (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear ()))))
-        instantiateMeta (ExEnd out) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))))
+        solveNumMeta (ExEnd out) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
         pure (nVar (VPar (toEnd halfSrc)))
       Linear (VPar (InEnd tgt)) -> do
         twoSrc <- buildNum 2
@@ -337,7 +349,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         wire (doubleSrc, TNat, doubleTgt)
         wire (addOut, TNat, NamedPort tgt "")
 
-        instantiateMeta (InEnd tgt) (VNum (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd flooredHalfTgt))))))
+        solveNumMeta (InEnd tgt) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd flooredHalfTgt)))))
         pure (nVar (VPar (toEnd flooredHalfTgt)))
 
       -- full(n + 1) = 1 + 2 * full(n)

From 2139140956f78badffd452b5ec814665c44d425f Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:02:34 +0100
Subject: [PATCH 030/182] SolvePatterns build fixes; unified.brat+infer.brat
 fail with non-closed Nat value

---
 brat/Brat/Checker/SolvePatterns.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index d1f8a8fd..990c337d 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -215,7 +215,6 @@ computeMeta e nv = case (e, vars nv) of
    defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
    defineTgt (NamedPort tgt2 "") (VNum (nVar (VPar (toEnd idSrc))))
    wire (idSrc, TNat, NamedPort tgt2 "")
-   let nv' = fmap (const (VPar (toEnd idSrc))) nv
    src1 <- buildNatVal nv
    wire (src1, TNat, NamedPort tgt1 "")
 
@@ -277,7 +276,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     instantiateMeta (ExEnd x) (VNum (nPlus 1 y))
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
 
-  demandSucc sm@(StrictMono k (Linear (VPar (InEnd x)))) = do
+  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = do
     one <- buildNum 1
     ((lhs,rhs),out) <- buildArithOp Add
     wire (one, TNat, rhs)
@@ -313,7 +312,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         wire (twoSrc, TNat, twoTgt)
         wire (outSrc, TNat, NamedPort tgt "")
         let half = nVar (VPar (toEnd halfTgt))
-        instantiateMeta (InEnd tgt) (VNum (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
+        instantiateMeta (InEnd tgt) (VNum (n2PowTimes 1 half))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))

From 78cc87c3bccc4d6e73dd2cf3d9143055159b7c97 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 11:48:28 +0100
Subject: [PATCH 031/182] Step0. Yield in getThunks

---
 brat/Brat/Checker/Helpers.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 63172f7f..252bd943 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -265,7 +265,11 @@ getThunks Braty row@((src, Right ty):rest) = eval S0 ty >>= \case
     (nodes, unders', overs') <- getThunks Braty rest
     pure (node:nodes, unders <> unders', overs <> overs')
   (VFun _ _) -> err $ ExpectedThunk (showMode Braty) (showRow row)
-  v -> typeErr $ "Force called on non-thunk: " ++ show v
+  v -> do
+    h <- req AskHopeSet
+    case v of
+      VApp (VPar e) _ | M.member e h -> Yield (AwaitingAny $ S.singleton e) (\_ -> getThunks Braty row)
+      _ -> typeErr $ "Force called on non-thunk: " ++ show v
 getThunks Kerny row@((src, Right ty):rest) = eval S0 ty >>= \case
   (VFun Kerny (ss :->> ts)) -> do
     (node, unders, overs, _) <- let ?my = Kerny in anext "" (Splice (end src)) (S0, Some (Zy :* S0)) ss ts

From fb99b1add82ec5cd846904a2d36997ba10dfc268 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 20 Sep 2024 14:56:55 +0100
Subject: [PATCH 032/182] Drop already-commented-out Helpers.hs export list

---
 brat/Brat/Checker/Helpers.hs | 20 +-------------------
 1 file changed, 1 insertion(+), 19 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 252bd943..ebfced25 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -1,24 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 
-module Brat.Checker.Helpers {-(pullPortsRow, pullPortsSig
-                            ,simpleCheck
-                            ,combineDisjointEnvs
-                            ,ensureEmpty, noUnders
-                            ,rowToSig
-                            ,showMode, getVec
-                            ,mkThunkTy
-                            ,wire
-                            ,next, knext, anext
-                            ,kindType, getThunks
-                            ,binderToValue, valueToBinder
-                            ,kConFields
-                            ,defineSrc, defineTgt
-                            ,declareSrc, declareTgt
-                            ,makeBox
-                            ,uncons
-                            ,evalBinder
-                            ,evalSrcRow, evalTgtRow
-                            )-} where
+module Brat.Checker.Helpers where
 
 import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd)
 import Brat.Checker.Types

From 07c17ed7ac6b39d77f4516f2dd4aa6344361ca8a Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 15:31:52 +0100
Subject: [PATCH 033/182] WIP two-stage check

---
 brat/Brat/Checker.hs         | 307 +++++++++++++++++++----------------
 brat/Brat/Checker/Helpers.hs |  19 +--
 brat/Brat/Load.hs            |   4 +-
 3 files changed, 175 insertions(+), 155 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index e046a63b..950c0157 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -130,14 +130,15 @@ checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
             => WC (Term d KVerb)
             -> [(Src, BinderType m)] -- Expected
             -> [(Tgt, BinderType m)] -- Actual
-            -> Checking [(Src, BinderType m)]
-checkInputs _ overs [] = pure overs
-checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ (
-  (wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u)
-  *>
-  checkInputs tm overs unders
- )
+            -> Either ErrorMsg ([(Src, BinderType m)], Checking ())
+checkInputs _ overs [] = pure (overs, pure ())
+checkInputs tm@(WC fc _) (o:overs) (u:unders) = do
+  (overs', p) <- checkInputs tm overs unders
+  pure (overs', thisWire *> p)
  where
+  thisWire = localFC fc $
+    wrapError (addRowContext ?my (o:overs) (u:unders)) $
+      checkWire ?my tm False o u
   addRowContext :: Show (BinderType m)
               => Modey m
               -> [(Src, BinderType m)] -- Expected
@@ -146,20 +147,22 @@ checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ (
   addRowContext _ as bs (Err fc (TypeMismatch tm _ _))
    = Err fc $ TypeMismatch tm (showRow as) (showRow bs)
   addRowContext _ _ _ e = e
-checkInputs tm [] unders = typeErr $ "No overs but unders: " ++ show unders ++ " for " ++ show tm
+checkInputs tm [] unders = Left $ TypeErr $ "No overs but unders: " ++ show unders ++ " for " ++ show tm
 
+-- TODO refactor more? combine checkInputs; find prefix first and then `zip`
 checkOutputs :: (CheckConstraints m k, ?my :: Modey m)
              => WC (Term Syn k)
              -> [(Tgt, BinderType m)] -- Expected
              -> [(Src, BinderType m)] -- Actual
-             -> Checking [(Tgt, BinderType m)]
-checkOutputs _ unders [] = pure unders
-checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ (
-  (wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u)
-  *>
-  checkOutputs tm unders overs
- )
+             -> Either ErrorMsg ([(Tgt, BinderType m)], Checking ())
+checkOutputs _ unders [] = pure (unders, pure ())
+checkOutputs tm@(WC fc _) (u:unders) (o:overs) = do
+  (unders', p) <- checkOutputs tm unders overs
+  pure (unders', thisWire *> p)
  where
+  thisWire = localFC fc $
+              wrapError (addRowContext ?my (u:unders) (o:overs)) $
+              checkWire ?my tm True o u
   addRowContext :: Show (BinderType m)
               => Modey m
               -> [(Tgt, BinderType m)] -- Expected
@@ -168,21 +171,7 @@ checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ (
   addRowContext _ as bs (Err fc (TypeMismatch tm _ _))
    = Err fc $ TypeMismatch tm (showRow as) (showRow bs)
   addRowContext _ _ _ e = e
-checkOutputs tm [] overs = typeErr $ "No unders but overs: " ++ show overs ++ " for " ++ show tm
-
-checkThunk :: (CheckConstraints m UVerb, EvMode m)
-           => Modey m
-           -> String
-           -> CTy m Z
-           -> WC (Term Chk UVerb)
-           -> Checking Src
-checkThunk m name cty tm = do
-  ((dangling, _), ()) <- let ?my = m in makeBox name cty $
-    \(thOvers, thUnders) -> do
-      (((), ()), (emptyOvers, emptyUnders)) <- check tm (thOvers, thUnders)
-      ensureEmpty "thunk leftovers" emptyOvers
-      ensureEmpty "thunk leftunders" emptyUnders
-  pure dangling
+checkOutputs tm [] overs = Left $ TypeErr $ "No unders but overs: " ++ show overs ++ " for " ++ show tm
 
 check :: (CheckConstraints m k
          ,EvMode m
@@ -192,7 +181,8 @@ check :: (CheckConstraints m k
       => WC (Term d k)
       -> ChkConnectors m d k
       -> Checking (SynConnectors m d k
-                  ,ChkConnectors m d k)
+                  ,ChkConnectors m d k
+                  ,Checking ())
 check (WC fc tm) conn = localFC fc (check' tm conn)
 
 check' :: forall m d k
@@ -204,22 +194,24 @@ check' :: forall m d k
        => Term d k
        -> ChkConnectors m d k
        -> Checking (SynConnectors m d k
-                   ,ChkConnectors m d k) -- rightovers
-check' Empty tys = pure (((), ()), tys)
+                   ,ChkConnectors m d k -- rightovers
+                   ,Checking () -- subproblem(s) still needing solving
+                   )
+check' Empty tys = pure (((), ()), tys, pure ())
 check' (s :|: t) tys = do
   -- in Checking mode, each LHS/RHS removes its wires+types from the ChkConnectors remaining
-  ((ins, outs), tys)  <- check s tys
-  ((ins', outs'), tys) <- check t tys
+  ((ins, outs), tys, ps)  <- check s tys
+  ((ins', outs'), tys, pt) <- check t tys
   -- in Synthesizing mode, instead here we join together the outputs, and the inputs
-  pure ((combine ins ins', tensor outs outs'), tys)
+  pure ((combine ins ins', tensor outs outs'), tys, ps <* pt)
 check' (s :-: t) (overs, unders) = do
   -- s is Syn, t is a UVerb
-  ((ins, overs), (rightovers, ())) <- check s (overs, ())
-  (((), outs), (emptyOvers, rightunders)) <- check t (overs, unders)
+  ((ins, overs), (rightovers, ()), ps) <- check s (overs, ())
+  (((), outs), (emptyOvers, rightunders), pt) <- check t (overs, unders)
   ensureEmpty "composition overs" emptyOvers
-  pure ((ins, outs), (rightovers, rightunders))
+  pure ((ins, outs), (rightovers, rightunders), ps <* pt)
 check' Pass ([], ()) = typeErr "pass is being given an empty row"
-check' Pass (overs, ()) = pure (((), overs), ([], ()))
+check' Pass (overs, ()) = pure (((), overs), ([], ()), pure ())
 check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
   -- Used overs have their port pulling taken care of
   (problem, rightOverSrcs) <- localFC abstFC $ argProblemsWithLeftovers (fst <$> overs) (normaliseAbstractor abst) []
@@ -243,28 +235,31 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
         localEnv fakeEnv $ do
           (_, fakeUnders, [], _) <- anext "lambda_fake_target" Hypo fakeAcc outs R0
           Just tgtMap <- pure $ zip_same_length (fst <$> fakeUnders) unders
-          (((), ()), ((), rightFakeUnders)) <- check body ((), fakeUnders)
+          -- no need to finish checking the body subproblem, we'll check it again in a moment
+          (((), ()), ((), rightFakeUnders), _) <- check body ((), fakeUnders)
           pure (fakeUnders, rightFakeUnders, tgtMap)
 
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
       let usedUnders = [ fromJust (lookup tgt tgtMap) | tgt <- usedFakeUnders ]
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
-      sig <- mkSig usedOvers usedUnders
-      patOuts <- checkClauses sig usedOvers (c :| cs)
-      mkWires patOuts usedUnders
-      pure (((), ()), (rightOvers, rightUnders))
+      let clauseProblems = do
+            sig <- mkSig usedOvers usedUnders
+            (patOuts, rest) <- checkClauses sig usedOvers (c :| cs)
+            mkWires patOuts usedUnders
+            rest
+      pure (((), ()), (rightOvers, rightUnders), clauseProblems)
     Syny -> do
-      synthOuts <- suppressHoles $ suppressGraph $ do
+      (synthOuts, p) <- suppressHoles $ suppressGraph $ do
         env <- localFC abstFC $
           argProblems (fst <$> usedOvers) (normaliseAbstractor abst) [] >>=
           solve ?my >>=
           (solToEnv . snd)
-        (((), synthOuts), ((), ())) <- localEnv env $ check body ((), ())
-        pure synthOuts
-
+        (((), synthOuts), ((), ()), p) <- localEnv env $ check body ((), ())
+        pure (synthOuts, suppressHoles $ suppressGraph $ localEnv env p)
       sig <- mkSig usedOvers synthOuts
-      patOuts <- checkClauses sig usedOvers ((fst c, WC (fcOf body) (Emb body)) :| cs)
-      pure (((), patOuts), (rightOvers, ()))
+      (patOuts, clauseProbs) <- checkClauses sig usedOvers
+          ((fst c, WC (fcOf body) (Emb body)) :| cs)
+      pure (((), patOuts), (rightOvers, ()), p *> clauseProbs)
  where
   -- Invariant: When solToEnv is called, port pulling has already been resolved,
   -- because that's one of the functions of `argProblems`.
@@ -289,15 +284,20 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
     Nothing -> err $ InternalError "Trying to wire up different sized lists of wires"
     Just conns -> traverse (\((src, ty), (tgt, _)) -> wire (src, binderToValue ?my ty, tgt)) conns
 
+  checkClauses :: CTy m Z -> [(Src, BinderType m)] -> NonEmpty (WC Abstractor, WC (Term Chk Noun)) -> Checking ([(Src, BinderType m)], Checking ())
   checkClauses cty@(ins :->> outs) overs all_cs = do
+    (node, patMatchUnders, patMatchOvers, _) <- suppressGraph $
+        anext "lambda" Hypo (S0, Some (Zy :* S0)) ins outs
     let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
-            \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
-    clauses <- traverse (checkClause ?my "lambda" cty) clauses
-    (_, patMatchUnders, patMatchOvers, _) <- anext "lambda" (PatternMatch clauses) (S0, Some (Zy :* S0))
-                                             ins
-                                             outs
-    mkWires overs patMatchUnders
-    pure patMatchOvers
+                  \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
+    let clauseProblems = do
+          clauses <- traverse (checkClause ?my "lambda" cty) clauses
+          let inputs  = [ (portName p, biType @m ty) | (p, ty) <- patMatchUnders ]
+          let outputs = [ (portName p, biType @m ty) | (p, ty) <- patMatchOvers  ]
+          req $ AddNode node (mkNode ?my (PatternMatch clauses) inputs outputs) -- not added by anext because suppressGraph
+          mkWires overs patMatchUnders -- might canonicalize type better now
+          pure ()
+    pure (patMatchOvers, clauseProblems)
 
 check' (Pull ports t) (overs, unders) = do
   unders <- pullPortsRow ports unders
@@ -305,23 +305,39 @@ check' (Pull ports t) (overs, unders) = do
 check' (t ::: outs) (overs, ()) | Braty <- ?my = do
   (ins :->> outs) :: CTy Brat Z <- kindCheckAnnotation Braty ":::" outs
   (_, hungries, danglies, _) <- next "id" Id (S0,Some (Zy :* S0)) ins outs
-  ((), leftOvers) <- noUnders $ check t (overs, hungries)
-  pure (((), danglies), (leftOvers, ()))
+  (((), ()), (leftOvers, unders), p) <- check t (overs, hungries)
+  ensureEmpty "unders" unders
+  pure (((), danglies), (leftOvers, ()), p)
 check' (Emb t) (overs, unders) = do
-  ((ins, outs), (overs, ())) <- check t (overs, ())
-  unders <- checkOutputs t unders outs
-  pure ((ins, ()), (overs, unders))
+  ((ins, outs), (overs, ()), p) <- check t (overs, ())
+  (unders, p') <- throwLeft $ checkOutputs t unders outs
+  pure ((ins, ()), (overs, unders), p *> p')
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
-  (Braty, ty) -> do
-    ty <- evalBinder Braty ty
-    case ty of
-      -- the case split here is so we can be sure we have the necessary CheckConstraints
-      Right ty@(VFun Braty cty) -> checkThunk Braty "thunk" cty tm >>= wire . (,ty, hungry)
-      Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
-      Left (Star args) -> kindCheck [(hungry, Star args)] (Th tm) $> ()
-      _ -> err . ExpectedThunk "" $ showRow (u:unders)
-    pure (((), ()), ((), unders))
+  (Braty, ty) ->
+    let subp = evalBinder Braty ty >>= \case
+          -- the case split here is so we can be sure we have the necessary CheckConstraints
+          Right ty@(VFun Braty cty) -> checkThunk Braty "thunk" cty tm >>= wire . (,ty, hungry)
+          Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
+          Left (Star args) -> kindCheck [(hungry, Star args)] (Th tm) $> ()
+          _ -> err . ExpectedThunk "" $ showRow (u:unders)
+    in pure (((), ()), ((), unders), subp)
   (Kerny, _) -> err . ThunkInKernel $ show (Th tm)
+ where
+  checkThunk :: (CheckConstraints m1 UVerb, EvMode m1)
+            => Modey m1
+            -> String
+            -> CTy m1 Z
+            -> WC (Term Chk UVerb)
+            -> Checking Src
+  checkThunk m name cty tm = do
+    ((dangling, _), ()) <- let ?my = m in makeBox name cty $
+      \(thOvers, thUnders) -> do
+        (((), ()), (emptyOvers, emptyUnders), p) <- check tm (thOvers, thUnders)
+        ensureEmpty "thunk leftovers" emptyOvers
+        ensureEmpty "thunk leftunders" emptyUnders
+        p
+    pure dangling
+
 check' (TypedTh t) ((), ()) = case ?my of
   -- the thunk itself must be Braty
   Kerny -> err . ThunkInKernel $ show (TypedTh t)
@@ -335,32 +351,38 @@ check' (TypedTh t) ((), ()) = case ?my of
       -- both a classical type and a kernel type, but just in case:
       -- (pushing down Emb(TypedTh(v)) to Thunk(Emb+Forget(v)) would help in Checkable cases)
       (Right _, Right _) -> typeErr "TypedTh could be either Brat or Kernel"
-      (Left _, Right (conns, ((), ()))) -> let ?my = Kerny in createThunk conns
-      (Right (conns, ((), ())), Left _) -> createThunk conns
+      (Left _, Right (conns, ((), ()), kp)) -> let ?my = Kerny in createThunk conns kp
+      (Right (conns, ((), ()), bp), Left _) -> createThunk conns bp
  where
   createThunk :: (CheckConstraints m2 Noun, ?my :: Modey m2, EvMode m2)
               => SynConnectors m2 Syn KVerb
+              -> Checking ()
               -> Checking (SynConnectors Brat Syn Noun
-                          ,ChkConnectors Brat Syn Noun)
-  createThunk (ins, outs) = do
+                          ,ChkConnectors Brat Syn Noun
+                          ,Checking ())
+  createThunk (ins, outs) p = do
     Some (ez :* inR) <- mkArgRo ?my S0 (first (fmap toEnd) <$> ins)
     Some (_ :* outR) <- mkArgRo ?my ez (first (fmap toEnd) <$> outs)
-    (thunkOut, ()) <- makeBox "thunk" (inR :->> outR) $
+    (thunkOut, p) <- makeBox "thunk" (inR :->> outR) $
         \(thOvers, thUnders) -> do
           -- if these ensureEmpty's fail then its a bug!
-          checkInputs t thOvers ins >>= ensureEmpty "TypedTh inputs"
-          checkOutputs t thUnders outs >>= ensureEmpty "TypedTh outputs"
-    pure (((), [thunkOut]), ((), ()))
+          (rightUnders, ip) <- throwLeft $ checkInputs t thOvers ins
+          ensureEmpty "TypedTh inputs" rightUnders
+          (leftOvers, op) <- throwLeft $ checkOutputs t thUnders outs
+          ensureEmpty "TypedTh outputs" leftOvers
+          pure (p *> ip *> op)
+    pure (((), [thunkOut]), ((), ()), p)
 check' (Force th) ((), ()) = do
-  (((), outs), ((), ())) <- let ?my = Braty in check th ((), ())
+  (((), outs), ((), ()), p) <- let ?my = Braty in check th ((), ())
   -- pull a bunch of thunks (only!) out of here
-  (_, thInputs, thOutputs) <- getThunks ?my outs
-  pure ((thInputs, thOutputs), ((), ()))
+  p *> do -- allow p to run concurrently with getThunks and rest of check' Force
+    (_, thInputs, thOutputs) <- getThunks ?my outs
+    pure ((thInputs, thOutputs), ((), ()), pure ())
 check' (Forget kv) (overs, unders) = do
-  ((ins, outs), ((), rightUnders)) <- check kv ((), unders)
-  leftOvers <- checkInputs kv overs ins
-  pure (((), outs), (leftOvers, rightUnders))
-check' (Var x) ((), ()) = (, ((), ())) . ((),) <$> case ?my of
+  ((ins, outs), ((), rightUnders), p) <- check kv ((), unders)
+  (leftOvers, p') <- throwLeft $ checkInputs kv overs ins
+  pure (((), outs), (leftOvers, rightUnders), p *> p')
+check' (Var x) ((), ()) = (, ((), ()), pure ()) . ((),) <$> case ?my of
   Braty -> vlup x
   Kerny -> req (KLup x) >>= \case
     Just (p, ty) -> pure [(p, ty)]
@@ -373,35 +395,35 @@ check' (Arith op l r) ((), u@(hungry, ty):unders) = case (?my, ty) of
       Right TInt -> check_arith TInt
       Right TFloat -> check_arith TFloat
       _ -> err . ArithNotExpected $ show u
-    pure (((), ()), ((), unders))
   (Kerny, _) -> err ArithInKernel
  where
   check_arith ty = let ?my = Braty in do
     let inRo = RPr ("left", ty) $ RPr ("right", ty) R0
     let outRo = RPr ("out", ty) R0
     (_, [lunders, runders], [(dangling, _)], _) <- next (show op) (ArithNode op) (S0, Some $ Zy :* S0) inRo outRo
-    (((), ()), ((), leftUnders)) <- check l ((), [lunders])
+    (((), ()), ((), leftUnders), pl) <- check l ((), [lunders])
     ensureEmpty "arith unders" leftUnders
-    (((), ()), ((), leftUnders)) <- check r ((), [runders])
+    (((), ()), ((), leftUnders), pr) <- check r ((), [runders])
     ensureEmpty "arith unders" leftUnders
     wire (dangling, ty, hungry)
-    pure (((), ()), ((), unders))
+    pure (((), ()), ((), unders), pl *> pr)
 check' (fun :$: arg) (overs, unders) = do
-  ((ins, outputs), ((), leftUnders)) <- check fun ((), unders)
-  ((argIns, ()), (leftOvers, argUnders)) <- check arg (overs, ins)
+  ((ins, outputs), ((), leftUnders), pf) <- check fun ((), unders)
+  ((argIns, ()), (leftOvers, argUnders), pa) <- check arg (overs, ins)
   ensureEmpty "leftover function args" argUnders
-  pure ((argIns, outputs), (leftOvers, leftUnders))
+  pure ((argIns, outputs), (leftOvers, leftUnders), pf *> pa)
 check' (Let abs x y) conn = do
-  (((), dangling), ((), ())) <- check x ((), ())
+  (((), dangling), ((), ()), px) <- check x ((), ())
   env <- abstractAll dangling (unWC abs)
-  localEnv env $ check y conn
+  (sycs, chcs, py) <- localEnv env $ check y conn
+  pure (sycs, chcs, px *> py)
 check' (NHole (mnemonic, name)) connectors = do
   fc <- req AskFC
   let suggestions = Nothing
   () <- case ?my of
     Kerny -> req $ LogHole $ TypedHole NKHole (HoleData { .. })
     Braty -> req $ LogHole $ TypedHole NBHole (HoleData { .. })
-  pure (((), ()), ((), []))
+  pure (((), ()), ((), []), pure ())
 -- TODO: Fix this
 {-
   where
@@ -435,17 +457,18 @@ check' (VHole (mnemonic, name)) connectors = do
   req $ LogHole $ case ?my of
     Braty -> TypedHole VBHole (HoleData { .. })
     Kerny -> TypedHole VKHole (HoleData { .. })
-  pure (((), ()), ([], []))
+  pure (((), ()), ([], []), pure ())
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
-check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = case (?my, ty) of
-  (Braty, Left k) -> do
-    (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
-    ensureEmpty "kindCheck leftovers" leftOvers
-    pure (((), ()), ((), unders))
-  (Braty, Right ty) -> aux Braty clup ty $> (((), ()), ((), unders))
-  (Kerny, _) -> aux Kerny kclup ty $> (((), ()), ((), unders))
+check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
+  pure (((), ()), ((), unders), subp)
  where
+  subp = case (?my, ty) of
+    (Braty, Left k) -> do
+      (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
+      ensureEmpty "kindCheck leftovers" leftOvers
+    (Braty, Right ty) -> aux Braty clup ty
+    (Kerny, _) -> aux Kerny kclup ty
   aux :: Modey m -> (UserName -> UserName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
     VCon tycon tyargs <- eval S0 ty
@@ -463,46 +486,44 @@ check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = case (?my, ty) of
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
-    (((), ()), ((), leftUnders)) <- wrapError wrap $ check vargs ((), argUnders)
+    (((), ()), ((), leftUnders), p) <- wrapError wrap $ check vargs ((), argUnders)
     ensureEmpty "con unders" leftUnders
+    p
     wire (dangling, ty, hungry)
 
 check' (C cty) ((), ((hungry, ty):unders)) = case (?my, ty) of
-  (Braty, Left k) -> do
-    (_, leftOvers) <- kindCheck [(hungry, k)] (C cty)
-    ensureEmpty "kindCheck leftovers" leftOvers
-    pure (((), ()), ((), unders))
+  (Braty, Left k) -> pure (((), ()), ((), unders),
+      kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
   _ -> typeErr $ "Ill-kinded function type: " ++ show cty
-check' (Simple tm) ((), ((hungry, ty):unders)) = do
-  ty <- evalBinder ?my ty
-  case (?my, ty, tm) of
-    -- The only SimpleType that checks against a kind is a Nat
-    (Braty, Left Nat, Num n) -> do
-      (_, _, [(dangling, _)], _) <- next "" (Const (Num n)) (S0,Some (Zy :* S0))
-                                    R0 (REx ("value", Nat) R0)
-      let val = VNum (nConstant (fromIntegral n))
-      defineSrc dangling val
-      defineTgt hungry val
-      wire (dangling, kindType Nat, hungry)
-      pure (((), ()), ((), unders))
-    -- No defining needed, so everything else can be unified
-    _ -> do
-      let vty = biType @m ty
-      throwLeft $ simpleCheck ?my vty tm
-      (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
-                                     R0 (RPr ("value", vty) R0)
-      wire (dangling, vty, hungry)
-      pure (((), ()), ((), unders))
+check' (Simple tm) ((), ((hungry, ty):unders)) = pure (((), ()), ((), unders), subp)
+ where
+  subp = do
+    ty <- evalBinder ?my ty
+    case (?my, ty, tm) of
+      -- The only SimpleType that checks against a kind is a Nat
+      (Braty, Left Nat, Num n) -> do
+        (_, _, [(dangling, _)], _) <- next "" (Const (Num n)) (S0,Some (Zy :* S0))
+                                      R0 (REx ("value", Nat) R0)
+        let val = VNum (nConstant (fromIntegral n))
+        defineSrc dangling val
+        defineTgt hungry val
+        wire (dangling, kindType Nat, hungry)
+      -- No defining needed, so everything else can be unified
+      _ -> do
+        let vty = biType @m ty
+        throwLeft $ simpleCheck ?my vty tm
+        (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
+                                      R0 (RPr ("value", vty) R0)
+        wire (dangling, vty, hungry)
 check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
   (Braty, Left _k) -> do
     fc <- req AskFC
     req (ANewHope (toEnd tgt, fc))
-    pure (((), ()), ((), unders))
+    pure (((), ()), ((), unders), pure ()) -- could probably delay ANewHope too
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
 check' tm _ = error $ "check' " ++ show tm
 
-
 -- Clauses from either function definitions or case statements, as we get
 -- them from the elaborator
 data Clause = Clause
@@ -560,15 +581,19 @@ checkBody :: (CheckConstraints m UVerb, EvMode m, ?my :: Modey m)
           -> FunBody Term UVerb
           -> CTy m Z -- Function type
           -> Checking Src
-checkBody fnName body cty = case body of
-  NoLhs tm -> do
-    ((src, _), _) <- makeBox (fnName ++ ".box") cty $ \(overs, unders) -> check tm (overs, unders)
-    pure src
-  Clauses (c :| cs) -> do
-    fc <- req AskFC
-    ((box, _), _) <- makeBox (fnName ++ ".box") cty (check (WC fc (Lambda c cs)))
-    pure box
-  Undefined -> err (InternalError "Checking undefined clause")
+checkBody fnName body cty = do
+  tm <- case body of
+    NoLhs tm -> pure tm
+    Clauses (c :| cs) -> do
+      fc <- req AskFC
+      pure (WC fc (Lambda c cs))
+    Undefined -> err (InternalError "Checking undefined clause")
+  ((src, _), ()) <- makeBox (fnName ++ ".box") cty $ \(overs, unders) -> do
+    (((),()), (rightOvers, rightUnders), p) <- check tm (overs, unders)
+    ensureEmpty ("unconsumed inputs to " ++ fnName) rightOvers
+    ensureEmpty ("unproduced outputs from " ++ fnName) rightUnders
+    p
+  pure src
 
 -- Constructs row from a list of ends and types. Uses standardize to ensure that dependency is
 -- detected. Fills in the first bot ends from a stack. The stack grows every time we go under
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index ebfced25..c69ae9ce 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -125,11 +125,6 @@ ensureEmpty :: Show ty => String -> [(NamedPort e, ty)] -> Checking ()
 ensureEmpty _ [] = pure ()
 ensureEmpty str xs = err $ InternalError $ "Expected empty " ++ str ++ ", got:\n  " ++ showSig (rowToSig xs)
 
-noUnders m = do
-  ((outs, ()), (overs, unders)) <- m
-  ensureEmpty "unders" unders
-  pure (outs, overs)
-
 rowToSig :: Traversable t => t (NamedPort e, ty) -> t (PortName, ty)
 rowToSig = fmap $ \(p,ty) -> (portName p, ty)
 
@@ -175,13 +170,13 @@ anext str th vals0 ins outs = do
 
   () <- req (AddNode node (mkNode (modey @m) th inputs outputs))
   pure (node, unders, overs, vals2)
- where
-  mkNode :: forall m. Modey m -> NodeType m
-         -> [(PortName, Val Z)]
-         -> [(PortName, Val Z)]
-         -> Node
-  mkNode Braty = BratNode
-  mkNode Kerny = KernelNode
+
+mkNode :: forall m. Modey m -> NodeType m
+        -> [(PortName, Val Z)]
+        -> [(PortName, Val Z)]
+        -> Node
+mkNode Braty = BratNode
+mkNode Kerny = KernelNode
 
 type Endz = Ny :* Stack Z End
 
diff --git a/brat/Brat/Load.hs b/brat/Brat/Load.hs
index 9fffe43c..5f077ad0 100644
--- a/brat/Brat/Load.hs
+++ b/brat/Brat/Load.hs
@@ -67,8 +67,8 @@ checkDecl pre (VDecl FuncDecl{..}) to_define = (fnName -!) $ localFC fnLoc $ do
     -- We must have a row of nouns as the definition
     Nothing -> case fnBody of
       NoLhs body -> do
-        (((), ()), ((), [])) <- let ?my = Braty in check body ((), to_define)
-        pure ()
+        (((), ()), ((), []), p) <- let ?my = Braty in check body ((), to_define)
+        p
       Undefined -> error "No body in `checkDecl`"
       ThunkOf _ -> case fnSig of
         Some ro -> err $ ExpectedThunk (showMode Braty) (show ro)

From 23853e5e6b315230dc91fc8cc6718514f0463b99 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 16:12:06 +0100
Subject: [PATCH 034/182] Add infer_thunks(,2).brat example; ...2 works but map
 body not checked

---
 brat/examples/infer_thunks.brat  | 11 +++++++++++
 brat/examples/infer_thunks2.brat | 11 +++++++++++
 2 files changed, 22 insertions(+)
 create mode 100644 brat/examples/infer_thunks.brat
 create mode 100644 brat/examples/infer_thunks2.brat

diff --git a/brat/examples/infer_thunks.brat b/brat/examples/infer_thunks.brat
new file mode 100644
index 00000000..1030efc5
--- /dev/null
+++ b/brat/examples/infer_thunks.brat
@@ -0,0 +1,11 @@
+ext "to_float" to_float(i :: Int) -> Float
+
+id(X :: *, X) -> X
+id(_, x) = x
+
+map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
+map(_, _, _, []) = []
+map(X, Y, f, x ,- xs) = f(x) ,- map(X, Y, f, xs)
+
+test :: List(Float)
+test = map(!, !, {f => f(5)}, [to_float])
diff --git a/brat/examples/infer_thunks2.brat b/brat/examples/infer_thunks2.brat
new file mode 100644
index 00000000..d9006b1a
--- /dev/null
+++ b/brat/examples/infer_thunks2.brat
@@ -0,0 +1,11 @@
+ext "to_float" to_float(i :: Int) -> Float
+
+id(X :: *, X) -> X
+id(_, x) = x
+
+map(X :: *, Y :: *, List(X), { X -> Y }) -> List(Y)
+map(_, _, [], _) = []
+map(X, Y, x ,- xs, f) = f(x) ,- map(X, Y, xs, f)
+
+test :: List(Float)
+test = map(!, !, [to_float], {f => f(5)})

From 75e9017962e357c267df2c6089f5485ca10fe44c Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 20 Sep 2024 15:12:46 +0100
Subject: [PATCH 035/182] checkClause returns subproblem (oops) - BOTH
 infer_thunks(,2) failing to find f

---
 brat/Brat/Checker.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 950c0157..f62fe55a 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -291,12 +291,14 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
     let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
                   \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
     let clauseProblems = do
-          clauses <- traverse (checkClause ?my "lambda" cty) clauses
+          clauses_probs <- traverse (checkClause ?my "lambda" cty) clauses
+          let clauses = clauses_probs <&> (\(tm, n, _) -> (tm, n))
+          let probs = clauses_probs <&> (\(_, _, p) -> p)
           let inputs  = [ (portName p, biType @m ty) | (p, ty) <- patMatchUnders ]
           let outputs = [ (portName p, biType @m ty) | (p, ty) <- patMatchOvers  ]
           req $ AddNode node (mkNode ?my (PatternMatch clauses) inputs outputs) -- not added by anext because suppressGraph
           mkWires overs patMatchUnders -- might canonicalize type better now
-          pure ()
+          sequence_ probs
     pure (patMatchOvers, clauseProblems)
 
 check' (Pull ports t) (overs, unders) = do
@@ -543,6 +545,7 @@ checkClause :: forall m. (CheckConstraints m UVerb, EvMode m) => Modey m
             -> Checking
                ( TestMatchData m -- TestMatch data (LHS)
                , Name   -- Function node (RHS)
+               , Checking ()  -- subproblem for later
                )
 checkClause my fnName cty clause = modily my $ do
   let clauseName = fnName ++ "." ++ show (index clause)
@@ -566,13 +569,14 @@ checkClause my fnName cty clause = modily my $ do
           pure (vars, match, patRo :->> outRo)
 
   -- Now actually make a box for the RHS and check it
-  ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
+  ((boxPort, _ty), p) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
     let abstractor = foldr ((:||:) . APat . Bind) AEmpty vars
     let ?my = my in do
       env <- abstractAll rhsOvers abstractor
-      localEnv env $ check @m (rhs clause) ((), rhsUnders)
+      (((), ()), ((), []), p) <- localEnv env $ check @m (rhs clause) ((), rhsUnders)
+      pure p
   let NamedPort {end=Ex rhsNode _} = boxPort
-  pure (match, rhsNode)
+  pure (match, rhsNode, p)
 
 -- Top level function for type checking function definitions
 -- Will make a top-level box for the function, then type check the definition

From 0f21ce7b473427b8267e41f36d2ebc97e3456804 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 20 Sep 2024 15:13:20 +0100
Subject: [PATCH 036/182] Revert "checkClause returns subproblem (oops) - BOTH
 infer_thunks(,2) failing to find f"

This reverts commit dda55c7e6f0e2241f54de924d80af73f62307f09.
---
 brat/Brat/Checker.hs | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index f62fe55a..950c0157 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -291,14 +291,12 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
     let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
                   \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
     let clauseProblems = do
-          clauses_probs <- traverse (checkClause ?my "lambda" cty) clauses
-          let clauses = clauses_probs <&> (\(tm, n, _) -> (tm, n))
-          let probs = clauses_probs <&> (\(_, _, p) -> p)
+          clauses <- traverse (checkClause ?my "lambda" cty) clauses
           let inputs  = [ (portName p, biType @m ty) | (p, ty) <- patMatchUnders ]
           let outputs = [ (portName p, biType @m ty) | (p, ty) <- patMatchOvers  ]
           req $ AddNode node (mkNode ?my (PatternMatch clauses) inputs outputs) -- not added by anext because suppressGraph
           mkWires overs patMatchUnders -- might canonicalize type better now
-          sequence_ probs
+          pure ()
     pure (patMatchOvers, clauseProblems)
 
 check' (Pull ports t) (overs, unders) = do
@@ -545,7 +543,6 @@ checkClause :: forall m. (CheckConstraints m UVerb, EvMode m) => Modey m
             -> Checking
                ( TestMatchData m -- TestMatch data (LHS)
                , Name   -- Function node (RHS)
-               , Checking ()  -- subproblem for later
                )
 checkClause my fnName cty clause = modily my $ do
   let clauseName = fnName ++ "." ++ show (index clause)
@@ -569,14 +566,13 @@ checkClause my fnName cty clause = modily my $ do
           pure (vars, match, patRo :->> outRo)
 
   -- Now actually make a box for the RHS and check it
-  ((boxPort, _ty), p) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
+  ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
     let abstractor = foldr ((:||:) . APat . Bind) AEmpty vars
     let ?my = my in do
       env <- abstractAll rhsOvers abstractor
-      (((), ()), ((), []), p) <- localEnv env $ check @m (rhs clause) ((), rhsUnders)
-      pure p
+      localEnv env $ check @m (rhs clause) ((), rhsUnders)
   let NamedPort {end=Ex rhsNode _} = boxPort
-  pure (match, rhsNode, p)
+  pure (match, rhsNode)
 
 -- Top level function for type checking function definitions
 -- Will make a top-level box for the function, then type check the definition

From 3bebd4cb071b3c758ac10b42438127bce44f72f9 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 21 Aug 2024 17:25:51 +0100
Subject: [PATCH 037/182] WIP debug (shows we stop at [to_float] and never
 check to_float)

---
 brat/Brat/Checker.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 950c0157..154c68d0 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -48,6 +48,7 @@ import Brat.UserName
 import Bwd
 import Hasochism
 import Util (zip_same_length)
+import Debug.Trace
 
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
@@ -183,7 +184,7 @@ check :: (CheckConstraints m k
       -> Checking (SynConnectors m d k
                   ,ChkConnectors m d k
                   ,Checking ())
-check (WC fc tm) conn = localFC fc (check' tm conn)
+check (WC fc tm) conn = trace ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
 
 check' :: forall m d k
         . (CheckConstraints m k
@@ -461,7 +462,8 @@ check' (VHole (mnemonic, name)) connectors = do
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
-  pure (((), ()), ((), unders), subp)
+  trace ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs) $
+    pure (((), ()), ((), unders), subp)
  where
   subp = case (?my, ty) of
     (Braty, Left k) -> do

From dce7f0f1e0b5d835bbdce5816fb0769550fcfff5 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:03:44 +0100
Subject: [PATCH 038/182] Try just using *> rather than returning subproblem
 (tests build, 59 fail)

---
 brat/Brat/Checker.hs | 117 ++++++++++++++++++++-----------------------
 brat/Brat/Load.hs    |   4 +-
 2 files changed, 57 insertions(+), 64 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 154c68d0..4932e479 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -183,7 +183,7 @@ check :: (CheckConstraints m k
       -> ChkConnectors m d k
       -> Checking (SynConnectors m d k
                   ,ChkConnectors m d k
-                  ,Checking ())
+                  )
 check (WC fc tm) conn = trace ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
 
 check' :: forall m d k
@@ -196,23 +196,22 @@ check' :: forall m d k
        -> ChkConnectors m d k
        -> Checking (SynConnectors m d k
                    ,ChkConnectors m d k -- rightovers
-                   ,Checking () -- subproblem(s) still needing solving
                    )
-check' Empty tys = pure (((), ()), tys, pure ())
+check' Empty tys = pure (((), ()), tys)
 check' (s :|: t) tys = do
   -- in Checking mode, each LHS/RHS removes its wires+types from the ChkConnectors remaining
-  ((ins, outs), tys, ps)  <- check s tys
-  ((ins', outs'), tys, pt) <- check t tys
+  ((ins, outs), tys)  <- check s tys
+  ((ins', outs'), tys) <- check t tys
   -- in Synthesizing mode, instead here we join together the outputs, and the inputs
-  pure ((combine ins ins', tensor outs outs'), tys, ps <* pt)
+  pure ((combine ins ins', tensor outs outs'), tys)
 check' (s :-: t) (overs, unders) = do
   -- s is Syn, t is a UVerb
-  ((ins, overs), (rightovers, ()), ps) <- check s (overs, ())
-  (((), outs), (emptyOvers, rightunders), pt) <- check t (overs, unders)
+  ((ins, overs), (rightovers, ())) <- check s (overs, ())
+  (((), outs), (emptyOvers, rightunders)) <- check t (overs, unders)
   ensureEmpty "composition overs" emptyOvers
-  pure ((ins, outs), (rightovers, rightunders), ps <* pt)
+  pure ((ins, outs), (rightovers, rightunders))
 check' Pass ([], ()) = typeErr "pass is being given an empty row"
-check' Pass (overs, ()) = pure (((), overs), ([], ()), pure ())
+check' Pass (overs, ()) = pure (((), overs), ([], ()))
 check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
   -- Used overs have their port pulling taken care of
   (problem, rightOverSrcs) <- localFC abstFC $ argProblemsWithLeftovers (fst <$> overs) (normaliseAbstractor abst) []
@@ -236,31 +235,30 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
         localEnv fakeEnv $ do
           (_, fakeUnders, [], _) <- anext "lambda_fake_target" Hypo fakeAcc outs R0
           Just tgtMap <- pure $ zip_same_length (fst <$> fakeUnders) unders
-          -- no need to finish checking the body subproblem, we'll check it again in a moment
-          (((), ()), ((), rightFakeUnders), _) <- check body ((), fakeUnders)
+          (((), ()), ((), rightFakeUnders)) <- check body ((), fakeUnders)
           pure (fakeUnders, rightFakeUnders, tgtMap)
 
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
       let usedUnders = [ fromJust (lookup tgt tgtMap) | tgt <- usedFakeUnders ]
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
-      let clauseProblems = do
+      let clauseProblems :: Checking () = do
             sig <- mkSig usedOvers usedUnders
             (patOuts, rest) <- checkClauses sig usedOvers (c :| cs)
             mkWires patOuts usedUnders
             rest
-      pure (((), ()), (rightOvers, rightUnders), clauseProblems)
+      clauseProblems *> pure (((), ()), (rightOvers, rightUnders))
     Syny -> do
-      (synthOuts, p) <- suppressHoles $ suppressGraph $ do
+      synthOuts <- suppressHoles $ suppressGraph $ do
         env <- localFC abstFC $
           argProblems (fst <$> usedOvers) (normaliseAbstractor abst) [] >>=
           solve ?my >>=
           (solToEnv . snd)
-        (((), synthOuts), ((), ()), p) <- localEnv env $ check body ((), ())
-        pure (synthOuts, suppressHoles $ suppressGraph $ localEnv env p)
+        (((), synthOuts), ((), ())) <- localEnv env $ check body ((), ())
+        pure synthOuts
       sig <- mkSig usedOvers synthOuts
       (patOuts, clauseProbs) <- checkClauses sig usedOvers
           ((fst c, WC (fcOf body) (Emb body)) :| cs)
-      pure (((), patOuts), (rightOvers, ()), p *> clauseProbs)
+      clauseProbs *> pure (((), patOuts), (rightOvers, ()))
  where
   -- Invariant: When solToEnv is called, port pulling has already been resolved,
   -- because that's one of the functions of `argProblems`.
@@ -306,13 +304,13 @@ check' (Pull ports t) (overs, unders) = do
 check' (t ::: outs) (overs, ()) | Braty <- ?my = do
   (ins :->> outs) :: CTy Brat Z <- kindCheckAnnotation Braty ":::" outs
   (_, hungries, danglies, _) <- next "id" Id (S0,Some (Zy :* S0)) ins outs
-  (((), ()), (leftOvers, unders), p) <- check t (overs, hungries)
+  (((), ()), (leftOvers, unders)) <- check t (overs, hungries)
   ensureEmpty "unders" unders
-  pure (((), danglies), (leftOvers, ()), p)
+  pure (((), danglies), (leftOvers, ()))
 check' (Emb t) (overs, unders) = do
-  ((ins, outs), (overs, ()), p) <- check t (overs, ())
+  ((ins, outs), (overs, ())) <- check t (overs, ())
   (unders, p') <- throwLeft $ checkOutputs t unders outs
-  pure ((ins, ()), (overs, unders), p *> p')
+  p' *> pure ((ins, ()), (overs, unders))
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
   (Braty, ty) ->
     let subp = evalBinder Braty ty >>= \case
@@ -321,7 +319,7 @@ check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
           Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
           Left (Star args) -> kindCheck [(hungry, Star args)] (Th tm) $> ()
           _ -> err . ExpectedThunk "" $ showRow (u:unders)
-    in pure (((), ()), ((), unders), subp)
+    in subp *> pure (((), ()), ((), unders))
   (Kerny, _) -> err . ThunkInKernel $ show (Th tm)
  where
   checkThunk :: (CheckConstraints m1 UVerb, EvMode m1)
@@ -333,10 +331,9 @@ check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
   checkThunk m name cty tm = do
     ((dangling, _), ()) <- let ?my = m in makeBox name cty $
       \(thOvers, thUnders) -> do
-        (((), ()), (emptyOvers, emptyUnders), p) <- check tm (thOvers, thUnders)
+        (((), ()), (emptyOvers, emptyUnders)) <- check tm (thOvers, thUnders)
         ensureEmpty "thunk leftovers" emptyOvers
         ensureEmpty "thunk leftunders" emptyUnders
-        p
     pure dangling
 
 check' (TypedTh t) ((), ()) = case ?my of
@@ -352,16 +349,15 @@ check' (TypedTh t) ((), ()) = case ?my of
       -- both a classical type and a kernel type, but just in case:
       -- (pushing down Emb(TypedTh(v)) to Thunk(Emb+Forget(v)) would help in Checkable cases)
       (Right _, Right _) -> typeErr "TypedTh could be either Brat or Kernel"
-      (Left _, Right (conns, ((), ()), kp)) -> let ?my = Kerny in createThunk conns kp
-      (Right (conns, ((), ()), bp), Left _) -> createThunk conns bp
+      (Left _, Right (conns, ((), ()))) -> let ?my = Kerny in createThunk conns
+      (Right (conns, ((), ())), Left _) -> createThunk conns
  where
   createThunk :: (CheckConstraints m2 Noun, ?my :: Modey m2, EvMode m2)
               => SynConnectors m2 Syn KVerb
-              -> Checking ()
               -> Checking (SynConnectors Brat Syn Noun
                           ,ChkConnectors Brat Syn Noun
-                          ,Checking ())
-  createThunk (ins, outs) p = do
+                          )
+  createThunk (ins, outs) = do
     Some (ez :* inR) <- mkArgRo ?my S0 (first (fmap toEnd) <$> ins)
     Some (_ :* outR) <- mkArgRo ?my ez (first (fmap toEnd) <$> outs)
     (thunkOut, p) <- makeBox "thunk" (inR :->> outR) $
@@ -371,19 +367,18 @@ check' (TypedTh t) ((), ()) = case ?my of
           ensureEmpty "TypedTh inputs" rightUnders
           (leftOvers, op) <- throwLeft $ checkOutputs t thUnders outs
           ensureEmpty "TypedTh outputs" leftOvers
-          pure (p *> ip *> op)
-    pure (((), [thunkOut]), ((), ()), p)
+          pure (ip *> op)
+    p *> pure (((), [thunkOut]), ((), ()))
 check' (Force th) ((), ()) = do
-  (((), outs), ((), ()), p) <- let ?my = Braty in check th ((), ())
+  (((), outs), ((), ())) <- let ?my = Braty in check th ((), ())
   -- pull a bunch of thunks (only!) out of here
-  p *> do -- allow p to run concurrently with getThunks and rest of check' Force
-    (_, thInputs, thOutputs) <- getThunks ?my outs
-    pure ((thInputs, thOutputs), ((), ()), pure ())
+  (_, thInputs, thOutputs) <- getThunks ?my outs
+  pure ((thInputs, thOutputs), ((), ()))
 check' (Forget kv) (overs, unders) = do
-  ((ins, outs), ((), rightUnders), p) <- check kv ((), unders)
-  (leftOvers, p') <- throwLeft $ checkInputs kv overs ins
-  pure (((), outs), (leftOvers, rightUnders), p *> p')
-check' (Var x) ((), ()) = (, ((), ()), pure ()) . ((),) <$> case ?my of
+  ((ins, outs), ((), rightUnders)) <- check kv ((), unders)
+  (leftOvers, p) <- throwLeft $ checkInputs kv overs ins
+  p *> pure (((), outs), (leftOvers, rightUnders))
+check' (Var x) ((), ()) = (, ((), ())) . ((),) <$> case ?my of
   Braty -> vlup x
   Kerny -> req (KLup x) >>= \case
     Just (p, ty) -> pure [(p, ty)]
@@ -402,29 +397,28 @@ check' (Arith op l r) ((), u@(hungry, ty):unders) = case (?my, ty) of
     let inRo = RPr ("left", ty) $ RPr ("right", ty) R0
     let outRo = RPr ("out", ty) R0
     (_, [lunders, runders], [(dangling, _)], _) <- next (show op) (ArithNode op) (S0, Some $ Zy :* S0) inRo outRo
-    (((), ()), ((), leftUnders), pl) <- check l ((), [lunders])
+    (((), ()), ((), leftUnders)) <- check l ((), [lunders])
     ensureEmpty "arith unders" leftUnders
-    (((), ()), ((), leftUnders), pr) <- check r ((), [runders])
+    (((), ()), ((), leftUnders)) <- check r ((), [runders])
     ensureEmpty "arith unders" leftUnders
     wire (dangling, ty, hungry)
-    pure (((), ()), ((), unders), pl *> pr)
+    pure (((), ()), ((), unders))
 check' (fun :$: arg) (overs, unders) = do
-  ((ins, outputs), ((), leftUnders), pf) <- check fun ((), unders)
-  ((argIns, ()), (leftOvers, argUnders), pa) <- check arg (overs, ins)
+  ((ins, outputs), ((), leftUnders)) <- check fun ((), unders)
+  ((argIns, ()), (leftOvers, argUnders)) <- check arg (overs, ins)
   ensureEmpty "leftover function args" argUnders
-  pure ((argIns, outputs), (leftOvers, leftUnders), pf *> pa)
+  pure ((argIns, outputs), (leftOvers, leftUnders))
 check' (Let abs x y) conn = do
-  (((), dangling), ((), ()), px) <- check x ((), ())
+  (((), dangling), ((), ())) <- check x ((), ())
   env <- abstractAll dangling (unWC abs)
-  (sycs, chcs, py) <- localEnv env $ check y conn
-  pure (sycs, chcs, px *> py)
+  localEnv env $ check y conn
 check' (NHole (mnemonic, name)) connectors = do
   fc <- req AskFC
   let suggestions = Nothing
   () <- case ?my of
     Kerny -> req $ LogHole $ TypedHole NKHole (HoleData { .. })
     Braty -> req $ LogHole $ TypedHole NBHole (HoleData { .. })
-  pure (((), ()), ((), []), pure ())
+  pure (((), ()), ((), []))
 -- TODO: Fix this
 {-
   where
@@ -458,14 +452,14 @@ check' (VHole (mnemonic, name)) connectors = do
   req $ LogHole $ case ?my of
     Braty -> TypedHole VBHole (HoleData { .. })
     Kerny -> TypedHole VKHole (HoleData { .. })
-  pure (((), ()), ([], []), pure ())
+  pure (((), ()), ([], []))
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
   trace ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs) $
-    pure (((), ()), ((), unders), subp)
+    subp *> pure (((), ()), ((), unders))
  where
-  subp = case (?my, ty) of
+  subp :: Checking () = case (?my, ty) of
     (Braty, Left k) -> do
       (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
       ensureEmpty "kindCheck leftovers" leftOvers
@@ -488,16 +482,16 @@ check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
-    (((), ()), ((), leftUnders), p) <- wrapError wrap $ check vargs ((), argUnders)
+    (((), ()), ((), leftUnders)) <- wrapError wrap $ check vargs ((), argUnders)
     ensureEmpty "con unders" leftUnders
-    p
     wire (dangling, ty, hungry)
 
 check' (C cty) ((), ((hungry, ty):unders)) = case (?my, ty) of
-  (Braty, Left k) -> pure (((), ()), ((), unders),
-      kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
+  (Braty, Left k) -> 
+      (kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
+      *> pure (((), ()), ((), unders))
   _ -> typeErr $ "Ill-kinded function type: " ++ show cty
-check' (Simple tm) ((), ((hungry, ty):unders)) = pure (((), ()), ((), unders), subp)
+check' (Simple tm) ((), ((hungry, ty):unders)) = subp *> pure (((), ()), ((), unders))
  where
   subp = do
     ty <- evalBinder ?my ty
@@ -520,8 +514,8 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = pure (((), ()), ((), unders), s
 check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
   (Braty, Left _k) -> do
     fc <- req AskFC
-    req (ANewHope (toEnd tgt, fc))
-    pure (((), ()), ((), unders), pure ()) -- could probably delay ANewHope too
+    req (ANewHope (toEnd tgt, fc)) -- could probably delay via *>
+    pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
 check' tm _ = error $ "check' " ++ show tm
@@ -591,10 +585,9 @@ checkBody fnName body cty = do
       pure (WC fc (Lambda c cs))
     Undefined -> err (InternalError "Checking undefined clause")
   ((src, _), ()) <- makeBox (fnName ++ ".box") cty $ \(overs, unders) -> do
-    (((),()), (rightOvers, rightUnders), p) <- check tm (overs, unders)
+    (((),()), (rightOvers, rightUnders)) <- check tm (overs, unders)
     ensureEmpty ("unconsumed inputs to " ++ fnName) rightOvers
     ensureEmpty ("unproduced outputs from " ++ fnName) rightUnders
-    p
   pure src
 
 -- Constructs row from a list of ends and types. Uses standardize to ensure that dependency is
diff --git a/brat/Brat/Load.hs b/brat/Brat/Load.hs
index 5f077ad0..9fffe43c 100644
--- a/brat/Brat/Load.hs
+++ b/brat/Brat/Load.hs
@@ -67,8 +67,8 @@ checkDecl pre (VDecl FuncDecl{..}) to_define = (fnName -!) $ localFC fnLoc $ do
     -- We must have a row of nouns as the definition
     Nothing -> case fnBody of
       NoLhs body -> do
-        (((), ()), ((), []), p) <- let ?my = Braty in check body ((), to_define)
-        p
+        (((), ()), ((), [])) <- let ?my = Braty in check body ((), to_define)
+        pure ()
       Undefined -> error "No body in `checkDecl`"
       ThunkOf _ -> case fnSig of
         Some ro -> err $ ExpectedThunk (showMode Braty) (show ro)

From 5764083e87999536dbdc54358749420d4164f5b9 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:04:39 +0100
Subject: [PATCH 039/182] WIP add request to Fork, but TODO captureOuterLocals
 (tests build but 128 fail)

---
 brat/Brat/Checker.hs        | 52 ++++++++++++++++++++-----------------
 brat/Brat/Checker/Monad.hs  | 12 ++++++++-
 brat/Control/Monad/Freer.hs |  2 ++
 3 files changed, 41 insertions(+), 25 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 4932e479..10d9a421 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -241,12 +241,12 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
       let usedUnders = [ fromJust (lookup tgt tgtMap) | tgt <- usedFakeUnders ]
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
-      let clauseProblems :: Checking () = do
+      req . Fork $ do
             sig <- mkSig usedOvers usedUnders
             (patOuts, rest) <- checkClauses sig usedOvers (c :| cs)
             mkWires patOuts usedUnders
             rest
-      clauseProblems *> pure (((), ()), (rightOvers, rightUnders))
+      pure (((), ()), (rightOvers, rightUnders))
     Syny -> do
       synthOuts <- suppressHoles $ suppressGraph $ do
         env <- localFC abstFC $
@@ -258,7 +258,8 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       sig <- mkSig usedOvers synthOuts
       (patOuts, clauseProbs) <- checkClauses sig usedOvers
           ((fst c, WC (fcOf body) (Emb body)) :| cs)
-      clauseProbs *> pure (((), patOuts), (rightOvers, ()))
+      req $ Fork clauseProbs -- TODO don't return clauseProbs from checkClauses
+      pure (((), patOuts), (rightOvers, ()))
  where
   -- Invariant: When solToEnv is called, port pulling has already been resolved,
   -- because that's one of the functions of `argProblems`.
@@ -310,16 +311,17 @@ check' (t ::: outs) (overs, ()) | Braty <- ?my = do
 check' (Emb t) (overs, unders) = do
   ((ins, outs), (overs, ())) <- check t (overs, ())
   (unders, p') <- throwLeft $ checkOutputs t unders outs
-  p' *> pure ((ins, ()), (overs, unders))
+  req $ Fork p'
+  pure ((ins, ()), (overs, unders))
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
-  (Braty, ty) ->
-    let subp = evalBinder Braty ty >>= \case
+  (Braty, ty) -> do
+    req . Fork $ evalBinder Braty ty >>= \case
           -- the case split here is so we can be sure we have the necessary CheckConstraints
           Right ty@(VFun Braty cty) -> checkThunk Braty "thunk" cty tm >>= wire . (,ty, hungry)
           Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
           Left (Star args) -> kindCheck [(hungry, Star args)] (Th tm) $> ()
           _ -> err . ExpectedThunk "" $ showRow (u:unders)
-    in subp *> pure (((), ()), ((), unders))
+    pure (((), ()), ((), unders))
   (Kerny, _) -> err . ThunkInKernel $ show (Th tm)
  where
   checkThunk :: (CheckConstraints m1 UVerb, EvMode m1)
@@ -368,7 +370,8 @@ check' (TypedTh t) ((), ()) = case ?my of
           (leftOvers, op) <- throwLeft $ checkOutputs t thUnders outs
           ensureEmpty "TypedTh outputs" leftOvers
           pure (ip *> op)
-    p *> pure (((), [thunkOut]), ((), ()))
+    req $ Fork p
+    pure (((), [thunkOut]), ((), ()))
 check' (Force th) ((), ()) = do
   (((), outs), ((), ())) <- let ?my = Braty in check th ((), ())
   -- pull a bunch of thunks (only!) out of here
@@ -377,7 +380,8 @@ check' (Force th) ((), ()) = do
 check' (Forget kv) (overs, unders) = do
   ((ins, outs), ((), rightUnders)) <- check kv ((), unders)
   (leftOvers, p) <- throwLeft $ checkInputs kv overs ins
-  p *> pure (((), outs), (leftOvers, rightUnders))
+  req $ Fork p
+  pure (((), outs), (leftOvers, rightUnders))
 check' (Var x) ((), ()) = (, ((), ())) . ((),) <$> case ?my of
   Braty -> vlup x
   Kerny -> req (KLup x) >>= \case
@@ -455,16 +459,16 @@ check' (VHole (mnemonic, name)) connectors = do
   pure (((), ()), ([], []))
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
-check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
-  trace ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs) $
-    subp *> pure (((), ()), ((), unders))
+check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
+  traceM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
+  req . Fork $ case (?my, ty) of
+      (Braty, Left k) -> do
+        (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
+        ensureEmpty "kindCheck leftovers" leftOvers
+      (Braty, Right ty) -> aux Braty clup ty
+      (Kerny, _) -> aux Kerny kclup ty
+  pure (((), ()), ((), unders))
  where
-  subp :: Checking () = case (?my, ty) of
-    (Braty, Left k) -> do
-      (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
-      ensureEmpty "kindCheck leftovers" leftOvers
-    (Braty, Right ty) -> aux Braty clup ty
-    (Kerny, _) -> aux Kerny kclup ty
   aux :: Modey m -> (UserName -> UserName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
     VCon tycon tyargs <- eval S0 ty
@@ -487,13 +491,12 @@ check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) =
     wire (dangling, ty, hungry)
 
 check' (C cty) ((), ((hungry, ty):unders)) = case (?my, ty) of
-  (Braty, Left k) -> 
-      (kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
-      *> pure (((), ()), ((), unders))
+  (Braty, Left k) ->  do
+      req $ Fork (kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
+      pure (((), ()), ((), unders))
   _ -> typeErr $ "Ill-kinded function type: " ++ show cty
-check' (Simple tm) ((), ((hungry, ty):unders)) = subp *> pure (((), ()), ((), unders))
- where
-  subp = do
+check' (Simple tm) ((), ((hungry, ty):unders)) = do
+  req . Fork $ do
     ty <- evalBinder ?my ty
     case (?my, ty, tm) of
       -- The only SimpleType that checks against a kind is a Nat
@@ -511,6 +514,7 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = subp *> pure (((), ()), ((), un
         (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
                                       R0 (RPr ("value", vty) R0)
         wire (dangling, vty, hungry)
+  pure (((), ()), ((), unders))
 check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
   (Braty, Left _k) -> do
     fc <- req AskFC
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 28f4faed..9d187340 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -97,12 +97,14 @@ data CheckingSig ty where
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
   ANewHope :: (End, FC) -> CheckingSig ()
   AskHopeSet :: CheckingSig HopeSet
+  Fork :: Checking () -> CheckingSig ()
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
 localAlias con@(name, alias) (Req (ALup u) k)
   | u == name = localAlias con $ k (Just alias)
 localAlias con (Req (InLvl str c) k) = Req (InLvl str (localAlias con c)) (localAlias con . k)
+localAlias con (Req (Fork c) k) = Req (Fork $ localAlias con c) (localAlias con . k)
 localAlias con (Req r k) = Req r (localAlias con . k)
 localAlias con (Define v e k) = Define v e (localAlias con . k)
 localAlias con (Yield st k) = Yield st (localAlias con . k)
@@ -112,6 +114,7 @@ localFC _ (Ret v) = Ret v
 localFC f (Req AskFC k) = localFC f (k f)
 localFC f (Req (Throw (e@Err{fc=Nothing})) k) = localFC f (Req (Throw (e{fc=Just f})) k)
 localFC f (Req (InLvl str c) k) = Req (InLvl str (localFC f c)) (localFC f . k)
+localFC f (Req (Fork c) k) = Req (Fork $ localFC f c) (localFC f . k)
 localFC f (Req r k) = Req r (localFC f . k)
 localFC f (Define v e k) = Define v e (localFC f . k)
 localFC f (Yield st k) = Yield st (localFC f . k)
@@ -129,6 +132,7 @@ localVEnv ext (Req AskVEnv k) = do env <- req AskVEnv
                                    -- ext shadows local vars
                                    localVEnv ext (k (env { locals = M.union ext (locals env) }))
 localVEnv ext (Req (InLvl str c) k) = Req (InLvl str (localVEnv ext c)) (localVEnv ext . k)
+localVEnv ext (Req (Fork c) k) = Req (Fork $ localVEnv ext c) (localVEnv ext . k)
 localVEnv ext (Req r k) = Req r (localVEnv ext . k)
 localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
 localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
@@ -149,6 +153,7 @@ captureOuterLocals c = do
     helper (avail, captured) (k v)
   helper (avail, captured) (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
     helper (avail, M.insert x new captured) (k j)
+  helper _state (Req (Fork _c) _k) = error "it happens!" -- ALAN
   helper state (Req r k) = Req r (helper state . k)
   helper state (Define e v k) = Define e v (helper state . k)
   helper state (Yield st k) = Yield st (helper state . k)
@@ -157,6 +162,7 @@ wrapError :: (Error -> Error) -> Checking v -> Checking v
 wrapError _ (Ret v) = Ret v
 wrapError f (Req (Throw e) k) = Req (Throw (f e)) k
 wrapError f (Req (InLvl str c) k) = Req (InLvl str (wrapError f c)) (wrapError f . k)
+wrapError f (Req (Fork c) k) = Req (Fork $ wrapError f c) (wrapError f . k)
 wrapError f (Req r k) = Req r (wrapError f . k)
 wrapError f (Define v e k) = Define v e (wrapError f . k)
 wrapError f (Yield st k) = Yield st (wrapError f . k)
@@ -220,6 +226,7 @@ localKVar env (Req KDone k) = case [ x | (x,(One,_)) <- M.assocs env ] of
                                               ,intercalate ", " (fmap show xs)
                                               ,"haven't been used"
                                               ]
+localKVar env (Req (Fork c) k) = Req (Fork $ localKVar env c) (localKVar env . k)
 localKVar env (Req r k) = Req r (localKVar env . k)
 localKVar env (Define e v k) = Define e v (localKVar env . k)
 localKVar env (Yield st k) = Yield st (localKVar env . k)
@@ -293,8 +300,9 @@ handler (Req s k) ctx g ns
         handler (k args) ctx g ns
 
       ANewHope (e, fc) -> handler (k ()) (ctx { hopeSet = M.insert e fc (hopeSet ctx) }) g ns
-
       AskHopeSet -> handler (k (hopeSet ctx)) ctx g ns
+      Fork c -> handler (k () <* c) ctx g ns
+
 handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
   case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
@@ -359,6 +367,7 @@ instance MonadFail Checking where
 suppressHoles :: Checking a -> Checking a
 suppressHoles (Ret x) = Ret x
 suppressHoles (Req (LogHole _) k) = suppressHoles (k ())
+suppressHoles (Req (Fork c) k) = Req (Fork $ suppressHoles c) (suppressHoles . k)
 suppressHoles (Req c k) = Req c (suppressHoles . k)
 suppressHoles (Define v e k) = Define v e (suppressHoles . k)
 suppressHoles (Yield st k) = Yield st (suppressHoles . k)
@@ -368,6 +377,7 @@ suppressGraph :: Checking a -> Checking a
 suppressGraph (Ret x) = Ret x
 suppressGraph (Req (AddNode _ _) k) = suppressGraph (k ())
 suppressGraph (Req (Wire _) k) = suppressGraph (k ())
+suppressGraph (Req (Fork c) k) = Req (Fork $ suppressGraph c) (suppressGraph . k)
 suppressGraph (Req c k) = Req c (suppressGraph . k)
 suppressGraph (Define v e k) = Define v e (suppressGraph . k)
 suppressGraph (Yield st k) = Yield st (suppressGraph . k)
diff --git a/brat/Control/Monad/Freer.hs b/brat/Control/Monad/Freer.hs
index 8dedc5e4..9b6be04f 100644
--- a/brat/Control/Monad/Freer.hs
+++ b/brat/Control/Monad/Freer.hs
@@ -93,6 +93,8 @@ instance Monad (Free sig) where
   Req r j >>= k = Req r (j >=> k)
   Define e v k1 >>= k2 = Define e v (k1 >=> k2)
   Yield st k1 >>= k2 = Yield st (k1 >=> k2)
+  --- equivalent to
+  -- Yield st k1 >>= k2 = Yield st (\n -> (k1 n) >>= k2)
 
 req :: sig t -> Free sig t
 req s = Req s Ret

From a2ebfcf49d6fb0f2ffe17f28567f938ab121ae7f Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:05:41 +0100
Subject: [PATCH 040/182] Add captureSets, AddCapture

---
 brat/Brat/Checker/Monad.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 9d187340..48c8cd22 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -61,6 +61,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , aliasTable :: M.Map UserName Alias
                    -- All the ends here should be targets
                    , hopeSet :: HopeSet
+                   , captureSets :: M.Map Name VEnv
                    }
 
 -- Commands for synchronous operations
@@ -98,6 +99,7 @@ data CheckingSig ty where
   ANewHope :: (End, FC) -> CheckingSig ()
   AskHopeSet :: CheckingSig HopeSet
   Fork :: Checking () -> CheckingSig ()
+  AddCapture :: Name -> (UserName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
@@ -302,6 +304,8 @@ handler (Req s k) ctx g ns
       ANewHope (e, fc) -> handler (k ()) (ctx { hopeSet = M.insert e fc (hopeSet ctx) }) g ns
       AskHopeSet -> handler (k (hopeSet ctx)) ctx g ns
       Fork c -> handler (k () <* c) ctx g ns
+      AddCapture n (var, ends) ->
+        handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g ns
 
 handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
   case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of

From 2e4b14ed5b52ee9815c0529a28558f4b55b4ee18 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:09:42 +0100
Subject: [PATCH 041/182] Plumb captureSet into CompilationState (never read),
 various Load.hs corrections

---
 brat/Brat/Checker.hs       |  5 +++--
 brat/Brat/Checker/Monad.hs |  4 +++-
 brat/Brat/Compile/Hugr.hs  | 14 +++++++++-----
 brat/Brat/Compiler.hs      |  9 +++++----
 brat/Brat/Load.hs          | 19 +++++++++++--------
 brat/lsp/Driver.hs         |  2 +-
 brat/test/Test/Graph.hs    |  2 +-
 brat/test/Test/Util.hs     |  2 +-
 8 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 10d9a421..301a97a7 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -980,7 +980,7 @@ run :: VEnv
     -> Store
     -> Namespace
     -> Checking a
-    -> Either Error (a, ([TypedHole], Store, Graph, Namespace))
+    -> Either Error (a, ([TypedHole], Store, Graph, CaptureSets, Namespace))
 run ve initStore ns m = do
   let ctx = Ctx { globalVEnv = ve
                 , store = initStore
@@ -990,6 +990,7 @@ run ve initStore ns m = do
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
                 , hopeSet = M.empty
+                , captureSets = M.empty
                 }
   (a,ctx,(holes, graph),ns) <- handler m ctx mempty ns
   let tyMap = typeMap $ store ctx
@@ -997,7 +998,7 @@ run ve initStore ns m = do
   -- Even though we didn't need them for typechecking problems, our runtime
   -- behaviour depends on the values of the holes, which we can't account for.
   case M.toList $ M.filterWithKey (\e _ -> isNatKinded tyMap e) (hopeSet ctx) of
-    [] -> pure (a, (holes, store ctx, graph, ns))
+    [] -> pure (a, (holes, store ctx, graph, captureSets ctx, ns))
     -- Just use the FC of the first hole while we don't have the capacity to
     -- show multiple error locations
     hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 48c8cd22..024051a1 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -53,6 +53,8 @@ data CtxEnv = CtxEnv
 
 type HopeSet = M.Map End FC
 
+type CaptureSets = M.Map Name VEnv
+
 data Context = Ctx { globalVEnv :: VEnv
                    , store :: Store
                    , constructors :: ConstructorMap Brat
@@ -61,7 +63,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    , aliasTable :: M.Map UserName Alias
                    -- All the ends here should be targets
                    , hopeSet :: HopeSet
-                   , captureSets :: M.Map Name VEnv
+                   , captureSets :: CaptureSets
                    }
 
 -- Commands for synchronous operations
diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 1dc9a157..258464ae 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -10,7 +10,7 @@
 module Brat.Compile.Hugr (compile) where
 
 import Brat.Constructors.Patterns (pattern CFalse, pattern CTrue)
-import Brat.Checker.Monad (track, trackM, CheckingSig(..))
+import Brat.Checker.Monad (track, trackM, CheckingSig(..), CaptureSets)
 import Brat.Checker.Helpers (binderToValue)
 import Brat.Checker.Types (Store(..), VEnv)
 import Brat.Eval (eval, evalCTy, kindType)
@@ -55,6 +55,7 @@ type TypedPort = (PortId NodeId, HugrType)
 
 data CompilationState = CompilationState
  { bratGraph :: Graph -- the input BRAT Graph; should not be written
+ , capSets :: CaptureSets -- environments captured by Box nodes in previous
  , nameSupply :: Namespace
  , nodes :: M.Map NodeId (HugrOp NodeId) -- this node's id => HugrOp containing parent id
  , edges :: [(PortId NodeId, PortId NodeId)]
@@ -73,8 +74,9 @@ data CompilationState = CompilationState
  , decls :: M.Map Name (NodeId, Bool)
  }
 
-emptyCS g ns store = CompilationState
+emptyCS g cs ns store = CompilationState
   { bratGraph = g
+  , capSets = cs
   , nameSupply = ns
   , nodes = M.empty
   , edges = []
@@ -497,10 +499,11 @@ compileConstDfg :: NodeId -> String -> FunctionType -> (NodeId -> Compile a) ->
 compileConstDfg parent desc box_sig contents = do
   st <- gets store
   g <- gets bratGraph
+  cs <- gets capSets
   -- First, we fork off a new namespace
   (res, cs) <- desc -! do
     ns <- gets nameSupply
-    pure $ flip runState (emptyCS g ns st) $ do
+    pure $ flip runState (emptyCS g cs ns st) $ do
       -- make a DFG node at the root. We can't use `addNode` since the
       -- DFG needs itself as parent
       dfg_id <- freshNode ("Box_" ++ show desc)
@@ -870,13 +873,14 @@ compileNoun outs srcPorts parent = do
 compile :: Store
         -> Namespace
         -> Graph
+        -> CaptureSets
         -> VEnv
         -> BS.ByteString
-compile store ns g venv
+compile store ns g capSets venv
   = evalState
     (trackM "compileFunctions" *>
      compileModule venv *>
      trackM "dumpJSON" *>
      dumpJSON
     )
-    (emptyCS g ns store)
+    (emptyCS g capSets ns store)
diff --git a/brat/Brat/Compiler.hs b/brat/Brat/Compiler.hs
index 7de1b429..8e3986ae 100644
--- a/brat/Brat/Compiler.hs
+++ b/brat/Brat/Compiler.hs
@@ -20,7 +20,7 @@ import System.Exit (die)
 printDeclsHoles :: [FilePath] -> String -> IO ()
 printDeclsHoles libDirs file = do
   env <- runExceptT $ loadFilename root libDirs file
-  (_, decls, holes, _, _) <- eitherIO env
+  (_, decls, holes, _, _, _) <- eitherIO env
   putStrLn "Decls:"
   print decls
   putStrLn ""
@@ -53,7 +53,8 @@ printAST printRaw printAST file = do
 writeDot :: [FilePath] -> String -> String -> IO ()
 writeDot libDirs file out = do
   env <- runExceptT $ loadFilename root libDirs file
-  (_, _, _, _, graph) <- eitherIO env
+  -- Discard captureSets; perhaps we could incorporate into the graph
+  (_, _, _, _, graph, _) <- eitherIO env
   writeFile out (toDotString graph)
 {-
  where
@@ -65,9 +66,9 @@ compileFile :: [FilePath] -> String -> IO (Either String BS.ByteString)
 compileFile libDirs file = do
   let (checkRoot, newRoot) = split "checking" root
   env <- runExceptT $ loadFilename checkRoot libDirs file
-  (venv, _, holes, defs, outerGraph) <- eitherIO env
+  (venv, _, holes, defs, outerGraph, capSets) <- eitherIO env
   pure $ case holes of
-    [] -> Right $ compile defs newRoot outerGraph venv
+    [] -> Right $ compile defs newRoot outerGraph capSets venv
     xs -> Left (show (CompilingHoles (show <$> xs)))
 
 compileAndPrintFile :: [FilePath] -> String -> IO ()
diff --git a/brat/Brat/Load.hs b/brat/Brat/Load.hs
index 9fffe43c..8fa3d960 100644
--- a/brat/Brat/Load.hs
+++ b/brat/Brat/Load.hs
@@ -50,10 +50,12 @@ type VMod = (VEnv
             ,[(UserName, VDecl)] -- all symbols from all modules
             ,[TypedHole]          -- for just the last module
             ,Store  -- Ends declared & defined in the module
-            ,Graph) -- per function, first elem is name
+            ,Graph  -- all functions in this module, nodes identified from first VEnv
+            ,CaptureSets -- for nodes in this module's Graph only
+            )
 
 emptyMod :: VMod
-emptyMod = (M.empty, [], [], initStore, (M.empty, []))
+emptyMod = (M.empty, [], [], initStore, (M.empty, []), M.empty)
 
 -- N.B. This should only be passed local functions
 -- If the decl is a function with pattern matching clauses, return the Name of
@@ -131,7 +133,7 @@ loadStmtsWithEnv ns (venv, oldDecls, oldEndData) (fname, pre, stmts, cts) = addS
   -- Generate some stuff for each entry:
     --  * A map from names to VDecls (aka an Env)
     --  * Some overs and outs??
-  (entries, (_holes, kcStore, kcGraph, ns)) <- run venv initStore ns $
+  (entries, (holes, kcStore, kcGraph, capSets, ns)) <- run venv initStore ns $
     withAliases aliases $ ("globals" -!) $ forM decls $ \d -> localFC (fnLoc d) $ do
       let name = PrefixName pre (fnName d)
       (thing, ins :->> outs, sig, prefix) <- case (fnLocality d) of
@@ -147,16 +149,18 @@ loadStmtsWithEnv ns (venv, oldDecls, oldEndData) (fname, pre, stmts, cts) = addS
       (_, unders, overs, _) <- prefix -! next (show name) thing (S0, Some (Zy :* S0)) ins outs
       pure ((name, VDecl d{fnSig=sig}), (unders, overs))
   trackM "finished kind checking"
+  unless (length holes == 0) $ error "Should be no holes from kind-checking"
+  unless (M.null capSets) $ error "Should be no captures from kind-checking"
   -- We used to check there were no holes from that, but for now we do not bother
   -- A list of local functions (read: with bodies) to define with checkDecl
   let to_define = M.fromList [ (name, unders) | ((name, VDecl decl), (unders, _)) <- entries, fnLocality decl == Local ]
   let vdecls = map fst entries
   -- Now generate environment mapping usernames to nodes in the graph
   venv <- pure $ venv <> M.fromList [(name, overs) | ((name, _), (_, overs)) <- entries]
-  ((), (holes, newEndData, graph, _)) <- run venv kcStore ns $ withAliases aliases $ do
+  ((), (holes, newEndData, graph, capSets, _)) <- run venv kcStore ns $ withAliases aliases $ do
     remaining <- "check_defs" -! foldM checkDecl' to_define vdecls
     pure $ assert (M.null remaining) () -- all to_defines were defined
-  pure (venv, oldDecls <> vdecls, holes, oldEndData <> newEndData, kcGraph <> graph)
+  pure (venv, oldDecls <> vdecls, holes, oldEndData <> newEndData, kcGraph <> graph, capSets)
  where
   checkDecl' :: M.Map UserName [(Tgt, BinderType Brat)]
              -> (UserName, VDecl)
@@ -202,11 +206,10 @@ loadFiles ns (cwd :| extraDirs) fname contents = do
       let main = (cwd </> fname ++ ".brat", [], mainStmts, mainCts)
       pure (deps ++ [main])
     Nothing -> throwError (SrcErr "" $ dumbErr (InternalError "Empty dependency graph"))
-  -- keep (as we fold) and then return only the graphs from the last file in the list
+  -- keep VEnv as we fold but discard holes, graph and captures except from the last file in the list
   liftEither $ foldM
-    (\(venv, decls, _, defs, _) -> loadStmtsWithEnv ns (venv, decls, defs))
+    (\(venv, decls, _, defs, _, _) -> loadStmtsWithEnv ns (venv, decls, defs))
     emptyMod
---     (fname, [], M.empty, contents)
     allStmts'
   where
     -- builds a map from Import to (index in which discovered, module)
diff --git a/brat/lsp/Driver.hs b/brat/lsp/Driver.hs
index 5192af16..22d7a81a 100644
--- a/brat/lsp/Driver.hs
+++ b/brat/lsp/Driver.hs
@@ -115,7 +115,7 @@ loadVFile state _ msg = do
       --                                                vv
       env <- liftIO . runExceptT $ loadFiles Name.root (cwd :| []) (show fileName) file
       case env of
-        Right (_,newDecls,holes,_,_) -> do
+        Right (_,newDecls,holes,_,_,_) -> do
           old <- liftIO $ takeMVar state
           liftIO $ putMVar state (updateState (snd <$> newDecls, holes) old)
           allGood fileName
diff --git a/brat/test/Test/Graph.hs b/brat/test/Test/Graph.hs
index f05bc60f..c86c39c6 100644
--- a/brat/test/Test/Graph.hs
+++ b/brat/test/Test/Graph.hs
@@ -21,7 +21,7 @@ mkGraphTest bratFile = do
   makeBratGraph :: String -> IO Graph
   makeBratGraph contents = runExceptT (loadFiles root includeDirs bratFile contents) >>= \case
     -- ns is a map so will already be sorted
-    Right (_, _, _, _, (ns, es)) -> pure (ns, sortOn endNames es)
+    Right (_, _, _, _, (ns, es), _) -> pure (ns, sortOn endNames es)
     Left err -> assertFailure (show err)
 
   endNames (inp, _, outp) = show inp ++ show outp
diff --git a/brat/test/Test/Util.hs b/brat/test/Test/Util.hs
index 9d9ceddc..a83df95f 100644
--- a/brat/test/Test/Util.hs
+++ b/brat/test/Test/Util.hs
@@ -28,5 +28,5 @@ parseAndCheck libDirs file = testCase (show file) $ do
   env <- runExceptT $ loadFilename root libDirs file
   case env of
     Left err -> assertFailure (show err)
-    Right (venv, nouns, holes, _, _) ->
+    Right (venv, nouns, holes, _, _, _) ->
       ((length venv) + (length nouns) + (length holes) > 0) @? "Should produce something"

From 85ff9c75e6b63df5347fbb2359aed93f70698c57 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 23 Aug 2024 15:27:37 +0100
Subject: [PATCH 042/182] captureOuterLocals routes captures via AddCapture, so
 Box VEnv always null

---
 brat/Brat/Checker/Helpers.hs |  4 ++--
 brat/Brat/Checker/Monad.hs   | 31 +++++++++++++------------------
 brat/Brat/Compile/Hugr.hs    |  6 +++---
 3 files changed, 18 insertions(+), 23 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index c69ae9ce..21c78b8d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -305,9 +305,9 @@ makeBox name cty@(ss :->> ts) body = do
       bres <- name -! body (overs, unders)
       pure (thunk, bres)
     (Braty, body) -> do
-      (bres, captures) <- name -! (captureOuterLocals $ body (overs, unders))
-      (_, [], [thunk], _) <- next (name ++ "_thunk") (Box captures src tgt) (S0, Some (Zy :* S0))
+      (node, [], [thunk], _) <- next (name ++ "_thunk") (Box M.empty src tgt) (S0, Some (Zy :* S0))
                                      R0 (RPr ("thunk", VFun ?my cty) R0)
+      bres <- name -! (captureOuterLocals node $ body (overs, unders))
       pure (thunk, bres)
 
 -- Evaluate either mode's BinderType
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 024051a1..12428f85 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -141,26 +141,21 @@ localVEnv ext (Req r k) = Req r (localVEnv ext . k)
 localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
 localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
 
--- runs a computation, but intercepts uses of outer *locals* variables and redirects
--- them to use new outports of the specified node (expected to be a Source).
--- Returns a list of captured variables and their generated (Source-node) outports
-captureOuterLocals :: Checking v -> Checking (v, VEnv)
-captureOuterLocals c = do
+-- runs a computation, but logs (via AddCapture, under the specified Name) uses of outer
+-- *local* variables
+captureOuterLocals :: Name -> Checking v -> Checking v
+captureOuterLocals n c = do
   outerLocals <- locals <$> req AskVEnv
-  helper (outerLocals, M.empty) c
+  helper outerLocals c
  where
-  helper :: (VEnv, VEnv) -> Checking v
-         -> Checking (v, M.Map UserName [(Src, BinderType Brat)])
-  helper (_, captured) (Ret v) = Ret (v, captured)
-  helper state@(avail,_) (Req (InLvl str c) k) = do
-    (v, captured) <- req (InLvl str (helper state c))
-    helper (avail, captured) (k v)
-  helper (avail, captured) (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
-    helper (avail, M.insert x new captured) (k j)
-  helper _state (Req (Fork _c) _k) = error "it happens!" -- ALAN
-  helper state (Req r k) = Req r (helper state . k)
-  helper state (Define e v k) = Define e v (helper state . k)
-  helper state (Yield st k) = Yield st (helper state . k)
+  helper :: VEnv -> Checking v -> Checking v
+  helper _ (Ret v) = Ret v
+  helper avail (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
+    (req $ AddCapture n (x,new)) >> helper avail (k j)
+  helper avail (Req (Fork c) k) = Req (Fork $ helper avail c) (helper avail . k)
+  helper avail (Req r k) = Req r (helper avail . k)
+  helper avail (Define e v k) = Define e v (helper avail . k)
+  helper avail (Yield st k) = Yield st (helper avail . k)
 
 wrapError :: (Error -> Error) -> Checking v -> Checking v
 wrapError _ (Ret v) = Ret v
diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 258464ae..98d70721 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -427,10 +427,10 @@ compileWithInputs parent name = gets compiled <&> M.lookup name >>= \case
             Nothing -> error "Callee has been erased"
 
     -- We need to figure out if this thunk contains a brat- or a kernel-computation
-    (Box venv src tgt) -> case outs of
+    (Box venv src tgt) -> assert (M.null venv) $ case outs of
       [(_, VFun Kerny cty)] -> default_edges . nodeId . fst <$>
-           compileKernBox parent name (assert (M.null venv) $ compileBox (src, tgt)) cty
-      [(_, VFun Braty cty)] -> compileBratBox parent name (venv, src, tgt) cty <&>
+           compileKernBox parent name (compileBox (src, tgt)) cty
+      [(_, VFun Braty cty)] -> gets capSets >>= \cs -> compileBratBox parent name (cs M.! name, src, tgt) cty <&>
           (\(partialNode, captures) -> Just (partialNode, 1, captures)) -- 1 is arbitrary, Box has no real inputs
       outs -> error $ "Unexpected outs of box: " ++ show outs
 

From c90845c614776b37db0578c954f03a4f430979ad Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 23 Aug 2024 15:29:42 +0100
Subject: [PATCH 043/182] And remove VEnv from Box

---
 brat/Brat/Checker/Helpers.hs | 4 ++--
 brat/Brat/Compile/Hugr.hs    | 6 +++---
 brat/Brat/Dot.hs             | 4 ++--
 brat/Brat/Graph.hs           | 4 +---
 4 files changed, 8 insertions(+), 10 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 21c78b8d..6fdcc38d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -300,12 +300,12 @@ makeBox name cty@(ss :->> ts) body = do
   (tgt, unders, _, _) <- anext (name ++ "/out") Target ctx ts R0
   case (?my, body) of
     (Kerny, _) -> do
-      (_,_,[thunk],_) <- next (name ++ "_thunk") (Box M.empty src tgt) (S0, Some (Zy :* S0))
+      (_,_,[thunk],_) <- next (name ++ "_thunk") (Box src tgt) (S0, Some (Zy :* S0))
                                 R0 (RPr ("thunk", VFun Kerny cty) R0)
       bres <- name -! body (overs, unders)
       pure (thunk, bres)
     (Braty, body) -> do
-      (node, [], [thunk], _) <- next (name ++ "_thunk") (Box M.empty src tgt) (S0, Some (Zy :* S0))
+      (node, [], [thunk], _) <- next (name ++ "_thunk") (Box src tgt) (S0, Some (Zy :* S0))
                                      R0 (RPr ("thunk", VFun ?my cty) R0)
       bres <- name -! (captureOuterLocals node $ body (overs, unders))
       pure (thunk, bres)
diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 98d70721..e1e392f2 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -299,7 +299,7 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
 
   didMatch :: [HugrType] -> NodeId -> [TypedPort] -> Compile [TypedPort]
   didMatch outTys parent ins = gets bratGraph >>= \(ns,_) -> case ns M.! rhs of
-    BratNode (Box _venv src tgt) _ _ -> do
+    BratNode (Box src tgt) _ _ -> do
       dfgId <- addNode "DidMatch_DFG" (OpDFG (DFG parent (FunctionType (snd <$> ins) outTys)))
       compileBox (src, tgt) dfgId
       for (zip (fst <$> ins) (Port dfgId <$> [0..])) addEdge
@@ -427,7 +427,7 @@ compileWithInputs parent name = gets compiled <&> M.lookup name >>= \case
             Nothing -> error "Callee has been erased"
 
     -- We need to figure out if this thunk contains a brat- or a kernel-computation
-    (Box venv src tgt) -> assert (M.null venv) $ case outs of
+    (Box src tgt) -> case outs of
       [(_, VFun Kerny cty)] -> default_edges . nodeId . fst <$>
            compileKernBox parent name (compileBox (src, tgt)) cty
       [(_, VFun Braty cty)] -> gets capSets >>= \cs -> compileBratBox parent name (cs M.! name, src, tgt) cty <&>
@@ -815,7 +815,7 @@ compileModule venv = do
     let srcPortTys = [(srcPort, ty) | (srcPort, ty, In tgt _) <- es, tgt == idNode ]
     case srcPortTys of
       -- All top-level functions are compiled into Box-es, which should look like this:
-      [(Ex input 0, _)] | Just (BratNode (Box _ src tgt) _ outs) <- M.lookup input ns ->
+      [(Ex input 0, _)] | Just (BratNode (Box src tgt) _ outs) <- M.lookup input ns ->
         case outs of
           [(_, VFun Braty cty)] -> do
             sig <- compileSig Braty cty
diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs
index 9acc9645..17aed1fc 100644
--- a/brat/Brat/Dot.hs
+++ b/brat/Brat/Dot.hs
@@ -50,7 +50,7 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert
   getRefEdge :: Name' -> Node -> [(Name', Name', EdgeType)]
   getRefEdge x (BratNode (Eval (Ex y _)) _ _) = [(Name' y, x, EvalEdge)]
   getRefEdge x (KernelNode (Splice (Ex y _)) _ _) = [(Name' y, x, EvalEdge)]
-  getRefEdge x (BratNode (Box _ src _) _ _) = [(x, Name' src, SrcEdge)]
+  getRefEdge x (BratNode (Box src _) _ _) = [(x, Name' src, SrcEdge)]
   getRefEdge _ _ = []
 
   -- Map all nodes in a box to the src node
@@ -59,7 +59,7 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert
    where
     (g, toNode, toVert) = toGraph (ns, ws)
     f (_, node) m = case node of
-      BratNode (Box _ src tgt) _ _ ->
+      BratNode (Box src tgt) _ _ ->
         -- Find all nodes in the box spanned by src and tgt, i.e. all nodes
         -- reachable from src that can reach tgt
         let srcReaches = reachable g (fromJust (toVert src))
diff --git a/brat/Brat/Graph.hs b/brat/Brat/Graph.hs
index 0d8d83cd..796c32c0 100644
--- a/brat/Brat/Graph.hs
+++ b/brat/Brat/Graph.hs
@@ -2,7 +2,6 @@
 
 module Brat.Graph where
 
-import Brat.Checker.Types (VEnv)
 import Brat.Naming
 import Brat.Syntax.Common
 import Brat.Syntax.Simple
@@ -35,8 +34,7 @@ data NodeType :: Mode -> Type where
   Const :: SimpleTerm -> NodeType a
   Eval  :: OutPort -> NodeType Brat   -- A computation on a wire
   Splice :: OutPort -> NodeType Kernel  -- A computation (classical) to add to this kernel
-  Box :: VEnv -- Parameters that are in scope
-      -> Name -- Source node
+  Box :: Name -- Source node
       -> Name -- Target node
       -> NodeType Brat -- Graph in a box
   Source :: NodeType a  -- For building..

From 115c0fa9196f3b4c6737530c4137d982707cfa3c Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 23 Aug 2024 17:22:05 +0100
Subject: [PATCH 044/182] wip debug

---
 brat/Brat/Checker.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 301a97a7..8863f224 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -461,8 +461,9 @@ check' (VHole (mnemonic, name)) connectors = do
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
   traceM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
-  req . Fork $ case (?my, ty) of
+  req . Fork $ trace "In forked computation for check' Con" $ case (?my, ty) of
       (Braty, Left k) -> do
+        traceM "Braty Left"
         (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
         ensureEmpty "kindCheck leftovers" leftOvers
       (Braty, Right ty) -> aux Braty clup ty
@@ -471,6 +472,7 @@ check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
  where
   aux :: Modey m -> (UserName -> UserName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
+    traceM $ "In forked aux for check' Con"
     VCon tycon tyargs <- eval S0 ty
     (CArgs pats nFree _ argTypeRo) <- lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths

From c24ca0d63e4995b26b181b57bae8b9e8e3851517 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 25 Sep 2024 11:49:28 +0100
Subject: [PATCH 045/182] new: Add `Lluf` operation to the BRAT hugr extension

---
 hugr_extension/src/defs.rs | 11 ++++++++++-
 hugr_extension/src/ops.rs  |  5 +++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/hugr_extension/src/defs.rs b/hugr_extension/src/defs.rs
index 2ff5c129..d19b0f6e 100644
--- a/hugr_extension/src/defs.rs
+++ b/hugr_extension/src/defs.rs
@@ -8,6 +8,7 @@ use hugr::{
         OpDef, SignatureError, SignatureFromArgs, SignatureFunc,
     },
     ops::OpName,
+    std_extensions::arithmetic::int_types::INT_TYPES,
     types::{type_param::TypeParam, FunctionType, PolyFuncType, Type, TypeArg, TypeBound},
 };
 
@@ -18,6 +19,10 @@ use strum::ParseError;
 
 use crate::ctor::Ctor;
 
+lazy_static! {
+    static ref U64: Type = INT_TYPES[6].clone();
+}
+
 /// Brat extension operation definitions.
 #[derive(Clone, Copy, Debug, Hash, Sequence, PartialEq, Eq)]
 #[allow(missing_docs)]
@@ -28,6 +33,7 @@ pub enum BratOpDef {
     Panic,
     Ctor(BratCtor),
     PrimCtorTest(BratCtor),
+    Lluf,
 }
 
 impl OpName for BratOpDef {
@@ -40,6 +46,7 @@ impl OpName for BratOpDef {
             Panic => "Panic".into(),
             Ctor(ctor) => format_smolstr!("Ctor::{}", ctor.name()),
             PrimCtorTest(ctor) => format_smolstr!("PrimCtorTest::{}", ctor.name()),
+            Lluf => "Lluf".into()
         }
     }
 }
@@ -56,6 +63,7 @@ impl FromStr for BratOpDef {
             ["Panic"] => Ok(BratOpDef::Panic),
             ["Ctor", ctor] => Ok(BratOpDef::Ctor(BratCtor::from_str(ctor)?)),
             ["PrimCtorTest", ctor] => Ok(BratOpDef::PrimCtorTest(BratCtor::from_str(ctor)?)),
+            ["Lluf"] => Ok(BratOpDef::Lluf),
             _ => Err(ParseError::VariantNotFound),
         }
     }
@@ -80,7 +88,8 @@ impl MakeOpDef for BratOpDef {
                 let output = Type::new_tuple_sum(vec![input.clone(), sig.body().input().clone()]);
                 PolyFuncType::new(sig.params(), FunctionType::new(input.clone(), vec![output]))
                     .into()
-            }
+            },
+            Lluf => FunctionType::new(vec![U64.clone()], vec![U64.clone()]).into()
         }
     }
 }
diff --git a/hugr_extension/src/ops.rs b/hugr_extension/src/ops.rs
index 835d3f49..4f64a076 100644
--- a/hugr_extension/src/ops.rs
+++ b/hugr_extension/src/ops.rs
@@ -37,6 +37,8 @@ pub enum BratOp {
         ctor: BratCtor,
         args: Vec<TypeArg>,
     },
+    // The inverse operation of "full" on Nats
+    Lluf,
 }
 
 impl OpName for BratOp {
@@ -49,6 +51,7 @@ impl OpName for BratOp {
             Panic { .. } => "Panic".into(),
             Ctor { ctor, .. } => format_smolstr!("Ctor::{}", ctor.name()),
             PrimCtorTest { ctor, .. } => format_smolstr!("PrimCtorTest::{}", ctor.name()),
+            Lluf => "Lluf".into(),
         }
     }
 }
@@ -104,6 +107,7 @@ impl MakeExtensionOp for BratOp {
                 ctor,
                 args: ext_op.args().to_vec(),
             }),
+            BratOpDef::Lluf => Ok(BratOp::Lluf),
         }
     }
 
@@ -141,6 +145,7 @@ impl MakeExtensionOp for BratOp {
             BratOp::Panic { sig } => vec![arg_from_row(sig.input()), arg_from_row(sig.output())],
             BratOp::Ctor { args, .. } => args.clone(),
             BratOp::PrimCtorTest { args, .. } => args.clone(),
+            BratOp::Lluf => vec![],
         }
     }
 }

From 672392cddc3f5088bcee0ca2ca59142837dd1ab9 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 25 Sep 2024 17:03:49 +0100
Subject: [PATCH 046/182] checkpoint b4 I break eerything

---
 brat/Brat/Checker/SolveHoles.hs    | 29 +++++++++----------
 brat/Brat/Checker/SolvePatterns.hs | 45 +++++++++++-------------------
 2 files changed, 31 insertions(+), 43 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 72a69b29..e0068009 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -157,6 +157,7 @@ buildNum :: Integer -> Checking Src
 buildNum n = buildConst (Num (fromIntegral n)) TNat
 
 
+-- Generate wiring to produce a dynamic instance of the numval argument
 buildNatVal :: NumVal (VVar Z) -> Checking Src
 buildNatVal nv@(NumValue n gro) = case n of
   0 -> buildGro gro
@@ -204,30 +205,30 @@ buildNatVal nv@(NumValue n gro) = case n of
     pure out
   buildMono _ = err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
 
-invertNatVal :: Src -> NumVal a -> Checking Src
-invertNatVal src (NumValue up gro) = case up of
-  0 -> invertGro src gro
+invertNatVal :: Tgt -> NumVal (VVar Z) -> Checking Tgt
+invertNatVal tgt (NumValue up gro) = case up of
+  0 -> invertGro tgt gro
   _ -> do
     ((lhs,rhs),out) <- buildArithOp Sub
     upSrc <- buildNum up
-    wire (src, TNat, lhs)
     wire (upSrc, TNat, rhs)
-    invertGro out gro
+    wire (out, TNat, tgt)
+    invertGro lhs gro
  where
   invertGro _ Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
-  invertGro src (StrictMonoFun sm) = invertSM src sm
+  invertGro tgt (StrictMonoFun sm) = invertSM tgt sm
 
-  invertSM src (StrictMono k mono) = case k of
-    0 -> invertMono src mono
+  invertSM tgt (StrictMono k mono) = case k of
+    0 -> invertMono tgt mono
     _ -> do
       divisor <- buildNum (2 ^ k)
       ((lhs,rhs),out) <- buildArithOp Div
-      wire (src, TNat, lhs)
+      wire (out, TNat, tgt)
       wire (divisor, TNat, rhs)
-      invertMono out mono
+      invertMono lhs mono
 
-  invertMono src (Linear _) = pure src
-  invertMono src (Full sm) = do
+  invertMono tgt (Linear (VPar (InEnd e))) = pure (NamedPort e "numval")
+  invertMono tgt (Full sm) = do
     (_, [(llufTgt,_)], [(llufSrc,_)], _) <- next "luff" (Prim ("BRAT","lluf")) (S0, Some (Zy :* S0)) (REx ("n", Nat) R0) (REx ("n", Nat) R0)
-    wire (src, TNat, llufTgt)
-    invertSM llufSrc sm
+    wire (llufSrc, TNat, tgt)
+    invertSM llufTgt sm
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index b3117684..f796c12a 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -201,7 +201,7 @@ instantiateMeta e val = do
   throwLeft (doesntOccur e val)
   Define e val (const (Ret ()))
 
--- solve a Nat kinded metavariable. Unline `instantiateMeta`, this function also
+-- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
 -- makes the dynamic wiring for a metavariable. This only needs to happen for
 -- numbers because they have nontrivial runtime behaviour.
 --
@@ -211,14 +211,15 @@ solveNumMeta e nv = case (e, vars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd tgt)]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by invering nv
-   tgtSrc <- invertNatVal (NamedPort src "") nv
+   tgtSrc <- invertNatVal nv
    -- If `nv` is *just* a variable, invertNatVal will return `src`. We need to
    -- catch this because defining x := x will cause eval to loop.
-   unless (ExEnd src == toEnd tgtSrc) (defineSrc src (VNum (const (VPar (ExEnd tgtSrc)) <$> nv)))
-   defineTgt (InEnd tgt) (VNum (nVar tgtSrc))
+   unless (ExEnd src == toEnd tgtSrc) $
+     (defineSrc (NamedPort src "") (VNum (const (VPar (ExEnd tgtSrc)) <$> nv)))
+   defineTgt (NamedPort tgt "") (VNum (nVar tgtSrc))
    wire (tgtSrc, TNat, NamedPort tgt "")
 
- (ExEnd src, _) -> defineSrc src nv
+ (ExEnd src, _) -> defineSrc (NamedPort src "") nv
 
  -- Both targets, we need to create the thing that they both derive from
  (InEnd tgt1, [VPar (InEnd tgt2)]) -> do
@@ -229,13 +230,13 @@ solveNumMeta e nv = case (e, vars nv) of
    wire (idSrc, TNat, NamedPort tgt2 "")
    let nv' = fmap (const (VPar (toEnd idSrc))) nv
    src1 <- buildNatVal nv'
-   defineTgt tgt1 (VNum nv')
+   defineTgt (NamedPort tgt1 "") (VNum nv')
    wire (src1, TNat, NamedPort tgt1 "")
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
    src <- buildNatVal nv
-   defineTgt tgt nv
+   defineTgt (NamedPort tgt "") nv
    wire (src, TNat, NamedPort tgt "")
 
  where
@@ -290,11 +291,8 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
 
   demandSucc sm@(StrictMono k (Linear (VPar (InEnd x)))) = do
-    one <- buildNum 1
-    ((lhs,rhs),out) <- buildArithOp Add
-    wire (one, TNat, rhs)
-    wire (out, TNat, NamedPort x "")
-    let y = nVar (VPar (toEnd lhs))
+    yTgt <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
+    let y = nVar (VPar (toEnd yTgt))
     solveNumMeta (InEnd x) (nPlus 1 y)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
 
@@ -320,12 +318,9 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd half))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
       Linear (VPar (InEnd tgt)) -> do
-        twoSrc <- buildNum 2
-        ((halfTgt,twoTgt),outSrc) <- buildArithOp Mul
-        wire (twoSrc, TNat, twoTgt)
-        wire (outSrc, TNat, NamedPort tgt "")
+        halfTgt <- buildNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear tgt))))
         let half = nVar (VPar (toEnd halfTgt))
-        solveNumMeta (InEnd tgt) (n2PowTimes 1 (nVar (VPar (toEnd halfTgt))))
+        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
@@ -339,18 +334,10 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
         solveNumMeta (ExEnd out) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
         pure (nVar (VPar (toEnd halfSrc)))
       Linear (VPar (InEnd tgt)) -> do
-        twoSrc <- buildNum 2
-        ((flooredHalfTgt, twoTgt), doubleSrc) <- buildArithOp Mul
-        wire (twoSrc, TNat, twoTgt)
-
-        oneSrc <- buildNum 1
-        ((doubleTgt, oneTgt), addOut) <- buildArithOp Add
-        wire (oneSrc, TNat, oneTgt)
-        wire (doubleSrc, TNat, doubleTgt)
-        wire (addOut, TNat, NamedPort tgt "")
-
-        solveNumMeta (InEnd tgt) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd flooredHalfTgt)))))
-        pure (nVar (VPar (toEnd flooredHalfTgt)))
+        flooredHalfTgt <- buildNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd tgt))))))
+        let flooredHalf = nVar (VPar (toEnd flooredHalfTgt))
+        solveNumMeta (InEnd tgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
+        pure flooredHalf
 
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half

From 9f3faa8d1af71e4ea4025f2f4d91c396af930693 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 23 Aug 2024 17:47:57 +0100
Subject: [PATCH 047/182] A couple of unit tests with Fork/Define/Yield (add
 assertCheckingFail)

---
 brat/test/Main.hs      | 48 +++++++++++++++++++++++++++++++++++++++++-
 brat/test/Test/Util.hs |  7 ++++++
 2 files changed, 54 insertions(+), 1 deletion(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 29d3f78b..aeebbda4 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -15,12 +15,57 @@ import Test.Substitution
 import Test.Syntax.Let
 import Test.TypeArith
 
+import Brat.Checker.Monad
+import Brat.Syntax.Common
+import Brat.Syntax.Port
+import Brat.Syntax.Value
+import Brat.UserName
+import Brat.Error
+import Control.Monad.Freer
+import qualified Data.Set as S
+import Debug.Trace
+import Test.Util
+import Test.Tasty.HUnit (testCase)
+
+coroT1 :: Checking ()
+coroT1 = do
+  name <- req (Fresh "anything")
+  let e = InEnd $ In name 0
+  req $ Declare e Braty (Left $ Star [])
+  req . Fork $ do
+    req (ELup e) >>= \case
+      Just _ -> err $ InternalError "already defined"
+      Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+  Yield (AwaitingAny $ S.singleton e) $ \_ -> do
+    traceM "Yield continued"
+    v <- req $ ELup e
+    case v of
+      Just _ -> pure ()
+      Nothing -> err $ InternalError "not defined"
+
+coroT2 :: Checking ()
+coroT2 = do
+  name <- req (Fresh "anything")
+  let e = InEnd $ In name 0
+  req $ Declare e Braty (Left $ Star [])
+  v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
+  -- No way to execute this without a 'v'
+  req . Fork $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+  err $ InternalError $ case v of
+    Nothing -> "ELup performed without waiting for Yield" -- true in next case too
+    Just _ -> "ELup returned value before being Defined"
+
+
 main = do
   failureTests  <- getFailureTests
   checkingTests <- getCheckingTests
   parsingTests <- getParsingTests
   compilationTests <- setupCompilationTests
   graphTests <- getGraphTests
+  let coroTests = testGroup "coroutine"
+       [testCase "coroT1" $ assertChecking coroT1
+       ,testCase "coroT2" $ assertCheckingFail "Typechecking blocked on" coroT2
+       ]
   defaultMain $ testGroup "All" [graphTests
                                 ,failureTests
                                 ,checkingTests
@@ -34,4 +79,5 @@ main = do
                                 ,abstractorTests
                                 ,compilationTests
                                 ,typeArithTests
-                                ]
+                                ,coroTests
+                                ]
\ No newline at end of file
diff --git a/brat/test/Test/Util.hs b/brat/test/Test/Util.hs
index a83df95f..8773e549 100644
--- a/brat/test/Test/Util.hs
+++ b/brat/test/Test/Util.hs
@@ -15,6 +15,7 @@ import Bwd
 import Control.Monad.Except
 import Test.Tasty
 import Test.Tasty.HUnit
+import Data.List (isInfixOf)
 
 runEmpty m = run emptyEnv initStore root m
 
@@ -23,6 +24,12 @@ assertChecking m = case runEmpty $ localFC (FC (Pos 0 0) (Pos 0 0)) m of
   Right _ -> pure ()
   Left err -> assertFailure (showError err)
 
+assertCheckingFail :: Show a => String -> Checking a -> Assertion
+assertCheckingFail needle m = case runEmpty $ localFC (FC (Pos 0 0) (Pos 0 0)) m of
+  Right res -> assertFailure ("Computation produced result " ++ show res ++ " when should have Thrown")
+  Left err -> let shown = showError err in
+    if isInfixOf needle shown then pure () else assertFailure ("Unexpected error " ++ shown)
+
 parseAndCheck :: [FilePath] -> FilePath -> TestTree
 parseAndCheck libDirs file = testCase (show file) $ do
   env <- runExceptT $ loadFilename root libDirs file

From e694a8de131624d8c40c5387f1594d184e6cc55d Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 18:11:46 +0100
Subject: [PATCH 048/182] Reduce change, revert checkInputs/Outputs back to
 Checking, also checkClauses

---
 brat/Brat/Checker.hs | 131 +++++++++++++++++++------------------------
 1 file changed, 58 insertions(+), 73 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 8863f224..c163992f 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -131,15 +131,12 @@ checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
             => WC (Term d KVerb)
             -> [(Src, BinderType m)] -- Expected
             -> [(Tgt, BinderType m)] -- Actual
-            -> Either ErrorMsg ([(Src, BinderType m)], Checking ())
-checkInputs _ overs [] = pure (overs, pure ())
-checkInputs tm@(WC fc _) (o:overs) (u:unders) = do
-  (overs', p) <- checkInputs tm overs unders
-  pure (overs', thisWire *> p)
+            -> Checking [(Src, BinderType m)]
+checkInputs _ overs [] = pure overs
+checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do
+  req . Fork $ wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
+  checkInputs tm overs unders
  where
-  thisWire = localFC fc $
-    wrapError (addRowContext ?my (o:overs) (u:unders)) $
-      checkWire ?my tm False o u
   addRowContext :: Show (BinderType m)
               => Modey m
               -> [(Src, BinderType m)] -- Expected
@@ -148,22 +145,18 @@ checkInputs tm@(WC fc _) (o:overs) (u:unders) = do
   addRowContext _ as bs (Err fc (TypeMismatch tm _ _))
    = Err fc $ TypeMismatch tm (showRow as) (showRow bs)
   addRowContext _ _ _ e = e
-checkInputs tm [] unders = Left $ TypeErr $ "No overs but unders: " ++ show unders ++ " for " ++ show tm
+checkInputs tm [] unders = typeErr $ "No overs but unders: " ++ show unders ++ " for " ++ show tm
 
--- TODO refactor more? combine checkInputs; find prefix first and then `zip`
 checkOutputs :: (CheckConstraints m k, ?my :: Modey m)
              => WC (Term Syn k)
              -> [(Tgt, BinderType m)] -- Expected
              -> [(Src, BinderType m)] -- Actual
-             -> Either ErrorMsg ([(Tgt, BinderType m)], Checking ())
-checkOutputs _ unders [] = pure (unders, pure ())
-checkOutputs tm@(WC fc _) (u:unders) (o:overs) = do
-  (unders', p) <- checkOutputs tm unders overs
-  pure (unders', thisWire *> p)
+             -> Checking [(Tgt, BinderType m)]
+checkOutputs _ unders [] = pure unders
+checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do
+  req . Fork $ wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
+  checkOutputs tm unders overs
  where
-  thisWire = localFC fc $
-              wrapError (addRowContext ?my (u:unders) (o:overs)) $
-              checkWire ?my tm True o u
   addRowContext :: Show (BinderType m)
               => Modey m
               -> [(Tgt, BinderType m)] -- Expected
@@ -172,7 +165,7 @@ checkOutputs tm@(WC fc _) (u:unders) (o:overs) = do
   addRowContext _ as bs (Err fc (TypeMismatch tm _ _))
    = Err fc $ TypeMismatch tm (showRow as) (showRow bs)
   addRowContext _ _ _ e = e
-checkOutputs tm [] overs = Left $ TypeErr $ "No unders but overs: " ++ show overs ++ " for " ++ show tm
+checkOutputs tm [] overs = typeErr $ "No unders but overs: " ++ show overs ++ " for " ++ show tm
 
 check :: (CheckConstraints m k
          ,EvMode m
@@ -182,8 +175,7 @@ check :: (CheckConstraints m k
       => WC (Term d k)
       -> ChkConnectors m d k
       -> Checking (SynConnectors m d k
-                  ,ChkConnectors m d k
-                  )
+                  ,ChkConnectors m d k)
 check (WC fc tm) conn = trace ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
 
 check' :: forall m d k
@@ -195,8 +187,7 @@ check' :: forall m d k
        => Term d k
        -> ChkConnectors m d k
        -> Checking (SynConnectors m d k
-                   ,ChkConnectors m d k -- rightovers
-                   )
+                   ,ChkConnectors m d k) -- rightovers
 check' Empty tys = pure (((), ()), tys)
 check' (s :|: t) tys = do
   -- in Checking mode, each LHS/RHS removes its wires+types from the ChkConnectors remaining
@@ -243,9 +234,9 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
       req . Fork $ do
             sig <- mkSig usedOvers usedUnders
-            (patOuts, rest) <- checkClauses sig usedOvers (c :| cs)
+            patOuts <- checkClauses sig usedOvers (c :| cs)
             mkWires patOuts usedUnders
-            rest
+            pure ()
       pure (((), ()), (rightOvers, rightUnders))
     Syny -> do
       synthOuts <- suppressHoles $ suppressGraph $ do
@@ -256,9 +247,8 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
         (((), synthOuts), ((), ())) <- localEnv env $ check body ((), ())
         pure synthOuts
       sig <- mkSig usedOvers synthOuts
-      (patOuts, clauseProbs) <- checkClauses sig usedOvers
+      patOuts <- checkClauses sig usedOvers
           ((fst c, WC (fcOf body) (Emb body)) :| cs)
-      req $ Fork clauseProbs -- TODO don't return clauseProbs from checkClauses
       pure (((), patOuts), (rightOvers, ()))
  where
   -- Invariant: When solToEnv is called, port pulling has already been resolved,
@@ -284,20 +274,20 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
     Nothing -> err $ InternalError "Trying to wire up different sized lists of wires"
     Just conns -> traverse (\((src, ty), (tgt, _)) -> wire (src, binderToValue ?my ty, tgt)) conns
 
-  checkClauses :: CTy m Z -> [(Src, BinderType m)] -> NonEmpty (WC Abstractor, WC (Term Chk Noun)) -> Checking ([(Src, BinderType m)], Checking ())
+  checkClauses :: CTy m Z -> [(Src, BinderType m)] -> NonEmpty (WC Abstractor, WC (Term Chk Noun)) -> Checking [(Src, BinderType m)]
   checkClauses cty@(ins :->> outs) overs all_cs = do
     (node, patMatchUnders, patMatchOvers, _) <- suppressGraph $
         anext "lambda" Hypo (S0, Some (Zy :* S0)) ins outs
-    let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
+    req . Fork $ do
+      let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
                   \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
-    let clauseProblems = do
-          clauses <- traverse (checkClause ?my "lambda" cty) clauses
-          let inputs  = [ (portName p, biType @m ty) | (p, ty) <- patMatchUnders ]
-          let outputs = [ (portName p, biType @m ty) | (p, ty) <- patMatchOvers  ]
-          req $ AddNode node (mkNode ?my (PatternMatch clauses) inputs outputs) -- not added by anext because suppressGraph
-          mkWires overs patMatchUnders -- might canonicalize type better now
-          pure ()
-    pure (patMatchOvers, clauseProblems)
+      clauses <- traverse (checkClause ?my "lambda" cty) clauses
+      let inputs  = [ (portName p, biType @m ty) | (p, ty) <- patMatchUnders ]
+      let outputs = [ (portName p, biType @m ty) | (p, ty) <- patMatchOvers  ]
+      req $ AddNode node (mkNode ?my (PatternMatch clauses) inputs outputs) -- not added by anext because suppressGraph
+      mkWires overs patMatchUnders -- might canonicalize type better now
+      pure ()
+    pure patMatchOvers
 
 check' (Pull ports t) (overs, unders) = do
   unders <- pullPortsRow ports unders
@@ -310,8 +300,7 @@ check' (t ::: outs) (overs, ()) | Braty <- ?my = do
   pure (((), danglies), (leftOvers, ()))
 check' (Emb t) (overs, unders) = do
   ((ins, outs), (overs, ())) <- check t (overs, ())
-  (unders, p') <- throwLeft $ checkOutputs t unders outs
-  req $ Fork p'
+  unders <- checkOutputs t unders outs
   pure ((ins, ()), (overs, unders))
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
   (Braty, ty) -> do
@@ -357,20 +346,15 @@ check' (TypedTh t) ((), ()) = case ?my of
   createThunk :: (CheckConstraints m2 Noun, ?my :: Modey m2, EvMode m2)
               => SynConnectors m2 Syn KVerb
               -> Checking (SynConnectors Brat Syn Noun
-                          ,ChkConnectors Brat Syn Noun
-                          )
+                          ,ChkConnectors Brat Syn Noun)
   createThunk (ins, outs) = do
     Some (ez :* inR) <- mkArgRo ?my S0 (first (fmap toEnd) <$> ins)
     Some (_ :* outR) <- mkArgRo ?my ez (first (fmap toEnd) <$> outs)
-    (thunkOut, p) <- makeBox "thunk" (inR :->> outR) $
+    (thunkOut, ()) <- makeBox "thunk" (inR :->> outR) $
         \(thOvers, thUnders) -> do
           -- if these ensureEmpty's fail then its a bug!
-          (rightUnders, ip) <- throwLeft $ checkInputs t thOvers ins
-          ensureEmpty "TypedTh inputs" rightUnders
-          (leftOvers, op) <- throwLeft $ checkOutputs t thUnders outs
-          ensureEmpty "TypedTh outputs" leftOvers
-          pure (ip *> op)
-    req $ Fork p
+          checkInputs t thOvers ins >>= ensureEmpty "TypedTh inputs"
+          checkOutputs t thUnders outs >>= ensureEmpty "TypedTh outputs"
     pure (((), [thunkOut]), ((), ()))
 check' (Force th) ((), ()) = do
   (((), outs), ((), ())) <- let ?my = Braty in check th ((), ())
@@ -379,8 +363,7 @@ check' (Force th) ((), ()) = do
   pure ((thInputs, thOutputs), ((), ()))
 check' (Forget kv) (overs, unders) = do
   ((ins, outs), ((), rightUnders)) <- check kv ((), unders)
-  (leftOvers, p) <- throwLeft $ checkInputs kv overs ins
-  req $ Fork p
+  leftOvers <- checkInputs kv overs ins
   pure (((), outs), (leftOvers, rightUnders))
 check' (Var x) ((), ()) = (, ((), ())) . ((),) <$> case ?my of
   Braty -> vlup x
@@ -493,39 +476,41 @@ check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
     wire (dangling, ty, hungry)
 
 check' (C cty) ((), ((hungry, ty):unders)) = case (?my, ty) of
-  (Braty, Left k) ->  do
-      req $ Fork (kindCheck [(hungry, k)] (C cty) >>= (ensureEmpty "kindCheck leftovers") . snd)
-      pure (((), ()), ((), unders))
+  (Braty, Left k) -> do
+    (_, leftOvers) <- kindCheck [(hungry, k)] (C cty)
+    ensureEmpty "kindCheck leftovers" leftOvers
+    pure (((), ()), ((), unders))
   _ -> typeErr $ "Ill-kinded function type: " ++ show cty
 check' (Simple tm) ((), ((hungry, ty):unders)) = do
-  req . Fork $ do
-    ty <- evalBinder ?my ty
-    case (?my, ty, tm) of
-      -- The only SimpleType that checks against a kind is a Nat
-      (Braty, Left Nat, Num n) -> do
-        (_, _, [(dangling, _)], _) <- next "" (Const (Num n)) (S0,Some (Zy :* S0))
-                                      R0 (REx ("value", Nat) R0)
-        let val = VNum (nConstant (fromIntegral n))
-        defineSrc dangling val
-        defineTgt hungry val
-        wire (dangling, kindType Nat, hungry)
-      -- No defining needed, so everything else can be unified
-      _ -> do
-        let vty = biType @m ty
-        throwLeft $ simpleCheck ?my vty tm
-        (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
-                                      R0 (RPr ("value", vty) R0)
-        wire (dangling, vty, hungry)
-  pure (((), ()), ((), unders))
+  ty <- evalBinder ?my ty
+  case (?my, ty, tm) of
+    -- The only SimpleType that checks against a kind is a Nat
+    (Braty, Left Nat, Num n) -> do
+      (_, _, [(dangling, _)], _) <- next "" (Const (Num n)) (S0,Some (Zy :* S0))
+                                    R0 (REx ("value", Nat) R0)
+      let val = VNum (nConstant (fromIntegral n))
+      defineSrc dangling val
+      defineTgt hungry val
+      wire (dangling, kindType Nat, hungry)
+      pure (((), ()), ((), unders))
+    -- No defining needed, so everything else can be unified
+    _ -> do
+      let vty = biType @m ty
+      throwLeft $ simpleCheck ?my vty tm
+      (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
+                                     R0 (RPr ("value", vty) R0)
+      wire (dangling, vty, hungry)
+      pure (((), ()), ((), unders))
 check' Hope ((), ((tgt, ty):unders)) = case (?my, ty) of
   (Braty, Left _k) -> do
     fc <- req AskFC
-    req (ANewHope (toEnd tgt, fc)) -- could probably delay via *>
+    req (ANewHope (toEnd tgt, fc))
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
 check' tm _ = error $ "check' " ++ show tm
 
+
 -- Clauses from either function definitions or case statements, as we get
 -- them from the elaborator
 data Clause = Clause

From 2b7354361b3092b964d4f239a1609c98a4abf509 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 16:17:37 +0100
Subject: [PATCH 049/182] Add string description to Fork

---
 brat/Brat/Checker.hs       | 20 +++++++++-----------
 brat/Brat/Checker/Monad.hs | 22 +++++++++++-----------
 brat/test/Main.hs          |  4 ++--
 3 files changed, 22 insertions(+), 24 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index c163992f..87bc6428 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -134,7 +134,7 @@ checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
             -> Checking [(Src, BinderType m)]
 checkInputs _ overs [] = pure overs
 checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do
-  req . Fork $ wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
+  req . Fork "checkInput" $ wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
   checkInputs tm overs unders
  where
   addRowContext :: Show (BinderType m)
@@ -154,7 +154,7 @@ checkOutputs :: (CheckConstraints m k, ?my :: Modey m)
              -> Checking [(Tgt, BinderType m)]
 checkOutputs _ unders [] = pure unders
 checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do
-  req . Fork $ wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
+  req . Fork "checkOutput" $ wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
   checkOutputs tm unders overs
  where
   addRowContext :: Show (BinderType m)
@@ -232,7 +232,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
       let usedUnders = [ fromJust (lookup tgt tgtMap) | tgt <- usedFakeUnders ]
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
-      req . Fork $ do
+      req . Fork "LambdaChk" $ do
             sig <- mkSig usedOvers usedUnders
             patOuts <- checkClauses sig usedOvers (c :| cs)
             mkWires patOuts usedUnders
@@ -278,7 +278,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
   checkClauses cty@(ins :->> outs) overs all_cs = do
     (node, patMatchUnders, patMatchOvers, _) <- suppressGraph $
         anext "lambda" Hypo (S0, Some (Zy :* S0)) ins outs
-    req . Fork $ do
+    req . Fork "checkClauses" $ do
       let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
                   \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
       clauses <- traverse (checkClause ?my "lambda" cty) clauses
@@ -304,7 +304,7 @@ check' (Emb t) (overs, unders) = do
   pure ((ins, ()), (overs, unders))
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
   (Braty, ty) -> do
-    req . Fork $ evalBinder Braty ty >>= \case
+    req . Fork "check'Th" $ evalBinder Braty ty >>= \case
           -- the case split here is so we can be sure we have the necessary CheckConstraints
           Right ty@(VFun Braty cty) -> checkThunk Braty "thunk" cty tm >>= wire . (,ty, hungry)
           Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
@@ -444,20 +444,18 @@ check' (VHole (mnemonic, name)) connectors = do
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
   traceM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
-  req . Fork $ trace "In forked computation for check' Con" $ case (?my, ty) of
+  req . Fork "check'Con" $ case (?my, ty) of
       (Braty, Left k) -> do
-        traceM "Braty Left"
         (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
         ensureEmpty "kindCheck leftovers" leftOvers
       (Braty, Right ty) -> aux Braty clup ty
-      (Kerny, _) -> aux Kerny kclup ty
+      (Kerny, _) -> trace "Kerny" $ aux Kerny kclup ty
   pure (((), ()), ((), unders))
  where
   aux :: Modey m -> (UserName -> UserName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
-    traceM $ "In forked aux for check' Con"
-    VCon tycon tyargs <- eval S0 ty
-    (CArgs pats nFree _ argTypeRo) <- lup vcon tycon
+    VCon tycon tyargs <- trace "In forked aux for check' Con" $ eval S0 ty
+    (CArgs pats nFree _ argTypeRo) <- trace "forked aux doing lup" $ lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths
     wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
     Some (ny :* env) <- throwLeft $ valMatches tyargs pats
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 12428f85..c65b1214 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -20,7 +20,7 @@ import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Data.Set as S
 
--- import Debug.Trace
+import Debug.Trace
 
 trackM :: Monad m => String -> m ()
 trackM = const (pure ())
@@ -100,7 +100,7 @@ data CheckingSig ty where
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
   ANewHope :: (End, FC) -> CheckingSig ()
   AskHopeSet :: CheckingSig HopeSet
-  Fork :: Checking () -> CheckingSig ()
+  Fork :: String -> Checking () -> CheckingSig ()
   AddCapture :: Name -> (UserName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
@@ -108,7 +108,7 @@ localAlias _ (Ret v) = Ret v
 localAlias con@(name, alias) (Req (ALup u) k)
   | u == name = localAlias con $ k (Just alias)
 localAlias con (Req (InLvl str c) k) = Req (InLvl str (localAlias con c)) (localAlias con . k)
-localAlias con (Req (Fork c) k) = Req (Fork $ localAlias con c) (localAlias con . k)
+localAlias con (Req (Fork d c) k) = Req (Fork d $ localAlias con c) (localAlias con . k)
 localAlias con (Req r k) = Req r (localAlias con . k)
 localAlias con (Define v e k) = Define v e (localAlias con . k)
 localAlias con (Yield st k) = Yield st (localAlias con . k)
@@ -118,7 +118,7 @@ localFC _ (Ret v) = Ret v
 localFC f (Req AskFC k) = localFC f (k f)
 localFC f (Req (Throw (e@Err{fc=Nothing})) k) = localFC f (Req (Throw (e{fc=Just f})) k)
 localFC f (Req (InLvl str c) k) = Req (InLvl str (localFC f c)) (localFC f . k)
-localFC f (Req (Fork c) k) = Req (Fork $ localFC f c) (localFC f . k)
+localFC f (Req (Fork d c) k) = Req (Fork d $ localFC f c) (localFC f . k)
 localFC f (Req r k) = Req r (localFC f . k)
 localFC f (Define v e k) = Define v e (localFC f . k)
 localFC f (Yield st k) = Yield st (localFC f . k)
@@ -136,7 +136,7 @@ localVEnv ext (Req AskVEnv k) = do env <- req AskVEnv
                                    -- ext shadows local vars
                                    localVEnv ext (k (env { locals = M.union ext (locals env) }))
 localVEnv ext (Req (InLvl str c) k) = Req (InLvl str (localVEnv ext c)) (localVEnv ext . k)
-localVEnv ext (Req (Fork c) k) = Req (Fork $ localVEnv ext c) (localVEnv ext . k)
+localVEnv ext (Req (Fork d c) k) = Req (Fork d $ localVEnv ext c) (localVEnv ext . k)
 localVEnv ext (Req r k) = Req r (localVEnv ext . k)
 localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
 localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
@@ -152,7 +152,7 @@ captureOuterLocals n c = do
   helper _ (Ret v) = Ret v
   helper avail (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
     (req $ AddCapture n (x,new)) >> helper avail (k j)
-  helper avail (Req (Fork c) k) = Req (Fork $ helper avail c) (helper avail . k)
+  helper avail (Req (Fork d c) k) = Req (Fork d $ helper avail c) (helper avail . k)
   helper avail (Req r k) = Req r (helper avail . k)
   helper avail (Define e v k) = Define e v (helper avail . k)
   helper avail (Yield st k) = Yield st (helper avail . k)
@@ -161,7 +161,7 @@ wrapError :: (Error -> Error) -> Checking v -> Checking v
 wrapError _ (Ret v) = Ret v
 wrapError f (Req (Throw e) k) = Req (Throw (f e)) k
 wrapError f (Req (InLvl str c) k) = Req (InLvl str (wrapError f c)) (wrapError f . k)
-wrapError f (Req (Fork c) k) = Req (Fork $ wrapError f c) (wrapError f . k)
+wrapError f (Req (Fork d c) k) = Req (Fork d $ wrapError f c) (wrapError f . k)
 wrapError f (Req r k) = Req r (wrapError f . k)
 wrapError f (Define v e k) = Define v e (wrapError f . k)
 wrapError f (Yield st k) = Yield st (wrapError f . k)
@@ -225,7 +225,7 @@ localKVar env (Req KDone k) = case [ x | (x,(One,_)) <- M.assocs env ] of
                                               ,intercalate ", " (fmap show xs)
                                               ,"haven't been used"
                                               ]
-localKVar env (Req (Fork c) k) = Req (Fork $ localKVar env c) (localKVar env . k)
+localKVar env (Req (Fork d c) k) = Req (Fork d $ localKVar env c) (localKVar env . k)
 localKVar env (Req r k) = Req r (localKVar env . k)
 localKVar env (Define e v k) = Define e v (localKVar env . k)
 localKVar env (Yield st k) = Yield st (localKVar env . k)
@@ -300,7 +300,7 @@ handler (Req s k) ctx g ns
 
       ANewHope (e, fc) -> handler (k ()) (ctx { hopeSet = M.insert e fc (hopeSet ctx) }) g ns
       AskHopeSet -> handler (k (hopeSet ctx)) ctx g ns
-      Fork c -> handler (k () <* c) ctx g ns
+      Fork desc c -> handler (trace ("Forking " ++ desc) $ k () <* c) ctx g ns
       AddCapture n (var, ends) ->
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g ns
 
@@ -368,7 +368,7 @@ instance MonadFail Checking where
 suppressHoles :: Checking a -> Checking a
 suppressHoles (Ret x) = Ret x
 suppressHoles (Req (LogHole _) k) = suppressHoles (k ())
-suppressHoles (Req (Fork c) k) = Req (Fork $ suppressHoles c) (suppressHoles . k)
+suppressHoles (Req (Fork d c) k) = Req (Fork d $ suppressHoles c) (suppressHoles . k)
 suppressHoles (Req c k) = Req c (suppressHoles . k)
 suppressHoles (Define v e k) = Define v e (suppressHoles . k)
 suppressHoles (Yield st k) = Yield st (suppressHoles . k)
@@ -378,7 +378,7 @@ suppressGraph :: Checking a -> Checking a
 suppressGraph (Ret x) = Ret x
 suppressGraph (Req (AddNode _ _) k) = suppressGraph (k ())
 suppressGraph (Req (Wire _) k) = suppressGraph (k ())
-suppressGraph (Req (Fork c) k) = Req (Fork $ suppressGraph c) (suppressGraph . k)
+suppressGraph (Req (Fork d c) k) = Req (Fork d $ suppressGraph c) (suppressGraph . k)
 suppressGraph (Req c k) = Req c (suppressGraph . k)
 suppressGraph (Define v e k) = Define v e (suppressGraph . k)
 suppressGraph (Yield st k) = Yield st (suppressGraph . k)
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index aeebbda4..60c104a3 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -32,7 +32,7 @@ coroT1 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
   req $ Declare e Braty (Left $ Star [])
-  req . Fork $ do
+  req . Fork "t1" $ do
     req (ELup e) >>= \case
       Just _ -> err $ InternalError "already defined"
       Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
@@ -50,7 +50,7 @@ coroT2 = do
   req $ Declare e Braty (Left $ Star [])
   v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
   -- No way to execute this without a 'v'
-  req . Fork $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+  req . Fork "t2" $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
   err $ InternalError $ case v of
     Nothing -> "ELup performed without waiting for Yield" -- true in next case too
     Just _ -> "ELup returned value before being Defined"

From 251455ba383a5a433eaee494fd9cbdd5504d0809 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 13 Sep 2024 19:31:49 +0100
Subject: [PATCH 050/182] TEMP remove failure tests

---
 brat/test/Main.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 60c104a3..f2d8ff27 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -57,7 +57,7 @@ coroT2 = do
 
 
 main = do
-  failureTests  <- getFailureTests
+  --failureTests  <- getFailureTests
   checkingTests <- getCheckingTests
   parsingTests <- getParsingTests
   compilationTests <- setupCompilationTests
@@ -67,7 +67,7 @@ main = do
        ,testCase "coroT2" $ assertCheckingFail "Typechecking blocked on" coroT2
        ]
   defaultMain $ testGroup "All" [graphTests
-                                ,failureTests
+                                --,failureTests
                                 ,checkingTests
                                 ,letTests
                                 ,libDirTests

From 47f4c31a9ace21b1b41a0a4640dcfebcf81ad782 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 16:19:38 +0100
Subject: [PATCH 051/182] Fork outside Req, with both child computations (44
 fails)

---
 brat/Brat/Checker.hs        | 12 ++++++------
 brat/Brat/Checker/Monad.hs  | 29 ++++++++++++++++++-----------
 brat/Control/Monad/Freer.hs |  8 ++++++++
 brat/test/Main.hs           | 22 +++++++++++-----------
 4 files changed, 43 insertions(+), 28 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 87bc6428..a726c783 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -134,7 +134,7 @@ checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m)
             -> Checking [(Src, BinderType m)]
 checkInputs _ overs [] = pure overs
 checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do
-  req . Fork "checkInput" $ wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
+  mkFork "checkInput" $ wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u
   checkInputs tm overs unders
  where
   addRowContext :: Show (BinderType m)
@@ -154,7 +154,7 @@ checkOutputs :: (CheckConstraints m k, ?my :: Modey m)
              -> Checking [(Tgt, BinderType m)]
 checkOutputs _ unders [] = pure unders
 checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do
-  req . Fork "checkOutput" $ wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
+  mkFork "checkOutput" $ wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u
   checkOutputs tm unders overs
  where
   addRowContext :: Show (BinderType m)
@@ -232,7 +232,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
       let usedUnders = [ fromJust (lookup tgt tgtMap) | tgt <- usedFakeUnders ]
       let rightUnders = [ fromJust (lookup tgt tgtMap) | (tgt, _) <- rightFakeUnders ]
-      req . Fork "LambdaChk" $ do
+      mkFork "LambdaChk" $ do
             sig <- mkSig usedOvers usedUnders
             patOuts <- checkClauses sig usedOvers (c :| cs)
             mkWires patOuts usedUnders
@@ -278,7 +278,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
   checkClauses cty@(ins :->> outs) overs all_cs = do
     (node, patMatchUnders, patMatchOvers, _) <- suppressGraph $
         anext "lambda" Hypo (S0, Some (Zy :* S0)) ins outs
-    req . Fork "checkClauses" $ do
+    mkFork "checkClauses" $ do
       let clauses = NE.zip (NE.fromList [0..]) all_cs <&>
                   \(i, (abs, tm)) -> Clause i (normaliseAbstractor <$> abs) tm
       clauses <- traverse (checkClause ?my "lambda" cty) clauses
@@ -304,7 +304,7 @@ check' (Emb t) (overs, unders) = do
   pure ((ins, ()), (overs, unders))
 check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
   (Braty, ty) -> do
-    req . Fork "check'Th" $ evalBinder Braty ty >>= \case
+    mkFork "check'Th" $ evalBinder Braty ty >>= \case
           -- the case split here is so we can be sure we have the necessary CheckConstraints
           Right ty@(VFun Braty cty) -> checkThunk Braty "thunk" cty tm >>= wire . (,ty, hungry)
           Right ty@(VFun Kerny cty) -> checkThunk Kerny "thunk" cty tm >>= wire . (,ty, hungry)
@@ -444,7 +444,7 @@ check' (VHole (mnemonic, name)) connectors = do
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
   traceM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
-  req . Fork "check'Con" $ case (?my, ty) of
+  mkFork "check'Con" $ case (?my, ty) of
       (Braty, Left k) -> do
         (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
         ensureEmpty "kindCheck leftovers" leftOvers
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index c65b1214..e0cba674 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -20,7 +20,9 @@ import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Data.Set as S
 
-import Debug.Trace
+-- Used for messages about thread forking / spawning
+thTrace = const id
+--thTrace = trace
 
 trackM :: Monad m => String -> m ()
 trackM = const (pure ())
@@ -66,6 +68,9 @@ data Context = Ctx { globalVEnv :: VEnv
                    , captureSets :: CaptureSets
                    }
 
+mkFork :: String -> Free sig () -> Free sig ()
+mkFork d par = thTrace ("Forking " ++ d) $ Fork d par $ pure ()
+
 -- Commands for synchronous operations
 data CheckingSig ty where
   Fresh   :: String -> CheckingSig Name
@@ -100,7 +105,6 @@ data CheckingSig ty where
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
   ANewHope :: (End, FC) -> CheckingSig ()
   AskHopeSet :: CheckingSig HopeSet
-  Fork :: String -> Checking () -> CheckingSig ()
   AddCapture :: Name -> (UserName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
@@ -108,20 +112,20 @@ localAlias _ (Ret v) = Ret v
 localAlias con@(name, alias) (Req (ALup u) k)
   | u == name = localAlias con $ k (Just alias)
 localAlias con (Req (InLvl str c) k) = Req (InLvl str (localAlias con c)) (localAlias con . k)
-localAlias con (Req (Fork d c) k) = Req (Fork d $ localAlias con c) (localAlias con . k)
 localAlias con (Req r k) = Req r (localAlias con . k)
 localAlias con (Define v e k) = Define v e (localAlias con . k)
 localAlias con (Yield st k) = Yield st (localAlias con . k)
+localAlias con (Fork d par c) = Fork d (localAlias con par) (localAlias con c)
 
 localFC :: FC -> Checking v -> Checking v
 localFC _ (Ret v) = Ret v
 localFC f (Req AskFC k) = localFC f (k f)
 localFC f (Req (Throw (e@Err{fc=Nothing})) k) = localFC f (Req (Throw (e{fc=Just f})) k)
 localFC f (Req (InLvl str c) k) = Req (InLvl str (localFC f c)) (localFC f . k)
-localFC f (Req (Fork d c) k) = Req (Fork d $ localFC f c) (localFC f . k)
 localFC f (Req r k) = Req r (localFC f . k)
 localFC f (Define v e k) = Define v e (localFC f . k)
 localFC f (Yield st k) = Yield st (localFC f . k)
+localFC f (Fork d par c) = Fork d (localFC f par) (localFC f c)
 
 
 localEnv :: (?my :: Modey m) => Env (EnvData m) -> Checking v -> Checking v
@@ -136,10 +140,10 @@ localVEnv ext (Req AskVEnv k) = do env <- req AskVEnv
                                    -- ext shadows local vars
                                    localVEnv ext (k (env { locals = M.union ext (locals env) }))
 localVEnv ext (Req (InLvl str c) k) = Req (InLvl str (localVEnv ext c)) (localVEnv ext . k)
-localVEnv ext (Req (Fork d c) k) = Req (Fork d $ localVEnv ext c) (localVEnv ext . k)
 localVEnv ext (Req r k) = Req r (localVEnv ext . k)
 localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
 localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
+localVEnv ext (Fork d par c) = Fork d (localVEnv ext par) (localVEnv ext c)
 
 -- runs a computation, but logs (via AddCapture, under the specified Name) uses of outer
 -- *local* variables
@@ -152,19 +156,19 @@ captureOuterLocals n c = do
   helper _ (Ret v) = Ret v
   helper avail (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
     (req $ AddCapture n (x,new)) >> helper avail (k j)
-  helper avail (Req (Fork d c) k) = Req (Fork d $ helper avail c) (helper avail . k)
   helper avail (Req r k) = Req r (helper avail . k)
   helper avail (Define e v k) = Define e v (helper avail . k)
   helper avail (Yield st k) = Yield st (helper avail . k)
+  helper avail (Fork d par c) = Fork d (helper avail par) (helper avail c)
 
 wrapError :: (Error -> Error) -> Checking v -> Checking v
 wrapError _ (Ret v) = Ret v
 wrapError f (Req (Throw e) k) = Req (Throw (f e)) k
 wrapError f (Req (InLvl str c) k) = Req (InLvl str (wrapError f c)) (wrapError f . k)
-wrapError f (Req (Fork d c) k) = Req (Fork d $ wrapError f c) (wrapError f . k)
 wrapError f (Req r k) = Req r (wrapError f . k)
 wrapError f (Define v e k) = Define v e (wrapError f . k)
 wrapError f (Yield st k) = Yield st (wrapError f . k)
+wrapError f (Fork d par c) = Fork d (wrapError f par) (wrapError f c)
 
 throwLeft :: Either ErrorMsg a -> Checking a
 throwLeft (Right x) = pure x
@@ -225,10 +229,12 @@ localKVar env (Req KDone k) = case [ x | (x,(One,_)) <- M.assocs env ] of
                                               ,intercalate ", " (fmap show xs)
                                               ,"haven't been used"
                                               ]
-localKVar env (Req (Fork d c) k) = Req (Fork d $ localKVar env c) (localKVar env . k)
 localKVar env (Req r k) = Req r (localKVar env . k)
 localKVar env (Define e v k) = Define e v (localKVar env . k)
 localKVar env (Yield st k) = Yield st (localKVar env . k)
+localKVar env (Fork desc par c) =
+  -- can't send end both ways, so until we can join (TODO), restrict Forks to local scope
+  thTrace ("Spawning(LKV) " ++ desc) $ localKVar env $ par *> c
 
 catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
 catchErr (Ret t) = Ret (Right t)
@@ -236,6 +242,7 @@ catchErr (Req (Throw e) _) = pure $ Left e
 catchErr (Req r k) = Req r (catchErr . k)
 catchErr (Define e v k) = Define e v (catchErr . k)
 catchErr (Yield st k) = Yield st (catchErr . k)
+catchErr (Fork desc par c) = thTrace ("Spawning(catch) " ++ desc) $ catchErr $ par *> c
 
 handler :: Free CheckingSig v
         -> Context
@@ -300,7 +307,6 @@ handler (Req s k) ctx g ns
 
       ANewHope (e, fc) -> handler (k ()) (ctx { hopeSet = M.insert e fc (hopeSet ctx) }) g ns
       AskHopeSet -> handler (k (hopeSet ctx)) ctx g ns
-      Fork desc c -> handler (trace ("Forking " ++ desc) $ k () <* c) ctx g ns
       AddCapture n (var, ends) ->
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g ns
 
@@ -317,6 +323,7 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
             }) g ns
 handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
 handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]
+handler (Fork desc par c) ctx g ns = handler (thTrace ("Spawning " ++ desc) $ par *> c) ctx g ns
 
 howStuck :: Val n -> Stuck
 howStuck (VApp (VPar e) _) = AwaitingAny (S.singleton e)
@@ -368,20 +375,20 @@ instance MonadFail Checking where
 suppressHoles :: Checking a -> Checking a
 suppressHoles (Ret x) = Ret x
 suppressHoles (Req (LogHole _) k) = suppressHoles (k ())
-suppressHoles (Req (Fork d c) k) = Req (Fork d $ suppressHoles c) (suppressHoles . k)
 suppressHoles (Req c k) = Req c (suppressHoles . k)
 suppressHoles (Define v e k) = Define v e (suppressHoles . k)
 suppressHoles (Yield st k) = Yield st (suppressHoles . k)
+suppressHoles (Fork d par c) = Fork d (suppressHoles par) (suppressHoles c)
 
 -- Run a computation without doing any graph generation
 suppressGraph :: Checking a -> Checking a
 suppressGraph (Ret x) = Ret x
 suppressGraph (Req (AddNode _ _) k) = suppressGraph (k ())
 suppressGraph (Req (Wire _) k) = suppressGraph (k ())
-suppressGraph (Req (Fork d c) k) = Req (Fork d $ suppressGraph c) (suppressGraph . k)
 suppressGraph (Req c k) = Req c (suppressGraph . k)
 suppressGraph (Define v e k) = Define v e (suppressGraph . k)
 suppressGraph (Yield st k) = Yield st (suppressGraph . k)
+suppressGraph (Fork d par c) = Fork d (suppressGraph par) (suppressGraph c)
 
 defineEnd :: End -> Val Z -> Checking ()
 defineEnd e v = Define e v (const (Ret ()))
diff --git a/brat/Control/Monad/Freer.hs b/brat/Control/Monad/Freer.hs
index 9b6be04f..8df5cd90 100644
--- a/brat/Control/Monad/Freer.hs
+++ b/brat/Control/Monad/Freer.hs
@@ -45,12 +45,14 @@ data Free (sig :: Type -> Type) (v :: Type) where
   Req ::  sig t -> (t -> Free sig v) -> Free sig v
   Define :: End -> Val Z -> (News -> Free sig v) -> Free sig v
   Yield :: Stuck -> (News -> Free sig v) -> Free sig v
+  Fork :: String -> Free sig () -> Free sig v -> Free sig v
 
 instance Functor (Free sig) where
   fmap f (Ret v) = Ret (f v)
   fmap f (Req sig k) = Req sig (fmap f . k)
   fmap f (Define e v k) = Define e v (fmap f . k)
   fmap f (Yield st k) = Yield st (fmap f . k)
+  fmap f (Fork d par c) = Fork d par (fmap f c)
 
 class NewsWatcher t where
   (///) :: t -> News -> t
@@ -67,6 +69,7 @@ instance NewsWatcher (Free sig v) where
   Req sig k /// n = Req sig $ \v -> k v /// n
   Define e v k /// n = Define e v (k /// n)
   Yield st k /// n = Yield (st /// n) (k /// n)
+  Fork d par c /// n = Fork d (par /// n) (c /// n)
 
 instance Applicative (Free sig) where
   pure = Ret
@@ -76,6 +79,10 @@ instance Applicative (Free sig) where
   Yield Unstuck k <*> a = k mempty <*> a
   f <*> Yield Unstuck k = f <*> k mempty
 
+  -- Aggressively forward Forks
+  Fork d par c <*> ma = Fork d par (c <*> ma)
+  ma <*> Fork d par c = Fork d par (ma <*> c)
+
   -- Make progress on the left
   Ret f <*> ma = fmap f ma
   Req sig k <*> ma = Req sig ((<*> ma) . k)
@@ -95,6 +102,7 @@ instance Monad (Free sig) where
   Yield st k1 >>= k2 = Yield st (k1 >=> k2)
   --- equivalent to
   -- Yield st k1 >>= k2 = Yield st (\n -> (k1 n) >>= k2)
+  Fork d par k1 >>= k2 = Fork d par (k1 >>= k2)
 
 req :: sig t -> Free sig t
 req s = Req s Ret
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index f2d8ff27..c88e250f 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -32,16 +32,16 @@ coroT1 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
   req $ Declare e Braty (Left $ Star [])
-  req . Fork "t1" $ do
-    req (ELup e) >>= \case
-      Just _ -> err $ InternalError "already defined"
-      Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
-  Yield (AwaitingAny $ S.singleton e) $ \_ -> do
-    traceM "Yield continued"
-    v <- req $ ELup e
-    case v of
-      Just _ -> pure ()
-      Nothing -> err $ InternalError "not defined"
+  mkFork "t1" (req (ELup e) >>= \case
+          Just _ -> err $ InternalError "already defined"
+          Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+      )
+  Yield (AwaitingAny $ S.singleton e) $ \_ -> pure ()
+  traceM "Yield continued"
+  v <- req $ ELup e
+  case v of
+    Just _ -> pure ()
+    Nothing -> err $ InternalError "not defined"
 
 coroT2 :: Checking ()
 coroT2 = do
@@ -50,7 +50,7 @@ coroT2 = do
   req $ Declare e Braty (Left $ Star [])
   v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
   -- No way to execute this without a 'v'
-  req . Fork "t2" $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+  mkFork "t2" $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
   err $ InternalError $ case v of
     Nothing -> "ELup performed without waiting for Yield" -- true in next case too
     Just _ -> "ELup returned value before being Defined"

From 9dc4b0ef2bae301f225457d66bad9f34e60b5a20 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 16:41:30 +0100
Subject: [PATCH 052/182] WIP remove debug

---
 brat/Brat/Checker.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index a726c783..12b4fe8c 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -48,7 +48,7 @@ import Brat.UserName
 import Bwd
 import Hasochism
 import Util (zip_same_length)
-import Debug.Trace
+--import Debug.Trace
 
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
@@ -176,7 +176,7 @@ check :: (CheckConstraints m k
       -> ChkConnectors m d k
       -> Checking (SynConnectors m d k
                   ,ChkConnectors m d k)
-check (WC fc tm) conn = trace ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
+check (WC fc tm) conn = track ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
 
 check' :: forall m d k
         . (CheckConstraints m k
@@ -443,19 +443,19 @@ check' (VHole (mnemonic, name)) connectors = do
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
 check' tm@(Con vcon vargs) ((), ((hungry, ty):unders)) = do
-  traceM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
+  trackM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
   mkFork "check'Con" $ case (?my, ty) of
       (Braty, Left k) -> do
         (_, leftOvers) <- kindCheck [(hungry, k)] (Con vcon vargs)
         ensureEmpty "kindCheck leftovers" leftOvers
       (Braty, Right ty) -> aux Braty clup ty
-      (Kerny, _) -> trace "Kerny" $ aux Kerny kclup ty
+      (Kerny, _) -> track "Kerny" $ aux Kerny kclup ty
   pure (((), ()), ((), unders))
  where
   aux :: Modey m -> (UserName -> UserName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
-    VCon tycon tyargs <- trace "In forked aux for check' Con" $ eval S0 ty
-    (CArgs pats nFree _ argTypeRo) <- trace "forked aux doing lup" $ lup vcon tycon
+    VCon tycon tyargs <- track "In forked aux for check' Con" $ eval S0 ty
+    (CArgs pats nFree _ argTypeRo) <- track "forked aux doing lup" $ lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths
     wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
     Some (ny :* env) <- throwLeft $ valMatches tyargs pats

From 554bae2b35841a07c2681bad85e3fdd8984acf5d Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 18 Sep 2024 12:42:32 +0100
Subject: [PATCH 053/182] Fix compilation crashing on empty captureSet

---
 brat/Brat/Compile/Hugr.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index e1e392f2..ea1ee2cf 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -430,8 +430,10 @@ compileWithInputs parent name = gets compiled <&> M.lookup name >>= \case
     (Box src tgt) -> case outs of
       [(_, VFun Kerny cty)] -> default_edges . nodeId . fst <$>
            compileKernBox parent name (compileBox (src, tgt)) cty
-      [(_, VFun Braty cty)] -> gets capSets >>= \cs -> compileBratBox parent name (cs M.! name, src, tgt) cty <&>
-          (\(partialNode, captures) -> Just (partialNode, 1, captures)) -- 1 is arbitrary, Box has no real inputs
+      [(_, VFun Braty cty)] -> do
+        cs <- gets (M.findWithDefault M.empty name . capSets)
+        (partialNode, captures) <- compileBratBox parent name (cs, src, tgt) cty
+        pure $ Just (partialNode, 1, captures) -- 1 is arbitrary, Box has no real inputs
       outs -> error $ "Unexpected outs of box: " ++ show outs
 
     Source -> default_edges <$> do

From 0bfcc270114987ee26b1be45644301e07c4259d1 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 18 Sep 2024 13:54:44 +0100
Subject: [PATCH 054/182] Add isSkolem func, use in typeEqEta - TODO for now
 True for any outport

---
 brat/Brat/Checker/Monad.hs      |  6 ++++++
 brat/Brat/Checker/SolveHoles.hs | 13 ++++++++++---
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index e0cba674..f53f73fe 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -236,6 +236,12 @@ localKVar env (Fork desc par c) =
   -- can't send end both ways, so until we can join (TODO), restrict Forks to local scope
   thTrace ("Spawning(LKV) " ++ desc) $ localKVar env $ par *> c
 
+-- Skolem constants are e.g. function parameters that are *not* going to be defined if we wait.
+-- (exception: clause inputs can sometimes be defined if there is exactly one possible value).
+isSkolem :: End -> Checking Bool
+isSkolem (InEnd _) = pure False
+isSkolem (ExEnd _) = pure True -- TODO: should only be True for function parameters i.e. Source nodes
+
 catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
 catchErr (Ret t) = Ret (Right t)
 catchErr (Req (Throw e) _) = pure $ Left e
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 72a69b29..ba8602c2 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -14,6 +14,8 @@ import Bwd
 import Hasochism
 import Util (zip_same_length)
 
+import Control.Exception (assert)
+import Control.Monad (filterM)
 import Data.Foldable (traverse_)
 import Data.Functor
 import qualified Data.Map as M
@@ -64,13 +66,18 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopeSet k exp (SApp (SPar e) B0)
 typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
   | Just (SPar e) <- isNumVar exp, M.member e hopeSet = solveHope Nat e act
   | Just (SPar e) <- isNumVar act, M.member e hopeSet = solveHope Nat e exp
+-- harder cases, neither is in the hopeSet, so we can't define it ourselves
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  case [e | (VApp (VPar e) _) <- [exp,act], M.member e hopeSet] of
-    [] -> typeEqRigid tm stuff k exp act
-    es -> do
+  let ends = [e | (VApp (VPar e) _) <- [exp,act], assert (not $ M.member e hopeSet) True]
+  filterM shouldWait ends >>= \case
+    [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
+    es -> do -- tricky: must wait for one or other to become more defined
       Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
+ where
+  shouldWait :: End -> Checking Bool
+  shouldWait e = isSkolem e <&> not
 
 -- This will update the hopeSet, potentially invalidating things that have been eval'd
 -- The Sem is closed, for now.

From a4115fbc7a67783dda58150f54949bcfdb0d15e9 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 18 Sep 2024 14:11:36 +0100
Subject: [PATCH 055/182] simpleCheck is Checking, allow to define hopes
 (except nat/int?!) and block

---
 brat/Brat/Checker.hs               |  8 ++++----
 brat/Brat/Checker/Helpers.hs       | 30 +++++++++++++++++++++++-------
 brat/Brat/Checker/SolvePatterns.hs |  2 +-
 3 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 12b4fe8c..c519633c 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -494,7 +494,7 @@ check' (Simple tm) ((), ((hungry, ty):unders)) = do
     -- No defining needed, so everything else can be unified
     _ -> do
       let vty = biType @m ty
-      throwLeft $ simpleCheck ?my vty tm
+      simpleCheck ?my vty tm
       (_, _, [(dangling, _)], _) <- anext @m "" (Const tm) (S0,Some (Zy :* S0))
                                      R0 (RPr ("value", vty) R0)
       wire (dangling, vty, hungry)
@@ -889,9 +889,9 @@ abstractPattern :: forall m
                 -> Pattern
                 -> Checking (Env (EnvData m)) -- Local env for checking body of lambda
 abstractPattern m (src, ty) (Bind x) = let ?my = m in singletonEnv x (src, ty)
-abstractPattern Braty (_, Left Nat) (Lit tm) = throwLeft (simpleCheck Braty TNat tm) $> emptyEnv
-abstractPattern Braty (_, Right ty) (Lit tm) = throwLeft (simpleCheck Braty ty tm) $> emptyEnv
-abstractPattern Kerny (_, ty) (Lit tm) = throwLeft (simpleCheck Kerny ty tm) $> emptyEnv
+abstractPattern Braty (_, Left Nat) (Lit tm) = simpleCheck Braty TNat tm $> emptyEnv
+abstractPattern Braty (_, Right ty) (Lit tm) = simpleCheck Braty ty tm $> emptyEnv
+abstractPattern Kerny (_, ty) (Lit tm) = simpleCheck Kerny ty tm $> emptyEnv
 abstractPattern Braty (dangling, Left k) pat = abstractKind k pat
  where
   abstractKind :: TypeKind -> Pattern -> Checking (Env (EnvData Brat))
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 6fdcc38d..9d7fe868 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -2,7 +2,7 @@
 
 module Brat.Checker.Helpers where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd)
+import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, throwLeft, isSkolem)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType)
@@ -21,18 +21,34 @@ import Util (log2)
 
 import Control.Monad.Freer
 import Control.Arrow ((***))
+import Data.Functor ((<&>))
 import Data.List (intercalate)
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Prelude hiding (last)
 
-simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()
-simpleCheck Braty TNat (Num n) | n >= 0 = pure ()
-simpleCheck Braty TInt (Num _) = pure ()
-simpleCheck Braty TFloat (Float _) = pure ()
-simpleCheck Braty TText (Text _) = pure ()
-simpleCheck _ ty tm = Left $ TypeErr $ unwords
+simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
+simpleCheck my ty tm = case (my, ty) of
+  (Braty, VApp (VPar e) _) -> do
+    isHope <- req AskHopeSet <&> M.member e
+    if isHope then
+      case tm of
+        Float _ -> defineEnd e TFloat
+        Text _ -> defineEnd e TText
+        Num n | n < 0 -> defineEnd e TInt
+        Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
+    else isSkolem e >>= \case
+      True -> throwLeft $ helper Braty ty tm
+      False -> Yield (AwaitingAny $ S.singleton e) (\_ -> simpleCheck Braty ty tm)
+  _ -> throwLeft $ helper my ty tm
+ where
+  helper :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()
+  helper Braty TNat (Num n) | n >= 0 = pure ()
+  helper Braty TInt (Num _) = pure ()
+  helper Braty TFloat (Float _) = pure ()
+  helper Braty TText (Text _) = pure ()
+  helper _ ty tm = Left $ TypeErr $ unwords
                       ["Expected something of type"
                       ,"`" ++ show ty ++ "`"
                       ,"but got"
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 990c337d..f78b44c7 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -82,7 +82,7 @@ solve my ((src, Lit tm):p) = do
           unless (n >= 0) $ typeErr "Negative Nat kind"
           unifyNum (nConstant (fromIntegral n)) (nVar (VPar (ExEnd (end src))))
     (Braty, Right ty) -> do
-      throwLeft (simpleCheck Braty ty tm)
+      simpleCheck Braty ty tm
     _ -> typeErr $ "Literal " ++ show tm ++ " isn't valid at this type"
   (tests, sol) <- solve my p
   pure ((src, PrimLitTest tm):tests, sol)

From 3b76be2c2169e809c7021f5eb2f4b8de6424a8df Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 15:44:06 +0100
Subject: [PATCH 056/182] typeMap stores skolem-ness (always False ATM); TypeOf
 returns (EndType,Bool)

---
 brat/Brat/Checker.hs               | 2 +-
 brat/Brat/Checker/Monad.hs         | 5 +++--
 brat/Brat/Checker/SolvePatterns.hs | 3 ++-
 brat/Brat/Checker/Types.hs         | 2 +-
 brat/Brat/Eval.hs                  | 2 +-
 5 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index c519633c..af938460 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -989,5 +989,5 @@ run ve initStore ns m = do
     hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
  where
   isNatKinded tyMap e = case tyMap M.! e of
-    EndType Braty (Left Nat) -> True
+    (EndType Braty (Left Nat), _) -> True
     _ -> False
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index f53f73fe..41db5d9a 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -97,7 +97,7 @@ data CheckingSig ty where
   ELup    :: End -> CheckingSig (Maybe (Val Z))
   -- Lookup an alias in the table
   ALup    :: UserName -> CheckingSig (Maybe Alias)
-  TypeOf  :: End -> CheckingSig EndType
+  TypeOf  :: End -> CheckingSig (EndType, Bool)
   AddNode :: Name -> Node -> CheckingSig ()
   Wire    :: Wire -> CheckingSig ()
   KDone   :: CheckingSig ()
@@ -290,7 +290,7 @@ handler (Req s k) ctx g ns
                        track ("Declared " ++ show end ++ " :: " ++ bty_str) $
                        handler (k ())
                        (ctx { store =
-                              st { typeMap = M.insert end (EndType my bty) m }
+                              st { typeMap = M.insert end (EndType my bty, False) m }
                             }) g ns
       -- TODO: Use the kind argument for partially applied constructors
       TLup key -> do
@@ -321,6 +321,7 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
       Nothing -> case M.lookup end tm of
         Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
+        -- Allow even Skolems to be defined (e.g. clauses with unique soln)
         -- TODO can we check the value is of the kind declared?
         Just _ -> let news = News (M.singleton end (howStuck v)) in
           handler (k news)
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index f78b44c7..216d98b4 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -20,6 +20,7 @@ import Hasochism
 
 import Control.Monad (unless)
 import Data.Bifunctor (first)
+import Data.Functor ((<&>))
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Data.Type.Equality ((:~:)(..), testEquality)
@@ -121,7 +122,7 @@ solve my ((src, PCon c abs):p) = do
 
 
 typeOfEnd :: Modey m -> End -> Checking (BinderType m)
-typeOfEnd my e = req (TypeOf e) >>= \case
+typeOfEnd my e = (req (TypeOf e) <&> fst) >>= \case
   EndType my' ty
     | Just Refl <- testEquality my my' -> case my' of
         Braty -> case ty of
diff --git a/brat/Brat/Checker/Types.hs b/brat/Brat/Checker/Types.hs
index 2428c83f..69d2748f 100644
--- a/brat/Brat/Checker/Types.hs
+++ b/brat/Brat/Checker/Types.hs
@@ -95,7 +95,7 @@ instance Show EndType where
   show (EndType Braty (Right ty)) = show ty
 
 data Store = Store
-  { typeMap  :: M.Map End EndType
+  { typeMap  :: M.Map End (EndType, Bool) -- True = is skolem const, will never be defined
   , valueMap :: M.Map End (Val Z)
   }
 
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 2bea55d5..e06397aa 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -190,7 +190,7 @@ kindEq (TypeFor m xs) (TypeFor m' ys) | m == m' = kindListEq xs ys
 kindEq k k' = Left . TypeErr $ "Unequal kinds " ++ show k ++ " and " ++ show k'
 
 kindOf :: VVar Z -> Checking TypeKind
-kindOf (VPar e) = req (TypeOf e) >>= \case
+kindOf (VPar e) = (req (TypeOf e) <&> fst) >>= \case
   EndType Braty (Left k) -> pure k
   EndType my ty -> typeErr $ "End " ++ show e ++ " isn't a kind, it's type is " ++ case my of
     Braty -> show ty

From 2ebb9415bd285fbf12b126b85d3cc77c8ca20719 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 15:49:21 +0100
Subject: [PATCH 057/182] Inline only use of declareSrc

---
 brat/Brat/Checker/Helpers.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 9d7fe868..3d71cc99 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -180,7 +180,8 @@ anext str th vals0 ins outs = do
   (overs, vals2)  <- endPorts node ExEnd Ex 0 vals1 outs
   () <- sequence_ $
         [ declareTgt tgt (modey @m) ty | (tgt, ty) <- unders ] ++
-        [ declareSrc src (modey @m) ty | (src, ty) <- overs ]
+        [ req (Declare (ExEnd (end src)) (modey @m) ty) | (src, ty) <- overs ]
+
   let inputs  = [ (portName p, biType @m ty) | (p, ty) <- unders ]
   let outputs = [ (portName p, biType @m ty) | (p, ty) <- overs  ]
 
@@ -295,9 +296,6 @@ defineSrc src v = defineEnd (ExEnd (end src)) v
 defineTgt :: Tgt -> Val Z -> Checking ()
 defineTgt tgt v = defineEnd (InEnd (end tgt)) v
 
-declareSrc :: Src -> Modey m -> BinderType m -> Checking ()
-declareSrc src my ty = req (Declare (ExEnd (end src)) my ty)
-
 declareTgt :: Tgt -> Modey m -> BinderType m -> Checking ()
 declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty)
 

From e0c79971c1b7b4cc5a78601b387847aa5842136b Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 16:33:18 +0100
Subject: [PATCH 058/182] Declare takes Bool param (still always False)

---
 brat/Brat/Checker.hs         | 2 +-
 brat/Brat/Checker/Helpers.hs | 4 ++--
 brat/Brat/Checker/Monad.hs   | 6 +++---
 brat/test/Main.hs            | 4 ++--
 4 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index af938460..d09470d9 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -791,7 +791,7 @@ kindCheckRow' :: forall m n
 kindCheckRow' _ ez env (_,i) [] = pure (i, env, Some (ez :* R0))
 kindCheckRow' Braty (ny :* s) env (name,i) ((p, Left k):rest) = do -- s is Stack Z n
   let dangling = Ex name (ny2int ny)
-  req (Declare (ExEnd dangling) Braty (Left k))
+  req (Declare (ExEnd dangling) Braty (Left k) False) -- assume none are Skolem consts??
   env <- pure $ M.insert (plain p) [(NamedPort dangling p, Left k)] env
   (i, env, ser) <- kindCheckRow' Braty (Sy ny :* (s :<< ExEnd dangling)) env (name, i) rest
   case ser of
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 3d71cc99..5b763ede 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -180,7 +180,7 @@ anext str th vals0 ins outs = do
   (overs, vals2)  <- endPorts node ExEnd Ex 0 vals1 outs
   () <- sequence_ $
         [ declareTgt tgt (modey @m) ty | (tgt, ty) <- unders ] ++
-        [ req (Declare (ExEnd (end src)) (modey @m) ty) | (src, ty) <- overs ]
+        [ req (Declare (ExEnd (end src)) (modey @m) ty False) | (src, ty) <- overs ]
 
   let inputs  = [ (portName p, biType @m ty) | (p, ty) <- unders ]
   let outputs = [ (portName p, biType @m ty) | (p, ty) <- overs  ]
@@ -297,7 +297,7 @@ defineTgt :: Tgt -> Val Z -> Checking ()
 defineTgt tgt v = defineEnd (InEnd (end tgt)) v
 
 declareTgt :: Tgt -> Modey m -> BinderType m -> Checking ()
-declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty)
+declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty False)
 
 -- listToRow :: [(PortName, BinderType m)] -> Ro m Z i
 -- listToRow [] = R0
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 41db5d9a..ec48e037 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -102,7 +102,7 @@ data CheckingSig ty where
   Wire    :: Wire -> CheckingSig ()
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
-  Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
+  Declare :: End -> Modey m -> BinderType m -> Bool -> CheckingSig () -- Bool = is-skole
   ANewHope :: (End, FC) -> CheckingSig ()
   AskHopeSet :: CheckingSig HopeSet
   AddCapture :: Name -> (UserName, [(Src, BinderType Brat)]) -> CheckingSig ()
@@ -282,7 +282,7 @@ handler (Req s k) ctx g ns
       TypeOf end -> case M.lookup end . typeMap . store $ ctx of
         Just et -> handler (k et) ctx g ns
         Nothing -> Left (dumbErr . InternalError $ "End " ++ show end ++ " isn't Declared")
-      Declare end my bty ->
+      Declare end my bty skol ->
         let st@Store{typeMap=m} = store ctx
         in case M.lookup end m of
           Just _ -> Left $ dumbErr (InternalError $ "Redeclaring " ++ show end)
@@ -290,7 +290,7 @@ handler (Req s k) ctx g ns
                        track ("Declared " ++ show end ++ " :: " ++ bty_str) $
                        handler (k ())
                        (ctx { store =
-                              st { typeMap = M.insert end (EndType my bty, False) m }
+                              st { typeMap = M.insert end (EndType my bty, skol) m }
                             }) g ns
       -- TODO: Use the kind argument for partially applied constructors
       TLup key -> do
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index c88e250f..9af48abf 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -31,7 +31,7 @@ coroT1 :: Checking ()
 coroT1 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
-  req $ Declare e Braty (Left $ Star [])
+  req $ Declare e Braty (Left $ Star []) False
   mkFork "t1" (req (ELup e) >>= \case
           Just _ -> err $ InternalError "already defined"
           Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
@@ -47,7 +47,7 @@ coroT2 :: Checking ()
 coroT2 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
-  req $ Declare e Braty (Left $ Star [])
+  req $ Declare e Braty (Left $ Star []) False
   v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
   -- No way to execute this without a 'v'
   mkFork "t2" $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())

From 45751ac7f72d7fdacab94594cc35d14358f34ecc Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 17 Sep 2024 16:52:37 +0100
Subject: [PATCH 059/182] anext' allows setting Sources to be skolem

---
 brat/Brat/Checker.hs         |  2 +-
 brat/Brat/Checker/Helpers.hs | 17 +++++++++++++++--
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index d09470d9..43a0d492 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -217,7 +217,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       -- with the other clauses, as part of the body.
       (ins :->> outs) <- mkSig usedOvers unders
       (allFakeUnders, rightFakeUnders, tgtMap) <- suppressHoles $ suppressGraph $ do
-        (_, [], fakeOvers, fakeAcc) <- anext "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins
+        (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins True
         -- Hypo `check` calls need an environment, even just to compute leftovers;
         -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
         let srcMap = fromJust $ zip_same_length (fst <$> usedOvers) (fst <$> fakeOvers)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 5b763ede..0794d348 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -173,14 +173,27 @@ anext :: forall m i j k
       -> Ro m i j -- Inputs and Outputs use de Bruijn indices
       -> Ro m j k
       -> Checking (Name, Unders m Chk, Overs m UVerb, (Semz k, Some Endz))
-anext str th vals0 ins outs = do
+anext str th vals0 ins outs = anext' str th vals0 ins outs $ case th of
+  Source -> True
+  _ -> False
+
+anext' :: forall m i j k
+       . EvMode m
+      => String
+      -> NodeType m
+      -> (Semz i, Some Endz)
+      -> Ro m i j -- Inputs and Outputs use de Bruijn indices
+      -> Ro m j k
+      -> Bool -- whether outports are skolem consts (will never be defined), inports never are
+      -> Checking (Name, Unders m Chk, Overs m UVerb, (Semz k, Some Endz))
+anext' str th vals0 ins outs skol = do
   node <- req (Fresh str) -- Pick a name for the thunk
   -- Use the new name to generate Ends with which to instantiate types
   (unders, vals1) <- endPorts node InEnd In 0 vals0 ins
   (overs, vals2)  <- endPorts node ExEnd Ex 0 vals1 outs
   () <- sequence_ $
         [ declareTgt tgt (modey @m) ty | (tgt, ty) <- unders ] ++
-        [ req (Declare (ExEnd (end src)) (modey @m) ty False) | (src, ty) <- overs ]
+        [ req (Declare (ExEnd (end src)) (modey @m) ty skol) | (src, ty) <- overs ]
 
   let inputs  = [ (portName p, biType @m ty) | (p, ty) <- unders ]
   let outputs = [ (portName p, biType @m ty) | (p, ty) <- overs  ]

From 87270bfef7d6d4574ecb459cf8923e2820ffa969 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 18 Sep 2024 14:37:28 +0100
Subject: [PATCH 060/182] implement isSkolem using TypeOf

---
 brat/Brat/Checker/Monad.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index ec48e037..49c1a7d7 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -16,6 +16,7 @@ import Util
 import Control.Monad.Freer
 
 import Control.Monad.Fail ()
+import Data.Functor ((<&>))
 import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -239,8 +240,7 @@ localKVar env (Fork desc par c) =
 -- Skolem constants are e.g. function parameters that are *not* going to be defined if we wait.
 -- (exception: clause inputs can sometimes be defined if there is exactly one possible value).
 isSkolem :: End -> Checking Bool
-isSkolem (InEnd _) = pure False
-isSkolem (ExEnd _) = pure True -- TODO: should only be True for function parameters i.e. Source nodes
+isSkolem e = req (TypeOf e) <&> snd
 
 catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
 catchErr (Ret t) = Ret (Right t)

From 2fcdd488f65b34ef8603496bb4ab7651929b5756 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 25 Sep 2024 23:28:12 +0100
Subject: [PATCH 061/182] Common up Checking wrappers via 'wrapper' and
 'wrapper2'

---
 brat/Brat/Checker/Monad.hs | 107 ++++++++++++++++---------------------
 1 file changed, 46 insertions(+), 61 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 49c1a7d7..2d5b00f7 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -108,82 +108,72 @@ data CheckingSig ty where
   AskHopeSet :: CheckingSig HopeSet
   AddCapture :: Name -> (UserName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
+wrapper :: (forall a. CheckingSig a -> Checking (Maybe a)) -> Checking v -> Checking v
+wrapper _ (Ret v) = Ret v
+wrapper f (Req (InLvl str c) k) = Req (InLvl str (wrapper f c)) (wrapper f . k)
+wrapper f (Req s k) = f s >>= \case
+  Just v -> wrapper f (k v)
+  Nothing -> Req s (wrapper f . k)
+wrapper f (Define v e k) = Define v e (wrapper f . k)
+wrapper f (Yield st k) = Yield st (wrapper f . k)
+wrapper f (Fork d par c) = Fork d (wrapper f par) (wrapper f c)
+
+wrapper2 :: (forall a. CheckingSig a -> Maybe a) -> Checking v -> Checking v
+wrapper2 f = wrapper (\s -> pure (f s))
+
 localAlias :: (UserName, Alias) -> Checking v -> Checking v
-localAlias _ (Ret v) = Ret v
-localAlias con@(name, alias) (Req (ALup u) k)
-  | u == name = localAlias con $ k (Just alias)
-localAlias con (Req (InLvl str c) k) = Req (InLvl str (localAlias con c)) (localAlias con . k)
-localAlias con (Req r k) = Req r (localAlias con . k)
-localAlias con (Define v e k) = Define v e (localAlias con . k)
-localAlias con (Yield st k) = Yield st (localAlias con . k)
-localAlias con (Fork d par c) = Fork d (localAlias con par) (localAlias con c)
+localAlias (name, alias) = wrapper2 (\case
+    ALup u | u == name -> Just (Just alias)
+    _ -> Nothing)
 
 localFC :: FC -> Checking v -> Checking v
-localFC _ (Ret v) = Ret v
-localFC f (Req AskFC k) = localFC f (k f)
-localFC f (Req (Throw (e@Err{fc=Nothing})) k) = localFC f (Req (Throw (e{fc=Just f})) k)
-localFC f (Req (InLvl str c) k) = Req (InLvl str (localFC f c)) (localFC f . k)
-localFC f (Req r k) = Req r (localFC f . k)
-localFC f (Define v e k) = Define v e (localFC f . k)
-localFC f (Yield st k) = Yield st (localFC f . k)
-localFC f (Fork d par c) = Fork d (localFC f par) (localFC f c)
-
+localFC f = wrapper (\case
+  AskFC -> pure $ Just f
+  (Throw (e@Err{fc=Nothing})) -> req (Throw (e{fc=Just f})) >> error "Throw returned"
+  _ -> pure $ Nothing)
 
 localEnv :: (?my :: Modey m) => Env (EnvData m) -> Checking v -> Checking v
 localEnv = case ?my of
   Braty -> localVEnv
   Kerny -> \env m -> localKVar env (m <* req KDone)
 
-localVEnv :: VEnv -> Checking v -> Checking v
-localVEnv _   (Ret v) = Ret v
-localVEnv ext (Req (VLup x) k) | Just x <- M.lookup x ext = localVEnv ext (k (Just x))
-localVEnv ext (Req AskVEnv k) = do env <- req AskVEnv
-                                   -- ext shadows local vars
-                                   localVEnv ext (k (env { locals = M.union ext (locals env) }))
-localVEnv ext (Req (InLvl str c) k) = Req (InLvl str (localVEnv ext c)) (localVEnv ext . k)
-localVEnv ext (Req r k) = Req r (localVEnv ext . k)
-localVEnv ext (Define v e k) = Define v e (localVEnv ext . k)
-localVEnv ext (Yield st k) = Yield st (localVEnv ext . k)
-localVEnv ext (Fork d par c) = Fork d (localVEnv ext par) (localVEnv ext c)
+localVEnv :: M.Map UserName [(Src, BinderType Brat)] -> Checking v -> Checking v
+localVEnv ext = wrapper (\case
+  (VLup x) | j@(Just _) <- M.lookup x ext -> pure $ Just j -- invoke continuation with j
+  AskVEnv -> do
+    outerEnv <- req AskVEnv
+    pure $ Just -- value to return to original continuation
+      (outerEnv { locals = M.union ext (locals outerEnv) })  -- ext shadows local vars                          
+  _ -> pure Nothing)
 
 -- runs a computation, but logs (via AddCapture, under the specified Name) uses of outer
 -- *local* variables
 captureOuterLocals :: Name -> Checking v -> Checking v
 captureOuterLocals n c = do
   outerLocals <- locals <$> req AskVEnv
-  helper outerLocals c
+  wrapper (helper outerLocals) c
  where
-  helper :: VEnv -> Checking v -> Checking v
-  helper _ (Ret v) = Ret v
-  helper avail (Req (VLup x) k) | j@(Just new) <- M.lookup x avail =
-    (req $ AddCapture n (x,new)) >> helper avail (k j)
-  helper avail (Req r k) = Req r (helper avail . k)
-  helper avail (Define e v k) = Define e v (helper avail . k)
-  helper avail (Yield st k) = Yield st (helper avail . k)
-  helper avail (Fork d par c) = Fork d (helper avail par) (helper avail c)
+  helper :: VEnv -> forall a. CheckingSig a -> Checking (Maybe a)
+  helper avail (VLup x) | j@(Just new) <- M.lookup x avail =
+    (req $ AddCapture n (x,new)) >> (pure $ Just j)
+  helper _ _ = pure Nothing
 
 wrapError :: (Error -> Error) -> Checking v -> Checking v
-wrapError _ (Ret v) = Ret v
-wrapError f (Req (Throw e) k) = Req (Throw (f e)) k
-wrapError f (Req (InLvl str c) k) = Req (InLvl str (wrapError f c)) (wrapError f . k)
-wrapError f (Req r k) = Req r (wrapError f . k)
-wrapError f (Define v e k) = Define v e (wrapError f . k)
-wrapError f (Yield st k) = Yield st (wrapError f . k)
-wrapError f (Fork d par c) = Fork d (wrapError f par) (wrapError f c)
+wrapError f = wrapper (\case
+  (Throw e) -> req (Throw (f e)) -- do not return value from outer Throw!
+  _ -> pure Nothing)
 
 throwLeft :: Either ErrorMsg a -> Checking a
 throwLeft (Right x) = pure x
 throwLeft (Left msg) = err msg
 
 vlup :: UserName -> Checking [(Src, BinderType Brat)]
-vlup s = do
-  req (VLup s) >>= \case
+vlup s = req (VLup s) >>= \case
     Just vty -> pure vty
     Nothing -> err $ VarNotFound (show s)
 
 alup :: UserName -> Checking Alias
-alup s = do
-  req (ALup s) >>= \case
+alup s = req (ALup s) >>= \case
     Just vty -> pure vty
     Nothing -> err $ VarNotFound (show s)
 
@@ -217,6 +207,7 @@ lookupAndUse x kenv = case M.lookup x kenv of
    Just (Tons, rest) -> Right $ Just (rest, M.insert x (Tons, rest) kenv)
 
 localKVar :: KEnv -> Checking v -> Checking v
+-- Doesn't fit the wrapper pattern because the `env` mutates
 localKVar _   (Ret v) = Ret v
 localKVar env (Req (KLup x) k) = case lookupAndUse x env of
                                    Left err@(Err (Just _) _) -> req $ Throw err
@@ -380,22 +371,16 @@ instance MonadFail Checking where
 
 -- Run a computation without logging any holes
 suppressHoles :: Checking a -> Checking a
-suppressHoles (Ret x) = Ret x
-suppressHoles (Req (LogHole _) k) = suppressHoles (k ())
-suppressHoles (Req c k) = Req c (suppressHoles . k)
-suppressHoles (Define v e k) = Define v e (suppressHoles . k)
-suppressHoles (Yield st k) = Yield st (suppressHoles . k)
-suppressHoles (Fork d par c) = Fork d (suppressHoles par) (suppressHoles c)
+suppressHoles = wrapper2 (\case
+  (LogHole _) -> Just ()
+  _ -> Nothing)
 
 -- Run a computation without doing any graph generation
 suppressGraph :: Checking a -> Checking a
-suppressGraph (Ret x) = Ret x
-suppressGraph (Req (AddNode _ _) k) = suppressGraph (k ())
-suppressGraph (Req (Wire _) k) = suppressGraph (k ())
-suppressGraph (Req c k) = Req c (suppressGraph . k)
-suppressGraph (Define v e k) = Define v e (suppressGraph . k)
-suppressGraph (Yield st k) = Yield st (suppressGraph . k)
-suppressGraph (Fork d par c) = Fork d (suppressGraph par) (suppressGraph c)
+suppressGraph = wrapper2 (\case
+  (AddNode _ _) -> Just ()
+  (Wire _) -> Just ()
+  _ -> Nothing)
 
 defineEnd :: End -> Val Z -> Checking ()
 defineEnd e v = Define e v (const (Ret ()))

From 75a5ac07a9aebbd7461c032bd16a869a77424f5c Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 15:53:05 +0100
Subject: [PATCH 062/182] print hopeset when blocked

---
 brat/Brat/Checker/Monad.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 2d5b00f7..c644d836 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -320,7 +320,9 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
                 hopeSet = M.delete end (hopeSet ctx)
             }) g ns
 handler (Yield Unstuck k) ctx g ns = handler (k mempty) ctx g ns
-handler (Yield (AwaitingAny ends) _k) _ _ _ = Left $ dumbErr $ TypeErr $ unlines $ ("Typechecking blocked on:":(show <$> S.toList ends)) ++ ["", "Try writing more types! :-)"]
+handler (Yield (AwaitingAny ends) _k) ctx _ _ = Left $ dumbErr $ TypeErr $ unlines $
+  ("Typechecking blocked on:":(show <$> S.toList ends))
+  ++ "":"Hopeset is":(show <$> M.keys (hopeSet ctx)) ++ ["Try writing more types! :-)"]
 handler (Fork desc par c) ctx g ns = handler (thTrace ("Spawning " ++ desc) $ par *> c) ctx g ns
 
 howStuck :: Val n -> Stuck

From 9f1c6ff5c9d8efdb20947ecb1b08478bf1e814de Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 16:42:37 +0100
Subject: [PATCH 063/182] Use defineEnd more

---
 brat/Brat/Checker/SolveHoles.hs    | 2 +-
 brat/Brat/Checker/SolvePatterns.hs | 2 +-
 brat/test/Main.hs                  | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index ba8602c2..a79cb407 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -84,7 +84,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
 -- TODO: This needs to update the BRAT graph with the solution.
 solveHope :: TypeKind -> End -> Sem -> Checking ()
 solveHope k e v = quote Zy v >>= \v -> case doesntOccur e v of
-  Right () -> Define e v $ \_ -> do
+  Right () -> defineEnd e v >> do
     dangling <- case (k, v) of
       (Nat, VNum v) -> buildNatVal v
       (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 216d98b4..a07d8aa9 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -199,7 +199,7 @@ unify l k r = do
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)
-  Define e val (const (Ret ()))
+  defineEnd e val
 
 -- Make the dynamic wiring for a metavariable. This only needs to happen for
 -- numbers because they have nontrivial runtime behaviour.
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 9af48abf..6a2190fa 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -34,7 +34,7 @@ coroT1 = do
   req $ Declare e Braty (Left $ Star []) False
   mkFork "t1" (req (ELup e) >>= \case
           Just _ -> err $ InternalError "already defined"
-          Nothing -> Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+          Nothing -> defineEnd e (VCon (PrefixName [] "nil") [])
       )
   Yield (AwaitingAny $ S.singleton e) $ \_ -> pure ()
   traceM "Yield continued"
@@ -50,7 +50,7 @@ coroT2 = do
   req $ Declare e Braty (Left $ Star []) False
   v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
   -- No way to execute this without a 'v'
-  mkFork "t2" $ Define e (VCon (PrefixName [] "nil") []) (\_ -> pure ())
+  mkFork "t2" $ defineEnd e (VCon (PrefixName [] "nil") [])
   err $ InternalError $ case v of
     Nothing -> "ELup performed without waiting for Yield" -- true in next case too
     Just _ -> "ELup returned value before being Defined"

From 0808dab16d764f52370320e7d315e7396c7e7b63 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 15:04:55 +0100
Subject: [PATCH 064/182] Add mkYield, use it

---
 brat/Brat/Checker/Helpers.hs    | 6 +++---
 brat/Brat/Checker/Monad.hs      | 3 +++
 brat/Brat/Checker/SolveHoles.hs | 4 ++--
 brat/test/Main.hs               | 6 ++++--
 4 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 0794d348..40356d85 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -2,7 +2,7 @@
 
 module Brat.Checker.Helpers where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, throwLeft, isSkolem)
+import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, throwLeft, isSkolem, mkYield)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType)
@@ -40,7 +40,7 @@ simpleCheck my ty tm = case (my, ty) of
         Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
     else isSkolem e >>= \case
       True -> throwLeft $ helper Braty ty tm
-      False -> Yield (AwaitingAny $ S.singleton e) (\_ -> simpleCheck Braty ty tm)
+      False -> mkYield "simpleCheck" (S.singleton e) >> simpleCheck Braty ty tm
   _ -> throwLeft $ helper my ty tm
  where
   helper :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()
@@ -275,7 +275,7 @@ getThunks Braty row@((src, Right ty):rest) = eval S0 ty >>= \case
   v -> do
     h <- req AskHopeSet
     case v of
-      VApp (VPar e) _ | M.member e h -> Yield (AwaitingAny $ S.singleton e) (\_ -> getThunks Braty row)
+      VApp (VPar e) _ | M.member e h -> mkYield "getThunks" (S.singleton e) >> getThunks Braty row
       _ -> typeErr $ "Force called on non-thunk: " ++ show v
 getThunks Kerny row@((src, Right ty):rest) = eval S0 ty >>= \case
   (VFun Kerny (ss :->> ts)) -> do
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index c644d836..612a7e70 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -72,6 +72,9 @@ data Context = Ctx { globalVEnv :: VEnv
 mkFork :: String -> Free sig () -> Free sig ()
 mkFork d par = thTrace ("Forking " ++ d) $ Fork d par $ pure ()
 
+mkYield :: String -> S.Set End -> Free sig ()
+mkYield desc es = thTrace ("Yielding in " ++ desc) $ Yield (AwaitingAny es) (\_ -> Ret ())
+
 -- Commands for synchronous operations
 data CheckingSig ty where
   Fresh   :: String -> CheckingSig Name
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index a79cb407..e8ed479c 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -73,8 +73,8 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   let ends = [e | (VApp (VPar e) _) <- [exp,act], assert (not $ M.member e hopeSet) True]
   filterM shouldWait ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
-    es -> do -- tricky: must wait for one or other to become more defined
-      Yield (AwaitingAny $ S.fromList es) (\_ -> typeEq tm stuff k exp act)
+    es -> -- tricky: must wait for one or other to become more defined
+      mkYield "typeEqEta" (S.fromList es) >> typeEq tm stuff k exp act
  where
   shouldWait :: End -> Checking Bool
   shouldWait e = isSkolem e <&> not
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 6a2190fa..1226b226 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -36,7 +36,7 @@ coroT1 = do
           Just _ -> err $ InternalError "already defined"
           Nothing -> defineEnd e (VCon (PrefixName [] "nil") [])
       )
-  Yield (AwaitingAny $ S.singleton e) $ \_ -> pure ()
+  mkYield "coroT1" (S.singleton e) >> pure ()
   traceM "Yield continued"
   v <- req $ ELup e
   case v of
@@ -48,7 +48,9 @@ coroT2 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
   req $ Declare e Braty (Left $ Star []) False
-  v <- Yield (AwaitingAny $ S.singleton e) $ \_ -> req $ ELup e
+  v <- do
+    mkYield "coroT2" (S.singleton e)
+    req $ ELup e
   -- No way to execute this without a 'v'
   mkFork "t2" $ defineEnd e (VCon (PrefixName [] "nil") [])
   err $ InternalError $ case v of

From a83de68ad4de49bfa1eb317b1b459e7f696e1a5a Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 14:46:01 +0100
Subject: [PATCH 065/182] Remove concurrency-blocking -!s in makeBox (27 -> 24
 fails)

---
 brat/Brat/Checker/Helpers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 40356d85..dc5e2e2b 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -8,7 +8,7 @@ import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType)
 import Brat.FC (FC)
 import Brat.Graph (Node(..), NodeType(..))
-import Brat.Naming (Name, FreshMonad(..))
+import Brat.Naming (Name)
 import Brat.Syntax.Common
 import Brat.Syntax.Core (Term(..))
 import Brat.Syntax.Simple
@@ -329,12 +329,12 @@ makeBox name cty@(ss :->> ts) body = do
     (Kerny, _) -> do
       (_,_,[thunk],_) <- next (name ++ "_thunk") (Box src tgt) (S0, Some (Zy :* S0))
                                 R0 (RPr ("thunk", VFun Kerny cty) R0)
-      bres <- name -! body (overs, unders)
+      bres <- body (overs, unders)
       pure (thunk, bres)
     (Braty, body) -> do
       (node, [], [thunk], _) <- next (name ++ "_thunk") (Box src tgt) (S0, Some (Zy :* S0))
                                      R0 (RPr ("thunk", VFun ?my cty) R0)
-      bres <- name -! (captureOuterLocals node $ body (overs, unders))
+      bres <- (captureOuterLocals node $ body (overs, unders))
       pure (thunk, bres)
 
 -- Evaluate either mode's BinderType

From 98a56717defd33694de94ab34c1bbf97377ba32b Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 15:45:04 +0100
Subject: [PATCH 066/182] Remove howStuck, just use Unstuck (30 -> 27 fails)

---
 brat/Brat/Checker/Monad.hs | 31 ++++++++-----------------------
 1 file changed, 8 insertions(+), 23 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 612a7e70..a8311774 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -316,8 +316,14 @@ handler (Define end v k) ctx g ns = let st@Store{typeMap=tm, valueMap=vm} = stor
       Nothing -> case M.lookup end tm of
         Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
         -- Allow even Skolems to be defined (e.g. clauses with unique soln)
-        -- TODO can we check the value is of the kind declared?
-        Just _ -> let news = News (M.singleton end (howStuck v)) in
+        -- TODO(1) can we check the value is of the kind declared?
+        -- TODO(2) it'd be better to figure out if the end is really Unstuck,
+        -- or just awaiting some other end, but that seems overly complex atm, as
+        -- (a) we must be "Unstuck" if the end is Defined to something Skolem *OR* in the HopeSet,
+        -- (b) Numbers are tricky, whether they are stuck or not depends upon the question
+        -- (c) since there are no infinite end-creating loops, it's correct (merely inefficient)
+        -- to just "have another go".
+        Just _ -> let news = News (M.singleton end Unstuck) in
           handler (k news)
             (ctx { store = st { valueMap = M.insert end v vm },
                 hopeSet = M.delete end (hopeSet ctx)
@@ -328,27 +334,6 @@ handler (Yield (AwaitingAny ends) _k) ctx _ _ = Left $ dumbErr $ TypeErr $ unlin
   ++ "":"Hopeset is":(show <$> M.keys (hopeSet ctx)) ++ ["Try writing more types! :-)"]
 handler (Fork desc par c) ctx g ns = handler (thTrace ("Spawning " ++ desc) $ par *> c) ctx g ns
 
-howStuck :: Val n -> Stuck
-howStuck (VApp (VPar e) _) = AwaitingAny (S.singleton e)
-howStuck (VLam bod) = howStuck bod
-howStuck (VCon _ _) = Unstuck
-howStuck (VFun _ _) = Unstuck
-howStuck (VSum _ _) = Unstuck
--- Numbers are likely to cause problems.
--- Whether they are stuck or not depends on the question we're asking!
-howStuck (VNum (NumValue 0 gro)) = howStuckGro gro
- where
-  howStuckGro Constant0 = Unstuck
-  howStuckGro (StrictMonoFun f) = howStuckSM f
-
-  howStuckSM (StrictMono 0 mono) = howStuckMono mono
-  howStuckSM _ = AwaitingAny mempty
-
-  howStuckMono (Full sm) = howStuckSM sm
-  howStuckMono (Linear (VPar e)) = AwaitingAny (S.singleton e) -- ALAN was VHop
-  howStuckMono (Linear _) = AwaitingAny mempty
-howStuck _ = AwaitingAny mempty
-
 type Checking = Free CheckingSig
 
 instance Semigroup a => Semigroup (Checking a) where

From db83ba9c7a155250b3dfb01386aebf6eaef62b76 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 20:43:06 +0100
Subject: [PATCH 067/182] typeEqEta shouldWait for ends inside nums as well,
 assert -> unless

---
 brat/Brat/Checker/SolveHoles.hs |  7 ++++---
 brat/Brat/Eval.hs               | 17 +++++++++--------
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index e8ed479c..199afda5 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -14,10 +14,10 @@ import Bwd
 import Hasochism
 import Util (zip_same_length)
 
-import Control.Exception (assert)
-import Control.Monad (filterM)
+import Control.Monad (filterM, unless)
 import Data.Foldable (traverse_)
 import Data.Functor
+import Data.Maybe (catMaybes)
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
@@ -70,7 +70,8 @@ typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = [e | (VApp (VPar e) _) <- [exp,act], assert (not $ M.member e hopeSet) True]
+  let ends = [e | (VApp (VPar e) _) <- [exp,act]] ++ catMaybes [getNumVar n | VNum n <- [exp, act]]
+  unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
   filterM shouldWait ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     es -> -- tricky: must wait for one or other to become more defined
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index e06397aa..4c3b75fb 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -17,6 +17,7 @@ module Brat.Eval (EvMode(..)
                  ,kindType
                  ,numVal
                  ,quote
+                 ,getNumVar
                  ) where
 
 import Brat.Checker.Monad
@@ -298,6 +299,14 @@ eqTests tm lvkz = go
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "
                    ++ show us ++ "\n  " ++ show vs
 
+getNumVar :: NumVal (VVar n) -> Maybe End
+getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
+  Linear v -> case v of
+    VPar e -> Just e
+    _ -> Nothing
+  Full sm -> getNumVar (numValue sm)
+getNumVar _ = Nothing
+
 -- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
 -- We can have bogus failures here because we're not normalising under lambdas
 -- N.B. the value argument is normalised.
@@ -305,14 +314,6 @@ doesntOccur :: End -> Val n -> Either ErrorMsg ()
 doesntOccur e (VNum nv) = case getNumVar nv of
   Just e' -> collision e e'
   _ -> pure ()
- where
-  getNumVar :: NumVal (VVar n) -> Maybe End
-  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear v -> case v of
-      VPar e -> Just e
-      _ -> Nothing
-    Full sm -> getNumVar (numValue sm)
-  getNumVar _ = Nothing
 doesntOccur e (VApp var args) = case var of
   VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
   _ -> pure ()

From 710c931f831129056111e4286e11c87189dd3acd Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Thu, 3 Oct 2024 17:45:06 +0100
Subject: [PATCH 068/182] Redo invertNatVal

---
 brat/Brat/Checker/SolveHoles.hs    | 27 +++++++++-------
 brat/Brat/Checker/SolvePatterns.hs | 50 +++++++++++++++---------------
 2 files changed, 40 insertions(+), 37 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index e0068009..6245a902 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -205,30 +205,33 @@ buildNatVal nv@(NumValue n gro) = case n of
     pure out
   buildMono _ = err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
 
-invertNatVal :: Tgt -> NumVal (VVar Z) -> Checking Tgt
-invertNatVal tgt (NumValue up gro) = case up of
-  0 -> invertGro tgt gro
+invertNatVal :: NumVal (VVar Z) -> Checking Tgt
+invertNatVal (NumValue up gro) = case up of
+  0 -> invertGro gro
   _ -> do
     ((lhs,rhs),out) <- buildArithOp Sub
     upSrc <- buildNum up
     wire (upSrc, TNat, rhs)
+    tgt <- invertGro gro
     wire (out, TNat, tgt)
-    invertGro lhs gro
+    pure lhs
  where
-  invertGro _ Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
-  invertGro tgt (StrictMonoFun sm) = invertSM tgt sm
+  invertGro Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
+  invertGro (StrictMonoFun sm) = invertSM sm
 
-  invertSM tgt (StrictMono k mono) = case k of
-    0 -> invertMono tgt mono
+  invertSM (StrictMono k mono) = case k of
+    0 -> invertMono mono
     _ -> do
       divisor <- buildNum (2 ^ k)
       ((lhs,rhs),out) <- buildArithOp Div
+      tgt <- invertMono mono
       wire (out, TNat, tgt)
       wire (divisor, TNat, rhs)
-      invertMono lhs mono
+      pure lhs
 
-  invertMono tgt (Linear (VPar (InEnd e))) = pure (NamedPort e "numval")
-  invertMono tgt (Full sm) = do
+  invertMono (Linear (VPar (InEnd e))) = pure (NamedPort e "numval")
+  invertMono (Full sm) = do
     (_, [(llufTgt,_)], [(llufSrc,_)], _) <- next "luff" (Prim ("BRAT","lluf")) (S0, Some (Zy :* S0)) (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+    tgt <- invertSM sm
     wire (llufSrc, TNat, tgt)
-    invertSM llufTgt sm
+    pure llufTgt
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index f796c12a..8ddff7bf 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -2,7 +2,7 @@ module Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
 
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
-import Brat.Checker.SolveHoles (buildNatVal, buildNum, invertNatVal)
+import Brat.Checker.SolveHoles (buildNatVal, invertNatVal)
 import Brat.Checker.Types (EndType(..))
 import Brat.Constructors
 import Brat.Constructors.Patterns
@@ -210,16 +210,12 @@ solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
 solveNumMeta e nv = case (e, vars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd tgt)]) -> do
-   -- Compute the value of the `tgt` variable from the known `src` value by invering nv
+   -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
    tgtSrc <- invertNatVal nv
-   -- If `nv` is *just* a variable, invertNatVal will return `src`. We need to
-   -- catch this because defining x := x will cause eval to loop.
-   unless (ExEnd src == toEnd tgtSrc) $
-     (defineSrc (NamedPort src "") (VNum (const (VPar (ExEnd tgtSrc)) <$> nv)))
-   defineTgt (NamedPort tgt "") (VNum (nVar tgtSrc))
-   wire (tgtSrc, TNat, NamedPort tgt "")
+   defineSrc (NamedPort src "") (VNum (nVar (VPar (toEnd tgtSrc))))
+   wire (NamedPort src "", TNat, tgtSrc)
 
- (ExEnd src, _) -> defineSrc (NamedPort src "") nv
+ (ExEnd src, _) -> defineSrc (NamedPort src "") (VNum nv)
 
  -- Both targets, we need to create the thing that they both derive from
  (InEnd tgt1, [VPar (InEnd tgt2)]) -> do
@@ -236,7 +232,7 @@ solveNumMeta e nv = case (e, vars nv) of
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
    src <- buildNatVal nv
-   defineTgt (NamedPort tgt "") nv
+   defineTgt (NamedPort tgt "") (VNum nv)
    wire (src, TNat, NamedPort tgt "")
 
  where
@@ -245,6 +241,7 @@ solveNumMeta e nv = case (e, vars nv) of
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
+-- ...But we don't need to do any wiring here, right?
 unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
@@ -284,17 +281,18 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
-  demandSucc sm@(StrictMono k (Linear (VPar (ExEnd x)))) = do
+  demandSucc sm@(StrictMono k (Linear (VPar (ExEnd x)))) = error "Todo..." {-do
+    -- This is sus because we don't have any tgt?
     ySrc <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
     let y = nVar (VPar (toEnd ySrc))
     solveNumMeta (ExEnd x) (nPlus 1 y)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
+  -}
 
-  demandSucc sm@(StrictMono k (Linear (VPar (InEnd x)))) = do
-    yTgt <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
-    let y = nVar (VPar (toEnd yTgt))
-    solveNumMeta (InEnd x) (nPlus 1 y)
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
+  demandSucc sm@(StrictMono k (Linear (VPar (InEnd weeEnd)))) = do
+    bigEnd <- invertNatVal (NumValue 1 (StrictMonoFun sm))
+    solveNumMeta (toEnd bigEnd) (NumValue 0 (StrictMonoFun sm))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (InEnd weeEnd)))
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
@@ -314,11 +312,11 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
-        half <- invertNatVal (NamedPort out "") (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear ()))))
+        half <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
         solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd half))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
       Linear (VPar (InEnd tgt)) -> do
-        halfTgt <- buildNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear tgt))))
+        halfTgt <- buildNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd tgt))))))
         let half = nVar (VPar (toEnd halfTgt))
         solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
@@ -330,13 +328,15 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
         -- compute (/2) . (-1)
-        halfSrc <- invertNatVal (NamedPort out "") (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear ()))))
-        solveNumMeta (ExEnd out) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
-        pure (nVar (VPar (toEnd halfSrc)))
-      Linear (VPar (InEnd tgt)) -> do
-        flooredHalfTgt <- buildNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd tgt))))))
-        let flooredHalf = nVar (VPar (toEnd flooredHalfTgt))
-        solveNumMeta (InEnd tgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
+        doubTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 mono)))
+        let [VPar (InEnd halfTgt)] = foldMap pure mono
+        solveNumMeta (toEnd doubTgt) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
+        pure (nVar (VPar (toEnd halfTgt)))
+      Linear (VPar (InEnd weeTgt)) -> do
+        -- compute (/2) . (-1)
+        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
+        let flooredHalf = nVar (VPar (toEnd weeTgt))
+        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
         pure flooredHalf
 
       -- full(n + 1) = 1 + 2 * full(n)

From 3b36023441308eaab582da4a8c9a1cffaf2f0e43 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 4 Oct 2024 12:43:11 +0100
Subject: [PATCH 069/182] Refactor typeEqEta

---
 brat/Brat/Checker/SolveHoles.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 199afda5..3050aeeb 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -14,7 +14,7 @@ import Bwd
 import Hasochism
 import Util (zip_same_length)
 
-import Control.Monad (filterM, unless)
+import Control.Monad (filterM, unless, (>=>))
 import Data.Foldable (traverse_)
 import Data.Functor
 import Data.Maybe (catMaybes)
@@ -70,15 +70,16 @@ typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = [e | (VApp (VPar e) _) <- [exp,act]] ++ catMaybes [getNumVar n | VNum n <- [exp, act]]
+  let ends = catMaybes $ [exp,act] <&> getEnd
   unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
-  filterM shouldWait ends >>= \case
+  filterM (isSkolem >=> pure . not) ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     es -> -- tricky: must wait for one or other to become more defined
       mkYield "typeEqEta" (S.fromList es) >> typeEq tm stuff k exp act
  where
-  shouldWait :: End -> Checking Bool
-  shouldWait e = isSkolem e <&> not
+  getEnd (VApp (VPar e) _) = Just e
+  getEnd (VNum n) = getNumVar n
+  getEnd _ = Nothing
 
 -- This will update the hopeSet, potentially invalidating things that have been eval'd
 -- The Sem is closed, for now.

From 3e15acc780e1d2ac60de85eb48dcea05378cab70 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 4 Oct 2024 14:00:28 +0100
Subject: [PATCH 070/182] typeEqEta: fast-path without blocking for both ends
 the same

---
 brat/Brat/Checker/SolveHoles.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 3050aeeb..01409912 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -74,6 +74,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
   filterM (isSkolem >=> pure . not) ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
+    [e1, e2] | e1 == e2 -> pure () -- trivially same, even if they're both still yet-to-be-defined
     es -> -- tricky: must wait for one or other to become more defined
       mkYield "typeEqEta" (S.fromList es) >> typeEq tm stuff k exp act
  where

From a900ac46d69ca4ccf8f25b2f78e56c4c84c1e7e3 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Oct 2024 20:43:06 +0100
Subject: [PATCH 071/182] typeEqEta shouldWait for ends inside nums as well,
 assert -> unless

---
 brat/Brat/Checker/SolveHoles.hs |  7 ++++---
 brat/Brat/Eval.hs               | 17 +++++++++--------
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index e8ed479c..199afda5 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -14,10 +14,10 @@ import Bwd
 import Hasochism
 import Util (zip_same_length)
 
-import Control.Exception (assert)
-import Control.Monad (filterM)
+import Control.Monad (filterM, unless)
 import Data.Foldable (traverse_)
 import Data.Functor
+import Data.Maybe (catMaybes)
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
@@ -70,7 +70,8 @@ typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = [e | (VApp (VPar e) _) <- [exp,act], assert (not $ M.member e hopeSet) True]
+  let ends = [e | (VApp (VPar e) _) <- [exp,act]] ++ catMaybes [getNumVar n | VNum n <- [exp, act]]
+  unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
   filterM shouldWait ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     es -> -- tricky: must wait for one or other to become more defined
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index e06397aa..4c3b75fb 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -17,6 +17,7 @@ module Brat.Eval (EvMode(..)
                  ,kindType
                  ,numVal
                  ,quote
+                 ,getNumVar
                  ) where
 
 import Brat.Checker.Monad
@@ -298,6 +299,14 @@ eqTests tm lvkz = go
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "
                    ++ show us ++ "\n  " ++ show vs
 
+getNumVar :: NumVal (VVar n) -> Maybe End
+getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
+  Linear v -> case v of
+    VPar e -> Just e
+    _ -> Nothing
+  Full sm -> getNumVar (numValue sm)
+getNumVar _ = Nothing
+
 -- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
 -- We can have bogus failures here because we're not normalising under lambdas
 -- N.B. the value argument is normalised.
@@ -305,14 +314,6 @@ doesntOccur :: End -> Val n -> Either ErrorMsg ()
 doesntOccur e (VNum nv) = case getNumVar nv of
   Just e' -> collision e e'
   _ -> pure ()
- where
-  getNumVar :: NumVal (VVar n) -> Maybe End
-  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear v -> case v of
-      VPar e -> Just e
-      _ -> Nothing
-    Full sm -> getNumVar (numValue sm)
-  getNumVar _ = Nothing
 doesntOccur e (VApp var args) = case var of
   VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
   _ -> pure ()

From 3bf4f0bfee5fa0a8792f2358ca459a03296bdaed Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 4 Oct 2024 12:43:11 +0100
Subject: [PATCH 072/182] Refactor typeEqEta

---
 brat/Brat/Checker/SolveHoles.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 199afda5..3050aeeb 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -14,7 +14,7 @@ import Bwd
 import Hasochism
 import Util (zip_same_length)
 
-import Control.Monad (filterM, unless)
+import Control.Monad (filterM, unless, (>=>))
 import Data.Foldable (traverse_)
 import Data.Functor
 import Data.Maybe (catMaybes)
@@ -70,15 +70,16 @@ typeEqEta _ (Zy :* _ :* _) hopeSet Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = [e | (VApp (VPar e) _) <- [exp,act]] ++ catMaybes [getNumVar n | VNum n <- [exp, act]]
+  let ends = catMaybes $ [exp,act] <&> getEnd
   unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
-  filterM shouldWait ends >>= \case
+  filterM (isSkolem >=> pure . not) ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     es -> -- tricky: must wait for one or other to become more defined
       mkYield "typeEqEta" (S.fromList es) >> typeEq tm stuff k exp act
  where
-  shouldWait :: End -> Checking Bool
-  shouldWait e = isSkolem e <&> not
+  getEnd (VApp (VPar e) _) = Just e
+  getEnd (VNum n) = getNumVar n
+  getEnd _ = Nothing
 
 -- This will update the hopeSet, potentially invalidating things that have been eval'd
 -- The Sem is closed, for now.

From 2c8f26ba640464af15fecfb888c3fe39fe8d3b8c Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 4 Oct 2024 14:00:28 +0100
Subject: [PATCH 073/182] typeEqEta: fast-path without blocking for both ends
 the same

---
 brat/Brat/Checker/SolveHoles.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 3050aeeb..01409912 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -74,6 +74,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopeSet k exp act = do
   unless (not $ any (flip M.member hopeSet) ends) $ typeErr "ends were in hopeset"
   filterM (isSkolem >=> pure . not) ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
+    [e1, e2] | e1 == e2 -> pure () -- trivially same, even if they're both still yet-to-be-defined
     es -> -- tricky: must wait for one or other to become more defined
       mkYield "typeEqEta" (S.fromList es) >> typeEq tm stuff k exp act
  where

From 42ef6d383fb358809f0c3ffa1fec62a7dd060874 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 4 Oct 2024 15:11:11 +0100
Subject: [PATCH 074/182] Call eval after resumption in simpleCheck

---
 brat/Brat/Checker/Helpers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 40356d85..26953f09 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -40,7 +40,10 @@ simpleCheck my ty tm = case (my, ty) of
         Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
     else isSkolem e >>= \case
       True -> throwLeft $ helper Braty ty tm
-      False -> mkYield "simpleCheck" (S.singleton e) >> simpleCheck Braty ty tm
+      False -> do
+        mkYield "simpleCheck" (S.singleton e)
+        ty <- eval S0 ty
+        simpleCheck Braty ty tm
   _ -> throwLeft $ helper my ty tm
  where
   helper :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()

From 55178541103ca553f3e393d95b9800adcd074136 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 7 Oct 2024 11:28:43 +0100
Subject: [PATCH 075/182] SolvePatterns build fixes

---
 brat/Brat/Checker/SolvePatterns.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 583e8d80..65de73d0 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -210,7 +210,7 @@ instantiateMeta e val = do
 solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
 solveNumMeta e nv = case (e, vars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
- (ExEnd src,  [VPar (InEnd tgt)]) -> do
+ (ExEnd src,  [VPar (InEnd _)]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
    tgtSrc <- invertNatVal nv
    defineSrc (NamedPort src "") (VNum (nVar (VPar (toEnd tgtSrc))))
@@ -282,7 +282,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
-  demandSucc sm@(StrictMono k (Linear (VPar (ExEnd x)))) = error "Todo..." {-do
+  demandSucc (StrictMono _ (Linear (VPar (ExEnd _)))) = error "Todo..." {-do
     -- This is sus because we don't have any tgt?
     ySrc <- invertNatVal (NamedPort x "") (NumValue 1 (StrictMonoFun sm))
     let y = nVar (VPar (toEnd ySrc))
@@ -327,7 +327,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar (ExEnd out)) -> do
+      Linear (VPar (ExEnd _)) -> do
         -- compute (/2) . (-1)
         doubTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 mono)))
         let [VPar (InEnd halfTgt)] = foldMap pure mono

From 4f8099b6242366000f8e3b35d9b16c9f2a7eaf4d Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 21 Oct 2024 11:07:55 +0100
Subject: [PATCH 076/182] Comment out mapVec

---
 brat/examples/infer.brat | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index dacdb0a7..6eeab947 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -2,6 +2,7 @@ map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
 map(_, _, _, []) = []
 map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 
-mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
-mapVec(_, _, _, _, []) = []
-mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+-- This not working at the moment, see https://github.com/CQCL/brat/issues/35
+--mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
+--mapVec(_, _, _, _, []) = []
+--mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)

From 9203cb6ce4ddc8d2b7ba7d110acd61db1891fc15 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 21 Oct 2024 11:24:32 +0100
Subject: [PATCH 077/182] Fix checking of infer.brat w/note, add more.
 Compilation fails on Pow ?!

---
 brat/examples/infer.brat | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index 6eeab947..c0996697 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -2,7 +2,17 @@ map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
 map(_, _, _, []) = []
 map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 
--- This not working at the moment, see https://github.com/CQCL/brat/issues/35
---mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
---mapVec(_, _, _, _, []) = []
---mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+-- The "succ" being required in all 3 of these cases is https://github.com/CQCL/brat/issues/35
+mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
+mapVec(_, _, _, _, []) = []
+mapVec(_, _, f, succ(_), x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+
+-- While map above can infer the holes from the other arguments,
+-- here we need to infer the holes (arguments) from the results:
+repeat(X :: *, n :: #, x :: X) -> Vec(X, n)
+repeat(_, 0, _) = []
+repeat(_, succ(_), x) = x ,- repeat(!, !, x) -- X can be inferred from x but n cannot
+
+mapFirst(X :: *, Y :: *, { X -> Y}, n :: #, Vec(X, n)) -> Vec(Y, n)
+mapFirst(_, _, _, _, []) = []
+mapFirst(_, _, f, succ(_), x ,- _) = repeat(!, !, f(x)) -- first ! (X) is second _ (Y)
\ No newline at end of file

From 95dad0f0b79282b2976900afc08a2ce3d696c212 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 21 Oct 2024 11:24:37 +0100
Subject: [PATCH 078/182] Revert "TEMP remove failure tests"

This reverts commit 251455ba383a5a433eaee494fd9cbdd5504d0809.
---
 brat/test/Main.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 1226b226..fc9b2389 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -59,7 +59,7 @@ coroT2 = do
 
 
 main = do
-  --failureTests  <- getFailureTests
+  failureTests  <- getFailureTests
   checkingTests <- getCheckingTests
   parsingTests <- getParsingTests
   compilationTests <- setupCompilationTests
@@ -69,7 +69,7 @@ main = do
        ,testCase "coroT2" $ assertCheckingFail "Typechecking blocked on" coroT2
        ]
   defaultMain $ testGroup "All" [graphTests
-                                --,failureTests
+                                ,failureTests
                                 ,checkingTests
                                 ,letTests
                                 ,libDirTests

From 352e9f88a7dd8461f9a5e8ffa7922d33271771d5 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 22 Nov 2024 10:55:31 +0000
Subject: [PATCH 079/182] Fix infer.brat, no need to multiply by 2^0

---
 brat/Brat/Checker/SolveHoles.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 2ceec4e3..df483bf0 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -184,6 +184,7 @@ buildNatVal nv@(NumValue n gro) = case n of
   buildGro (StrictMonoFun sm) = buildSM sm
 
   buildSM :: StrictMono (VVar Z) -> Checking Src
+  buildSM (StrictMono 0 mono) = buildMono mono
   buildSM (StrictMono k mono) = do
     -- Calculate 2^k as `factor`
     two <- buildNum 2

From 7c20289be7d162a13befe071c21db0cee1a1dc31 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 22 Nov 2024 15:53:21 +0000
Subject: [PATCH 080/182] Fix bad merge, check against HopeSet before vectorise
 not after

---
 brat/Brat/Checker/Helpers.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index fbd550f1..f929f17e 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -268,23 +268,21 @@ getThunks :: Modey m
                       ,Overs m UVerb
                       )
 getThunks _ [] = pure ([], [], [])
-getThunks Braty row@((src, Right ty):rest) = (eval S0 ty >>= vectorise . (src,)) >>= \case
-  (src, VFun Braty (ss :->> ts)) -> do
+getThunks Braty row@((src, Right ty):rest) = req AskHopeSet >>= \h -> eval S0 ty >>= \case
+  VApp (VPar e) _ | M.member e h -> mkYield "getThunks" (S.singleton e) >> getThunks Braty row
+  ty -> do
+    (src, VFun Braty (ss :->> ts)) <- vectorise (src, ty)
     (node, unders, overs, _) <- let ?my = Braty in
                                   anext "" (Eval (end src)) (S0, Some (Zy :* S0)) ss ts
     (nodes, unders', overs') <- getThunks Braty rest
     pure (node:nodes, unders <> unders', overs <> overs')
-  (_, VFun _ _) -> err $ ExpectedThunk (showMode Braty) (showRow row) -- Shouldn't happen
-  (_, v) -> do
-    h <- req AskHopeSet
-    case v of
-      VApp (VPar e) _ | M.member e h -> mkYield "getThunks" (S.singleton e) >> getThunks Braty row
-      _ -> typeErr $ "Force called on non-thunk: " ++ show v
+-- TODO we probably want to check against the HopeSet here too, good to refactor+common-up somehow
 getThunks Kerny row@((src, Right ty):rest) = (eval S0 ty >>= vectorise . (src,)) >>= \case
   (src, VFun Kerny (ss :->> ts)) -> do
     (node, unders, overs, _) <- let ?my = Kerny in anext "" (Splice (end src)) (S0, Some (Zy :* S0)) ss ts
     (nodes, unders', overs') <- getThunks Kerny rest
     pure (node:nodes, unders <> unders', overs <> overs')
+  -- These shouldn't happen (as this is return value of vectorise - can we return something more specific?)
   (_, VFun _ _) -> err $ ExpectedThunk (showMode Kerny) (showRow row)
   v -> typeErr $ "Force called on non-(kernel)-thunk: " ++ show v
 getThunks Braty ((src, Left (Star args)):rest) = do

From f7839231f73aada908d6d64edfdbbef043b74b18 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 18 Dec 2024 14:14:28 +0000
Subject: [PATCH 081/182] Add hole solving but not for nats

---
 brat/Brat/Checker.hs                          |  29 +++-
 brat/Brat/Checker/Helpers.hs                  |   5 +
 brat/Brat/Checker/Monad.hs                    |  16 ++
 brat/Brat/Checker/SolveHoles.hs               | 160 ++++++++++++++++++
 brat/Brat/Checker/SolvePatterns.hs            |  38 +----
 brat/Brat/Elaborator.hs                       |   1 +
 brat/Brat/Error.hs                            |   3 +-
 brat/Brat/Eval.hs                             |  58 +++++--
 brat/Brat/Lexer/Flat.hs                       |   1 +
 brat/Brat/Lexer/Token.hs                      |   2 +
 brat/Brat/Parser.hs                           |   1 +
 brat/Brat/Syntax/Common.hs                    |   2 +-
 brat/Brat/Syntax/Concrete.hs                  |   1 +
 brat/Brat/Syntax/Core.hs                      |   3 +
 brat/Brat/Syntax/Raw.hs                       |   3 +
 brat/Brat/Unelaborator.hs                     |   2 +
 brat/brat.cabal                               |   1 +
 brat/examples/infer.brat                      |   8 +
 brat/test/golden/error/remaining_hopes.brat   |   5 +
 .../golden/error/remaining_hopes.brat.golden  |   8 +
 20 files changed, 292 insertions(+), 55 deletions(-)
 create mode 100644 brat/Brat/Checker/SolveHoles.hs
 create mode 100644 brat/examples/infer.brat
 create mode 100644 brat/test/golden/error/remaining_hopes.brat
 create mode 100644 brat/test/golden/error/remaining_hopes.brat.golden

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index ffee325f..3b317be0 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -25,6 +25,7 @@ import Prelude hiding (filter)
 import Brat.Checker.Helpers
 import Brat.Checker.Monad
 import Brat.Checker.Quantity
+import Brat.Checker.SolveHoles (typeEq)
 import Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
 import Brat.Checker.Types
 import Brat.Constructors
@@ -659,7 +660,13 @@ check' (Of n e) ((), unders) = case ?my of
       (elems, unders, rightUnders) <- getVecs len unders
       pure ((tgt, el):elems, (tgt, ty):unders, rightUnders)
   getVecs _ unders = pure ([], [], unders)
-
+check' Hope ((), (NamedPort hope _, ty):unders) = case (?my, ty) of
+  (Braty, Left _k) -> do
+    fc <- req AskFC
+    req (ANewHope hope fc)
+    pure (((), ()), ((), unders))
+  (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
+  (Kerny, _) -> typeErr "Won't infer kernel typed !"
 check' tm _ = error $ "check' " ++ show tm
 
 
@@ -1124,7 +1131,7 @@ run :: VEnv
     -> Namespace
     -> Checking a
     -> Either Error (a, ([TypedHole], Store, Graph))
-run ve initStore ns m =
+run ve initStore ns m = do
   let ctx = Ctx { globalVEnv = ve
                 , store = initStore
                 -- TODO: fill with default constructors
@@ -1132,5 +1139,19 @@ run ve initStore ns m =
                 , kconstructors = kernelConstructors
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
-                } in
-    (\(a,ctx,(holes, graph)) -> (a, (holes, store ctx, graph))) <$> handler (localNS ns m) ctx mempty
+                , hopes = M.empty
+                }
+  (a,ctx,(holes, graph)) <- handler (localNS ns m) ctx mempty
+  let tyMap = typeMap $ store ctx
+  -- If the `hopes` set has any remaining holes with kind Nat, we need to abort.
+  -- Even though we didn't need them for typechecking problems, our runtime
+  -- behaviour depends on the values of the holes, which we can't account for.
+  case M.toList $ M.filterWithKey (\e _ -> isNatKinded tyMap (InEnd e)) (hopes ctx) of
+    [] -> pure (a, (holes, store ctx, graph))
+    -- Just use the FC of the first hole while we don't have the capacity to
+    -- show multiple error locations
+    hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
+ where
+  isNatKinded tyMap e = case tyMap M.! e of
+    EndType Braty (Left Nat) -> True
+    _ -> False
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index f58ac827..d792a0a4 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -492,3 +492,8 @@ runArith (NumValue upl grol) Pow (NumValue upr gror)
  -- 2^(2^k * upr) + 2^(2^k * upr) * (full(2^(k + k') * mono))
  = pure $ NumValue (upl ^ upr) (StrictMonoFun (StrictMono (l * upr) (Full (StrictMono (k + k') mono))))
 runArith _ _ _ = Nothing
+
+buildConst :: SimpleTerm -> Val Z -> Checking Src
+buildConst tm ty = do
+  (_, _, [(out,_)], _) <- next "buildConst" (Const tm) (S0, Some (Zy :* S0)) R0 (RPr ("value", ty) R0)
+  pure out
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index e993711b..cb9fd015 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -50,12 +50,16 @@ data CtxEnv = CtxEnv
   , locals :: VEnv
   }
 
+type Hopes = M.Map InPort FC
+
 data Context = Ctx { globalVEnv :: VEnv
                    , store :: Store
                    , constructors :: ConstructorMap Brat
                    , kconstructors :: ConstructorMap Kernel
                    , typeConstructors :: M.Map (Mode, QualName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map QualName Alias
+                   -- All the ends here should be targets
+                   , hopes :: Hopes
                    }
 
 data CheckingSig ty where
@@ -89,6 +93,9 @@ data CheckingSig ty where
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
   Define  :: End -> Val Z -> CheckingSig ()
+  ANewHope :: InPort -> FC -> CheckingSig ()
+  AskHopes :: CheckingSig Hopes
+  RemoveHope :: InPort -> CheckingSig ()
 
 localAlias :: (QualName, Alias) -> Checking v -> Checking v
 localAlias _ (Ret v) = Ret v
@@ -267,6 +274,15 @@ handler (Req s k) ctx g
                 M.lookup tycon tbl
         handler (k args) ctx g
 
+      ANewHope e fc -> handler (k ()) (ctx { hopes = M.insert e fc (hopes ctx) }) g
+
+      AskHopes -> handler (k (hopes ctx)) ctx g
+
+      RemoveHope e -> let hset = hopes ctx in
+                        if M.member e hset
+                        then handler (k ()) (ctx { hopes = M.delete e hset }) g
+                        else Left (dumbErr (InternalError ("Trying to remove Hope not in set: " ++ show e)))
+
 type Checking = Free CheckingSig
 
 instance Semigroup a => Semigroup (Checking a) where
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
new file mode 100644
index 00000000..8711006a
--- /dev/null
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -0,0 +1,160 @@
+module Brat.Checker.SolveHoles (typeEq) where
+
+import Brat.Checker.Helpers (buildConst)
+import Brat.Checker.Monad
+import Brat.Checker.Types (kindForMode)
+import Brat.Error (ErrorMsg(..))
+import Brat.Eval
+import Brat.Syntax.Common
+import Brat.Syntax.Simple (SimpleTerm(..))
+import Brat.Syntax.Value
+import Control.Monad.Freer
+import Bwd
+import Hasochism
+import Util (zipSameLength)
+
+import Data.Bifunctor (second)
+import Data.Foldable (sequenceA_)
+import Data.Functor
+import qualified Data.Map as M
+import Data.Type.Equality (TestEquality(..), (:~:)(..))
+
+-- External interface to typeEq' for closed values only.
+typeEq :: String -- String representation of the term for error reporting
+       -> TypeKind -- The kind we're comparing at
+       -> Val Z -- Expected
+       -> Val Z -- Actual
+       -> Checking ()
+typeEq str = typeEq' str (Zy :* S0 :* S0)
+
+-- Demand that two things are equal, we're allowed to solve variables in the
+-- hope set to make this true.
+-- Raises a user error if the vals cannot be made equal.
+typeEq' :: String -- String representation of the term for error reporting
+        -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+        -> TypeKind -- The kind we're comparing at
+        -> Val n -- Expected
+        -> Val n -- Actual
+        -> Checking ()
+typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
+  hopes <- req AskHopes
+  exp <- sem sems exp
+  act <- sem sems act
+  typeEqEta str stuff hopes k exp act
+
+isNumVar :: Sem -> Maybe SVar
+isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
+isNumVar _ = Nothing
+
+-- Presumes that the hope set and the two `Sem`s are up to date.
+typeEqEta :: String -- String representation of the term for error reporting
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+          -> Hopes -- A map from the hope set to corresponding FCs
+          -> TypeKind -- The kind we're comparing at
+          -> Sem -- Expected
+          -> Sem -- Actual
+          -> Checking ()
+typeEqEta tm (lvy :* kz :* sems) hopes (TypeFor m ((_, k):ks)) exp act = do
+  -- Higher kinded things
+  let nextSem = semLvl lvy
+  let xz = B0 :< nextSem
+  exp <- applySem exp xz
+  act <- applySem act xz
+  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) hopes (TypeFor m ks) exp act
+-- Not higher kinded - check for flex terms
+-- (We don't solve under binders for now, so we only consider Zy here)
+-- 1. "easy" flex cases
+typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
+  | M.member e hopes = solveHope k e act
+typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
+  | M.member e hopes = solveHope k e exp
+typeEqEta _ (Zy :* _ :* _) hopes Nat exp act
+  | Just (SPar (InEnd e)) <- isNumVar exp, M.member e hopes = solveHope Nat e act
+  | Just (SPar (InEnd e)) <- isNumVar act, M.member e hopes = solveHope Nat e exp
+-- 2. harder cases, neither is in the hope set, so we can't define it ourselves
+typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
+  exp <- quote ny exp
+  act <- quote ny act
+  case [e | (VApp (VPar (InEnd e)) _) <- [exp,act], M.member e hopes] of
+    [] -> typeEqRigid tm stuff k exp act
+    [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
+    _es -> error "TODO: must wait for one or the other to become more defined"
+
+-- This will update the `hopes` set, potentially invalidating things that have
+-- been eval'd.
+-- The Sem is closed, for now.
+solveHope :: TypeKind -> InPort -> Sem -> Checking ()
+solveHope k hope v = quote Zy v >>= \v -> case doesntOccur (InEnd hope) v of
+  Right () -> do
+    defineEnd (InEnd hope) v
+    dangling <- case (k, v) of
+      (Nat, VNum _v) -> err $ Unimplemented "Nat hope solving" []
+      (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
+      _ -> buildConst Unit TUnit
+    req (Wire (end dangling, kindType k, hope))
+    req (RemoveHope hope)
+  Left msg -> case v of
+    VApp (VPar (InEnd end)) B0 | hope == end -> pure ()
+    -- TODO: Not all occurrences are toxic. The end could be in an argument
+    -- to a hoping variable which isn't used.
+    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
+    _ -> err msg
+
+typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
+typeEqs _ _ [] [] [] = pure ()
+typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq' tm stuff k exp act
+typeEqs _ _ _ _ _ = typeErr "arity mismatch"
+
+typeEqRow :: Modey m
+          -> String -- The term we complain about in errors
+          -> (Ny :* Stack Z TypeKind :* Stack Z Sem) lv -- Next available level, the kinds of existing levels
+          -> Ro m lv top0
+          -> Ro m lv top1
+          -> Either ErrorMsg (Some ((Ny :* Stack Z TypeKind :* Stack Z Sem) -- The new stack of kinds and fresh level
+                                   :* ((:~:) top0 :* (:~:) top1)) -- Proofs both input rows have same length (quantified over by Some)
+                             ,[Checking ()] -- subproblems to run in parallel
+                             )
+typeEqRow _ _ stuff R0 R0 = pure (Some (stuff :* (Refl :* Refl)), [])
+typeEqRow m tm stuff (RPr (_,ty1) ro1) (RPr (_,ty2) ro2) = typeEqRow m tm stuff ro1 ro2 <&> second
+  ((:) (typeEq' tm stuff (kindForMode m) ty1 ty2))
+typeEqRow m tm (ny :* kz :* semz) (REx (_,k1) ro1) (REx (_,k2) ro2) | k1 == k2 = typeEqRow m tm (Sy ny :* (kz :<< k1) :* (semz :<< semLvl ny)) ro1 ro2
+typeEqRow _ _ _ _ _ = Left $ TypeErr "Mismatched rows"
+
+-- Calls to typeEqRigid *must* start with rigid types to ensure termination
+typeEqRigid :: String -- String representation of the term for error reporting
+            -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
+            -> TypeKind -- The kind we're comparing at
+            -> Val n -- Expected
+            -> Val n -- Actual
+            -> Checking ()
+typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
+  -- TODO: What if there's hope in the numbers?
+  exp <- sem semz exp
+  act <- sem semz act
+  if getNum exp == getNum act
+  then pure ()
+  else err $ TypeMismatch tm (show exp) (show act)
+typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
+  svKind f >>= \case
+    TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
+      -- pattern should always match
+    _ -> err $ InternalError "quote gave a surprising result"
+ where
+  svKind (VPar e) = kindOf (VPar e)
+  svKind (VInx n) = pure $ proj kz n
+typeEqRigid tm lvkz (TypeFor m []) (VCon c args) (VCon c' args') | c == c' =
+  req (TLup (m, c)) >>= \case
+        Just ks -> typeEqs tm lvkz (snd <$> ks) args args'
+        Nothing -> err $ TypeErr $ "Type constructor " ++ show c
+                        ++ " undefined " ++ " at kind " ++ show (TypeFor m [])
+typeEqRigid tm lvkz (Star []) (VFun m0 (ins0 :->> outs0)) (VFun m1 (ins1 :->> outs1)) | Just Refl <- testEquality m0 m1 = do
+  probs :: [Checking ()] <- throwLeft $ typeEqRow m0 tm lvkz ins0 ins1 >>= \case -- this is in Either ErrorMsg
+        (Some (lvkz :* (Refl :* Refl)), ps1) -> typeEqRow m0 tm lvkz outs0 outs1 <&> (ps1++) . snd
+  sequenceA_ probs -- uses Applicative (unlike sequence_ which uses Monad), hence parallelized
+typeEqRigid tm lvkz (TypeFor _ []) (VSum m0 rs0) (VSum m1 rs1)
+  | Just Refl <- testEquality m0 m1 = case zipSameLength rs0 rs1 of
+      Nothing -> typeErr "Mismatched sum lengths"
+      Just rs -> traverse eqVariant rs >>= (sequenceA_ . concat)
+ where
+  eqVariant (Some r0, Some r1) = throwLeft (snd <$> typeEqRow m0 tm lvkz r0 r1)
+typeEqRigid tm _ _ v0 v1 = err $ TypeMismatch tm (show v0) (show v1)
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index d9034655..362bfea5 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -19,7 +19,6 @@ import Hasochism
 
 import Control.Monad (unless)
 import Data.Bifunctor (first)
-import Data.Foldable (for_, traverse_)
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Data.Type.Equality ((:~:)(..), testEquality)
@@ -78,7 +77,7 @@ solve my ((src, Lit tm):p) = do
     (Braty, Left Nat)
       | Num n <- tm -> do
           unless (n >= 0) $ typeErr "Negative Nat kind"
-          unifyNum (nConstant (fromIntegral n)) (nVar (VPar (ExEnd (end src))))
+          unifyNum (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
     (Braty, Right ty) -> do
       throwLeft (simpleCheck Braty ty tm)
     _ -> typeErr $ "Literal " ++ show tm ++ " isn't valid at this type"
@@ -97,7 +96,7 @@ solve my ((src, PCon c abs):p) = do
       -- Special case for 0, so that we can call `unifyNum` instead of pattern
       -- matching using what's returned from `natConstructors`
       PrefixName [] "zero" -> do
-        unifyNum (nVar (VPar (ExEnd (end src)))) nZero
+        unifyNum (nVar (VPar (toEnd src))) nZero
         p <- argProblems [] (normaliseAbstractor abs) p
         (tests, sol) <- solve my p
         pure ((src, PrimLitTest (Num 0)):tests, sol)
@@ -108,7 +107,7 @@ solve my ((src, PCon c abs):p) = do
             (REx ("inner", Nat) R0)
           unifyNum
            (nVar (VPar (ExEnd (end src))))
-           (relationToInner (nVar (VPar (ExEnd (end dangling)))))
+           (relationToInner (nVar (VPar (toEnd dangling))))
           p <- argProblems [dangling] (normaliseAbstractor abs) p
           (tests, sol) <- solve my p
           -- When we get @-patterns, we shouldn't drop this anymore
@@ -199,38 +198,7 @@ instantiateMeta e val = do
   defineEnd e val
 
 
--- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
--- We can have bogus failures here because we're not normalising under lambdas
--- N.B. the value argument is normalised.
-doesntOccur :: End -> Val n -> Either ErrorMsg ()
-doesntOccur e (VNum nv) = for_ (getNumVar nv) (collision e)
  where
-  getNumVar :: NumVal (VVar n) -> Maybe End
-  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear v -> case v of
-      VPar e -> Just e
-      _ -> Nothing
-    Full sm -> getNumVar (numValue sm)
-  getNumVar _ = Nothing
-doesntOccur e (VApp var args) = case var of
-  VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
-  _ -> pure ()
-doesntOccur e (VCon _ args) = traverse_ (doesntOccur e) args
-doesntOccur e (VLam body) = doesntOccur e body
-doesntOccur e (VFun my (ins :->> outs)) = case my of
-  Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
-  Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
-doesntOccur e (VSum my rows) = traverse_ (\(Some ro) -> doesntOccurRo my e ro) rows
-
-collision :: End -> End -> Either ErrorMsg ()
-collision e v | e == v = Left . UnificationError $
-                         show e ++ " is cyclic"
-              | otherwise = pure ()
-
-doesntOccurRo :: Modey m -> End -> Ro m i j -> Either ErrorMsg ()
-doesntOccurRo _ _ R0 = pure ()
-doesntOccurRo my e (RPr (_, ty) ro) = doesntOccur e ty *> doesntOccurRo my e ro
-doesntOccurRo Braty e (REx _ ro) = doesntOccurRo Braty e ro
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
diff --git a/brat/Brat/Elaborator.hs b/brat/Brat/Elaborator.hs
index da34e09b..5a4ed219 100644
--- a/brat/Brat/Elaborator.hs
+++ b/brat/Brat/Elaborator.hs
@@ -91,6 +91,7 @@ elaborate (WC fc x) = do
 
 elaborate' :: Flat -> Either Error SomeRaw'
 elaborate' (FVar x) = pure $ SomeRaw' (RVar x)
+elaborate' FHope = pure $ SomeRaw' RHope
 elaborate' (FArith op a b) = do
   (SomeRaw a) <- elaborate a
   (SomeRaw b) <- elaborate b
diff --git a/brat/Brat/Error.hs b/brat/Brat/Error.hs
index f34dba14..fc8a841f 100644
--- a/brat/Brat/Error.hs
+++ b/brat/Brat/Error.hs
@@ -83,6 +83,7 @@ data ErrorMsg
  -- The argument is the row of unused connectors
  | ThunkLeftOvers String
  | ThunkLeftUnders String
+ | RemainingNatHopes [String]
 
 instance Show ErrorMsg where
   show (TypeErr x) = "Type error: " ++ x
@@ -166,7 +167,7 @@ instance Show ErrorMsg where
   show UnreachableBranch = "Branch cannot be reached"
   show (ThunkLeftOvers overs) = "Expected function to address all inputs, but " ++ overs ++ " wasn't used"
   show (ThunkLeftUnders unders) = "Expected function to return additional values of type: " ++ unders
-
+  show (RemainingNatHopes hs) = unlines ("Expected to work out values for these holes:":(("    " ++) <$> hs))
 
 data Error = Err { fc  :: Maybe FC
                  , msg :: ErrorMsg
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 52fff0e8..f9ae33d3 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -4,22 +4,27 @@ module Brat.Eval (EvMode(..)
                  ,ValPat(..)
                  ,NumPat(..)
                  ,apply
+                 ,applySem
                  ,eval
                  ,sem
+                 ,semLvl
+                 ,doesntOccur
                  ,evalCTy
                  ,eqTest
+                 ,getNum
                  ,kindEq
+                 ,kindOf
                  ,kindType
                  ,numVal
-                 ,typeEq
+                 ,quote
                  ) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Types (EndType(..), kindForMode)
 import Brat.Error (ErrorMsg(..))
 import Brat.QualName (plain)
-import Brat.Syntax.Value
 import Brat.Syntax.Common
+import Brat.Syntax.Value
 import Control.Monad.Freer (req)
 import Bwd
 import Hasochism
@@ -29,6 +34,7 @@ import Data.Bifunctor (second)
 import Data.Functor
 import Data.Kind (Type)
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
+import Data.Foldable (traverse_)
 
 kindType :: TypeKind -> Val Z
 kindType Nat = TNat
@@ -191,14 +197,8 @@ kindOf (VPar e) = req (TypeOf e) >>= \case
     Kerny -> show ty
 kindOf (VInx n) = case n of {}
 
--- We should have made sure that the two values share the given kind
-typeEq :: String -- String representation of the term for error reporting
-   -> TypeKind -- The kind we're comparing at
-   -> Val Z -- Expected
-   -> Val Z -- Actual
-   -> Checking ()
-typeEq str k exp act = eqTest str k exp act >>= throwLeft
-
+-------- for SolvePatterns usage: not allowed to solve hopes,
+-- and if pattern insoluble, it's not a type error (it's a "pattern match case unreachable")
 eqTest :: String -- String representation of the term for error reporting
        -> TypeKind -- The kind we're comparing at
        -> Val Z -- Expected
@@ -256,10 +256,7 @@ eqWorker tm lvkz (TypeFor _ []) (SSum m0 stk0 rs0) (SSum m1 stk1 rs1)
       Just rs -> traverse eqVariant rs <&> sequence_
  where
   eqVariant (Some r0, Some r1) = eqRowTest m0 tm lvkz (stk0,r0) (stk1,r1) <&> dropRight
-eqWorker tm _ _ s0 s1 = do
-  v0 <- quote Zy s0
-  v1 <- quote Zy s1
-  pure . Left $ TypeMismatch tm (show v0) (show v1)
+eqWorker tm _ _ v0 v1 = pure . Left $ TypeMismatch tm (show v0) (show v1)
 
 -- Type rows have bot0,bot1 dangling de Bruijn indices, which we instantiate with
 -- de Bruijn levels. As we go under binders in these rows, we add to the scope's
@@ -300,3 +297,36 @@ eqTests tm lvkz = go
     Left e -> pure $ Left e
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "
                    ++ show us ++ "\n  " ++ show vs
+
+-- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
+-- We can have bogus failures here because we're not normalising under lambdas
+-- N.B. the value argument is normalised.
+doesntOccur :: End -> Val n -> Either ErrorMsg ()
+doesntOccur e (VNum nv) = traverse_ (collision e) (getNumVar nv)
+ where
+  getNumVar :: NumVal (VVar n) -> Maybe End
+  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
+    Linear v -> case v of
+      VPar e -> Just e
+      _ -> Nothing
+    Full sm -> getNumVar (numValue sm)
+  getNumVar _ = Nothing
+doesntOccur e (VApp var args) = case var of
+  VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
+  _ -> pure ()
+doesntOccur e (VCon _ args) = traverse_ (doesntOccur e) args
+doesntOccur e (VLam body) = doesntOccur e body
+doesntOccur e (VFun my (ins :->> outs)) = case my of
+  Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
+  Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
+doesntOccur e (VSum my rows) = traverse_ (\(Some ro) -> doesntOccurRo my e ro) rows
+
+collision :: End -> End -> Either ErrorMsg ()
+collision e v | e == v = Left . UnificationError $
+                         show e ++ " is cyclic"
+              | otherwise = pure ()
+
+doesntOccurRo :: Modey m -> End -> Ro m i j -> Either ErrorMsg ()
+doesntOccurRo _ _ R0 = pure ()
+doesntOccurRo my e (RPr (_, ty) ro) = doesntOccur e ty *> doesntOccurRo my e ro
+doesntOccurRo Braty e (REx _ ro) = doesntOccurRo Braty e ro
diff --git a/brat/Brat/Lexer/Flat.hs b/brat/Brat/Lexer/Flat.hs
index 1f41d5ba..30fd6f62 100644
--- a/brat/Brat/Lexer/Flat.hs
+++ b/brat/Brat/Lexer/Flat.hs
@@ -87,6 +87,7 @@ tok = try (char '(' $> LParen)
       <|> try (string "-" $> Minus)
       <|> try (string "$" $> Dollar)
       <|> try (string "|" $> Pipe)
+      <|> try (string "!" $> Bang)
       <|> try (K <$> try keyword)
       <|> try qualified
       <|> Ident <$> ident
diff --git a/brat/Brat/Lexer/Token.hs b/brat/Brat/Lexer/Token.hs
index d5f8842b..80dca83b 100644
--- a/brat/Brat/Lexer/Token.hs
+++ b/brat/Brat/Lexer/Token.hs
@@ -43,6 +43,7 @@ data Tok
  | Dollar
  | Underscore
  | Pipe
+ | Bang
  | Cons
  | Snoc
  | ConcatEqEven
@@ -88,6 +89,7 @@ instance Show Tok where
   show Dollar = "$"
   show Underscore = "_"
   show Pipe = "|"
+  show Bang = "!"
   show Cons = ",-"
   show Snoc = "-,"
   show ConcatEqEven = "=,="
diff --git a/brat/Brat/Parser.hs b/brat/Brat/Parser.hs
index 494f193b..087a406a 100644
--- a/brat/Brat/Parser.hs
+++ b/brat/Brat/Parser.hs
@@ -515,6 +515,7 @@ expr' p = choice $ (try . getParser <$> enumFrom p) ++ [atomExpr]
               <|> var
               <|> match Underscore $> FUnderscore
               <|> match Pipe $> FIdentity
+              <|> match Bang $> FHope
 
 
 cnoun :: Parser Flat -> Parser (WC (Raw 'Chk 'Noun))
diff --git a/brat/Brat/Syntax/Common.hs b/brat/Brat/Syntax/Common.hs
index dacd8d1b..622c598d 100644
--- a/brat/Brat/Syntax/Common.hs
+++ b/brat/Brat/Syntax/Common.hs
@@ -111,7 +111,7 @@ instance Eq ty => Eq (TypeRowElem ty) where
   Anon ty == Anon ty' = ty == ty'
 
 data TypeKind = TypeFor Mode [(PortName, TypeKind)] | Nat | Row
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 pattern Star, Dollar :: [(PortName, TypeKind)] -> TypeKind
 pattern Star ks = TypeFor Brat ks
diff --git a/brat/Brat/Syntax/Concrete.hs b/brat/Brat/Syntax/Concrete.hs
index d2d567f6..3e07bb44 100644
--- a/brat/Brat/Syntax/Concrete.hs
+++ b/brat/Brat/Syntax/Concrete.hs
@@ -22,6 +22,7 @@ type FEnv = ([FDecl], [RawAlias])
 
 data Flat
  = FVar QualName
+ | FHope
  | FApp (WC Flat) (WC Flat)
  | FJuxt (WC Flat) (WC Flat)
  | FThunk (WC Flat)
diff --git a/brat/Brat/Syntax/Core.hs b/brat/Brat/Syntax/Core.hs
index d3c30cff..c9dbd046 100644
--- a/brat/Brat/Syntax/Core.hs
+++ b/brat/Brat/Syntax/Core.hs
@@ -49,6 +49,7 @@ data Term :: Dir -> Kind -> Type where
   Pull     :: [PortName] -> WC (Term Chk k) -> Term Chk k
   Var      :: QualName -> Term Syn Noun  -- Look up in noun (value) env
   Identity :: Term Syn UVerb
+  Hope     :: Term Chk Noun
   Arith    :: ArithOp -> WC (Term Chk Noun) -> WC (Term Chk Noun) -> Term Chk Noun
   Of       :: WC (Term Chk Noun) -> WC (Term d Noun) -> Term d Noun
 
@@ -113,8 +114,10 @@ instance Show (Term d k) where
                           ,"of"
                           ,bracket POf e
                           ]
+
   show (Var x) = show x
   show Identity = "|"
+  show Hope = "!"
   -- Nested applications should be bracketed too, hence 4 instead of 3
   show (fun :$: arg) = bracket PApp fun ++ ('(' : show arg ++ ")")
   show (tm ::: ty) = bracket PAnn tm ++ " :: " ++ show ty
diff --git a/brat/Brat/Syntax/Raw.hs b/brat/Brat/Syntax/Raw.hs
index ca26fa79..62934f1b 100644
--- a/brat/Brat/Syntax/Raw.hs
+++ b/brat/Brat/Syntax/Raw.hs
@@ -71,6 +71,7 @@ data Raw :: Dir -> Kind -> Type where
   RPull     :: [PortName] -> WC (Raw Chk k) -> Raw Chk k
   RVar      :: QualName -> Raw Syn Noun
   RIdentity :: Raw Syn UVerb
+  RHope     :: Raw Chk Noun
   RArith    :: ArithOp -> WC (Raw Chk Noun) -> WC (Raw Chk Noun) -> Raw Chk Noun
   ROf       :: WC (Raw Chk Noun) -> WC (Raw d Noun) -> Raw d Noun
   (:::::)   :: WC (Raw Chk Noun) -> [RawIO] -> Raw Syn Noun
@@ -102,6 +103,7 @@ instance Show (Raw d k) where
     = unwords ["let", show abs, "=", show xs, "in", show body]
   show (RNHole name) = '?':name
   show (RVHole name) = '?':name
+  show RHope = "!"
   show (RSimple tm) = show tm
   show RPass = show "pass"
   show REmpty = "()"
@@ -201,6 +203,7 @@ instance (Kindable k) => Desugarable (Raw d k) where
   -- TODO: holes need to know their arity for type checking
   desugar' (RNHole strName) = NHole . (strName,) <$> freshM strName
   desugar' (RVHole strName) = VHole . (strName,) <$> freshM strName
+  desugar' RHope = pure Hope
   desugar' RPass = pure Pass
   desugar' (RSimple simp) = pure $ Simple simp
   desugar' REmpty = pure Empty
diff --git a/brat/Brat/Unelaborator.hs b/brat/Brat/Unelaborator.hs
index 51d85041..5ff57492 100644
--- a/brat/Brat/Unelaborator.hs
+++ b/brat/Brat/Unelaborator.hs
@@ -38,6 +38,7 @@ unelab _ _ (Con c args) = FCon c (unelab Chky Nouny <$> args)
 unelab _ _ (C (ss :-> ts)) = FFn (toRawRo ss :-> toRawRo ts)
 unelab _ _ (K cty) = FKernel $ fmap (\(p, ty) -> Named p (toRaw ty)) cty
 unelab _ _ Identity = FIdentity
+unelab _ _ Hope = FHope
 unelab _ _ FanIn = FFanIn
 unelab _ _ FanOut = FFanOut
 
@@ -67,6 +68,7 @@ toRaw (Con c args) = RCon c (toRaw <$> args)
 toRaw (C (ss :-> ts)) = RFn (toRawRo ss :-> toRawRo ts)
 toRaw (K cty) = RKernel $ (\(p, ty) -> Named p (toRaw ty)) <$> cty
 toRaw Identity = RIdentity
+toRaw Hope = RHope
 toRaw FanIn = RFanIn
 toRaw FanOut = RFanOut
 
diff --git a/brat/brat.cabal b/brat/brat.cabal
index 58a29efa..a7d22664 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -66,6 +66,7 @@ library
                        Brat.Checker.Helpers,
                        Brat.Checker.Helpers.Nodes,
                        Brat.Checker.Monad,
+                       Brat.Checker.SolveHoles,
                        Brat.Checker.SolvePatterns,
                        Brat.Checker.Types,
                        Brat.Compile.Hugr,
diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
new file mode 100644
index 00000000..e10ee44e
--- /dev/null
+++ b/brat/examples/infer.brat
@@ -0,0 +1,8 @@
+map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
+map(_, _, _, []) = []
+map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
+
+-- TODO: Make BRAT solve for the # kinded args
+mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
+mapVec(_, _, _, _, []) = []
+mapVec(_, _, f, succ(n), x ,- xs) = f(x) ,- mapVec(!, !, f, n, xs)
diff --git a/brat/test/golden/error/remaining_hopes.brat b/brat/test/golden/error/remaining_hopes.brat
new file mode 100644
index 00000000..164b8190
--- /dev/null
+++ b/brat/test/golden/error/remaining_hopes.brat
@@ -0,0 +1,5 @@
+f(n :: #) -> Nat
+f(n) = n
+
+g :: Nat
+g = f(!)
diff --git a/brat/test/golden/error/remaining_hopes.brat.golden b/brat/test/golden/error/remaining_hopes.brat.golden
new file mode 100644
index 00000000..80d15436
--- /dev/null
+++ b/brat/test/golden/error/remaining_hopes.brat.golden
@@ -0,0 +1,8 @@
+Error in test/golden/error/remaining_hopes.brat on line 5:
+g = f(!)
+     ^^^
+
+  Expected to work out values for these holes:
+    In checking_check_defs_1_g_1_Eval 0
+
+

From d981a5b319ae582887ad899f0633c7768933c310 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Wed, 18 Dec 2024 14:37:07 +0000
Subject: [PATCH 082/182] feat: Add nat hope solving

---
 brat/Brat/Checker/Helpers.hs       | 146 +++++++++++++++++++----------
 brat/Brat/Checker/SolveHoles.hs    |   6 +-
 brat/Brat/Checker/SolvePatterns.hs | 120 +++++++++++++++---------
 brat/examples/infer.brat           |   3 +-
 brat/examples/unified.brat         |  12 +++
 brat/test/Test/Compile/Hugr.hs     |   1 +
 6 files changed, 192 insertions(+), 96 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index d792a0a4..5c33437b 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -272,58 +272,12 @@ vecLayers :: Modey m -> Val Z -> Checking ([(Src, NumVal (VVar Z))] -- The sizes
                                           ,CTy m Z -- The function type at the end
                                           )
 vecLayers my (TVec ty (VNum n)) = do
-  src <- mkStaticNum n
+  src <- buildNatVal n
   first ((src, n):) <$> vecLayers my ty
 vecLayers Braty (VFun Braty cty) = pure ([], cty)
 vecLayers Kerny (VFun Kerny cty) = pure ([], cty)
 vecLayers my ty = typeErr $ "Expected a " ++ showMode my ++ "function or vector of functions, got " ++ show ty
 
-mkStaticNum :: NumVal (VVar Z) -> Checking Src
-mkStaticNum n@(NumValue c gro) = do
-  (_, [], [(constSrc,_)], _) <- next "const" (Const (Num (fromIntegral c))) (S0, Some (Zy :* S0)) R0 (RPr ("value", TNat) R0)
-  src <- case gro of
-    Constant0 -> pure constSrc
-    StrictMonoFun sm -> do
-      (_, [(lhs,_),(rhs,_)], [(src,_)], _) <- next "add_const" (ArithNode Add) (S0, Some (Zy :* S0))
-                                              (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0))
-                                              (RPr ("value", TNat) R0)
-      smSrc <- mkStrictMono sm
-      wire (constSrc, TNat, lhs)
-      wire (smSrc, TNat, rhs)
-      pure src
-  defineSrc src (VNum n)
-  pure src
- where
-  mkStrictMono :: StrictMono (VVar Z) -> Checking Src
-  mkStrictMono (StrictMono k mono) = do
-    (_, [], [(constSrc,_)], _) <- next "2^k" (Const (Num (2^k))) (S0, Some (Zy :* S0)) R0 (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(src,_)], _) <- next "mult_const" (ArithNode Mul) (S0, Some (Zy :* S0))
-                                            (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0))
-                                            (RPr ("value", TNat) R0)
-    monoSrc <- mkMono mono
-    wire (constSrc, TNat, lhs)
-    wire (monoSrc, TNat, rhs)
-    pure src
-
-  mkMono :: Monotone (VVar Z) -> Checking Src
-  mkMono (Linear (VPar (ExEnd e))) = pure (NamedPort e "mono")
-  mkMono (Full sm) = do
-    (_, [], [(twoSrc,_)], _) <- next "2" (Const (Num 2)) (S0, Some (Zy :* S0)) R0 (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(powSrc,_)], _) <- next "2^" (ArithNode Pow) (S0, Some (Zy :* S0))
-                                               (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0))
-                                               (RPr ("value", TNat) R0)
-    smSrc <- mkStrictMono sm
-    wire (twoSrc, TNat, lhs)
-    wire (smSrc, TNat, rhs)
-
-    (_, [], [(oneSrc,_)], _) <- next "1" (Const (Num 1)) (S0, Some (Zy :* S0)) R0 (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(src,_)], _) <- next "n-1" (ArithNode Sub) (S0, Some (Zy :* S0))
-                                            (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0))
-                                            (RPr ("value", TNat) R0)
-    wire (powSrc, TNat, lhs)
-    wire (oneSrc, TNat, rhs)
-    pure src
-
 vectorise :: forall m. Modey m -> (Src, Val Z) -> Checking (Src, CTy m Z)
 vectorise my (src, ty) = do
   (layers, cty) <- vecLayers my ty
@@ -493,7 +447,105 @@ runArith (NumValue upl grol) Pow (NumValue upr gror)
  = pure $ NumValue (upl ^ upr) (StrictMonoFun (StrictMono (l * upr) (Full (StrictMono (k + k') mono))))
 runArith _ _ _ = Nothing
 
+buildArithOp :: ArithOp -> Checking ((Tgt, Tgt), Src)
+buildArithOp op = do
+  (_, [(lhs,_), (rhs,_)], [(out,_)], _) <- next (show op) (ArithNode op) (S0, Some (Zy :* S0)) (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0)) (RPr ("value", TNat) R0)
+  pure ((lhs, rhs), out)
+
 buildConst :: SimpleTerm -> Val Z -> Checking Src
 buildConst tm ty = do
   (_, _, [(out,_)], _) <- next "buildConst" (Const tm) (S0, Some (Zy :* S0)) R0 (RPr ("value", ty) R0)
   pure out
+
+buildNum :: Integer -> Checking Src
+buildNum n = buildConst (Num (fromIntegral n)) TNat
+
+-- Generate wiring to produce a dynamic instance of the numval argument
+-- N.B. In these functions, we wire using Req, rather than the `wire` function
+-- because we don't want it to do any extra evaluation.
+buildNatVal :: NumVal (VVar Z) -> Checking Src
+buildNatVal nv@(NumValue n gro) = case n of
+  0 -> buildGro gro
+  n -> do
+    nDangling <- buildNum n
+    ((lhs,rhs),out) <- buildArithOp Add
+    src <- buildGro gro
+    req $ Wire (end nDangling, TNat, end lhs)
+    req $ Wire (end src, TNat, end rhs)
+    defineSrc out (VNum (nPlus n (nVar (VPar (toEnd src)))))
+    pure out
+ where
+  buildGro :: Fun00 (VVar Z) -> Checking Src
+  buildGro Constant0 = buildNum 0
+  buildGro (StrictMonoFun sm) = buildSM sm
+
+  buildSM :: StrictMono (VVar Z) -> Checking Src
+  buildSM (StrictMono k mono) = do
+    -- Calculate 2^k as `factor`
+    two <- buildNum 2
+    kDangling <- buildNum k
+    ((lhs,rhs),factor) <- buildArithOp Pow
+    req $ Wire (end two, TNat, end lhs)
+    req $ Wire (end kDangling, TNat, end rhs)
+    -- Multiply mono by 2^k
+    ((lhs,rhs),out) <- buildArithOp Mul
+    monoDangling <- buildMono mono
+    req $ Wire (end factor, TNat, end lhs)
+    req $ Wire (end monoDangling, TNat, end rhs)
+    defineSrc out (VNum (n2PowTimes k (nVar (VPar (toEnd monoDangling)))))
+    pure out
+
+  buildMono :: Monotone (VVar Z) -> Checking Src
+  buildMono (Linear (VPar (ExEnd e))) = pure $ NamedPort e "numval"
+  buildMono (Full sm) = do
+    -- Calculate 2^n as `outPlus1`
+    two <- buildNum 2
+    dangling <- buildSM sm
+    ((lhs,rhs),outPlus1) <- buildArithOp Pow
+    req $ Wire (end two, TNat, end lhs)
+    req $ Wire (end dangling, TNat, end rhs)
+    -- Then subtract 1
+    one <- buildNum 1
+    ((lhs,rhs),out) <- buildArithOp Sub
+    req $ Wire (end outPlus1, TNat, end lhs)
+    req $ Wire (end one, TNat, end rhs)
+    defineSrc out (VNum (nFull (nVar (VPar (toEnd dangling)))))
+    pure out
+  buildMono _ = err . InternalError $ "Trying to build a non-closed nat value: " ++ show nv
+
+invertNatVal :: NumVal (VVar Z) -> Checking Tgt
+invertNatVal (NumValue up gro) = case up of
+  0 -> invertGro gro
+  _ -> do
+    ((lhs,rhs),out) <- buildArithOp Sub
+    upSrc <- buildNum up
+    req $ Wire (end upSrc, TNat, end rhs)
+    tgt <- invertGro gro
+    req $ Wire (end out, TNat, end tgt)
+    defineTgt tgt (VNum (nVar (VPar (toEnd out))))
+    defineTgt lhs (VNum (nPlus up (nVar (VPar (toEnd tgt)))))
+    pure lhs
+ where
+  invertGro Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
+  invertGro (StrictMonoFun sm) = invertSM sm
+
+  invertSM (StrictMono k mono) = case k of
+    0 -> invertMono mono
+    _ -> do
+      divisor <- buildNum (2 ^ k)
+      ((lhs,rhs),out) <- buildArithOp Div
+      tgt <- invertMono mono
+      req $ Wire (end out, TNat, end tgt)
+      req $ Wire (end divisor, TNat, end rhs)
+      defineTgt tgt (VNum (nVar (VPar (toEnd out))))
+      defineTgt lhs (VNum (n2PowTimes k (nVar (VPar (toEnd tgt)))))
+      pure lhs
+
+  invertMono (Linear (VPar (InEnd e))) = pure (NamedPort e "numval")
+  invertMono (Full sm) = do
+    (_, [(llufTgt,_)], [(llufSrc,_)], _) <- next "luff" (Prim ("BRAT","lluf")) (S0, Some (Zy :* S0)) (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+    tgt <- invertSM sm
+    req $ Wire (end llufSrc, TNat, end tgt)
+    defineTgt tgt (VNum (nVar (VPar (toEnd llufSrc))))
+    defineTgt llufTgt (VNum (nFull (nVar (VPar (toEnd tgt)))))
+    pure llufTgt
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 8711006a..801ec0fe 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,8 +1,8 @@
-module Brat.Checker.SolveHoles (typeEq) where
+module Brat.Checker.SolveHoles (typeEq, buildNum) where
 
-import Brat.Checker.Helpers (buildConst)
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
+import Brat.Checker.Helpers (buildConst, buildNatVal, buildNum)
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common
@@ -88,7 +88,7 @@ solveHope k hope v = quote Zy v >>= \v -> case doesntOccur (InEnd hope) v of
   Right () -> do
     defineEnd (InEnd hope) v
     dangling <- case (k, v) of
-      (Nat, VNum _v) -> err $ Unimplemented "Nat hope solving" []
+      (Nat, VNum v) -> buildNatVal v
       (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
       _ -> buildConst Unit TUnit
     req (Wire (end dangling, kindType k, hope))
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 362bfea5..cd76efd3 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -197,8 +197,42 @@ instantiateMeta e val = do
   throwLeft (doesntOccur e val)
   defineEnd e val
 
+-- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
+-- makes the dynamic wiring for a metavariable. This only needs to happen for
+-- numbers because they have nontrivial runtime behaviour.
+--
+-- We assume that the caller has done the occurs check and rules out trivial equations.
+solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
+solveNumMeta e nv = case (e, vars nv) of
+ -- Compute the thing that the rhs should be based on the src, and instantiate src to that
+ (ExEnd src,  [VPar (InEnd _tgt)]) -> do
+   -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
+   tgtSrc <- invertNatVal nv
+   instantiateMeta (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
+   wire (NamedPort src "", TNat, tgtSrc)
+
+ (ExEnd src, _) -> instantiateMeta (ExEnd src) (VNum nv)
+
+ -- Both targets, we need to create the thing that they both derive from
+ (InEnd bigTgt, [VPar (InEnd weeTgt)]) -> do
+   (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
+                                         (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+   defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
+   instantiateMeta (InEnd weeTgt) (VNum (nVar (VPar (toEnd idSrc))))
+   wire (idSrc, TNat, NamedPort weeTgt "")
+   let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
+   bigSrc <- buildNatVal nv'
+   instantiateMeta (InEnd bigTgt) (VNum nv')
+   wire (bigSrc, TNat, NamedPort bigTgt "")
 
+ -- RHS is constant or Src, wire it into tgt
+ (InEnd tgt,  _) -> do
+   src <- buildNatVal nv
+   instantiateMeta (InEnd tgt) (VNum nv)
+   wire (src, TNat, NamedPort tgt "")
  where
+  vars :: NumVal a -> [a]
+  vars = foldMap pure
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
@@ -219,11 +253,9 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     lhsStrictMono (StrictMono (n - 1) mono) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear v) num = case v of
-    VPar e -> instantiateMeta e (VNum num)
-    _ -> case num of -- our only hope is to instantiate the RHS
-      NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar (ExEnd e))))) -> instantiateMeta (toEnd e) (VNum (nVar v))
-      _ -> err . UnificationError $ "Couldn't instantiate variable " ++ show v
+  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
+  lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
+                                  solveNumMeta e num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
@@ -234,7 +266,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (VPar e) -> instantiateMeta e (VNum (nConstant 0))
+    Linear (VPar e) -> solveNumMeta e (nConstant 0)
     Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
     _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
   demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
@@ -244,9 +276,23 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
-  demandSucc (StrictMono k (Linear (VPar (ExEnd out)))) = do
-    y <- mkPred out
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k y
+  demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
+    (_, [(yTgt, _)], [(ySrc, _)], _) <-
+      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
+
+    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
+    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
+  --   2^k * x
+  -- = 2^k * (y + 1)
+  -- = 2^k + 2^k * y
+  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
+  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = do
+    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
+    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
+    solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
+
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
@@ -265,53 +311,39 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
-        half <- mkHalf out
+        half <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
+        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd half))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
-      Linear _ -> err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+      Linear (VPar (InEnd tgt)) -> do
+        halfTgt <- buildNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd tgt))))))
+        let half = nVar (VPar (toEnd halfTgt))
+        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
 
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar (ExEnd out)) -> mkPred out >>= demandEven
-      Linear _ -> err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+      -- TODO: Why aren't we using `out`??
+      Linear (VPar (ExEnd _out)) -> do
+        -- compute (/2) . (-1)
+        doubTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 mono)))
+        let [VPar (InEnd halfTgt)] = foldMap pure mono
+        solveNumMeta (toEnd doubTgt) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
+        pure (nVar (VPar (toEnd halfTgt)))
+      Linear (VPar (InEnd weeTgt)) -> do
+        -- compute (/2) . (-1)
+        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
+        let flooredHalf = nVar (VPar (toEnd weeTgt))
+        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
+        pure flooredHalf
+
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
       Full sm -> nFull <$> demandSucc sm
     oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
 
-  -- Add dynamic logic to compute half of a variable.
-  mkHalf :: OutPort -> Checking Src
-  mkHalf out = do
-    (_, [], [(const2,_)], _) <- next "const2" (Const (Num 2)) (S0, Some (Zy :* S0))
-                                R0
-                                (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(half,_)], _) <- next "div2" (ArithNode Div) (S0, Some (Zy :* S0))
-                                             (RPr ("left", TNat) (RPr ("right", TNat) R0))
-                                             (RPr ("out", TNat) R0)
-    wire (NamedPort out "numerator", TNat, lhs)
-    wire (const2, TNat, rhs)
-    req $ Define (toEnd out) (VNum (n2PowTimes 1 (nVar (VPar (toEnd half)))))
-    pure half
-
-
-  -- Add dynamic logic to compute the predecessor of a variable, and return that
-  -- predecessor.
-  -- The variable must be a non-zero nat!!
-  mkPred :: OutPort -> Checking (NumVal (VVar Z))
-  mkPred out = do
-    (_, [], [(const1,_)], _) <- next "const1" (Const (Num 1)) (S0, Some (Zy :* S0))
-                                R0
-                                (RPr ("value", TNat) R0)
-    (_, [(lhs,_),(rhs,_)], [(pred,_)], _) <- next "minus1" (ArithNode Sub) (S0, Some (Zy :* S0))
-                                             (RPr ("left", TNat) (RPr ("right", TNat) R0))
-                                             (RPr ("out", TNat) R0)
-    wire (NamedPort out "", TNat, lhs)
-    wire (const1, TNat, rhs)
-    req $ Define (ExEnd out) (VNum (nPlus 1 (nVar (VPar (toEnd pred)))))
-    pure (nVar (VPar (toEnd pred)))
-
 -- The variable must be a non-zero nat!!
 patVal :: ValPat -> [End] -> (Val Z, [End])
 -- Nat variables will only be found in a `NumPat`, not a `ValPat`
diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index e10ee44e..dacdb0a7 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -2,7 +2,6 @@ map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
 map(_, _, _, []) = []
 map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 
--- TODO: Make BRAT solve for the # kinded args
 mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
 mapVec(_, _, _, _, []) = []
-mapVec(_, _, f, succ(n), x ,- xs) = f(x) ,- mapVec(!, !, f, n, xs)
+mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
diff --git a/brat/examples/unified.brat b/brat/examples/unified.brat
index f04c167a..becc483e 100644
--- a/brat/examples/unified.brat
+++ b/brat/examples/unified.brat
@@ -28,3 +28,15 @@ swapFront(X :: *, n :: #, Vec(X, n)) -> Vec(X, n)
 swapFront(_, _, []) = []
 swapFront(_, _, [x]) = [x]
 swapFront(X, _, cons(x, cons(y, zs))) = cons(y, cons(x, zs))
+
+filled(X :: *, n :: #, Vec(X, full(n))) -> Vec(X, full(n))
+filled(_, _, xsl =, x ,= xsr) = xsl =, x ,= xsr
+
+fullId(X :: *, n :: #, Vec(X, full(n))) -> Vec(X, full(n))
+fullId(_, _, [] =,= []) = []
+fullId(_, _, [] =, x ,= []) = [x]
+fullId(_, succ(n), xl =, x ,= xr) = fullId(!, n, xl) =, x ,= fullId(!, n, xr)
+
+-- mapAndConquer(X :: *, Y :: *, n :: #, f :: { X -> Y }, Vec(X, succ(n))) -> Vec(Y, succ(n))
+-- mapAndConquer(_, _, doub(n), f, xsl =, x ,= xsr) = mapAndConquer(!, !, n, f, xsl) =, f(x) ,= mapAndConquer(!, !, n, f, xsr)
+-- mapAndConquer(_, _, succ(doub(n)), f, xsl =,= xsr) = mapAndConquer(!, !, n, f, xsl) =,= mapAndConquer(!, !, n, f, xsr)
diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index 11de7093..ef24aa26 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -38,6 +38,7 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
   ,"batcher-merge-sort" -- Generates MapFun nodes which aren't implemented yet
+  ,"infer" -- Generates `Pow` nodes which aren't implemented yet
   -- Victims of #13
   ,"arith"
   ,"cqcconf"

From 2bc84cfbac79550216198a852fe9d5345561aa55 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 11:32:51 +0000
Subject: [PATCH 083/182] Drop unnecessary 'derive Ord' for TypeKind

---
 brat/Brat/Syntax/Common.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/Brat/Syntax/Common.hs b/brat/Brat/Syntax/Common.hs
index c9abb808..eb355607 100644
--- a/brat/Brat/Syntax/Common.hs
+++ b/brat/Brat/Syntax/Common.hs
@@ -111,7 +111,7 @@ instance Eq ty => Eq (TypeRowElem ty) where
   Anon ty == Anon ty' = ty == ty'
 
 data TypeKind = TypeFor Mode [(PortName, TypeKind)] | Nat
-  deriving (Eq, Ord)
+  deriving Eq
 
 instance Show TypeKind where
   show (TypeFor m args) = let argsStr = if null args then "" else "(" ++ intercalate ", " (show <$> args) ++ ")"

From e32d0b9dbe139377bf9584e0e52bf9e6d68fb527 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 11:33:10 +0000
Subject: [PATCH 084/182] Remove repeated export of DIRY in Syntax/Common.hs

---
 brat/Brat/Syntax/Common.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/brat/Brat/Syntax/Common.hs b/brat/Brat/Syntax/Common.hs
index eb355607..f90dbed6 100644
--- a/brat/Brat/Syntax/Common.hs
+++ b/brat/Brat/Syntax/Common.hs
@@ -2,7 +2,6 @@ module Brat.Syntax.Common (PortName,
                            Dir(..),
                            Kind(..),
                            Diry(..),
-                           DIRY(..),
                            Kindy(..),
                            CType'(..),
                            Import(..),

From 3a607034a960716f65def8e69b1e53e8c76414d8 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 11:40:50 +0000
Subject: [PATCH 085/182] review comments

---
 brat/Brat/Checker/Monad.hs         |  3 +--
 brat/Brat/Checker/SolveHoles.hs    | 11 ++++++-----
 brat/Brat/Checker/SolvePatterns.hs |  1 +
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index cb9fd015..baecc9e6 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -58,7 +58,6 @@ data Context = Ctx { globalVEnv :: VEnv
                    , kconstructors :: ConstructorMap Kernel
                    , typeConstructors :: M.Map (Mode, QualName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map QualName Alias
-                   -- All the ends here should be targets
                    , hopes :: Hopes
                    }
 
@@ -281,7 +280,7 @@ handler (Req s k) ctx g
       RemoveHope e -> let hset = hopes ctx in
                         if M.member e hset
                         then handler (k ()) (ctx { hopes = M.delete e hset }) g
-                        else Left (dumbErr (InternalError ("Trying to remove Hope not in set: " ++ show e)))
+                        else Left (dumbErr (InternalError ("Trying to remove unknown Hope: " ++ show e)))
 
 type Checking = Free CheckingSig
 
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 8711006a..2c759f9b 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -19,7 +19,9 @@ import Data.Functor
 import qualified Data.Map as M
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
--- External interface to typeEq' for closed values only.
+-- Demand that two closed values are equal, we're allowed to solve variables in the
+-- hope set to make this true.
+-- Raises a user error if the vals cannot be made equal.
 typeEq :: String -- String representation of the term for error reporting
        -> TypeKind -- The kind we're comparing at
        -> Val Z -- Expected
@@ -27,9 +29,8 @@ typeEq :: String -- String representation of the term for error reporting
        -> Checking ()
 typeEq str = typeEq' str (Zy :* S0 :* S0)
 
--- Demand that two things are equal, we're allowed to solve variables in the
--- hope set to make this true.
--- Raises a user error if the vals cannot be made equal.
+
+-- Internal version of typeEq with environment for non-closed values
 typeEq' :: String -- String representation of the term for error reporting
         -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
         -> TypeKind -- The kind we're comparing at
@@ -80,7 +81,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
     [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
     _es -> error "TODO: must wait for one or the other to become more defined"
 
--- This will update the `hopes` set, potentially invalidating things that have
+-- This will update the `hopes`, potentially invalidating things that have
 -- been eval'd.
 -- The Sem is closed, for now.
 solveHope :: TypeKind -> InPort -> Sem -> Checking ()
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 362bfea5..3778cf45 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -108,6 +108,7 @@ solve my ((src, PCon c abs):p) = do
           unifyNum
            (nVar (VPar (ExEnd (end src))))
            (relationToInner (nVar (VPar (toEnd dangling))))
+          -- TODO also do wiring corresponding to relationToInner
           p <- argProblems [dangling] (normaliseAbstractor abs) p
           (tests, sol) <- solve my p
           -- When we get @-patterns, we shouldn't drop this anymore

From 496521005dcc48c2faa9c4f7d92c0942233e44aa Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 11:54:52 +0000
Subject: [PATCH 086/182] another comment

---
 brat/Brat/Checker/SolveHoles.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 2c759f9b..0441aac5 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -77,7 +77,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
   act <- quote ny act
   case [e | (VApp (VPar (InEnd e)) _) <- [exp,act], M.member e hopes] of
-    [] -> typeEqRigid tm stuff k exp act
+    [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
     _es -> error "TODO: must wait for one or the other to become more defined"
 

From 9b8a9973e7010dcd9b99cf2aaa9fd8fa89dac54f Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 12:06:03 +0000
Subject: [PATCH 087/182] No need to filter hopes, but clarify with error

---
 brat/Brat/Checker/SolveHoles.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 0441aac5..41d927ae 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -13,6 +13,7 @@ import Bwd
 import Hasochism
 import Util (zipSameLength)
 
+import Control.Monad (when)
 import Data.Bifunctor (second)
 import Data.Foldable (sequenceA_)
 import Data.Functor
@@ -76,7 +77,10 @@ typeEqEta _ (Zy :* _ :* _) hopes Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  case [e | (VApp (VPar (InEnd e)) _) <- [exp,act], M.member e hopes] of
+  let ends = [e | (VApp (VPar e) _) <- [exp, act]]
+  -- sanity check: we've already dealt with either end being in the hopeset
+  when (or [M.member ie hopes | InEnd ie <- ends]) $ typeErr "ends were in hopeset"
+  case ends of
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
     _es -> error "TODO: must wait for one or the other to become more defined"

From 06c454e187e13c7cdb936701fe7f1c655a6e4490 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 12:10:16 +0000
Subject: [PATCH 088/182] Factor out getNumVar, use in typeEq'

---
 brat/Brat/Checker/SolveHoles.hs |  7 ++++++-
 brat/Brat/Eval.hs               | 17 +++++++++--------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 41d927ae..adcd133d 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -17,6 +17,7 @@ import Control.Monad (when)
 import Data.Bifunctor (second)
 import Data.Foldable (sequenceA_)
 import Data.Functor
+import Data.Maybe (catMaybes)
 import qualified Data.Map as M
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
@@ -77,13 +78,17 @@ typeEqEta _ (Zy :* _ :* _) hopes Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = [e | (VApp (VPar e) _) <- [exp, act]]
+  let ends = catMaybes $ [exp,act] <&> getEnd
   -- sanity check: we've already dealt with either end being in the hopeset
   when (or [M.member ie hopes | InEnd ie <- ends]) $ typeErr "ends were in hopeset"
   case ends of
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
     _es -> error "TODO: must wait for one or the other to become more defined"
+ where
+  getEnd (VApp (VPar e) _) = Just e
+  getEnd (VNum n) = getNumVar n
+  getEnd _ = Nothing
 
 -- This will update the `hopes`, potentially invalidating things that have
 -- been eval'd.
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index f9ae33d3..ff9f1489 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -17,6 +17,7 @@ module Brat.Eval (EvMode(..)
                  ,kindType
                  ,numVal
                  ,quote
+                 ,getNumVar
                  ) where
 
 import Brat.Checker.Monad
@@ -298,19 +299,19 @@ eqTests tm lvkz = go
   go _ us vs = pure . Left . TypeErr $ "Arity mismatch in type constructor arguments:\n  "
                    ++ show us ++ "\n  " ++ show vs
 
+getNumVar :: NumVal (VVar n) -> Maybe End
+getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
+  Linear v -> case v of
+    VPar e -> Just e
+    _ -> Nothing
+  Full sm -> getNumVar (numValue sm)
+getNumVar _ = Nothing
+
 -- Be conservative, fail if in doubt. Not dangerous like being wrong while succeeding
 -- We can have bogus failures here because we're not normalising under lambdas
 -- N.B. the value argument is normalised.
 doesntOccur :: End -> Val n -> Either ErrorMsg ()
 doesntOccur e (VNum nv) = traverse_ (collision e) (getNumVar nv)
- where
-  getNumVar :: NumVal (VVar n) -> Maybe End
-  getNumVar (NumValue _ (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear v -> case v of
-      VPar e -> Just e
-      _ -> Nothing
-    Full sm -> getNumVar (numValue sm)
-  getNumVar _ = Nothing
 doesntOccur e (VApp var args) = case var of
   VPar e' -> collision e e' *> traverse_ (doesntOccur e) args
   _ -> pure ()

From 6b05fb646f98d44748f38650c8c52537150bba4a Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 12:19:25 +0000
Subject: [PATCH 089/182] hlint

---
 brat/Brat/Checker/Helpers.hs       | 2 +-
 brat/Brat/Checker/SolveHoles.hs    | 4 ++--
 brat/Brat/Checker/SolvePatterns.hs | 2 --
 brat/Brat/Parser.hs                | 2 +-
 4 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index d792a0a4..9b0871e5 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -117,7 +117,7 @@ pullPorts :: forall a ty
           -> Checking [a]
 pullPorts toPort showFn to_pull types =
   -- the "state" here is the things still available to be pulled
-  (\(pulled, rest) -> pulled ++ rest) <$> runStateT (mapM pull1Port to_pull) types
+  uncurry (++) <$> runStateT (mapM pull1Port to_pull) types
  where
   pull1Port :: PortName -> StateT [a] Checking a
   pull1Port p = StateT $ \available -> case partition ((== p) . toPort) available of
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index adcd133d..308eb59d 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -17,7 +17,7 @@ import Control.Monad (when)
 import Data.Bifunctor (second)
 import Data.Foldable (sequenceA_)
 import Data.Functor
-import Data.Maybe (catMaybes)
+import Data.Maybe (mapMaybe)
 import qualified Data.Map as M
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
@@ -78,7 +78,7 @@ typeEqEta _ (Zy :* _ :* _) hopes Nat exp act
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = catMaybes $ [exp,act] <&> getEnd
+  let ends = mapMaybe getEnd [exp,act]
   -- sanity check: we've already dealt with either end being in the hopeset
   when (or [M.member ie hopes | InEnd ie <- ends]) $ typeErr "ends were in hopeset"
   case ends of
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 3778cf45..7339157d 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -199,8 +199,6 @@ instantiateMeta e val = do
   defineEnd e val
 
 
- where
-
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
diff --git a/brat/Brat/Parser.hs b/brat/Brat/Parser.hs
index 8cc677fb..1b0e6513 100644
--- a/brat/Brat/Parser.hs
+++ b/brat/Brat/Parser.hs
@@ -568,7 +568,7 @@ expr' p = choice $ (try . getParser <$> enumFrom p) ++ [atomExpr]
     let firstPortFC = fcOf . fst <$> uncons ports
     case ports of
       [] -> juxtRhsWithPull
-      _ -> (\juxt@(WC juxtFC _) -> WC (maybe juxtFC (\fc -> spanFC fc juxtFC) firstPortFC) (FPull (unWC <$> ports) juxt)) <$> juxtRhsWithPull
+      _ -> (\juxt@(WC juxtFC _) -> WC (maybe juxtFC (`spanFC` juxtFC) firstPortFC) (FPull (unWC <$> ports) juxt)) <$> juxtRhsWithPull
    where
     portPull :: Parser (WC String)
     portPull = do

From 98c74f8f5431e5e6bb053bf5bf08bd3ba511c144 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 12:33:50 +0000
Subject: [PATCH 090/182] Don't (re-)export buildNum from SolveHoles.hs

---
 brat/Brat/Checker/SolveHoles.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 1e2beba5..6e906a5d 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,8 +1,8 @@
-module Brat.Checker.SolveHoles (typeEq, buildNum) where
+module Brat.Checker.SolveHoles (typeEq) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
-import Brat.Checker.Helpers (buildConst, buildNatVal, buildNum)
+import Brat.Checker.Helpers (buildConst, buildNatVal)
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common

From f5c0a201ccfe0246d13e7ca501238b99f13b1b0d Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 7 Jan 2025 12:34:58 +0000
Subject: [PATCH 091/182] and further reduce diff

---
 brat/Brat/Checker/SolveHoles.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 6e906a5d..71d0eae6 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,8 +1,8 @@
 module Brat.Checker.SolveHoles (typeEq) where
 
+import Brat.Checker.Helpers (buildConst, buildNatVal)
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
-import Brat.Checker.Helpers (buildConst, buildNatVal)
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common

From 8f83c77af443879b4214a080a00969a98375fb2c Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@quantinuum.com>
Date: Tue, 7 Jan 2025 14:40:16 +0000
Subject: [PATCH 092/182] Compute 2^constant at compile-time (#74)

Thus fixing `infer.brat`
---
 brat/Brat/Checker/Helpers.hs   | 9 ++-------
 brat/test/Test/Compile/Hugr.hs | 1 -
 2 files changed, 2 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 48e3268b..07bd3e3c 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -481,13 +481,8 @@ buildNatVal nv@(NumValue n gro) = case n of
 
   buildSM :: StrictMono (VVar Z) -> Checking Src
   buildSM (StrictMono k mono) = do
-    -- Calculate 2^k as `factor`
-    two <- buildNum 2
-    kDangling <- buildNum k
-    ((lhs,rhs),factor) <- buildArithOp Pow
-    req $ Wire (end two, TNat, end lhs)
-    req $ Wire (end kDangling, TNat, end rhs)
-    -- Multiply mono by 2^k
+    factor <- buildNum $ 2 ^ k
+    -- Multiply mono by 2^k; note we could avoid this if k==0
     ((lhs,rhs),out) <- buildArithOp Mul
     monoDangling <- buildMono mono
     req $ Wire (end factor, TNat, end lhs)
diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index ef24aa26..11de7093 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -38,7 +38,6 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
   ,"batcher-merge-sort" -- Generates MapFun nodes which aren't implemented yet
-  ,"infer" -- Generates `Pow` nodes which aren't implemented yet
   -- Victims of #13
   ,"arith"
   ,"cqcconf"

From 90a3adecce0207ee4b93f248999edef44746735a Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Tue, 1 Apr 2025 14:52:22 +0100
Subject: [PATCH 093/182] [ broken ] troublesome examples of nat solving

---
 brat/examples/infer.brat | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index dacdb0a7..2bcfb105 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -5,3 +5,25 @@ map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
 mapVec(_, _, _, _, []) = []
 mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+
+isfull(n :: #) -> Bool
+isfull(succ(doub(n))) = isfull(n)
+isfull(0) = true
+isfull(_) = false
+
+hasfulllen(n :: #, Vec(Bool, n)) -> Bool
+hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(xs)
+hasfulllen(_, []) = true
+hasfulllen(_, _) = false
+
+eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
+eatsfull(n, _) = n
+mkftwo :: Nat
+mkftwo = eatsfull(!, [false,false,false]) 
+
+eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
+eatsodd(n, _) = n
+mkotwo' :: Nat
+mkotwo' = eatsodd(2, [false,false,false,false,false]) 
+mkotwo :: Nat
+mkotwo = eatsodd(!, [false,false,false,false,false])

From 2d9fb1aedffcbc72e50c25927241ca990e7e719e Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 1 Apr 2025 15:01:00 +0100
Subject: [PATCH 094/182] Fix demandEven

---
 brat/Brat/Checker/SolvePatterns.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 20e528a3..c4fe8dce 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -312,11 +312,12 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar (ExEnd out)) -> do
-        half <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
-        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd half))))
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd half)))))
+        (_, [], [(halfSrc, _)], _) <-
+          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
       Linear (VPar (InEnd tgt)) -> do
-        halfTgt <- buildNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd tgt))))))
+        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
         let half = nVar (VPar (toEnd halfTgt))
         solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))

From e4010b46bdb99c90b28e1080ac35395230c0f9fa Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 1 Apr 2025 15:09:21 +0100
Subject: [PATCH 095/182] Fix recursive call in `hasfulllen`

---
 brat/examples/infer.brat | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index 2bcfb105..3593eac2 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -12,18 +12,18 @@ isfull(0) = true
 isfull(_) = false
 
 hasfulllen(n :: #, Vec(Bool, n)) -> Bool
-hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(xs)
+hasfulllen(succ(n), x ,- (xs =,= ys)) = hasfulllen(n, xs)
 hasfulllen(_, []) = true
 hasfulllen(_, _) = false
 
 eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
 eatsfull(n, _) = n
 mkftwo :: Nat
-mkftwo = eatsfull(!, [false,false,false]) 
+mkftwo = eatsfull(!, [false,false,false])
 
 eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
 eatsodd(n, _) = n
 mkotwo' :: Nat
-mkotwo' = eatsodd(2, [false,false,false,false,false]) 
+mkotwo' = eatsodd(2, [false,false,false,false,false])
 mkotwo :: Nat
 mkotwo = eatsodd(!, [false,false,false,false,false])

From 783107c9e2623135726fd40b1425750bff670038 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Tue, 1 Apr 2025 15:11:19 +0100
Subject: [PATCH 096/182] [ minor fix ] hasfulllen needs a numeric input

---
 brat/examples/infer.brat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index 3593eac2..62b0955b 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -12,7 +12,7 @@ isfull(0) = true
 isfull(_) = false
 
 hasfulllen(n :: #, Vec(Bool, n)) -> Bool
-hasfulllen(succ(n), x ,- (xs =,= ys)) = hasfulllen(n, xs)
+hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(!, xs)
 hasfulllen(_, []) = true
 hasfulllen(_, _) = false
 

From aa0a5091b9caf44fa1861b4c5461a8929bcc52a3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@cambridgequantum.com>
Date: Tue, 1 Apr 2025 15:32:37 +0100
Subject: [PATCH 097/182] Fix the other call site that calls `invertNatVal`
 with a Src

---
 brat/Brat/Checker/SolvePatterns.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index c4fe8dce..8525de1e 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -328,12 +328,11 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       -- TODO: Why aren't we using `out`??
-      Linear (VPar (ExEnd _out)) -> do
+      Linear (VPar (ExEnd bubble)) -> do
         -- compute (/2) . (-1)
-        doubTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 mono)))
-        let [VPar (InEnd halfTgt)] = foldMap pure mono
-        solveNumMeta (toEnd doubTgt) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfTgt)))))
-        pure (nVar (VPar (toEnd halfTgt)))
+        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
+        pure (nVar (VPar (toEnd halfSrc)))
       Linear (VPar (InEnd weeTgt)) -> do
         -- compute (/2) . (-1)
         bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))

From 03316af61ec12576037c19ef8ebdda9fc9d0ddf2 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Apr 2025 17:57:24 +0100
Subject: [PATCH 098/182] fix some golden/graph tests, mostly internal variable
 names, plus an FC -> line no.

Only examples/unified.brat failing now.
---
 .../error/fanin-dynamic-length.brat.golden    |  2 +-
 .../error/fanout-dynamic-length.brat.golden   |  2 +-
 .../error/remaining-nat-hopes.brat.golden     |  4 +-
 brat/test/golden/error/vectorise1.brat.golden |  2 +-
 brat/test/golden/error/vectorise3.brat.golden |  2 +-
 brat/test/golden/graph/addN.brat.graph        | 30 +++++------
 brat/test/golden/graph/addN2.brat.graph       | 30 +++++------
 brat/test/golden/graph/cons.brat.graph        | 30 +++++------
 brat/test/golden/graph/id.brat.graph          | 28 +++++-----
 brat/test/golden/graph/kernel.brat.graph      | 52 +++++++++----------
 brat/test/golden/graph/list.brat.graph        | 28 +++++-----
 brat/test/golden/graph/num.brat.graph         | 16 +++---
 brat/test/golden/graph/pair.brat.graph        | 20 +++----
 brat/test/golden/graph/rx.brat.graph          | 32 ++++++------
 brat/test/golden/graph/swap.brat.graph        | 34 ++++++------
 brat/test/golden/graph/vec.brat.graph         | 28 +++++-----
 16 files changed, 170 insertions(+), 170 deletions(-)

diff --git a/brat/test/golden/error/fanin-dynamic-length.brat.golden b/brat/test/golden/error/fanin-dynamic-length.brat.golden
index 993c4357..4abd7f20 100644
--- a/brat/test/golden/error/fanin-dynamic-length.brat.golden
+++ b/brat/test/golden/error/fanin-dynamic-length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/fanin-dynamic-length.brat on line 2:
 f(n) = { [\/] }
        ^^^^^^^^
 
-  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 0
+  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0
 
diff --git a/brat/test/golden/error/fanout-dynamic-length.brat.golden b/brat/test/golden/error/fanout-dynamic-length.brat.golden
index 2d79c6e4..edda996d 100644
--- a/brat/test/golden/error/fanout-dynamic-length.brat.golden
+++ b/brat/test/golden/error/fanout-dynamic-length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/fanout-dynamic-length.brat on line 2:
 f(n) = { [/\] }
        ^^^^^^^^
 
-  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 0
+  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0
 
diff --git a/brat/test/golden/error/remaining-nat-hopes.brat.golden b/brat/test/golden/error/remaining-nat-hopes.brat.golden
index 013e8b6c..b1bdb98f 100644
--- a/brat/test/golden/error/remaining-nat-hopes.brat.golden
+++ b/brat/test/golden/error/remaining-nat-hopes.brat.golden
@@ -1,8 +1,8 @@
-Error in test/golden/error/remaining-nat-hopes.brat@FC {start = Pos {line = 8, col = 31}, end = Pos {line = 8, col = 34}}:
+Error in test/golden/error/remaining-nat-hopes.brat on line 8:
 bad = let _ = read([]) in show(!)
                               ^^^
 
   Expected to work out values for these holes:
-    In checking_check_defs_1_bad_2__2 0
+    In checking_check_defs_1_bad_5__2 0
 
 
diff --git a/brat/test/golden/error/vectorise1.brat.golden b/brat/test/golden/error/vectorise1.brat.golden
index 570e060c..78802548 100644
--- a/brat/test/golden/error/vectorise1.brat.golden
+++ b/brat/test/golden/error/vectorise1.brat.golden
@@ -2,7 +2,7 @@ Error in test/golden/error/vectorise1.brat on line 2:
 bad1(n) = (n of (1, 2.0)), (n of 3)
                            ^^^^^^^^
 
-  Type error: Got: Vector of length VPar Ex checking_check_defs_1_bad1_bad1.box_2_lambda_fake_source 0
+  Type error: Got: Vector of length VPar Ex checking_check_defs_1_bad1_lambda_fake_source_3 0
 Expected: empty row
 
 
diff --git a/brat/test/golden/error/vectorise3.brat.golden b/brat/test/golden/error/vectorise3.brat.golden
index 0b7c4871..221b90d5 100644
--- a/brat/test/golden/error/vectorise3.brat.golden
+++ b/brat/test/golden/error/vectorise3.brat.golden
@@ -3,5 +3,5 @@ f(_, _, n, f, xs) = (n of f)(xs)
                     ^^^^^^^^^^^^
 
   Type error: Expected function 「n」 of f() to consume all of its arguments (「xs」)
- but found leftovers: (b1 :: Vec(VApp VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 0 B0, VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 2))
+ but found leftovers: (b1 :: Vec(VApp VPar Ex checking_check_defs_1_f_lambda_fake_source_3 0 B0, VPar Ex checking_check_defs_1_f_lambda_fake_source_3 2))
 
diff --git a/brat/test/golden/graph/addN.brat.graph b/brat/test/golden/graph/addN.brat.graph
index b653f383..abbf73eb 100644
--- a/brat/test/golden/graph/addN.brat.graph
+++ b/brat/test/golden/graph/addN.brat.graph
@@ -1,15 +1,15 @@
 Nodes:
-(check_defs_1_addN_addN.box_2_lambda_11,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 0, portName = "inp"},Int)]}),check_defs_1_addN_addN.box_2_lambda.0_rhs_thunk_10) :| [])) [("inp",Int)] [("out",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs_9_,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7,BratNode Source [] [("n",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs_thunk_10,BratNode (Box (fromList []) check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7 check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_addN.box_2_lambda.0_setup/in_3,BratNode Source [] [("inp",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_setup/out_4,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_2_lambda.0_setup_thunk_6,BratNode (Box (fromList []) check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 check_defs_1_addN_addN.box_2_lambda.0_setup/out_4) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1__6,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,BratNode Source [] [("n",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_thunk_3,BratNode (Box (fromList []) check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
 (globals_Int_1,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_5,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_6,BratNode (Constructor Int) [] [("value",[])])
@@ -21,15 +21,15 @@ Nodes:
 (globals_prim_8_add,BratNode (Prim ("","add")) [] [("thunk",{ (a :: Int), (b :: Int) -> (c :: Int) })])
 
 Wires:
-(Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_addN.box_2_lambda_11 0)
-(Ex check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 0)
-(Ex check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8 0)
-(Ex check_defs_1_addN_addN.box_2_lambda_11 0,Int,In check_defs_1_addN_addN.box/out_1 0)
-(Ex check_defs_1_addN_addN.box_thunk_3 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1__6 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1__6 0)
+(Ex check_defs_1_addN_LambdaChk_9_lambda 0,Int,In check_defs_1_addN_addN.box/out_1 0)
+(Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_LambdaChk_9_lambda 0)
+(Ex check_defs_1_addN_addN.box_thunk_2 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
 (Ex globals_Int_1 0,[],In globals___kcr_N 0)
 (Ex globals_Int_11 0,[],In globals___kcc_10 0)
 (Ex globals_Int_12 0,[],In globals___kcc_10 1)
 (Ex globals_Int_5 0,[],In globals___kcc_4 0)
 (Ex globals_Int_6 0,[],In globals___kcc_4 1)
 (Ex globals_Int_7 0,[],In globals___kcc_4 2)
-(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 1)
+(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1__6 1)
diff --git a/brat/test/golden/graph/addN2.brat.graph b/brat/test/golden/graph/addN2.brat.graph
index 70642c12..9584bfb2 100644
--- a/brat/test/golden/graph/addN2.brat.graph
+++ b/brat/test/golden/graph/addN2.brat.graph
@@ -1,15 +1,15 @@
 Nodes:
-(check_defs_1_addN_addN.box_2_lambda_11,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 0, portName = "inp"},Int)]}),check_defs_1_addN_addN.box_2_lambda.0_rhs_thunk_10) :| [])) [("inp",Int)] [("out",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs_9_,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7,BratNode Source [] [("n",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_2_lambda.0_rhs_thunk_10,BratNode (Box (fromList []) check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7 check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_addN.box_2_lambda.0_setup/in_3,BratNode Source [] [("inp",Int)])
-(check_defs_1_addN_addN.box_2_lambda.0_setup/out_4,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_2_lambda.0_setup_thunk_6,BratNode (Box (fromList []) check_defs_1_addN_addN.box_2_lambda.0_setup/in_3 check_defs_1_addN_addN.box_2_lambda.0_setup/out_4) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1__6,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,BratNode Source [] [("n",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_addN.box_thunk_3,BratNode (Box (fromList []) check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
 (globals_Int_1,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_5,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_6,BratNode (Constructor Int) [] [("value",[])])
@@ -21,15 +21,15 @@ Nodes:
 (globals_prim_8_add,BratNode (Prim ("","add")) [] [("a1",{ (a :: Int), (b :: Int) -> (c :: Int) })])
 
 Wires:
-(Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_addN.box_2_lambda_11 0)
-(Ex check_defs_1_addN_addN.box_2_lambda.0_rhs/in_7 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 0)
-(Ex check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs/out_8 0)
-(Ex check_defs_1_addN_addN.box_2_lambda_11 0,Int,In check_defs_1_addN_addN.box/out_1 0)
-(Ex check_defs_1_addN_addN.box_thunk_3 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1__6 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1__6 0)
+(Ex check_defs_1_addN_LambdaChk_9_lambda 0,Int,In check_defs_1_addN_addN.box/out_1 0)
+(Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_LambdaChk_9_lambda 0)
+(Ex check_defs_1_addN_addN.box_thunk_2 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
 (Ex globals_Int_1 0,[],In globals___kcr_N 0)
 (Ex globals_Int_11 0,[],In globals___kcc_10 0)
 (Ex globals_Int_12 0,[],In globals___kcc_10 1)
 (Ex globals_Int_5 0,[],In globals___kcc_4 0)
 (Ex globals_Int_6 0,[],In globals___kcc_4 1)
 (Ex globals_Int_7 0,[],In globals___kcc_4 2)
-(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_addN.box_2_lambda.0_rhs_9_ 1)
+(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1__6 1)
diff --git a/brat/test/golden/graph/cons.brat.graph b/brat/test/golden/graph/cons.brat.graph
index 3da7e8a1..1d139e3f 100644
--- a/brat/test/golden/graph/cons.brat.graph
+++ b/brat/test/golden/graph/cons.brat.graph
@@ -1,11 +1,11 @@
 Nodes:
-(check_defs_1_three_1__1,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_three_1_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_two__1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_two__3,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_two_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_two_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_two_nil_4,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_three_2_check'Con__1,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_three_2_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
+(check_defs_1_two_check'Con__1,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_two_check'Con_check'Con_2__1,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_two_check'Con_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_two_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_two_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
 (globals__3,BratNode (Const 2) [] [("value",Nat)])
 (globals__8,BratNode (Const 3) [] [("value",Nat)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
@@ -16,17 +16,17 @@ Nodes:
 (globals_decl_9_three,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-(Ex check_defs_1_three_1__1 0,Int,In check_defs_1_three_1_cons 0)
-(Ex check_defs_1_three_1_cons 0,Vec(Int, 3),In globals_decl_9_three 0)
-(Ex check_defs_1_two__1 0,Int,In check_defs_1_two_cons 0)
-(Ex check_defs_1_two__3 0,Int,In check_defs_1_two_cons_2 0)
-(Ex check_defs_1_two_cons 0,Vec(Int, 2),In globals_decl_4_two 0)
-(Ex check_defs_1_two_cons_2 0,Vec(Int, 1),In check_defs_1_two_cons 1)
-(Ex check_defs_1_two_nil_4 0,Vec(Int, 0),In check_defs_1_two_cons_2 1)
+(Ex check_defs_1_three_2_check'Con__1 0,Int,In check_defs_1_three_2_check'Con_cons 0)
+(Ex check_defs_1_three_2_check'Con_cons 0,Vec(Int, 3),In globals_decl_9_three 0)
+(Ex check_defs_1_two_check'Con__1 0,Int,In check_defs_1_two_check'Con_cons 0)
+(Ex check_defs_1_two_check'Con_check'Con_2__1 0,Int,In check_defs_1_two_check'Con_check'Con_2_cons 0)
+(Ex check_defs_1_two_check'Con_check'Con_2_check'Con_2_nil 0,Vec(Int, 0),In check_defs_1_two_check'Con_check'Con_2_cons 1)
+(Ex check_defs_1_two_check'Con_check'Con_2_cons 0,Vec(Int, 1),In check_defs_1_two_check'Con_cons 1)
+(Ex check_defs_1_two_check'Con_cons 0,Vec(Int, 2),In globals_decl_4_two 0)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Int_7 0,[],In globals_Vec_6 0)
 (Ex globals_Vec_1 0,[],In globals___kca_two 0)
 (Ex globals_Vec_6 0,[],In globals___kca_three_5 0)
 (Ex globals__3 0,Nat,In globals_Vec_1 1)
 (Ex globals__8 0,Nat,In globals_Vec_6 1)
-(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_1_cons 1)
+(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_2_check'Con_cons 1)
diff --git a/brat/test/golden/graph/id.brat.graph b/brat/test/golden/graph/id.brat.graph
index 16c379b7..f7ede146 100644
--- a/brat/test/golden/graph/id.brat.graph
+++ b/brat/test/golden/graph/id.brat.graph
@@ -1,22 +1,22 @@
 Nodes:
-(check_defs_1_main_thunk_3_lambda_10,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 0, portName = "a"},Qubit)]}),check_defs_1_main_thunk_3_lambda.0_rhs_thunk_8) :| [])) [("a",Qubit)] [("b",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_rhs/in_6,KernelNode Source [] [("q",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_rhs/out_7,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_thunk_3_lambda.0_rhs_thunk_8,BratNode (Box (fromList []) check_defs_1_main_thunk_3_lambda.0_rhs/in_6 check_defs_1_main_thunk_3_lambda.0_rhs/out_7) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_thunk_3_lambda.0_setup/in_2,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_setup/out_3,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_thunk_3_lambda.0_setup_thunk_4,BratNode (Box (fromList []) check_defs_1_main_thunk_3_lambda.0_setup/in_2 check_defs_1_main_thunk_3_lambda.0_setup/out_3) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_thunk/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_thunk/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_main_thunk/in check_defs_1_main_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q",Qubit)])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_check'Th_thunk/in check_defs_1_main_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_4,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_decl_5_main,BratNode Id [("a1",{ (a :: Qubit) -o (b :: Qubit) })] [("a1",{ (a :: Qubit) -o (b :: Qubit) })])
 
 Wires:
-(Ex check_defs_1_main_thunk/in 0,Qubit,In check_defs_1_main_thunk_3_lambda_10 0)
-(Ex check_defs_1_main_thunk_3_lambda.0_rhs/in_6 0,Qubit,In check_defs_1_main_thunk_3_lambda.0_rhs/out_7 0)
-(Ex check_defs_1_main_thunk_3_lambda_10 0,Qubit,In check_defs_1_main_thunk/out_1 0)
-(Ex check_defs_1_main_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_5_main 0)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 0,Qubit,In check_defs_1_main_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_check'Th_thunk/in 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 0)
+(Ex check_defs_1_main_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_5_main 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_4 0,[],In globals___kcr__3 0)
diff --git a/brat/test/golden/graph/kernel.brat.graph b/brat/test/golden/graph/kernel.brat.graph
index 9544c538..959a263c 100644
--- a/brat/test/golden/graph/kernel.brat.graph
+++ b/brat/test/golden/graph/kernel.brat.graph
@@ -1,18 +1,18 @@
 Nodes:
-(check_defs_1_id3_thunk_3_lambda_14,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 2, portName = "c1"},Qubit)]}),check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_12) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_nil_3,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/in_10,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/out_11,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_12,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 check_defs_1_id3_thunk_3_lambda.0_rhs/out_11) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_thunk_3_lambda.0_setup/in_6,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_setup/out_7,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_setup_thunk_8,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_setup/in_6 check_defs_1_id3_thunk_3_lambda.0_setup/out_7) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_id3_thunk/in check_defs_1_id3_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_nil_9,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
+(check_defs_1_id3_check'Th_LambdaChk_9_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
+(check_defs_1_id3_check'Th_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
+(check_defs_1_id3_check'Th_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_id3_check'Th_thunk/in check_defs_1_id3_check'Th_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 (globals__8,BratNode (Const 3) [] [("value",Nat)])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_3,BratNode (Constructor Qubit) [] [("value",[])])
@@ -22,18 +22,18 @@ Nodes:
 (globals_decl_9_id3,BratNode Id [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })] [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 
 Wires:
-(Ex check_defs_1_id3_thunk/in 0,Qubit,In check_defs_1_id3_thunk_3_lambda_14 0)
-(Ex check_defs_1_id3_thunk/in 1,Qubit,In check_defs_1_id3_thunk_3_lambda_14 1)
-(Ex check_defs_1_id3_thunk/in 2,Qubit,In check_defs_1_id3_thunk_3_lambda_14 2)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 0,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 1,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 2,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 0,Vec(Qubit, 3),In check_defs_1_id3_thunk_3_lambda.0_rhs/out_11 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 0,Vec(Qubit, 2),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 0,Vec(Qubit, 1),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_nil_3 0,Vec(Qubit, 0),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 1)
-(Ex check_defs_1_id3_thunk_3_lambda_14 0,Vec(Qubit, 3),In check_defs_1_id3_thunk/out_1 0)
-(Ex check_defs_1_id3_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 0,Vec(Qubit, 3),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 0,Vec(Qubit, 2),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 1)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 0,Vec(Qubit, 1),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 1)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 0)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 1,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 0)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 2,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 0)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_nil_9 0,Vec(Qubit, 0),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 1)
+(Ex check_defs_1_id3_check'Th_LambdaChk_9_lambda 0,Vec(Qubit, 3),In check_defs_1_id3_check'Th_thunk/out_1 0)
+(Ex check_defs_1_id3_check'Th_thunk/in 0,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 0)
+(Ex check_defs_1_id3_check'Th_thunk/in 1,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 1)
+(Ex check_defs_1_id3_check'Th_thunk/in 2,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 2)
+(Ex check_defs_1_id3_check'Th_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_3 0,[],In globals___kcr__1 1)
 (Ex globals_Qubit_4 0,[],In globals___kcr__1 2)
diff --git a/brat/test/golden/graph/list.brat.graph b/brat/test/golden/graph/list.brat.graph
index 255e1de0..ae89c017 100644
--- a/brat/test/golden/graph/list.brat.graph
+++ b/brat/test/golden/graph/list.brat.graph
@@ -1,22 +1,22 @@
 Nodes:
-(check_defs_1_xs__1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs__3,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs__5,BratNode (Const 3) [] [("value",Int)])
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_nil_6,BratNode (Constructor nil) [] [("value",List(Int))])
+(check_defs_1_xs_check'Con__1,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2__1,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2__1,BratNode (Const 3) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",List(Int))])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_List_1,BratNode (Constructor List) [("listValue",[])] [("value",[])])
 (globals_decl_3_xs,BratNode Id [("a1",List(Int))] [("a1",List(Int))])
 
 Wires:
-(Ex check_defs_1_xs__1 0,Int,In check_defs_1_xs_cons 0)
-(Ex check_defs_1_xs__3 0,Int,In check_defs_1_xs_cons_2 0)
-(Ex check_defs_1_xs__5 0,Int,In check_defs_1_xs_cons_4 0)
-(Ex check_defs_1_xs_cons 0,List(Int),In globals_decl_3_xs 0)
-(Ex check_defs_1_xs_cons_2 0,List(Int),In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_cons_4 0,List(Int),In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_nil_6 0,List(Int),In check_defs_1_xs_cons_4 1)
+(Ex check_defs_1_xs_check'Con__1 0,Int,In check_defs_1_xs_check'Con_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2__1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2__1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil 0,List(Int),In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 1)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0,List(Int),In check_defs_1_xs_check'Con_check'Con_2_cons 1)
+(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,List(Int),In check_defs_1_xs_check'Con_cons 1)
+(Ex check_defs_1_xs_check'Con_cons 0,List(Int),In globals_decl_3_xs 0)
 (Ex globals_Int_2 0,[],In globals_List_1 0)
 (Ex globals_List_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/num.brat.graph b/brat/test/golden/graph/num.brat.graph
index 27521a96..88aa4b00 100644
--- a/brat/test/golden/graph/num.brat.graph
+++ b/brat/test/golden/graph/num.brat.graph
@@ -1,17 +1,17 @@
 Nodes:
-(check_defs_1_m_1__1,BratNode (Const -3) [] [("value",Int)])
-(check_defs_1_m_1_doub,BratNode (Constructor doub) [("value",Int)] [("value",Int)])
-(check_defs_1_n__1,BratNode (Const 2) [] [("value",Nat)])
-(check_defs_1_n_succ,BratNode (Constructor succ) [("value",Nat)] [("value",Nat)])
+(check_defs_1_m_2_check'Con__1,BratNode (Const -3) [] [("value",Int)])
+(check_defs_1_m_2_check'Con_doub,BratNode (Constructor doub) [("value",Int)] [("value",Int)])
+(check_defs_1_n_check'Con__1,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_n_check'Con_succ,BratNode (Constructor succ) [("value",Nat)] [("value",Nat)])
 (globals_Int_4,BratNode (Constructor Int) [] [("value",[])])
 (globals_Nat_1,BratNode (Constructor Nat) [] [("value",[])])
 (globals_decl_2_n,BratNode Id [("a1",Nat)] [("a1",Nat)])
 (globals_decl_5_m,BratNode Id [("a1",Int)] [("a1",Int)])
 
 Wires:
-(Ex check_defs_1_m_1__1 0,Int,In check_defs_1_m_1_doub 0)
-(Ex check_defs_1_m_1_doub 0,Int,In globals_decl_5_m 0)
-(Ex check_defs_1_n__1 0,Nat,In check_defs_1_n_succ 0)
-(Ex check_defs_1_n_succ 0,Nat,In globals_decl_2_n 0)
+(Ex check_defs_1_m_2_check'Con__1 0,Int,In check_defs_1_m_2_check'Con_doub 0)
+(Ex check_defs_1_m_2_check'Con_doub 0,Int,In globals_decl_5_m 0)
+(Ex check_defs_1_n_check'Con__1 0,Nat,In check_defs_1_n_check'Con_succ 0)
+(Ex check_defs_1_n_check'Con_succ 0,Nat,In globals_decl_2_n 0)
 (Ex globals_Int_4 0,[],In globals___kca_m_3 0)
 (Ex globals_Nat_1 0,[],In globals___kca_n 0)
diff --git a/brat/test/golden/graph/pair.brat.graph b/brat/test/golden/graph/pair.brat.graph
index 42192ce4..4be2b30f 100644
--- a/brat/test/golden/graph/pair.brat.graph
+++ b/brat/test/golden/graph/pair.brat.graph
@@ -1,9 +1,9 @@
 Nodes:
-(check_defs_1_xs__1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
-(check_defs_1_xs_nil_4,BratNode (Constructor nil) [] [("value",[])])
-(check_defs_1_xs_true_3,BratNode (Constructor true) [] [("value",Bool)])
+(check_defs_1_xs_check'Con__1,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_1_true,BratNode (Constructor true) [] [("value",Bool)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",[])])
+(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
+(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
 (globals_Bool_4,BratNode (Constructor Bool) [] [("value",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_cons_1,BratNode (Constructor cons) [("head",[]),("tail",[])] [("value",[])])
@@ -12,11 +12,11 @@ Nodes:
 (globals_nil_5,BratNode (Constructor nil) [] [("value",[])])
 
 Wires:
-(Ex check_defs_1_xs__1 0,Int,In check_defs_1_xs_cons 0)
-(Ex check_defs_1_xs_cons 0,[Int,Bool],In globals_decl_6_xs 0)
-(Ex check_defs_1_xs_cons_2 0,[Bool],In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_nil_4 0,[],In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_true_3 0,Bool,In check_defs_1_xs_cons_2 0)
+(Ex check_defs_1_xs_check'Con__1 0,Int,In check_defs_1_xs_check'Con_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_1_true 0,Bool,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_nil 0,[],In check_defs_1_xs_check'Con_check'Con_2_cons 1)
+(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,[Bool],In check_defs_1_xs_check'Con_cons 1)
+(Ex check_defs_1_xs_check'Con_cons 0,[Int,Bool],In globals_decl_6_xs 0)
 (Ex globals_Bool_4 0,[],In globals_cons_3 0)
 (Ex globals_Int_2 0,[],In globals_cons_1 0)
 (Ex globals_cons_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/rx.brat.graph b/brat/test/golden/graph/rx.brat.graph
index 5f241723..2adaa745 100644
--- a/brat/test/golden/graph/rx.brat.graph
+++ b/brat/test/golden/graph/rx.brat.graph
@@ -1,15 +1,15 @@
 Nodes:
-(check_defs_1_main_2_thunk_3_lambda_11,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_2_thunk_3_lambda.0_setup/in_3 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_2_thunk_3_lambda.0_setup/in_3 0, portName = "a"},Qubit)]}),check_defs_1_main_2_thunk_3_lambda.0_rhs_thunk_9) :| [])) [("a",Qubit)] [("b",Qubit)])
-(check_defs_1_main_2_thunk_3_lambda.0_rhs_10_,KernelNode (Splice (Ex globals_decl_18_xish 0)) [("rxa",Qubit)] [("rxb",Qubit)])
-(check_defs_1_main_2_thunk_3_lambda.0_rhs/in_7,KernelNode Source [] [("q",Qubit)])
-(check_defs_1_main_2_thunk_3_lambda.0_rhs/out_8,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_2_thunk_3_lambda.0_rhs_thunk_9,BratNode (Box (fromList []) check_defs_1_main_2_thunk_3_lambda.0_rhs/in_7 check_defs_1_main_2_thunk_3_lambda.0_rhs/out_8) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_2_thunk_3_lambda.0_setup/in_3,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_2_thunk_3_lambda.0_setup/out_4,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_2_thunk_3_lambda.0_setup_thunk_5,BratNode (Box (fromList []) check_defs_1_main_2_thunk_3_lambda.0_setup/in_3 check_defs_1_main_2_thunk_3_lambda.0_setup/out_4) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_2_thunk/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_2_thunk/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_2_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_main_2_thunk/in check_defs_1_main_2_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1__6,KernelNode (Splice (Ex globals_decl_18_xish 0)) [("rxa",Qubit)] [("rxb",Qubit)])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q",Qubit)])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_3_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_3_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_3_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_3_check'Th_thunk/in check_defs_1_main_3_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
 (check_defs_1_nums_,BratNode (Const 1) [] [("value",Int)])
 (check_defs_1_nums__1,BratNode (Const 2) [] [("value",Int)])
 (check_defs_1_nums__2,BratNode (Const 3) [] [("value",Int)])
@@ -31,11 +31,11 @@ Nodes:
 (globals_prim_7_Rx,BratNode (Prim ("","Rx")) [] [("thunk",{ (th :: Float) -> (a1 :: { (rxa :: Qubit) -o (rxb :: Qubit) }) })])
 
 Wires:
-(Ex check_defs_1_main_2_thunk/in 0,Qubit,In check_defs_1_main_2_thunk_3_lambda_11 0)
-(Ex check_defs_1_main_2_thunk_3_lambda.0_rhs/in_7 0,Qubit,In check_defs_1_main_2_thunk_3_lambda.0_rhs_10_ 0)
-(Ex check_defs_1_main_2_thunk_3_lambda.0_rhs_10_ 0,Qubit,In check_defs_1_main_2_thunk_3_lambda.0_rhs/out_8 0)
-(Ex check_defs_1_main_2_thunk_3_lambda_11 0,Qubit,In check_defs_1_main_2_thunk/out_1 0)
-(Ex check_defs_1_main_2_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_24_main 0)
+(Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1__6 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1__6 0)
+(Ex check_defs_1_main_3_check'Th_LambdaChk_6_lambda 0,Qubit,In check_defs_1_main_3_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_3_check'Th_thunk/in 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_lambda 0)
+(Ex check_defs_1_main_3_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_24_main 0)
 (Ex check_defs_1_nums_ 0,Int,In globals_decl_12_nums 0)
 (Ex check_defs_1_nums__1 0,Int,In globals_decl_12_nums 1)
 (Ex check_defs_1_nums__2 0,Int,In globals_decl_12_nums 2)
diff --git a/brat/test/golden/graph/swap.brat.graph b/brat/test/golden/graph/swap.brat.graph
index 8372d6db..bdb5e50e 100644
--- a/brat/test/golden/graph/swap.brat.graph
+++ b/brat/test/golden/graph/swap.brat.graph
@@ -1,14 +1,14 @@
 Nodes:
-(check_defs_1_main_thunk_3_lambda_10,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_thunk_3_lambda.0_setup/in_2 1, portName = "b"},Qubit)]}),check_defs_1_main_thunk_3_lambda.0_rhs_thunk_8) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_rhs/in_6,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_rhs/out_7,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_thunk_3_lambda.0_rhs_thunk_8,BratNode (Box (fromList []) check_defs_1_main_thunk_3_lambda.0_rhs/in_6 check_defs_1_main_thunk_3_lambda.0_rhs/out_7) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_thunk_3_lambda.0_setup/in_2,KernelNode Source [] [("a",Qubit),("b",Qubit)])
-(check_defs_1_main_thunk_3_lambda.0_setup/out_3,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_thunk_3_lambda.0_setup_thunk_4,BratNode (Box (fromList []) check_defs_1_main_thunk_3_lambda.0_setup/in_2 check_defs_1_main_thunk_3_lambda.0_setup/out_3) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
-(check_defs_1_main_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_main_thunk/in check_defs_1_main_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_check'Th_LambdaChk_5_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
+(check_defs_1_main_check'Th_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
+(check_defs_1_main_check'Th_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_check'Th_thunk/in check_defs_1_main_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_3,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_5,BratNode (Constructor Qubit) [] [("value",[])])
@@ -16,13 +16,13 @@ Nodes:
 (globals_decl_7_main,BratNode Id [("a1",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })] [("a1",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
 
 Wires:
-(Ex check_defs_1_main_thunk/in 0,Qubit,In check_defs_1_main_thunk_3_lambda_10 0)
-(Ex check_defs_1_main_thunk/in 1,Qubit,In check_defs_1_main_thunk_3_lambda_10 1)
-(Ex check_defs_1_main_thunk_3_lambda.0_rhs/in_6 0,Qubit,In check_defs_1_main_thunk_3_lambda.0_rhs/out_7 1)
-(Ex check_defs_1_main_thunk_3_lambda.0_rhs/in_6 1,Qubit,In check_defs_1_main_thunk_3_lambda.0_rhs/out_7 0)
-(Ex check_defs_1_main_thunk_3_lambda_10 0,Qubit,In check_defs_1_main_thunk/out_1 0)
-(Ex check_defs_1_main_thunk_3_lambda_10 1,Qubit,In check_defs_1_main_thunk/out_1 1)
-(Ex check_defs_1_main_thunk_thunk_2 0,{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) },In globals_decl_7_main 0)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 1)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 1,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 0)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 0,Qubit,In check_defs_1_main_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 1,Qubit,In check_defs_1_main_check'Th_thunk/out_1 1)
+(Ex check_defs_1_main_check'Th_thunk/in 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 0)
+(Ex check_defs_1_main_check'Th_thunk/in 1,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 1)
+(Ex check_defs_1_main_check'Th_thunk_thunk_2 0,{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) },In globals_decl_7_main 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_3 0,[],In globals___kcr__1 1)
 (Ex globals_Qubit_5 0,[],In globals___kcr__4 0)
diff --git a/brat/test/golden/graph/vec.brat.graph b/brat/test/golden/graph/vec.brat.graph
index 100f9489..b28a8c96 100644
--- a/brat/test/golden/graph/vec.brat.graph
+++ b/brat/test/golden/graph/vec.brat.graph
@@ -1,24 +1,24 @@
 Nodes:
-(check_defs_1_xs__1,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_xs__3,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs__5,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_xs_nil_6,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_xs_check'Con__1,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2__1,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2__1,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
+(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
 (globals__3,BratNode (Const 3) [] [("value",Nat)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Vec_1,BratNode (Constructor Vec) [("X",[]),("n",Nat)] [("value",[])])
 (globals_decl_4_xs,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-(Ex check_defs_1_xs__1 0,Int,In check_defs_1_xs_cons 0)
-(Ex check_defs_1_xs__3 0,Int,In check_defs_1_xs_cons_2 0)
-(Ex check_defs_1_xs__5 0,Int,In check_defs_1_xs_cons_4 0)
-(Ex check_defs_1_xs_cons 0,Vec(Int, 3),In globals_decl_4_xs 0)
-(Ex check_defs_1_xs_cons_2 0,Vec(Int, 2),In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_cons_4 0,Vec(Int, 1),In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_nil_6 0,Vec(Int, 0),In check_defs_1_xs_cons_4 1)
+(Ex check_defs_1_xs_check'Con__1 0,Int,In check_defs_1_xs_check'Con_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2__1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2__1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil 0,Vec(Int, 0),In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 1)
+(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0,Vec(Int, 1),In check_defs_1_xs_check'Con_check'Con_2_cons 1)
+(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,Vec(Int, 2),In check_defs_1_xs_check'Con_cons 1)
+(Ex check_defs_1_xs_check'Con_cons 0,Vec(Int, 3),In globals_decl_4_xs 0)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Vec_1 0,[],In globals___kca_xs 0)
 (Ex globals__3 0,Nat,In globals_Vec_1 1)

From d081457aa846529687646f4df4a0ff40cfb182f7 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 1 Apr 2025 19:37:51 +0100
Subject: [PATCH 099/182] Remove RemoveHope, Define does it automatically

---
 brat/Brat/Checker/Monad.hs      | 6 ------
 brat/Brat/Checker/SolveHoles.hs | 1 -
 2 files changed, 7 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 78562424..d18fbe92 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -107,7 +107,6 @@ data CheckingSig ty where
   Declare :: End -> Modey m -> BinderType m -> Bool -> CheckingSig () -- Bool = is-skolem
   ANewHope :: InPort -> FC -> CheckingSig ()
   AskHopes :: CheckingSig Hopes
-  RemoveHope :: InPort -> CheckingSig () -- ALAN ?
   AddCapture :: Name -> (QualName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 wrapper :: (forall a. CheckingSig a -> Checking (Maybe a)) -> Checking v -> Checking v
@@ -301,11 +300,6 @@ handler (Req s k) ctx g
 
       AskHopes -> handler (k (hopes ctx)) ctx g
 
-      RemoveHope e -> let hset = hopes ctx in
-                        if M.member e hset
-                        then handler (k ()) (ctx { hopes = M.delete e hset }) g
-                        else Left (dumbErr (InternalError ("Trying to remove unknown Hope: " ++ show e)))
-
       AddCapture n (var, ends) ->
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g
 
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 944b9b53..3fde7c08 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -104,7 +104,6 @@ solveHope k hope v = quote Zy v >>= \v -> case doesntOccur (InEnd hope) v of
       (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
       _ -> buildConst Unit TUnit
     req (Wire (end dangling, kindType k, hope))
-    req (RemoveHope hope)
   Left msg -> case v of
     VApp (VPar (InEnd end)) B0 | hope == end -> pure ()
     -- TODO: Not all occurrences are toxic. The end could be in an argument

From 2c44b1dd748da0938a2fa477775c91395985c453 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Wed, 2 Apr 2025 12:22:40 +0100
Subject: [PATCH 100/182] Replace Bool with IsSkolem = SkolemConst | Definable

---
 brat/Brat/Checker.hs            |  4 ++--
 brat/Brat/Checker/Helpers.hs    | 12 ++++++------
 brat/Brat/Checker/Monad.hs      | 10 +++++-----
 brat/Brat/Checker/SolveHoles.hs |  4 ++--
 brat/Brat/Checker/Types.hs      |  7 +++++--
 brat/test/Main.hs               |  5 +++--
 6 files changed, 23 insertions(+), 19 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index c04f46b6..abd73b26 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -223,7 +223,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       -- with the other clauses, as part of the body.
       (ins :->> outs) <- mkSig usedOvers unders
       (allFakeUnders, rightFakeUnders, tgtMap) <- suppressHoles $ suppressGraph $ do
-        (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins True
+        (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins SkolemConst
         -- Hypo `check` calls need an environment, even just to compute leftovers;
         -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
         let srcMap = fromJust $ zipSameLength (fst <$> usedOvers) (fst <$> fakeOvers)
@@ -968,7 +968,7 @@ kindCheckRow' :: forall m n
 kindCheckRow' _ ez env (_,i) [] = pure (i, env, Some (ez :* R0))
 kindCheckRow' Braty (ny :* s) env (name,i) ((p, Left k):rest) = do -- s is Stack Z n
   let dangling = Ex name (ny2int ny)
-  req (Declare (ExEnd dangling) Braty (Left k) False) -- assume none are Skolem consts??
+  req (Declare (ExEnd dangling) Braty (Left k) Definable) -- assume none are SkolemConst??
   env <- pure $ M.insert (plain p) [(NamedPort dangling p, Left k)] env
   (i, env, ser) <- kindCheckRow' Braty (Sy ny :* (s :<< ExEnd dangling)) env (name, i) rest
   case ser of
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 38adde10..495b8e0a 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -42,8 +42,8 @@ simpleCheck my ty tm = case (my, ty) of
         Num n | n < 0 -> defineEnd e TInt
         Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
     else isSkolem e >>= \case
-      True -> throwLeft $ helper Braty ty tm
-      False -> do
+      SkolemConst -> throwLeft $ helper Braty ty tm
+      Definable -> do
         mkYield "simpleCheck" (S.singleton e)
         ty <- eval S0 ty
         simpleCheck Braty ty tm
@@ -166,8 +166,8 @@ anext :: forall m i j k
       -> Ro m j k
       -> Checking (Name, Unders m Chk, Overs m UVerb, (Semz k, Some Endz))
 anext str th vals0 ins outs = anext' str th vals0 ins outs $ case th of
-  Source -> True
-  _ -> False
+  Source -> SkolemConst
+  _ -> Definable
 
 anext' :: forall m i j k
        . EvMode m
@@ -176,7 +176,7 @@ anext' :: forall m i j k
       -> (Semz i, Some Endz)
       -> Ro m i j -- Inputs and Outputs use de Bruijn indices
       -> Ro m j k
-      -> Bool -- whether outports are skolem consts (will never be defined), inports never are
+      -> IsSkolem -- inports are always Definable
       -> Checking (Name, Unders m Chk, Overs m UVerb, (Semz k, Some Endz))
 anext' str th vals0 ins outs skol = do
   node <- req (Fresh str) -- Pick a name for the thunk
@@ -351,7 +351,7 @@ defineTgt :: Tgt -> Val Z -> Checking ()
 defineTgt tgt = defineEnd (InEnd (end tgt))
 
 declareTgt :: Tgt -> Modey m -> BinderType m -> Checking ()
-declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty False)
+declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty Definable)
 
 -- listToRow :: [(PortName, BinderType m)] -> Ro m Z i
 -- listToRow [] = R0
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index d18fbe92..7a8eb791 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -99,12 +99,12 @@ data CheckingSig ty where
   ELup    :: End -> CheckingSig (Maybe (Val Z))
   -- Lookup an alias in the table
   ALup    :: QualName -> CheckingSig (Maybe Alias)
-  TypeOf  :: End -> CheckingSig (EndType, Bool) -- Bool = is-skolem
+  TypeOf  :: End -> CheckingSig (EndType, IsSkolem)
   AddNode :: Name -> Node -> CheckingSig ()
   Wire    :: Wire -> CheckingSig ()
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
-  Declare :: End -> Modey m -> BinderType m -> Bool -> CheckingSig () -- Bool = is-skolem
+  Declare :: End -> Modey m -> BinderType m -> IsSkolem -> CheckingSig ()
   ANewHope :: InPort -> FC -> CheckingSig ()
   AskHopes :: CheckingSig Hopes
   AddCapture :: Name -> (QualName, [(Src, BinderType Brat)]) -> CheckingSig ()
@@ -228,9 +228,9 @@ localKVar env (Fork desc par c) =
   -- can't send end both ways, so until we can join (TODO), restrict Forks to local scope
   thTrace ("Spawning(LKV) " ++ desc) $ localKVar env $ par *> c
 
--- Skolem constants are e.g. function parameters that are *not* going to be defined if we wait.
+-- SkolemConst constants are e.g. function parameters that are *not* going to be defined if we wait.
 -- (exception: clause inputs can sometimes be defined if there is exactly one possible value).
-isSkolem :: End -> Checking Bool
+isSkolem :: End -> Checking IsSkolem
 isSkolem e = req (TypeOf e) <&> snd
 
 catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
@@ -312,7 +312,7 @@ handler (Define end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = store c
         -- TODO(1) can we check the value is of the kind declared?
         -- TODO(2) it'd be better to figure out if the end is really Unstuck,
         -- or just awaiting some other end, but that seems overly complex atm, as
-        -- (a) we must be "Unstuck" if the end is Defined to something Skolem *OR* in the HopeSet,
+        -- (a) we must be "Unstuck" if the end is Defined to something SkolemConst *OR* in the HopeSet,
         -- (b) Numbers are tricky, whether they are stuck or not depends upon the question
         -- (c) since there are no infinite end-creating loops, it's correct (merely inefficient)
         -- to just "have another go".
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 3fde7c08..6069db84 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -2,7 +2,7 @@ module Brat.Checker.SolveHoles (typeEq) where
 
 import Brat.Checker.Helpers (buildNatVal, buildConst)
 import Brat.Checker.Monad
-import Brat.Checker.Types (kindForMode)
+import Brat.Checker.Types (kindForMode, IsSkolem(..))
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common
@@ -82,7 +82,7 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   let ends = mapMaybe getEnd [exp,act]
   -- sanity check: we've already dealt with either end being in the hopeset
   when (or [M.member ie hopes | InEnd ie <- ends]) $ typeErr "ends were in hopeset"
-  filterM (isSkolem >=> pure . not) ends >>= \case
+  filterM (isSkolem >=> pure . (== Definable)) ends >>= \case
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
     es -> -- tricky: must wait for one or other to become more defined
diff --git a/brat/Brat/Checker/Types.hs b/brat/Brat/Checker/Types.hs
index 9f37e6a3..52fedf99 100644
--- a/brat/Brat/Checker/Types.hs
+++ b/brat/Brat/Checker/Types.hs
@@ -5,7 +5,7 @@ module Brat.Checker.Types (Overs, Unders
                           ,ChkConnectors, SynConnectors
                           ,Mode(..), Modey(..)
                           ,Env, VEnv, KEnv, EnvData
-                          ,Store(..), EndType(..)
+                          ,IsSkolem(..), Store(..), EndType(..)
                           ,emptyEnv
                           ,TypedHole(..), HoleTag(..), HoleData(..)
                           ,initStore
@@ -94,8 +94,11 @@ instance Show EndType where
   show (EndType Braty (Left k)) = show k
   show (EndType Braty (Right ty)) = show ty
 
+data IsSkolem = SkolemConst | Definable
+  deriving (Eq, Show)
+
 data Store = Store
-  { typeMap  :: M.Map End (EndType, Bool) -- True = is skolem const, will never be defined
+  { typeMap  :: M.Map End (EndType, IsSkolem)
   , valueMap :: M.Map End (Val Z)
   }
 
diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 84a659af..8bf0e362 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -16,6 +16,7 @@ import Test.Syntax.Let
 import Test.TypeArith
 
 import Brat.Checker.Monad
+import Brat.Checker.Types (IsSkolem(..))
 import Brat.Syntax.Common
 import Brat.Syntax.Value
 import Brat.QualName
@@ -30,7 +31,7 @@ coroT1 :: Checking ()
 coroT1 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
-  req $ Declare e Braty (Left $ Star []) False
+  req $ Declare e Braty (Left $ Star []) Definable
   mkFork "t1" (req (ELup e) >>= \case
           Just _ -> err $ InternalError "already defined"
           Nothing -> defineEnd e (VCon (PrefixName [] "nil") [])
@@ -46,7 +47,7 @@ coroT2 :: Checking ()
 coroT2 = do
   name <- req (Fresh "anything")
   let e = InEnd $ In name 0
-  req $ Declare e Braty (Left $ Star []) False
+  req $ Declare e Braty (Left $ Star []) Definable
   v <- do
     mkYield "coroT2" (S.singleton e)
     req $ ELup e

From 61dd235a7dd8a0ae72df248cf65e8d5cf9fb26a8 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 2 Apr 2025 15:28:14 +0100
Subject: [PATCH 101/182] [ progress ] factored out SolveNumbers; started numEq
 (to be nuked)

---
 brat/Brat/Checker/Monad.hs         |   1 +
 brat/Brat/Checker/SolveHoles.hs    | 147 ++++++++++++++++++++++++++-
 brat/Brat/Checker/SolveNumbers.hs  | 158 +++++++++++++++++++++++++++++
 brat/Brat/Checker/SolvePatterns.hs | 154 +---------------------------
 brat/Brat/Eval.hs                  |   6 ++
 brat/brat.cabal                    |   1 +
 6 files changed, 312 insertions(+), 155 deletions(-)
 create mode 100644 brat/Brat/Checker/SolveNumbers.hs

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index baecc9e6..eeb2b2e2 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -333,3 +333,4 @@ localNS ns (Req c k) = Req c (localNS ns . k)
 
 defineEnd :: End -> Val Z -> Checking ()
 defineEnd e v = req (Define e v)
+
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index fd864aaf..b873bbd4 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -11,6 +11,7 @@ import Brat.Syntax.Value
 import Control.Monad.Freer
 import Bwd
 import Hasochism
+-- import Brat.Syntax.Port (toEnd)
 
 import Control.Monad (when)
 import Data.Bifunctor (second)
@@ -20,6 +21,10 @@ import Data.Maybe (mapMaybe)
 import qualified Data.Map as M
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
+import Debug.Trace
+
+trunk = trace
+
 -- Demand that two closed values are equal, we're allowed to solve variables in the
 -- hope set to make this true.
 -- Raises a user error if the vals cannot be made equal.
@@ -42,11 +47,145 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
   hopes <- req AskHopes
   exp <- sem sems exp
   act <- sem sems act
-  typeEqEta str stuff hopes k exp act
+  trunk ("TYPEEQ' " ++ show exp ++ " =? " ++ show act) $ typeEqEta str stuff hopes k exp act
 
+{-
 isNumVar :: Sem -> Maybe SVar
 isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
 isNumVar _ = Nothing
+-}
+
+natEq :: NumVal SVar -> NumVal SVar -> Checking ()
+natEq i j | i == j = pure ()
+natEq (NumValue lup lgro) (NumValue rup rgro)
+  | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
+  | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
+ where
+  solveNumMeta :: End -> NumVal SVar -> Checking ()
+  solveNumMeta e num = typeErr $ "SOLVENUMMETA " ++ show e ++ " " ++ show num
+
+  lhsFun00 :: Fun00 SVar -> NumVal SVar -> Checking ()
+  lhsFun00 Constant0 num = demand0 num
+  lhsFun00 (StrictMonoFun sm) num = lhsStrictMono sm num
+
+  lhsStrictMono :: StrictMono SVar -> NumVal SVar -> Checking ()
+  lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
+  lhsStrictMono (StrictMono n mono) num = do
+    num <- demandEven num
+    lhsStrictMono (StrictMono (n - 1) mono) num
+
+  lhsMono :: Monotone SVar -> NumVal SVar -> Checking ()
+  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
+  lhsMono (Linear (SPar e)) num = -- throwLeft (doesntOccur e (SNum num)) *>
+                                  solveNumMeta e num
+  lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
+    = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
+  lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
+  lhsMono (Full sm) (NumValue up gro) = do
+    smPred <- demandSucc sm
+    natEq (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
+
+  demand0 :: NumVal SVar -> Checking ()
+  demand0 (NumValue 0 Constant0) = pure ()
+  demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
+    Linear (SPar e) -> solveNumMeta e (nConstant 0)
+    Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
+    _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
+  demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
+
+  -- Complain if a number isn't a successor, else return its predecessor
+  demandSucc :: StrictMono SVar -> Checking (NumVal SVar)
+  --   2^k * x
+  -- = 2^k * (y + 1)
+  -- = 2^k + 2^k * y
+  demandSucc (StrictMono _{-k-} (Linear (SPar (ExEnd x)))) = do
+    {-
+    (_, [(yTgt, _)], [(ySrc, _)], _) <-
+      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
+
+    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
+    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
+    -}
+    typeErr $ "DEMANDSUCC EX " ++ show x
+  --   2^k * x
+  -- = 2^k * (y + 1)
+  -- = 2^k + 2^k * y
+  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
+  demandSucc (StrictMono _{-k-} (Linear (SPar (InEnd x)))) = do
+    {-
+    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
+    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
+    solveNumMeta (InEnd x) (nVar (SPar (toEnd yPlus1)))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
+    -}
+    typeErr $ "DEMANDSUCC IN " ++ show x
+
+  --   2^k * full(n + 1)
+  -- = 2^k * (1 + 2 * full(n))
+  -- = 2^k + 2^(k + 1) * full(n)
+  demandSucc (StrictMono k (Full nPlus1)) = do
+    n <- demandSucc nPlus1
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
+  demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
+
+  -- Complain if a number isn't even, otherwise return half
+  demandEven :: NumVal SVar -> Checking (NumVal SVar)
+  demandEven n@(NumValue up gro) = case up `divMod` 2 of
+    (up, 0) -> NumValue up <$> evenGro gro
+    (up, 1) -> nPlus (up + 1) <$> oddGro gro
+   where
+    evenGro :: Fun00 SVar -> Checking (Fun00 SVar)
+    evenGro Constant0 = pure Constant0
+    evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
+      Linear (SPar (ExEnd out)) -> do
+        {-
+        (_, [], [(halfSrc, _)], _) <-
+          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
+	-}
+	typeErr $ "EVENGRO EX " ++ show out
+      Linear (SPar (InEnd tgt)) -> do
+        {-
+        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
+        let half = nVar (VPar (toEnd halfTgt))
+        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
+        pure (StrictMonoFun (StrictMono 0 (Linear (SPar (toEnd halfTgt)))))
+	-}
+	typeErr $ "EVENGRO IN " ++ show tgt
+      Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
+    evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
+
+    -- Check a numval is odd, and return its rounded down half
+    oddGro :: Fun00 SVar -> Checking (NumVal SVar)
+    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
+      -- TODO: Why aren't we using `out`??
+      Linear (SPar (ExEnd bubble)) -> do
+        -- compute (/2) . (-1)
+	{-
+        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
+        pure (nVar (VPar (toEnd halfSrc)))
+	-}
+	typeErr $ "ODDGRO EX " ++ show bubble
+      Linear (SPar (InEnd weeTgt)) -> do
+        -- compute (/2) . (-1)
+	{-
+        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
+        let flooredHalf = nVar (VPar (toEnd weeTgt))
+        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
+        pure flooredHalf
+	-}
+	typeErr $ "ODDGRO IN " ++ show weeTgt
+
+      -- full(n + 1) = 1 + 2 * full(n)
+      -- hence, full(n) is the rounded down half
+      Full sm -> nFull <$> demandSucc sm
+    oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+
+
+
 
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
@@ -70,9 +209,11 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
   | M.member e hopes = solveHope k e act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
   | M.member e hopes = solveHope k e exp
-typeEqEta _ (Zy :* _ :* _) hopes Nat exp act
+typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = natEq exp act
+  {-
   | Just (SPar (InEnd e)) <- isNumVar exp, M.member e hopes = solveHope Nat e act
   | Just (SPar (InEnd e)) <- isNumVar act, M.member e hopes = solveHope Nat e exp
+  -}
 -- 2. harder cases, neither is in the hope set, so we can't define it ourselves
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
@@ -145,7 +286,7 @@ typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
   act <- sem semz act
   if getNum exp == getNum act
   then pure ()
-  else err $ TypeMismatch tm (show exp) (show act)
+  else trunk "HELLO TYPEEQRIGID TODO" $ err $ TypeMismatch tm ("TYPEEQRIGID " ++ show exp) ("TODO " ++ show act)
 typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
   svKind f >>= \case
     TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
new file mode 100644
index 00000000..ec3497e9
--- /dev/null
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -0,0 +1,158 @@
+module Brat.Checker.SolveNumbers (unifyNum) where
+
+import Brat.Checker.Monad
+import Brat.Checker.Helpers
+import Brat.Syntax.Value
+import Brat.Syntax.Common
+import Brat.Syntax.Port
+import Brat.Error
+import Brat.Eval
+import Brat.Graph (NodeType(..))
+import Hasochism
+
+-- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
+-- makes the dynamic wiring for a metavariable. This only needs to happen for
+-- numbers because they have nontrivial runtime behaviour.
+--
+-- We assume that the caller has done the occurs check and rules out trivial equations.
+solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
+solveNumMeta e nv = case (e, vars nv) of
+ -- Compute the thing that the rhs should be based on the src, and instantiate src to that
+ (ExEnd src,  [VPar (InEnd _tgt)]) -> do
+   -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
+   tgtSrc <- invertNatVal nv
+   instantiateMeta (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
+   wire (NamedPort src "", TNat, tgtSrc)
+
+ (ExEnd src, _) -> instantiateMeta (ExEnd src) (VNum nv)
+
+ -- Both targets, we need to create the thing that they both derive from
+ (InEnd bigTgt, [VPar (InEnd weeTgt)]) -> do
+   (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
+                                         (REx ("n", Nat) R0) (REx ("n", Nat) R0)
+   defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
+   instantiateMeta (InEnd weeTgt) (VNum (nVar (VPar (toEnd idSrc))))
+   wire (idSrc, TNat, NamedPort weeTgt "")
+   let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
+   bigSrc <- buildNatVal nv'
+   instantiateMeta (InEnd bigTgt) (VNum nv')
+   wire (bigSrc, TNat, NamedPort bigTgt "")
+
+ -- RHS is constant or Src, wire it into tgt
+ (InEnd tgt,  _) -> do
+   src <- buildNatVal nv
+   instantiateMeta (InEnd tgt) (VNum nv)
+   wire (src, TNat, NamedPort tgt "")
+ where
+  vars :: NumVal a -> [a]
+  vars = foldMap pure
+
+-- Need to keep track of which way we're solving - which side is known/unknown
+-- Things which are dynamically unknown must be Tgts - information flows from Srcs
+-- ...But we don't need to do any wiring here, right?
+unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum (NumValue lup lgro) (NumValue rup rgro)
+  | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
+  | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
+ where
+  lhsFun00 :: Fun00 (VVar Z) -> NumVal (VVar Z) -> Checking ()
+  lhsFun00 Constant0 num = demand0 num
+  lhsFun00 (StrictMonoFun sm) num = lhsStrictMono sm num
+
+  lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
+  lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
+  lhsStrictMono (StrictMono n mono) num = do
+    num <- demandEven num
+    lhsStrictMono (StrictMono (n - 1) mono) num
+
+  lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
+  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
+  lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
+                                  solveNumMeta e num
+  lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
+    = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
+  lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
+  lhsMono (Full sm) (NumValue up gro) = do
+    smPred <- demandSucc sm
+    unifyNum (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
+
+  demand0 :: NumVal (VVar Z) -> Checking ()
+  demand0 (NumValue 0 Constant0) = pure ()
+  demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
+    Linear (VPar e) -> solveNumMeta e (nConstant 0)
+    Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
+    _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
+  demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
+
+  -- Complain if a number isn't a successor, else return its predecessor
+  demandSucc :: StrictMono (VVar Z) -> Checking (NumVal (VVar Z))
+  --   2^k * x
+  -- = 2^k * (y + 1)
+  -- = 2^k + 2^k * y
+  demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
+    (_, [(yTgt, _)], [(ySrc, _)], _) <-
+      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
+
+    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
+    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
+  --   2^k * x
+  -- = 2^k * (y + 1)
+  -- = 2^k + 2^k * y
+  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
+  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = do
+    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
+    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
+    solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
+
+  --   2^k * full(n + 1)
+  -- = 2^k * (1 + 2 * full(n))
+  -- = 2^k + 2^(k + 1) * full(n)
+  demandSucc (StrictMono k (Full nPlus1)) = do
+    n <- demandSucc nPlus1
+    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
+  demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
+
+  -- Complain if a number isn't even, otherwise return half
+  demandEven :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
+  demandEven n@(NumValue up gro) = case up `divMod` 2 of
+    (up, 0) -> NumValue up <$> evenGro gro
+    (up, 1) -> nPlus (up + 1) <$> oddGro gro
+   where
+    evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
+    evenGro Constant0 = pure Constant0
+    evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
+      Linear (VPar (ExEnd out)) -> do
+        (_, [], [(halfSrc, _)], _) <-
+          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
+      Linear (VPar (InEnd tgt)) -> do
+        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
+        let half = nVar (VPar (toEnd halfTgt))
+        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
+      Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
+    evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
+
+    -- Check a numval is odd, and return its rounded down half
+    oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
+    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
+      -- TODO: Why aren't we using `out`??
+      Linear (VPar (ExEnd bubble)) -> do
+        -- compute (/2) . (-1)
+        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
+        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
+        pure (nVar (VPar (toEnd halfSrc)))
+      Linear (VPar (InEnd weeTgt)) -> do
+        -- compute (/2) . (-1)
+        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
+        let flooredHalf = nVar (VPar (toEnd weeTgt))
+        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
+        pure flooredHalf
+
+      -- full(n + 1) = 1 + 2 * full(n)
+      -- hence, full(n) is the rounded down half
+      Full sm -> nFull <$> demandSucc sm
+    oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 8525de1e..af68231e 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -3,6 +3,7 @@ module Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
 import Brat.Checker.Types (EndType(..))
+import Brat.Checker.SolveNumbers
 import Brat.Constructors
 import Brat.Constructors.Patterns
 import Brat.Error
@@ -16,13 +17,13 @@ import Brat.QualName
 import Bwd
 import Control.Monad.Freer
 import Hasochism
+import Brat.Syntax.Port (toEnd)
 
 import Control.Monad (unless)
 import Data.Bifunctor (first)
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Data.Type.Equality ((:~:)(..), testEquality)
-import Brat.Syntax.Port (toEnd)
 
 -- Refine clauses from function definitions (and potentially future case statements)
 -- by processing each one in sequence. This will involve repeating tests for various
@@ -193,157 +194,6 @@ unify l k r = do
 
 -- Solve a metavariable statically - don't do anything dynamic
 -- Once a metavariable is solved, we expect to not see it again in a normal form.
-instantiateMeta :: End -> Val Z -> Checking ()
-instantiateMeta e val = do
-  throwLeft (doesntOccur e val)
-  defineEnd e val
-
--- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
--- makes the dynamic wiring for a metavariable. This only needs to happen for
--- numbers because they have nontrivial runtime behaviour.
---
--- We assume that the caller has done the occurs check and rules out trivial equations.
-solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
-solveNumMeta e nv = case (e, vars nv) of
- -- Compute the thing that the rhs should be based on the src, and instantiate src to that
- (ExEnd src,  [VPar (InEnd _tgt)]) -> do
-   -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
-   tgtSrc <- invertNatVal nv
-   instantiateMeta (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
-   wire (NamedPort src "", TNat, tgtSrc)
-
- (ExEnd src, _) -> instantiateMeta (ExEnd src) (VNum nv)
-
- -- Both targets, we need to create the thing that they both derive from
- (InEnd bigTgt, [VPar (InEnd weeTgt)]) -> do
-   (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
-                                         (REx ("n", Nat) R0) (REx ("n", Nat) R0)
-   defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
-   instantiateMeta (InEnd weeTgt) (VNum (nVar (VPar (toEnd idSrc))))
-   wire (idSrc, TNat, NamedPort weeTgt "")
-   let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
-   bigSrc <- buildNatVal nv'
-   instantiateMeta (InEnd bigTgt) (VNum nv')
-   wire (bigSrc, TNat, NamedPort bigTgt "")
-
- -- RHS is constant or Src, wire it into tgt
- (InEnd tgt,  _) -> do
-   src <- buildNatVal nv
-   instantiateMeta (InEnd tgt) (VNum nv)
-   wire (src, TNat, NamedPort tgt "")
- where
-  vars :: NumVal a -> [a]
-  vars = foldMap pure
-
--- Need to keep track of which way we're solving - which side is known/unknown
--- Things which are dynamically unknown must be Tgts - information flows from Srcs
--- ...But we don't need to do any wiring here, right?
-unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum (NumValue lup lgro) (NumValue rup rgro)
-  | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
-  | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
- where
-  lhsFun00 :: Fun00 (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsFun00 Constant0 num = demand0 num
-  lhsFun00 (StrictMonoFun sm) num = lhsStrictMono sm num
-
-  lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
-  lhsStrictMono (StrictMono n mono) num = do
-    num <- demandEven num
-    lhsStrictMono (StrictMono (n - 1) mono) num
-
-  lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
-  lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
-                                  solveNumMeta e num
-  lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
-    = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
-  lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
-  lhsMono (Full sm) (NumValue up gro) = do
-    smPred <- demandSucc sm
-    unifyNum (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
-
-  demand0 :: NumVal (VVar Z) -> Checking ()
-  demand0 (NumValue 0 Constant0) = pure ()
-  demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (VPar e) -> solveNumMeta e (nConstant 0)
-    Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
-    _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
-  demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
-
-  -- Complain if a number isn't a successor, else return its predecessor
-  demandSucc :: StrictMono (VVar Z) -> Checking (NumVal (VVar Z))
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
-    (_, [(yTgt, _)], [(ySrc, _)], _) <-
-      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
-
-    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
-    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = do
-    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
-    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
-    solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
-
-  --   2^k * full(n + 1)
-  -- = 2^k * (1 + 2 * full(n))
-  -- = 2^k + 2^(k + 1) * full(n)
-  demandSucc (StrictMono k (Full nPlus1)) = do
-    n <- demandSucc nPlus1
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
-  demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
-
-  -- Complain if a number isn't even, otherwise return half
-  demandEven :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
-  demandEven n@(NumValue up gro) = case up `divMod` 2 of
-    (up, 0) -> NumValue up <$> evenGro gro
-    (up, 1) -> nPlus (up + 1) <$> oddGro gro
-   where
-    evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
-    evenGro Constant0 = pure Constant0
-    evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar (ExEnd out)) -> do
-        (_, [], [(halfSrc, _)], _) <-
-          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
-      Linear (VPar (InEnd tgt)) -> do
-        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
-        let half = nVar (VPar (toEnd halfTgt))
-        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
-      Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
-    evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
-
-    -- Check a numval is odd, and return its rounded down half
-    oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
-    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      -- TODO: Why aren't we using `out`??
-      Linear (VPar (ExEnd bubble)) -> do
-        -- compute (/2) . (-1)
-        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
-        pure (nVar (VPar (toEnd halfSrc)))
-      Linear (VPar (InEnd weeTgt)) -> do
-        -- compute (/2) . (-1)
-        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
-        let flooredHalf = nVar (VPar (toEnd weeTgt))
-        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
-        pure flooredHalf
-
-      -- full(n + 1) = 1 + 2 * full(n)
-      -- hence, full(n) is the rounded down half
-      Full sm -> nFull <$> demandSucc sm
-    oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
 
 -- The variable must be a non-zero nat!!
 patVal :: ValPat -> [End] -> (Val Z, [End])
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 3625c80b..5dbc2f49 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -18,6 +18,7 @@ module Brat.Eval (EvMode(..)
                  ,numVal
                  ,quote
                  ,getNumVar
+		 ,instantiateMeta
                  ) where
 
 import Brat.Checker.Monad
@@ -316,6 +317,11 @@ doesntOccur e (VFun my (ins :->> outs)) = case my of
   Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
   Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
 
+instantiateMeta :: End -> Val Z -> Checking ()
+instantiateMeta e val = do
+  throwLeft (doesntOccur e val)
+  defineEnd e val
+
 collision :: End -> End -> Either ErrorMsg ()
 collision e v | e == v = Left . UnificationError $
                          show e ++ " is cyclic"
diff --git a/brat/brat.cabal b/brat/brat.cabal
index 3873bcf1..74541aee 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -69,6 +69,7 @@ library
                        Brat.Checker.Helpers.Nodes,
                        Brat.Checker.Monad,
                        Brat.Checker.SolveHoles,
+		       Brat.Checker.SolveNumbers,
                        Brat.Checker.SolvePatterns,
                        Brat.Checker.Types,
                        Brat.Compile.Hugr,

From ae05f2ea7d178e36b7386d9d2f42198f8f5a066b Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 2 Apr 2025 15:42:20 +0100
Subject: [PATCH 102/182] [ progress ] unifyNum now used in solveHoles as well
 as solvePatterns, but it's coming when it should be going

---
 brat/Brat/Checker/SolveHoles.hs | 140 +-------------------------------
 brat/Brat/Eval.hs               |   6 +-
 2 files changed, 9 insertions(+), 137 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index b873bbd4..b84c6a1b 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -3,6 +3,7 @@ module Brat.Checker.SolveHoles (typeEq) where
 import Brat.Checker.Helpers (buildConst, buildNatVal)
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
+import Brat.Checker.SolveNumbers
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common
@@ -47,142 +48,8 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
   hopes <- req AskHopes
   exp <- sem sems exp
   act <- sem sems act
-  trunk ("TYPEEQ' " ++ show exp ++ " =? " ++ show act) $ typeEqEta str stuff hopes k exp act
+  typeEqEta str stuff hopes k exp act
 
-{-
-isNumVar :: Sem -> Maybe SVar
-isNumVar (SNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v))))) = Just v
-isNumVar _ = Nothing
--}
-
-natEq :: NumVal SVar -> NumVal SVar -> Checking ()
-natEq i j | i == j = pure ()
-natEq (NumValue lup lgro) (NumValue rup rgro)
-  | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
-  | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
- where
-  solveNumMeta :: End -> NumVal SVar -> Checking ()
-  solveNumMeta e num = typeErr $ "SOLVENUMMETA " ++ show e ++ " " ++ show num
-
-  lhsFun00 :: Fun00 SVar -> NumVal SVar -> Checking ()
-  lhsFun00 Constant0 num = demand0 num
-  lhsFun00 (StrictMonoFun sm) num = lhsStrictMono sm num
-
-  lhsStrictMono :: StrictMono SVar -> NumVal SVar -> Checking ()
-  lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
-  lhsStrictMono (StrictMono n mono) num = do
-    num <- demandEven num
-    lhsStrictMono (StrictMono (n - 1) mono) num
-
-  lhsMono :: Monotone SVar -> NumVal SVar -> Checking ()
-  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
-  lhsMono (Linear (SPar e)) num = -- throwLeft (doesntOccur e (SNum num)) *>
-                                  solveNumMeta e num
-  lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
-    = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
-  lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
-  lhsMono (Full sm) (NumValue up gro) = do
-    smPred <- demandSucc sm
-    natEq (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
-
-  demand0 :: NumVal SVar -> Checking ()
-  demand0 (NumValue 0 Constant0) = pure ()
-  demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (SPar e) -> solveNumMeta e (nConstant 0)
-    Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
-    _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
-  demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
-
-  -- Complain if a number isn't a successor, else return its predecessor
-  demandSucc :: StrictMono SVar -> Checking (NumVal SVar)
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  demandSucc (StrictMono _{-k-} (Linear (SPar (ExEnd x)))) = do
-    {-
-    (_, [(yTgt, _)], [(ySrc, _)], _) <-
-      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
-
-    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
-    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
-    -}
-    typeErr $ "DEMANDSUCC EX " ++ show x
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-  demandSucc (StrictMono _{-k-} (Linear (SPar (InEnd x)))) = do
-    {-
-    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
-    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
-    solveNumMeta (InEnd x) (nVar (SPar (toEnd yPlus1)))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
-    -}
-    typeErr $ "DEMANDSUCC IN " ++ show x
-
-  --   2^k * full(n + 1)
-  -- = 2^k * (1 + 2 * full(n))
-  -- = 2^k + 2^(k + 1) * full(n)
-  demandSucc (StrictMono k (Full nPlus1)) = do
-    n <- demandSucc nPlus1
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
-  demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
-
-  -- Complain if a number isn't even, otherwise return half
-  demandEven :: NumVal SVar -> Checking (NumVal SVar)
-  demandEven n@(NumValue up gro) = case up `divMod` 2 of
-    (up, 0) -> NumValue up <$> evenGro gro
-    (up, 1) -> nPlus (up + 1) <$> oddGro gro
-   where
-    evenGro :: Fun00 SVar -> Checking (Fun00 SVar)
-    evenGro Constant0 = pure Constant0
-    evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (SPar (ExEnd out)) -> do
-        {-
-        (_, [], [(halfSrc, _)], _) <-
-          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
-	-}
-	typeErr $ "EVENGRO EX " ++ show out
-      Linear (SPar (InEnd tgt)) -> do
-        {-
-        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
-        let half = nVar (VPar (toEnd halfTgt))
-        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
-        pure (StrictMonoFun (StrictMono 0 (Linear (SPar (toEnd halfTgt)))))
-	-}
-	typeErr $ "EVENGRO IN " ++ show tgt
-      Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
-    evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
-
-    -- Check a numval is odd, and return its rounded down half
-    oddGro :: Fun00 SVar -> Checking (NumVal SVar)
-    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      -- TODO: Why aren't we using `out`??
-      Linear (SPar (ExEnd bubble)) -> do
-        -- compute (/2) . (-1)
-	{-
-        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
-        pure (nVar (VPar (toEnd halfSrc)))
-	-}
-	typeErr $ "ODDGRO EX " ++ show bubble
-      Linear (SPar (InEnd weeTgt)) -> do
-        -- compute (/2) . (-1)
-	{-
-        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
-        let flooredHalf = nVar (VPar (toEnd weeTgt))
-        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
-        pure flooredHalf
-	-}
-	typeErr $ "ODDGRO IN " ++ show weeTgt
-
-      -- full(n + 1) = 1 + 2 * full(n)
-      -- hence, full(n) is the rounded down half
-      Full sm -> nFull <$> demandSucc sm
-    oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
 
 
 
@@ -209,7 +76,8 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
   | M.member e hopes = solveHope k e act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
   | M.member e hopes = solveHope k e exp
-typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = natEq exp act
+typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = do
+  unifyNum (quoteNum Zy exp) (quoteNum Zy act)
   {-
   | Just (SPar (InEnd e)) <- isNumVar exp, M.member e hopes = solveHope Nat e act
   | Just (SPar (InEnd e)) <- isNumVar act, M.member e hopes = solveHope Nat e exp
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 5dbc2f49..0503aff6 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -17,6 +17,7 @@ module Brat.Eval (EvMode(..)
                  ,kindType
                  ,numVal
                  ,quote
+		 ,quoteNum
                  ,getNumVar
 		 ,instantiateMeta
                  ) where
@@ -118,7 +119,7 @@ semLvl lvy = SApp (SLvl $ ny2int lvy) B0
 
 -- note that typeEq is a kind of quote but that also does eta-expansion
 quote :: Ny lv -> Sem -> Checking (Val lv)
-quote lvy (SNum num) = pure $ VNum (fmap (quoteVar lvy) num)
+quote lvy (SNum num) = pure $ VNum (quoteNum lvy num)
 quote lvy (SCon nm args) = VCon nm <$> traverse (quote lvy) args
 quote lvy (SLam stk body) = do
   body <- sem (stk :<< semLvl lvy) body
@@ -131,6 +132,9 @@ quoteCTy lvy my ga (ins :->> outs) = quoteRo my ga ins lvy >>= \case
   (ga', Some (ins' :* lvy')) -> quoteRo my ga' outs lvy' >>= \case
     (_, Some (outs' :* _)) -> pure (ins' :->> outs')
 
+quoteNum ::  Ny lv -> NumVal SVar -> NumVal (VVar lv)
+quoteNum lvy num = fmap (quoteVar lvy) num
+
 -- first number is next Lvl to use in Value
 --         require every Lvl in Sem is < n (converted by n - 1 - lvl), else must fail at runtime
 quoteVar :: Ny n -> SVar -> VVar n

From b81186aab6699ea2a68c0d03f8c6a4a8479c3e1d Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 2 Apr 2025 16:29:48 +0100
Subject: [PATCH 103/182] [ progress ] Fred vs Ginger now a thing.

---
 brat/Brat/Checker/SolveHoles.hs    | 12 ++-----
 brat/Brat/Checker/SolveNumbers.hs  | 57 ++++++++++++++++++++----------
 brat/Brat/Checker/SolvePatterns.hs |  8 ++---
 3 files changed, 45 insertions(+), 32 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index b84c6a1b..765079ff 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -22,10 +22,6 @@ import Data.Maybe (mapMaybe)
 import qualified Data.Map as M
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
-import Debug.Trace
-
-trunk = trace
-
 -- Demand that two closed values are equal, we're allowed to solve variables in the
 -- hope set to make this true.
 -- Raises a user error if the vals cannot be made equal.
@@ -50,10 +46,6 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
   act <- sem sems act
   typeEqEta str stuff hopes k exp act
 
-
-
-
-
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
@@ -77,7 +69,7 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
   | M.member e hopes = solveHope k e exp
 typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = do
-  unifyNum (quoteNum Zy exp) (quoteNum Zy act)
+  unifyNum NUFred (quoteNum Zy exp) (quoteNum Zy act)
   {-
   | Just (SPar (InEnd e)) <- isNumVar exp, M.member e hopes = solveHope Nat e act
   | Just (SPar (InEnd e)) <- isNumVar act, M.member e hopes = solveHope Nat e exp
@@ -154,7 +146,7 @@ typeEqRigid tm (_ :* _ :* semz) Nat exp act = do
   act <- sem semz act
   if getNum exp == getNum act
   then pure ()
-  else trunk "HELLO TYPEEQRIGID TODO" $ err $ TypeMismatch tm ("TYPEEQRIGID " ++ show exp) ("TODO " ++ show act)
+  else err $ TypeMismatch tm ("TYPEEQRIGID " ++ show exp) ("TODO " ++ show act)
 typeEqRigid tm stuff@(_ :* kz :* _) (TypeFor m []) (VApp f args) (VApp f' args') | f == f' =
   svKind f >>= \case
     TypeFor m' ks | m == m' -> typeEqs tm stuff (snd <$> ks) (args <>> []) (args' <>> [])
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index ec3497e9..936dc9ed 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -1,4 +1,4 @@
-module Brat.Checker.SolveNumbers (unifyNum) where
+module Brat.Checker.SolveNumbers (unifyNum, NumUnifyMode(..)) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
@@ -9,6 +9,20 @@ import Brat.Error
 import Brat.Eval
 import Brat.Graph (NodeType(..))
 import Hasochism
+import Control.Monad.Freer
+
+import Debug.Trace
+import qualified Data.Map as M
+
+trail = trace
+
+-- This is currently lifted from SolvePatterns, which still imports it.
+-- It is also used in SolveHoles, where it does the right mathematics
+-- but the wrong wiring.
+
+data NumUnifyMode = NUGinger | NUFred deriving (Show, Eq)
+-- As Ginger Rogers said, "I do everything Fred does, only backwars in high heels.".
+
 
 -- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
 -- makes the dynamic wiring for a metavariable. This only needs to happen for
@@ -50,8 +64,8 @@ solveNumMeta e nv = case (e, vars nv) of
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
-unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum (NumValue lup lgro) (NumValue rup rgro)
+unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -74,7 +88,7 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
     smPred <- demandSucc sm
-    unifyNum (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
+    unifyNum numo (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
@@ -89,22 +103,29 @@ unifyNum (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
+  demandSucc n | trail ("DEMANDSUCC " ++ show n) False = undefined
   demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
-    (_, [(yTgt, _)], [(ySrc, _)], _) <-
-      next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
+      (_, [(yTgt, _)], [(ySrc, _)], _) <-
+	next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
 
-    defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
-    instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = do
-    (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
-    yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
-    solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
-    pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
+      defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
+      instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
+      pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
+      --   2^k * x
+      -- = 2^k * (y + 1)
+      -- = 2^k + 2^k * y
+      -- Hence, the predecessor is (2^k - 1) + (2^k * y)
+    
+  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = case numo of
+    NUGinger -> do
+      (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
+      yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
+      solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
+      pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
+    NUFred -> do
+      hopes <- req AskHopes
+      if not $ M.member x hopes then typeErr $ "Goodbye Fred!" else do
+        typeErr $ "Hello Fred!"
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index af68231e..8fd26e7d 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -78,7 +78,7 @@ solve my ((src, Lit tm):p) = do
     (Braty, Left Nat)
       | Num n <- tm -> do
           unless (n >= 0) $ typeErr "Negative Nat kind"
-          unifyNum (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
+          unifyNum NUGinger (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
     (Braty, Right ty) -> do
       throwLeft (simpleCheck Braty ty tm)
     _ -> typeErr $ "Literal " ++ show tm ++ " isn't valid at this type"
@@ -97,7 +97,7 @@ solve my ((src, PCon c abs):p) = do
       -- Special case for 0, so that we can call `unifyNum` instead of pattern
       -- matching using what's returned from `natConstructors`
       PrefixName [] "zero" -> do
-        unifyNum (nVar (VPar (toEnd src))) nZero
+        unifyNum NUGinger (nVar (VPar (toEnd src))) nZero
         p <- argProblems [] (normaliseAbstractor abs) p
         (tests, sol) <- solve my p
         pure ((src, PrimLitTest (Num 0)):tests, sol)
@@ -106,7 +106,7 @@ solve my ((src, PCon c abs):p) = do
           (node, [], kids@[(dangling, _)], _) <- next "unpacked_nat" Hypo (S0, Some (Zy :* S0))
             R0 -- we don't need to wire the src in; we just need the inner stuff
             (REx ("inner", Nat) R0)
-          unifyNum
+          unifyNum NUGinger
            (nVar (VPar (ExEnd (end src))))
            (relationToInner (nVar (VPar (toEnd dangling))))
           -- TODO also do wiring corresponding to relationToInner
@@ -183,7 +183,7 @@ unify l k r = do
         | c == c' -> do
             ks <- tlup (Kernel, c)
             unifys args (snd <$> ks) args'
-      (VNum l, VNum r, Nat) -> unifyNum l r
+      (VNum l, VNum r, Nat) -> unifyNum NUGinger l r
       (VApp (VPar x) B0, v, _) -> instantiateMeta x v
       (v, VApp (VPar x) B0, _) -> instantiateMeta x v
       -- TODO: Handle function types

From 09641ea96bf197648c06edb8c5852db73d904ce0 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Thu, 3 Apr 2025 12:01:06 +0100
Subject: [PATCH 104/182] [ progress ] eatsfullbis.brat now typechecks; long
 way to go; messy

---
 brat/Brat/Checker/Helpers.hs      | 43 ++++++++++++++++++++++++++-----
 brat/Brat/Checker/SolveHoles.hs   | 28 +++-----------------
 brat/Brat/Checker/SolveNumbers.hs | 13 +++++++---
 brat/examples/eatsfull.brat       |  4 +++
 brat/examples/eatsfullbis.brat    |  6 +++++
 5 files changed, 60 insertions(+), 34 deletions(-)
 create mode 100644 brat/examples/eatsfull.brat
 create mode 100644 brat/examples/eatsfullbis.brat

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 07bd3e3c..c680a8db 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -18,12 +18,13 @@ module Brat.Checker.Helpers {-(pullPortsRow, pullPortsSig
                             ,uncons
                             ,evalBinder
                             ,evalSrcRow, evalTgtRow
+			    ,solveHopeVal, solveHopeSem
                             )-} where
 
 import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
-import Brat.Eval (eval, EvMode(..), kindType)
+import Brat.Eval (eval, EvMode(..), kindType, quote, doesntOccur)
 import Brat.FC (FC)
 import Brat.Graph (Node(..), NodeType(..))
 import Brat.Naming (Name, FreshMonad(..))
@@ -36,6 +37,7 @@ import Bwd
 import Hasochism
 import Util (log2)
 
+import Control.Monad ((>=>))
 import Control.Monad.State.Lazy (StateT(..), runStateT)
 import Control.Monad.Freer (req)
 import Data.Bifunctor
@@ -460,6 +462,14 @@ buildConst tm ty = do
 buildNum :: Integer -> Checking Src
 buildNum n = buildConst (Num (fromIntegral n)) TNat
 
+buildAdd :: Integer -> Checking (Tgt, Src)
+buildAdd n = do
+  nDangling <- buildNum n
+  ((lhs,rhs),out) <- buildArithOp Add
+  req $ Wire (end nDangling, TNat, end lhs)
+  defineSrc out (VNum (nPlus n (nVar (VPar (toEnd rhs)))))
+  pure (rhs, out)
+
 -- Generate wiring to produce a dynamic instance of the numval argument
 -- N.B. In these functions, we wire using Req, rather than the `wire` function
 -- because we don't want it to do any extra evaluation.
@@ -467,12 +477,10 @@ buildNatVal :: NumVal (VVar Z) -> Checking Src
 buildNatVal nv@(NumValue n gro) = case n of
   0 -> buildGro gro
   n -> do
-    nDangling <- buildNum n
-    ((lhs,rhs),out) <- buildArithOp Add
+    (inn, out) <- buildAdd n
     src <- buildGro gro
-    req $ Wire (end nDangling, TNat, end lhs)
-    req $ Wire (end src, TNat, end rhs)
-    defineSrc out (VNum (nPlus n (nVar (VPar (toEnd src)))))
+    req $ Wire (end src, TNat, end inn)
+    defineTgt inn (VNum (nVar (VPar (toEnd src))))
     pure out
  where
   buildGro :: Fun00 (VVar Z) -> Checking Src
@@ -544,3 +552,26 @@ invertNatVal (NumValue up gro) = case up of
     defineTgt tgt (VNum (nVar (VPar (toEnd llufSrc))))
     defineTgt llufTgt (VNum (nFull (nVar (VPar (toEnd tgt)))))
     pure llufTgt
+
+-- This will update the `hopes`, potentially invalidating things that have
+-- been eval'd.
+-- The Sem is closed, for now.
+solveHopeVal :: TypeKind -> InPort -> Val Z -> Checking ()
+solveHopeVal k hope v = case doesntOccur (InEnd hope) v of
+  Right () -> do
+    defineEnd (InEnd hope) v
+    dangling <- case (k, v) of
+      (Nat, VNum v) -> buildNatVal v
+      (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
+      _ -> buildConst Unit TUnit
+    req (Wire (end dangling, kindType k, hope))
+    req (RemoveHope hope)
+  Left msg -> case v of
+    VApp (VPar (InEnd end)) B0 | hope == end -> pure ()
+    -- TODO: Not all occurrences are toxic. The end could be in an argument
+    -- to a hoping variable which isn't used.
+    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
+    _ -> err msg
+
+solveHopeSem :: TypeKind -> InPort -> Sem -> Checking ()
+solveHopeSem k hope = quote Zy >=> solveHopeVal k hope
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 765079ff..ce2689a8 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,13 +1,13 @@
 module Brat.Checker.SolveHoles (typeEq) where
 
-import Brat.Checker.Helpers (buildConst, buildNatVal)
+import Brat.Checker.Helpers (solveHopeSem)
 import Brat.Checker.Monad
 import Brat.Checker.Types (kindForMode)
 import Brat.Checker.SolveNumbers
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Syntax.Common
-import Brat.Syntax.Simple (SimpleTerm(..))
+-- import Brat.Syntax.Simple (SimpleTerm(..))
 import Brat.Syntax.Value
 import Control.Monad.Freer
 import Bwd
@@ -65,9 +65,9 @@ typeEqEta tm (lvy :* kz :* sems) hopes (TypeFor m ((_, k):ks)) exp act = do
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- 1. "easy" flex cases
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
-  | M.member e hopes = solveHope k e act
+  | M.member e hopes = solveHopeSem k e act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
-  | M.member e hopes = solveHope k e exp
+  | M.member e hopes = solveHopeSem k e exp
 typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = do
   unifyNum NUFred (quoteNum Zy exp) (quoteNum Zy act)
   {-
@@ -93,26 +93,6 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   getEnd (VNum n) = getNumVar n
   getEnd _ = Nothing
 
--- This will update the `hopes`, potentially invalidating things that have
--- been eval'd.
--- The Sem is closed, for now.
-solveHope :: TypeKind -> InPort -> Sem -> Checking ()
-solveHope k hope v = quote Zy v >>= \v -> case doesntOccur (InEnd hope) v of
-  Right () -> do
-    defineEnd (InEnd hope) v
-    dangling <- case (k, v) of
-      (Nat, VNum v) -> buildNatVal v
-      (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
-      _ -> buildConst Unit TUnit
-    req (Wire (end dangling, kindType k, hope))
-    req (RemoveHope hope)
-  Left msg -> case v of
-    VApp (VPar (InEnd end)) B0 | hope == end -> pure ()
-    -- TODO: Not all occurrences are toxic. The end could be in an argument
-    -- to a hoping variable which isn't used.
-    -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
-    _ -> err msg
-
 typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
 typeEqs _ _ [] [] [] = pure ()
 typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq' tm stuff k exp act
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 936dc9ed..ac1aa523 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -11,10 +11,10 @@ import Brat.Graph (NodeType(..))
 import Hasochism
 import Control.Monad.Freer
 
-import Debug.Trace
+--import Debug.Trace
 import qualified Data.Map as M
 
-trail = trace
+--trail = trace
 
 -- This is currently lifted from SolvePatterns, which still imports it.
 -- It is also used in SolveHoles, where it does the right mathematics
@@ -54,8 +54,10 @@ solveNumMeta e nv = case (e, vars nv) of
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
+   hopes <- req AskHopes
    src <- buildNatVal nv
    instantiateMeta (InEnd tgt) (VNum nv)
+   if M.member tgt hopes then req (RemoveHope tgt) else pure ()
    wire (src, TNat, NamedPort tgt "")
  where
   vars :: NumVal a -> [a]
@@ -103,7 +105,6 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
-  demandSucc n | trail ("DEMANDSUCC " ++ show n) False = undefined
   demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
       (_, [(yTgt, _)], [(ySrc, _)], _) <-
 	next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
@@ -125,7 +126,11 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
     NUFred -> do
       hopes <- req AskHopes
       if not $ M.member x hopes then typeErr $ "Goodbye Fred!" else do
-        typeErr $ "Hello Fred!"
+        (tgt, src) <- buildAdd 1
+	fc <- req AskFC
+	req (ANewHope (end tgt) fc)
+	solveHopeVal Nat x (VNum (nVar (VPar (toEnd src))))
+	pure (nVar (VPar (toEnd tgt)))
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
diff --git a/brat/examples/eatsfull.brat b/brat/examples/eatsfull.brat
new file mode 100644
index 00000000..bce0d05a
--- /dev/null
+++ b/brat/examples/eatsfull.brat
@@ -0,0 +1,4 @@
+eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
+eatsfull(n, _) = n
+mkftwo :: Nat
+mkftwo = eatsfull(!, [false,false,false])
diff --git a/brat/examples/eatsfullbis.brat b/brat/examples/eatsfullbis.brat
new file mode 100644
index 00000000..2a94d1fc
--- /dev/null
+++ b/brat/examples/eatsfullbis.brat
@@ -0,0 +1,6 @@
+eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
+eatsfull(n, _) = n
+falses :: Vec(Bool, 3)
+falses = [false, false, false]
+mkftwo :: Nat
+mkftwo = eatsfull(!, falses)

From 5b0c6a8a3aa19902d63eebff9f54e6f41272a72b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Thu, 3 Apr 2025 15:57:46 +0100
Subject: [PATCH 105/182] Skeleton for converting valPats to Valz

---
 brat/Brat/Checker/Helpers.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index c680a8db..88fffaff 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -575,3 +575,22 @@ solveHopeVal k hope v = case doesntOccur (InEnd hope) v of
 
 solveHopeSem :: TypeKind -> InPort -> Sem -> Checking ()
 solveHopeSem k hope = quote Zy >=> solveHopeVal k hope
+
+-- Convert a pattern into a value for the purposes of solving it with unification
+-- for pattern matching. This is used for checking type constructors - we're only
+-- dealing in static information.
+valPat2Val :: -> KindType
+              -> ValPat
+              -> Checking (Either ErrorMsg (Bwd (Val Z) -- Values of the pattern vars
+                                           ,Val Z  -- The value of the whole pattern
+                                           )
+                        )
+valPat2Val my k VPVar = do
+  (_, [(idTgt, _)], [_], _) <- anext "" Id (S0, Some (Zy :* S0)) (REx ("", Left k) R0) (REx ("", Left k) R0)
+  let val = VApp (VPar (end idTgt)) B0
+  -- TODO: Make the FC optional in ANewHope
+  let dummyFC = FC (Pos 0 0) (Pos 0 0)
+  req (ANewHope inTgt dummyFC)
+  pure (Right (B0 :< val, val))
+valPat2Val my ty (VPCon u args) = _
+valPat2Val my ty (VPNum n) = _

From 16ccb968912c9712335f1b56a89a8c73c29c5d7d Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 4 Apr 2025 15:55:00 +0100
Subject: [PATCH 106/182] [wip] Bug hunting

---
 brat/Brat/Checker.hs              |  20 ++++-
 brat/Brat/Checker/Helpers.hs      | 125 ++++++++++++++++++++++++++----
 brat/Brat/Checker/Monad.hs        |   4 +-
 brat/Brat/Checker/SolveNumbers.hs |  53 ++++++++++---
 brat/Brat/Eval.hs                 |   1 +
 brat/Brat/Syntax/Common.hs        |   5 ++
 brat/brat.cabal                   |   8 +-
 7 files changed, 182 insertions(+), 34 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 3b317be0..81dadd6e 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -48,6 +48,8 @@ import Bwd
 import Hasochism
 import Util (zipSameLength)
 
+import Debug.Trace
+
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
 standardise :: TypeKind -> Val Z -> Checking (Val Z)
@@ -456,11 +458,23 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
  where
   aux :: Modey m -> (QualName -> QualName -> Checking (CtorArgs m)) -> Val Z -> Checking ()
   aux my lup ty = do
+    -- TODO: Use concurrency to avoid strictness - we don't have to work out that
+    -- this is a VCon immediately.
     VCon tycon tyargs <- eval S0 ty
+    traceM $ "checking constructor of type: " ++ show tycon ++ " " ++ show tyargs
     (CArgs pats nFree _ argTypeRo) <- lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths
-    wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
-    Some (ny :* env) <- throwLeft $ valMatches tyargs pats
+    -- wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
+    -- Get the kinds of type args
+    let m = deModey my -- TODO: remember what this is
+    (_, ks) <- unzip <$> tlup (m, tycon)
+    -- Turn `pats` into values for unification
+    (varz, patVals) <- valPats2Val ks pats
+    traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
+    -- Create a unification problem between tyargs and the value versions of pats
+    typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
+    traceM "Made it past unification"
+    Some (ny :* env) <- pure $ bwdStack varz
     -- Make sure env is the correct length for args
     Refl <- throwLeft $ natEqOrBust ny nFree
     let topy = roTopM my ny argTypeRo
@@ -471,7 +485,7 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
-    (((), ()), ((), leftUnders)) <- wrapError wrap $ check vargs ((), argUnders)
+    (((), ()), ((), leftUnders)) <- {- wrapError wrap $ -} check vargs ((), argUnders)
     ensureEmpty "con unders" leftUnders
     wire (dangling, ty, hungry)
 
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 88fffaff..31cc1245 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -21,7 +21,7 @@ module Brat.Checker.Helpers {-(pullPortsRow, pullPortsSig
 			    ,solveHopeVal, solveHopeSem
                             )-} where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd)
+import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, tlup)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType, quote, doesntOccur)
@@ -47,6 +47,8 @@ import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import qualified Data.Map as M
 import Prelude hiding (last)
 
+import Debug.Trace
+
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()
 simpleCheck Braty TNat (Num n) | n >= 0 = pure ()
 simpleCheck Braty TInt (Num _) = pure ()
@@ -470,6 +472,66 @@ buildAdd n = do
   defineSrc out (VNum (nPlus n (nVar (VPar (toEnd rhs)))))
   pure (rhs, out)
 
+buildSub :: Integer -> Checking (Tgt, Src)
+buildSub n = do
+  nDangling <- buildNum n
+  ((lhs,rhs),out) <- buildArithOp Sub
+  req $ Wire (end nDangling, TNat, end lhs)
+  defineTgt rhs (VNum (nPlus n (nVar (VPar (toEnd out)))))
+  pure (rhs, out)
+
+buildDoub :: Checking (Tgt, Src)
+buildDoub = do
+  nDangling <- buildNum 2
+  ((lhs,rhs),out) <- buildArithOp Mul
+  req $ Wire (end nDangling, TNat, end lhs)
+  defineSrc out (VNum (n2PowTimes 1 (nVar (VPar (toEnd rhs)))))
+  pure (rhs, out)
+
+buildHalve :: Checking (Tgt, Src)
+buildHalve = do
+  nDangling <- buildNum 2
+  ((lhs,rhs),out) <- buildArithOp Div
+  req $ Wire (end nDangling, TNat, end lhs)
+  defineTgt rhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
+  pure (rhs, out)
+
+replaceHope :: InPort -> InPort -> Checking ()
+replaceHope old new = do
+  hs <- req AskHopes
+  case M.lookup old hs of
+    Nothing -> pure ()
+    Just fc -> do
+      req (RemoveHope old)
+      req (ANewHope new fc)
+
+-- Return an End with the same polarity whose value is half that of the input End
+makeHalf :: End -> Checking End
+makeHalf (InEnd e) = do
+  (doubIn, doubOut) <- buildDoub
+  req (Wire (end doubOut, TNat, e))
+  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd doubOut))))
+  replaceHope e (end doubIn)
+  pure (InEnd (end doubIn))
+makeHalf (ExEnd e) = do
+  (halveIn, halveOut) <- buildHalve
+  req (Wire (e, TNat, end halveIn))
+  defineTgt halveIn (VNum (nVar (VPar (toEnd e))))
+  pure (toEnd halveOut)
+
+makePred :: End -> Checking End
+makePred (InEnd e) = do
+  (succIn, succOut) <- buildAdd 1
+  req (Wire (end succOut, TNat, e))
+  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd succIn))))
+  replaceHope e (end succIn)
+  pure (toEnd succIn)
+makePred (ExEnd e) = do
+  (predIn, predOut) <- buildSub 1
+  req (Wire (e, TNat, end predIn))
+  defineTgt predIn (VNum (nVar (VPar (toEnd e))))
+  pure (toEnd predOut)
+
 -- Generate wiring to produce a dynamic instance of the numval argument
 -- N.B. In these functions, we wire using Req, rather than the `wire` function
 -- because we don't want it to do any extra evaluation.
@@ -579,18 +641,51 @@ solveHopeSem k hope = quote Zy >=> solveHopeVal k hope
 -- Convert a pattern into a value for the purposes of solving it with unification
 -- for pattern matching. This is used for checking type constructors - we're only
 -- dealing in static information.
-valPat2Val :: -> KindType
-              -> ValPat
-              -> Checking (Either ErrorMsg (Bwd (Val Z) -- Values of the pattern vars
-                                           ,Val Z  -- The value of the whole pattern
-                                           )
-                        )
-valPat2Val my k VPVar = do
-  (_, [(idTgt, _)], [_], _) <- anext "" Id (S0, Some (Zy :* S0)) (REx ("", Left k) R0) (REx ("", Left k) R0)
-  let val = VApp (VPar (end idTgt)) B0
+valPat2Val :: TypeKind
+           -> ValPat
+           -> Checking (Bwd (Val Z) -- Values of the pattern vars
+                       ,Val Z  -- The value of the whole pattern
+                       )
+valPat2Val k VPVar = do
+  (_, [(idTgt, _)], [_], _) <- anext "pat2val" Id (S0, Some (Zy :* S0)) (REx ("", k) R0) (REx ("", k) R0)
+  let val = VApp (VPar (toEnd idTgt)) B0
   -- TODO: Make the FC optional in ANewHope
-  let dummyFC = FC (Pos 0 0) (Pos 0 0)
-  req (ANewHope inTgt dummyFC)
-  pure (Right (B0 :< val, val))
-valPat2Val my ty (VPCon u args) = _
-valPat2Val my ty (VPNum n) = _
+  fc <- req AskFC
+  req (ANewHope (end idTgt) fc)
+  pure (B0 :< val, val)
+valPat2Val (TypeFor m _) (VPCon con args) = do
+  ks <- fmap snd <$> tlup (m, con)
+  (stk, args) <- valPats2Val ks args
+  let val = VCon con args
+  pure (stk, val)
+valPat2Val Nat (VPNum n) = numPat2Val n >>= \(stk, nv) -> pure (stk, VNum nv)
+ where
+  numPat2Val :: NumPat -> Checking (Bwd (Val Z), NumVal (VVar Z))
+  numPat2Val NP0 = pure (B0, nZero)
+  numPat2Val (NP1Plus np) = second (nPlus 1) <$> numPat2Val np
+  numPat2Val (NP2Times np) = second (n2PowTimes 1) <$> numPat2Val np
+  numPat2Val NPVar = do
+    (_, [(idTgt, _)], [_], _) <- anext "numpat2val" Id (S0, Some (Zy :* S0)) (REx ("", Nat) R0) (REx ("", Nat) R0)
+    fc <- req AskFC
+    req (ANewHope (end idTgt) fc)
+    let var = endVal Nat (toEnd idTgt)
+    pure (B0 :< var, nVar (VPar (toEnd idTgt)))
+
+valPats2Val :: [TypeKind]
+            -> [ValPat]
+            -> Checking (Bwd (Val Z) -- Values of the pattern vars
+                        ,[Val Z]  -- The value of the whole pattern
+                        )
+valPats2Val (k:ks) (v:vs) = do
+  (stk, v) <- valPat2Val k v
+  (stk', vs) <- valPats2Val ks vs
+  pure (stk <+ stk', v:vs)
+valPats2Val [] [] = pure (B0, [])
+valPats2Val _ _ = err $ InternalError "Type args didn't match expected - kindCheck should've sorted it"
+
+traceChecking :: (Show a, Show b) => String -> (a -> Checking b) -> (a -> Checking b)
+traceChecking lbl m a = do
+  traceM ("Enter " ++ lbl ++ ": " ++ show a)
+  b <- m a
+  traceM ("Exit  " ++ lbl ++ ": " ++ show b)
+  pure b
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index eeb2b2e2..96900937 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -167,6 +167,9 @@ kclup :: QualName -- Value constructor
       -> Checking (CtorArgs Kernel)
 kclup vcon tycon = req AskFC >>= \fc -> req (KCLup fc vcon tycon)
 
+-- TODO: Future proof this by taking a TypeKind argument instead of a mode.
+-- Currently we have kinds `Nat` for `TypeFor m`, where we don't lookup `Nat`
+-- with tlup, but this will change!
 tlup :: (Mode, QualName) -> Checking [(PortName, TypeKind)]
 tlup (m, c) = req (TLup (m, c)) >>= \case
   Nothing -> req (TLup (otherMode, c)) >>= \case
@@ -333,4 +336,3 @@ localNS ns (Req c k) = Req c (localNS ns . k)
 
 defineEnd :: End -> Val Z -> Checking ()
 defineEnd e v = req (Define e v)
-
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index ac1aa523..f4a75f8c 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -11,7 +11,7 @@ import Brat.Graph (NodeType(..))
 import Hasochism
 import Control.Monad.Freer
 
---import Debug.Trace
+import Debug.Trace
 import qualified Data.Map as M
 
 --trail = trace
@@ -45,29 +45,40 @@ solveNumMeta e nv = case (e, vars nv) of
    (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
                                          (REx ("n", Nat) R0) (REx ("n", Nat) R0)
    defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
+   hopes <- req AskHopes
    instantiateMeta (InEnd weeTgt) (VNum (nVar (VPar (toEnd idSrc))))
+   if M.member weeTgt hopes then req (RemoveHope weeTgt) else pure ()
    wire (idSrc, TNat, NamedPort weeTgt "")
    let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
    bigSrc <- buildNatVal nv'
    instantiateMeta (InEnd bigTgt) (VNum nv')
+   if M.member bigTgt hopes then req (RemoveHope bigTgt) else pure ()
    wire (bigSrc, TNat, NamedPort bigTgt "")
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
-   hopes <- req AskHopes
    src <- buildNatVal nv
    instantiateMeta (InEnd tgt) (VNum nv)
+   hopes <- req AskHopes
    if M.member tgt hopes then req (RemoveHope tgt) else pure ()
    wire (src, TNat, NamedPort tgt "")
  where
   vars :: NumVal a -> [a]
   vars = foldMap pure
 
+unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum numo a b | trace ("unifyNum\n  " ++ show a ++ "\n  " ++ show b) False = undefined
+unifyNum numo nv0 nv1 = do
+  nv0 <- numEval S0 nv0
+  nv1 <- numEval S0 nv1
+  unifyNum' numo (quoteNum Zy nv0) (quoteNum Zy nv1)
+
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
-unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
+unifyNum' :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum' _ a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
+unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -78,7 +89,7 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
   lhsStrictMono (StrictMono n mono) num = do
-    num <- demandEven num
+    num <- traceChecking "demandEven" demandEven num
     lhsStrictMono (StrictMono (n - 1) mono) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
@@ -89,7 +100,7 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
     = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
-    smPred <- demandSucc sm
+    smPred <- traceChecking "demandSucc" demandSucc sm
     unifyNum numo (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
@@ -102,6 +113,7 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
 
   -- Complain if a number isn't a successor, else return its predecessor
   demandSucc :: StrictMono (VVar Z) -> Checking (NumVal (VVar Z))
+{-
   --   2^k * x
   -- = 2^k * (y + 1)
   -- = 2^k + 2^k * y
@@ -116,7 +128,12 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
       -- = 2^k * (y + 1)
       -- = 2^k + 2^k * y
       -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-    
+-}
+
+  demandSucc (StrictMono k (Linear (VPar e))) = do
+    pred <- traceChecking "makePred" makePred e
+    pure (nPlus (2^k - 1) (nVar (VPar pred)))
+{-
   demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = case numo of
     NUGinger -> do
       (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
@@ -131,12 +148,13 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
 	req (ANewHope (end tgt) fc)
 	solveHopeVal Nat x (VNum (nVar (VPar (toEnd src))))
 	pure (nVar (VPar (toEnd tgt)))
+-}
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
   demandSucc (StrictMono k (Full nPlus1)) = do
-    n <- demandSucc nPlus1
+    n <- traceChecking "demandSucc" demandSucc nPlus1
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
   demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
 
@@ -149,22 +167,34 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
     evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar (ExEnd out)) -> do
+      Linear (VPar e) -> do
+        traceM $ "Calling makeHalf (" ++ show e ++ ")"
+        half <- traceChecking "makeHalf" makeHalf e
+        pure (StrictMonoFun (StrictMono 0 (Linear (VPar half))))
+{-
+
         (_, [], [(halfSrc, _)], _) <-
           next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
         solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
       Linear (VPar (InEnd tgt)) -> do
+        traceM "Halving in demandEven"
         halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
         let half = nVar (VPar (toEnd halfTgt))
         solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
+-}
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
 
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
-    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
+    oddGro (StrictMonoFun (StrictMono 0 mono)) = case trace "got to oddGro " mono of
+      Linear (VPar e) -> do
+        pred <- traceChecking "makePred" makePred e
+        half <- traceChecking "makeHalf" makeHalf pred
+        pure (nVar (VPar half))
+{-
       -- TODO: Why aren't we using `out`??
       Linear (VPar (ExEnd bubble)) -> do
         -- compute (/2) . (-1)
@@ -178,7 +208,8 @@ unifyNum numo (NumValue lup lgro) (NumValue rup rgro)
         solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
         pure flooredHalf
 
+-}
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
-      Full sm -> nFull <$> demandSucc sm
+      Full sm -> nFull <$> traceChecking "demandSucc" demandSucc sm
     oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 0503aff6..e64041bb 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -2,6 +2,7 @@
 
 module Brat.Eval (EvMode(..)
                  ,ValPat(..)
+                 ,NumEval(..)
                  ,NumPat(..)
                  ,apply
                  ,applySem
diff --git a/brat/Brat/Syntax/Common.hs b/brat/Brat/Syntax/Common.hs
index f90dbed6..c13195a9 100644
--- a/brat/Brat/Syntax/Common.hs
+++ b/brat/Brat/Syntax/Common.hs
@@ -34,6 +34,7 @@ module Brat.Syntax.Common (PortName,
                            KINDY(..),
                            DIRY(..),
                            modily,
+                           deModey,
                            ArithOp(..),
                            pattern Dollar,
                            pattern Star,
@@ -84,6 +85,10 @@ modily :: Modey m -> (MODEY m => t) -> t
 modily Braty t = t
 modily Kerny t = t
 
+deModey :: Modey m -> Mode
+deModey Braty = Brat
+deModey Kerny = Kernel
+
 instance TestEquality Modey where
   testEquality Braty Braty = Just Refl
   testEquality Kerny Kerny = Just Refl
diff --git a/brat/brat.cabal b/brat/brat.cabal
index 74541aee..3999cf9b 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -44,11 +44,11 @@ common warning-flags
     -Wno-unused-do-bind
     -Wno-missing-signatures
     -Wno-noncanonical-monoid-instances
-    -Werror=unused-imports
-    -Werror=unused-matches
+--    -Werror=unused-imports
+--    -Werror=unused-matches
     -Werror=missing-methods
-    -Werror=unused-top-binds
-    -Werror=unused-local-binds
+--    -Werror=unused-top-binds
+--    -Werror=unused-local-binds
     -Werror=redundant-constraints
     -Werror=orphans
     -Werror=overlapping-patterns

From 4acf90c827bf7b579f68a3cbd224f42217b7247c Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Fri, 4 Apr 2025 17:26:39 +0100
Subject: [PATCH 107/182] [ fix ] makePred now defines the hole to be the succ

---
 brat/Brat/Checker.hs              |  1 +
 brat/Brat/Checker/Helpers.hs      | 14 +++++++-------
 brat/Brat/Checker/SolveNumbers.hs | 24 ++++++++++++++++--------
 brat/Brat/Syntax/Value.hs         |  2 +-
 4 files changed, 25 insertions(+), 16 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 81dadd6e..33a41c56 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -482,6 +482,7 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
     -- in the kernel case the bottom and top of the row are the same
     let ty' = weaken topy ty
     env <- traverseStack (sem S0) env
+    traceM $ "Matchenv: " ++ show env
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 31cc1245..5c99b192 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -476,9 +476,9 @@ buildSub :: Integer -> Checking (Tgt, Src)
 buildSub n = do
   nDangling <- buildNum n
   ((lhs,rhs),out) <- buildArithOp Sub
-  req $ Wire (end nDangling, TNat, end lhs)
-  defineTgt rhs (VNum (nPlus n (nVar (VPar (toEnd out)))))
-  pure (rhs, out)
+  req $ Wire (end nDangling, TNat, end rhs)
+  defineTgt lhs (VNum (nPlus n (nVar (VPar (toEnd out)))))
+  pure (lhs, out)
 
 buildDoub :: Checking (Tgt, Src)
 buildDoub = do
@@ -492,9 +492,9 @@ buildHalve :: Checking (Tgt, Src)
 buildHalve = do
   nDangling <- buildNum 2
   ((lhs,rhs),out) <- buildArithOp Div
-  req $ Wire (end nDangling, TNat, end lhs)
-  defineTgt rhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
-  pure (rhs, out)
+  req $ Wire (end nDangling, TNat, end rhs)
+  defineTgt lhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
+  pure (lhs, out)
 
 replaceHope :: InPort -> InPort -> Checking ()
 replaceHope old new = do
@@ -523,7 +523,7 @@ makePred :: End -> Checking End
 makePred (InEnd e) = do
   (succIn, succOut) <- buildAdd 1
   req (Wire (end succOut, TNat, e))
-  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd succIn))))
+  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd succOut))))
   replaceHope e (end succIn)
   pure (toEnd succIn)
 makePred (ExEnd e) = do
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index f4a75f8c..ca3dcf99 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -30,6 +30,7 @@ data NumUnifyMode = NUGinger | NUFred deriving (Show, Eq)
 --
 -- We assume that the caller has done the occurs check and rules out trivial equations.
 solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
+solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
 solveNumMeta e nv = case (e, vars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd _tgt)]) -> do
@@ -67,11 +68,14 @@ solveNumMeta e nv = case (e, vars nv) of
   vars = foldMap pure
 
 unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum numo a b | trace ("unifyNum\n  " ++ show a ++ "\n  " ++ show b) False = undefined
 unifyNum numo nv0 nv1 = do
+  traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
   unifyNum' numo (quoteNum Zy nv0) (quoteNum Zy nv1)
+  nv0 <- numEval S0 (quoteNum Zy nv0)
+  nv1 <- numEval S0 (quoteNum Zy nv1)
+  traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1)) 
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
@@ -89,7 +93,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
   lhsStrictMono (StrictMono n mono) num = do
-    num <- traceChecking "demandEven" demandEven num
+    num <- traceChecking "lhsSM demandEven" demandEven num
     lhsStrictMono (StrictMono (n - 1) mono) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
@@ -100,7 +104,9 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
     = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
-    smPred <- traceChecking "demandSucc" demandSucc sm
+    smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
+    sm <- numEval S0 sm
+    traceM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum numo (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
@@ -132,7 +138,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
 
   demandSucc (StrictMono k (Linear (VPar e))) = do
     pred <- traceChecking "makePred" makePred e
-    pure (nPlus (2^k - 1) (nVar (VPar pred)))
+    pure (nPlus ((2^k) - 1) (nVar (VPar pred)))
 {-
   demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = case numo of
     NUGinger -> do
@@ -153,16 +159,18 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
-  demandSucc (StrictMono k (Full nPlus1)) = do
+  demandSucc x@(StrictMono k (Full nPlus1)) = do
     n <- traceChecking "demandSucc" demandSucc nPlus1
+    foo <- numEval S0 x
+    traceM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
   demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
 
   -- Complain if a number isn't even, otherwise return half
   demandEven :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
   demandEven n@(NumValue up gro) = case up `divMod` 2 of
-    (up, 0) -> NumValue up <$> evenGro gro
-    (up, 1) -> nPlus (up + 1) <$> oddGro gro
+    (up, 0) -> NumValue up <$> traceChecking "evenGro" evenGro gro
+    (up, 1) -> nPlus (up + 1) <$> traceChecking "oddGro" oddGro gro
    where
     evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
     evenGro Constant0 = pure Constant0
@@ -189,7 +197,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
 
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
-    oddGro (StrictMonoFun (StrictMono 0 mono)) = case trace "got to oddGro " mono of
+    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar e) -> do
         pred <- traceChecking "makePred" makePred e
         half <- traceChecking "makeHalf" makeHalf pred
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index 4bc71fcd..a39be7f6 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -347,7 +347,7 @@ instance NumFun Monotone where
   calculate (Linear n) = n
   calculate (Full sm) = full (calculate sm)
    where
-    full n = 2 ^ n - 1
+    full n = (2 ^ n) - 1
 
   numValue = numValue . StrictMono 0
 

From 537346b4fd2e6c7d5a0c4f942fa98d4d31b4ac36 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Mon, 7 Apr 2025 11:03:39 +0100
Subject: [PATCH 108/182] [ progress ] removed tracing

---
 brat/Brat/Checker.hs              | 10 +++++-----
 brat/Brat/Checker/Helpers.hs      |  6 +++++-
 brat/Brat/Checker/SolveNumbers.hs | 24 ++++++++++++------------
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 33a41c56..2387f810 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -48,7 +48,7 @@ import Bwd
 import Hasochism
 import Util (zipSameLength)
 
-import Debug.Trace
+-- import Debug.Trace
 
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
@@ -461,7 +461,7 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
     -- TODO: Use concurrency to avoid strictness - we don't have to work out that
     -- this is a VCon immediately.
     VCon tycon tyargs <- eval S0 ty
-    traceM $ "checking constructor of type: " ++ show tycon ++ " " ++ show tyargs
+    -- traceM $ "checking constructor of type: " ++ show tycon ++ " " ++ show tyargs
     (CArgs pats nFree _ argTypeRo) <- lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths
     -- wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
@@ -470,10 +470,10 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
     (varz, patVals) <- valPats2Val ks pats
-    traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
+    -- traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
     typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
-    traceM "Made it past unification"
+    -- traceM "Made it past unification"
     Some (ny :* env) <- pure $ bwdStack varz
     -- Make sure env is the correct length for args
     Refl <- throwLeft $ natEqOrBust ny nFree
@@ -482,7 +482,7 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = case (?my, ty) of
     -- in the kernel case the bottom and top of the row are the same
     let ty' = weaken topy ty
     env <- traverseStack (sem S0) env
-    traceM $ "Matchenv: " ++ show env
+    -- traceM $ "Matchenv: " ++ show env
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 5c99b192..6bb7bdae 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -47,7 +47,7 @@ import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import qualified Data.Map as M
 import Prelude hiding (last)
 
-import Debug.Trace
+-- import Debug.Trace
 
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Either ErrorMsg ()
 simpleCheck Braty TNat (Num n) | n >= 0 = pure ()
@@ -683,9 +683,13 @@ valPats2Val (k:ks) (v:vs) = do
 valPats2Val [] [] = pure (B0, [])
 valPats2Val _ _ = err $ InternalError "Type args didn't match expected - kindCheck should've sorted it"
 
+{-
 traceChecking :: (Show a, Show b) => String -> (a -> Checking b) -> (a -> Checking b)
 traceChecking lbl m a = do
   traceM ("Enter " ++ lbl ++ ": " ++ show a)
   b <- m a
   traceM ("Exit  " ++ lbl ++ ": " ++ show b)
   pure b
+-}
+
+traceChecking = const id
\ No newline at end of file
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index ca3dcf99..bc6aa3a1 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -11,10 +11,10 @@ import Brat.Graph (NodeType(..))
 import Hasochism
 import Control.Monad.Freer
 
-import Debug.Trace
+-- import Debug.Trace
 import qualified Data.Map as M
 
---trail = trace
+-- trail = trace
 
 -- This is currently lifted from SolvePatterns, which still imports it.
 -- It is also used in SolveHoles, where it does the right mathematics
@@ -30,7 +30,7 @@ data NumUnifyMode = NUGinger | NUFred deriving (Show, Eq)
 --
 -- We assume that the caller has done the occurs check and rules out trivial equations.
 solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
-solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
+-- solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
 solveNumMeta e nv = case (e, vars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd _tgt)]) -> do
@@ -69,19 +69,19 @@ solveNumMeta e nv = case (e, vars nv) of
 
 unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum numo nv0 nv1 = do
-  traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
+  -- traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
   unifyNum' numo (quoteNum Zy nv0) (quoteNum Zy nv1)
-  nv0 <- numEval S0 (quoteNum Zy nv0)
-  nv1 <- numEval S0 (quoteNum Zy nv1)
-  traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1)) 
+  -- nv0 <- numEval S0 (quoteNum Zy nv0)
+  -- nv1 <- numEval S0 (quoteNum Zy nv1)
+  -- traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1)) 
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
 unifyNum' :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum' _ a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
+-- unifyNum' _ a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
 unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
@@ -106,7 +106,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   lhsMono (Full sm) (NumValue up gro) = do
     smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
     sm <- numEval S0 sm
-    traceM $ "succ now " ++ show (quoteNum Zy sm)
+    -- traceM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum numo (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
@@ -161,8 +161,8 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
   -- = 2^k + 2^(k + 1) * full(n)
   demandSucc x@(StrictMono k (Full nPlus1)) = do
     n <- traceChecking "demandSucc" demandSucc nPlus1
-    foo <- numEval S0 x
-    traceM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
+    -- foo <- numEval S0 x
+    -- traceM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
   demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
 
@@ -176,7 +176,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar e) -> do
-        traceM $ "Calling makeHalf (" ++ show e ++ ")"
+        -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
         half <- traceChecking "makeHalf" makeHalf e
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar half))))
 {-

From 36b1a0d8944a2c79f22462ec365cc37458393642 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Mon, 7 Apr 2025 11:57:26 +0100
Subject: [PATCH 109/182] [ progress ] no more Fred and Ginger

---
 brat/Brat/Checker/SolveHoles.hs    |  2 +-
 brat/Brat/Checker/SolveNumbers.hs  | 77 ++++--------------------------
 brat/Brat/Checker/SolvePatterns.hs |  8 ++--
 3 files changed, 13 insertions(+), 74 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index ce2689a8..5b70acca 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -69,7 +69,7 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
   | M.member e hopes = solveHopeSem k e exp
 typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = do
-  unifyNum NUFred (quoteNum Zy exp) (quoteNum Zy act)
+  unifyNum (quoteNum Zy exp) (quoteNum Zy act)
   {-
   | Just (SPar (InEnd e)) <- isNumVar exp, M.member e hopes = solveHope Nat e act
   | Just (SPar (InEnd e)) <- isNumVar act, M.member e hopes = solveHope Nat e exp
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index bc6aa3a1..c7bb6b16 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -1,4 +1,4 @@
-module Brat.Checker.SolveNumbers (unifyNum, NumUnifyMode(..)) where
+module Brat.Checker.SolveNumbers (unifyNum) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
@@ -20,10 +20,6 @@ import qualified Data.Map as M
 -- It is also used in SolveHoles, where it does the right mathematics
 -- but the wrong wiring.
 
-data NumUnifyMode = NUGinger | NUFred deriving (Show, Eq)
--- As Ginger Rogers said, "I do everything Fred does, only backwars in high heels.".
-
-
 -- Solve a Nat kinded metavariable. Unlike `instantiateMeta`, this function also
 -- makes the dynamic wiring for a metavariable. This only needs to happen for
 -- numbers because they have nontrivial runtime behaviour.
@@ -67,12 +63,12 @@ solveNumMeta e nv = case (e, vars nv) of
   vars :: NumVal a -> [a]
   vars = foldMap pure
 
-unifyNum :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum numo nv0 nv1 = do
+unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum nv0 nv1 = do
   -- traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
-  unifyNum' numo (quoteNum Zy nv0) (quoteNum Zy nv1)
+  unifyNum' (quoteNum Zy nv0) (quoteNum Zy nv1)
   -- nv0 <- numEval S0 (quoteNum Zy nv0)
   -- nv1 <- numEval S0 (quoteNum Zy nv1)
   -- traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1)) 
@@ -80,9 +76,9 @@ unifyNum numo nv0 nv1 = do
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
-unifyNum' :: NumUnifyMode -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
--- unifyNum' _ a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
-unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
+unifyNum' :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+-- unifyNum' a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
+unifyNum' (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -107,7 +103,7 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
     smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
     sm <- numEval S0 sm
     -- traceM $ "succ now " ++ show (quoteNum Zy sm)
-    unifyNum numo (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
+    unifyNum (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
@@ -119,42 +115,13 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
 
   -- Complain if a number isn't a successor, else return its predecessor
   demandSucc :: StrictMono (VVar Z) -> Checking (NumVal (VVar Z))
-{-
-  --   2^k * x
-  -- = 2^k * (y + 1)
-  -- = 2^k + 2^k * y
-  demandSucc (StrictMono k (Linear (VPar (ExEnd x)))) = do
-      (_, [(yTgt, _)], [(ySrc, _)], _) <-
-	next "yId" Id (S0, Some (Zy :* S0)) (REx ("value", Nat) R0) (REx ("value", Nat) R0)
-
-      defineSrc ySrc (VNum (nVar (VPar (toEnd yTgt))))
-      instantiateMeta (ExEnd x) (VNum (nPlus 1 (nVar (VPar (toEnd yTgt)))))
-      pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd ySrc)))
       --   2^k * x
       -- = 2^k * (y + 1)
       -- = 2^k + 2^k * y
       -- Hence, the predecessor is (2^k - 1) + (2^k * y)
--}
-
   demandSucc (StrictMono k (Linear (VPar e))) = do
     pred <- traceChecking "makePred" makePred e
     pure (nPlus ((2^k) - 1) (nVar (VPar pred)))
-{-
-  demandSucc (StrictMono k (Linear (VPar (InEnd x)))) = case numo of
-    NUGinger -> do
-      (_, [(y,_)], _, _) <- anext "y" Hypo (S0, Some (Zy :* S0)) (REx ("", Nat) R0) R0
-      yPlus1 <- invertNatVal (nPlus 1 (nVar (VPar (toEnd y))))
-      solveNumMeta (InEnd x) (nVar (VPar (toEnd yPlus1)))
-      pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes k (nVar (VPar (toEnd y)))
-    NUFred -> do
-      hopes <- req AskHopes
-      if not $ M.member x hopes then typeErr $ "Goodbye Fred!" else do
-        (tgt, src) <- buildAdd 1
-	fc <- req AskFC
-	req (ANewHope (end tgt) fc)
-	solveHopeVal Nat x (VNum (nVar (VPar (toEnd src))))
-	pure (nVar (VPar (toEnd tgt)))
--}
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
@@ -179,19 +146,6 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
         -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
         half <- traceChecking "makeHalf" makeHalf e
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar half))))
-{-
-
-        (_, [], [(halfSrc, _)], _) <-
-          next "half" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd out) (n2PowTimes 1 (nVar (VPar (toEnd halfSrc))))
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfSrc)))))
-      Linear (VPar (InEnd tgt)) -> do
-        traceM "Halving in demandEven"
-        halfTgt <- invertNatVal (NumValue 0 (StrictMonoFun (StrictMono 1 mono)))
-        let half = nVar (VPar (toEnd halfTgt))
-        solveNumMeta (InEnd tgt) (n2PowTimes 1 half)
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar (toEnd halfTgt)))))
--}
       Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
 
@@ -202,21 +156,6 @@ unifyNum' numo (NumValue lup lgro) (NumValue rup rgro)
         pred <- traceChecking "makePred" makePred e
         half <- traceChecking "makeHalf" makeHalf pred
         pure (nVar (VPar half))
-{-
-      -- TODO: Why aren't we using `out`??
-      Linear (VPar (ExEnd bubble)) -> do
-        -- compute (/2) . (-1)
-        (_, [], [(halfSrc,_)], _) <- next "floorHalf" Hypo (S0, Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
-        solveNumMeta (ExEnd bubble) (nPlus 1 (n2PowTimes 1 (nVar (VPar (toEnd halfSrc)))))
-        pure (nVar (VPar (toEnd halfSrc)))
-      Linear (VPar (InEnd weeTgt)) -> do
-        -- compute (/2) . (-1)
-        bigTgt <- invertNatVal (NumValue 1 (StrictMonoFun (StrictMono 1 (Linear (VPar (toEnd weeTgt))))))
-        let flooredHalf = nVar (VPar (toEnd weeTgt))
-        solveNumMeta (toEnd bigTgt) (nPlus 1 (n2PowTimes 1 flooredHalf))
-        pure flooredHalf
-
--}
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
       Full sm -> nFull <$> traceChecking "demandSucc" demandSucc sm
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 8fd26e7d..af68231e 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -78,7 +78,7 @@ solve my ((src, Lit tm):p) = do
     (Braty, Left Nat)
       | Num n <- tm -> do
           unless (n >= 0) $ typeErr "Negative Nat kind"
-          unifyNum NUGinger (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
+          unifyNum (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
     (Braty, Right ty) -> do
       throwLeft (simpleCheck Braty ty tm)
     _ -> typeErr $ "Literal " ++ show tm ++ " isn't valid at this type"
@@ -97,7 +97,7 @@ solve my ((src, PCon c abs):p) = do
       -- Special case for 0, so that we can call `unifyNum` instead of pattern
       -- matching using what's returned from `natConstructors`
       PrefixName [] "zero" -> do
-        unifyNum NUGinger (nVar (VPar (toEnd src))) nZero
+        unifyNum (nVar (VPar (toEnd src))) nZero
         p <- argProblems [] (normaliseAbstractor abs) p
         (tests, sol) <- solve my p
         pure ((src, PrimLitTest (Num 0)):tests, sol)
@@ -106,7 +106,7 @@ solve my ((src, PCon c abs):p) = do
           (node, [], kids@[(dangling, _)], _) <- next "unpacked_nat" Hypo (S0, Some (Zy :* S0))
             R0 -- we don't need to wire the src in; we just need the inner stuff
             (REx ("inner", Nat) R0)
-          unifyNum NUGinger
+          unifyNum
            (nVar (VPar (ExEnd (end src))))
            (relationToInner (nVar (VPar (toEnd dangling))))
           -- TODO also do wiring corresponding to relationToInner
@@ -183,7 +183,7 @@ unify l k r = do
         | c == c' -> do
             ks <- tlup (Kernel, c)
             unifys args (snd <$> ks) args'
-      (VNum l, VNum r, Nat) -> unifyNum NUGinger l r
+      (VNum l, VNum r, Nat) -> unifyNum l r
       (VApp (VPar x) B0, v, _) -> instantiateMeta x v
       (v, VApp (VPar x) B0, _) -> instantiateMeta x v
       -- TODO: Handle function types

From 3930d3dda4a4e4086ec0c16a40d60a3347175b8f Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 7 Apr 2025 12:02:56 +0100
Subject: [PATCH 110/182] Fix redefinition in make{Half,Pred}

---
 brat/Brat/Checker/Helpers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 6bb7bdae..406631a9 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -516,7 +516,7 @@ makeHalf (InEnd e) = do
 makeHalf (ExEnd e) = do
   (halveIn, halveOut) <- buildHalve
   req (Wire (e, TNat, end halveIn))
-  defineTgt halveIn (VNum (nVar (VPar (toEnd e))))
+  defineSrc (NamedPort e "") (VNum (nVar (VPar (toEnd halveIn))))
   pure (toEnd halveOut)
 
 makePred :: End -> Checking End
@@ -529,7 +529,7 @@ makePred (InEnd e) = do
 makePred (ExEnd e) = do
   (predIn, predOut) <- buildSub 1
   req (Wire (e, TNat, end predIn))
-  defineTgt predIn (VNum (nVar (VPar (toEnd e))))
+  defineSrc (NamedPort e "") (VNum (nVar (VPar (toEnd predIn))))
   pure (toEnd predOut)
 
 -- Generate wiring to produce a dynamic instance of the numval argument

From 1cd750da67462da55a77ea1e8fd1654c77635175 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 7 Apr 2025 14:19:31 +0100
Subject: [PATCH 111/182] Keep track of which hopes are dynamic

---
 brat/Brat/Checker.hs         |  6 +++---
 brat/Brat/Checker/Helpers.hs | 13 +++++--------
 brat/Brat/Checker/Monad.hs   | 11 ++++++++---
 3 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 2387f810..4e5cbe18 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -678,7 +678,7 @@ check' (Of n e) ((), unders) = case ?my of
 check' Hope ((), (NamedPort hope _, ty):unders) = case (?my, ty) of
   (Braty, Left _k) -> do
     fc <- req AskFC
-    req (ANewHope hope fc)
+    req (ANewHope hope (HopeData (Just fc) True))
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
@@ -1161,11 +1161,11 @@ run ve initStore ns m = do
   -- If the `hopes` set has any remaining holes with kind Nat, we need to abort.
   -- Even though we didn't need them for typechecking problems, our runtime
   -- behaviour depends on the values of the holes, which we can't account for.
-  case M.toList $ M.filterWithKey (\e _ -> isNatKinded tyMap (InEnd e)) (hopes ctx) of
+  case M.toList $ M.filterWithKey (\e hd -> isNatKinded tyMap (InEnd e) && hopeDynamic hd) (hopes ctx) of
     [] -> pure (a, (holes, store ctx, graph))
     -- Just use the FC of the first hole while we don't have the capacity to
     -- show multiple error locations
-    hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
+    hs@((_,hd):_) -> Left $ Err (hopeFC hd) (RemainingNatHopes (show . fst <$> hs))
  where
   isNatKinded tyMap e = case tyMap M.! e of
     EndType Braty (Left Nat) -> True
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 406631a9..63141788 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -21,7 +21,7 @@ module Brat.Checker.Helpers {-(pullPortsRow, pullPortsSig
 			    ,solveHopeVal, solveHopeSem
                             )-} where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, tlup)
+import Brat.Checker.Monad (Checking, CheckingSig(..), HopeData(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, tlup)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType, quote, doesntOccur)
@@ -501,9 +501,9 @@ replaceHope old new = do
   hs <- req AskHopes
   case M.lookup old hs of
     Nothing -> pure ()
-    Just fc -> do
+    Just hd -> do
       req (RemoveHope old)
-      req (ANewHope new fc)
+      req (ANewHope new (HopeData Nothing (hopeDynamic hd)))
 
 -- Return an End with the same polarity whose value is half that of the input End
 makeHalf :: End -> Checking End
@@ -649,9 +649,7 @@ valPat2Val :: TypeKind
 valPat2Val k VPVar = do
   (_, [(idTgt, _)], [_], _) <- anext "pat2val" Id (S0, Some (Zy :* S0)) (REx ("", k) R0) (REx ("", k) R0)
   let val = VApp (VPar (toEnd idTgt)) B0
-  -- TODO: Make the FC optional in ANewHope
-  fc <- req AskFC
-  req (ANewHope (end idTgt) fc)
+  req (ANewHope (end idTgt) (HopeData Nothing False))
   pure (B0 :< val, val)
 valPat2Val (TypeFor m _) (VPCon con args) = do
   ks <- fmap snd <$> tlup (m, con)
@@ -666,8 +664,7 @@ valPat2Val Nat (VPNum n) = numPat2Val n >>= \(stk, nv) -> pure (stk, VNum nv)
   numPat2Val (NP2Times np) = second (n2PowTimes 1) <$> numPat2Val np
   numPat2Val NPVar = do
     (_, [(idTgt, _)], [_], _) <- anext "numpat2val" Id (S0, Some (Zy :* S0)) (REx ("", Nat) R0) (REx ("", Nat) R0)
-    fc <- req AskFC
-    req (ANewHope (end idTgt) fc)
+    req (ANewHope (end idTgt) (HopeData Nothing False))
     let var = endVal Nat (toEnd idTgt)
     pure (B0 :< var, nVar (VPar (toEnd idTgt)))
 
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 96900937..d049e078 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -50,7 +50,12 @@ data CtxEnv = CtxEnv
   , locals :: VEnv
   }
 
-type Hopes = M.Map InPort FC
+data HopeData = HopeData
+  { hopeFC :: Maybe FC
+  , hopeDynamic :: Bool
+  } deriving (Eq, Ord, Show)
+
+type Hopes = M.Map InPort HopeData
 
 data Context = Ctx { globalVEnv :: VEnv
                    , store :: Store
@@ -92,7 +97,7 @@ data CheckingSig ty where
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> CheckingSig ()
   Define  :: End -> Val Z -> CheckingSig ()
-  ANewHope :: InPort -> FC -> CheckingSig ()
+  ANewHope :: InPort -> HopeData -> CheckingSig ()
   AskHopes :: CheckingSig Hopes
   RemoveHope :: InPort -> CheckingSig ()
 
@@ -276,7 +281,7 @@ handler (Req s k) ctx g
                 M.lookup tycon tbl
         handler (k args) ctx g
 
-      ANewHope e fc -> handler (k ()) (ctx { hopes = M.insert e fc (hopes ctx) }) g
+      ANewHope e hd -> handler (k ()) (ctx { hopes = M.insert e hd (hopes ctx) }) g
 
       AskHopes -> handler (k (hopes ctx)) ctx g
 

From ae3be3437915a873acb4ebf8779917353e70d9c2 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 7 Apr 2025 15:22:22 +0100
Subject: [PATCH 112/182] Better handling of flex-flex case when unifying
 numbers

---
 brat/Brat/Checker/SolveNumbers.hs | 37 ++++++++++++++++++++++++++++---
 brat/Brat/Syntax/Port.hs          |  1 +
 brat/Brat/Syntax/Value.hs         |  2 ++
 3 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index c7bb6b16..b46f5e85 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -84,20 +84,51 @@ unifyNum' (NumValue lup lgro) (NumValue rup rgro)
  where
   lhsFun00 :: Fun00 (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsFun00 Constant0 num = demand0 num
+  -- Both sides are variables
+  lhsFun00 (StrictMonoFun (StrictMono 0 (Linear v))) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) = flexFlex v v'
+  -- There's just a variable on the right - move it to the left
+  lhsFun00 sm (NumValue 0 (StrictMonoFun smv@(StrictMono 0 (Linear _)))) = lhsStrictMono smv (NumValue 0 sm)
   lhsFun00 (StrictMonoFun sm) num = lhsStrictMono sm num
 
+  flexFlex :: VVar Z -> VVar Z -> Checking ()
+  flexFlex v v' = case compare v v' of
+    GT -> flexFlex v' v
+    EQ -> pure ()
+    LT -> case (v, v') of
+      (VPar (ExEnd e), v@(VPar (ExEnd _))) -> defineSrc (NamedPort e "") (VNum (nVar v))
+      (VPar (InEnd e), v@(VPar (ExEnd dangling))) -> do
+        req (Wire (dangling, TNat, e))
+        defineTgt (NamedPort e "") (VNum (nVar v))
+        (M.member e <$> req AskHopes) >>= \case
+          True -> req (RemoveHope e)
+          False -> pure ()
+      (v@(VPar (InEnd e)), v'@(VPar (InEnd e'))) -> do
+        hs <- req AskHopes
+        case (M.lookup e hs, M.lookup e' hs) of
+          (Nothing, Just _) -> do
+            defineTgt (NamedPort e' "") (VNum (nVar v))
+            req (RemoveHope e')
+          (Just _, Nothing) -> do
+            defineTgt (NamedPort e "") (VNum (nVar v'))
+            req (RemoveHope e)
+          (Nothing, Nothing) -> error "Two non-hopes in unifyNum"
+          (Just hd, Just hd') -> if hopeDynamic hd
+                                 then do defineTgt (NamedPort e' "") (VNum (nVar v))
+                                         req (RemoveHope e')
+                                 else do defineTgt (NamedPort e "") (VNum (nVar v'))
+                                         req (RemoveHope e)
+
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
   lhsStrictMono (StrictMono n mono) num = do
     num <- traceChecking "lhsSM demandEven" demandEven num
-    lhsStrictMono (StrictMono (n - 1) mono) num
+    lhsFun00 (StrictMonoFun (StrictMono (n - 1) mono)) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear v) (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear v')))) | v == v' = pure ()
   lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
                                   solveNumMeta e num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
-    = lhsStrictMono sm (NumValue 0 (StrictMonoFun sm'))
+    = lhsFun00 (StrictMonoFun sm) (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
     smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
diff --git a/brat/Brat/Syntax/Port.hs b/brat/Brat/Syntax/Port.hs
index 4b118576..5ce7c8d3 100644
--- a/brat/Brat/Syntax/Port.hs
+++ b/brat/Brat/Syntax/Port.hs
@@ -41,6 +41,7 @@ instance ToEnd InPort where
 instance ToEnd OutPort where
   toEnd = ExEnd
 
+-- N.B. Ord is derived with In < Ex
 data End = InEnd InPort | ExEnd OutPort
  deriving (Eq, Ord)
 
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index a39be7f6..c12aa149 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -53,6 +53,7 @@ data Inx :: N -> Type where
   VS :: Inx n -> Inx (S n)
 
 deriving instance Eq (Inx n)
+deriving instance Ord (Inx n)
 
 instance Show (Inx n) where
   show = show . toNat
@@ -143,6 +144,7 @@ data VVar :: N -> Type where
   VPar :: End -> VVar n  -- Has to be declared in the Store (for equality testing)
   VInx :: Inx n -> VVar n
 
+deriving instance Ord (VVar n)
 deriving instance Show (VVar n)
 
 instance Eq (VVar n) where

From 6724dbd74f191454b091ef0e60cc59e45b376738 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 7 Apr 2025 15:23:33 +0100
Subject: [PATCH 113/182] Accept new golden values, regress vector errors for
 now

---
 brat/test/golden/error/badvec.brat.golden     |  6 +-
 brat/test/golden/error/badvec2.brat.golden    |  6 +-
 brat/test/golden/error/badvec3.brat.golden    |  6 +-
 brat/test/golden/error/badvec4.brat.golden    |  6 +-
 brat/test/golden/error/kbadvec.brat.golden    |  6 +-
 brat/test/golden/error/kbadvec2.brat.golden   |  6 +-
 brat/test/golden/error/kbadvec3.brat.golden   |  6 +-
 brat/test/golden/error/vec_length.brat.golden |  5 +-
 brat/test/golden/graph/cons.brat.graph        | 59 +++++++++++----
 brat/test/golden/graph/kernel.brat.graph      | 73 +++++++++++++------
 brat/test/golden/graph/list.brat.graph        | 36 ++++++---
 brat/test/golden/graph/pair.brat.graph        | 32 +++++---
 brat/test/golden/graph/vec.brat.graph         | 57 +++++++++++----
 13 files changed, 192 insertions(+), 112 deletions(-)

diff --git a/brat/test/golden/error/badvec.brat.golden b/brat/test/golden/error/badvec.brat.golden
index 35e9fc33..f60758f4 100644
--- a/brat/test/golden/error/badvec.brat.golden
+++ b/brat/test/golden/error/badvec.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/badvec.brat on line 2:
 v3 = [1]
      ^^^
 
-  Expected vector of length 3
-from the type:  Vec(Int, 3)
-but got vector: [1]
-of length 1
-
+  Unification error: Couldn't force 2 to be 0
 
diff --git a/brat/test/golden/error/badvec2.brat.golden b/brat/test/golden/error/badvec2.brat.golden
index 2029db69..6d897a48 100644
--- a/brat/test/golden/error/badvec2.brat.golden
+++ b/brat/test/golden/error/badvec2.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/badvec2.brat on line 2:
 v3 = nil
      ^^^
 
-  Expected vector of length 3
-from the type:  Vec(Int, 3)
-but got vector: []
-of length 0
-
+  Unification error: Couldn't force 3 to be 0
 
diff --git a/brat/test/golden/error/badvec3.brat.golden b/brat/test/golden/error/badvec3.brat.golden
index 76e928b2..a17674df 100644
--- a/brat/test/golden/error/badvec3.brat.golden
+++ b/brat/test/golden/error/badvec3.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/badvec3.brat on line 2:
 v3 = cons(1, nil)
      ^^^^^^^^^^^^
 
-  Expected vector of length 0
-from the type:  Vec(Int, 0)
-but got vector: [1]
-of length (> 0)
-
+  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_v3_numpat2val_1 0 to be 0
 
diff --git a/brat/test/golden/error/badvec4.brat.golden b/brat/test/golden/error/badvec4.brat.golden
index 7fe59dfd..13b202ae 100644
--- a/brat/test/golden/error/badvec4.brat.golden
+++ b/brat/test/golden/error/badvec4.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/badvec4.brat on line 2:
 v3 = [1,2]
      ^^^^^
 
-  Expected vector of length 3
-from the type:  Vec(Int, 3)
-but got vector: [1,2]
-of length 2
-
+  Unification error: Couldn't force 1 to be 0
 
diff --git a/brat/test/golden/error/kbadvec.brat.golden b/brat/test/golden/error/kbadvec.brat.golden
index 07a9e553..73424591 100644
--- a/brat/test/golden/error/kbadvec.brat.golden
+++ b/brat/test/golden/error/kbadvec.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/kbadvec.brat on line 2:
 triple = { b => [b] }
                 ^^^
 
-  Expected vector of length 3
-from the type:  Vec(Bit, 3)
-but got vector: [「b」]
-of length 1
-
+  Unification error: Couldn't force 2 to be 0
 
diff --git a/brat/test/golden/error/kbadvec2.brat.golden b/brat/test/golden/error/kbadvec2.brat.golden
index c70190e9..e245c2cb 100644
--- a/brat/test/golden/error/kbadvec2.brat.golden
+++ b/brat/test/golden/error/kbadvec2.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/kbadvec2.brat on line 2:
 triple = { b => nil }
                 ^^^
 
-  Expected vector of length 3
-from the type:  Vec(Bit, 3)
-but got vector: []
-of length 0
-
+  Unification error: Couldn't force 3 to be 0
 
diff --git a/brat/test/golden/error/kbadvec3.brat.golden b/brat/test/golden/error/kbadvec3.brat.golden
index 97be8bec..d8718593 100644
--- a/brat/test/golden/error/kbadvec3.brat.golden
+++ b/brat/test/golden/error/kbadvec3.brat.golden
@@ -2,9 +2,5 @@ Error in test/golden/error/kbadvec3.brat on line 2:
 constNil = { b => cons(1, nil) }
                   ^^^^^^^^^^^^
 
-  Expected vector of length 0
-from the type:  Vec(Bit, 0)
-but got vector: [1]
-of length (> 0)
-
+  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_constNil_thunk_2_numpat2val_3 0 to be 0
 
diff --git a/brat/test/golden/error/vec_length.brat.golden b/brat/test/golden/error/vec_length.brat.golden
index 6fda6b03..b8f5be01 100644
--- a/brat/test/golden/error/vec_length.brat.golden
+++ b/brat/test/golden/error/vec_length.brat.golden
@@ -2,8 +2,5 @@ Error in test/golden/error/vec_length.brat on line 2:
 f(_, _, xs) = xs
               ^^
 
-  Type mismatch when checking xs
-Expected: (a1 :: Vec(VApp VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 0 B0, VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 1))
-But got:  (xs :: Vec(VApp VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 0 B0, 1 + VPar Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 1))
-
+  Unification error: Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 1 is cyclic
 
diff --git a/brat/test/golden/graph/cons.brat.graph b/brat/test/golden/graph/cons.brat.graph
index cc61c7b8..3914b766 100644
--- a/brat/test/golden/graph/cons.brat.graph
+++ b/brat/test/golden/graph/cons.brat.graph
@@ -1,11 +1,29 @@
 Nodes:
-(check_defs_1_three_1_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_three_1_const_1,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_two_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_two_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_two_const_1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_two_const_3,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_two_nil_4,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_three_1_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_three_1_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_three_1_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_three_1_buildConst_5,BratNode (Const []) [] [("value",[])])
+(check_defs_1_three_1_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
+(check_defs_1_three_1_const_7,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_three_1_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_three_1_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_two_buildConst_2,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_two_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_two_buildConst_5,BratNode (Const []) [] [("value",[])])
+(check_defs_1_two_buildConst_10,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_two_buildConst_11,BratNode (Const []) [] [("value",[])])
+(check_defs_1_two_buildConst_15,BratNode (Const []) [] [("value",[])])
+(check_defs_1_two_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
+(check_defs_1_two_cons_12,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_two_const_7,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_two_const_13,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_two_nil_16,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_two_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_two_numpat2val_9,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_two_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_pat2val_8,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_pat2val_14,BratNode Id [("",[])] [("",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_7,BratNode (Constructor Int) [] [("value",[])])
 (globals_Vec_1,BratNode (Constructor Vec) [("X",[]),("n",Nat)] [("value",[])])
@@ -16,17 +34,28 @@ Nodes:
 (globals_decl_9_three,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-(Ex check_defs_1_three_1_cons 0,Vec(Int, 3),In globals_decl_9_three 0)
-(Ex check_defs_1_three_1_const_1 0,Int,In check_defs_1_three_1_cons 0)
-(Ex check_defs_1_two_cons 0,Vec(Int, 2),In globals_decl_4_two 0)
-(Ex check_defs_1_two_cons_2 0,Vec(Int, 1),In check_defs_1_two_cons 1)
-(Ex check_defs_1_two_const_1 0,Int,In check_defs_1_two_cons 0)
-(Ex check_defs_1_two_const_3 0,Int,In check_defs_1_two_cons_2 0)
-(Ex check_defs_1_two_nil_4 0,Vec(Int, 0),In check_defs_1_two_cons_2 1)
+(Ex check_defs_1_three_1_Add_3 0,Nat,In check_defs_1_three_1_numpat2val_1 0)
+(Ex check_defs_1_three_1_buildConst_2 0,Nat,In check_defs_1_three_1_Add_3 0)
+(Ex check_defs_1_three_1_buildConst_4 0,Nat,In check_defs_1_three_1_Add_3 1)
+(Ex check_defs_1_three_1_buildConst_5 0,[],In check_defs_1_three_1_pat2val 0)
+(Ex check_defs_1_three_1_cons_6 0,Vec(Int, 3),In globals_decl_9_three 0)
+(Ex check_defs_1_three_1_const_7 0,Int,In check_defs_1_three_1_cons_6 0)
+(Ex check_defs_1_two_Add_3 0,Nat,In check_defs_1_two_numpat2val_1 0)
+(Ex check_defs_1_two_buildConst_10 0,Nat,In check_defs_1_two_numpat2val_9 0)
+(Ex check_defs_1_two_buildConst_11 0,[],In check_defs_1_two_pat2val_8 0)
+(Ex check_defs_1_two_buildConst_15 0,[],In check_defs_1_two_pat2val_14 0)
+(Ex check_defs_1_two_buildConst_2 0,Nat,In check_defs_1_two_Add_3 0)
+(Ex check_defs_1_two_buildConst_4 0,Nat,In check_defs_1_two_Add_3 1)
+(Ex check_defs_1_two_buildConst_5 0,[],In check_defs_1_two_pat2val 0)
+(Ex check_defs_1_two_cons_12 0,Vec(Int, 1),In check_defs_1_two_cons_6 1)
+(Ex check_defs_1_two_cons_6 0,Vec(Int, 2),In globals_decl_4_two 0)
+(Ex check_defs_1_two_const_13 0,Int,In check_defs_1_two_cons_12 0)
+(Ex check_defs_1_two_const_7 0,Int,In check_defs_1_two_cons_6 0)
+(Ex check_defs_1_two_nil_16 0,Vec(Int, 0),In check_defs_1_two_cons_12 1)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Int_7 0,[],In globals_Vec_6 0)
 (Ex globals_Vec_1 0,[],In globals___kca_two 0)
 (Ex globals_Vec_6 0,[],In globals___kca_three_5 0)
 (Ex globals_const_3 0,Nat,In globals_Vec_1 1)
 (Ex globals_const_8 0,Nat,In globals_Vec_6 1)
-(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_1_cons 1)
+(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_1_cons_6 1)
diff --git a/brat/test/golden/graph/kernel.brat.graph b/brat/test/golden/graph/kernel.brat.graph
index 26ad580e..eb6a97e5 100644
--- a/brat/test/golden/graph/kernel.brat.graph
+++ b/brat/test/golden/graph/kernel.brat.graph
@@ -1,15 +1,33 @@
 Nodes:
-(check_defs_1_id3_thunk_3_lambda_14,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_6 2, portName = "c1"},Qubit)]}),check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_12) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_13_nil_3,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/in_10,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/out_11,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_12,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 check_defs_1_id3_thunk_3_lambda.0_rhs/out_11) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_thunk_3_lambda.0_setup/in_6,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_setup/out_7,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_setup_thunk_8,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_setup/in_6 check_defs_1_id3_thunk_3_lambda.0_setup/out_7) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_thunk_3_lambda_32,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 2, portName = "c1"},Qubit)]}),check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_30) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_5,BratNode (Const []) [] [("value",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_9,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_11,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_12,BratNode (Const []) [] [("value",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_16,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_17,BratNode (Const []) [] [("value",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_20,BratNode (Const []) [] [("value",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_nil_21,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_8,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_15,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_7,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_14,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_19,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_thunk_3_lambda.0_rhs/in_28,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
+(check_defs_1_id3_thunk_3_lambda.0_rhs/out_29,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_30,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 check_defs_1_id3_thunk_3_lambda.0_rhs/out_29) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_thunk_3_lambda.0_setup/in_24,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
+(check_defs_1_id3_thunk_3_lambda.0_setup/out_25,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_thunk_3_lambda.0_setup_thunk_26,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_setup/in_24 check_defs_1_id3_thunk_3_lambda.0_setup/out_25) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 (check_defs_1_id3_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
 (check_defs_1_id3_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
 (check_defs_1_id3_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_id3_thunk/in check_defs_1_id3_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
@@ -22,17 +40,28 @@ Nodes:
 (globals_decl_9_id3,BratNode Id [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })] [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 
 Wires:
-(Ex check_defs_1_id3_thunk/in 0,Qubit,In check_defs_1_id3_thunk_3_lambda_14 0)
-(Ex check_defs_1_id3_thunk/in 1,Qubit,In check_defs_1_id3_thunk_3_lambda_14 1)
-(Ex check_defs_1_id3_thunk/in 2,Qubit,In check_defs_1_id3_thunk_3_lambda_14 2)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 0,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 1,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_10 2,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 0,Vec(Qubit, 3),In check_defs_1_id3_thunk_3_lambda.0_rhs/out_11 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 0,Vec(Qubit, 2),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 0,Vec(Qubit, 1),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_1 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_13_nil_3 0,Vec(Qubit, 0),In check_defs_1_id3_thunk_3_lambda.0_rhs_13_cons_2 1)
-(Ex check_defs_1_id3_thunk_3_lambda_14 0,Vec(Qubit, 3),In check_defs_1_id3_thunk/out_1 0)
+(Ex check_defs_1_id3_thunk/in 0,Qubit,In check_defs_1_id3_thunk_3_lambda_32 0)
+(Ex check_defs_1_id3_thunk/in 1,Qubit,In check_defs_1_id3_thunk_3_lambda_32 1)
+(Ex check_defs_1_id3_thunk/in 2,Qubit,In check_defs_1_id3_thunk_3_lambda_32 2)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 0,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 1,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 2,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_8 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_1 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_11 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 1)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_12 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_7 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_16 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_15 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_17 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_14 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_2 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_20 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_19 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_4 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 1)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_5 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_9 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 0,Vec(Qubit, 2),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 1)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 0,Vec(Qubit, 1),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 1)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 0,Vec(Qubit, 3),In check_defs_1_id3_thunk_3_lambda.0_rhs/out_29 0)
+(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_nil_21 0,Vec(Qubit, 0),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 1)
+(Ex check_defs_1_id3_thunk_3_lambda_32 0,Vec(Qubit, 3),In check_defs_1_id3_thunk/out_1 0)
 (Ex check_defs_1_id3_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_3 0,[],In globals___kcr__1 1)
diff --git a/brat/test/golden/graph/list.brat.graph b/brat/test/golden/graph/list.brat.graph
index de1910c1..2790b2b0 100644
--- a/brat/test/golden/graph/list.brat.graph
+++ b/brat/test/golden/graph/list.brat.graph
@@ -1,22 +1,34 @@
 Nodes:
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_buildConst_1,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_5,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_9,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_13,BratNode (Const []) [] [("value",[])])
 (check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_const_1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_const_3,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_const_5,BratNode (Const 3) [] [("value",Int)])
-(check_defs_1_xs_nil_6,BratNode (Constructor nil) [] [("value",List(Int))])
+(check_defs_1_xs_cons_6,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_cons_10,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_const_3,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_const_7,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_const_11,BratNode (Const 3) [] [("value",Int)])
+(check_defs_1_xs_nil_14,BratNode (Constructor nil) [] [("value",List(Int))])
+(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_4,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_8,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_12,BratNode Id [("",[])] [("",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_List_1,BratNode (Constructor List) [("listValue",[])] [("value",[])])
 (globals_decl_3_xs,BratNode Id [("a1",List(Int))] [("a1",List(Int))])
 
 Wires:
-(Ex check_defs_1_xs_cons 0,List(Int),In globals_decl_3_xs 0)
-(Ex check_defs_1_xs_cons_2 0,List(Int),In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_cons_4 0,List(Int),In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_const_1 0,Int,In check_defs_1_xs_cons 0)
+(Ex check_defs_1_xs_buildConst_1 0,[],In check_defs_1_xs_pat2val 0)
+(Ex check_defs_1_xs_buildConst_13 0,[],In check_defs_1_xs_pat2val_12 0)
+(Ex check_defs_1_xs_buildConst_5 0,[],In check_defs_1_xs_pat2val_4 0)
+(Ex check_defs_1_xs_buildConst_9 0,[],In check_defs_1_xs_pat2val_8 0)
+(Ex check_defs_1_xs_cons_10 0,List(Int),In check_defs_1_xs_cons_6 1)
+(Ex check_defs_1_xs_cons_2 0,List(Int),In globals_decl_3_xs 0)
+(Ex check_defs_1_xs_cons_6 0,List(Int),In check_defs_1_xs_cons_2 1)
+(Ex check_defs_1_xs_const_11 0,Int,In check_defs_1_xs_cons_10 0)
 (Ex check_defs_1_xs_const_3 0,Int,In check_defs_1_xs_cons_2 0)
-(Ex check_defs_1_xs_const_5 0,Int,In check_defs_1_xs_cons_4 0)
-(Ex check_defs_1_xs_nil_6 0,List(Int),In check_defs_1_xs_cons_4 1)
+(Ex check_defs_1_xs_const_7 0,Int,In check_defs_1_xs_cons_6 0)
+(Ex check_defs_1_xs_nil_14 0,List(Int),In check_defs_1_xs_cons_10 1)
 (Ex globals_Int_2 0,[],In globals_List_1 0)
 (Ex globals_List_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/pair.brat.graph b/brat/test/golden/graph/pair.brat.graph
index ef826479..fab32291 100644
--- a/brat/test/golden/graph/pair.brat.graph
+++ b/brat/test/golden/graph/pair.brat.graph
@@ -1,9 +1,17 @@
 Nodes:
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
-(check_defs_1_xs_const_1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_nil_4,BratNode (Constructor nil) [] [("value",[])])
-(check_defs_1_xs_true_3,BratNode (Constructor true) [] [("value",Bool)])
+(check_defs_1_xs_buildConst_2,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_3,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_8,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_9,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
+(check_defs_1_xs_cons_10,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
+(check_defs_1_xs_const_5,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_nil_12,BratNode (Constructor nil) [] [("value",[])])
+(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_1,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_6,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_7,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_true_11,BratNode (Constructor true) [] [("value",Bool)])
 (globals_Bool_4,BratNode (Constructor Bool) [] [("value",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_cons_1,BratNode (Constructor cons) [("head",[]),("tail",[])] [("value",[])])
@@ -12,11 +20,15 @@ Nodes:
 (globals_nil_5,BratNode (Constructor nil) [] [("value",[])])
 
 Wires:
-(Ex check_defs_1_xs_cons 0,[Int,Bool],In globals_decl_6_xs 0)
-(Ex check_defs_1_xs_cons_2 0,[Bool],In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_const_1 0,Int,In check_defs_1_xs_cons 0)
-(Ex check_defs_1_xs_nil_4 0,[],In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_true_3 0,Bool,In check_defs_1_xs_cons_2 0)
+(Ex check_defs_1_xs_buildConst_2 0,[],In check_defs_1_xs_pat2val_1 0)
+(Ex check_defs_1_xs_buildConst_3 0,[],In check_defs_1_xs_pat2val 0)
+(Ex check_defs_1_xs_buildConst_8 0,[],In check_defs_1_xs_pat2val_7 0)
+(Ex check_defs_1_xs_buildConst_9 0,[],In check_defs_1_xs_pat2val_6 0)
+(Ex check_defs_1_xs_cons_10 0,[Bool],In check_defs_1_xs_cons_4 1)
+(Ex check_defs_1_xs_cons_4 0,[Int,Bool],In globals_decl_6_xs 0)
+(Ex check_defs_1_xs_const_5 0,Int,In check_defs_1_xs_cons_4 0)
+(Ex check_defs_1_xs_nil_12 0,[],In check_defs_1_xs_cons_10 1)
+(Ex check_defs_1_xs_true_11 0,Bool,In check_defs_1_xs_cons_10 0)
 (Ex globals_Bool_4 0,[],In globals_cons_3 0)
 (Ex globals_Int_2 0,[],In globals_cons_1 0)
 (Ex globals_cons_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/vec.brat.graph b/brat/test/golden/graph/vec.brat.graph
index 844bd6c8..d6a96b30 100644
--- a/brat/test/golden/graph/vec.brat.graph
+++ b/brat/test/golden/graph/vec.brat.graph
@@ -1,24 +1,53 @@
 Nodes:
-(check_defs_1_xs_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_xs_const_1,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_xs_const_3,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_const_5,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_nil_6,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_xs_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_xs_Add_11,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_xs_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_xs_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_xs_buildConst_5,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_10,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_xs_buildConst_12,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_xs_buildConst_13,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_18,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_xs_buildConst_19,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_buildConst_23,BratNode (Const []) [] [("value",[])])
+(check_defs_1_xs_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
+(check_defs_1_xs_cons_14,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
+(check_defs_1_xs_cons_20,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_xs_const_7,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_xs_const_15,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_const_21,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_nil_24,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_xs_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_numpat2val_9,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_numpat2val_17,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_8,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_16,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_pat2val_22,BratNode Id [("",[])] [("",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Vec_1,BratNode (Constructor Vec) [("X",[]),("n",Nat)] [("value",[])])
 (globals_const_3,BratNode (Const 3) [] [("value",Nat)])
 (globals_decl_4_xs,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-(Ex check_defs_1_xs_cons 0,Vec(Int, 3),In globals_decl_4_xs 0)
-(Ex check_defs_1_xs_cons_2 0,Vec(Int, 2),In check_defs_1_xs_cons 1)
-(Ex check_defs_1_xs_cons_4 0,Vec(Int, 1),In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_const_1 0,Int,In check_defs_1_xs_cons 0)
-(Ex check_defs_1_xs_const_3 0,Int,In check_defs_1_xs_cons_2 0)
-(Ex check_defs_1_xs_const_5 0,Int,In check_defs_1_xs_cons_4 0)
-(Ex check_defs_1_xs_nil_6 0,Vec(Int, 0),In check_defs_1_xs_cons_4 1)
+(Ex check_defs_1_xs_Add_11 0,Nat,In check_defs_1_xs_numpat2val_9 0)
+(Ex check_defs_1_xs_Add_3 0,Nat,In check_defs_1_xs_numpat2val_1 0)
+(Ex check_defs_1_xs_buildConst_10 0,Nat,In check_defs_1_xs_Add_11 0)
+(Ex check_defs_1_xs_buildConst_12 0,Nat,In check_defs_1_xs_Add_11 1)
+(Ex check_defs_1_xs_buildConst_13 0,[],In check_defs_1_xs_pat2val_8 0)
+(Ex check_defs_1_xs_buildConst_18 0,Nat,In check_defs_1_xs_numpat2val_17 0)
+(Ex check_defs_1_xs_buildConst_19 0,[],In check_defs_1_xs_pat2val_16 0)
+(Ex check_defs_1_xs_buildConst_2 0,Nat,In check_defs_1_xs_Add_3 0)
+(Ex check_defs_1_xs_buildConst_23 0,[],In check_defs_1_xs_pat2val_22 0)
+(Ex check_defs_1_xs_buildConst_4 0,Nat,In check_defs_1_xs_Add_3 1)
+(Ex check_defs_1_xs_buildConst_5 0,[],In check_defs_1_xs_pat2val 0)
+(Ex check_defs_1_xs_cons_14 0,Vec(Int, 2),In check_defs_1_xs_cons_6 1)
+(Ex check_defs_1_xs_cons_20 0,Vec(Int, 1),In check_defs_1_xs_cons_14 1)
+(Ex check_defs_1_xs_cons_6 0,Vec(Int, 3),In globals_decl_4_xs 0)
+(Ex check_defs_1_xs_const_15 0,Int,In check_defs_1_xs_cons_14 0)
+(Ex check_defs_1_xs_const_21 0,Int,In check_defs_1_xs_cons_20 0)
+(Ex check_defs_1_xs_const_7 0,Int,In check_defs_1_xs_cons_6 0)
+(Ex check_defs_1_xs_nil_24 0,Vec(Int, 0),In check_defs_1_xs_cons_20 1)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Vec_1 0,[],In globals___kca_xs 0)
 (Ex globals_const_3 0,Nat,In globals_Vec_1 1)

From 0802411e276f3b00dc7df7108672fa116abcf359 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 8 Apr 2025 10:06:37 +0100
Subject: [PATCH 114/182] Lots of debug printing

---
 brat/Brat/Checker.hs              | 40 ++++++++++++++++------------
 brat/Brat/Checker/Helpers.hs      | 43 ++++++++++++++++++-------------
 brat/Brat/Checker/Monad.hs        | 18 ++++++-------
 brat/Brat/Checker/SolveHoles.hs   |  9 +++++--
 brat/Brat/Checker/SolveNumbers.hs | 21 ++++++++-------
 brat/Brat/Eval.hs                 |  2 +-
 brat/Control/Monad/Freer.hs       | 12 ++++-----
 7 files changed, 82 insertions(+), 63 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 8549ffe2..33467d5d 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -51,7 +51,7 @@ import Bwd
 import Hasochism
 import Util (zipSameLength)
 
--- import Debug.Trace
+import Debug.Trace
 
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
@@ -124,7 +124,7 @@ checkWire Braty _ outputs (dangling, Left ok) (hungry, Left uk) = do
   throwLeft $ if outputs
     then kindEq ok uk
     else kindEq uk ok
-  defineTgt hungry (endVal ok (ExEnd (end dangling)))
+  defineTgt' "checkWire" hungry (endVal ok (ExEnd (end dangling)))
   wire (dangling, kindType ok, hungry)
 checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ do
   let ot = binderToValue Braty o
@@ -173,6 +173,7 @@ checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m)
              -> [(Tgt, BinderType m)] -- Expected
              -> [(Src, BinderType m)] -- Actual
              -> Checking [(Tgt, BinderType m)]
+checkOutputs tm unders overs | trace ("checkOutputs\n  " ++ show unders ++ "\n  " ++ show overs) False = undefined
 checkOutputs tm unders overs = checkIO tm unders overs (flip $ checkWire ?my tm True) "No unders but overs: "
 
 check :: (CheckConstraints m k
@@ -184,7 +185,11 @@ check :: (CheckConstraints m k
       -> ChkConnectors m d k
       -> Checking (SynConnectors m d k
                   ,ChkConnectors m d k)
-check (WC fc tm) conn = track ("Beginning check of " ++ show tm) $ localFC fc (check' tm conn)
+check (WC fc tm) conn = do
+  trackM ("Beginning check of " ++ show tm)
+  x <- localFC fc (check' tm conn)
+  trackM ("End check of " ++ show tm)
+  pure x
 
 check' :: forall m d k
         . (CheckConstraints m k
@@ -480,10 +485,11 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
     (varz, patVals) <- valPats2Val ks pats
-    -- traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
+    traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
     typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
-    -- traceM "Made it past unification"
+    ty <- eval S0 ty
+    traceM $ "Made it past unification for ty =  " ++ show ty
     Some (ny :* env) <- pure $ bwdStack varz
     -- Make sure env is the correct length for args
     Refl <- throwLeft $ natEqOrBust ny nFree
@@ -515,7 +521,7 @@ check' (Simple tm) ((), (hungry, ty):unders) = do
                                     R0 (REx ("value", Nat) R0)
       let val = VNum (nConstant (fromIntegral n))
       defineSrc dangling val
-      defineTgt hungry val
+      defineTgt' "check.simple" hungry val
       wire (dangling, kindType Nat, hungry)
       pure (((), ()), ((), unders))
     -- No defining needed, so everything else can be unified
@@ -616,7 +622,7 @@ check' (Of n e) ((), unders) = case ?my of
               -- Wire the length into all the replicate nodes
               for_ lenIns $ \(tgt, _) -> do
                 wire (natOver, kindType Nat, tgt)
-                defineTgt tgt n
+                defineTgt' "Of" tgt n
               (((), ()), ((), elemRightUnders)) <- check e ((), repUnders)
               -- If `elemRightUnders` isn't empty, it means we were too greedy
               -- in the call to getVecs, so we should work out which elements of
@@ -644,7 +650,7 @@ check' (Of n e) ((), unders) = case ?my of
             let (lenIns, elemIns, vecOuts) = unzip3 conns
             for_ lenIns $ \(tgt,_) -> do
               wire (natOver, kindType Nat, tgt)
-              defineTgt tgt n
+              defineTgt' "Of syn" tgt n
             zipWithM_ (\(dangling, ty) (hungry, _) -> wire (dangling, ty, hungry)) outputs elemIns
             pure (((), vecOuts), ((), ()))
           _ -> localFC (fcOf e) $ typeErr "No type dependency allowed when using `of`"
@@ -818,7 +824,7 @@ kindCheck ((hungry, k@(TypeFor m [])):unders) (Con c arg) = req (TLup (m, c)) >>
       ensureEmpty "kindCheck unders" emptyUnders
       -- now evVa can pick up the definitions
       value <- eval S0 $ VCon c [ endVal k (InEnd (end tgt)) | (tgt, k) <- kindArgs ]
-      defineTgt hungry value
+      defineTgt' "kind0" hungry value
       defineSrc dangling value
       wire (dangling, kindType k, hungry)
       pure ([value],unders)
@@ -838,7 +844,7 @@ kindCheck ((hungry, k@(TypeFor m [])):unders) (Con c arg) = req (TLup (m, c)) >>
         ensureEmpty "alias args" emptyUnders
         val <- apply aliasLam args
         defineSrc kindOut val
-        defineTgt hungry val
+        defineTgt' "kind1" hungry val
         wire (kindOut, kindType k, hungry)
         pure ([val], unders)
     Nothing -> typeErr $ "Can't find type constructor or type alias " ++ show c
@@ -849,7 +855,7 @@ kindCheck ((hungry, Star []):unders) (C (ss :-> ts)) = do
     (i, env, Some (ez :* inRo)) -> kindCheckRow' Braty ez env (name, i) ts >>= \case
       (_, _, Some (_ :* outRo)) -> do
         let val = VFun Braty (inRo :->> outRo)
-        defineTgt hungry val
+        defineTgt' "kind2" hungry val
         pure ([val], unders)
 kindCheck ((hungry, Star []):unders) (K (ss :-> ts)) = do
   -- N.B. Kernels can't bind so we don't need to pass around a stack of ends
@@ -859,7 +865,7 @@ kindCheck ((hungry, Star []):unders) (K (ss :-> ts)) = do
     (Some ss, Some ts) -> case kernelNoBind ss of
       Refl -> do
         let val = VFun Kerny (ss :->> ts)
-        defineTgt hungry val
+        defineTgt' "kind3" hungry val
         pure ([val], unders)
 
 -- N.B. This code is currently only called for checking the validity of type aliases
@@ -879,7 +885,7 @@ kindCheck ((hungry, TypeFor m args):unders) (Th (WC _ (Lambda (xs, WC fc body) [
     vbody <- eval S0 vbody
     let vlam = case endz of
           Some (ny :* endz) -> lambdify endz (changeVar (ParToInx (AddZ ny) endz) vbody)
-    defineTgt hungry vlam
+    defineTgt' "kind4" hungry vlam
     pure ([vlam], unders)
  where
   lambdify :: Stack Z End i -> Val i -> Val Z
@@ -896,7 +902,7 @@ kindCheck unders (Emb (WC fc (Var v))) = localFC fc $ vlup v >>= f unders
     throwLeft $ kindEq k k'
     wire (dangling, kindType k, hungry)
     value <- eval S0 (endVal k (ExEnd (end dangling)))
-    defineTgt hungry value
+    defineTgt' "kind5" hungry value
     (vs, leftUnders) <- f us xs
     pure (value:vs, leftUnders)
   f _ (x:_) = err $ InternalError $ "Kindchecking a row which contains " ++ show x
@@ -904,7 +910,7 @@ kindCheck unders (Emb (WC fc (Var v))) = localFC fc $ vlup v >>= f unders
 kindCheck ((hungry, Nat):unders) (Simple (Num n)) | n >= 0 = do
   (_, _, [(dangling, _)], _) <- next "const" (Const (Num n)) (S0,Some (Zy :* S0)) R0 (REx ("value", Nat) R0)
   let value = VNum (nConstant (fromIntegral n))
-  defineTgt hungry value
+  defineTgt' "kind6" hungry value
   defineSrc dangling value
   wire (dangling, TNat, hungry)
   pure ([value], unders)
@@ -919,7 +925,7 @@ kindCheck ((hungry, Nat):unders) (Arith op lhs rhs) = do
       case runArith lhs op rhs of
         Nothing -> typeErr "Type level arithmetic too confusing"
         Just result -> do
-          defineTgt hungry (VNum result)
+          defineTgt' "kind7" hungry (VNum result)
           defineSrc dangling (VNum result)
           wire (dangling, kindType Nat, hungry)
           pure ([VNum result], unders)
@@ -937,7 +943,7 @@ kindCheck ((hungry, Nat):unders) (Con c arg)
      ensureEmpty "kindCheck unders" us
      v <- eval S0 (VNum (f nv))
      defineSrc cdangling v
-     defineTgt hungry v
+     defineTgt' "kind8" hungry v
      pure ([v], unders)
 
 kindCheck ((_, k):_) tm = typeErr $ "Expected " ++ show tm ++ " to have kind " ++ show k
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index eb944216..de0dd027 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -40,9 +40,9 @@ simpleCheck my ty tm = case (my, ty) of
                    ExEnd _ -> False
     if isHope then
       case tm of
-        Float _ -> defineEnd e TFloat
-        Text _ -> defineEnd e TText
-        Num n | n < 0 -> defineEnd e TInt
+        Float _ -> defineEnd "simpleCheck" e TFloat
+        Text _ -> defineEnd "simpleCheck" e TText
+        Num n | n < 0 -> defineEnd "simpleCheck" e TInt
         Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
     else isSkolem e >>= \case
       SkolemConst -> throwLeft $ helper Braty ty tm
@@ -311,7 +311,7 @@ vectorise my (src, ty) = do
       next "MapFun" MapFun (S0, Some (Zy :* S0))
       (REx ("len", Nat) (RPr ("value", weak1 ty) R0))
       (RPr ("vector", weak1 vecFun) R0)
-    defineTgt lenTgt (VNum len)
+    defineTgt' "vectorise" lenTgt (VNum len)
     wire (lenSrc, kindType Nat, lenTgt)
     wire (valSrc, ty, valTgt)
     let vecCTy = case (my,my',cty) of
@@ -348,10 +348,16 @@ valueToBinder Braty = Right
 valueToBinder Kerny = id
 
 defineSrc :: Src -> Val Z -> Checking ()
-defineSrc src = defineEnd (ExEnd (end src))
+defineSrc src = defineEnd "" (ExEnd (end src))
 
 defineTgt :: Tgt -> Val Z -> Checking ()
-defineTgt tgt = defineEnd (InEnd (end tgt))
+defineTgt tgt = defineEnd "" (InEnd (end tgt))
+
+defineSrc' :: String -> Src -> Val Z -> Checking ()
+defineSrc' lbl src = defineEnd lbl (ExEnd (end src))
+
+defineTgt' :: String -> Tgt -> Val Z -> Checking ()
+defineTgt' lbl tgt = defineEnd lbl (InEnd (end tgt))
 
 declareTgt :: Tgt -> Modey m -> BinderType m -> Checking ()
 declareTgt tgt my ty = req (Declare (InEnd (end tgt)) my ty Definable)
@@ -488,7 +494,7 @@ buildSub n = do
   nDangling <- buildNum n
   ((lhs,rhs),out) <- buildArithOp Sub
   req $ Wire (end nDangling, TNat, end rhs)
-  defineTgt lhs (VNum (nPlus n (nVar (VPar (toEnd out)))))
+  defineTgt' "Sub" lhs (VNum (nPlus n (nVar (VPar (toEnd out)))))
   pure (lhs, out)
 
 buildDoub :: Checking (Tgt, Src)
@@ -504,7 +510,7 @@ buildHalve = do
   nDangling <- buildNum 2
   ((lhs,rhs),out) <- buildArithOp Div
   req $ Wire (end nDangling, TNat, end rhs)
-  defineTgt lhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
+  defineTgt' "Helpers"lhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
   pure (lhs, out)
 
 replaceHope :: InPort -> InPort -> Checking ()
@@ -519,7 +525,7 @@ makeHalf :: End -> Checking End
 makeHalf (InEnd e) = do
   (doubIn, doubOut) <- buildDoub
   req (Wire (end doubOut, TNat, e))
-  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd doubOut))))
+  defineTgt' "Helpers"(NamedPort e "") (VNum (nVar (VPar (toEnd doubOut))))
   replaceHope e (end doubIn)
   pure (InEnd (end doubIn))
 makeHalf (ExEnd e) = do
@@ -532,7 +538,7 @@ makePred :: End -> Checking End
 makePred (InEnd e) = do
   (succIn, succOut) <- buildAdd 1
   req (Wire (end succOut, TNat, e))
-  defineTgt (NamedPort e "") (VNum (nVar (VPar (toEnd succOut))))
+  defineTgt' "Helpers"(NamedPort e "") (VNum (nVar (VPar (toEnd succOut))))
   replaceHope e (end succIn)
   pure (toEnd succIn)
 makePred (ExEnd e) = do
@@ -551,7 +557,8 @@ buildNatVal nv@(NumValue n gro) = case n of
     (inn, out) <- buildAdd n
     src <- buildGro gro
     req $ Wire (end src, TNat, end inn)
-    defineTgt inn (VNum (nVar (VPar (toEnd src))))
+    traceM $ "buildNatVal " ++ show inn
+    defineTgt' "Helpers"inn (VNum (nVar (VPar (toEnd src))))
     pure out
  where
   buildGro :: Fun00 (VVar Z) -> Checking Src
@@ -596,8 +603,8 @@ invertNatVal (NumValue up gro) = case up of
     req $ Wire (end upSrc, TNat, end rhs)
     tgt <- invertGro gro
     req $ Wire (end out, TNat, end tgt)
-    defineTgt tgt (VNum (nVar (VPar (toEnd out))))
-    defineTgt lhs (VNum (nPlus up (nVar (VPar (toEnd tgt)))))
+    defineTgt' "Helpers"tgt (VNum (nVar (VPar (toEnd out))))
+    defineTgt' "Helpers"lhs (VNum (nPlus up (nVar (VPar (toEnd tgt)))))
     pure lhs
  where
   invertGro Constant0 = error "Invariant violated: the numval arg to invertNatVal should contain a variable"
@@ -611,8 +618,8 @@ invertNatVal (NumValue up gro) = case up of
       tgt <- invertMono mono
       req $ Wire (end out, TNat, end tgt)
       req $ Wire (end divisor, TNat, end rhs)
-      defineTgt tgt (VNum (nVar (VPar (toEnd out))))
-      defineTgt lhs (VNum (n2PowTimes k (nVar (VPar (toEnd tgt)))))
+      defineTgt' "Helpers"tgt (VNum (nVar (VPar (toEnd out))))
+      defineTgt' "Helpers"lhs (VNum (n2PowTimes k (nVar (VPar (toEnd tgt)))))
       pure lhs
 
   invertMono (Linear (VPar (InEnd e))) = pure (NamedPort e "numval")
@@ -620,8 +627,8 @@ invertNatVal (NumValue up gro) = case up of
     (_, [(llufTgt,_)], [(llufSrc,_)], _) <- next "luff" (Prim ("BRAT","lluf")) (S0, Some (Zy :* S0)) (REx ("n", Nat) R0) (REx ("n", Nat) R0)
     tgt <- invertSM sm
     req $ Wire (end llufSrc, TNat, end tgt)
-    defineTgt tgt (VNum (nVar (VPar (toEnd llufSrc))))
-    defineTgt llufTgt (VNum (nFull (nVar (VPar (toEnd tgt)))))
+    defineTgt' "Helpers"tgt (VNum (nVar (VPar (toEnd llufSrc))))
+    defineTgt' "Helpers"llufTgt (VNum (nFull (nVar (VPar (toEnd tgt)))))
     pure llufTgt
 
 -- This will update the `hopes`, potentially invalidating things that have
@@ -630,7 +637,7 @@ invertNatVal (NumValue up gro) = case up of
 solveHopeVal :: TypeKind -> InPort -> Val Z -> Checking ()
 solveHopeVal k hope v = case doesntOccur (InEnd hope) v of
   Right () -> do
-    defineEnd (InEnd hope) v
+    defineEnd "solveHopeVal" (InEnd hope) v
     dangling <- case (k, v) of
       (Nat, VNum v) -> buildNatVal v
       (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 59e57782..5566d574 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -79,7 +79,7 @@ mkFork :: String -> Free sig () -> Free sig ()
 mkFork d par = thTrace ("Forking " ++ d) $ Fork d par $ pure ()
 
 mkYield :: String -> S.Set End -> Free sig ()
-mkYield desc es = thTrace ("Yielding in " ++ desc) $ Yield (AwaitingAny es) (\_ -> Ret ())
+mkYield desc es = thTrace ("Yielding in " ++ desc ++ "\n  " ++ show es) $ Yield (AwaitingAny es) (\_ -> Ret ())
 
 -- Commands for synchronous operations
 data CheckingSig ty where
@@ -121,7 +121,7 @@ wrapper _ (Ret v) = Ret v
 wrapper f (Req s k) = f s >>= \case
   Just v -> wrapper f (k v)
   Nothing -> Req s (wrapper f . k)
-wrapper f (Define v e k) = Define v e (wrapper f . k)
+wrapper f (Define lbl v e k) = Define lbl v e (wrapper f . k)
 wrapper f (Yield st k) = Yield st (wrapper f . k)
 wrapper f (Fork d par c) = Fork d (wrapper f par) (wrapper f c)
 
@@ -232,7 +232,7 @@ localKVar env (Req KDone k) = case [ x | (x,(One,_)) <- M.assocs env ] of
                                               ,"haven't been used"
                                               ]
 localKVar env (Req r k) = Req r (localKVar env . k)
-localKVar env (Define e v k) = Define e v (localKVar env . k)
+localKVar env (Define lbl e v k) = Define lbl e v (localKVar env . k)
 localKVar env (Yield st k) = Yield st (localKVar env . k)
 localKVar env (Fork desc par c) =
   -- can't send end both ways, so until we can join (TODO), restrict Forks to local scope
@@ -247,7 +247,7 @@ catchErr :: Free CheckingSig a -> Free CheckingSig (Either Error a)
 catchErr (Ret t) = Ret (Right t)
 catchErr (Req (Throw e) _) = pure $ Left e
 catchErr (Req r k) = Req r (catchErr . k)
-catchErr (Define e v k) = Define e v (catchErr . k)
+catchErr (Define lbl e v k) = Define lbl e v (catchErr . k)
 catchErr (Yield st k) = Yield st (catchErr . k)
 catchErr (Fork desc par c) = thTrace ("Spawning(catch) " ++ desc) $ catchErr $ par *> c
 
@@ -313,8 +313,8 @@ handler (Req s k) ctx g
       AddCapture n (var, ends) ->
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g
 
-handler (Define end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
-  case track ("Define " ++ show end ++ " = " ++ show v) $ M.lookup end vm of
+handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
+  case track ("Define( " ++ lbl ++ ")" ++ show end ++ " = " ++ show v) $ M.lookup end vm of
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
       Nothing -> case M.lookup end tm of
         Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
@@ -387,10 +387,10 @@ localNS ns (Req (Fresh str) k) = let (name, root) = fresh str ns in
 localNS ns (Req (SplitNS str) k) = let (subSpace, newRoot) = split str ns in
                                       localNS newRoot (k subSpace)
 localNS ns (Req c k) = Req c (localNS ns . k)
-localNS ns (Define e v k) = Define e v (localNS ns . k)
+localNS ns (Define lbl e v k) = Define lbl e v (localNS ns . k)
 localNS ns (Yield st k) = Yield st (localNS ns . k)
 localNS ns (Fork desc par c) = let (subSpace, newRoot) = split desc ns in
                                  Fork desc (localNS subSpace par) (localNS newRoot c)
 
-defineEnd :: End -> Val Z -> Checking ()
-defineEnd e v = Define e v (const (Ret ()))
+defineEnd :: String -> End -> Val Z -> Checking ()
+defineEnd lbl e v = Define lbl e v (const (Ret ()))
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index d9868ded..81d54dcc 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -23,6 +23,8 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
+import Debug.Trace
+
 -- Demand that two closed values are equal, we're allowed to solve variables in the
 -- hope set to make this true.
 -- Raises a user error if the vals cannot be made equal.
@@ -45,6 +47,10 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
   hopes <- req AskHopes
   exp <- sem sems exp
   act <- sem sems act
+  qexp <- (quote Zy exp)
+  qact <- (quote Zy act)
+  traceM ("typeEq' exp: " ++ show qexp)
+  traceM ("typeEq' act: " ++ show qact)
   typeEqEta str stuff hopes k exp act
 
 -- Presumes that the hope set and the two `Sem`s are up to date.
@@ -69,8 +75,7 @@ typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
   | M.member e hopes = solveHopeSem k e act
 typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
   | M.member e hopes = solveHopeSem k e exp
-typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = do
-  unifyNum (quoteNum Zy exp) (quoteNum Zy act)
+typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = unifyNum (quoteNum Zy exp) (quoteNum Zy act)
 -- 2. harder cases, neither is in the hope set, so we can't define it ourselves
 typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
   exp <- quote ny exp
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 70b4be87..a0c991a4 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -11,7 +11,7 @@ import Brat.Graph (NodeType(..))
 import Hasochism
 import Control.Monad.Freer
 
--- import Debug.Trace
+import Debug.Trace
 import qualified Data.Map as M
 
 -- trail = trace
@@ -60,13 +60,13 @@ solveNumMeta e nv = case (e, vars nv) of
 
 unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum nv0 nv1 = do
-  -- traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
+  traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
   unifyNum' (quoteNum Zy nv0) (quoteNum Zy nv1)
-  -- nv0 <- numEval S0 (quoteNum Zy nv0)
-  -- nv1 <- numEval S0 (quoteNum Zy nv1)
-  -- traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1))
+  nv0 <- numEval S0 (quoteNum Zy nv0)
+  nv1 <- numEval S0 (quoteNum Zy nv1)
+  traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1))
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
@@ -93,16 +93,17 @@ unifyNum' (NumValue lup lgro) (NumValue rup rgro)
       (VPar (ExEnd e), v@(VPar (ExEnd _))) -> defineSrc (NamedPort e "") (VNum (nVar v))
       (VPar (InEnd e), v@(VPar (ExEnd dangling))) -> do
         req (Wire (dangling, TNat, e))
-        defineTgt (NamedPort e "") (VNum (nVar v))
+        hs <- req AskHopes
+        defineTgt' ("flex-flex In Ex " ++ show (M.member e hs)) (NamedPort e "") (VNum (nVar v))
       (v@(VPar (InEnd e)), v'@(VPar (InEnd e'))) -> do
         hs <- req AskHopes
         case (M.lookup e hs, M.lookup e' hs) of
-          (Nothing, Just _) -> defineTgt (NamedPort e' "") (VNum (nVar v))
-          (Just _, Nothing) -> defineTgt (NamedPort e "") (VNum (nVar v'))
+          (Nothing, Just _) -> defineTgt' "flex-flex In In0"(NamedPort e' "") (VNum (nVar v))
+          (Just _, Nothing) -> defineTgt' "flex-flex In In1"(NamedPort e "") (VNum (nVar v'))
           (Nothing, Nothing) -> error "Two non-hopes in unifyNum"
           (Just hd, Just hd') -> if hopeDynamic hd
-                                 then defineTgt (NamedPort e' "") (VNum (nVar v))
-                                 else defineTgt (NamedPort e "") (VNum (nVar v'))
+                                 then defineTgt' "flex-flex In In2"(NamedPort e' "") (VNum (nVar v))
+                                 else defineTgt' "flex-flex In In3"(NamedPort e "") (VNum (nVar v'))
 
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index bc982e66..af2b0238 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -326,7 +326,7 @@ doesntOccur e (VFun my (ins :->> outs)) = case my of
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)
-  defineEnd e val
+  defineEnd "instantiateMeta" e val
 
 collision :: End -> End -> Either ErrorMsg ()
 collision e v | e == v = Left . UnificationError $
diff --git a/brat/Control/Monad/Freer.hs b/brat/Control/Monad/Freer.hs
index 8df5cd90..ed8b7455 100644
--- a/brat/Control/Monad/Freer.hs
+++ b/brat/Control/Monad/Freer.hs
@@ -43,14 +43,14 @@ instance Monoid Stuck where
 data Free (sig :: Type -> Type) (v :: Type) where
   Ret :: v -> Free sig v
   Req ::  sig t -> (t -> Free sig v) -> Free sig v
-  Define :: End -> Val Z -> (News -> Free sig v) -> Free sig v
+  Define :: String -> End -> Val Z -> (News -> Free sig v) -> Free sig v
   Yield :: Stuck -> (News -> Free sig v) -> Free sig v
   Fork :: String -> Free sig () -> Free sig v -> Free sig v
 
 instance Functor (Free sig) where
   fmap f (Ret v) = Ret (f v)
   fmap f (Req sig k) = Req sig (fmap f . k)
-  fmap f (Define e v k) = Define e v (fmap f . k)
+  fmap f (Define lbl e v k) = Define lbl e v (fmap f . k)
   fmap f (Yield st k) = Yield st (fmap f . k)
   fmap f (Fork d par c) = Fork d par (fmap f c)
 
@@ -67,7 +67,7 @@ instance NewsWatcher (News -> t) where
 instance NewsWatcher (Free sig v) where
   Ret v /// _ = Ret v
   Req sig k /// n = Req sig $ \v -> k v /// n
-  Define e v k /// n = Define e v (k /// n)
+  Define lbl e v k /// n = Define lbl e v (k /// n)
   Yield st k /// n = Yield (st /// n) (k /// n)
   Fork d par c /// n = Fork d (par /// n) (c /// n)
 
@@ -86,19 +86,19 @@ instance Applicative (Free sig) where
   -- Make progress on the left
   Ret f <*> ma = fmap f ma
   Req sig k <*> ma = Req sig ((<*> ma) . k)
-  Define e v k1 <*> ma = Define e v $ \n -> (k1 n) <*> (ma /// n)
+  Define lbl e v k1 <*> ma = Define lbl e v $ \n -> (k1 n) <*> (ma /// n)
 
   -- What happens when Yield is on the left
   y <*> Ret v = fmap ($ v) y
   y <*> Req sig k = Req sig $ \v -> y <*> k v
   y1@(Yield st1 _) <*> y2@(Yield st2 _) = Yield (st1 <> st2) $
     \n -> (y1 /// n) <*> (y2 /// n)
-  y <*> Define e v k = Define e v $ \n -> (y /// n) <*> k n
+  y <*> Define lbl e v k = Define lbl e v $ \n -> (y /// n) <*> k n
 
 instance Monad (Free sig) where
   Ret v >>= k = k v
   Req r j >>= k = Req r (j >=> k)
-  Define e v k1 >>= k2 = Define e v (k1 >=> k2)
+  Define lbl e v k1 >>= k2 = Define lbl e v (k1 >=> k2)
   Yield st k1 >>= k2 = Yield st (k1 >=> k2)
   --- equivalent to
   -- Yield st k1 >>= k2 = Yield st (\n -> (k1 n) >>= k2)

From d95c95fa98ec1a93978ff9fdf0e8a9cad4c23720 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Tue, 8 Apr 2025 10:41:57 +0100
Subject: [PATCH 115/182] [ minor progress ] typeEqs forks

---
 brat/Brat/Checker/SolveHoles.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 81d54dcc..1a492356 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -95,7 +95,9 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
 
 typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
 typeEqs _ _ [] [] [] = pure ()
-typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = typeEqs tm stuff ks exps acts <* typeEq' tm stuff k exp act
+typeEqs tm stuff (k:ks) (exp:exps) (act:acts) = do
+  mkFork "typeEqsTail" $ typeEqs tm stuff ks exps acts
+  typeEq' tm stuff k exp act
 typeEqs _ _ _ _ _ = typeErr "arity mismatch"
 
 typeEqRow :: Modey m

From 575fa2e7e9364a10b2c7166097147f3dbe960ae1 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 8 Apr 2025 12:01:23 +0100
Subject: [PATCH 116/182] Drop needless call to abstractAll (transitively
 valMatch)

---
 brat/Brat/Checker.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 33467d5d..44bde358 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -746,10 +746,17 @@ checkClause my fnName cty clause = modily my $ do
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
     let abstractor = foldr ((:||:) . APat . Bind) AEmpty vars
     let ?my = my in do
-      env <- abstractAll rhsOvers abstractor
+      env <- mkEnv vars rhsOvers
       localEnv env $ check @m (rhs clause) ((), rhsUnders)
   let NamedPort {end=Ex rhsNode _} = boxPort
   pure (match, rhsNode)
+ where
+  mkEnv :: (?my :: Modey m) => [String] -> [(Src, BinderType m)] -> Checking (Env (EnvData m))
+  mkEnv (x:xs) (src:srcs) = do
+    e1 <- singletonEnv x src
+    e2 <- mkEnv xs srcs
+    mergeEnvs [e1, e2]
+  mkEnv [] [] = pure emptyEnv
 
 -- Top level function for type checking function definitions
 -- Will make a top-level box for the function, then type check the definition

From 6cbd6f302077cebd4e501c47a30a6d125e75a19d Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 8 Apr 2025 12:03:12 +0100
Subject: [PATCH 117/182] Add debug labels to test file

---
 brat/test/Main.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 8bf0e362..2c67e0cb 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -34,7 +34,7 @@ coroT1 = do
   req $ Declare e Braty (Left $ Star []) Definable
   mkFork "t1" (req (ELup e) >>= \case
           Just _ -> err $ InternalError "already defined"
-          Nothing -> defineEnd e (VCon (PrefixName [] "nil") [])
+          Nothing -> defineEnd "test" e (VCon (PrefixName [] "nil") [])
       )
   mkYield "coroT1" (S.singleton e) >> pure ()
   traceM "Yield continued"
@@ -52,7 +52,7 @@ coroT2 = do
     mkYield "coroT2" (S.singleton e)
     req $ ELup e
   -- No way to execute this without a 'v'
-  mkFork "t2" $ defineEnd e (VCon (PrefixName [] "nil") [])
+  mkFork "t2" $ defineEnd "test" e (VCon (PrefixName [] "nil") [])
   err $ InternalError $ case v of
     Nothing -> "ELup performed without waiting for Yield" -- true in next case too
     Just _ -> "ELup returned value before being Defined"
@@ -82,4 +82,4 @@ main = do
                                 ,compilationTests
                                 ,typeArithTests
                                 ,coroTests
-                                ]
\ No newline at end of file
+                                ]

From 4eaf26ce35849f44562dd9c8224a19e45994b121 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 8 Apr 2025 17:23:34 +0100
Subject: [PATCH 118/182] Start dealing in the ownership of unsolved Ends

---
 brat/Brat/Checker.hs              | 30 ++++++++++++++-------
 brat/Brat/Checker/Helpers.hs      | 44 ++++++++++++++++++-------------
 brat/Brat/Checker/Monad.hs        | 35 ++++++++++++++++--------
 brat/Brat/Checker/SolveHoles.hs   | 38 +++++++++++++-------------
 brat/Brat/Checker/SolveNumbers.hs | 43 ++++++++++++++----------------
 brat/Brat/Compile/Hugr.hs         |  1 +
 brat/Brat/Naming.hs               |  2 +-
 brat/Brat/Syntax/Port.hs          |  4 +++
 brat/Brat/Syntax/Value.hs         | 11 ++++++++
 9 files changed, 126 insertions(+), 82 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 44bde358..69d5ac16 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -121,19 +121,25 @@ checkWire :: Modey m
           -> (Tgt, BinderType m)
           -> Checking ()
 checkWire Braty _ outputs (dangling, Left ok) (hungry, Left uk) = do
+  prefix <- whoAmI
+  traceM ("Who am I: checkWire: " ++ show prefix)
   throwLeft $ if outputs
     then kindEq ok uk
     else kindEq uk ok
   defineTgt' "checkWire" hungry (endVal ok (ExEnd (end dangling)))
   wire (dangling, kindType ok, hungry)
-checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ do
+checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ "$checkWire" -! do
+  prefix <- whoAmI
+  traceM ("Who am I: checkWire: " ++ show prefix)
   let ot = binderToValue Braty o
   let ut = binderToValue Braty u
   if outputs
     then typeEq (show tm) (Star []) ot ut
     else typeEq (show tm) (Star []) ut ot
   wire (dangling, ot, hungry)
-checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ do
+checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ "checkWire" -! do
+  prefix <- whoAmI
+  traceM ("Who am I: checkWire: " ++ show prefix)
   if outputs
     then typeEq (show tm) (Dollar []) ot ut
     else typeEq (show tm) (Dollar []) ut ot
@@ -484,10 +490,10 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     let m = deModey my -- TODO: remember what this is
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
-    (varz, patVals) <- valPats2Val ks pats
+    (varz, patVals) <- "$vp2v" -! valPats2Val ks pats
     traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
-    typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
+    "$unifyTypeArgs" -! typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
     ty <- eval S0 ty
     traceM $ "Made it past unification for ty =  " ++ show ty
     Some (ny :* env) <- pure $ bwdStack varz
@@ -583,7 +589,7 @@ check' FanIn (overs, (tgt, ty):unders) = do
     wire (dangling, binderToValue my ty, tgt)
     pure (Just overs)
   faninNodes _ _ _ _ [] = pure Nothing
-  faninNodes my n (hungry, ty) elTy ((over, overTy):overs) = do
+  faninNodes my n (hungry, ty) elTy ((over, overTy):overs) = "$fanin" -! do
     let k = case my of
           Kerny -> Dollar []
           Braty -> Star []
@@ -691,10 +697,14 @@ check' (Of n e) ((), unders) = case ?my of
       (elems, unders, rightUnders) <- getVecs len unders
       pure ((tgt, el):elems, (tgt, ty):unders, rightUnders)
   getVecs _ unders = pure ([], [], unders)
-check' Hope ((), (NamedPort hope _, ty):unders) = case (?my, ty) of
-  (Braty, Left _k) -> do
+check' Hope ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
+  (Braty, Left k) -> do
+    (_, [(hungry, _)], [(dangling, _)], _) <- anext "$!" Id (S0, Some (Zy :* S0))
+                                              (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
-    req (ANewHope hope (HopeData (Just fc) True))
+    req (ANewHope (end hungry) fc)
+    wire (dangling, kindType k, NamedPort bang "")
+    defineTgt tgt (endVal k (toEnd hungry))
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
@@ -731,7 +741,7 @@ checkClause my fnName cty clause = modily my $ do
                      \(overs, unders) -> do
     -- Make a problem to solve based on the lhs and the overs
     problem <- argProblems (fst <$> overs) (unWC $ lhs clause) []
-    (tests, sol) <- localFC (fcOf (lhs clause)) $ solve my problem
+    (tests, sol) <- localFC (fcOf (lhs clause)) $ "$lhs" -! solve my problem
     -- The solution gives us the variables bound by the patterns.
     -- We turn them into a row
     mkArgRo my S0 ((\(n, (src, ty)) -> (NamedPort (toEnd src) n, ty)) <$> sol) >>= \case
@@ -747,7 +757,7 @@ checkClause my fnName cty clause = modily my $ do
     let abstractor = foldr ((:||:) . APat . Bind) AEmpty vars
     let ?my = my in do
       env <- mkEnv vars rhsOvers
-      localEnv env $ check @m (rhs clause) ((), rhsUnders)
+      localEnv env $ "$rhs" -! check @m (rhs clause) ((), rhsUnders)
   let NamedPort {end=Ex rhsNode _} = boxPort
   pure (match, rhsNode)
  where
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index de0dd027..42f97087 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -8,11 +8,11 @@ import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType, quote, doesntOccur)
 import Brat.FC (FC)
 import Brat.Graph (Node(..), NodeType(..))
-import Brat.Naming (Name)
+import Brat.Naming (FreshMonad(..), Name(..))
 import Brat.Syntax.Common
 import Brat.Syntax.Core (Term(..))
 import Brat.Syntax.Simple
-import Brat.Syntax.Port (ToEnd(..))
+import Brat.Syntax.Port (ToEnd(..), endName)
 import Brat.Syntax.Value
 import Bwd
 import Hasochism
@@ -34,11 +34,8 @@ import Debug.Trace
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
   (Braty, VApp (VPar e) _) -> do
-    hopes <- req AskHopes
-    let isHope = case e of
-                   InEnd i -> M.member i hopes
-                   ExEnd _ -> False
-    if isHope then
+    mine <- mineToSolve
+    if mine e then
       case tm of
         Float _ -> defineEnd "simpleCheck" e TFloat
         Text _ -> defineEnd "simpleCheck" e TText
@@ -350,6 +347,7 @@ valueToBinder Kerny = id
 defineSrc :: Src -> Val Z -> Checking ()
 defineSrc src = defineEnd "" (ExEnd (end src))
 
+-- TODO: Do the work of checking if there's a dynamic hope here
 defineTgt :: Tgt -> Val Z -> Checking ()
 defineTgt tgt = defineEnd "" (InEnd (end tgt))
 
@@ -513,20 +511,12 @@ buildHalve = do
   defineTgt' "Helpers"lhs (VNum (n2PowTimes 1 (nVar (VPar (toEnd out)))))
   pure (lhs, out)
 
-replaceHope :: InPort -> InPort -> Checking ()
-replaceHope old new = do
-  hs <- req AskHopes
-  case M.lookup old hs of
-    Nothing -> pure ()
-    Just hd -> req (ANewHope new (HopeData Nothing (hopeDynamic hd)))
-
 -- Return an End with the same polarity whose value is half that of the input End
 makeHalf :: End -> Checking End
 makeHalf (InEnd e) = do
   (doubIn, doubOut) <- buildDoub
   req (Wire (end doubOut, TNat, e))
   defineTgt' "Helpers"(NamedPort e "") (VNum (nVar (VPar (toEnd doubOut))))
-  replaceHope e (end doubIn)
   pure (InEnd (end doubIn))
 makeHalf (ExEnd e) = do
   (halveIn, halveOut) <- buildHalve
@@ -539,7 +529,6 @@ makePred (InEnd e) = do
   (succIn, succOut) <- buildAdd 1
   req (Wire (end succOut, TNat, e))
   defineTgt' "Helpers"(NamedPort e "") (VNum (nVar (VPar (toEnd succOut))))
-  replaceHope e (end succIn)
   pure (toEnd succIn)
 makePred (ExEnd e) = do
   (predIn, predOut) <- buildSub 1
@@ -664,7 +653,6 @@ valPat2Val :: TypeKind
 valPat2Val k VPVar = do
   (_, [(idTgt, _)], [_], _) <- anext "pat2val" Id (S0, Some (Zy :* S0)) (REx ("", k) R0) (REx ("", k) R0)
   let val = VApp (VPar (toEnd idTgt)) B0
-  req (ANewHope (end idTgt) (HopeData Nothing False))
   pure (B0 :< val, val)
 valPat2Val (TypeFor m _) (VPCon con args) = do
   ks <- fmap snd <$> tlup (m, con)
@@ -679,7 +667,6 @@ valPat2Val Nat (VPNum n) = numPat2Val n >>= \(stk, nv) -> pure (stk, VNum nv)
   numPat2Val (NP2Times np) = second (n2PowTimes 1) <$> numPat2Val np
   numPat2Val NPVar = do
     (_, [(idTgt, _)], [_], _) <- anext "numpat2val" Id (S0, Some (Zy :* S0)) (REx ("", Nat) R0) (REx ("", Nat) R0)
-    req (ANewHope (end idTgt) (HopeData Nothing False))
     let var = endVal Nat (toEnd idTgt)
     pure (B0 :< var, nVar (VPar (toEnd idTgt)))
 
@@ -703,3 +690,24 @@ traceChecking lbl m a = do
   pure b
 
 -- traceChecking = const id
+
+allowedToSolve :: Bwd (String, Int) -> End -> Bool
+allowedToSolve prefix e =
+  let whoAreWe = lastDollar prefix
+      MkName ePrefix = endName e
+      whoCanSolve = lastDollar (B0 <>< ePrefix)
+  in  case (e, whoAreWe, whoCanSolve) of
+        -- Solving a hope
+        -- TODO: Check that the ! is in the same region of code as we are!
+        -- (by checking we have a common prefix before the $rhs)
+        (InEnd _, _, Just "!") -> True
+        -- We can only solve dangling wires when doing pattern matching in `solve`
+        (ExEnd _, Just "lhs", _) -> True
+        _ -> False
+ where
+  lastDollar B0 = Nothing
+  lastDollar (zx :< ('$':str, _)) = Just str
+  lastDollar (zx :< x) = lastDollar zx
+
+mineToSolve :: Checking (End -> Bool)
+mineToSolve = allowedToSolve <$> whoAmI
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 5566d574..bead3111 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -1,5 +1,6 @@
 module Brat.Checker.Monad where
 
+import Bwd
 import Brat.Checker.Quantity (Quantity(..))
 import Brat.Checker.Types hiding (HoleData(..))
 import Brat.Constructors (ConstructorMap, CtorArgs)
@@ -71,7 +72,10 @@ data Context = Ctx { globalVEnv :: VEnv
                    , kconstructors :: ConstructorMap Kernel
                    , typeConstructors :: M.Map (Mode, QualName) [(PortName, TypeKind)]
                    , aliasTable :: M.Map QualName Alias
+                   -- On the chopping block
                    , hopes :: Hopes
+                   -- Ends which need to be solved because they affect runtime behaviour
+                   , dynamicSet :: M.Map End FC
                    , captureSets :: CaptureSets
                    }
 
@@ -85,6 +89,7 @@ mkYield desc es = thTrace ("Yielding in " ++ desc ++ "\n  " ++ show es) $ Yield
 data CheckingSig ty where
   Fresh   :: String -> CheckingSig Name
   SplitNS :: String -> CheckingSig Namespace
+  AskNS   :: CheckingSig (Bwd (String, Int))
   Throw   :: Error  -> CheckingSig a
   LogHole :: TypedHole -> CheckingSig ()
   AskFC   :: CheckingSig FC
@@ -112,8 +117,8 @@ data CheckingSig ty where
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> IsSkolem -> CheckingSig ()
-  ANewHope :: InPort -> HopeData -> CheckingSig ()
-  AskHopes :: CheckingSig Hopes
+  ANewDynamic :: End -> FC -> CheckingSig ()
+  AskDynamics :: CheckingSig (M.Map End FC)
   AddCapture :: Name -> (QualName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 wrapper :: (forall a. CheckingSig a -> Checking (Maybe a)) -> Checking v -> Checking v
@@ -260,6 +265,7 @@ handler (Req s k) ctx g
   = case s of
       Fresh _ -> error "Fresh in handler, should only happen under `-!`"
       SplitNS _ -> error "SplitNS in handler, should only happen under `-!`"
+      AskNS -> error "AskNS in handler, should only happen under `-!`"
       Throw err -> Left err
       LogHole hole -> do (v,ctx,(holes,g)) <- handler (k ()) ctx g
                          return (v,ctx,(hole:holes,g))
@@ -306,9 +312,9 @@ handler (Req s k) ctx g
                 M.lookup tycon tbl
         handler (k args) ctx g
 
-      ANewHope e hd -> handler (k ()) (ctx { hopes = M.insert e hd (hopes ctx) }) g
+      ANewDynamic e fc -> handler (k ()) (ctx { dynamicSet = M.insert e fc (dynamicSet ctx) }) g
 
-      AskHopes -> handler (k (hopes ctx)) ctx g
+      AskDynamics -> handler (k (dynamicSet ctx)) ctx g
 
       AddCapture n (var, ends) ->
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g
@@ -326,13 +332,18 @@ handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = sto
         -- (b) Numbers are tricky, whether they are stuck or not depends upon the question
         -- (c) since there are no infinite end-creating loops, it's correct (merely inefficient)
         -- to just "have another go".
-        Just _ -> let news = News (M.singleton end Unstuck) in
-          handler (k news)
-            (ctx { store = st { valueMap = M.insert end v vm },
-                hopes = case end of
-                  InEnd e -> M.delete e (hopes ctx)
-                  ExEnd _ -> hopes ctx
-            }) g
+        Just _ -> let news = News (M.singleton end Unstuck)
+                      newDynamics = case v of
+                        VNum nv -> numVars nv
+                        _ -> []
+                  in handler (k news)
+                     (ctx { store = st { valueMap = M.insert end v vm },
+                                    dynamicSet = case M.lookup end (dynamicSet ctx) of
+                                      Just fc -> M.union
+                                                 (M.fromList (zip newDynamics (repeat fc)))
+                                                 (M.delete end (dynamicSet ctx))
+                                      Nothing -> dynamicSet ctx
+                          }) g
 handler (Yield Unstuck k) ctx g = handler (k mempty) ctx g
 handler (Yield (AwaitingAny ends) _k) ctx _ = Left $ dumbErr $ TypeErr $ unlines $
   ("Typechecking blocked on:":(show <$> S.toList ends))
@@ -359,6 +370,7 @@ typeErr = err . TypeErr
 instance FreshMonad Checking where
   freshName x = req $ Fresh x
   str -! c = inLvl str c
+  whoAmI = req AskNS
 
 -- This way we get file contexts when pattern matching fails
 instance MonadFail Checking where
@@ -386,6 +398,7 @@ localNS ns (Req (Fresh str) k) = let (name, root) = fresh str ns in
   localNS root (k name)
 localNS ns (Req (SplitNS str) k) = let (subSpace, newRoot) = split str ns in
                                       localNS newRoot (k subSpace)
+localNS ns (Req AskNS k) = localNS ns (k (fst ns))
 localNS ns (Req c k) = Req c (localNS ns . k)
 localNS ns (Define lbl e v k) = Define lbl e v (localNS ns . k)
 localNS ns (Yield st k) = Yield st (localNS ns . k)
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 1a492356..2af64bb4 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -6,6 +6,7 @@ import Brat.Checker.SolveNumbers
 import Brat.Checker.Types (kindForMode, IsSkolem(..))
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
+import Brat.Naming (FreshMonad(..))
 import Brat.Syntax.Common
 -- import Brat.Syntax.Simple (SimpleTerm(..))
 import Brat.Syntax.Value
@@ -33,7 +34,10 @@ typeEq :: String -- String representation of the term for error reporting
        -> Val Z -- Expected
        -> Val Z -- Actual
        -> Checking ()
-typeEq str = typeEq' str (Zy :* S0 :* S0)
+typeEq str k exp act = do
+  prefix <- whoAmI
+  traceM ("typeEq: Who am I: " ++ show prefix)
+  typeEq' str (Zy :* S0 :* S0) k exp act
 
 
 -- Internal version of typeEq with environment for non-closed values
@@ -44,50 +48,46 @@ typeEq' :: String -- String representation of the term for error reporting
         -> Val n -- Actual
         -> Checking ()
 typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
-  hopes <- req AskHopes
+  mine <- mineToSolve
   exp <- sem sems exp
   act <- sem sems act
   qexp <- (quote Zy exp)
   qact <- (quote Zy act)
   traceM ("typeEq' exp: " ++ show qexp)
   traceM ("typeEq' act: " ++ show qact)
-  typeEqEta str stuff hopes k exp act
+  typeEqEta str stuff mine k exp act
 
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-          -> Hopes -- A map from the hope set to corresponding FCs
+          -> (End -> Bool) -- Tells us if we can solve a given End
           -> TypeKind -- The kind we're comparing at
           -> Sem -- Expected
           -> Sem -- Actual
           -> Checking ()
-typeEqEta tm (lvy :* kz :* sems) hopes (TypeFor m ((_, k):ks)) exp act = do
+typeEqEta tm (lvy :* kz :* sems) mine (TypeFor m ((_, k):ks)) exp act = do
   -- Higher kinded things
   let nextSem = semLvl lvy
   let xz = B0 :< nextSem
   exp <- applySem exp xz
   act <- applySem act xz
-  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) hopes (TypeFor m ks) exp act
+  typeEqEta tm (Sy lvy :* (kz :<< k) :* (sems :<< nextSem)) mine (TypeFor m ks) exp act
 -- Not higher kinded - check for flex terms
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- 1. "easy" flex cases
-typeEqEta _tm (Zy :* _ks :* _sems) hopes k (SApp (SPar (InEnd e)) B0) act
-  | M.member e hopes = solveHopeSem k e act
-typeEqEta _tm (Zy :* _ks :* _sems) hopes k exp (SApp (SPar (InEnd e)) B0)
-  | M.member e hopes = solveHopeSem k e exp
-typeEqEta _ (Zy :* _ :* _) _ {-hopes-} Nat (SNum exp) (SNum act) = unifyNum (quoteNum Zy exp) (quoteNum Zy act)
+typeEqEta _tm (Zy :* _ks :* _sems) mine k (SApp (SPar e) B0) act
+  | mine e = solveHopeSem k e act
+typeEqEta _tm (Zy :* _ks :* _sems) mine k exp (SApp (SPar e) B0)
+  | mine e = solveHopeSem k e exp
+typeEqEta _ (Zy :* _ :* _) mine Nat (SNum exp) (SNum act) = unifyNum mine (quoteNum Zy exp) (quoteNum Zy act)
 -- 2. harder cases, neither is in the hope set, so we can't define it ourselves
-typeEqEta tm stuff@(ny :* _ks :* _sems) hopes k exp act = do
+typeEqEta tm stuff@(ny :* _ks :* _sems) _ k exp act = do
   exp <- quote ny exp
   act <- quote ny act
-  let ends = mapMaybe getEnd [exp,act]
-  -- sanity check: we've already dealt with either end being in the hopeset
-  when (or [M.member ie hopes | InEnd ie <- ends]) $ typeErr "ends were in hopeset"
-  filterM (isSkolem >=> pure . (== Definable)) ends >>= \case
+  unless (exp == act) $ case flexes act ++ flexes exp of
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
-    [e1, e2] | e1 == e2 -> pure () -- trivially same, even if both still yet-to-be-defined
-    es -> -- tricky: must wait for one or other to become more defined
-      mkYield "typeEqEta" (S.fromList es) >> typeEq' tm stuff k exp act
+    -- tricky: must wait for one or other to become more defined
+    es -> mkYield "typeEqEta" (S.fromList es) >> typeEq' tm stuff k exp act
  where
   getEnd (VApp (VPar e) _) = Just e
   getEnd (VNum n) = getNumVar n
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index a0c991a4..963d29c4 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -13,6 +13,7 @@ import Control.Monad.Freer
 
 import Debug.Trace
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 -- trail = trace
 
@@ -27,7 +28,7 @@ import qualified Data.Map as M
 -- We assume that the caller has done the occurs check and rules out trivial equations.
 solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
 -- solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
-solveNumMeta e nv = case (e, vars nv) of
+solveNumMeta e nv = case (e, numVars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [VPar (InEnd _tgt)]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
@@ -54,16 +55,13 @@ solveNumMeta e nv = case (e, vars nv) of
    src <- buildNatVal nv
    instantiateMeta (InEnd tgt) (VNum nv)
    wire (src, TNat, NamedPort tgt "")
- where
-  vars :: NumVal a -> [a]
-  vars = foldMap pure
 
-unifyNum :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
-unifyNum nv0 nv1 = do
+unifyNum :: (End -> Bool) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum mine nv0 nv1 = do
   traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
-  unifyNum' (quoteNum Zy nv0) (quoteNum Zy nv1)
+  unifyNum' mine (quoteNum Zy nv0) (quoteNum Zy nv1)
   nv0 <- numEval S0 (quoteNum Zy nv0)
   nv1 <- numEval S0 (quoteNum Zy nv1)
   traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1))
@@ -71,9 +69,9 @@ unifyNum nv0 nv1 = do
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
-unifyNum' :: NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum' :: (End -> Bool) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 -- unifyNum' a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
-unifyNum' (NumValue lup lgro) (NumValue rup rgro)
+unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -90,20 +88,19 @@ unifyNum' (NumValue lup lgro) (NumValue rup rgro)
     GT -> flexFlex v' v
     EQ -> pure ()
     LT -> case (v, v') of
-      (VPar (ExEnd e), v@(VPar (ExEnd _))) -> defineSrc (NamedPort e "") (VNum (nVar v))
-      (VPar (InEnd e), v@(VPar (ExEnd dangling))) -> do
-        req (Wire (dangling, TNat, e))
-        hs <- req AskHopes
-        defineTgt' ("flex-flex In Ex " ++ show (M.member e hs)) (NamedPort e "") (VNum (nVar v))
-      (v@(VPar (InEnd e)), v'@(VPar (InEnd e'))) -> do
-        hs <- req AskHopes
-        case (M.lookup e hs, M.lookup e' hs) of
-          (Nothing, Just _) -> defineTgt' "flex-flex In In0"(NamedPort e' "") (VNum (nVar v))
-          (Just _, Nothing) -> defineTgt' "flex-flex In In1"(NamedPort e "") (VNum (nVar v'))
-          (Nothing, Nothing) -> error "Two non-hopes in unifyNum"
-          (Just hd, Just hd') -> if hopeDynamic hd
-                                 then defineTgt' "flex-flex In In2"(NamedPort e' "") (VNum (nVar v))
-                                 else defineTgt' "flex-flex In In3"(NamedPort e "") (VNum (nVar v'))
+      (v@(VPar e@(ExEnd p)), v'@(VPar e'@(ExEnd p')))
+       | mine e -> defineSrc (NamedPort p "") (VNum (nVar v'))
+       | mine e' -> defineSrc (NamedPort p' "") (VNum (nVar v))
+       | otherwise -> typeErr $ "Can't force " ++ show v ++ " to be " ++ show v'
+      (VPar e@(InEnd p), v@(VPar (ExEnd dangling)))
+       | mine e -> do
+          req (Wire (dangling, TNat, p))
+          defineTgt' ("flex-flex In Ex") (NamedPort p "") (VNum (nVar v))
+       | otherwise -> mkYield "flexFlex" (S.singleton e) >> unifyNum mine (VNum (nVar v)) (VNum (nVar v'))
+      (v@(VPar e@(InEnd p)), v'@(VPar e'@(InEnd p')))
+       | mine e -> defineTgt' "flex-flex In In1" (NamedPort p "") (VNum (nVar v'))
+       | mine e' -> defineTgt' "flex-flex In In0"(NamedPort p' "") (VNum (nVar v))
+       | otherwise -> mkYield "flexFlex" (S.fromList [e, e']) >> unifyNum mine (VNum (nVar v)) (VNum (nVar v'))
 
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 0dd12114..8706ca5b 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -129,6 +129,7 @@ instance FreshMonad Compile where
     put (s { nameSupply = nsNew })
     pure v
 
+  whoAmI = gets (fst . nameSupply)
 
 runCheckingInCompile :: Free CheckingSig t -> Compile t
 runCheckingInCompile (Ret t) = pure t
diff --git a/brat/Brat/Naming.hs b/brat/Brat/Naming.hs
index b1719526..c5804fde 100644
--- a/brat/Brat/Naming.hs
+++ b/brat/Brat/Naming.hs
@@ -45,4 +45,4 @@ instance Show Name where
 class Monad m => FreshMonad m where
   freshName :: String -> m Name
   (-!) :: String -> m a -> m a
-
+  whoAmI :: m (Bwd (String, Int))
diff --git a/brat/Brat/Syntax/Port.hs b/brat/Brat/Syntax/Port.hs
index 5ce7c8d3..878e1f7f 100644
--- a/brat/Brat/Syntax/Port.hs
+++ b/brat/Brat/Syntax/Port.hs
@@ -48,3 +48,7 @@ data End = InEnd InPort | ExEnd OutPort
 instance Show End where
   show (InEnd e) = show e
   show (ExEnd e) = show e
+
+endName :: End -> Name
+endName (InEnd (In n _)) = n
+endName (ExEnd (Ex n _)) = n
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index fc70e0d4..7fbf4c12 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -621,3 +621,14 @@ stkLen (zx :<< _) = Sy (stkLen zx)
 numValIsConstant :: NumVal (VVar Z) -> Maybe Integer
 numValIsConstant (NumValue up Constant0) = pure up
 numValIsConstant _ = Nothing
+
+flexes :: Val n -> [End]
+flexes (VApp (VPar e) _) = [e]
+flexes (VNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar e)))))) = [e]
+flexes _ = []
+
+numVars :: NumVal (VVar Z) -> [End]
+numVars nv = [e | v@(VPar e) <- vvars nv]
+ where
+  vvars :: NumVal a -> [a]
+  vvars = foldMap pure

From 36067bf699b358783dfa904261a8afc15ef7ff69 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 9 Apr 2025 10:57:12 +0100
Subject: [PATCH 119/182] Still broken but now compiling

---
 brat/Brat/Checker.hs               | 19 +++++++++---------
 brat/Brat/Checker/Helpers.hs       | 32 ++++++++++++++++++------------
 brat/Brat/Checker/Monad.hs         | 16 +++++++--------
 brat/Brat/Checker/SolveHoles.hs    | 20 ++++++++++---------
 brat/Brat/Checker/SolveNumbers.hs  | 19 ++++++++++--------
 brat/Brat/Checker/SolvePatterns.hs | 10 +++++++---
 brat/brat.cabal                    |  2 +-
 7 files changed, 66 insertions(+), 52 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 69d5ac16..599f0ad9 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -122,7 +122,7 @@ checkWire :: Modey m
           -> Checking ()
 checkWire Braty _ outputs (dangling, Left ok) (hungry, Left uk) = do
   prefix <- whoAmI
-  traceM ("Who am I: checkWire: " ++ show prefix)
+  trackM ("Who am I: checkWire: " ++ show prefix)
   throwLeft $ if outputs
     then kindEq ok uk
     else kindEq uk ok
@@ -130,7 +130,7 @@ checkWire Braty _ outputs (dangling, Left ok) (hungry, Left uk) = do
   wire (dangling, kindType ok, hungry)
 checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ "$checkWire" -! do
   prefix <- whoAmI
-  traceM ("Who am I: checkWire: " ++ show prefix)
+  trackM ("Who am I: checkWire: " ++ show prefix)
   let ot = binderToValue Braty o
   let ut = binderToValue Braty u
   if outputs
@@ -139,7 +139,7 @@ checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ "$ch
   wire (dangling, ot, hungry)
 checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ "checkWire" -! do
   prefix <- whoAmI
-  traceM ("Who am I: checkWire: " ++ show prefix)
+  trackM ("Who am I: checkWire: " ++ show prefix)
   if outputs
     then typeEq (show tm) (Dollar []) ot ut
     else typeEq (show tm) (Dollar []) ut ot
@@ -179,7 +179,7 @@ checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m)
              -> [(Tgt, BinderType m)] -- Expected
              -> [(Src, BinderType m)] -- Actual
              -> Checking [(Tgt, BinderType m)]
-checkOutputs tm unders overs | trace ("checkOutputs\n  " ++ show unders ++ "\n  " ++ show overs) False = undefined
+checkOutputs tm unders overs | track ("checkOutputs\n  " ++ show unders ++ "\n  " ++ show overs) False = undefined
 checkOutputs tm unders overs = checkIO tm unders overs (flip $ checkWire ?my tm True) "No unders but overs: "
 
 check :: (CheckConstraints m k
@@ -491,11 +491,11 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
     (varz, patVals) <- "$vp2v" -! valPats2Val ks pats
-    traceM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
+    trackM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
     "$unifyTypeArgs" -! typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
     ty <- eval S0 ty
-    traceM $ "Made it past unification for ty =  " ++ show ty
+    trackM $ "Made it past unification for ty =  " ++ show ty
     Some (ny :* env) <- pure $ bwdStack varz
     -- Make sure env is the correct length for args
     Refl <- throwLeft $ natEqOrBust ny nFree
@@ -504,7 +504,6 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     -- in the kernel case the bottom and top of the row are the same
     let ty' = weaken topy ty
     env <- traverseStack (sem S0) env
-    -- traceM $ "Matchenv: " ++ show env
     (_, argUnders, [(dangling, _)], _) <- anext (show vcon) (Constructor vcon)
                                           (env, Some (Zy :* S0))
                                           argTypeRo (RPr ("value", ty') R0)
@@ -702,7 +701,6 @@ check' Hope ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
     (_, [(hungry, _)], [(dangling, _)], _) <- anext "$!" Id (S0, Some (Zy :* S0))
                                               (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
-    req (ANewHope (end hungry) fc)
     wire (dangling, kindType k, NamedPort bang "")
     defineTgt tgt (endVal k (toEnd hungry))
     pure (((), ()), ((), unders))
@@ -1189,6 +1187,7 @@ run ve initStore ns m = do
                 , typeConstructors = defaultTypeConstructors
                 , aliasTable = M.empty
                 , hopes = M.empty
+                , dynamicSet = M.empty
                 , captureSets = M.empty
                 }
   (a,ctx,(holes, graph)) <- handler (localNS ns m) ctx mempty
@@ -1196,11 +1195,11 @@ run ve initStore ns m = do
   -- If the `hopes` set has any remaining holes with kind Nat, we need to abort.
   -- Even though we didn't need them for typechecking problems, our runtime
   -- behaviour depends on the values of the holes, which we can't account for.
-  case M.toList $ M.filterWithKey (\e hd -> isNatKinded tyMap (InEnd e) && hopeDynamic hd) (hopes ctx) of
+  case M.toList $ M.filterWithKey (\e _ -> isNatKinded tyMap e) (dynamicSet ctx) of
     [] -> pure (a, (holes, store ctx, graph, captureSets ctx))
     -- Just use the FC of the first hole while we don't have the capacity to
     -- show multiple error locations
-    hs@((_,hd):_) -> Left $ Err (hopeFC hd) (RemainingNatHopes (show . fst <$> hs))
+    hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
  where
   isNatKinded tyMap e = case tyMap M.! e of
     (EndType Braty (Left Nat), _) -> True
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 42f97087..6998f063 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -31,6 +31,8 @@ import Prelude hiding (last)
 
 import Debug.Trace
 
+
+
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
   (Braty, VApp (VPar e) _) -> do
@@ -257,17 +259,15 @@ getThunks :: Modey m
                       ,Overs m UVerb
                       )
 getThunks _ [] = pure ([], [], [])
-getThunks Braty row@((src, Right ty):rest) = req AskHopes >>= \h -> eval S0 ty >>= \case
-  VApp (VPar e@(InEnd i)) _ | M.member i h -> mkYield "getThunks" (S.singleton e) >> getThunks Braty row
-  ty -> do
-    (src, ss :->> ts) <- vectorise Braty (src, ty)
-    (node, unders, overs, _) <- let ?my = Braty in
-                                  anext "Eval" (Eval (end src)) (S0, Some (Zy :* S0)) ss ts
-    (nodes, unders', overs') <- getThunks Braty rest
-    pure (node:nodes, unders <> unders', overs <> overs')
+getThunks Braty row@((src, Right ty):rest) = do
+  ty <- awaitTypeDefinition ty
+  (src, ss :->> ts) <- vectorise Braty (src, ty)
+  (node, unders, overs, _) <- let ?my = Braty in
+                                anext "Eval" (Eval (end src)) (S0, Some (Zy :* S0)) ss ts
+  (nodes, unders', overs') <- getThunks Braty rest
+  pure (node:nodes, unders <> unders', overs <> overs')
 getThunks Kerny ((src, Right ty):rest) = do
-  -- TODO we probably want to check against the HopeSet here too, good to refactor+common-up somehow
-  ty <- eval S0 ty
+  ty <- awaitTypeDefinition ty
   (src, ss :->> ts) <- vectorise Kerny (src,ty)
   (node, unders, overs, _) <- let ?my = Kerny in anext "Splice" (Splice (end src)) (S0, Some (Zy :* S0)) ss ts
   (nodes, unders', overs') <- getThunks Kerny rest
@@ -546,7 +546,7 @@ buildNatVal nv@(NumValue n gro) = case n of
     (inn, out) <- buildAdd n
     src <- buildGro gro
     req $ Wire (end src, TNat, end inn)
-    traceM $ "buildNatVal " ++ show inn
+    --traceM $ "buildNatVal " ++ show inn
     defineTgt' "Helpers"inn (VNum (nVar (VPar (toEnd src))))
     pure out
  where
@@ -684,9 +684,9 @@ valPats2Val _ _ = err $ InternalError "Type args didn't match expected - kindChe
 
 traceChecking :: (Show a, Show b) => String -> (a -> Checking b) -> (a -> Checking b)
 traceChecking lbl m a = do
-  traceM ("Enter " ++ lbl ++ ": " ++ show a)
+  --traceM ("Enter " ++ lbl ++ ": " ++ show a)
   b <- m a
-  traceM ("Exit  " ++ lbl ++ ": " ++ show b)
+  --traceM ("Exit  " ++ lbl ++ ": " ++ show b)
   pure b
 
 -- traceChecking = const id
@@ -711,3 +711,9 @@ allowedToSolve prefix e =
 
 mineToSolve :: Checking (End -> Bool)
 mineToSolve = allowedToSolve <$> whoAmI
+
+-- Don't call this on kinds
+awaitTypeDefinition :: Val Z -> Checking (Val Z)
+awaitTypeDefinition ty = eval S0 ty >>= \case
+  VApp (VPar e) _ -> mkYield "awaitTypeDefinition" (S.singleton e) >> awaitTypeDefinition ty
+  ty -> pure ty
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index bead3111..f472abe4 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -25,15 +25,15 @@ import qualified Data.Set as S
 import Debug.Trace
 
 -- Used for messages about thread forking / spawning
---thTrace = const id
-thTrace = trace
+thTrace = const id
+--thTrace = trace
 
 trackM :: Monad m => String -> m ()
---trackM = const (pure ())
-trackM = traceM
+trackM = const (pure ())
+--trackM = traceM
 
--- track = const id
-track = trace
+track = const id
+--track = trace
 trackShowId x = track (show x) x
 
 -- Data for using a type alias. E.g.
@@ -320,7 +320,7 @@ handler (Req s k) ctx g
         handler (k ()) ctx {captureSets=M.insertWith M.union n (M.singleton var ends) (captureSets ctx)} g
 
 handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = store ctx in
-  case track ("Define( " ++ lbl ++ ")" ++ show end ++ " = " ++ show v) $ M.lookup end vm of
+  case track ("Define(" ++ lbl ++ ")" ++ show end ++ " = " ++ show v) $ M.lookup end vm of
       Just _ -> Left $ dumbErr (InternalError $ "Redefining " ++ show end)
       Nothing -> case M.lookup end tm of
         Nothing -> Left $ dumbErr (InternalError $ "Defining un-Declared " ++ show end ++ " in \n" ++ show tm)
@@ -347,7 +347,7 @@ handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = sto
 handler (Yield Unstuck k) ctx g = handler (k mempty) ctx g
 handler (Yield (AwaitingAny ends) _k) ctx _ = Left $ dumbErr $ TypeErr $ unlines $
   ("Typechecking blocked on:":(show <$> S.toList ends))
-  ++ "":"Hopeset is":(show <$> M.keys (hopes ctx)) ++ ["Try writing more types! :-)"]
+  ++ "":"Dynamic set is":(show <$> M.keys (dynamicSet ctx)) ++ ["Try writing more types! :-)"]
 handler (Fork desc par c) ctx g = handler (thTrace ("Spawning " ++ desc) $ par *> c) ctx g
 
 type Checking = Free CheckingSig
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 2af64bb4..951d7dc4 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,6 +1,6 @@
 module Brat.Checker.SolveHoles (typeEq) where
 
-import Brat.Checker.Helpers (buildNatVal, buildConst, solveHopeSem)
+import Brat.Checker.Helpers (buildNatVal, buildConst, mineToSolve, solveHopeSem)
 import Brat.Checker.Monad
 import Brat.Checker.SolveNumbers
 import Brat.Checker.Types (kindForMode, IsSkolem(..))
@@ -15,7 +15,7 @@ import Bwd
 import Hasochism
 -- import Brat.Syntax.Port (toEnd)
 
-import Control.Monad (when, filterM, (>=>))
+import Control.Monad (unless, when, filterM, (>=>))
 import Data.Bifunctor (second)
 import Data.Foldable (sequenceA_)
 import Data.Functor
@@ -24,8 +24,6 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
-import Debug.Trace
-
 -- Demand that two closed values are equal, we're allowed to solve variables in the
 -- hope set to make this true.
 -- Raises a user error if the vals cannot be made equal.
@@ -36,7 +34,7 @@ typeEq :: String -- String representation of the term for error reporting
        -> Checking ()
 typeEq str k exp act = do
   prefix <- whoAmI
-  traceM ("typeEq: Who am I: " ++ show prefix)
+  trackM ("typeEq: Who am I: " ++ show prefix)
   typeEq' str (Zy :* S0 :* S0) k exp act
 
 
@@ -53,8 +51,8 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
   act <- sem sems act
   qexp <- (quote Zy exp)
   qact <- (quote Zy act)
-  traceM ("typeEq' exp: " ++ show qexp)
-  traceM ("typeEq' act: " ++ show qact)
+  trackM ("typeEq' exp: " ++ show qexp)
+  trackM ("typeEq' act: " ++ show qact)
   typeEqEta str stuff mine k exp act
 
 -- Presumes that the hope set and the two `Sem`s are up to date.
@@ -76,9 +74,13 @@ typeEqEta tm (lvy :* kz :* sems) mine (TypeFor m ((_, k):ks)) exp act = do
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- 1. "easy" flex cases
 typeEqEta _tm (Zy :* _ks :* _sems) mine k (SApp (SPar e) B0) act
-  | mine e = solveHopeSem k e act
+  | mine e = case e of
+    InEnd e -> solveHopeSem k e act
+    ExEnd _ -> quote Zy act >>= instantiateMeta e
 typeEqEta _tm (Zy :* _ks :* _sems) mine k exp (SApp (SPar e) B0)
-  | mine e = solveHopeSem k e exp
+  | mine e = case e of
+    InEnd e -> solveHopeSem k e exp
+    ExEnd _ -> quote Zy exp >>= instantiateMeta e
 typeEqEta _ (Zy :* _ :* _) mine Nat (SNum exp) (SNum act) = unifyNum mine (quoteNum Zy exp) (quoteNum Zy act)
 -- 2. harder cases, neither is in the hope set, so we can't define it ourselves
 typeEqEta tm stuff@(ny :* _ks :* _sems) _ k exp act = do
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 963d29c4..919dffa3 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -15,7 +15,10 @@ import Debug.Trace
 import qualified Data.Map as M
 import qualified Data.Set as S
 
--- trail = trace
+trailM :: Applicative f => String -> f ()
+trailM = const (pure ())
+trail = const id
+--trail = trace
 
 -- This is currently lifted from SolvePatterns, which still imports it.
 -- It is also used in SolveHoles, where it does the right mathematics
@@ -30,7 +33,7 @@ solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
 -- solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
 solveNumMeta e nv = case (e, numVars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
- (ExEnd src,  [VPar (InEnd _tgt)]) -> do
+ (ExEnd src,  [InEnd _tgt]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
    tgtSrc <- invertNatVal nv
    instantiateMeta (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
@@ -39,7 +42,7 @@ solveNumMeta e nv = case (e, numVars nv) of
  (ExEnd src, _) -> instantiateMeta (ExEnd src) (VNum nv)
 
  -- Both targets, we need to create the thing that they both derive from
- (InEnd bigTgt, [VPar (InEnd weeTgt)]) -> do
+ (InEnd bigTgt, [InEnd weeTgt]) -> do
    (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
                                          (REx ("n", Nat) R0) (REx ("n", Nat) R0)
    defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
@@ -58,13 +61,13 @@ solveNumMeta e nv = case (e, numVars nv) of
 
 unifyNum :: (End -> Bool) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum mine nv0 nv1 = do
-  traceM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
+  trailM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
   nv1 <- numEval S0 nv1
   unifyNum' mine (quoteNum Zy nv0) (quoteNum Zy nv1)
   nv0 <- numEval S0 (quoteNum Zy nv0)
   nv1 <- numEval S0 (quoteNum Zy nv1)
-  traceM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1))
+  trailM $ ("unifyNum Out\n  " ++ show (quoteNum Zy nv0) ++ "\n  " ++ show (quoteNum Zy nv1))
 
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
@@ -96,11 +99,11 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
        | mine e -> do
           req (Wire (dangling, TNat, p))
           defineTgt' ("flex-flex In Ex") (NamedPort p "") (VNum (nVar v))
-       | otherwise -> mkYield "flexFlex" (S.singleton e) >> unifyNum mine (VNum (nVar v)) (VNum (nVar v'))
+       | otherwise -> mkYield "flexFlex" (S.singleton e) >> unifyNum mine (nVar v) (nVar v')
       (v@(VPar e@(InEnd p)), v'@(VPar e'@(InEnd p')))
        | mine e -> defineTgt' "flex-flex In In1" (NamedPort p "") (VNum (nVar v'))
        | mine e' -> defineTgt' "flex-flex In In0"(NamedPort p' "") (VNum (nVar v))
-       | otherwise -> mkYield "flexFlex" (S.fromList [e, e']) >> unifyNum mine (VNum (nVar v)) (VNum (nVar v'))
+       | otherwise -> mkYield "flexFlex" (S.fromList [e, e']) >> unifyNum mine (nVar v) (nVar v')
 
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
@@ -118,7 +121,7 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
     sm <- numEval S0 sm
     -- traceM $ "succ now " ++ show (quoteNum Zy sm)
-    unifyNum (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
+    unifyNum mine (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 8926414d..3fd77957 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -79,7 +79,8 @@ solve my ((src, Lit tm):p) = do
     (Braty, Left Nat)
       | Num n <- tm -> do
           unless (n >= 0) $ typeErr "Negative Nat kind"
-          unifyNum (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
+          mine <- mineToSolve
+          unifyNum mine (nConstant (fromIntegral n)) (nVar (VPar (toEnd src)))
     (Braty, Right ty) -> do
       simpleCheck Braty ty tm
     _ -> typeErr $ "Literal " ++ show tm ++ " isn't valid at this type"
@@ -87,6 +88,7 @@ solve my ((src, Lit tm):p) = do
   pure ((src, PrimLitTest tm):tests, sol)
 solve my ((src, PCon c abs):p) = do
   ty <- typeOfSrc my src
+  mine <- mineToSolve
   case (my, ty) of
     -- TODO: When solving constructors, we need to provide actual wiring to get
     -- from the fully applied constructor to the bound pattern variables.
@@ -98,7 +100,7 @@ solve my ((src, PCon c abs):p) = do
       -- Special case for 0, so that we can call `unifyNum` instead of pattern
       -- matching using what's returned from `natConstructors`
       PrefixName [] "zero" -> do
-        unifyNum (nVar (VPar (toEnd src))) nZero
+        unifyNum mine (nVar (VPar (toEnd src))) nZero
         p <- argProblems [] (normaliseAbstractor abs) p
         (tests, sol) <- solve my p
         pure ((src, PrimLitTest (Num 0)):tests, sol)
@@ -109,6 +111,7 @@ solve my ((src, PCon c abs):p) = do
             R0 -- we don't need to wire the src in; we just need the inner stuff
             (REx ("inner", Nat) R0)
           unifyNum
+           mine
            (nVar (VPar (ExEnd (end src))))
            (relationToInner (nVar (VPar (toEnd dangling))))
           -- TODO also do wiring corresponding to relationToInner
@@ -172,6 +175,7 @@ unifys _ _ _ = error "jagged unifyArgs lists"
 -- Unify two Braty types
 unify :: Val Z -> TypeKind -> Val Z -> Checking ()
 unify l k r = do
+  mine <- mineToSolve
   -- Only complain normalised terms
   (l, r) <- (,) <$> eval S0 l <*> eval S0 r
   eqTest "unify" k l r >>= \case
@@ -185,7 +189,7 @@ unify l k r = do
         | c == c' -> do
             ks <- tlup (Kernel, c)
             unifys args (snd <$> ks) args'
-      (VNum l, VNum r, Nat) -> unifyNum l r
+      (VNum l, VNum r, Nat) -> unifyNum mine l r
       (VApp (VPar x) B0, v, _) -> instantiateMeta x v
       (v, VApp (VPar x) B0, _) -> instantiateMeta x v
       -- TODO: Handle function types
diff --git a/brat/brat.cabal b/brat/brat.cabal
index 3999cf9b..e291b7f5 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -49,7 +49,7 @@ common warning-flags
     -Werror=missing-methods
 --    -Werror=unused-top-binds
 --    -Werror=unused-local-binds
-    -Werror=redundant-constraints
+--    -Werror=redundant-constraints
     -Werror=orphans
     -Werror=overlapping-patterns
 

From 15980627dd94382445525fe76d16d6016c3b4d87 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 9 Apr 2025 11:54:29 +0100
Subject: [PATCH 120/182] More tracing

---
 brat/Brat/Checker/Helpers.hs | 8 ++++----
 brat/Brat/Checker/Monad.hs   | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 6998f063..14d8751d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -31,7 +31,7 @@ import Prelude hiding (last)
 
 import Debug.Trace
 
-
+trackPermission = const id
 
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
@@ -700,10 +700,10 @@ allowedToSolve prefix e =
         -- Solving a hope
         -- TODO: Check that the ! is in the same region of code as we are!
         -- (by checking we have a common prefix before the $rhs)
-        (InEnd _, _, Just "!") -> True
+        (InEnd _, _, Just "!") -> trackPermission ("Allowed to solve hope:\n  " ++ show prefix) True
         -- We can only solve dangling wires when doing pattern matching in `solve`
-        (ExEnd _, Just "lhs", _) -> True
-        _ -> False
+        (ExEnd _, Just "lhs", _) -> trackPermission ("Allowed to solve Src:\n  " ++ show prefix ++ "\n  " ++ show e) True
+        _ -> trackPermission ("Not allowed to solve:\n  " ++ show prefix ++ "\n  " ++ show e) False
  where
   lastDollar B0 = Nothing
   lastDollar (zx :< ('$':str, _)) = Just str
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index f472abe4..31b8bfc1 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -312,7 +312,7 @@ handler (Req s k) ctx g
                 M.lookup tycon tbl
         handler (k args) ctx g
 
-      ANewDynamic e fc -> handler (k ()) (ctx { dynamicSet = M.insert e fc (dynamicSet ctx) }) g
+      ANewDynamic e fc -> trackM ("ANewDynamic " ++ show e) *> handler (k ()) (ctx { dynamicSet = M.insert e fc (dynamicSet ctx) }) g
 
       AskDynamics -> handler (k (dynamicSet ctx)) ctx g
 

From 777b7a63280839ce2e31eefa517dc4ba57f978d4 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 9 Apr 2025 11:54:38 +0100
Subject: [PATCH 121/182] Allow solving when unifying args with valPat2Val

---
 brat/Brat/Checker/Helpers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 14d8751d..19026c1d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -703,6 +703,7 @@ allowedToSolve prefix e =
         (InEnd _, _, Just "!") -> trackPermission ("Allowed to solve hope:\n  " ++ show prefix) True
         -- We can only solve dangling wires when doing pattern matching in `solve`
         (ExEnd _, Just "lhs", _) -> trackPermission ("Allowed to solve Src:\n  " ++ show prefix ++ "\n  " ++ show e) True
+        (InEnd _, Just "unifyTypeArgs", Just "vp2v") -> trackPermission ("Allowed to solve Tgt:\n  " ++ show prefix ++ "\n  " ++ show e) True
         _ -> trackPermission ("Not allowed to solve:\n  " ++ show prefix ++ "\n  " ++ show e) False
  where
   lastDollar B0 = Nothing

From 7e776387191941c291ce52c4af7116ef61428c97 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 9 Apr 2025 15:33:29 +0100
Subject: [PATCH 122/182] [ progress / broken ] new mineToSolve logic not
 rolled out yet

---
 brat/Brat/Checker.hs              |  8 ++--
 brat/Brat/Checker/Helpers.hs      | 70 ++++++++++++++++++-------------
 brat/Brat/Checker/SolveHoles.hs   | 12 ++----
 brat/Brat/Checker/SolveNumbers.hs | 33 +++++++++------
 4 files changed, 70 insertions(+), 53 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 599f0ad9..fad5753c 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -490,10 +490,10 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     let m = deModey my -- TODO: remember what this is
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
-    (varz, patVals) <- "$vp2v" -! valPats2Val ks pats
+    (varz, patVals) <- "$!" -! valPats2Val ks pats
     trackM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
-    "$unifyTypeArgs" -! typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
+    typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
     ty <- eval S0 ty
     trackM $ "Made it past unification for ty =  " ++ show ty
     Some (ny :* env) <- pure $ bwdStack varz
@@ -735,11 +735,11 @@ checkClause my fnName cty clause = modily my $ do
   -- First, we check the patterns on the LHS. This requires some overs,
   -- so we make a box, however this box will be skipped during compilation.
   (vars, match, rhsCty) <- suppressHoles . fmap snd $
-                     let ?my = my in makeBox (clauseName ++ "_setup") cty $
+       let ?my = my in ("$lhs" -!) $ makeBox (clauseName ++ "_setup") cty $
                      \(overs, unders) -> do
     -- Make a problem to solve based on the lhs and the overs
     problem <- argProblems (fst <$> overs) (unWC $ lhs clause) []
-    (tests, sol) <- localFC (fcOf (lhs clause)) $ "$lhs" -! solve my problem
+    (tests, sol) <- localFC (fcOf (lhs clause)) $ solve my problem
     -- The solution gives us the variables bound by the patterns.
     -- We turn them into a row
     mkArgRo my S0 ((\(n, (src, ty)) -> (NamedPort (toEnd src) n, ty)) <$> sol) >>= \case
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 19026c1d..f7b263ca 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -24,6 +24,7 @@ import Control.Monad.State.Lazy (StateT(..), runStateT)
 import Data.Bifunctor
 import Data.Foldable (foldrM)
 import Data.List (partition)
+import Data.Maybe (isJust)
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -37,7 +38,7 @@ simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
   (Braty, VApp (VPar e) _) -> do
     mine <- mineToSolve
-    if mine e then
+    if isJust (mine e) then
       case tm of
         Float _ -> defineEnd "simpleCheck" e TFloat
         Text _ -> defineEnd "simpleCheck" e TText
@@ -623,24 +624,22 @@ invertNatVal (NumValue up gro) = case up of
 -- This will update the `hopes`, potentially invalidating things that have
 -- been eval'd.
 -- The Sem is closed, for now.
-solveHopeVal :: TypeKind -> InPort -> Val Z -> Checking ()
-solveHopeVal k hope v = case doesntOccur (InEnd hope) v of
-  Right () -> do
-    defineEnd "solveHopeVal" (InEnd hope) v
-    dangling <- case (k, v) of
-      (Nat, VNum v) -> buildNatVal v
-      (Nat, _) -> err $ InternalError "Head of Nat wasn't a VNum"
-      _ -> buildConst Unit TUnit
-    req (Wire (end dangling, kindType k, hope))
-  Left msg -> case v of
-    VApp (VPar (InEnd end)) B0 | hope == end -> pure ()
+solveVal :: TypeKind -> End -> Val Z -> Checking ()
+solveVal _ it (VApp (VPar e) B0) | it == e = pure ()
+solveVal k it v | Left msg <- doesntOccur it v =
     -- TODO: Not all occurrences are toxic. The end could be in an argument
     -- to a hoping variable which isn't used.
     -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
-    _ -> err msg
+    err msg
+solveVal Nat it@(InEnd inn) v@(VNum nv) = do
+  dangling <- buildNatVal nv
+  req (Wire (end dangling, TNat, inn))
+  defineEnd "solveValNat" it v
+solveVal _ it v = defineEnd "solveVal" it v
+  -- Do we also need dummy wiring here?
 
-solveHopeSem :: TypeKind -> InPort -> Sem -> Checking ()
-solveHopeSem k hope = quote Zy >=> solveHopeVal k hope
+solveSem :: TypeKind -> End -> Sem -> Checking ()
+solveSem k hope = quote Zy >=> solveVal k hope
 
 -- Convert a pattern into a value for the purposes of solving it with unification
 -- for pattern matching. This is used for checking type constructors - we're only
@@ -691,26 +690,41 @@ traceChecking lbl m a = do
 
 -- traceChecking = const id
 
-allowedToSolve :: Bwd (String, Int) -> End -> Bool
-allowedToSolve prefix e =
-  let whoAreWe = lastDollar prefix
-      MkName ePrefix = endName e
-      whoCanSolve = lastDollar (B0 <>< ePrefix)
-  in  case (e, whoAreWe, whoCanSolve) of
+dollarAndItsPrefix :: Bwd (String, Int) -> Maybe (Bwd (String, Int), String)
+dollarAndItsPrefix B0 = Nothing
+dollarAndItsPrefix (siz :< ('$':doll, _)) = Just (siz, doll)
+dollarAndItsPrefix (siz :< _) = dollarAndItsPrefix siz
+
+prefixLeftOf :: Bwd (String, Int) -> String -> Maybe (Bwd (String, Int))
+prefixLeftOf B0 _ = Nothing
+prefixLeftOf (siz :< (s, _)) key
+  | s == key = Just siz
+  | otherwise = prefixLeftOf siz key
+
+allowedToSolve :: Bwd (String, Int) -> End -> Maybe String
+allowedToSolve me it =
+  let MkName itFwd = endName it
+      itBwd = (B0 <>< itFwd)
+  in  case (it, dollarAndItsPrefix me, dollarAndItsPrefix itBwd) of
         -- Solving a hope
-        -- TODO: Check that the ! is in the same region of code as we are!
-        -- (by checking we have a common prefix before the $rhs)
-        (InEnd _, _, Just "!") -> trackPermission ("Allowed to solve hope:\n  " ++ show prefix) True
+        (InEnd _, Just (region, "rhs"), Just (maker, "!"))
+	  | Just region == prefixLeftOf maker "$rhs"
+	   ->
+	  trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
+	  $ Just "$!"
         -- We can only solve dangling wires when doing pattern matching in `solve`
-        (ExEnd _, Just "lhs", _) -> trackPermission ("Allowed to solve Src:\n  " ++ show prefix ++ "\n  " ++ show e) True
-        (InEnd _, Just "unifyTypeArgs", Just "vp2v") -> trackPermission ("Allowed to solve Tgt:\n  " ++ show prefix ++ "\n  " ++ show e) True
-        _ -> trackPermission ("Not allowed to solve:\n  " ++ show prefix ++ "\n  " ++ show e) False
+        (ExEnd _, Just (region, "lhs"), Just (region', "lhs"))
+	  | region == region'
+	  -> trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
+	  $ Just "gen"
+        _ -> trackPermission ("Forbidden to solve:\n  " ++ show me ++ " / " ++ show it)
+	  Nothing
  where
   lastDollar B0 = Nothing
   lastDollar (zx :< ('$':str, _)) = Just str
   lastDollar (zx :< x) = lastDollar zx
 
-mineToSolve :: Checking (End -> Bool)
+mineToSolve :: Checking (End -> Maybe String)
 mineToSolve = allowedToSolve <$> whoAmI
 
 -- Don't call this on kinds
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 951d7dc4..f8ec76f2 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,6 +1,6 @@
 module Brat.Checker.SolveHoles (typeEq) where
 
-import Brat.Checker.Helpers (buildNatVal, buildConst, mineToSolve, solveHopeSem)
+import Brat.Checker.Helpers (buildNatVal, buildConst, mineToSolve, solveSem)
 import Brat.Checker.Monad
 import Brat.Checker.SolveNumbers
 import Brat.Checker.Types (kindForMode, IsSkolem(..))
@@ -58,7 +58,7 @@ typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
 -- Presumes that the hope set and the two `Sem`s are up to date.
 typeEqEta :: String -- String representation of the term for error reporting
           -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n
-          -> (End -> Bool) -- Tells us if we can solve a given End
+          -> (End -> Maybe String) -- Tells us if we can solve a given End
           -> TypeKind -- The kind we're comparing at
           -> Sem -- Expected
           -> Sem -- Actual
@@ -74,13 +74,9 @@ typeEqEta tm (lvy :* kz :* sems) mine (TypeFor m ((_, k):ks)) exp act = do
 -- (We don't solve under binders for now, so we only consider Zy here)
 -- 1. "easy" flex cases
 typeEqEta _tm (Zy :* _ks :* _sems) mine k (SApp (SPar e) B0) act
-  | mine e = case e of
-    InEnd e -> solveHopeSem k e act
-    ExEnd _ -> quote Zy act >>= instantiateMeta e
+  | Just _ <- mine e = solveSem k e act
 typeEqEta _tm (Zy :* _ks :* _sems) mine k exp (SApp (SPar e) B0)
-  | mine e = case e of
-    InEnd e -> solveHopeSem k e exp
-    ExEnd _ -> quote Zy exp >>= instantiateMeta e
+  | Just _ <- mine e = solveSem k e exp
 typeEqEta _ (Zy :* _ :* _) mine Nat (SNum exp) (SNum act) = unifyNum mine (quoteNum Zy exp) (quoteNum Zy act)
 -- 2. harder cases, neither is in the hope set, so we can't define it ourselves
 typeEqEta tm stuff@(ny :* _ks :* _sems) _ k exp act = do
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 919dffa3..7978c93e 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -8,6 +8,7 @@ import Brat.Syntax.Port
 import Brat.Error
 import Brat.Eval
 import Brat.Graph (NodeType(..))
+import Brat.Naming
 import Hasochism
 import Control.Monad.Freer
 
@@ -59,7 +60,7 @@ solveNumMeta e nv = case (e, numVars nv) of
    instantiateMeta (InEnd tgt) (VNum nv)
    wire (src, TNat, NamedPort tgt "")
 
-unifyNum :: (End -> Bool) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum mine nv0 nv1 = do
   trailM $ ("unifyNum In\n  " ++ show nv0 ++ "\n  " ++ show nv1)
   nv0 <- numEval S0 nv0
@@ -72,7 +73,7 @@ unifyNum mine nv0 nv1 = do
 -- Need to keep track of which way we're solving - which side is known/unknown
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
-unifyNum' :: (End -> Bool) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
+unifyNum' :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 -- unifyNum' a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
 unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
@@ -92,17 +93,17 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     EQ -> pure ()
     LT -> case (v, v') of
       (v@(VPar e@(ExEnd p)), v'@(VPar e'@(ExEnd p')))
-       | mine e -> defineSrc (NamedPort p "") (VNum (nVar v'))
-       | mine e' -> defineSrc (NamedPort p' "") (VNum (nVar v))
+       | Just _ <- mine e -> defineSrc (NamedPort p "") (VNum (nVar v'))
+       | Just _ <- mine e' -> defineSrc (NamedPort p' "") (VNum (nVar v))
        | otherwise -> typeErr $ "Can't force " ++ show v ++ " to be " ++ show v'
       (VPar e@(InEnd p), v@(VPar (ExEnd dangling)))
-       | mine e -> do
+       | Just _ <- mine e -> do
           req (Wire (dangling, TNat, p))
           defineTgt' ("flex-flex In Ex") (NamedPort p "") (VNum (nVar v))
        | otherwise -> mkYield "flexFlex" (S.singleton e) >> unifyNum mine (nVar v) (nVar v')
       (v@(VPar e@(InEnd p)), v'@(VPar e'@(InEnd p')))
-       | mine e -> defineTgt' "flex-flex In In1" (NamedPort p "") (VNum (nVar v'))
-       | mine e' -> defineTgt' "flex-flex In In0"(NamedPort p' "") (VNum (nVar v))
+       | Just _ <- mine e -> defineTgt' "flex-flex In In1" (NamedPort p "") (VNum (nVar v'))
+       | Just _ <- mine e' -> defineTgt' "flex-flex In In0"(NamedPort p' "") (VNum (nVar v))
        | otherwise -> mkYield "flexFlex" (S.fromList [e, e']) >> unifyNum mine (nVar v) (nVar v')
 
   lhsStrictMono :: StrictMono (VVar Z) -> NumVal (VVar Z) -> Checking ()
@@ -112,8 +113,12 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     lhsFun00 (StrictMonoFun (StrictMono (n - 1) mono)) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear (VPar e)) num = throwLeft (doesntOccur e (VNum num)) *>
-                                  solveNumMeta e num
+  lhsMono (Linear (VPar e)) num = case mine e of
+    Just _ -> do
+      throwLeft (doesntOccur e (VNum num))  -- too much?
+      solveNumMeta e num -- really?
+    _ -> mkYield "lhsMono" (S.singleton e) >>
+         unifyNum mine (nVar (VPar e)) num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsFun00 (StrictMonoFun sm) (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
@@ -137,13 +142,15 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
       -- = 2^k * (y + 1)
       -- = 2^k + 2^k * y
       -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-  demandSucc (StrictMono k (Linear (VPar e))) = do
-    pred <- traceChecking "makePred" makePred e
+  demandSucc (StrictMono k (Linear (VPar e))) | Just loc <- mine e = do
+    pred <- loc -! traceChecking "makePred" makePred e
     pure (nPlus ((2^k) - 1) (nVar (VPar pred)))
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
+
+  -- if it's not "mine" should we wait?
   demandSucc x@(StrictMono k (Full nPlus1)) = do
     n <- traceChecking "demandSucc" demandSucc nPlus1
     -- foo <- numEval S0 x
@@ -160,7 +167,7 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
     evenGro Constant0 = pure Constant0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar e) -> do
+      Linear (VPar e) | Just loc <- mine e -> loc -! do
         -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
         half <- traceChecking "makeHalf" makeHalf e
         pure (StrictMonoFun (StrictMono 0 (Linear (VPar half))))
@@ -170,7 +177,7 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar e) -> do
+      Linear (VPar e) | Just loc <- mine e -> loc -! do
         pred <- traceChecking "makePred" makePred e
         half <- traceChecking "makeHalf" makeHalf pred
         pure (nVar (VPar half))

From d55841a7e844ded75eb69a3f3234c6b29d68baba Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 9 Apr 2025 15:57:33 +0100
Subject: [PATCH 123/182] [ fix ] check in lambda wrapped in $rhs

---
 brat/Brat/Checker.hs         |  2 +-
 brat/Brat/Checker/Helpers.hs |  3 ++-
 brat/Brat/Checker/Monad.hs   | 12 ++++++------
 3 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index fad5753c..5aaaaa7e 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -245,7 +245,7 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
         localEnv fakeEnv $ do
           (_, fakeUnders, [], _) <- anext "lambda_fake_target" Hypo fakeAcc outs R0
           Just tgtMap <- pure $ zipSameLength (fst <$> fakeUnders) unders
-          (((), ()), ((), rightFakeUnders)) <- check body ((), fakeUnders)
+          (((), ()), ((), rightFakeUnders)) <- "$rhs" -! check body ((), fakeUnders)
           pure (fakeUnders, rightFakeUnders, tgtMap)
 
       let usedFakeUnders = (fst <$> allFakeUnders) \\ (fst <$> rightFakeUnders)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index f7b263ca..aaa53af3 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -32,7 +32,8 @@ import Prelude hiding (last)
 
 import Debug.Trace
 
-trackPermission = const id
+--trackPermission = const id
+trackPermission = trace
 
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 31b8bfc1..36c41409 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -25,15 +25,15 @@ import qualified Data.Set as S
 import Debug.Trace
 
 -- Used for messages about thread forking / spawning
-thTrace = const id
---thTrace = trace
+--thTrace = const id
+thTrace = trace
 
 trackM :: Monad m => String -> m ()
-trackM = const (pure ())
---trackM = traceM
+--trackM = const (pure ())
+trackM = traceM
 
-track = const id
---track = trace
+--track = const id
+track = trace
 trackShowId x = track (show x) x
 
 -- Data for using a type alias. E.g.

From 4fbaff13bdf5373c7379777253d95454b821acf4 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 9 Apr 2025 16:42:17 +0100
Subject: [PATCH 124/182] [ fix ] get $checkwire out of $rhs's way; typesEq not
 unifys!

---
 brat/Brat/Checker.hs               | 24 ++++++++++--------------
 brat/Brat/Checker/SolveHoles.hs    | 12 +++++++++++-
 brat/Brat/Checker/SolvePatterns.hs |  4 +++-
 brat/examples/map.brat             |  3 +++
 4 files changed, 27 insertions(+), 16 deletions(-)
 create mode 100644 brat/examples/map.brat

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 5aaaaa7e..1deb0da1 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -121,25 +121,19 @@ checkWire :: Modey m
           -> (Tgt, BinderType m)
           -> Checking ()
 checkWire Braty _ outputs (dangling, Left ok) (hungry, Left uk) = do
-  prefix <- whoAmI
-  trackM ("Who am I: checkWire: " ++ show prefix)
   throwLeft $ if outputs
     then kindEq ok uk
     else kindEq uk ok
   defineTgt' "checkWire" hungry (endVal ok (ExEnd (end dangling)))
   wire (dangling, kindType ok, hungry)
-checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ "$checkWire" -! do
-  prefix <- whoAmI
-  trackM ("Who am I: checkWire: " ++ show prefix)
+checkWire Braty (WC fc tm) outputs (dangling, o) (hungry, u) = localFC fc $ do
   let ot = binderToValue Braty o
   let ut = binderToValue Braty u
   if outputs
     then typeEq (show tm) (Star []) ot ut
     else typeEq (show tm) (Star []) ut ot
   wire (dangling, ot, hungry)
-checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ "checkWire" -! do
-  prefix <- whoAmI
-  trackM ("Who am I: checkWire: " ++ show prefix)
+checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ do
   if outputs
     then typeEq (show tm) (Dollar []) ot ut
     else typeEq (show tm) (Dollar []) ut ot
@@ -236,12 +230,14 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       -- with the other clauses, as part of the body.
       (ins :->> outs) <- mkSig usedOvers unders
       (allFakeUnders, rightFakeUnders, tgtMap) <- suppressHoles $ suppressGraph $ do
-        (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins SkolemConst
-        -- Hypo `check` calls need an environment, even just to compute leftovers;
-        -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
-        let srcMap = fromJust $ zipSameLength (fst <$> usedOvers) (fst <$> fakeOvers)
-        let fakeProblem = [ (fromJust (lookup src srcMap), pat) | (src, pat) <- problem ]
-        fakeEnv <- localFC abstFC $ solve ?my fakeProblem >>= (solToEnv . snd)
+        (fakeEnv, fakeAcc) <- "$lhs" -! do
+	  (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins SkolemConst
+	  -- Hypo `check` calls need an environment, even just to compute leftovers;
+	  -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
+	  let srcMap = fromJust $ zipSameLength (fst <$> usedOvers) (fst <$> fakeOvers)
+	  let fakeProblem = [ (fromJust (lookup src srcMap), pat) | (src, pat) <- problem ]
+	  fakeEnv <- localFC abstFC $ solve ?my fakeProblem >>= (solToEnv . snd)
+	  pure (fakeEnv, fakeAcc)
         localEnv fakeEnv $ do
           (_, fakeUnders, [], _) <- anext "lambda_fake_target" Hypo fakeAcc outs R0
           Just tgtMap <- pure $ zipSameLength (fst <$> fakeUnders) unders
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index f8ec76f2..e95e3a7d 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,4 +1,4 @@
-module Brat.Checker.SolveHoles (typeEq) where
+module Brat.Checker.SolveHoles (typeEq, typesEq) where
 
 import Brat.Checker.Helpers (buildNatVal, buildConst, mineToSolve, solveSem)
 import Brat.Checker.Monad
@@ -37,6 +37,16 @@ typeEq str k exp act = do
   trackM ("typeEq: Who am I: " ++ show prefix)
   typeEq' str (Zy :* S0 :* S0) k exp act
 
+typesEq :: String -- String representation of the term for error reporting
+        -> [TypeKind] -- The kinds we're comparing at
+        -> [Val Z] -- Expected
+        -> [Val Z] -- Actual
+        -> Checking ()
+typesEq str k exp act = do
+  prefix <- whoAmI
+  trackM ("typesEq: Who am I: " ++ show prefix)
+  typeEqs str (Zy :* S0 :* S0) k exp act
+
 
 -- Internal version of typeEq with environment for non-closed values
 typeEq' :: String -- String representation of the term for error reporting
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 3fd77957..2bf26313 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -4,6 +4,7 @@ import Brat.Checker.Monad
 import Brat.Checker.Helpers
 import Brat.Checker.Types (EndType(..))
 import Brat.Checker.SolveNumbers
+import Brat.Checker.SolveHoles
 import Brat.Constructors
 import Brat.Constructors.Patterns
 import Brat.Error
@@ -162,7 +163,8 @@ solveConstructor my src (c, abs) ty p = do
       tyArgKinds <- tlup (Brat, tycon)
       -- Constrain tyargs to match pats
       trackM $ unlines ["unifys",show lhss,show tyArgKinds, show tyargs]
-      unifys lhss (snd <$> tyArgKinds) tyargs
+      typesEq "pretending to be unifys" (snd <$> tyArgKinds) lhss tyargs
+      -- unifys lhss (snd <$> tyArgKinds) tyargs
       p <- argProblems (fst <$> patArgWires) (normaliseAbstractor abs) p
       (tests, sol) <- solve my p
       pure ((src, PrimCtorTest c tycon node patArgWires) : tests, sol)
diff --git a/brat/examples/map.brat b/brat/examples/map.brat
new file mode 100644
index 00000000..db7b558d
--- /dev/null
+++ b/brat/examples/map.brat
@@ -0,0 +1,3 @@
+map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
+map(_, _, _, []) = []
+map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)

From 6e60114c71109f8001aa3e93121426a602c12922 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 9 Apr 2025 16:49:37 +0100
Subject: [PATCH 125/182] [ deletion ] unifys is gone

---
 brat/Brat/Checker/SolvePatterns.hs | 34 ------------------------------
 1 file changed, 34 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 2bf26313..f2876c45 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -169,40 +169,6 @@ solveConstructor my src (c, abs) ty p = do
       (tests, sol) <- solve my p
       pure ((src, PrimCtorTest c tycon node patArgWires) : tests, sol)
 
-unifys :: [Val Z] -> [TypeKind] -> [Val Z] -> Checking ()
-unifys [] [] [] = pure ()
-unifys (l:ls) (k:ks) (r:rs) = unify l k r *> unifys ls ks rs
-unifys _ _ _ = error "jagged unifyArgs lists"
-
--- Unify two Braty types
-unify :: Val Z -> TypeKind -> Val Z -> Checking ()
-unify l k r = do
-  mine <- mineToSolve
-  -- Only complain normalised terms
-  (l, r) <- (,) <$> eval S0 l <*> eval S0 r
-  eqTest "unify" k l r >>= \case
-    Right () -> pure ()
-    Left _ -> case (l, r, k) of
-      (VCon c args, VCon c' args', Star [])
-        | c == c' -> do
-            ks <- tlup (Brat, c)
-            unifys args (snd <$> ks) args'
-      (VCon c args, VCon c' args', Dollar [])
-        | c == c' -> do
-            ks <- tlup (Kernel, c)
-            unifys args (snd <$> ks) args'
-      (VNum l, VNum r, Nat) -> unifyNum mine l r
-      (VApp (VPar x) B0, v, _) -> instantiateMeta x v
-      (v, VApp (VPar x) B0, _) -> instantiateMeta x v
-      -- TODO: Handle function types
-      -- TODO: Postpone this problem instead of giving up. Stick it an a list of
-      --       equations that we hope are true and check them once we've processed
-      --       the whole `Problem`.
-      (l, r, _) -> err . UnificationError $ "Can't unify " ++ show l ++ " with " ++ show r
-
--- Solve a metavariable statically - don't do anything dynamic
--- Once a metavariable is solved, we expect to not see it again in a normal form.
-
 -- The variable must be a non-zero nat!!
 patVal :: ValPat -> [End] -> (Val Z, [End])
 -- Nat variables will only be found in a `NumPat`, not a `ValPat`

From afbb4c80a9a328d2a95a78fe911c84023d224477 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Wed, 9 Apr 2025 17:23:43 +0100
Subject: [PATCH 126/182] [ fix ] more $rhs for check; loc -! solveNumMeta

---
 brat/Brat/Checker/Helpers.hs      |  2 +-
 brat/Brat/Checker/SolveNumbers.hs | 17 ++++++++++-------
 brat/Brat/Load.hs                 |  4 ++--
 3 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index aaa53af3..b0201b6a 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -714,7 +714,7 @@ allowedToSolve me it =
 	  trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
 	  $ Just "$!"
         -- We can only solve dangling wires when doing pattern matching in `solve`
-        (ExEnd _, Just (region, "lhs"), Just (region', "lhs"))
+        (_, Just (region, "lhs"), Just (region', "lhs"))
 	  | region == region'
 	  -> trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
 	  $ Just "gen"
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 7978c93e..ddc8829f 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -92,16 +92,19 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     GT -> flexFlex v' v
     EQ -> pure ()
     LT -> case (v, v') of
-      (v@(VPar e@(ExEnd p)), v'@(VPar e'@(ExEnd p')))
+      (VPar e@(ExEnd p), VPar e'@(ExEnd p'))
        | Just _ <- mine e -> defineSrc (NamedPort p "") (VNum (nVar v'))
        | Just _ <- mine e' -> defineSrc (NamedPort p' "") (VNum (nVar v))
        | otherwise -> typeErr $ "Can't force " ++ show v ++ " to be " ++ show v'
-      (VPar e@(InEnd p), v@(VPar (ExEnd dangling)))
+      (VPar e@(InEnd p), VPar e'@(ExEnd dangling))
        | Just _ <- mine e -> do
           req (Wire (dangling, TNat, p))
-          defineTgt' ("flex-flex In Ex") (NamedPort p "") (VNum (nVar v))
+          defineTgt' ("flex-flex In Ex") (NamedPort p "") (VNum (nVar v'))
+       | Just _ <- mine e' -> do
+          req (Wire (dangling, TNat, p))
+          defineSrc' ("flex-flex In Ex") (NamedPort dangling "") (VNum (nVar v))
        | otherwise -> mkYield "flexFlex" (S.singleton e) >> unifyNum mine (nVar v) (nVar v')
-      (v@(VPar e@(InEnd p)), v'@(VPar e'@(InEnd p')))
+      (VPar e@(InEnd p), VPar e'@(InEnd p'))
        | Just _ <- mine e -> defineTgt' "flex-flex In In1" (NamedPort p "") (VNum (nVar v'))
        | Just _ <- mine e' -> defineTgt' "flex-flex In In0"(NamedPort p' "") (VNum (nVar v))
        | otherwise -> mkYield "flexFlex" (S.fromList [e, e']) >> unifyNum mine (nVar v) (nVar v')
@@ -114,9 +117,9 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
   lhsMono (Linear (VPar e)) num = case mine e of
-    Just _ -> do
+    Just loc -> do
       throwLeft (doesntOccur e (VNum num))  -- too much?
-      solveNumMeta e num -- really?
+      loc -! solveNumMeta e num -- really?
     _ -> mkYield "lhsMono" (S.singleton e) >>
          unifyNum mine (nVar (VPar e)) num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
@@ -131,7 +134,7 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (VPar e) -> solveNumMeta e (nConstant 0)
+    Linear (VPar e) | Just _ <- mine e -> solveNumMeta e (nConstant 0)
     Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
     _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
   demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
diff --git a/brat/Brat/Load.hs b/brat/Brat/Load.hs
index 73449f50..41f56d06 100644
--- a/brat/Brat/Load.hs
+++ b/brat/Brat/Load.hs
@@ -69,7 +69,7 @@ checkDecl pre (VDecl FuncDecl{..}) to_define = (fnName -!) $ localFC fnLoc $ do
     -- We must have a row of nouns as the definition
     Nothing -> case fnBody of
       NoLhs body -> do
-        (((), ()), ((), rightUnders)) <- let ?my = Braty in check body ((), to_define)
+        (((), ()), ((), rightUnders)) <- let ?my = Braty in "$rhs" -! check body ((), to_define)
         case rightUnders of
           [] -> pure ()
           _ -> localFC (fcOf body) $
@@ -94,7 +94,7 @@ checkDecl pre (VDecl FuncDecl{..}) to_define = (fnName -!) $ localFC fnLoc $ do
             Kerny -> wire (box_out, VFun my cty, thunk_in)
           [] -> err $ ExpectedThunk (showMode my) "No body"
           row -> err $ ExpectedThunk (showMode my) (showRow row)
-      Left body -> let ?my = Braty in check body ((), to_define) $> ()
+      Left body -> let ?my = Braty in "$rhs" -! check body ((), to_define) $> ()
  where
   getClauses :: FunBody Term Noun
              -> (Modey m, CTy m Z)

From ee3de263e3c2e667ca3ae7349412eacee122c836 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 11 Apr 2025 09:09:41 +0100
Subject: [PATCH 127/182] map failure: Feature not a bug?

---
 brat/examples/lib/functional.brat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/examples/lib/functional.brat b/brat/examples/lib/functional.brat
index f8ccccab..1327ee5d 100644
--- a/brat/examples/lib/functional.brat
+++ b/brat/examples/lib/functional.brat
@@ -1,6 +1,6 @@
 -- TODO: Fill this with holes once we can guess them
 map(X :: $,  Y :: $, n :: #, f :: { X -o Y }) -> { Vec(X, n) -o Vec(Y, n) }
-map(_, _, _, _) = { [] => [] }
+map(_, _, 0, _) = { [] => [] }
 map(X, Y, succ(n), f) = { cons(x,xs) => cons(f(x), map(X, Y, n, f)(xs)) }
 
 fold(X :: $

From f2ee595c80889ddef8ca2238de95df3582b241a9 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 11 Apr 2025 11:55:45 +0100
Subject: [PATCH 128/182] Fix bug in solveNumMeta

---
 brat/Brat/Checker/SolveNumbers.hs | 3 ++-
 brat/Brat/Eval.hs                 | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index ddc8829f..6131d443 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -30,6 +30,7 @@ trail = const id
 -- numbers because they have nontrivial runtime behaviour.
 --
 -- We assume that the caller has done the occurs check and rules out trivial equations.
+-- The caller also must check we have the right to solve the End
 solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
 -- solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
 solveNumMeta e nv = case (e, numVars nv) of
@@ -47,7 +48,7 @@ solveNumMeta e nv = case (e, numVars nv) of
    (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
                                          (REx ("n", Nat) R0) (REx ("n", Nat) R0)
    defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
-   instantiateMeta (InEnd weeTgt) (VNum (nVar (VPar (toEnd idSrc))))
+   instantiateMeta (InEnd bigTgt) (VNum (nVar (VPar (toEnd idSrc))))
    wire (idSrc, TNat, NamedPort weeTgt "")
    let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
    bigSrc <- buildNatVal nv'
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index af2b0238..7427c9bc 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -323,6 +323,7 @@ doesntOccur e (VFun my (ins :->> outs)) = case my of
   Braty -> doesntOccurRo my e ins *> doesntOccurRo my e outs
   Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
 
+-- This should only be called after checking we have the right to solve the end
 instantiateMeta :: End -> Val Z -> Checking ()
 instantiateMeta e val = do
   throwLeft (doesntOccur e val)

From 16cedf4f76334ee455b4b9b9dde9ee90ab9c7a5a Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 11 Apr 2025 12:00:16 +0100
Subject: [PATCH 129/182] Some yielding in unifyNum

---
 brat/Brat/Checker/SolveNumbers.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 6131d443..34fcc623 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -76,7 +76,7 @@ unifyNum mine nv0 nv1 = do
 -- ...But we don't need to do any wiring here, right?
 unifyNum' :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 -- unifyNum' a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
-unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
+unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -181,10 +181,15 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     -- Check a numval is odd, and return its rounded down half
     oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar e) | Just loc <- mine e -> loc -! do
-        pred <- traceChecking "makePred" makePred e
-        half <- traceChecking "makeHalf" makeHalf pred
-        pure (nVar (VPar half))
+      Linear (VPar e)
+       | Just loc <- mine e -> loc -! do
+         pred <- traceChecking "makePred" makePred e
+         half <- traceChecking "makeHalf" makeHalf pred
+         pure (nVar (VPar half))
+       | otherwise -> do
+         mkYield "oddGro" (S.singleton e)
+         nv <- quoteNum Zy <$> numEval S0 mono
+         demandEven (nPlus 1 nv) -- Is this dumb?
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
       Full sm -> nFull <$> traceChecking "demandSucc" demandSucc sm

From 6c582567660d8738977f39863035f46324385102 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 11 Apr 2025 12:02:39 +0100
Subject: [PATCH 130/182] A smaller test case (delete later)

---
 brat/Brat/Checker/SolveNumbers.hs |  2 +-
 brat/examples/smol.brat           | 11 +++++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 brat/examples/smol.brat

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 34fcc623..13bd77e5 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -189,7 +189,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
        | otherwise -> do
          mkYield "oddGro" (S.singleton e)
          nv <- quoteNum Zy <$> numEval S0 mono
-         demandEven (nPlus 1 nv) -- Is this dumb?
+         demandEven (nPlus 1 nv)
       -- full(n + 1) = 1 + 2 * full(n)
       -- hence, full(n) is the rounded down half
       Full sm -> nFull <$> traceChecking "demandSucc" demandSucc sm
diff --git a/brat/examples/smol.brat b/brat/examples/smol.brat
new file mode 100644
index 00000000..d4d0ffcb
--- /dev/null
+++ b/brat/examples/smol.brat
@@ -0,0 +1,11 @@
+foo(n :: #, Vec(Nat, 2 * n)) -> Vec(Nat, 4 * n)
+foo(n, xs =%= ys) = goo(n, (xs =%= ys) =%= (ys =%= xs))
+
+goo(n :: #, Vec(Nat, 4 * n)) -> Vec(Nat, 4 * n)
+goo(_, xs) = xs
+
+--merge(n :: #, Vec(Nat, 2^n), Vec(Nat, 2^n)) -> Vec(Nat, 2^(n + 1))
+--merge(succ(n), xs, ys) = fix(succ(n), xs =%= ys)
+--
+--fix(n :: #, Vec(Nat, 2^(n + 1))) -> Vec(Nat, 2^(n + 1))
+--fix(_, xs) = xs
\ No newline at end of file

From 9b404c6861c5fc1077b704ac1bdcdb5f2b962d18 Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Fri, 11 Apr 2025 17:23:22 +0100
Subject: [PATCH 131/182] [ fix ] more yielding in unifyNum; no unauthorised
 solving

---
 brat/Brat/Checker/SolveNumbers.hs | 92 ++++++++++++++++---------------
 1 file changed, 47 insertions(+), 45 deletions(-)

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 13bd77e5..4ad334e4 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -31,9 +31,9 @@ trail = const id
 --
 -- We assume that the caller has done the occurs check and rules out trivial equations.
 -- The caller also must check we have the right to solve the End
-solveNumMeta :: End -> NumVal (VVar Z) -> Checking ()
--- solveNumMeta e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
-solveNumMeta e nv = case (e, numVars nv) of
+solveNumMeta :: (End -> Maybe String) -> End -> NumVal (VVar Z) -> Checking ()
+solveNumMeta _ e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
+solveNumMeta mine e nv = case (e, numVars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [InEnd _tgt]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
@@ -45,15 +45,16 @@ solveNumMeta e nv = case (e, numVars nv) of
 
  -- Both targets, we need to create the thing that they both derive from
  (InEnd bigTgt, [InEnd weeTgt]) -> do
-   (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
+     (_, [(idTgt, _)], [(idSrc, _)], _) <- anext "numval id" Id (S0, Some (Zy :* S0))
                                          (REx ("n", Nat) R0) (REx ("n", Nat) R0)
-   defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
-   instantiateMeta (InEnd bigTgt) (VNum (nVar (VPar (toEnd idSrc))))
-   wire (idSrc, TNat, NamedPort weeTgt "")
-   let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
-   bigSrc <- buildNatVal nv'
-   instantiateMeta (InEnd bigTgt) (VNum nv')
-   wire (bigSrc, TNat, NamedPort bigTgt "")
+     defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
+     let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
+     bigSrc <- buildNatVal nv'
+     instantiateMeta (InEnd bigTgt) (VNum nv')
+     wire (bigSrc, TNat, NamedPort bigTgt "")
+     unifyNum mine (nVar (VPar (toEnd idSrc))) (nVar (VPar (toEnd weeTgt)))
+   
+
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
@@ -120,14 +121,14 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   lhsMono (Linear (VPar e)) num = case mine e of
     Just loc -> do
       throwLeft (doesntOccur e (VNum num))  -- too much?
-      loc -! solveNumMeta e num -- really?
+      loc -! solveNumMeta mine e num -- really?
     _ -> mkYield "lhsMono" (S.singleton e) >>
          unifyNum mine (nVar (VPar e)) num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsFun00 (StrictMonoFun sm) (NumValue 0 (StrictMonoFun sm'))
   lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
-    smPred <- traceChecking "lhsMono demandSucc" demandSucc sm
+    smPred <- traceChecking "lhsMono demandSucc" demandSucc (NumValue 0 (StrictMonoFun sm))
     sm <- numEval S0 sm
     -- traceM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum mine (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
@@ -135,28 +136,35 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of
-    Linear (VPar e) | Just _ <- mine e -> solveNumMeta e (nConstant 0)
+    Linear (VPar e) | Just _ <- mine e -> solveNumMeta mine e (nConstant 0)
     Full sm -> demand0 (NumValue 0 (StrictMonoFun sm))
     _ -> err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
   demand0 n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be 0"
 
   -- Complain if a number isn't a successor, else return its predecessor
-  demandSucc :: StrictMono (VVar Z) -> Checking (NumVal (VVar Z))
+  demandSucc :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
       --   2^k * x
       -- = 2^k * (y + 1)
       -- = 2^k + 2^k * y
       -- Hence, the predecessor is (2^k - 1) + (2^k * y)
-  demandSucc (StrictMono k (Linear (VPar e))) | Just loc <- mine e = do
-    pred <- loc -! traceChecking "makePred" makePred e
-    pure (nPlus ((2^k) - 1) (nVar (VPar pred)))
+  demandSucc (NumValue k x) | k > 0 = pure (NumValue (k - 1) x)
+  demandSucc (NumValue 0 (StrictMonoFun (mono@(StrictMono k (Linear (VPar e))))))
+    | Just loc <- mine e = do
+      pred <- loc -! traceChecking "makePred" makePred e
+      pure (nPlus ((2^k) - 1) (nVar (VPar pred)))
 
   --   2^k * full(n + 1)
   -- = 2^k * (1 + 2 * full(n))
   -- = 2^k + 2^(k + 1) * full(n)
 
+    | otherwise = do
+      mkYield "demandSucc" (S.singleton e)
+      nv <- quoteNum Zy <$> numEval S0 mono
+      demandSucc nv
+
   -- if it's not "mine" should we wait?
-  demandSucc x@(StrictMono k (Full nPlus1)) = do
-    n <- traceChecking "demandSucc" demandSucc nPlus1
+  demandSucc (NumValue 0 (StrictMonoFun x@(StrictMono k (Full nPlus1)))) = do
+    n <- traceChecking "demandSucc" demandSucc (NumValue 0 (StrictMonoFun nPlus1))
     -- foo <- numEval S0 x
     -- traceM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
@@ -165,32 +173,26 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   -- Complain if a number isn't even, otherwise return half
   demandEven :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
   demandEven n@(NumValue up gro) = case up `divMod` 2 of
-    (up, 0) -> NumValue up <$> traceChecking "evenGro" evenGro gro
-    (up, 1) -> nPlus (up + 1) <$> traceChecking "oddGro" oddGro gro
+    (up, 0) -> nPlus up <$> traceChecking "evenGro" evenGro gro
+    (up, 1) -> nPlus (up + 1) <$> traceChecking "oddGro" oddGro (NumValue 0 gro)
    where
-    evenGro :: Fun00 (VVar Z) -> Checking (Fun00 (VVar Z))
-    evenGro Constant0 = pure Constant0
+    evenGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
+    evenGro Constant0 = pure $ nConstant 0
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar e) | Just loc <- mine e -> loc -! do
-        -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
-        half <- traceChecking "makeHalf" makeHalf e
-        pure (StrictMonoFun (StrictMono 0 (Linear (VPar half))))
-      Full sm -> StrictMonoFun sm <$ demand0 (NumValue 0 (StrictMonoFun sm))
-    evenGro (StrictMonoFun (StrictMono n mono)) = pure (StrictMonoFun (StrictMono (n - 1) mono))
+      Linear (VPar e)
+        | Just loc <- mine e -> loc -! do
+          -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
+          half <- traceChecking "makeHalf" makeHalf e
+          pure (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar half)))))
+	| otherwise -> do
+	  mkYield "evenGro" (S.singleton e)
+	  nv <- quoteNum Zy <$> numEval S0 mono
+	  demandEven nv
+      Full sm -> nConstant 0 <$ demand0 (NumValue 0 (StrictMonoFun sm))
+    evenGro (StrictMonoFun (StrictMono n mono)) = pure (NumValue 0 (StrictMonoFun (StrictMono (n - 1) mono)))
 
     -- Check a numval is odd, and return its rounded down half
-    oddGro :: Fun00 (VVar Z) -> Checking (NumVal (VVar Z))
-    oddGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
-      Linear (VPar e)
-       | Just loc <- mine e -> loc -! do
-         pred <- traceChecking "makePred" makePred e
-         half <- traceChecking "makeHalf" makeHalf pred
-         pure (nVar (VPar half))
-       | otherwise -> do
-         mkYield "oddGro" (S.singleton e)
-         nv <- quoteNum Zy <$> numEval S0 mono
-         demandEven (nPlus 1 nv)
-      -- full(n + 1) = 1 + 2 * full(n)
-      -- hence, full(n) is the rounded down half
-      Full sm -> nFull <$> traceChecking "demandSucc" demandSucc sm
-    oddGro _ = err . UnificationError $ "Can't force " ++ show n ++ " to be even"
+    oddGro :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
+    oddGro x = do
+     pred <- demandSucc x
+     demandEven pred
\ No newline at end of file

From 376b2ccdd1f6026b2b466641f4e83e60c58b2efd Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 22 Apr 2025 17:18:41 +0100
Subject: [PATCH 132/182] fix bad debug printout

---
 brat/Brat/Checker/SolveHoles.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index e95e3a7d..7b9bf9a0 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -55,12 +55,12 @@ typeEq' :: String -- String representation of the term for error reporting
         -> Val n -- Expected
         -> Val n -- Actual
         -> Checking ()
-typeEq' str stuff@(_ny :* _ks :* sems) k exp act = do
+typeEq' str stuff@(ny :* _ks :* sems) k exp act = do
   mine <- mineToSolve
   exp <- sem sems exp
   act <- sem sems act
-  qexp <- (quote Zy exp)
-  qact <- (quote Zy act)
+  qexp <- (quote ny exp)
+  qact <- (quote ny act)
   trackM ("typeEq' exp: " ++ show qexp)
   trackM ("typeEq' act: " ++ show qact)
   typeEqEta str stuff mine k exp act

From 6bee95ac2101685730fcb8c62ac81e4a67672a14 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 14:50:38 +0100
Subject: [PATCH 133/182] Remove tracing in Checker.hs

---
 brat/Brat/Checker.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 1deb0da1..f93cfa9d 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -51,8 +51,6 @@ import Bwd
 import Hasochism
 import Util (zipSameLength)
 
-import Debug.Trace
-
 -- Put things into a standard form in a kind-directed manner, such that it is
 -- meaningful to do case analysis on them
 standardise :: TypeKind -> Val Z -> Checking (Val Z)

From b1a312dc89314977daa0637ea03a1dd1d6e2a4c8 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 16:49:03 +0100
Subject: [PATCH 134/182] Better handling of unifyNum special cases

---
 brat/Brat/Checker/SolveNumbers.hs | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 4ad334e4..e197b1c1 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -118,10 +118,17 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
     lhsFun00 (StrictMonoFun (StrictMono (n - 1) mono)) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
+  lhsMono (Linear (VPar e)) num | x <- mine e, trace ("lhsMono\n  " ++ show e ++ "\n  " ++ show num ++ "\n  " ++ show x) False = undefined
+  -- x = f(x) has 3 solutions, otherwise we should complain!
+  lhsMono lhs@(Linear (VPar e)) num | [e'] <- numVars num, e == e' = case num of
+    (NumValue 0 (StrictMonoFun sm)) -> case anyDoubsAnyFulls sm of
+      (True, _) -> lhsMono lhs (nConstant 0)
+      (False, True) -> mkYield "lhsMono2Sols" (S.singleton e) >>
+                       unifyNum mine (nVar (VPar e)) num
+      (False, False) -> pure ()
+    _ -> err . UnificationError $ "Can't make " ++ show e ++ " = " ++ show num
   lhsMono (Linear (VPar e)) num = case mine e of
-    Just loc -> do
-      throwLeft (doesntOccur e (VNum num))  -- too much?
-      loc -! solveNumMeta mine e num -- really?
+    Just loc -> loc -! solveNumMeta mine e num
     _ -> mkYield "lhsMono" (S.singleton e) >>
          unifyNum mine (nVar (VPar e)) num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
@@ -133,6 +140,10 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
     -- traceM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum mine (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
+  anyDoubsAnyFulls :: StrictMono (VVar Z) -> (Bool, Bool)
+  anyDoubsAnyFulls (StrictMono k (Full rest)) = let (ds,_) = anyDoubsAnyFulls rest in (k > 0 || ds, True)
+  anyDoubsAnyFulls (StrictMono k (Linear _)) = (k > 0, False)
+
   demand0 :: NumVal (VVar Z) -> Checking ()
   demand0 (NumValue 0 Constant0) = pure ()
   demand0 n@(NumValue 0 (StrictMonoFun (StrictMono _ mono))) = case mono of

From b780f757201517c24405da04a3c96af731db37f2 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 17:27:43 +0100
Subject: [PATCH 135/182] Add new dynamic when checking hope

---
 brat/Brat/Checker.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index f93cfa9d..d5e11fdf 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -696,7 +696,9 @@ check' Hope ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
                                               (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
     wire (dangling, kindType k, NamedPort bang "")
-    defineTgt tgt (endVal k (toEnd hungry))
+    defineTgt' "check hope (tgt)" tgt (endVal k (toEnd hungry))
+    defineSrc' "check hope (src)" dangling (endVal k (toEnd hungry))
+    req (ANewDynamic (toEnd hungry) fc)
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"

From 4b8302e59be2b4ea17d669aa4271171d4480511b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 17:48:24 +0100
Subject: [PATCH 136/182] Example file that exercises unifyNum + bugfix

---
 brat/Brat/Checker/SolveNumbers.hs | 11 ++++++-----
 brat/Brat/Eval.hs                 |  6 +++---
 brat/examples/vector_solve.brat   |  9 +++++++++
 3 files changed, 18 insertions(+), 8 deletions(-)
 create mode 100644 brat/examples/vector_solve.brat

diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index e197b1c1..8aa21d1c 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -38,10 +38,10 @@ solveNumMeta mine e nv = case (e, numVars nv) of
  (ExEnd src,  [InEnd _tgt]) -> do
    -- Compute the value of the `tgt` variable from the known `src` value by inverting nv
    tgtSrc <- invertNatVal nv
-   instantiateMeta (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
+   instantiateMeta "solveNumExIn" (ExEnd src) (VNum (nVar (VPar (toEnd tgtSrc))))
    wire (NamedPort src "", TNat, tgtSrc)
 
- (ExEnd src, _) -> instantiateMeta (ExEnd src) (VNum nv)
+ (ExEnd src, _) -> instantiateMeta "solveNumEx_" (ExEnd src) (VNum nv)
 
  -- Both targets, we need to create the thing that they both derive from
  (InEnd bigTgt, [InEnd weeTgt]) -> do
@@ -50,16 +50,17 @@ solveNumMeta mine e nv = case (e, numVars nv) of
      defineSrc idSrc (VNum (nVar (VPar (toEnd idTgt))))
      let nv' = fmap (const (VPar (toEnd idSrc))) nv -- weeTgt is the only thing to replace
      bigSrc <- buildNatVal nv'
-     instantiateMeta (InEnd bigTgt) (VNum nv')
+     nv' <- quoteNum Zy <$> numEval S0 nv'
+     instantiateMeta "solveNumInIn" (InEnd bigTgt) (VNum nv')
      wire (bigSrc, TNat, NamedPort bigTgt "")
      unifyNum mine (nVar (VPar (toEnd idSrc))) (nVar (VPar (toEnd weeTgt)))
-   
+
 
 
  -- RHS is constant or Src, wire it into tgt
  (InEnd tgt,  _) -> do
    src <- buildNatVal nv
-   instantiateMeta (InEnd tgt) (VNum nv)
+   instantiateMeta "solveNumIn_" (InEnd tgt) (VNum nv)
    wire (src, TNat, NamedPort tgt "")
 
 unifyNum :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index 7427c9bc..c6ddbed5 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -324,10 +324,10 @@ doesntOccur e (VFun my (ins :->> outs)) = case my of
   Kerny -> doesntOccurRo my e ins *> doesntOccurRo my e outs
 
 -- This should only be called after checking we have the right to solve the end
-instantiateMeta :: End -> Val Z -> Checking ()
-instantiateMeta e val = do
+instantiateMeta :: String -> End -> Val Z -> Checking ()
+instantiateMeta lbl e val = do
   throwLeft (doesntOccur e val)
-  defineEnd "instantiateMeta" e val
+  defineEnd (lbl ++ "->instantiateMeta") e val
 
 collision :: End -> End -> Either ErrorMsg ()
 collision e v | e == v = Left . UnificationError $
diff --git a/brat/examples/vector_solve.brat b/brat/examples/vector_solve.brat
new file mode 100644
index 00000000..ab5cc8f1
--- /dev/null
+++ b/brat/examples/vector_solve.brat
@@ -0,0 +1,9 @@
+sameLength(T :: *, n :: #, Vec(T, n), Vec(T, n)) -> (m :: #)
+sameLength(_, n, _, _) = n
+
+replicate(X :: *, n :: #, x :: X) -> Vec(X, n)
+replicate(_, 0, _) = []
+replicate(X, succ(n), x) = cons(x, replicate(X, n, x))
+
+foo :: (m :: #)
+foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
\ No newline at end of file

From e806bdb16bbd27e445f2abe52371c924ee04ebf2 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 17:49:53 +0100
Subject: [PATCH 137/182] Comments and fixups from partial review

---
 brat/Brat/Checker.hs              | 35 ++++++++++++++++++++-----------
 brat/Brat/Checker/Helpers.hs      |  3 +++
 brat/Brat/Checker/SolveHoles.hs   |  4 ++--
 brat/Brat/Checker/SolveNumbers.hs |  2 +-
 4 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index d5e11fdf..bd0b3e76 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -112,6 +112,8 @@ type CheckConstraints m k =
   ,CombineInputs (Inputs m KVerb)
   )
 
+-- We're assuming that checkWire is being called in its own fork
+-- (it's only called from checkIO)
 checkWire :: Modey m
           -> WC (Term d k) -- The term (for error reporting)
           -> Bool -- Is the "Src" node the expected one?
@@ -344,10 +346,15 @@ check' (Th tm) ((), u@(hungry, ty):unders) = case (?my, ty) of
           (overs, _) -> err (ThunkLeftOvers (showRow overs))
     pure dangling
 check' (TypedTh t) ((), ()) = case ?my of
-  -- the thunk itself must be Braty
+  -- the thunk itself must be Braty...
   Kerny -> err . ThunkInKernel $ show (TypedTh t)
   Braty -> do
-    -- but the computation in it could be either Brat or Kern
+    -- ...but the computation in it could be either Brat or Kern
+    --
+    -- FIXME: We only want to use one of these branches - any definitions made
+    -- by the other branch should be undone!
+    -- Possibly fix by snapshotting the state of the Checking monad, and being
+    -- biased as to which Mode we prefer.
     brat <- catchErr $ check t ((), ())
     kern <- catchErr $ let ?my = Kerny in check t ((), ())
     case (brat, kern) of
@@ -367,10 +374,10 @@ check' (TypedTh t) ((), ()) = case ?my of
     Some (ez :* inR) <- mkArgRo ?my S0 (first (fmap toEnd) <$> ins)
     Some (_ :* outR) <- mkArgRo ?my ez (first (fmap toEnd) <$> outs)
     (thunkOut, ()) <- makeBox "thunk" (inR :->> outR) $
-        \(thOvers, thUnders) -> do
+        \(thOvers, thUnders) ->
           -- if these ensureEmpty's fail then its a bug!
-          checkInputs t thOvers ins >>= ensureEmpty "TypedTh inputs"
-          checkOutputs t thUnders outs >>= ensureEmpty "TypedTh outputs"
+          (checkInputs t thOvers ins >>= ensureEmpty "TypedTh inputs") *>
+          (checkOutputs t thUnders outs >>= ensureEmpty "TypedTh outputs")
     pure (((), [thunkOut]), ((), ()))
 check' (Force th) ((), ()) = do
   (((), outs), ((), ())) <- let ?my = Braty in check th ((), ())
@@ -400,10 +407,13 @@ check' (Arith op l r) ((), u@(hungry, ty):unders) = case (?my, ty) of
     let inRo = RPr ("left", ty) $ RPr ("right", ty) R0
     let outRo = RPr ("out", ty) R0
     (_, [lunders, runders], [(dangling, _)], _) <- next (show op) (ArithNode op) (S0, Some $ Zy :* S0) inRo outRo
-    (((), ()), ((), leftUnders)) <- check l ((), [lunders])
-    ensureEmpty "arith unders" leftUnders
-    (((), ()), ((), leftUnders)) <- check r ((), [runders])
-    ensureEmpty "arith unders" leftUnders
+    let lhs = do
+         (((), ()), ((), leftUnders)) <- check l ((), [lunders])
+         ensureEmpty "arith unders" leftUnders
+    let rhs = do
+         (((), ()), ((), leftUnders)) <- check r ((), [runders])
+         ensureEmpty "arith unders" leftUnders
+    () <$ lhs <* rhs
     wire (dangling, ty, hungry)
     pure (((), ()), ((), unders))
 check' (fun :$: arg) (overs, unders) = do
@@ -417,6 +427,7 @@ check' (fun :$: arg) (overs, unders) = do
                          ]
 check' (Let abs x y) conn = do
   (((), dangling), ((), ())) <- check x ((), ())
+  -- TODO: Get rid of this: only use of abstractAll - replace with SolvePatterns
   env <- abstractAll dangling (unWC abs)
   localEnv env $ check y conn
 check' (NHole (mnemonic, name)) connectors = do
@@ -476,8 +487,8 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
   aux my lup ty = do
     -- TODO: Use concurrency to avoid strictness - we don't have to work out that
     -- this is a VCon immediately.
-    VCon tycon tyargs <- track "In forked aux for check' Con" $ eval S0 ty
-    (CArgs pats nFree _ argTypeRo) <- track "forked aux doing lup" $ lup vcon tycon
+    VCon tycon tyargs <- awaitTypeDefinition ty
+    (CArgs pats nFree _ argTypeRo) <- lup vcon tycon
     -- Look for vectors to produce better error messages for mismatched lengths
     -- wrap <- detectVecErrors vcon tycon tyargs pats ty (Left tm)
     -- Get the kinds of type args
@@ -485,7 +496,6 @@ check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
     (_, ks) <- unzip <$> tlup (m, tycon)
     -- Turn `pats` into values for unification
     (varz, patVals) <- "$!" -! valPats2Val ks pats
-    trackM $ "problem: " ++ show tyargs ++ " =?= " ++ show patVals
     -- Create a unification problem between tyargs and the value versions of pats
     typeEq (show tycon) (TypeFor m []) (VCon tycon tyargs) (VCon tycon patVals)
     ty <- eval S0 ty
@@ -526,6 +536,7 @@ check' (Simple tm) ((), (hungry, ty):unders) = do
     -- No defining needed, so everything else can be unified
     _ -> do
       let vty = biType @m ty
+      vty <- awaitTypeDefinition vty
       simpleCheck ?my vty tm
       (_, _, [(dangling, _)], _) <- anext @m "const" (Const tm) (S0,Some (Zy :* S0))
                                      R0 (RPr ("value", vty) R0)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index b0201b6a..1caef1b0 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -729,6 +729,9 @@ mineToSolve :: Checking (End -> Maybe String)
 mineToSolve = allowedToSolve <$> whoAmI
 
 -- Don't call this on kinds
+-- Note: We can't really tell whether there's any prospect of the variable becoming
+-- defined - if we could we could give a better error when something that wont be
+-- defined is passed in.
 awaitTypeDefinition :: Val Z -> Checking (Val Z)
 awaitTypeDefinition ty = eval S0 ty >>= \case
   VApp (VPar e) _ -> mkYield "awaitTypeDefinition" (S.singleton e) >> awaitTypeDefinition ty
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 7b9bf9a0..65111551 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -59,8 +59,8 @@ typeEq' str stuff@(ny :* _ks :* sems) k exp act = do
   mine <- mineToSolve
   exp <- sem sems exp
   act <- sem sems act
-  qexp <- (quote ny exp)
-  qact <- (quote ny act)
+  qexp <- quote ny exp
+  qact <- quote ny act
   trackM ("typeEq' exp: " ++ show qexp)
   trackM ("typeEq' act: " ++ show qact)
   typeEqEta str stuff mine k exp act
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 8aa21d1c..9e52b4c5 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -196,7 +196,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
           -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
           half <- traceChecking "makeHalf" makeHalf e
           pure (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar half)))))
-	| otherwise -> do
+        | otherwise -> do
 	  mkYield "evenGro" (S.singleton e)
 	  nv <- quoteNum Zy <$> numEval S0 mono
 	  demandEven nv

From 44ba066f564171aff2d67e7e1046490118b5cd30 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 28 Apr 2025 17:52:40 +0100
Subject: [PATCH 138/182] New examples

---
 brat/examples/vector_solve.brat | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/brat/examples/vector_solve.brat b/brat/examples/vector_solve.brat
index ab5cc8f1..3ce60774 100644
--- a/brat/examples/vector_solve.brat
+++ b/brat/examples/vector_solve.brat
@@ -6,4 +6,18 @@ replicate(_, 0, _) = []
 replicate(X, succ(n), x) = cons(x, replicate(X, n, x))
 
 foo :: (m :: #)
-foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
\ No newline at end of file
+foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
+
+fullTree(T :: *, n :: #, Vec(T, n)) -> Vec(T, 2^n - 1)
+fullTree(_, _, []) = []
+fullTree(_, _, x ,- xs) = fullTree(!, !, xs) =, x ,= fullTree(!, !, xs)
+
+-- goo :: (m :: #)
+-- goo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs))
+
+hoo :: (n :: #), (m :: #)
+hoo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs), sameLength(Nat, !, xs, fullTree(!, !, xs))
+
+-- Smarter version, fails badly
+-- hoo2 :: (n :: #), (m :: #)
+-- hoo2 = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, xs =%= xs)

From d5ca556cbddb066dcd1338c11f8f2d7965edf264 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 29 Apr 2025 12:20:35 +0100
Subject: [PATCH 139/182] Tracing; bug hunting

---
 brat/Brat/Checker/Monad.hs      |  5 +++--
 brat/examples/vector_solve.brat | 12 ++++++------
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 36c41409..afd22ee4 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -83,7 +83,7 @@ mkFork :: String -> Free sig () -> Free sig ()
 mkFork d par = thTrace ("Forking " ++ d) $ Fork d par $ pure ()
 
 mkYield :: String -> S.Set End -> Free sig ()
-mkYield desc es = thTrace ("Yielding in " ++ desc ++ "\n  " ++ show es) $ Yield (AwaitingAny es) (\_ -> Ret ())
+mkYield desc es = thTrace ("Yielding in " ++ desc ++ "\n  " ++ show es) $ Yield (AwaitingAny es) (\_ -> trackM ("woke up " ++ desc) >> Ret ())
 
 -- Commands for synchronous operations
 data CheckingSig ty where
@@ -339,7 +339,8 @@ handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = sto
                   in handler (k news)
                      (ctx { store = st { valueMap = M.insert end v vm },
                                     dynamicSet = case M.lookup end (dynamicSet ctx) of
-                                      Just fc -> M.union
+                                      Just fc -> track ("Replace " ++ show end ++ " with " ++ show newDynamics) $
+                                                 M.union
                                                  (M.fromList (zip newDynamics (repeat fc)))
                                                  (M.delete end (dynamicSet ctx))
                                       Nothing -> dynamicSet ctx
diff --git a/brat/examples/vector_solve.brat b/brat/examples/vector_solve.brat
index 3ce60774..7156a387 100644
--- a/brat/examples/vector_solve.brat
+++ b/brat/examples/vector_solve.brat
@@ -5,8 +5,8 @@ replicate(X :: *, n :: #, x :: X) -> Vec(X, n)
 replicate(_, 0, _) = []
 replicate(X, succ(n), x) = cons(x, replicate(X, n, x))
 
-foo :: (m :: #)
-foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
+-- foo :: (m :: #)
+-- foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
 
 fullTree(T :: *, n :: #, Vec(T, n)) -> Vec(T, 2^n - 1)
 fullTree(_, _, []) = []
@@ -15,9 +15,9 @@ fullTree(_, _, x ,- xs) = fullTree(!, !, xs) =, x ,= fullTree(!, !, xs)
 -- goo :: (m :: #)
 -- goo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs))
 
-hoo :: (n :: #), (m :: #)
-hoo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs), sameLength(Nat, !, xs, fullTree(!, !, xs))
+-- hoo :: (n :: #), (m :: #)
+-- hoo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs), sameLength(Nat, !, xs, fullTree(!, !, xs))
 
 -- Smarter version, fails badly
--- hoo2 :: (n :: #), (m :: #)
--- hoo2 = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, xs =%= xs)
+hoo2 :: (n :: #), (m :: #)
+hoo2 = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, xs =%= xs)

From b440a416b8c1a3f2393070359b7c13fbb8d4e80d Mon Sep 17 00:00:00 2001
From: Conor McBride <conor.mcbride@Quirkafleeg.local>
Date: Tue, 29 Apr 2025 13:47:52 +0100
Subject: [PATCH 140/182] [ fix ] zonk after demandEven

---
 brat/Brat/Checker/Helpers.hs      |  4 ++--
 brat/Brat/Checker/Monad.hs        | 12 ++++++------
 brat/Brat/Checker/SolveNumbers.hs | 16 ++++++++--------
 brat/examples/vector_solve.brat   | 16 +++++++++-------
 4 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 1caef1b0..59b449c6 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -32,8 +32,8 @@ import Prelude hiding (last)
 
 import Debug.Trace
 
---trackPermission = const id
-trackPermission = trace
+trackPermission = const id
+--trackPermission = trace
 
 simpleCheck :: Modey m -> Val Z -> SimpleTerm -> Checking ()
 simpleCheck my ty tm = case (my, ty) of
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index afd22ee4..4e06bbf8 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -25,15 +25,15 @@ import qualified Data.Set as S
 import Debug.Trace
 
 -- Used for messages about thread forking / spawning
---thTrace = const id
-thTrace = trace
+thTrace = const id
+--thTrace = trace
 
 trackM :: Monad m => String -> m ()
---trackM = const (pure ())
-trackM = traceM
+trackM = const (pure ())
+--trackM = traceM
 
---track = const id
-track = trace
+track = const id
+--track = trace
 trackShowId x = track (show x) x
 
 -- Data for using a type alias. E.g.
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 9e52b4c5..9d876502 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -32,7 +32,7 @@ trail = const id
 -- We assume that the caller has done the occurs check and rules out trivial equations.
 -- The caller also must check we have the right to solve the End
 solveNumMeta :: (End -> Maybe String) -> End -> NumVal (VVar Z) -> Checking ()
-solveNumMeta _ e nv | trace ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
+solveNumMeta _ e nv | trail ("solveNumMeta " ++ show e ++ " " ++ show nv) False = undefined
 solveNumMeta mine e nv = case (e, numVars nv) of
  -- Compute the thing that the rhs should be based on the src, and instantiate src to that
  (ExEnd src,  [InEnd _tgt]) -> do
@@ -77,7 +77,7 @@ unifyNum mine nv0 nv1 = do
 -- Things which are dynamically unknown must be Tgts - information flows from Srcs
 -- ...But we don't need to do any wiring here, right?
 unifyNum' :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
--- unifyNum' a b | trace ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
+unifyNum' _ a b | trail ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
 unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
@@ -116,10 +116,10 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   lhsStrictMono (StrictMono 0 mono) num = lhsMono mono num
   lhsStrictMono (StrictMono n mono) num = do
     num <- traceChecking "lhsSM demandEven" demandEven num
-    lhsFun00 (StrictMonoFun (StrictMono (n - 1) mono)) num
+    unifyNum mine (NumValue 0 (StrictMonoFun (StrictMono (n - 1) mono))) num
 
   lhsMono :: Monotone (VVar Z) -> NumVal (VVar Z) -> Checking ()
-  lhsMono (Linear (VPar e)) num | x <- mine e, trace ("lhsMono\n  " ++ show e ++ "\n  " ++ show num ++ "\n  " ++ show x) False = undefined
+  lhsMono (Linear (VPar e)) num | x <- mine e, trail ("lhsMono\n  " ++ show e ++ "\n  " ++ show num ++ "\n  " ++ show x) False = undefined
   -- x = f(x) has 3 solutions, otherwise we should complain!
   lhsMono lhs@(Linear (VPar e)) num | [e'] <- numVars num, e == e' = case num of
     (NumValue 0 (StrictMonoFun sm)) -> case anyDoubsAnyFulls sm of
@@ -134,11 +134,11 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
          unifyNum mine (nVar (VPar e)) num
   lhsMono (Full sm) (NumValue 0 (StrictMonoFun (StrictMono 0 (Full sm'))))
     = lhsFun00 (StrictMonoFun sm) (NumValue 0 (StrictMonoFun sm'))
-  lhsMono m@(Full _) (NumValue 0 gro) = lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
+  lhsMono m@(Full _) (NumValue 0 gro) = trail "lhsMono swaps" $ lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
     smPred <- traceChecking "lhsMono demandSucc" demandSucc (NumValue 0 (StrictMonoFun sm))
     sm <- numEval S0 sm
-    -- traceM $ "succ now " ++ show (quoteNum Zy sm)
+    -- trailM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum mine (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
   anyDoubsAnyFulls :: StrictMono (VVar Z) -> (Bool, Bool)
@@ -178,7 +178,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   demandSucc (NumValue 0 (StrictMonoFun x@(StrictMono k (Full nPlus1)))) = do
     n <- traceChecking "demandSucc" demandSucc (NumValue 0 (StrictMonoFun nPlus1))
     -- foo <- numEval S0 x
-    -- traceM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
+    -- trailM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
     pure $ nPlus ((2 ^ k) - 1) $ n2PowTimes (k + 1) $ nFull n
   demandSucc n = err . UnificationError $ "Couldn't force " ++ show n ++ " to be a successor"
 
@@ -193,7 +193,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
     evenGro (StrictMonoFun (StrictMono 0 mono)) = case mono of
       Linear (VPar e)
         | Just loc <- mine e -> loc -! do
-          -- traceM $ "Calling makeHalf (" ++ show e ++ ")"
+          -- trailM $ "Calling makeHalf (" ++ show e ++ ")"
           half <- traceChecking "makeHalf" makeHalf e
           pure (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar half)))))
         | otherwise -> do
diff --git a/brat/examples/vector_solve.brat b/brat/examples/vector_solve.brat
index 7156a387..a145ba5c 100644
--- a/brat/examples/vector_solve.brat
+++ b/brat/examples/vector_solve.brat
@@ -5,8 +5,8 @@ replicate(X :: *, n :: #, x :: X) -> Vec(X, n)
 replicate(_, 0, _) = []
 replicate(X, succ(n), x) = cons(x, replicate(X, n, x))
 
--- foo :: (m :: #)
--- foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
+foo :: (m :: #)
+foo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs)
 
 fullTree(T :: *, n :: #, Vec(T, n)) -> Vec(T, 2^n - 1)
 fullTree(_, _, []) = []
@@ -15,9 +15,11 @@ fullTree(_, _, x ,- xs) = fullTree(!, !, xs) =, x ,= fullTree(!, !, xs)
 -- goo :: (m :: #)
 -- goo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs))
 
--- hoo :: (n :: #), (m :: #)
--- hoo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs), sameLength(Nat, !, xs, fullTree(!, !, xs))
+hoo :: (n :: #), (m :: #)
+hoo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, xs =%= xs), sameLength(Nat, !, xs, fullTree(!, !, xs))
 
--- Smarter version, fails badly
-hoo2 :: (n :: #), (m :: #)
-hoo2 = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, xs =%= xs)
+ioo :: (n :: #), (m :: #)
+ioo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, xs =%= xs)
+
+joo :: (n :: #), (m :: #)
+joo = let xs = replicate(Nat, !, 42) in sameLength(Nat, !, xs, fullTree(!, !, xs)), sameLength(Nat, !, xs, [5])

From 976032a48ddbebcf2b7f41eaa57f70376d96273b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 29 Apr 2025 13:56:41 +0100
Subject: [PATCH 141/182] Accept some golden values

---
 brat/test/golden/error/badvec3.brat.golden    |   2 +-
 .../error/fanin-dynamic-length.brat.golden    |   2 +-
 .../error/fanout-dynamic-length.brat.golden   |   2 +-
 brat/test/golden/error/kbadvec3.brat.golden   |   2 +-
 .../error/remaining-nat-hopes.brat.golden     |   2 +-
 .../golden/error/remaining_hopes.brat.golden  |   2 +-
 brat/test/golden/error/vec_length.brat.golden |   2 +-
 brat/test/golden/error/vectorise1.brat.golden |   2 +-
 brat/test/golden/error/vectorise3.brat.golden |   2 +-
 brat/test/golden/graph/cons.brat.graph        | 104 +++++---------
 brat/test/golden/graph/kernel.brat.graph      | 134 ++++++------------
 brat/test/golden/graph/list.brat.graph        |  64 +++------
 brat/test/golden/graph/num.brat.graph         |  16 +--
 brat/test/golden/graph/one.brat.graph         |   4 +-
 brat/test/golden/graph/pair.brat.graph        |  52 ++-----
 brat/test/golden/graph/two.brat.graph         |  14 +-
 brat/test/golden/graph/vec.brat.graph         |  98 +++++--------
 17 files changed, 176 insertions(+), 328 deletions(-)

diff --git a/brat/test/golden/error/badvec3.brat.golden b/brat/test/golden/error/badvec3.brat.golden
index a17674df..94b04131 100644
--- a/brat/test/golden/error/badvec3.brat.golden
+++ b/brat/test/golden/error/badvec3.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/badvec3.brat on line 2:
 v3 = cons(1, nil)
      ^^^^^^^^^^^^
 
-  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_v3_numpat2val_1 0 to be 0
+  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_v3_$rhs_check'Con_$!_numpat2val_1 0 to be 0
 
diff --git a/brat/test/golden/error/fanin-dynamic-length.brat.golden b/brat/test/golden/error/fanin-dynamic-length.brat.golden
index 89db10f5..6c2d87eb 100644
--- a/brat/test/golden/error/fanin-dynamic-length.brat.golden
+++ b/brat/test/golden/error/fanin-dynamic-length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/fanin-dynamic-length.brat on line 2:
 f(n) = { [\/] }
          ^^^^
 
-  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0
+  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_lambda.0_rhs/in_1 0
 
diff --git a/brat/test/golden/error/fanout-dynamic-length.brat.golden b/brat/test/golden/error/fanout-dynamic-length.brat.golden
index 1dfb522e..0de3978a 100644
--- a/brat/test/golden/error/fanout-dynamic-length.brat.golden
+++ b/brat/test/golden/error/fanout-dynamic-length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/fanout-dynamic-length.brat on line 2:
 f(n) = { [/\] }
          ^^^^
 
-  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0
+  Type error: Can't fanout a Vec with non-constant length: VPar Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_lambda.0_rhs/in_1 0
 
diff --git a/brat/test/golden/error/kbadvec3.brat.golden b/brat/test/golden/error/kbadvec3.brat.golden
index d8718593..aa22410d 100644
--- a/brat/test/golden/error/kbadvec3.brat.golden
+++ b/brat/test/golden/error/kbadvec3.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/kbadvec3.brat on line 2:
 constNil = { b => cons(1, nil) }
                   ^^^^^^^^^^^^
 
-  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_constNil_thunk_2_numpat2val_3 0 to be 0
+  Unification error: Couldn't force 1 + VPar In checking_check_defs_1_constNil_$rhs_check'Th_LambdaChk_7_checkClauses_1_$rhs_4_check'Con_$!_numpat2val_1 0 to be 0
 
diff --git a/brat/test/golden/error/remaining-nat-hopes.brat.golden b/brat/test/golden/error/remaining-nat-hopes.brat.golden
index a61124a9..c1737905 100644
--- a/brat/test/golden/error/remaining-nat-hopes.brat.golden
+++ b/brat/test/golden/error/remaining-nat-hopes.brat.golden
@@ -3,6 +3,6 @@ bad = let _ = read([]) in show(!)
                               ^^^
 
   Expected to work out values for these holes:
-    In checking_check_defs_1_bad_5_Eval_2 0
+    In checking_check_defs_1_bad_5_$rhs_$!_3 0
 
 
diff --git a/brat/test/golden/error/remaining_hopes.brat.golden b/brat/test/golden/error/remaining_hopes.brat.golden
index 50a11e1d..ff53a23a 100644
--- a/brat/test/golden/error/remaining_hopes.brat.golden
+++ b/brat/test/golden/error/remaining_hopes.brat.golden
@@ -3,6 +3,6 @@ g = f(!)
      ^^^
 
   Expected to work out values for these holes:
-    In checking_check_defs_1_g_3_Eval 0
+    In checking_check_defs_1_g_3_$rhs_$!_1 0
 
 
diff --git a/brat/test/golden/error/vec_length.brat.golden b/brat/test/golden/error/vec_length.brat.golden
index b8f5be01..3f99f4b5 100644
--- a/brat/test/golden/error/vec_length.brat.golden
+++ b/brat/test/golden/error/vec_length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/vec_length.brat on line 2:
 f(_, _, xs) = xs
               ^^
 
-  Unification error: Ex checking_check_defs_1_f_f.box_2_lambda_fake_source 1 is cyclic
+  Unification error: Can't make Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_$lhs_lambda.0_setup/in 1 = 1 + VPar Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_$lhs_lambda.0_setup/in 1
 
diff --git a/brat/test/golden/error/vectorise1.brat.golden b/brat/test/golden/error/vectorise1.brat.golden
index 78802548..48596e5b 100644
--- a/brat/test/golden/error/vectorise1.brat.golden
+++ b/brat/test/golden/error/vectorise1.brat.golden
@@ -2,7 +2,7 @@ Error in test/golden/error/vectorise1.brat on line 2:
 bad1(n) = (n of (1, 2.0)), (n of 3)
                            ^^^^^^^^
 
-  Type error: Got: Vector of length VPar Ex checking_check_defs_1_bad1_lambda_fake_source_3 0
+  Type error: Got: Vector of length VPar Ex checking_check_defs_1_bad1_$lhs_3_lambda_fake_source 0
 Expected: empty row
 
 
diff --git a/brat/test/golden/error/vectorise3.brat.golden b/brat/test/golden/error/vectorise3.brat.golden
index 221b90d5..7ad18984 100644
--- a/brat/test/golden/error/vectorise3.brat.golden
+++ b/brat/test/golden/error/vectorise3.brat.golden
@@ -3,5 +3,5 @@ f(_, _, n, f, xs) = (n of f)(xs)
                     ^^^^^^^^^^^^
 
   Type error: Expected function 「n」 of f() to consume all of its arguments (「xs」)
- but found leftovers: (b1 :: Vec(VApp VPar Ex checking_check_defs_1_f_lambda_fake_source_3 0 B0, VPar Ex checking_check_defs_1_f_lambda_fake_source_3 2))
+ but found leftovers: (b1 :: Vec(VApp VPar Ex checking_check_defs_1_f_$lhs_3_lambda_fake_source 0 B0, VPar Ex checking_check_defs_1_f_$lhs_3_lambda_fake_source 2))
 
diff --git a/brat/test/golden/graph/cons.brat.graph b/brat/test/golden/graph/cons.brat.graph
index 09a6cdb0..06981276 100644
--- a/brat/test/golden/graph/cons.brat.graph
+++ b/brat/test/golden/graph/cons.brat.graph
@@ -1,39 +1,25 @@
 Nodes:
-<<<<<<< HEAD
-(check_defs_1_three_2_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_three_2_check'Con_const_1,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_two_check'Con_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
-(check_defs_1_two_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_two_check'Con_check'Con_2_const_1,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_two_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_two_check'Con_const_1,BratNode (Const 1) [] [("value",Int)])
-=======
-(check_defs_1_three_1_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_three_1_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
-(check_defs_1_three_1_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_three_1_buildConst_5,BratNode (Const []) [] [("value",[])])
-(check_defs_1_three_1_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_three_1_const_7,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_three_1_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_three_1_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_two_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_two_buildConst_2,BratNode (Const 1) [] [("value",Nat)])
-(check_defs_1_two_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_two_buildConst_5,BratNode (Const []) [] [("value",[])])
-(check_defs_1_two_buildConst_10,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_two_buildConst_11,BratNode (Const []) [] [("value",[])])
-(check_defs_1_two_buildConst_15,BratNode (Const []) [] [("value",[])])
-(check_defs_1_two_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_two_cons_12,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_two_const_7,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_two_const_13,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_two_nil_16,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
-(check_defs_1_two_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_two_numpat2val_9,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_two_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_two_pat2val_8,BratNode Id [("",[])] [("",[])])
-(check_defs_1_two_pat2val_14,BratNode Id [("",[])] [("",[])])
->>>>>>> origin/just-nat-solving
+(check_defs_1_three_2_$rhs_check'Con_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_three_2_$rhs_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_three_2_$rhs_check'Con_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
+(check_defs_1_three_2_$rhs_check'Con_const_3,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_two_$rhs_check'Con_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_two_$rhs_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_check'Con_4_nil_2,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_const_3,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_two_$rhs_check'Con_check'Con_4_typeEqsTail_1_buildConst_1,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_two_$rhs_check'Con_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
+(check_defs_1_two_$rhs_check'Con_const_3,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_7,BratNode (Constructor Int) [] [("value",[])])
 (globals_Vec_1,BratNode (Constructor Vec) [("X",[]),("n",Nat)] [("value",[])])
@@ -44,42 +30,24 @@ Nodes:
 (globals_decl_9_three,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-<<<<<<< HEAD
-(Ex check_defs_1_three_2_check'Con_cons 0,Vec(Int, 3),In globals_decl_9_three 0)
-(Ex check_defs_1_three_2_check'Con_const_1 0,Int,In check_defs_1_three_2_check'Con_cons 0)
-(Ex check_defs_1_two_check'Con_check'Con_2_check'Con_2_nil 0,Vec(Int, 0),In check_defs_1_two_check'Con_check'Con_2_cons 1)
-(Ex check_defs_1_two_check'Con_check'Con_2_cons 0,Vec(Int, 1),In check_defs_1_two_check'Con_cons 1)
-(Ex check_defs_1_two_check'Con_check'Con_2_const_1 0,Int,In check_defs_1_two_check'Con_check'Con_2_cons 0)
-(Ex check_defs_1_two_check'Con_cons 0,Vec(Int, 2),In globals_decl_4_two 0)
-(Ex check_defs_1_two_check'Con_const_1 0,Int,In check_defs_1_two_check'Con_cons 0)
-=======
-(Ex check_defs_1_three_1_Add_3 0,Nat,In check_defs_1_three_1_numpat2val_1 0)
-(Ex check_defs_1_three_1_buildConst_2 0,Nat,In check_defs_1_three_1_Add_3 0)
-(Ex check_defs_1_three_1_buildConst_4 0,Nat,In check_defs_1_three_1_Add_3 1)
-(Ex check_defs_1_three_1_buildConst_5 0,[],In check_defs_1_three_1_pat2val 0)
-(Ex check_defs_1_three_1_cons_6 0,Vec(Int, 3),In globals_decl_9_three 0)
-(Ex check_defs_1_three_1_const_7 0,Int,In check_defs_1_three_1_cons_6 0)
-(Ex check_defs_1_two_Add_3 0,Nat,In check_defs_1_two_numpat2val_1 0)
-(Ex check_defs_1_two_buildConst_10 0,Nat,In check_defs_1_two_numpat2val_9 0)
-(Ex check_defs_1_two_buildConst_11 0,[],In check_defs_1_two_pat2val_8 0)
-(Ex check_defs_1_two_buildConst_15 0,[],In check_defs_1_two_pat2val_14 0)
-(Ex check_defs_1_two_buildConst_2 0,Nat,In check_defs_1_two_Add_3 0)
-(Ex check_defs_1_two_buildConst_4 0,Nat,In check_defs_1_two_Add_3 1)
-(Ex check_defs_1_two_buildConst_5 0,[],In check_defs_1_two_pat2val 0)
-(Ex check_defs_1_two_cons_12 0,Vec(Int, 1),In check_defs_1_two_cons_6 1)
-(Ex check_defs_1_two_cons_6 0,Vec(Int, 2),In globals_decl_4_two 0)
-(Ex check_defs_1_two_const_13 0,Int,In check_defs_1_two_cons_12 0)
-(Ex check_defs_1_two_const_7 0,Int,In check_defs_1_two_cons_6 0)
-(Ex check_defs_1_two_nil_16 0,Vec(Int, 0),In check_defs_1_two_cons_12 1)
->>>>>>> origin/just-nat-solving
+(Ex check_defs_1_three_2_$rhs_check'Con_cons_2 0,Vec(Int, 3),In globals_decl_9_three 0)
+(Ex check_defs_1_three_2_$rhs_check'Con_const_3 0,Int,In check_defs_1_three_2_$rhs_check'Con_cons_2 0)
+(Ex check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_three_2_$rhs_check'Con_$!_numpat2val_1 0)
+(Ex check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_three_2_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 1)
+(Ex check_defs_1_two_$rhs_check'Con_check'Con_4_check'Con_4_nil_2 0,Vec(Int, 0),In check_defs_1_two_$rhs_check'Con_check'Con_4_cons_2 1)
+(Ex check_defs_1_two_$rhs_check'Con_check'Con_4_cons_2 0,Vec(Int, 1),In check_defs_1_two_$rhs_check'Con_cons_2 1)
+(Ex check_defs_1_two_$rhs_check'Con_check'Con_4_const_3 0,Int,In check_defs_1_two_$rhs_check'Con_check'Con_4_cons_2 0)
+(Ex check_defs_1_two_$rhs_check'Con_check'Con_4_typeEqsTail_1_buildConst_1 0,Nat,In check_defs_1_two_$rhs_check'Con_check'Con_4_$!_numpat2val_1 0)
+(Ex check_defs_1_two_$rhs_check'Con_cons_2 0,Vec(Int, 2),In globals_decl_4_two 0)
+(Ex check_defs_1_two_$rhs_check'Con_const_3 0,Int,In check_defs_1_two_$rhs_check'Con_cons_2 0)
+(Ex check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_two_$rhs_check'Con_$!_numpat2val_1 0)
+(Ex check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_two_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 1)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Int_7 0,[],In globals_Vec_6 0)
 (Ex globals_Vec_1 0,[],In globals___kca_two 0)
 (Ex globals_Vec_6 0,[],In globals___kca_three_5 0)
 (Ex globals_const_3 0,Nat,In globals_Vec_1 1)
 (Ex globals_const_8 0,Nat,In globals_Vec_6 1)
-<<<<<<< HEAD
-(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_2_check'Con_cons 1)
-=======
-(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_1_cons_6 1)
->>>>>>> origin/just-nat-solving
+(Ex globals_decl_4_two 0,Vec(Int, 2),In check_defs_1_three_2_$rhs_check'Con_cons_2 1)
diff --git a/brat/test/golden/graph/kernel.brat.graph b/brat/test/golden/graph/kernel.brat.graph
index 9acf54b7..e918270f 100644
--- a/brat/test/golden/graph/kernel.brat.graph
+++ b/brat/test/golden/graph/kernel.brat.graph
@@ -1,53 +1,32 @@
 Nodes:
-<<<<<<< HEAD
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_nil_9,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
-(check_defs_1_id3_check'Th_LambdaChk_9_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
-(check_defs_1_id3_check'Th_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_check'Th_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_id3_check'Th_thunk/in check_defs_1_id3_check'Th_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-=======
-(check_defs_1_id3_thunk_3_lambda_32,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_thunk_3_lambda.0_setup/in_24 2, portName = "c1"},Qubit)]}),check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_30) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_5,BratNode (Const []) [] [("value",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_9,BratNode (Const 1) [] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_11,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_12,BratNode (Const []) [] [("value",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_16,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_17,BratNode (Const []) [] [("value",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_20,BratNode (Const []) [] [("value",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_nil_21,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_8,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_15,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_7,BratNode Id [("",[])] [("",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_14,BratNode Id [("",[])] [("",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_19,BratNode Id [("",[])] [("",[])])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/in_28,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_rhs/out_29,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_rhs_thunk_30,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 check_defs_1_id3_thunk_3_lambda.0_rhs/out_29) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_thunk_3_lambda.0_setup/in_24,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_thunk_3_lambda.0_setup/out_25,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_3_lambda.0_setup_thunk_26,BratNode (Box (fromList []) check_defs_1_id3_thunk_3_lambda.0_setup/in_24 check_defs_1_id3_thunk_3_lambda.0_setup/out_25) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
-(check_defs_1_id3_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
-(check_defs_1_id3_thunk_thunk_2,BratNode (Box (fromList []) check_defs_1_id3_thunk/in check_defs_1_id3_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
->>>>>>> origin/just-nat-solving
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2,KernelNode (Constructor nil) [] [("value",Vec(Qubit, 0))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_cons_2,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 0))] [("value",Vec(Qubit, 1))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_typeEqsTail_1_buildConst_1,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_cons_2,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 1))] [("value",Vec(Qubit, 2))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_cons_2,KernelNode (Constructor cons) [("head",Qubit),("tail",Vec(Qubit, 2))] [("value",Vec(Qubit, 3))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_buildConst,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
+(check_defs_1_id3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
+(check_defs_1_id3_$rhs_check'Th_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
+(check_defs_1_id3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_id3_$rhs_check'Th_thunk/in check_defs_1_id3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_3,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_4,BratNode (Constructor Qubit) [] [("value",[])])
@@ -57,44 +36,25 @@ Nodes:
 (globals_decl_9_id3,BratNode Id [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })] [("a1",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
 
 Wires:
-<<<<<<< HEAD
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 0,Vec(Qubit, 3),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 0,Vec(Qubit, 2),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 1)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 0,Vec(Qubit, 1),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 1)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_6 0)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 1,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_7 0)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 2,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 0)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_nil_9 0,Vec(Qubit, 0),In check_defs_1_id3_check'Th_LambdaChk_9_checkClauses_1_cons_8 1)
-(Ex check_defs_1_id3_check'Th_LambdaChk_9_lambda 0,Vec(Qubit, 3),In check_defs_1_id3_check'Th_thunk/out_1 0)
-(Ex check_defs_1_id3_check'Th_thunk/in 0,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 0)
-(Ex check_defs_1_id3_check'Th_thunk/in 1,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 1)
-(Ex check_defs_1_id3_check'Th_thunk/in 2,Qubit,In check_defs_1_id3_check'Th_LambdaChk_9_lambda 2)
-(Ex check_defs_1_id3_check'Th_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
-=======
-(Ex check_defs_1_id3_thunk/in 0,Qubit,In check_defs_1_id3_thunk_3_lambda_32 0)
-(Ex check_defs_1_id3_thunk/in 1,Qubit,In check_defs_1_id3_thunk_3_lambda_32 1)
-(Ex check_defs_1_id3_thunk/in 2,Qubit,In check_defs_1_id3_thunk_3_lambda_32 2)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 0,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 1,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs/in_28 2,Qubit,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_8 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_1 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_11 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_12 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_7 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_16 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_numpat2val_15 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_17 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_14 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_2 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_20 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val_19 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_4 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_3 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_5 0,[],In check_defs_1_id3_thunk_3_lambda.0_rhs_31_pat2val 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_buildConst_9 0,Nat,In check_defs_1_id3_thunk_3_lambda.0_rhs_31_Add_10 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 0,Vec(Qubit, 2),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 0,Vec(Qubit, 1),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_13 1)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_6 0,Vec(Qubit, 3),In check_defs_1_id3_thunk_3_lambda.0_rhs/out_29 0)
-(Ex check_defs_1_id3_thunk_3_lambda.0_rhs_31_nil_21 0,Vec(Qubit, 0),In check_defs_1_id3_thunk_3_lambda.0_rhs_31_cons_18 1)
-(Ex check_defs_1_id3_thunk_3_lambda_32 0,Vec(Qubit, 3),In check_defs_1_id3_thunk/out_1 0)
-(Ex check_defs_1_id3_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
->>>>>>> origin/just-nat-solving
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2 0,Vec(Qubit, 0),In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_cons_2 1)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_cons_2 0,Vec(Qubit, 1),In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_cons_2 1)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_typeEqsTail_1_buildConst_1 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_$!_numpat2val_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_cons_2 0,Vec(Qubit, 2),In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_cons_2 1)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_$!_numpat2val_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 1)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_cons_2 0,Vec(Qubit, 3),In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_$!_numpat2val_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_typeEqsTail_1_$!_1_Add_1 1)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 0,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_cons_2 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 1,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_cons_2 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 2,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_check'Con_check'Con_4_check'Con_4_cons_2 0)
+(Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda 0,Vec(Qubit, 3),In check_defs_1_id3_$rhs_check'Th_thunk/out_1 0)
+(Ex check_defs_1_id3_$rhs_check'Th_thunk/in 0,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda 0)
+(Ex check_defs_1_id3_$rhs_check'Th_thunk/in 1,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda 1)
+(Ex check_defs_1_id3_$rhs_check'Th_thunk/in 2,Qubit,In check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda 2)
+(Ex check_defs_1_id3_$rhs_check'Th_thunk_thunk_2 0,{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) },In globals_decl_9_id3 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_3 0,[],In globals___kcr__1 1)
 (Ex globals_Qubit_4 0,[],In globals___kcr__1 2)
diff --git a/brat/test/golden/graph/list.brat.graph b/brat/test/golden/graph/list.brat.graph
index 37c32309..fc6e7300 100644
--- a/brat/test/golden/graph/list.brat.graph
+++ b/brat/test/golden/graph/list.brat.graph
@@ -1,54 +1,26 @@
 Nodes:
-<<<<<<< HEAD
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",List(Int))])
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_const_1,BratNode (Const 3) [] [("value",Int)])
-(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_check'Con_check'Con_2_const_1,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_check'Con_const_1,BratNode (Const 1) [] [("value",Int)])
-=======
-(check_defs_1_xs_buildConst_1,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_5,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_9,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_13,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_cons_6,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_cons_10,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
-(check_defs_1_xs_const_3,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_const_7,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_const_11,BratNode (Const 3) [] [("value",Int)])
-(check_defs_1_xs_nil_14,BratNode (Constructor nil) [] [("value",List(Int))])
-(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_4,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_8,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_12,BratNode Id [("",[])] [("",[])])
->>>>>>> origin/just-nat-solving
+(check_defs_1_xs_$rhs_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2,BratNode (Constructor nil) [] [("value",List(Int))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_const_3,BratNode (Const 3) [] [("value",Int)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_const_3,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_$rhs_check'Con_cons_2,BratNode (Constructor cons) [("head",Int),("tail",List(Int))] [("value",List(Int))])
+(check_defs_1_xs_$rhs_check'Con_const_3,BratNode (Const 1) [] [("value",Int)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_List_1,BratNode (Constructor List) [("listValue",[])] [("value",[])])
 (globals_decl_3_xs,BratNode Id [("a1",List(Int))] [("a1",List(Int))])
 
 Wires:
-<<<<<<< HEAD
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil 0,List(Int),In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0,List(Int),In check_defs_1_xs_check'Con_check'Con_2_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_const_1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0)
-(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,List(Int),In check_defs_1_xs_check'Con_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_const_1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
-(Ex check_defs_1_xs_check'Con_cons 0,List(Int),In globals_decl_3_xs 0)
-(Ex check_defs_1_xs_check'Con_const_1 0,Int,In check_defs_1_xs_check'Con_cons 0)
-=======
-(Ex check_defs_1_xs_buildConst_1 0,[],In check_defs_1_xs_pat2val 0)
-(Ex check_defs_1_xs_buildConst_13 0,[],In check_defs_1_xs_pat2val_12 0)
-(Ex check_defs_1_xs_buildConst_5 0,[],In check_defs_1_xs_pat2val_4 0)
-(Ex check_defs_1_xs_buildConst_9 0,[],In check_defs_1_xs_pat2val_8 0)
-(Ex check_defs_1_xs_cons_10 0,List(Int),In check_defs_1_xs_cons_6 1)
-(Ex check_defs_1_xs_cons_2 0,List(Int),In globals_decl_3_xs 0)
-(Ex check_defs_1_xs_cons_6 0,List(Int),In check_defs_1_xs_cons_2 1)
-(Ex check_defs_1_xs_const_11 0,Int,In check_defs_1_xs_cons_10 0)
-(Ex check_defs_1_xs_const_3 0,Int,In check_defs_1_xs_cons_2 0)
-(Ex check_defs_1_xs_const_7 0,Int,In check_defs_1_xs_cons_6 0)
-(Ex check_defs_1_xs_nil_14 0,List(Int),In check_defs_1_xs_cons_10 1)
->>>>>>> origin/just-nat-solving
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2 0,List(Int),In check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 0,List(Int),In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0,List(Int),In check_defs_1_xs_$rhs_check'Con_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_cons_2 0,List(Int),In globals_decl_3_xs 0)
+(Ex check_defs_1_xs_$rhs_check'Con_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_cons_2 0)
 (Ex globals_Int_2 0,[],In globals_List_1 0)
 (Ex globals_List_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/num.brat.graph b/brat/test/golden/graph/num.brat.graph
index f5179c31..23ffb004 100644
--- a/brat/test/golden/graph/num.brat.graph
+++ b/brat/test/golden/graph/num.brat.graph
@@ -1,17 +1,17 @@
 Nodes:
-(check_defs_1_m_2_check'Con_const_1,BratNode (Const -3) [] [("value",Int)])
-(check_defs_1_m_2_check'Con_doub,BratNode (Constructor doub) [("value",Int)] [("value",Int)])
-(check_defs_1_n_check'Con_const_1,BratNode (Const 2) [] [("value",Nat)])
-(check_defs_1_n_check'Con_succ,BratNode (Constructor succ) [("value",Nat)] [("value",Nat)])
+(check_defs_1_m_2_$rhs_check'Con_const_2,BratNode (Const -3) [] [("value",Int)])
+(check_defs_1_m_2_$rhs_check'Con_doub_1,BratNode (Constructor doub) [("value",Int)] [("value",Int)])
+(check_defs_1_n_$rhs_check'Con_const_2,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_n_$rhs_check'Con_succ_1,BratNode (Constructor succ) [("value",Nat)] [("value",Nat)])
 (globals_Int_4,BratNode (Constructor Int) [] [("value",[])])
 (globals_Nat_1,BratNode (Constructor Nat) [] [("value",[])])
 (globals_decl_2_n,BratNode Id [("a1",Nat)] [("a1",Nat)])
 (globals_decl_5_m,BratNode Id [("a1",Int)] [("a1",Int)])
 
 Wires:
-(Ex check_defs_1_m_2_check'Con_const_1 0,Int,In check_defs_1_m_2_check'Con_doub 0)
-(Ex check_defs_1_m_2_check'Con_doub 0,Int,In globals_decl_5_m 0)
-(Ex check_defs_1_n_check'Con_const_1 0,Nat,In check_defs_1_n_check'Con_succ 0)
-(Ex check_defs_1_n_check'Con_succ 0,Nat,In globals_decl_2_n 0)
+(Ex check_defs_1_m_2_$rhs_check'Con_const_2 0,Int,In check_defs_1_m_2_$rhs_check'Con_doub_1 0)
+(Ex check_defs_1_m_2_$rhs_check'Con_doub_1 0,Int,In globals_decl_5_m 0)
+(Ex check_defs_1_n_$rhs_check'Con_const_2 0,Nat,In check_defs_1_n_$rhs_check'Con_succ_1 0)
+(Ex check_defs_1_n_$rhs_check'Con_succ_1 0,Nat,In globals_decl_2_n 0)
 (Ex globals_Int_4 0,[],In globals___kca_m_3 0)
 (Ex globals_Nat_1 0,[],In globals___kca_n 0)
diff --git a/brat/test/golden/graph/one.brat.graph b/brat/test/golden/graph/one.brat.graph
index 2a7e1081..29d4122f 100644
--- a/brat/test/golden/graph/one.brat.graph
+++ b/brat/test/golden/graph/one.brat.graph
@@ -1,8 +1,8 @@
 Nodes:
-(check_defs_1_one_const,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_one_$rhs_const,BratNode (Const 1) [] [("value",Int)])
 (globals_Int_1,BratNode (Constructor Int) [] [("value",[])])
 (globals_decl_2_one,BratNode Id [("n",Int)] [("n",Int)])
 
 Wires:
-(Ex check_defs_1_one_const 0,Int,In globals_decl_2_one 0)
+(Ex check_defs_1_one_$rhs_const 0,Int,In globals_decl_2_one 0)
 (Ex globals_Int_1 0,[],In globals___kca_one 0)
diff --git a/brat/test/golden/graph/pair.brat.graph b/brat/test/golden/graph/pair.brat.graph
index fec8b3a6..88e697ab 100644
--- a/brat/test/golden/graph/pair.brat.graph
+++ b/brat/test/golden/graph/pair.brat.graph
@@ -1,25 +1,13 @@
 Nodes:
-<<<<<<< HEAD
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_1_true,BratNode (Constructor true) [] [("value",Bool)])
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",[])])
-(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
-(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
-(check_defs_1_xs_check'Con_const_1,BratNode (Const 1) [] [("value",Int)])
-=======
-(check_defs_1_xs_buildConst_2,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_3,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_8,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_9,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_cons_4,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
-(check_defs_1_xs_cons_10,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
-(check_defs_1_xs_const_5,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_nil_12,BratNode (Constructor nil) [] [("value",[])])
-(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_1,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_6,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_7,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_true_11,BratNode (Constructor true) [] [("value",Bool)])
->>>>>>> origin/just-nat-solving
+(check_defs_1_xs_$rhs_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_$!_pat2val_1,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_pat2val_1,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_3_true_1,BratNode (Constructor true) [] [("value",Bool)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_nil_1,BratNode (Constructor nil) [] [("value",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Bool),("tail",[])] [("value",[Bool])])
+(check_defs_1_xs_$rhs_check'Con_cons_2,BratNode (Constructor cons) [("head",Int),("tail",[Bool])] [("value",[Int,Bool])])
+(check_defs_1_xs_$rhs_check'Con_const_3,BratNode (Const 1) [] [("value",Int)])
 (globals_Bool_4,BratNode (Constructor Bool) [] [("value",[])])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_cons_1,BratNode (Constructor cons) [("head",[]),("tail",[])] [("value",[])])
@@ -28,23 +16,11 @@ Nodes:
 (globals_nil_5,BratNode (Constructor nil) [] [("value",[])])
 
 Wires:
-<<<<<<< HEAD
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_1_true 0,Bool,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_nil 0,[],In check_defs_1_xs_check'Con_check'Con_2_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,[Bool],In check_defs_1_xs_check'Con_cons 1)
-(Ex check_defs_1_xs_check'Con_cons 0,[Int,Bool],In globals_decl_6_xs 0)
-(Ex check_defs_1_xs_check'Con_const_1 0,Int,In check_defs_1_xs_check'Con_cons 0)
-=======
-(Ex check_defs_1_xs_buildConst_2 0,[],In check_defs_1_xs_pat2val_1 0)
-(Ex check_defs_1_xs_buildConst_3 0,[],In check_defs_1_xs_pat2val 0)
-(Ex check_defs_1_xs_buildConst_8 0,[],In check_defs_1_xs_pat2val_7 0)
-(Ex check_defs_1_xs_buildConst_9 0,[],In check_defs_1_xs_pat2val_6 0)
-(Ex check_defs_1_xs_cons_10 0,[Bool],In check_defs_1_xs_cons_4 1)
-(Ex check_defs_1_xs_cons_4 0,[Int,Bool],In globals_decl_6_xs 0)
-(Ex check_defs_1_xs_const_5 0,Int,In check_defs_1_xs_cons_4 0)
-(Ex check_defs_1_xs_nil_12 0,[],In check_defs_1_xs_cons_10 1)
-(Ex check_defs_1_xs_true_11 0,Bool,In check_defs_1_xs_cons_10 0)
->>>>>>> origin/just-nat-solving
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_3_true_1 0,Bool,In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_nil_1 0,[],In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0,[Bool],In check_defs_1_xs_$rhs_check'Con_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_cons_2 0,[Int,Bool],In globals_decl_6_xs 0)
+(Ex check_defs_1_xs_$rhs_check'Con_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_cons_2 0)
 (Ex globals_Bool_4 0,[],In globals_cons_3 0)
 (Ex globals_Int_2 0,[],In globals_cons_1 0)
 (Ex globals_cons_1 0,[],In globals___kca_xs 0)
diff --git a/brat/test/golden/graph/two.brat.graph b/brat/test/golden/graph/two.brat.graph
index cdb6a0c8..1ae2fcc4 100644
--- a/brat/test/golden/graph/two.brat.graph
+++ b/brat/test/golden/graph/two.brat.graph
@@ -1,7 +1,7 @@
 Nodes:
-(check_defs_1_one_const,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_two_1_Eval,BratNode (Eval (Ex globals_prim_5_add 0)) [("a",Int),("b",Int)] [("c",Int)])
-(check_defs_1_two_1_const_1,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_one_$rhs_const,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_two_1_$rhs_Eval,BratNode (Eval (Ex globals_prim_5_add 0)) [("a",Int),("b",Int)] [("c",Int)])
+(check_defs_1_two_1_$rhs_const_1,BratNode (Const 1) [] [("value",Int)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_3,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_4,BratNode (Constructor Int) [] [("value",[])])
@@ -12,12 +12,12 @@ Nodes:
 (globals_prim_5_add,BratNode (Prim ("","add")) [] [("thunk",{ (a :: Int), (b :: Int) -> (c :: Int) })])
 
 Wires:
-(Ex check_defs_1_one_const 0,Int,In globals_decl_8_one 0)
-(Ex check_defs_1_two_1_Eval 0,Int,In globals_decl_11_two 0)
-(Ex check_defs_1_two_1_const_1 0,Int,In check_defs_1_two_1_Eval 0)
+(Ex check_defs_1_one_$rhs_const 0,Int,In globals_decl_8_one 0)
+(Ex check_defs_1_two_1_$rhs_Eval 0,Int,In globals_decl_11_two 0)
+(Ex check_defs_1_two_1_$rhs_const_1 0,Int,In check_defs_1_two_1_$rhs_Eval 0)
 (Ex globals_Int_10 0,[],In globals___kca_two_9 0)
 (Ex globals_Int_2 0,[],In globals___kcc_1 0)
 (Ex globals_Int_3 0,[],In globals___kcc_1 1)
 (Ex globals_Int_4 0,[],In globals___kcc_1 2)
 (Ex globals_Int_7 0,[],In globals___kca_one_6 0)
-(Ex globals_decl_8_one 0,Int,In check_defs_1_two_1_Eval 1)
+(Ex globals_decl_8_one 0,Int,In check_defs_1_two_1_$rhs_Eval 1)
diff --git a/brat/test/golden/graph/vec.brat.graph b/brat/test/golden/graph/vec.brat.graph
index d2493b4a..63d51b0b 100644
--- a/brat/test/golden/graph/vec.brat.graph
+++ b/brat/test/golden/graph/vec.brat.graph
@@ -1,73 +1,45 @@
 Nodes:
-<<<<<<< HEAD
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_xs_check'Con_check'Con_2_check'Con_2_const_1,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_check'Con_check'Con_2_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_xs_check'Con_check'Con_2_const_1,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_check'Con_cons,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_xs_check'Con_const_1,BratNode (Const 0) [] [("value",Int)])
-=======
-(check_defs_1_xs_Add_3,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_xs_Add_11,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
-(check_defs_1_xs_buildConst_2,BratNode (Const 2) [] [("value",Nat)])
-(check_defs_1_xs_buildConst_4,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_xs_buildConst_5,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_10,BratNode (Const 1) [] [("value",Nat)])
-(check_defs_1_xs_buildConst_12,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_xs_buildConst_13,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_18,BratNode (Const 0) [] [("value",Nat)])
-(check_defs_1_xs_buildConst_19,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_buildConst_23,BratNode (Const []) [] [("value",[])])
-(check_defs_1_xs_cons_6,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
-(check_defs_1_xs_cons_14,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
-(check_defs_1_xs_cons_20,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
-(check_defs_1_xs_const_7,BratNode (Const 0) [] [("value",Int)])
-(check_defs_1_xs_const_15,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_xs_const_21,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_xs_nil_24,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
-(check_defs_1_xs_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_xs_numpat2val_9,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_xs_numpat2val_17,BratNode Id [("",Nat)] [("",Nat)])
-(check_defs_1_xs_pat2val,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_8,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_16,BratNode Id [("",[])] [("",[])])
-(check_defs_1_xs_pat2val_22,BratNode Id [("",[])] [("",[])])
->>>>>>> origin/just-nat-solving
+(check_defs_1_xs_$rhs_check'Con_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_$rhs_check'Con_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_$!_numpat2val_1,BratNode Id [("",Nat)] [("",Nat)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_$!_pat2val,BratNode Id [("",[])] [("",[])])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2,BratNode (Constructor nil) [] [("value",Vec(Int, 0))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 0))] [("value",Vec(Int, 1))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_const_3,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_typeEqsTail_1_buildConst_1,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 1))] [("value",Vec(Int, 2))])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_const_3,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst,BratNode (Const 1) [] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_cons_2,BratNode (Constructor cons) [("head",Int),("tail",Vec(Int, 2))] [("value",Vec(Int, 3))])
+(check_defs_1_xs_$rhs_check'Con_const_3,BratNode (Const 0) [] [("value",Int)])
+(check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1,BratNode (ArithNode Add) [("lhs",Nat),("rhs",Nat)] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst,BratNode (Const 2) [] [("value",Nat)])
+(check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2,BratNode (Const 0) [] [("value",Nat)])
 (globals_Int_2,BratNode (Constructor Int) [] [("value",[])])
 (globals_Vec_1,BratNode (Constructor Vec) [("X",[]),("n",Nat)] [("value",[])])
 (globals_const_3,BratNode (Const 3) [] [("value",Nat)])
 (globals_decl_4_xs,BratNode Id [("a1",Vec(Int, 3))] [("a1",Vec(Int, 3))])
 
 Wires:
-<<<<<<< HEAD
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_check'Con_2_nil 0,Vec(Int, 0),In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0,Vec(Int, 1),In check_defs_1_xs_check'Con_check'Con_2_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_check'Con_2_const_1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_check'Con_2_cons 0)
-(Ex check_defs_1_xs_check'Con_check'Con_2_cons 0,Vec(Int, 2),In check_defs_1_xs_check'Con_cons 1)
-(Ex check_defs_1_xs_check'Con_check'Con_2_const_1 0,Int,In check_defs_1_xs_check'Con_check'Con_2_cons 0)
-(Ex check_defs_1_xs_check'Con_cons 0,Vec(Int, 3),In globals_decl_4_xs 0)
-(Ex check_defs_1_xs_check'Con_const_1 0,Int,In check_defs_1_xs_check'Con_cons 0)
-=======
-(Ex check_defs_1_xs_Add_11 0,Nat,In check_defs_1_xs_numpat2val_9 0)
-(Ex check_defs_1_xs_Add_3 0,Nat,In check_defs_1_xs_numpat2val_1 0)
-(Ex check_defs_1_xs_buildConst_10 0,Nat,In check_defs_1_xs_Add_11 0)
-(Ex check_defs_1_xs_buildConst_12 0,Nat,In check_defs_1_xs_Add_11 1)
-(Ex check_defs_1_xs_buildConst_13 0,[],In check_defs_1_xs_pat2val_8 0)
-(Ex check_defs_1_xs_buildConst_18 0,Nat,In check_defs_1_xs_numpat2val_17 0)
-(Ex check_defs_1_xs_buildConst_19 0,[],In check_defs_1_xs_pat2val_16 0)
-(Ex check_defs_1_xs_buildConst_2 0,Nat,In check_defs_1_xs_Add_3 0)
-(Ex check_defs_1_xs_buildConst_23 0,[],In check_defs_1_xs_pat2val_22 0)
-(Ex check_defs_1_xs_buildConst_4 0,Nat,In check_defs_1_xs_Add_3 1)
-(Ex check_defs_1_xs_buildConst_5 0,[],In check_defs_1_xs_pat2val 0)
-(Ex check_defs_1_xs_cons_14 0,Vec(Int, 2),In check_defs_1_xs_cons_6 1)
-(Ex check_defs_1_xs_cons_20 0,Vec(Int, 1),In check_defs_1_xs_cons_14 1)
-(Ex check_defs_1_xs_cons_6 0,Vec(Int, 3),In globals_decl_4_xs 0)
-(Ex check_defs_1_xs_const_15 0,Int,In check_defs_1_xs_cons_14 0)
-(Ex check_defs_1_xs_const_21 0,Int,In check_defs_1_xs_cons_20 0)
-(Ex check_defs_1_xs_const_7 0,Int,In check_defs_1_xs_cons_6 0)
-(Ex check_defs_1_xs_nil_24 0,Vec(Int, 0),In check_defs_1_xs_cons_20 1)
->>>>>>> origin/just-nat-solving
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_check'Con_4_nil_2 0,Vec(Int, 0),In check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 0,Vec(Int, 1),In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_typeEqsTail_1_buildConst_1 0,Nat,In check_defs_1_xs_$rhs_check'Con_check'Con_4_check'Con_4_$!_numpat2val_1 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0,Vec(Int, 2),In check_defs_1_xs_$rhs_check'Con_cons_2 1)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_check'Con_4_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_xs_$rhs_check'Con_check'Con_4_$!_numpat2val_1 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_xs_$rhs_check'Con_check'Con_4_typeEqsTail_1_$!_1_Add_1 1)
+(Ex check_defs_1_xs_$rhs_check'Con_cons_2 0,Vec(Int, 3),In globals_decl_4_xs 0)
+(Ex check_defs_1_xs_$rhs_check'Con_const_3 0,Int,In check_defs_1_xs_$rhs_check'Con_cons_2 0)
+(Ex check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0,Nat,In check_defs_1_xs_$rhs_check'Con_$!_numpat2val_1 0)
+(Ex check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst 0,Nat,In check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 0)
+(Ex check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_buildConst_2 0,Nat,In check_defs_1_xs_$rhs_check'Con_typeEqsTail_1_$!_1_Add_1 1)
 (Ex globals_Int_2 0,[],In globals_Vec_1 0)
 (Ex globals_Vec_1 0,[],In globals___kca_xs 0)
 (Ex globals_const_3 0,Nat,In globals_Vec_1 1)

From b891eb20f6b319996ada7f6dbb3d38b6266dc5d1 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 1 Dec 2025 10:31:01 +0000
Subject: [PATCH 142/182] Add some metadata to hugr for ad hoc debugging

---
 brat/Brat/Compile/Hugr.hs | 74 +++++++++++++++++++++------------------
 brat/Data/Hugr.hs         | 41 +++++++++++++++++-----
 2 files changed, 71 insertions(+), 44 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 8706ca5b..7d5d16ca 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -109,7 +109,7 @@ addEdge e = do
 addNode :: String -> HugrOp NodeId -> Compile NodeId
 addNode name op = do
   id <- freshNode name
-  addOp op id
+  addOp (addMetadata [("id", show id)] op) id
   pure id
 
 type Compile = State CompilationState
@@ -228,7 +228,11 @@ compileArithNode parent op TFloat  = addNode (show op ++ "_Float") $ OpCustom $
 compileArithNode _ _ ty = error $ "compileArithNode: Unexpected type " ++ show ty
 
 renameAndSortHugr :: M.Map NodeId (HugrOp NodeId) -> [(PortId NodeId, PortId NodeId)] -> Hugr Int
-renameAndSortHugr nodes edges = fmap update (Hugr (fst <$> sorted_nodes) (edges ++ orderEdges)) where
+renameAndSortHugr nodes edges = indexMetadata $ fmap update (Hugr (fst <$> sorted_nodes) (edges ++ orderEdges)) where
+  indexMetadata :: Hugr Int -> Hugr Int
+  indexMetadata (Hugr ops edges) = Hugr [addMetadata [("index", show ix)] op | (ix, op) <- zip [0..] ops] edges
+
+
   sorted_nodes = let ([root], rest) = partition (\(n, nid) -> nid == getParent n) (swap <$> M.assocs nodes) in
                    root : sort rest
 
@@ -286,9 +290,9 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   testResult <- compileMatchSequence parent portTbl matchSeq
 
   -- Feed the test result into a conditional
-  makeConditional parent testResult [] [("didntMatch", didntMatch outTys)
-                                       ,("didMatch", didMatch outTys)
-                                       ]
+  makeConditional ("clause of " ++ show rhs) parent testResult [] [("didntMatch", didntMatch outTys)
+                                                                  ,("didMatch", didMatch outTys)
+                                                                  ]
  where
   didntMatch :: [HugrType] -> NodeId -> [TypedPort] -> Compile [TypedPort]
   didntMatch outTys parent ins = case nonEmpty clauses of
@@ -300,7 +304,7 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   didMatch :: [HugrType] -> NodeId -> [TypedPort] -> Compile [TypedPort]
   didMatch outTys parent ins = gets bratGraph >>= \(ns,_) -> case ns M.! rhs of
     BratNode (Box src tgt) _ _ -> do
-      dfgId <- addNode "DidMatch_DFG" (OpDFG (DFG parent (FunctionType (snd <$> ins) outTys bratExts)))
+      dfgId <- addNode "DidMatch_DFG" (OpDFG (DFG parent (FunctionType (snd <$> ins) outTys bratExts) []))
       compileBox (src, tgt) dfgId
       for_ (zip (fst <$> ins) (Port dfgId <$> [0..])) addEdge
       pure $ zip (Port dfgId <$> [0..]) outTys
@@ -399,13 +403,14 @@ compileWithInputs parent name = gets compiled >>= (\case
     Prim (ext,op) -> do
       let n = ext ++ ('_':op)
       let [] = ins
+      -- TODO: Handle primitives which aren't functions
       let [(_, VFun Braty cty)] = outs
       boxSig@(inputTys, outputTys) <- compileSig Braty cty
       let boxFunTy = FunctionType inputTys outputTys bratExts
       ((Port loadConst _, _ty), ()) <- compileConstDfg parent n boxSig $ \dfgId -> do
-        ins <- addNodeWithInputs ("Inputs" ++ n) (OpIn (InputNode dfgId inputTys)) [] inputTys
+        ins <- addNodeWithInputs ("Inputs" ++ n) (OpIn (InputNode dfgId inputTys [("source", "Prim")])) [] inputTys
         outs <- addNodeWithInputs n (OpCustom (CustomOp dfgId ext op boxFunTy [])) ins outputTys
-        addNodeWithInputs ("Outputs" ++ n) (OpOut (OutputNode dfgId outputTys)) outs []
+        addNodeWithInputs ("Outputs" ++ n) (OpOut (OutputNode dfgId outputTys [("source", "Prim")])) outs []
         pure ()
       pure $ default_edges loadConst
 
@@ -455,10 +460,10 @@ compileWithInputs parent name = gets compiled >>= (\case
 
     Source -> default_edges <$> do
       outs <- compilePorts outs
-      addNode "Input" (OpIn (InputNode parent outs))
+      addNode "Input" (OpIn (InputNode parent outs [("source", "Source"), ("parent", show parent)]))
     Target -> default_edges <$> do
       ins <- compilePorts ins
-      addNode "Output" (OpOut (OutputNode parent ins))
+      addNode "Output" (OpOut (OutputNode parent ins [("source", "Target")]))
 
     Id | Nothing <- hasPrefix ["checking", "globals", "decl"] name -> default_edges <$> do
       -- not a top-level decl, just compile it as an Id (TLDs handled in compileNode)
@@ -474,10 +479,10 @@ compileWithInputs parent name = gets compiled >>= (\case
     PatternMatch cs -> default_edges <$> do
       ins <- compilePorts ins
       outs <- compilePorts outs
-      dfgId <- addNode "DidMatch_DFG" (OpDFG (DFG parent (FunctionType ins outs bratExts)))
-      inputNode <- addNode "PatternMatch.Input" (OpIn (InputNode dfgId ins))
+      dfgId <- addNode "DidMatch_DFG" (OpDFG (DFG parent (FunctionType ins outs bratExts) []))
+      inputNode <- addNode "PatternMatch.Input" (OpIn (InputNode dfgId ins [("source", "PatternMatch"), ("parent", show dfgId)]))
       ccOuts <- compileClauses dfgId (zip (Port inputNode <$> [0..]) ins) cs
-      addNodeWithInputs "PatternMatch.Output" (OpOut (OutputNode dfgId (snd <$> ccOuts))) ccOuts []
+      addNodeWithInputs "PatternMatch.Output" (OpOut (OutputNode dfgId (snd <$> ccOuts)  [("source", "PatternMatch"), ("parent", show dfgId)])) ccOuts []
       pure dfgId
     ArithNode op -> default_edges <$> compileArithNode parent op (snd $ head ins)
     Selector _c -> error "Todo: selector"
@@ -495,7 +500,7 @@ compileConstructor parent tycon con sig
       -- A boolean value is a tag which takes no inputs and produces an empty tuple
       -- This is the same thing that happens in Brat.Checker.Clauses to make the
       -- discriminator (makeRowTag)
-      addNode "bool.tag" (OpTag (TagOp parent (if b then 1 else 0) [[], []]))
+      addNode "bool.tag" (OpTag (TagOp parent (if b then 1 else 0) [[], []] [("hint", "bool")]))
   | otherwise = let name = "Constructor " ++ show tycon ++ "::" ++ show con in
                   addNode name (constructorOp parent tycon con sig)
  where
@@ -532,7 +537,7 @@ compileConstDfg parent desc (inTys, outTys) contents = do
       dfg_id <- freshNode ("Box_" ++ show desc)
       a <- contents dfg_id
       let funTy = FunctionType inTys outTys bratExts
-      addOp (OpDFG $ DFG dfg_id funTy) dfg_id
+      addOp (OpDFG $ DFG dfg_id funTy []) dfg_id
       pure (funTy, a)
   let nestedHugr = renameAndSortHugr (nodes cs) (edges cs)
   let ht = HTFunc $ PolyFuncType [] funTy
@@ -559,7 +564,7 @@ compileBratBox parent name (venv, src, tgt) cty = do
   let boxInnerSig = FunctionType allInputTys outputTys bratExts
 
   (templatePort, _) <- compileConstDfg parent ("BB" ++ show name) (allInputTys, outputTys) $ \dfgId -> do
-    src_id <- addNode ("LiftedCapturesInputs" ++ show name) (OpIn (InputNode dfgId allInputTys))
+    src_id <- addNode ("LiftedCapturesInputs" ++ show name) (OpIn (InputNode dfgId allInputTys [("source", "compileBratBox")]))
     -- Now map ports in the BRAT Graph to their Hugr equivalents.
           -- Each captured value is read from an element of src_id, starting from 0
     let lifted = [(src, Port src_id i) | ((src, _ty), i) <- zip params [0..]]
@@ -631,12 +636,12 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
       testResult <- compilePrimTest parent typedPort primTest
       let testIx = length left
       let remainingMatchTests = MatchSequence (primTestOuts primTest ++ (second snd <$> others)) tests matchOutputs
-      ports <- makeConditional parent testResult (snd <$> others)
+      ports <- makeConditional ("matching " ++ show (src, primTest)) parent testResult (snd <$> others)
                [("didNotMatch", didNotMatchCase testIx sumTy)
                ,("didMatch",    didMatchCase testIx (primTest, snd typedPort) remainingMatchTests sumTy)]
       case ports of
-        [port] -> pure port
-        _ -> error "Expected exactly one output port from makeConditional"
+        (port:_) -> pure port
+        _ -> error $ "Expected at least one output port from makeConditional: got\n  " ++ show ports
 
     [] -> do
       -- Reorder into `matchOutputs` order
@@ -662,7 +667,7 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
     -- Remember which port a src corresponds to
     let portTable = zip (fst <$> matchInputs) ins
     didAllTestsSucceed <- compileMatchSequence parent portTable ms
-    makeConditional parent didAllTestsSucceed []
+    makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed []
       [("Undo", undo)
       ,("AllMatched", allMatched)
       ]
@@ -697,8 +702,8 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
     makeRowTag "DidNotMatch" parent 0 sumTy ins
 
 makeRowTag :: String -> NodeId -> Int -> SumOfRows -> [TypedPort] -> Compile [TypedPort]
-makeRowTag hint parent tag sor@(SoR sumRows) ins = assert (sumRows !! tag == (snd <$> ins)) $
-  addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows)) ins [compileSumOfRows sor]
+makeRowTag hint parent tag sor@(SoR sumRows) ins = assert (sumRows !! tag == (snd <$> ins)) $ do
+  addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!0))])) ins [compileSumOfRows sor]
 
 getSumVariants :: HugrType -> [[HugrType]]
 getSumVariants (HTSum (SU (UnitSum n))) = replicate n []
@@ -716,19 +721,20 @@ addNodeWithInputs name op inWires outTys = do
   for_ (zip (fst <$> inWires) (Port nodeId <$> [0..])) addEdge
   pure $ zip (Port nodeId <$> [0..]) outTys
 
-makeConditional :: NodeId    -- Parent node id
+makeConditional :: String    -- Label
+                -> NodeId    -- Parent node id
                 -> TypedPort -- The discriminator
                 -> [TypedPort] -- Other inputs
                 -> [(String, NodeId -> [TypedPort] -> Compile [TypedPort])] -- Must be ordered
                 -> Compile [TypedPort]
-makeConditional parent discrim otherInputs cases = do
+makeConditional lbl parent discrim otherInputs cases = do
   condId <- freshNode "Conditional"
   let rows = getSumVariants (snd discrim)
   outTyss <- for (zip (zip [0..] cases) rows) (\((ix, (name, f)), row) -> makeCase condId name ix (row ++ (snd <$> otherInputs)) f)
   unless
     (allRowsEqual outTyss)
     (error "Conditional output types didn't match")
-  let condOp = OpConditional (Conditional parent rows (snd <$> otherInputs) (head outTyss))
+  let condOp = OpConditional (Conditional parent rows (snd <$> otherInputs) (head outTyss) [("label", lbl)])
   addOp condOp condId
   addEdge (fst discrim, Port condId 0)
   traverse_ addEdge (zip (fst <$> otherInputs) (Port condId <$> [1..]))
@@ -737,14 +743,12 @@ makeConditional parent discrim otherInputs cases = do
   makeCase :: NodeId -> String -> Int -> [HugrType] -> (NodeId -> [TypedPort] -> Compile [TypedPort]) -> Compile [HugrType]
   makeCase parent name ix tys f = do
     caseId <- freshNode name
-    inpId <- addNode ("Input_" ++ name) (OpIn (InputNode caseId tys))
+    inpId <- addNode ("Input_" ++ name) (OpIn (InputNode caseId tys [("source", "makeCase." ++ show ix), ("context", lbl ++ "/" ++ name), ("parent", show parent)]))
     outs <- f caseId (zipWith (\offset ty -> (Port inpId offset, ty)) [0..] tys)
     let outTys = snd <$> outs
-
-    outId <- addNode ("Output" ++ name) (OpOut (OutputNode caseId outTys))
+    outId <- addNode ("Output" ++ name) (OpOut (OutputNode caseId outTys [("source", "makeCase")]))
     for_ (zip (fst <$> outs) (Port outId <$> [0..])) addEdge
-
-    addOp (OpCase (ix, Case parent (FunctionType tys outTys bratExts))) caseId
+    addOp (OpCase (ix, Case parent (FunctionType tys outTys bratExts) [("name",lbl ++ "/" ++ name)])) caseId
     pure outTys
 
   allRowsEqual :: [[HugrType]] -> Bool
@@ -812,7 +816,7 @@ compileModule venv = do
   -- to compute its value.
   bodies <- for decls (\(fnName, idNode) -> do
     (funTy, extra_call, body) <- analyseDecl idNode
-    defNode <- addNode (show fnName ++ "_def") (OpDefn $ FuncDefn moduleNode (show fnName) funTy)
+    defNode <- addNode (show fnName ++ "_def") (OpDefn $ FuncDefn moduleNode (show fnName) funTy [])
     registerFuncDef idNode (defNode, extra_call)
     pure (body defNode)
     )
@@ -857,8 +861,8 @@ compileModule venv = do
 
   withIO :: NodeId -> HugrType -> Compile TypedPort -> Compile ()
   withIO parent output c = do
-    addNode "input" (OpIn (InputNode parent []))
-    output <- addNode "output" (OpOut (OutputNode parent [output]))
+    addNode "input" (OpIn (InputNode parent [] [("source", "analyseDecl")]))
+    output <- addNode "output" (OpOut (OutputNode parent [output] [("source", "analyseDecl")]))
     wire <- c
     addEdge (fst wire, Port output 0)
 
@@ -882,8 +886,8 @@ compileModule venv = do
 
 compileNoun :: [HugrType] -> [OutPort] -> NodeId -> Compile ()
 compileNoun outs srcPorts parent = do
-  addNode "input" (OpIn (InputNode parent []))
-  output <- addNode "output" (OpOut (OutputNode parent outs))
+  addNode "input" (OpIn (InputNode parent [] [("source", "compileNoun")]))
+  output <- addNode "output" (OpOut (OutputNode parent outs [("source", "compileNoun")]))
   for_ (zip [0..] srcPorts) (\(outport, Ex src srcPort) ->
     compileWithInputs parent src >>= \case
       Just nodeId -> addEdge (Port nodeId srcPort, Port output outport) $> ()
diff --git a/brat/Data/Hugr.hs b/brat/Data/Hugr.hs
index f3bb8075..d08e6418 100644
--- a/brat/Data/Hugr.hs
+++ b/brat/Data/Hugr.hs
@@ -239,6 +239,7 @@ data FuncDefn node = FuncDefn
  { parent :: node
  , name :: String
  , signature_ :: PolyFuncType
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq a => Ord (FuncDefn a) where
@@ -249,6 +250,7 @@ instance ToJSON node => ToJSON (FuncDefn node) where
                                     ,"op" .= ("FuncDefn" :: Text)
                                     ,"name" .= name
                                     ,"signature" .= signature_
+                                    ,"metadata" .= metadata
                                     ]
 
 data CustomConst where
@@ -286,36 +288,41 @@ instance ToJSON node => ToJSON (ConstOp node) where
 data InputNode node = InputNode
  { parent :: node
  , types  :: [HugrType]
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq a => Ord (InputNode a) where
   compare _ _ = EQ
 
 instance ToJSON node => ToJSON (InputNode node) where
-  toJSON (InputNode parent types) = object ["parent" .= parent
-                                           ,"op" .= ("Input" :: Text)
-                                           ,"types" .= types
-                                           ]
+  toJSON (InputNode parent types metadata) = object ["parent" .= parent
+                                                    ,"op" .= ("Input" :: Text)
+                                                    ,"types" .= types
+                                                    ,"metadata" .= metadata
+                                                    ]
 
 data OutputNode node = OutputNode
  { parent :: node
  , types  :: [HugrType]
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq a => Ord (OutputNode a) where
   compare _ _ = EQ
 
 instance ToJSON node => ToJSON (OutputNode node) where
-  toJSON (OutputNode parent types) = object ["parent" .= parent
-                                            ,"op" .= ("Output" :: Text)
-                                            ,"types" .= types
-                                            ]
+  toJSON (OutputNode { .. }) = object ["parent" .= parent
+                                      ,"op" .= ("Output" :: Text)
+                                      ,"types" .= types
+                                      ,"metadata" .= metadata
+                                      ]
 
 data Conditional node = Conditional
  { parent :: node
  , sum_rows :: [[HugrType]]
  , other_inputs :: [HugrType]
  , outputs :: [HugrType]
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq a => Ord (Conditional a) where
@@ -329,11 +336,13 @@ instance ToJSON node => ToJSON (Conditional node) where
             ,"other_inputs" .= other_inputs
             ,"outputs" .= outputs
             ,"extension_delta" .= ([] :: [Text])
+            ,"metadata" .= metadata
             ]
 
 data Case node = Case
   { parent :: node
   , signature_ :: FunctionType
+  , metadata :: [(String, String)]
   } deriving (Eq, Functor, Show)
 
 instance Eq node => Ord (Case node) where
@@ -343,6 +352,7 @@ instance ToJSON node => ToJSON (Case node) where
   toJSON (Case { .. }) = object ["op" .= ("Case" :: Text)
                                 ,"parent" .= parent
                                 ,"signature" .= signature_
+                                ,"metadata" .= metadata
                                 ]
 
 {-
@@ -356,6 +366,7 @@ data Const = Const
 data DFG node = DFG
  { parent :: node
  , signature_ :: FunctionType
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq node => Ord (DFG node) where
@@ -365,23 +376,26 @@ instance ToJSON node => ToJSON (DFG node) where
   toJSON (DFG { .. }) = object ["op" .= ("DFG" :: Text)
                                ,"parent" .= parent
                                ,"signature" .= signature_
+                               ,"metadata" .= metadata
                                ]
 
 data TagOp node = TagOp
  { parent :: node
  , tag :: Int
  , variants :: [[HugrType]]
+ , metadata :: [(String, String)]
  } deriving (Eq, Functor, Show)
 
 instance Eq node => Ord (TagOp node) where
   compare _ _ = EQ
 
 instance ToJSON node => ToJSON (TagOp node) where
-  toJSON (TagOp parent tag variants)
+  toJSON (TagOp parent tag variants metadata)
    = object ["parent" .= parent
             ,"op" .= ("Tag" :: Text)
             ,"tag" .= tag
             ,"variants" .= variants
+            ,"metadata" .= metadata
             ]
 
 data MakeTupleOp node = MakeTupleOp
@@ -591,6 +605,15 @@ data HugrOp node
   | OpNoop (NoopOp node)
  deriving (Eq, Functor, Ord, Show)
 
+addMetadata :: [(String, String)] -> HugrOp node -> HugrOp node
+addMetadata md (OpDFG (DFG { .. })) = OpDFG (DFG { metadata = metadata ++ md, .. })
+addMetadata md (OpCase (i, (Case { .. }))) = OpCase (i, (Case { metadata = metadata ++ md, .. }))
+addMetadata md (OpIn (InputNode { .. })) = OpIn (InputNode { metadata = metadata ++ md, .. })
+addMetadata md (OpTag (TagOp { .. })) = OpTag (TagOp { metadata = metadata ++ md, .. })
+addMetadata md (OpDefn (FuncDefn { .. })) = OpDefn (FuncDefn { metadata = metadata ++ md, .. })
+addMetadata md (OpConditional (Conditional { .. })) = OpConditional (Conditional { metadata = metadata ++ md, .. })
+addMetadata _ op = op
+
 instance ToJSON node => ToJSON (HugrOp node) where
   toJSON (OpMod op) = toJSON op
   toJSON (OpDefn op) = toJSON op

From 8e83732810a6ee5db407b34a3df878e316fbc201 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:09:13 +0000
Subject: [PATCH 143/182] do not expect vector_solve to compile, it needs Pow

---
 brat/test/Test/Compile/Hugr.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index 11de7093..693f00fd 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -37,6 +37,7 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"qft"
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
+  ,"vector_solve" -- Generates "Pow" nodes which aren't implemented yet
   ,"batcher-merge-sort" -- Generates MapFun nodes which aren't implemented yet
   -- Victims of #13
   ,"arith"

From 4d052645beec4ffecd0ff3e9ab41a84f3ec73b11 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:16:03 +0000
Subject: [PATCH 144/182] Separate out infer2 failing example

---
 brat/examples/infer.brat   | 34 ----------------------------------
 brat/examples/infer2.brat  | 33 +++++++++++++++++++++++++++++++++
 brat/test/Test/Checking.hs |  1 +
 3 files changed, 34 insertions(+), 34 deletions(-)
 create mode 100644 brat/examples/infer2.brat

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index 5efc1bb1..dacdb0a7 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -5,37 +5,3 @@ map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
 mapVec(_, _, _, _, []) = []
 mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
-
--- The "succ" still being required in both of these cases is https://github.com/CQCL/brat/issues/35
-
--- While map above can infer the holes from the other arguments,
--- here we need to infer the holes (arguments) from the results:
-repeat(X :: *, n :: #, x :: X) -> Vec(X, n)
-repeat(_, 0, _) = []
-repeat(_, succ(_), x) = x ,- repeat(!, !, x) -- X can be inferred from x but n cannot
-
-mapFirst(X :: *, Y :: *, { X -> Y}, n :: #, Vec(X, n)) -> Vec(Y, n)
-mapFirst(_, _, _, _, []) = []
-mapFirst(_, _, f, succ(_), x ,- _) = repeat(!, !, f(x)) -- first ! (X) is second _ (Y)
-
-isfull(n :: #) -> Bool
-isfull(succ(doub(n))) = isfull(n)
-isfull(0) = true
-isfull(_) = false
-
-hasfulllen(n :: #, Vec(Bool, n)) -> Bool
-hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(!, xs)
-hasfulllen(_, []) = true
-hasfulllen(_, _) = false
-
-eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
-eatsfull(n, _) = n
-mkftwo :: Nat
-mkftwo = eatsfull(!, [false,false,false])
-
-eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
-eatsodd(n, _) = n
-mkotwo' :: Nat
-mkotwo' = eatsodd(2, [false,false,false,false,false])
-mkotwo :: Nat
-mkotwo = eatsodd(!, [false,false,false,false,false])
diff --git a/brat/examples/infer2.brat b/brat/examples/infer2.brat
new file mode 100644
index 00000000..421e2eb7
--- /dev/null
+++ b/brat/examples/infer2.brat
@@ -0,0 +1,33 @@
+-- The "succ" still being required in both of these cases is https://github.com/CQCL/brat/issues/35
+
+-- While some cases can infer the holes from the other arguments,
+-- here we need to infer the holes (arguments) from the results:
+repeat(X :: *, n :: #, x :: X) -> Vec(X, n)
+repeat(_, 0, _) = []
+repeat(_, succ(_), x) = x ,- repeat(!, !, x) -- X can be inferred from x but n cannot
+
+mapFirst(X :: *, Y :: *, { X -> Y}, n :: #, Vec(X, n)) -> Vec(Y, n)
+mapFirst(_, _, _, _, []) = []
+mapFirst(_, _, f, succ(_), x ,- _) = repeat(!, !, f(x)) -- first ! (X) is second _ (Y)
+
+isfull(n :: #) -> Bool
+isfull(succ(doub(n))) = isfull(n)
+isfull(0) = true
+isfull(_) = false
+
+hasfulllen(n :: #, Vec(Bool, n)) -> Bool
+hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(!, xs)
+hasfulllen(_, []) = true
+hasfulllen(_, _) = false
+
+eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
+eatsfull(n, _) = n
+mkftwo :: Nat
+mkftwo = eatsfull(!, [false,false,false])
+
+eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
+eatsodd(n, _) = n
+mkotwo' :: Nat
+mkotwo' = eatsodd(2, [false,false,false,false,false])
+mkotwo :: Nat
+mkotwo = eatsodd(!, [false,false,false,false,false])
diff --git a/brat/test/Test/Checking.hs b/brat/test/Test/Checking.hs
index a91e55ae..5b0fd0b2 100644
--- a/brat/test/Test/Checking.hs
+++ b/brat/test/Test/Checking.hs
@@ -15,6 +15,7 @@ expectedCheckingFails = map ("examples" </>) ["nested-abstractors.brat"
                                              ,"karlheinz.brat"
                                              ,"karlheinz_alias.brat"
                                              ,"hea.brat"
+                                             ,"infer2.brat" -- https://github.com/Quantinuum/brat/issues/35
                                              ]
 
 parseAndCheckXF :: [FilePath] -> [TestTree]

From df76f0cc47475506df8570e4f95715e879c214aa Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:21:51 +0000
Subject: [PATCH 145/182] update graph golden tests

---
 brat/test/golden/graph/addN.brat.graph  | 22 +++++------
 brat/test/golden/graph/addN2.brat.graph | 22 +++++------
 brat/test/golden/graph/id.brat.graph    | 28 ++++++-------
 brat/test/golden/graph/rx.brat.graph    | 52 ++++++++++++-------------
 brat/test/golden/graph/swap.brat.graph  | 34 ++++++++--------
 5 files changed, 79 insertions(+), 79 deletions(-)

diff --git a/brat/test/golden/graph/addN.brat.graph b/brat/test/golden/graph/addN.brat.graph
index 071750d4..84504c1e 100644
--- a/brat/test/golden/graph/addN.brat.graph
+++ b/brat/test/golden/graph/addN.brat.graph
@@ -1,12 +1,12 @@
 Nodes:
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,BratNode Source [] [("n",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
@@ -21,8 +21,8 @@ Nodes:
 (globals_prim_8_add,BratNode (Prim ("","add")) [] [("thunk",{ (a :: Int), (b :: Int) -> (c :: Int) })])
 
 Wires:
-(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 0)
 (Ex check_defs_1_addN_LambdaChk_9_lambda 0,Int,In check_defs_1_addN_addN.box/out_1 0)
 (Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_LambdaChk_9_lambda 0)
 (Ex check_defs_1_addN_addN.box_thunk_2 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
@@ -32,4 +32,4 @@ Wires:
 (Ex globals_Int_5 0,[],In globals___kcc_4 0)
 (Ex globals_Int_6 0,[],In globals___kcc_4 1)
 (Ex globals_Int_7 0,[],In globals___kcc_4 2)
-(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 1)
+(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 1)
diff --git a/brat/test/golden/graph/addN2.brat.graph b/brat/test/golden/graph/addN2.brat.graph
index 19809c36..a481cd0d 100644
--- a/brat/test/golden/graph/addN2.brat.graph
+++ b/brat/test/golden/graph/addN2.brat.graph
@@ -1,12 +1,12 @@
 Nodes:
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3,BratNode Source [] [("n",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
-(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in,BratNode Source [] [("inp",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/out_1,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval,BratNode (Eval (Ex globals_prim_8_add 0)) [("a",Int),("b",Int)] [("c",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
+(check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
@@ -21,8 +21,8 @@ Nodes:
 (globals_prim_8_add,BratNode (Prim ("","add")) [] [("a1",{ (a :: Int), (b :: Int) -> (c :: Int) })])
 
 Wires:
-(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_3 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 0)
 (Ex check_defs_1_addN_LambdaChk_9_lambda 0,Int,In check_defs_1_addN_addN.box/out_1 0)
 (Ex check_defs_1_addN_addN.box/in 0,Int,In check_defs_1_addN_LambdaChk_9_lambda 0)
 (Ex check_defs_1_addN_addN.box_thunk_2 0,{ (inp :: Int) -> (out :: Int) },In globals_decl_13_addN 0)
@@ -32,4 +32,4 @@ Wires:
 (Ex globals_Int_5 0,[],In globals___kcc_4 0)
 (Ex globals_Int_6 0,[],In globals___kcc_4 1)
 (Ex globals_Int_7 0,[],In globals___kcc_4 2)
-(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_Eval_6 1)
+(Ex globals_prim_2_N 0,Int,In check_defs_1_addN_LambdaChk_9_checkClauses_1_$rhs_4_Eval 1)
diff --git a/brat/test/golden/graph/id.brat.graph b/brat/test/golden/graph/id.brat.graph
index f7ede146..8467bd30 100644
--- a/brat/test/golden/graph/id.brat.graph
+++ b/brat/test/golden/graph/id.brat.graph
@@ -1,22 +1,22 @@
 Nodes:
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q",Qubit)])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_check'Th_LambdaChk_5_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit)] [("b",Qubit)])
-(check_defs_1_main_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_check'Th_thunk/in check_defs_1_main_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_4,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_decl_5_main,BratNode Id [("a1",{ (a :: Qubit) -o (b :: Qubit) })] [("a1",{ (a :: Qubit) -o (b :: Qubit) })])
 
 Wires:
-(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 0,Qubit,In check_defs_1_main_check'Th_thunk/out_1 0)
-(Ex check_defs_1_main_check'Th_thunk/in 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 0)
-(Ex check_defs_1_main_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_5_main 0)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 0,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 0,Qubit,In check_defs_1_main_$rhs_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_$rhs_check'Th_thunk/in 0,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 0)
+(Ex check_defs_1_main_$rhs_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_5_main 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_4 0,[],In globals___kcr__3 0)
diff --git a/brat/test/golden/graph/rx.brat.graph b/brat/test/golden/graph/rx.brat.graph
index d5605a7e..e3ff04df 100644
--- a/brat/test/golden/graph/rx.brat.graph
+++ b/brat/test/golden/graph/rx.brat.graph
@@ -1,20 +1,20 @@
 Nodes:
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_Splice_6,KernelNode (Splice (Ex globals_decl_18_xish 0)) [("rxa",Qubit)] [("rxb",Qubit)])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q",Qubit)])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_3_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit)] [("b",Qubit)])
-(check_defs_1_main_3_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
-(check_defs_1_main_3_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
-(check_defs_1_main_3_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_3_check'Th_thunk/in check_defs_1_main_3_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_nums_const,BratNode (Const 1) [] [("value",Int)])
-(check_defs_1_nums_const_1,BratNode (Const 2) [] [("value",Int)])
-(check_defs_1_nums_const_2,BratNode (Const 3) [] [("value",Int)])
-(check_defs_1_xish_1_Eval,BratNode (Eval (Ex globals_prim_7_Rx 0)) [("th",Float)] [("a1",{ (rxa :: Qubit) -o (rxb :: Qubit) })])
-(check_defs_1_xish_1_const_1,BratNode (Const 30.0) [] [("value",Float)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_Splice,KernelNode (Splice (Ex globals_decl_18_xish 0)) [("rxa",Qubit)] [("rxb",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
+(check_defs_1_main_3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_3_$rhs_check'Th_thunk/in check_defs_1_main_3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
+(check_defs_1_nums_$rhs_const,BratNode (Const 1) [] [("value",Int)])
+(check_defs_1_nums_$rhs_const_1,BratNode (Const 2) [] [("value",Int)])
+(check_defs_1_nums_$rhs_const_2,BratNode (Const 3) [] [("value",Int)])
+(check_defs_1_xish_1_$rhs_Eval,BratNode (Eval (Ex globals_prim_7_Rx 0)) [("th",Float)] [("a1",{ (rxa :: Qubit) -o (rxb :: Qubit) })])
+(check_defs_1_xish_1_$rhs_const_1,BratNode (Const 30.0) [] [("value",Float)])
 (globals_Float_2,BratNode (Constructor Float) [] [("value",[])])
 (globals_Int_9,BratNode (Constructor Int) [] [("value",[])])
 (globals_Int_10,BratNode (Constructor Int) [] [("value",[])])
@@ -31,16 +31,16 @@ Nodes:
 (globals_prim_7_Rx,BratNode (Prim ("","Rx")) [] [("thunk",{ (th :: Float) -> (a1 :: { (rxa :: Qubit) -o (rxb :: Qubit) }) })])
 
 Wires:
-(Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_Splice_6 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_checkClauses_1_Splice_6 0)
-(Ex check_defs_1_main_3_check'Th_LambdaChk_6_lambda 0,Qubit,In check_defs_1_main_3_check'Th_thunk/out_1 0)
-(Ex check_defs_1_main_3_check'Th_thunk/in 0,Qubit,In check_defs_1_main_3_check'Th_LambdaChk_6_lambda 0)
-(Ex check_defs_1_main_3_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_24_main 0)
-(Ex check_defs_1_nums_const 0,Int,In globals_decl_12_nums 0)
-(Ex check_defs_1_nums_const_1 0,Int,In globals_decl_12_nums 1)
-(Ex check_defs_1_nums_const_2 0,Int,In globals_decl_12_nums 2)
-(Ex check_defs_1_xish_1_Eval 0,{ (rxa :: Qubit) -o (rxb :: Qubit) },In globals_decl_18_xish 0)
-(Ex check_defs_1_xish_1_const_1 0,Float,In check_defs_1_xish_1_Eval 0)
+(Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_Splice 0,Qubit,In check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 0,Qubit,In check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$rhs_4_Splice 0)
+(Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda 0,Qubit,In check_defs_1_main_3_$rhs_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_3_$rhs_check'Th_thunk/in 0,Qubit,In check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda 0)
+(Ex check_defs_1_main_3_$rhs_check'Th_thunk_thunk_2 0,{ (a :: Qubit) -o (b :: Qubit) },In globals_decl_24_main 0)
+(Ex check_defs_1_nums_$rhs_const 0,Int,In globals_decl_12_nums 0)
+(Ex check_defs_1_nums_$rhs_const_1 0,Int,In globals_decl_12_nums 1)
+(Ex check_defs_1_nums_$rhs_const_2 0,Int,In globals_decl_12_nums 2)
+(Ex check_defs_1_xish_1_$rhs_Eval 0,{ (rxa :: Qubit) -o (rxb :: Qubit) },In globals_decl_18_xish 0)
+(Ex check_defs_1_xish_1_$rhs_const_1 0,Float,In check_defs_1_xish_1_$rhs_Eval 0)
 (Ex globals_Float_2 0,[],In globals___kcc_1 0)
 (Ex globals_Int_10 0,[],In globals___kca_nums_8 1)
 (Ex globals_Int_11 0,[],In globals___kca_nums_8 2)
diff --git a/brat/test/golden/graph/swap.brat.graph b/brat/test/golden/graph/swap.brat.graph
index bdb5e50e..f0c3319e 100644
--- a/brat/test/golden/graph/swap.brat.graph
+++ b/brat/test/golden/graph/swap.brat.graph
@@ -1,14 +1,14 @@
 Nodes:
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_check'Th_LambdaChk_5_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs_thunk_5) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
-(check_defs_1_main_check'Th_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
-(check_defs_1_main_check'Th_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
-(check_defs_1_main_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_check'Th_thunk/in check_defs_1_main_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
+(check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
+(check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
+(check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
 (globals_Qubit_2,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_3,BratNode (Constructor Qubit) [] [("value",[])])
 (globals_Qubit_5,BratNode (Constructor Qubit) [] [("value",[])])
@@ -16,13 +16,13 @@ Nodes:
 (globals_decl_7_main,BratNode Id [("a1",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })] [("a1",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
 
 Wires:
-(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 1)
-(Ex check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/in_3 1,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_checkClauses_1_lambda.0_rhs/out_4 0)
-(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 0,Qubit,In check_defs_1_main_check'Th_thunk/out_1 0)
-(Ex check_defs_1_main_check'Th_LambdaChk_5_lambda 1,Qubit,In check_defs_1_main_check'Th_thunk/out_1 1)
-(Ex check_defs_1_main_check'Th_thunk/in 0,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 0)
-(Ex check_defs_1_main_check'Th_thunk/in 1,Qubit,In check_defs_1_main_check'Th_LambdaChk_5_lambda 1)
-(Ex check_defs_1_main_check'Th_thunk_thunk_2 0,{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) },In globals_decl_7_main 0)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 0,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2 1)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 1,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2 0)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 0,Qubit,In check_defs_1_main_$rhs_check'Th_thunk/out_1 0)
+(Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 1,Qubit,In check_defs_1_main_$rhs_check'Th_thunk/out_1 1)
+(Ex check_defs_1_main_$rhs_check'Th_thunk/in 0,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 0)
+(Ex check_defs_1_main_$rhs_check'Th_thunk/in 1,Qubit,In check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda 1)
+(Ex check_defs_1_main_$rhs_check'Th_thunk_thunk_2 0,{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) },In globals_decl_7_main 0)
 (Ex globals_Qubit_2 0,[],In globals___kcr__1 0)
 (Ex globals_Qubit_3 0,[],In globals___kcr__1 1)
 (Ex globals_Qubit_5 0,[],In globals___kcr__4 0)

From 79ccbc349b2f4a950b2d60015a3e1331f58769bd Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:30:49 +0000
Subject: [PATCH 146/182] brat.cabal: re-enable checks as all passing anyway;
 fix indenting

---
 brat/brat.cabal | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/brat/brat.cabal b/brat/brat.cabal
index e291b7f5..aded7927 100644
--- a/brat/brat.cabal
+++ b/brat/brat.cabal
@@ -44,12 +44,12 @@ common warning-flags
     -Wno-unused-do-bind
     -Wno-missing-signatures
     -Wno-noncanonical-monoid-instances
---    -Werror=unused-imports
---    -Werror=unused-matches
+    -Werror=unused-imports
+    -Werror=unused-matches
     -Werror=missing-methods
---    -Werror=unused-top-binds
---    -Werror=unused-local-binds
---    -Werror=redundant-constraints
+    -Werror=unused-top-binds
+    -Werror=unused-local-binds
+    -Werror=redundant-constraints
     -Werror=orphans
     -Werror=overlapping-patterns
 
@@ -69,7 +69,7 @@ library
                        Brat.Checker.Helpers.Nodes,
                        Brat.Checker.Monad,
                        Brat.Checker.SolveHoles,
-		       Brat.Checker.SolveNumbers,
+                       Brat.Checker.SolveNumbers,
                        Brat.Checker.SolvePatterns,
                        Brat.Checker.Types,
                        Brat.Compile.Hugr,

From 06d030c53a6337644518f598a52a5189994e8bbe Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:52:24 +0000
Subject: [PATCH 147/182] spaces to tabs

---
 brat/Brat/Checker.hs              | 14 +++++++-------
 brat/Brat/Checker/Helpers.hs      | 16 ++++++++--------
 brat/Brat/Checker/SolveNumbers.hs |  6 +++---
 brat/Brat/Eval.hs                 |  4 ++--
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index bd0b3e76..5c6adb43 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -231,13 +231,13 @@ check' (Lambda c@(WC abstFC abst,  body) cs) (overs, unders) = do
       (ins :->> outs) <- mkSig usedOvers unders
       (allFakeUnders, rightFakeUnders, tgtMap) <- suppressHoles $ suppressGraph $ do
         (fakeEnv, fakeAcc) <- "$lhs" -! do
-	  (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins SkolemConst
-	  -- Hypo `check` calls need an environment, even just to compute leftovers;
-	  -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
-	  let srcMap = fromJust $ zipSameLength (fst <$> usedOvers) (fst <$> fakeOvers)
-	  let fakeProblem = [ (fromJust (lookup src srcMap), pat) | (src, pat) <- problem ]
-	  fakeEnv <- localFC abstFC $ solve ?my fakeProblem >>= (solToEnv . snd)
-	  pure (fakeEnv, fakeAcc)
+          (_, [], fakeOvers, fakeAcc) <- anext' "lambda_fake_source" Hypo (S0, Some (Zy :* S0)) R0 ins SkolemConst
+          -- Hypo `check` calls need an environment, even just to compute leftovers;
+          -- we get that env by solving `problem` reformulated in terms of the `fakeOvers`
+          let srcMap = fromJust $ zipSameLength (fst <$> usedOvers) (fst <$> fakeOvers)
+          let fakeProblem = [ (fromJust (lookup src srcMap), pat) | (src, pat) <- problem ]
+          fakeEnv <- localFC abstFC $ solve ?my fakeProblem >>= (solToEnv . snd)
+          pure (fakeEnv, fakeAcc)
         localEnv fakeEnv $ do
           (_, fakeUnders, [], _) <- anext "lambda_fake_target" Hypo fakeAcc outs R0
           Just tgtMap <- pure $ zipSameLength (fst <$> fakeUnders) unders
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 59b449c6..c787c58d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -709,17 +709,17 @@ allowedToSolve me it =
   in  case (it, dollarAndItsPrefix me, dollarAndItsPrefix itBwd) of
         -- Solving a hope
         (InEnd _, Just (region, "rhs"), Just (maker, "!"))
-	  | Just region == prefixLeftOf maker "$rhs"
-	   ->
-	  trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
-	  $ Just "$!"
+          | Just region == prefixLeftOf maker "$rhs"
+           ->
+          trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
+          $ Just "$!"
         -- We can only solve dangling wires when doing pattern matching in `solve`
         (_, Just (region, "lhs"), Just (region', "lhs"))
-	  | region == region'
-	  -> trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
-	  $ Just "gen"
+          | region == region'
+          -> trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
+          $ Just "gen"
         _ -> trackPermission ("Forbidden to solve:\n  " ++ show me ++ " / " ++ show it)
-	  Nothing
+          Nothing
  where
   lastDollar B0 = Nothing
   lastDollar (zx :< ('$':str, _)) = Just str
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 9d876502..5da07709 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -197,9 +197,9 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
           half <- traceChecking "makeHalf" makeHalf e
           pure (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar half)))))
         | otherwise -> do
-	  mkYield "evenGro" (S.singleton e)
-	  nv <- quoteNum Zy <$> numEval S0 mono
-	  demandEven nv
+          mkYield "evenGro" (S.singleton e)
+          nv <- quoteNum Zy <$> numEval S0 mono
+          demandEven nv
       Full sm -> nConstant 0 <$ demand0 (NumValue 0 (StrictMonoFun sm))
     evenGro (StrictMonoFun (StrictMono n mono)) = pure (NumValue 0 (StrictMonoFun (StrictMono (n - 1) mono)))
 
diff --git a/brat/Brat/Eval.hs b/brat/Brat/Eval.hs
index c6ddbed5..d7ee14c6 100644
--- a/brat/Brat/Eval.hs
+++ b/brat/Brat/Eval.hs
@@ -18,9 +18,9 @@ module Brat.Eval (EvMode(..)
                  ,kindType
                  ,numVal
                  ,quote
-		 ,quoteNum
+                 ,quoteNum
                  ,getNumVar
-		 ,instantiateMeta
+                 ,instantiateMeta
                  ) where
 
 import Brat.Checker.Monad

From 042ac585a34185e7974d56ac69635582b3c60583 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 8 Dec 2025 14:44:40 +0000
Subject: [PATCH 148/182] fix warnings

---
 brat/Brat/Checker.hs              |  5 ++---
 brat/Brat/Checker/Helpers.hs      | 19 +++++++------------
 brat/Brat/Checker/Monad.hs        |  2 +-
 brat/Brat/Checker/SolveHoles.hs   | 12 +++---------
 brat/Brat/Checker/SolveNumbers.hs | 11 +++++------
 brat/Brat/Syntax/Value.hs         |  2 +-
 6 files changed, 19 insertions(+), 32 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 5c6adb43..e4d35ce4 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -173,7 +173,7 @@ checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m)
              -> [(Tgt, BinderType m)] -- Expected
              -> [(Src, BinderType m)] -- Actual
              -> Checking [(Tgt, BinderType m)]
-checkOutputs tm unders overs | track ("checkOutputs\n  " ++ show unders ++ "\n  " ++ show overs) False = undefined
+checkOutputs _ unders overs | track ("checkOutputs\n  " ++ show unders ++ "\n  " ++ show overs) False = undefined
 checkOutputs tm unders overs = checkIO tm unders overs (flip $ checkWire ?my tm True) "No unders but overs: "
 
 check :: (CheckConstraints m k
@@ -473,7 +473,7 @@ check' (VHole (mnemonic, name)) connectors = do
   pure (((), ()), ([], []))
 -- TODO: Better error message
 check' tm@(Con _ _) ((), []) = typeErr $ "No type to check " ++ show tm ++ " against"
-check' tm@(Con vcon vargs) ((), (hungry, ty):unders) = do
+check' (Con vcon vargs) ((), (hungry, ty):unders) = do
   trackM ("check' Con vcon=" ++ show vcon ++ "  vargs=" ++ show vargs)
   mkFork "check'Con" $ case (?my, ty) of
       (Braty, Left k) -> do
@@ -759,7 +759,6 @@ checkClause my fnName cty clause = modily my $ do
 
   -- Now actually make a box for the RHS and check it
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
-    let abstractor = foldr ((:||:) . APat . Bind) AEmpty vars
     let ?my = my in do
       env <- mkEnv vars rhsOvers
       localEnv env $ "$rhs" -! check @m (rhs clause) ((), rhsUnders)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index c787c58d..8ceb56ab 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -2,7 +2,7 @@
 
 module Brat.Checker.Helpers where
 
-import Brat.Checker.Monad (Checking, CheckingSig(..), HopeData(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, tlup, isSkolem, mkYield, throwLeft)
+import Brat.Checker.Monad (Checking, CheckingSig(..), captureOuterLocals, err, typeErr, kindArgRows, defineEnd, tlup, isSkolem, mkYield, throwLeft)
 import Brat.Checker.Types
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval (eval, EvMode(..), kindType, quote, doesntOccur)
@@ -26,7 +26,6 @@ import Data.Foldable (foldrM)
 import Data.List (partition)
 import Data.Maybe (isJust)
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
-import qualified Data.Map as M
 import qualified Data.Set as S
 import Prelude hiding (last)
 
@@ -117,7 +116,7 @@ pullPortsSig :: Show ty
              -> Checking [(PortName, ty)]
 pullPortsSig = pullPorts fst showSig
 
-pullPorts :: forall a ty
+pullPorts :: forall a
            . (a -> PortName) -- A way to get a port name for each element
           -> ([a] -> String) -- A way to print the list
           -> [PortName] -- Things to pull to the front
@@ -261,7 +260,7 @@ getThunks :: Modey m
                       ,Overs m UVerb
                       )
 getThunks _ [] = pure ([], [], [])
-getThunks Braty row@((src, Right ty):rest) = do
+getThunks Braty ((src, Right ty):rest) = do
   ty <- awaitTypeDefinition ty
   (src, ss :->> ts) <- vectorise Braty (src, ty)
   (node, unders, overs, _) <- let ?my = Braty in
@@ -627,7 +626,7 @@ invertNatVal (NumValue up gro) = case up of
 -- The Sem is closed, for now.
 solveVal :: TypeKind -> End -> Val Z -> Checking ()
 solveVal _ it (VApp (VPar e) B0) | it == e = pure ()
-solveVal k it v | Left msg <- doesntOccur it v =
+solveVal _ it v | Left msg <- doesntOccur it v =
     -- TODO: Not all occurrences are toxic. The end could be in an argument
     -- to a hoping variable which isn't used.
     -- E.g. h1 = h2 h1 - this is valid if h2 is the identity, or ignores h1.
@@ -684,12 +683,12 @@ valPats2Val _ _ = err $ InternalError "Type args didn't match expected - kindChe
 
 traceChecking :: (Show a, Show b) => String -> (a -> Checking b) -> (a -> Checking b)
 traceChecking lbl m a = do
-  --traceM ("Enter " ++ lbl ++ ": " ++ show a)
+  traceM ("Enter " ++ lbl ++ ": " ++ show a)
   b <- m a
-  --traceM ("Exit  " ++ lbl ++ ": " ++ show b)
+  traceM ("Exit  " ++ lbl ++ ": " ++ show b)
   pure b
 
--- traceChecking = const id
+--traceChecking = const id
 
 dollarAndItsPrefix :: Bwd (String, Int) -> Maybe (Bwd (String, Int), String)
 dollarAndItsPrefix B0 = Nothing
@@ -720,10 +719,6 @@ allowedToSolve me it =
           $ Just "gen"
         _ -> trackPermission ("Forbidden to solve:\n  " ++ show me ++ " / " ++ show it)
           Nothing
- where
-  lastDollar B0 = Nothing
-  lastDollar (zx :< ('$':str, _)) = Just str
-  lastDollar (zx :< x) = lastDollar zx
 
 mineToSolve :: Checking (End -> Maybe String)
 mineToSolve = allowedToSolve <$> whoAmI
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 4e06bbf8..19809181 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -22,7 +22,7 @@ import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Data.Set as S
 
-import Debug.Trace
+-- import Debug.Trace
 
 -- Used for messages about thread forking / spawning
 thTrace = const id
diff --git a/brat/Brat/Checker/SolveHoles.hs b/brat/Brat/Checker/SolveHoles.hs
index 65111551..2631a4f6 100644
--- a/brat/Brat/Checker/SolveHoles.hs
+++ b/brat/Brat/Checker/SolveHoles.hs
@@ -1,9 +1,9 @@
 module Brat.Checker.SolveHoles (typeEq, typesEq) where
 
-import Brat.Checker.Helpers (buildNatVal, buildConst, mineToSolve, solveSem)
+import Brat.Checker.Helpers (mineToSolve, solveSem)
 import Brat.Checker.Monad
 import Brat.Checker.SolveNumbers
-import Brat.Checker.Types (kindForMode, IsSkolem(..))
+import Brat.Checker.Types (kindForMode)
 import Brat.Error (ErrorMsg(..))
 import Brat.Eval
 import Brat.Naming (FreshMonad(..))
@@ -15,12 +15,10 @@ import Bwd
 import Hasochism
 -- import Brat.Syntax.Port (toEnd)
 
-import Control.Monad (unless, when, filterM, (>=>))
+import Control.Monad (unless)
 import Data.Bifunctor (second)
 import Data.Foldable (sequenceA_)
 import Data.Functor
-import Data.Maybe (mapMaybe)
-import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Type.Equality (TestEquality(..), (:~:)(..))
 
@@ -96,10 +94,6 @@ typeEqEta tm stuff@(ny :* _ks :* _sems) _ k exp act = do
     [] -> typeEqRigid tm stuff k exp act -- easyish, both rigid i.e. already defined
     -- tricky: must wait for one or other to become more defined
     es -> mkYield "typeEqEta" (S.fromList es) >> typeEq' tm stuff k exp act
- where
-  getEnd (VApp (VPar e) _) = Just e
-  getEnd (VNum n) = getNumVar n
-  getEnd _ = Nothing
 
 typeEqs :: String -> (Ny :* Stack Z TypeKind :* Stack Z Sem) n -> [TypeKind] -> [Val n] -> [Val n] -> Checking ()
 typeEqs _ _ [] [] [] = pure ()
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 5da07709..40be5804 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -12,8 +12,7 @@ import Brat.Naming
 import Hasochism
 import Control.Monad.Freer
 
-import Debug.Trace
-import qualified Data.Map as M
+-- import Debug.Trace
 import qualified Data.Set as S
 
 trailM :: Applicative f => String -> f ()
@@ -78,7 +77,7 @@ unifyNum mine nv0 nv1 = do
 -- ...But we don't need to do any wiring here, right?
 unifyNum' :: (End -> Maybe String) -> NumVal (VVar Z) -> NumVal (VVar Z) -> Checking ()
 unifyNum' _ a b | trail ("unifyNum'\n  " ++ show a ++ "\n  " ++ show b) False = undefined
-unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
+unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
   | lup <= rup = lhsFun00 lgro (NumValue (rup - lup) rgro)
   | otherwise  = lhsFun00 rgro (NumValue (lup - rup) lgro)
  where
@@ -137,7 +136,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
   lhsMono m@(Full _) (NumValue 0 gro) = trail "lhsMono swaps" $ lhsFun00 gro (NumValue 0 (StrictMonoFun (StrictMono 0 m)))
   lhsMono (Full sm) (NumValue up gro) = do
     smPred <- traceChecking "lhsMono demandSucc" demandSucc (NumValue 0 (StrictMonoFun sm))
-    sm <- numEval S0 sm
+    _ <- numEval S0 sm
     -- trailM $ "succ now " ++ show (quoteNum Zy sm)
     unifyNum mine (n2PowTimes 1 (nFull smPred)) (NumValue (up - 1) gro)
 
@@ -175,7 +174,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
       demandSucc nv
 
   -- if it's not "mine" should we wait?
-  demandSucc (NumValue 0 (StrictMonoFun x@(StrictMono k (Full nPlus1)))) = do
+  demandSucc (NumValue 0 (StrictMonoFun (StrictMono k (Full nPlus1)))) = do
     n <- traceChecking "demandSucc" demandSucc (NumValue 0 (StrictMonoFun nPlus1))
     -- foo <- numEval S0 x
     -- trailM $ "ds: " ++ show x ++ " -> " ++ show (quoteNum Zy foo)
@@ -184,7 +183,7 @@ unifyNum' mine nvl@(NumValue lup lgro) nvr@(NumValue rup rgro)
 
   -- Complain if a number isn't even, otherwise return half
   demandEven :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
-  demandEven n@(NumValue up gro) = case up `divMod` 2 of
+  demandEven (NumValue up gro) = case up `divMod` 2 of
     (up, 0) -> nPlus up <$> traceChecking "evenGro" evenGro gro
     (up, 1) -> nPlus (up + 1) <$> traceChecking "oddGro" oddGro (NumValue 0 gro)
    where
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index 7fbf4c12..f97deebb 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -628,7 +628,7 @@ flexes (VNum (NumValue 0 (StrictMonoFun (StrictMono 0 (Linear (VPar e)))))) = [e
 flexes _ = []
 
 numVars :: NumVal (VVar Z) -> [End]
-numVars nv = [e | v@(VPar e) <- vvars nv]
+numVars nv = [e | VPar e <- vvars nv]
  where
   vvars :: NumVal a -> [a]
   vvars = foldMap pure

From 2954e62fc0a46bd987315a6e421f9a73e9b147a3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 15:23:52 +0000
Subject: [PATCH 149/182] Update hugr extension

---
 hugr_extension/src/defs.rs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/hugr_extension/src/defs.rs b/hugr_extension/src/defs.rs
index b74dc99a..f1683a70 100644
--- a/hugr_extension/src/defs.rs
+++ b/hugr_extension/src/defs.rs
@@ -12,8 +12,8 @@ use hugr::{
     std_extensions::arithmetic::int_types::INT_TYPES,
     std_extensions::collections::list_type,
     types::{
-        type_param::TypeParam, FuncValueType, PolyFuncTypeRV, Type, TypeArg, TypeBound, TypeEnum,
-        TypeRV,
+        type_param::TypeParam, FuncValueType, PolyFuncTypeRV, Signature, Type,
+        TypeArg, TypeBound, TypeEnum, TypeRV,
     },
 };
 
@@ -56,7 +56,7 @@ impl NamedOp for BratOpDef {
             Panic => "Panic".into(),
             Ctor(ctor) => format_smolstr!("Ctor::{}", ctor.name()),
             PrimCtorTest(ctor) => format_smolstr!("PrimCtorTest::{}", ctor.name()),
-            Lluf => "Lluf".into()
+            Lluf => "Lluf".into(),
             Replicate => "Replicate".into(),
         }
     }
@@ -140,7 +140,7 @@ impl MakeOpDef for BratOpDef {
                 )
                 .into()
             }
-            Lluf => FunctionType::new(vec![U64.clone()], vec![U64.clone()]).into(),
+            Lluf => Signature::new(vec![U64.clone()], vec![U64.clone()]).into(),
             Replicate => PolyFuncTypeRV::new(
                 [TypeParam::Type {
                     b: TypeBound::Copyable,

From 98f8186bf40a75ec03f3fb847e64efc357b2d4e5 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 15:57:54 +0000
Subject: [PATCH 150/182] Turn off traceChecking

---
 brat/Brat/Checker/Helpers.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 8ceb56ab..7f799f5f 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -29,8 +29,6 @@ import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import qualified Data.Set as S
 import Prelude hiding (last)
 
-import Debug.Trace
-
 trackPermission = const id
 --trackPermission = trace
 
@@ -681,11 +679,11 @@ valPats2Val (k:ks) (v:vs) = do
 valPats2Val [] [] = pure (B0, [])
 valPats2Val _ _ = err $ InternalError "Type args didn't match expected - kindCheck should've sorted it"
 
-traceChecking :: (Show a, Show b) => String -> (a -> Checking b) -> (a -> Checking b)
-traceChecking lbl m a = do
-  traceM ("Enter " ++ lbl ++ ": " ++ show a)
+traceChecking :: String -> (a -> Checking b) -> (a -> Checking b)
+traceChecking _lbl m a = do
+  -- trackM ("Enter " ++ lbl ++ ": " ++ show a)
   b <- m a
-  traceM ("Exit  " ++ lbl ++ ": " ++ show b)
+  -- trackM ("Exit  " ++ lbl ++ ": " ++ show b)
   pure b
 
 --traceChecking = const id

From e592dc81e9750b23e6edec7a5312f73b8380df9b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 22 Apr 2025 11:37:45 +0100
Subject: [PATCH 151/182] Pattern matching: Don't discard kinded things with
 `_` pattern

---
 brat/Brat/Checker/SolvePatterns.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index f2876c45..39048ec5 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -63,12 +63,19 @@ solve :: forall m. Modey m
                    )
 solve _ [] = pure ([], [])
 solve my ((src, DontCare):p) = do
-  () <- case my of
+  case my of
     Kerny -> do
       ty <- typeOfSrc Kerny src
       unless (fromJust (copyable ty)) $ typeErr $ "Ignoring linear variable of type " ++ show ty
-    Braty -> pure ()
-  solve my p
+      solve my p
+    Braty -> do
+      ty <- typeOfSrc Braty src
+      (tests, sol) <- solve my p
+      case ty of
+        Right _ -> pure (tests, sol)
+        -- Kinded things might be used to solve hopes. We pass them through so
+        -- that we can do the proper wiring in this case
+        Left _ -> pure (tests, ('_':portName src, (src, ty)):sol)
 solve my ((src, Bind x):p) = do
   ty <- typeOfSrc my src
   (tests, sol) <- solve my p

From cfdb35649365ce8ae5b59f1641b2277916f67891 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 23 Apr 2025 09:30:52 +0100
Subject: [PATCH 152/182] Intercept (problematic)

---
 brat/Brat/Checker.hs                          | 12 ++++++++----
 brat/test/golden/error/vec_length.brat.golden |  2 +-
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index e4d35ce4..eef3db0e 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -741,7 +741,7 @@ checkClause my fnName cty clause = modily my $ do
 
   -- First, we check the patterns on the LHS. This requires some overs,
   -- so we make a box, however this box will be skipped during compilation.
-  (vars, match, rhsCty) <- suppressHoles . fmap snd $
+  (sol, match, rhsCty) <- suppressHoles . fmap snd $
        let ?my = my in ("$lhs" -!) $ makeBox (clauseName ++ "_setup") cty $
                      \(overs, unders) -> do
     -- Make a problem to solve based on the lhs and the overs
@@ -754,14 +754,18 @@ checkClause my fnName cty clause = modily my $ do
       Some (patEz :* patRo) -> mkArgRo my patEz (first (fmap toEnd) <$> unders) >>= \case
         Some (_ :* outRo) -> do
           let match = TestMatchData my $ MatchSequence overs tests (snd <$> sol)
-          let vars = fst <$> sol
-          pure (vars, match, patRo :->> outRo)
+          pure (sol, match, patRo :->> outRo)
 
   -- Now actually make a box for the RHS and check it
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
+    -- Here we're relying too much on the implementation of typeEq, counting on
+    -- the fact that it'll define the first argument in the flex-flex case that
+    -- would arise if we've not yet defined the outer src
+
+    let vars = fst <$> sol
     let ?my = my in do
       env <- mkEnv vars rhsOvers
-      localEnv env $ "$rhs" -! check @m (rhs clause) ((), rhsUnders)
+      localEnv env $ "$rhs" -! (check @m (rhs clause) ((), rhsUnders))
   let NamedPort {end=Ex rhsNode _} = boxPort
   pure (match, rhsNode)
  where
diff --git a/brat/test/golden/error/vec_length.brat.golden b/brat/test/golden/error/vec_length.brat.golden
index 3f99f4b5..94f082ff 100644
--- a/brat/test/golden/error/vec_length.brat.golden
+++ b/brat/test/golden/error/vec_length.brat.golden
@@ -2,5 +2,5 @@ Error in test/golden/error/vec_length.brat on line 2:
 f(_, _, xs) = xs
               ^^
 
-  Unification error: Can't make Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_$lhs_lambda.0_setup/in 1 = 1 + VPar Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_$lhs_lambda.0_setup/in 1
+  Unification error: Can't make Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_lambda.0_rhs/in_1 1 = 1 + VPar Ex checking_check_defs_1_f_LambdaChk_7_checkClauses_1_lambda.0_rhs/in_1 1
 

From a535dc17421ded5fac2b03789c8a901ca6cee9a6 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 23 Apr 2025 09:31:00 +0100
Subject: [PATCH 153/182] Add dynamic when we see a hope

---
 brat/Brat/Checker.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index eef3db0e..fac2d9fe 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -706,6 +706,7 @@ check' Hope ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
     (_, [(hungry, _)], [(dangling, _)], _) <- anext "$!" Id (S0, Some (Zy :* S0))
                                               (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
+    req (ANewDynamic (toEnd bang) fc)
     wire (dangling, kindType k, NamedPort bang "")
     defineTgt' "check hope (tgt)" tgt (endVal k (toEnd hungry))
     defineSrc' "check hope (src)" dangling (endVal k (toEnd hungry))

From 8e0d2cfad591ba9c64667f9fb9b335af6cdabf3e Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 2 Dec 2025 10:44:57 +0000
Subject: [PATCH 154/182] Add optional names to Hopes

---
 brat/Brat/Checker.hs         |  4 ++--
 brat/Brat/Checker/Helpers.hs |  2 +-
 brat/Brat/Elaborator.hs      |  2 +-
 brat/Brat/Parser.hs          |  8 ++++++-
 brat/Brat/Syntax/Concrete.hs |  2 +-
 brat/Brat/Syntax/Core.hs     |  4 ++--
 brat/Brat/Syntax/Raw.hs      |  6 ++---
 brat/Brat/Unelaborator.hs    |  4 ++--
 brat/examples/infer.brat     | 46 ++++++++++++++++++++++++++++++++++++
 9 files changed, 65 insertions(+), 13 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index fac2d9fe..4d315a84 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -701,9 +701,9 @@ check' (Of n e) ((), unders) = case ?my of
       (elems, unders, rightUnders) <- getVecs len unders
       pure ((tgt, el):elems, (tgt, ty):unders, rightUnders)
   getVecs _ unders = pure ([], [], unders)
-check' Hope ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
+check' (Hope ident) ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) of
   (Braty, Left k) -> do
-    (_, [(hungry, _)], [(dangling, _)], _) <- anext "$!" Id (S0, Some (Zy :* S0))
+    (_, [(hungry, _)], [(dangling, _)], _) <- anext ("$!" ++ ident) Id (S0, Some (Zy :* S0))
                                               (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
     req (ANewDynamic (toEnd bang) fc)
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 7f799f5f..8e3cc859 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -705,7 +705,7 @@ allowedToSolve me it =
       itBwd = (B0 <>< itFwd)
   in  case (it, dollarAndItsPrefix me, dollarAndItsPrefix itBwd) of
         -- Solving a hope
-        (InEnd _, Just (region, "rhs"), Just (maker, "!"))
+        (InEnd _, Just (region, "rhs"), Just (maker, '!':_))
           | Just region == prefixLeftOf maker "$rhs"
            ->
           trackPermission ("Allowed to solve:\n  " ++ show me ++ " / " ++ show it)
diff --git a/brat/Brat/Elaborator.hs b/brat/Brat/Elaborator.hs
index 5a4ed219..2546dca3 100644
--- a/brat/Brat/Elaborator.hs
+++ b/brat/Brat/Elaborator.hs
@@ -91,7 +91,7 @@ elaborate (WC fc x) = do
 
 elaborate' :: Flat -> Either Error SomeRaw'
 elaborate' (FVar x) = pure $ SomeRaw' (RVar x)
-elaborate' FHope = pure $ SomeRaw' RHope
+elaborate' (FHope ident) = pure $ SomeRaw' (RHope ident)
 elaborate' (FArith op a b) = do
   (SomeRaw a) <- elaborate a
   (SomeRaw b) <- elaborate b
diff --git a/brat/Brat/Parser.hs b/brat/Brat/Parser.hs
index 1b0e6513..e9ce29fe 100644
--- a/brat/Brat/Parser.hs
+++ b/brat/Brat/Parser.hs
@@ -413,9 +413,15 @@ atomExpr = simpleExpr <|> inBracketsFC Paren (unWC <$> expr)
             <|> var
             <|> fmap (const FUnderscore) <$> matchFC Underscore
             <|> fmap (const FIdentity) <$> matchFC Pipe
-            <|> fmap (const FHope) <$> matchFC Bang
+            <|> pHope
 
 
+pHope :: Parser (WC Flat)
+pHope = do
+  WC bangFC () <- matchFC Bang
+  maybeWCName <- optional simpleName
+  pure (maybe (WC bangFC (FHope "")) (\(WC identFC ident) -> WC (spanFC bangFC identFC) (FHope ident)) maybeWCName)
+
 {- Infix operator precedence table (See Brat.Syntax.Common.Precedence)
 (loosest to tightest binding):
    =>
diff --git a/brat/Brat/Syntax/Concrete.hs b/brat/Brat/Syntax/Concrete.hs
index 3e07bb44..10bcb2e0 100644
--- a/brat/Brat/Syntax/Concrete.hs
+++ b/brat/Brat/Syntax/Concrete.hs
@@ -22,7 +22,7 @@ type FEnv = ([FDecl], [RawAlias])
 
 data Flat
  = FVar QualName
- | FHope
+ | FHope String
  | FApp (WC Flat) (WC Flat)
  | FJuxt (WC Flat) (WC Flat)
  | FThunk (WC Flat)
diff --git a/brat/Brat/Syntax/Core.hs b/brat/Brat/Syntax/Core.hs
index c9dbd046..286b2f0f 100644
--- a/brat/Brat/Syntax/Core.hs
+++ b/brat/Brat/Syntax/Core.hs
@@ -49,7 +49,7 @@ data Term :: Dir -> Kind -> Type where
   Pull     :: [PortName] -> WC (Term Chk k) -> Term Chk k
   Var      :: QualName -> Term Syn Noun  -- Look up in noun (value) env
   Identity :: Term Syn UVerb
-  Hope     :: Term Chk Noun
+  Hope     :: String -> Term Chk Noun
   Arith    :: ArithOp -> WC (Term Chk Noun) -> WC (Term Chk Noun) -> Term Chk Noun
   Of       :: WC (Term Chk Noun) -> WC (Term d Noun) -> Term d Noun
 
@@ -117,7 +117,7 @@ instance Show (Term d k) where
 
   show (Var x) = show x
   show Identity = "|"
-  show Hope = "!"
+  show (Hope ident) = '!':ident
   -- Nested applications should be bracketed too, hence 4 instead of 3
   show (fun :$: arg) = bracket PApp fun ++ ('(' : show arg ++ ")")
   show (tm ::: ty) = bracket PAnn tm ++ " :: " ++ show ty
diff --git a/brat/Brat/Syntax/Raw.hs b/brat/Brat/Syntax/Raw.hs
index 62934f1b..956cc55f 100644
--- a/brat/Brat/Syntax/Raw.hs
+++ b/brat/Brat/Syntax/Raw.hs
@@ -71,7 +71,7 @@ data Raw :: Dir -> Kind -> Type where
   RPull     :: [PortName] -> WC (Raw Chk k) -> Raw Chk k
   RVar      :: QualName -> Raw Syn Noun
   RIdentity :: Raw Syn UVerb
-  RHope     :: Raw Chk Noun
+  RHope     :: String -> Raw Chk Noun
   RArith    :: ArithOp -> WC (Raw Chk Noun) -> WC (Raw Chk Noun) -> Raw Chk Noun
   ROf       :: WC (Raw Chk Noun) -> WC (Raw d Noun) -> Raw d Noun
   (:::::)   :: WC (Raw Chk Noun) -> [RawIO] -> Raw Syn Noun
@@ -103,7 +103,7 @@ instance Show (Raw d k) where
     = unwords ["let", show abs, "=", show xs, "in", show body]
   show (RNHole name) = '?':name
   show (RVHole name) = '?':name
-  show RHope = "!"
+  show (RHope ident) = '!':ident
   show (RSimple tm) = show tm
   show RPass = show "pass"
   show REmpty = "()"
@@ -203,7 +203,7 @@ instance (Kindable k) => Desugarable (Raw d k) where
   -- TODO: holes need to know their arity for type checking
   desugar' (RNHole strName) = NHole . (strName,) <$> freshM strName
   desugar' (RVHole strName) = VHole . (strName,) <$> freshM strName
-  desugar' RHope = pure Hope
+  desugar' (RHope ident) = pure (Hope ident)
   desugar' RPass = pure Pass
   desugar' (RSimple simp) = pure $ Simple simp
   desugar' REmpty = pure Empty
diff --git a/brat/Brat/Unelaborator.hs b/brat/Brat/Unelaborator.hs
index 5ff57492..b06509f0 100644
--- a/brat/Brat/Unelaborator.hs
+++ b/brat/Brat/Unelaborator.hs
@@ -38,7 +38,7 @@ unelab _ _ (Con c args) = FCon c (unelab Chky Nouny <$> args)
 unelab _ _ (C (ss :-> ts)) = FFn (toRawRo ss :-> toRawRo ts)
 unelab _ _ (K cty) = FKernel $ fmap (\(p, ty) -> Named p (toRaw ty)) cty
 unelab _ _ Identity = FIdentity
-unelab _ _ Hope = FHope
+unelab _ _ (Hope ident) = FHope ident
 unelab _ _ FanIn = FFanIn
 unelab _ _ FanOut = FFanOut
 
@@ -68,7 +68,7 @@ toRaw (Con c args) = RCon c (toRaw <$> args)
 toRaw (C (ss :-> ts)) = RFn (toRawRo ss :-> toRawRo ts)
 toRaw (K cty) = RKernel $ (\(p, ty) -> Named p (toRaw ty)) <$> cty
 toRaw Identity = RIdentity
-toRaw Hope = RHope
+toRaw (Hope ident) = RHope ident
 toRaw FanIn = RFanIn
 toRaw FanOut = RFanOut
 
diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index dacdb0a7..112c3cd7 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -5,3 +5,49 @@ map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
 mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
 mapVec(_, _, _, _, []) = []
 mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+
+--map(X :: *, Y :: *, { X -> Y }, List(X)) -> List(Y)
+--map(_, _, _, []) = []
+--map(_, _, f, x ,- xs) = f(x) ,- map(!, !, f, xs)
+
+--mapVec(X :: *, Y :: *, { X -> Y }, n :: #, Vec(X, n)) -> Vec(Y, n)
+--mapVec(_, _, _, _, []) = []
+--mapVec(_, _, f, n, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
+
+--length(X :: *, n :: #, Vec(X, n)) -> (m :: #)
+--length(_, n, []) = n
+--length(_, n, x ,- xs) = n
+
+-- The "succ" still being required in both of these cases is https://github.com/CQCL/brat/issues/35
+
+-- While map above can infer the holes from the other arguments,
+-- here we need to infer the holes (arguments) from the results:
+-- repeat(X :: *, n :: #, x :: X) -> Vec(X, n)
+-- repeat(_, 0, _) = []
+-- repeat(_, succ(_), x) = x ,- repeat(!, !, x) -- X can be inferred from x but n cannot
+-- 
+-- mapFirst(X :: *, Y :: *, { X -> Y}, n :: #, Vec(X, n)) -> Vec(Y, n)
+-- mapFirst(_, _, _, _, []) = []
+-- mapFirst(_, _, f, succ(_), x ,- _) = repeat(!, !, f(x)) -- first ! (X) is second _ (Y)
+-- 
+-- isfull(n :: #) -> Bool
+-- isfull(succ(doub(n))) = isfull(n)
+-- isfull(0) = true
+-- isfull(_) = false
+-- 
+-- hasfulllen(n :: #, Vec(Bool, n)) -> Bool
+-- hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(!, xs)
+-- hasfulllen(_, []) = true
+-- hasfulllen(_, _) = false
+-- 
+-- eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
+-- eatsfull(n, _) = n
+-- mkftwo :: Nat
+-- mkftwo = eatsfull(!, [false,false,false])
+-- 
+-- eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
+-- eatsodd(n, _) = n
+-- mkotwo' :: Nat
+-- mkotwo' = eatsodd(2, [false,false,false,false,false])
+-- mkotwo :: Nat
+-- mkotwo = eatsodd(!, [false,false,false,false,false])

From 4d1e055e56d53c8230276a4d8a936337f1a6bf51 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 14:12:51 +0000
Subject: [PATCH 155/182] Ditch extra inputs in pattern match; inline undo

---
 brat/Brat/Compile/Hugr.hs               | 104 +++++++++++++++---------
 brat/Brat/Graph.hs                      |   9 +-
 brat/test/golden/graph/addN.brat.graph  |   2 +-
 brat/test/golden/graph/addN2.brat.graph |   2 +-
 brat/test/golden/graph/id.brat.graph    |   2 +-
 brat/test/golden/graph/rx.brat.graph    |   2 +-
 brat/test/golden/graph/swap.brat.graph  |   2 +-
 7 files changed, 78 insertions(+), 45 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 7d5d16ca..b52d3248 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -25,13 +25,14 @@ import Bwd
 import Control.Monad.Freer
 import Data.Hugr
 import Hasochism
+import Util
 
 import Control.Exception (assert)
 import Control.Monad (unless)
 import Data.Aeson
 import Data.Bifunctor (first, second)
 import qualified Data.ByteString.Lazy as BS
-import Data.Foldable (traverse_, for_)
+import Data.Foldable (for_)
 import Data.Functor ((<&>), ($>))
 import Data.List (partition, sort, sortBy)
 import qualified Data.Map as M
@@ -286,13 +287,47 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   let TestMatchData my matchSeq = matchData
   matchSeq <- compileGraphTypes (fmap (binderToValue my) matchSeq)
 
-  let portTbl = zip (fst <$> matchInputs matchSeq) ins
+{-
+  -- Dilemma: we want to compile this extra stuff *if we use it* and put it in
+  -- the port table. Otherwise it causes problems *because* the stuff isn't used.
+  extraStuff <- for extraInps $ \(src@(NamedPort out@(Ex bratNode port) _), ty) -> do
+       hugrNode <- compileWithInputs parent bratNode >>= \case
+         Just node -> pure (Port node port)
+         Nothing -> error $ "Couldn't compile " ++ show bratNode
+       -- TODO: This probably isn't working hard enough - might the type have deps?
+       let hugrTy = compileType (binderToValue my ty)
+       pure (src, (hugrNode, hugrTy))
+-}
+
+{-
+       case [ bang "wee" ns tgtEnd | (src', _, In tgtEnd _) <- es, out == src'] of
+--         [BratNode Hypo _ _] -> pure []
+--         [KernelNode Hypo _ _] -> pure []
+         _ -> do
+          compiledMap <- gets compiled
+          hugrNode <- case M.lookup bratNode compiledMap of
+            Nothing -> error $ show bratNode ++ " not found in\n" ++ intercalate "\n" (show <$> M.toList compiledMap)
+            Just node -> pure (Port node port)
+
+
+          -- IS THIS WHERE THE EXTRA INPUT IS COMING FROM
+          let hugrTy = compileType (binderToValue my ty)
+          traceM ("EXTRA INPUT:\n" ++ show src ++ "\n" ++ show hugrTy)
+          hugrNode <- compileWithInputs parent bratNode >>= \case
+            Just node -> pure (Port node port)
+            Nothing -> error $ "Couldn't compile " ++ show bratNode
+          -- TODO: This probably isn't working hard enough - might the type have deps?
+          let hugrTy = compileType (binderToValue my ty)
+          pure [(src, (hugrNode, hugrTy))])
+-}
+
+  let portTbl = fromJust (zipSameLength (fst <$> matchInputs matchSeq) ins)
   testResult <- compileMatchSequence parent portTbl matchSeq
 
   -- Feed the test result into a conditional
-  makeConditional ("clause of " ++ show rhs) parent testResult [] [("didntMatch", didntMatch outTys)
-                                                                  ,("didMatch", didMatch outTys)
-                                                                  ]
+  makeConditional ("clause of " ++ show rhs) parent testResult [("didntMatch", didntMatch outTys)
+                                                               ,("didMatch", didMatch outTys)
+                                                               ]
  where
   didntMatch :: [HugrType] -> NodeId -> [TypedPort] -> Compile [TypedPort]
   didntMatch outTys parent ins = case nonEmpty clauses of
@@ -613,7 +648,7 @@ compileKernBox parent name contents cty = do
 -- Return a sum whose first component is the types we started with in the order
 -- specified by the portTable argument.
 --
--- In the happy path we return wires in the order of `matchOutputs`
+-- In the happy path we return wires in the order of `rhsInputs`
 -- otherwise, the order is the same as how they came in via the portTable
 compileMatchSequence :: NodeId -- The parent node
                      -> [(Src  -- Things we've matched or passed through, coming from an Input node
@@ -621,10 +656,7 @@ compileMatchSequence :: NodeId -- The parent node
                      -> MatchSequence HugrType
                      -> Compile TypedPort
 compileMatchSequence parent portTable (MatchSequence {..}) = do
-  unless
-    ((second snd <$> portTable) == matchInputs)
-    (error "compileMatchSequence assert failed")
-  let sumTy = SoR [snd <$> matchInputs, snd <$> matchOutputs]
+  let sumTy = SoR [snd <$> matchInputs, snd <$> rhsInputs]
   case matchTests of
     (src, primTest):tests -> do
       -- Pick the port corresponding to the source we want to test
@@ -635,17 +667,20 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
       -- other inputs
       testResult <- compilePrimTest parent typedPort primTest
       let testIx = length left
-      let remainingMatchTests = MatchSequence (primTestOuts primTest ++ (second snd <$> others)) tests matchOutputs
-      ports <- makeConditional ("matching " ++ show (src, primTest)) parent testResult (snd <$> others)
-               [("didNotMatch", didNotMatchCase testIx sumTy)
+      let remainingMatchTests = MatchSequence (primTestOuts primTest ++ (second snd <$> others)) tests rhsInputs
+      ports <- makeConditional ("matching " ++ show (src, primTest)) parent testResult
+               [("didNotMatch", \parent _ -> makeRowTag "DidNotMatch" parent 0 sumTy (reorderPortTbl portTable (fst <$> matchInputs)))
                ,("didMatch",    didMatchCase testIx (primTest, snd typedPort) remainingMatchTests sumTy)]
       case ports of
         (port:_) -> pure port
         _ -> error $ "Expected at least one output port from makeConditional: got\n  " ++ show ports
 
     [] -> do
-      -- Reorder into `matchOutputs` order
-      let ins = reorderPortTbl portTable (fst <$> matchOutputs)
+      -- Reorder into `rhsInputs` order
+      rhsInputsRefinedFromUnification <- for rhsInputs $ \input@(src, hugrTy) -> compileWithInputs parent (endName (toEnd src)) >>= \case
+        Nothing -> error $ "Failed to compile rhsInput: " ++ show input
+        Just nodeId -> pure (src, (Port nodeId 0, hugrTy))
+      let ins = reorderPortTbl (portTable <> rhsInputsRefinedFromUnification) (fst <$> rhsInputs)
       -- Need to pack inputs into a tuple before feeding them into a tag node
       ports <- makeRowTag "Success" parent 1 sumTy ins
       case ports of
@@ -667,7 +702,7 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
     -- Remember which port a src corresponds to
     let portTable = zip (fst <$> matchInputs) ins
     didAllTestsSucceed <- compileMatchSequence parent portTable ms
-    makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed []
+    makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed
       [("Undo", undo)
       ,("AllMatched", allMatched)
       ]
@@ -678,29 +713,16 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
          -> Compile [TypedPort]
     undo parent ins = do
       -- Test results, and the rest of the inputs
-      let (refined, other) = splitAt (length (primTestOuts prevTest)) ins
+      let (refined, others) = splitAt (length (primTestOuts prevTest)) ins
       undoPort <- undoPrimTest parent refined oldTy prevTest
       -- Put it back in the right place
-      let (as, bs) = splitAt ix other
+      let (as, bs) = splitAt ix others
       let ins = as ++ undoPort : bs
       makeRowTag "Fail_Undo" parent 0 sumTy ins
 
     allMatched :: NodeId -> [TypedPort] -> Compile [TypedPort]
     allMatched parent = makeRowTag "AllMatched" parent 1 sumTy
 
-  didNotMatchCase :: Int -- The index at which to put the thing we inspected in outputs
-                  -> SumOfRows
-                  -> NodeId
-                  -> [TypedPort]
-                  -> Compile [TypedPort]
-  didNotMatchCase _ _ _ [] = error "No scrutinee input in didNotMatchCase"
-  didNotMatchCase ix sumTy parent (scrutinee:ins) = do
-    let (as, bs) = splitAt ix ins
-    -- We need to wire inputs to a `Tag0`, but bringing the tested src back to
-    -- the original position
-    let ins = as ++ scrutinee:bs
-    makeRowTag "DidNotMatch" parent 0 sumTy ins
-
 makeRowTag :: String -> NodeId -> Int -> SumOfRows -> [TypedPort] -> Compile [TypedPort]
 makeRowTag hint parent tag sor@(SoR sumRows) ins = assert (sumRows !! tag == (snd <$> ins)) $ do
   addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!0))])) ins [compileSumOfRows sor]
@@ -724,20 +746,19 @@ addNodeWithInputs name op inWires outTys = do
 makeConditional :: String    -- Label
                 -> NodeId    -- Parent node id
                 -> TypedPort -- The discriminator
-                -> [TypedPort] -- Other inputs
                 -> [(String, NodeId -> [TypedPort] -> Compile [TypedPort])] -- Must be ordered
                 -> Compile [TypedPort]
-makeConditional lbl parent discrim otherInputs cases = do
+makeConditional lbl _ discrim cases | track ("makeConditional(" ++ show lbl ++ ")\n  " ++ unlines (fst <$> cases) ++ "\n  " ++ show (snd discrim)) False = undefined
+makeConditional lbl parent discrim cases = do
   condId <- freshNode "Conditional"
   let rows = getSumVariants (snd discrim)
-  outTyss <- for (zip (zip [0..] cases) rows) (\((ix, (name, f)), row) -> makeCase condId name ix (row ++ (snd <$> otherInputs)) f)
+  outTyss <- for (fromJust $ zipSameLength (zip [0..] cases) rows) (\((ix, (name, f)), row) -> makeCase condId name ix row f)
   unless
     (allRowsEqual outTyss)
     (error "Conditional output types didn't match")
-  let condOp = OpConditional (Conditional parent rows (snd <$> otherInputs) (head outTyss) [("label", lbl)])
+  let condOp = OpConditional (Conditional parent rows [] (head outTyss) [("label", lbl)])
   addOp condOp condId
   addEdge (fst discrim, Port condId 0)
-  traverse_ addEdge (zip (fst <$> otherInputs) (Port condId <$> [1..]))
   pure $ zip (Port condId <$> [0..]) (head outTyss)
  where
   makeCase :: NodeId -> String -> Int -> [HugrType] -> (NodeId -> [TypedPort] -> Compile [TypedPort]) -> Compile [HugrType]
@@ -761,6 +782,8 @@ compilePrimTest :: NodeId
                 -> PrimTest HugrType -- The test to run
                 -> Compile TypedPort
 compilePrimTest parent (port, ty) (PrimCtorTest c tycon unpackingNode outputs) = do
+  -- PrimCtorTest returns the `outputs` specified in the happy case, else the
+  -- thing that was originally being tested, unchanged.
   let sumOut = HTSum (SG (GeneralSum [[ty], snd <$> outputs]))
   let sig = FunctionType [ty] [sumOut] ["BRAT"]
   testId <- addNode ("PrimCtorTest " ++ show c)
@@ -778,7 +801,8 @@ compilePrimTest parent port@(_, ty) (PrimLitTest tm) = do
   constId <- addNode "LitConst" (OpConst (ConstOp parent (valFromSimple tm)))
   loadPort <- head <$> addNodeWithInputs "LitLoad" (OpLoadConstant (LoadConstantOp parent ty))
                        [(Port constId 0, ty)] [ty]
-  -- Connect to a test node
+  -- PrimLitTest returns an empty sum in the happy case (no extra info), else
+  -- the thing that was originally being tested, unchanged.
   let sumOut = HTSum (SG (GeneralSum [[ty], []]))
   let sig = FunctionType [ty, ty] [sumOut] ["BRAT"]
   head <$> addNodeWithInputs ("PrimLitTest " ++ show tm)
@@ -789,6 +813,12 @@ compilePrimTest parent port@(_, ty) (PrimLitTest tm) = do
 constructorOp :: NodeId -> QualName -> QualName -> FunctionType -> HugrOp NodeId
 constructorOp parent tycon c sig = OpCustom (CustomOp parent "BRAT" ("Ctor::" ++ show tycon ++ "::" ++ show c) sig [])
 
+-- undoPrimTest, reconstructs the scrutinee of a test after the test has been run.
+-- For literal tests, the literal is recorded in the test, so we can just put it
+-- in a const node.
+-- For constructor tests, we assume that the outputs of the test are the
+-- arguments of the constructor, so we can apply them to the constructor in the
+-- same order to reproduce the scrutinee.
 undoPrimTest :: NodeId
              -> [TypedPort] -- The inputs we have to put back together
              -> HugrType -- The type of the thing we're making
diff --git a/brat/Brat/Graph.hs b/brat/Brat/Graph.hs
index 62c4619b..8097feb2 100644
--- a/brat/Brat/Graph.hs
+++ b/brat/Brat/Graph.hs
@@ -59,7 +59,10 @@ deriving instance Show (NodeType a)
 -- tag 0 with the function's inputs returned as they were
 -- tag 1 with the environment of pattern variables from a successful
 data TestMatchData (m :: Mode) where
-  TestMatchData :: Show (BinderType m) => Modey m -> MatchSequence (BinderType m) -> TestMatchData m
+  TestMatchData :: Show (BinderType m)
+                => Modey m
+                -> MatchSequence (BinderType m)
+                -> TestMatchData m
 
 deriving instance Show (TestMatchData a)
 
@@ -67,11 +70,11 @@ deriving instance Show (TestMatchData a)
 -- Invariants:
 --    1. Each src in `matchTests` has been mentioned earlier (either in `matchInputs`
 --       or in the srcs outputted by a previous `PrimCtorTest`
---    2. The same goes for the sources in `matchOutputs`
+--    2. The same goes for the sources in `rhsInputs`
 data MatchSequence ty = MatchSequence
   { matchInputs :: [(Src, ty)]
   , matchTests :: [(Src, PrimTest ty)]
-  , matchOutputs ::[(Src, ty)]
+  , rhsInputs ::[(Src, ty)]
   } deriving (Foldable, Functor, Traversable)
 deriving instance Show ty => Show (MatchSequence ty)
 
diff --git a/brat/test/golden/graph/addN.brat.graph b/brat/test/golden/graph/addN.brat.graph
index 84504c1e..09df6df5 100644
--- a/brat/test/golden/graph/addN.brat.graph
+++ b/brat/test/golden/graph/addN.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
diff --git a/brat/test/golden/graph/addN2.brat.graph b/brat/test/golden/graph/addN2.brat.graph
index a481cd0d..27acb69a 100644
--- a/brat/test/golden/graph/addN2.brat.graph
+++ b/brat/test/golden/graph/addN2.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
diff --git a/brat/test/golden/graph/id.brat.graph b/brat/test/golden/graph/id.brat.graph
index 8467bd30..92a147c9 100644
--- a/brat/test/golden/graph/id.brat.graph
+++ b/brat/test/golden/graph/id.brat.graph
@@ -5,7 +5,7 @@ Nodes:
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
diff --git a/brat/test/golden/graph/rx.brat.graph b/brat/test/golden/graph/rx.brat.graph
index e3ff04df..15d6678f 100644
--- a/brat/test/golden/graph/rx.brat.graph
+++ b/brat/test/golden/graph/rx.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_3_$rhs_check'Th_thunk/in check_defs_1_main_3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
diff --git a/brat/test/golden/graph/swap.brat.graph b/brat/test/golden/graph/swap.brat.graph
index f0c3319e..45a8f41d 100644
--- a/brat/test/golden/graph/swap.brat.graph
+++ b/brat/test/golden/graph/swap.brat.graph
@@ -5,7 +5,7 @@ Nodes:
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit),("a",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])

From b30ccd961cef3789699f54cdb7a99520174fc0b5 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 14:13:13 +0000
Subject: [PATCH 156/182] Process solutions to find extra implicit srcs

---
 brat/Brat/Checker.hs               | 69 ++++++++++++++++++++++++++++--
 brat/Brat/Checker/SolvePatterns.hs |  2 +-
 brat/Brat/Syntax/Value.hs          | 31 ++++++++++++++
 3 files changed, 97 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 4d315a84..0b5f2aaa 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -22,6 +22,7 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import qualified Data.Set as S
+import Data.Traversable (for)
 import Data.Type.Equality ((:~:)(..))
 import Prelude hiding (filter)
 
@@ -29,7 +30,7 @@ import Brat.Checker.Helpers
 import Brat.Checker.Monad
 import Brat.Checker.Quantity
 import Brat.Checker.SolveHoles (typeEq)
-import Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve)
+import Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve, typeOfEnd)
 import Brat.Checker.Types
 import Brat.Constructors
 import Brat.Error
@@ -742,20 +743,27 @@ checkClause my fnName cty clause = modily my $ do
 
   -- First, we check the patterns on the LHS. This requires some overs,
   -- so we make a box, however this box will be skipped during compilation.
-  (sol, match, rhsCty) <- suppressHoles . fmap snd $
+  (sol, match, rhsCty, defs) <- suppressHoles . fmap snd $
        let ?my = my in ("$lhs" -!) $ makeBox (clauseName ++ "_setup") cty $
                      \(overs, unders) -> do
     -- Make a problem to solve based on the lhs and the overs
     problem <- argProblems (fst <$> overs) (unWC $ lhs clause) []
     (tests, sol) <- localFC (fcOf (lhs clause)) $ solve my problem
+    (sol, defs) :: ([(String, (Src, BinderType m))], [((String, TypeKind), Val Z)]) <- case my of
+      Braty -> postProcessSolAndOuts sol unders
+      Kerny -> pure (sol, [])
     -- The solution gives us the variables bound by the patterns.
     -- We turn them into a row
     mkArgRo my S0 ((\(n, (src, ty)) -> (NamedPort (toEnd src) n, ty)) <$> sol) >>= \case
       -- Also make a row for the refined outputs (shifted by the pattern environment)
       Some (patEz :* patRo) -> mkArgRo my patEz (first (fmap toEnd) <$> unders) >>= \case
         Some (_ :* outRo) -> do
-          let match = TestMatchData my $ MatchSequence overs tests (snd <$> sol)
-          pure (sol, match, patRo :->> outRo)
+          let testOuts = snd <$> sol
+          let match = TestMatchData my (MatchSequence overs tests testOuts)
+          trackM $ "[[[[[[TestMatchData\n" ++ show match ++ "\n]]]]]]"
+          pure (sol, match, patRo :->> outRo, fmap (Some . (patEz :*) . abstractEndz patEz) <$> defs)
+
+  for defs $ \((name, kind), Some (_ :* val)) -> trackM ("Def: " ++ show ((name, kind), val))
 
   -- Now actually make a box for the RHS and check it
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
@@ -770,6 +778,59 @@ checkClause my fnName cty clause = modily my $ do
   let NamedPort {end=Ex rhsNode _} = boxPort
   pure (match, rhsNode)
  where
+  -- Process a solution, finding Ends that support the solved types, and return a list of definitions for substituting later on
+  postProcessSolAndOuts :: [(String, (Src, BinderType Brat))] -> [(Tgt, BinderType Brat)] -> Checking ([(String, (Src, BinderType Brat))], [((String, TypeKind), Val Z)])
+  postProcessSolAndOuts sol outputs = worker B0 sol
+   where
+    worker :: Bwd (String, (Src, BinderType Brat)) -> [(String, (Src, BinderType Brat))] -> Checking ([(String, (Src, BinderType Brat))], [((String, TypeKind), Val Z)])
+    worker zx [] = (, []) <$> outputDeps zx [] outputs
+    worker zx (entry@(patVar, (src, Left k)):sol) = let vsrc = VApp (VPar (toEnd src)) B0 in do
+      trackM ("processSol (kinded): " ++ show entry)
+      def <- eval S0 vsrc
+      if def == vsrc
+      then worker (zx :< entry) sol
+      else do
+         outPorts <- depOutPorts def
+         srcAndTys <- for outPorts (\outport -> (NamedPort outport "",) <$> typeOfEnd Braty (ExEnd outport))
+         zx <- pure $ foldl (\sol srcAndTy -> insert ("$" ++ show (end (fst srcAndTy)), srcAndTy) sol) zx srcAndTys
+         (sol, defs) <- worker (zx {-:< entry-}) sol
+         pure ({-(patVar, (src, Left k)):-}sol, ((patVar, k), def):defs)
+    -- Pat vars beginning with '_' aren't in scope, we can ignore them
+    -- (but if they're kinded they might come up later as the dependency of something else)
+    worker zx (('_':_, (src, ty)):sol) = worker zx sol
+    worker zx (entry@(patVar, (src, Right ty)):sol) = do
+      trackM ("processSol (typed): " ++ show entry)
+      ty <- eval S0 ty
+      outPorts <- depOutPorts ty
+      srcAndTys <- for outPorts (\outport -> (NamedPort outport "",) <$> typeOfEnd Braty (ExEnd outport))
+      zx <- pure $ foldl (\sol srcAndTy -> insert ("___" ++ show (end (fst srcAndTy)), srcAndTy) sol) zx srcAndTys
+      worker (zx :< entry) sol
+
+    insert :: (String, (Src, BinderType Brat)) -> Bwd (String, (Src, BinderType Brat)) -> Bwd (String, (Src, BinderType Brat))
+    insert entry@(_, (src, _)) entryz
+     | any (\(_, (src', _f)) -> src == src') entryz = entryz
+     | otherwise = track ("insert: " ++ show entry) $ entryz :< entry
+
+    outputDeps :: Bwd (String, (Src, BinderType Brat)) -- The solution for inputs, so we can make sure we don't duplicate anything
+               -> [Tgt] -- Kinded outputs that we're aware of and want to leave out of the solution
+               -> [(Tgt, BinderType Brat)] -- Outputs we're searching for dependencies
+               -> Checking [(String, (Src, BinderType Brat))]
+    outputDeps sol _ [] = pure (sol <>> [])
+    outputDeps sol ignoredTgts ((tgt, Left k):rest) = outputDeps sol (tgt:ignoredTgts) rest
+    outputDeps sol ignoredTgts ((tgt, Right ty):rest) = do
+      ty <- eval S0 ty
+      let deps = [ outport | ExEnd outport <- depEnds ty]
+      depsWithTys <- for deps (\outport -> (NamedPort outport "",) <$> typeOfEnd Braty (ExEnd outport))
+      sol <- pure $ foldl (\sol srcAndTy -> insert ("___" ++ show (end (fst srcAndTy)), srcAndTy) sol) sol depsWithTys
+      outputDeps sol ignoredTgts rest
+
+    -- We could use some checks around the locality of these things. Are they
+    -- all defined in terms of things which are generated by pattern tests?
+    depOutPorts :: (Show t, DepEnds t) => t -> Checking [OutPort]
+    depOutPorts x = for (depEnds x) $ \case
+      ExEnd outport -> pure outport
+      InEnd inport -> err . TypeErr $ "Type dependency of " ++ show x ++ " (" ++ show inport ++ ") had an ambiguous type."
+
   mkEnv :: (?my :: Modey m) => [String] -> [(Src, BinderType m)] -> Checking (Env (EnvData m))
   mkEnv (x:xs) (src:srcs) = do
     e1 <- singletonEnv x src
diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 39048ec5..e69c93e6 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -1,4 +1,4 @@
-module Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve) where
+module Brat.Checker.SolvePatterns (argProblems, argProblemsWithLeftovers, solve, typeOfEnd) where
 
 import Brat.Checker.Monad
 import Brat.Checker.Helpers
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index f97deebb..3b95fad1 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -632,3 +632,34 @@ numVars nv = [e | VPar e <- vvars nv]
  where
   vvars :: NumVal a -> [a]
   vvars = foldMap pure
+
+class DepEnds t where
+  depEnds :: t -> [End]
+
+instance DepEnds (NumVal (VVar n)) where
+  depEnds nv = [e | VPar e <- vvars nv]
+   where
+    vvars :: NumVal a -> [a]
+    vvars = foldMap pure
+
+instance DepEnds (Val n) where
+  depEnds (VNum nv) = depEnds nv
+  depEnds (VCon _ args) = depEnds args
+  depEnds (VLam body) = depEnds body
+  depEnds (VFun _ cty) = depEnds cty
+  depEnds (VApp (VPar e) args) = e : depEnds args
+  depEnds x = error ("depEnds " ++ show x)
+
+instance DepEnds t => DepEnds [t] where
+  depEnds = concatMap depEnds
+
+instance DepEnds t => DepEnds (Bwd t) where
+  depEnds = foldMap depEnds
+
+instance DepEnds (Ro m i j) where
+  depEnds R0 = []
+  depEnds (RPr (_, ty) ro) = depEnds ty ++ depEnds ro
+  depEnds (REx _ ro) = depEnds ro
+
+instance DepEnds (CTy m n) where
+  depEnds (ss :->> ts) = depEnds ss ++ depEnds ts

From c0649b95f3f275d946ef833bb3647bfdbc589be3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 13:47:57 +0000
Subject: [PATCH 157/182] Fix BRAT graph: make Hypo instead of Id node for
 pattern matching

---
 brat/Brat/Checker/SolvePatterns.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index e69c93e6..4e7117e2 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -115,14 +115,14 @@ solve my ((src, PCon c abs):p) = do
       _ -> case M.lookup c natConstructors of
         -- This `relationToInner` is very sus - it doesn't do any wiring!
         Just (Just _, relationToInner) -> do
-          (node, [], kids@[(dangling, _)], _) <- next "unpacked_nat" Hypo (S0, Some (Zy :* S0))
-            R0 -- we don't need to wire the src in; we just need the inner stuff
+          (node, [], kids@[(dangling, _)], _) <- next "natComponentHypo" Hypo (S0, Some (Zy :* S0))
+            R0
             (REx ("inner", Nat) R0)
+          -- unifyNum should do the wiring for us
           unifyNum
            mine
            (nVar (VPar (ExEnd (end src))))
            (relationToInner (nVar (VPar (toEnd dangling))))
-          -- TODO also do wiring corresponding to relationToInner
           p <- argProblems [dangling] (normaliseAbstractor abs) p
           (tests, sol) <- solve my p
           -- When we get @-patterns, we shouldn't drop this anymore

From 8f55383d8a1ddc0e287b59a5ae7743254407c7ce Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 13:51:04 +0000
Subject: [PATCH 158/182] Feed extra inputs into undo node

---
 brat/Brat/Compile/Hugr.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index b52d3248..f5b3ff92 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -699,9 +699,11 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
                -> [TypedPort]
                -> Compile [TypedPort]
   didMatchCase ix (prevTest, oldTy) ms@(MatchSequence{..}) sumTy parent ins = do
-    -- Remember which port a src corresponds to
-    let portTable = zip (fst <$> matchInputs) ins
-    didAllTestsSucceed <- compileMatchSequence parent portTable ms
+    -- We want to add the stuff generated by tests to the port table
+    let extraInputs = case prevTest of
+          PrimCtorTest _ _ _ newSrcs -> zip (fst <$> newSrcs) ins
+          PrimLitTest _ -> []
+    didAllTestsSucceed <- compileMatchSequence parent (portTable <> extraInputs) ms
     makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed
       [("Undo", undo)
       ,("AllMatched", allMatched)

From 0d01dc0a20280cc76fbe7a6ff9f3784511a21a64 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 14:46:12 +0000
Subject: [PATCH 159/182] Delete commented code

---
 brat/Brat/Compile/Hugr.hs | 34 ----------------------------------
 1 file changed, 34 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index f5b3ff92..dbc78221 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -287,40 +287,6 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   let TestMatchData my matchSeq = matchData
   matchSeq <- compileGraphTypes (fmap (binderToValue my) matchSeq)
 
-{-
-  -- Dilemma: we want to compile this extra stuff *if we use it* and put it in
-  -- the port table. Otherwise it causes problems *because* the stuff isn't used.
-  extraStuff <- for extraInps $ \(src@(NamedPort out@(Ex bratNode port) _), ty) -> do
-       hugrNode <- compileWithInputs parent bratNode >>= \case
-         Just node -> pure (Port node port)
-         Nothing -> error $ "Couldn't compile " ++ show bratNode
-       -- TODO: This probably isn't working hard enough - might the type have deps?
-       let hugrTy = compileType (binderToValue my ty)
-       pure (src, (hugrNode, hugrTy))
--}
-
-{-
-       case [ bang "wee" ns tgtEnd | (src', _, In tgtEnd _) <- es, out == src'] of
---         [BratNode Hypo _ _] -> pure []
---         [KernelNode Hypo _ _] -> pure []
-         _ -> do
-          compiledMap <- gets compiled
-          hugrNode <- case M.lookup bratNode compiledMap of
-            Nothing -> error $ show bratNode ++ " not found in\n" ++ intercalate "\n" (show <$> M.toList compiledMap)
-            Just node -> pure (Port node port)
-
-
-          -- IS THIS WHERE THE EXTRA INPUT IS COMING FROM
-          let hugrTy = compileType (binderToValue my ty)
-          traceM ("EXTRA INPUT:\n" ++ show src ++ "\n" ++ show hugrTy)
-          hugrNode <- compileWithInputs parent bratNode >>= \case
-            Just node -> pure (Port node port)
-            Nothing -> error $ "Couldn't compile " ++ show bratNode
-          -- TODO: This probably isn't working hard enough - might the type have deps?
-          let hugrTy = compileType (binderToValue my ty)
-          pure [(src, (hugrNode, hugrTy))])
--}
-
   let portTbl = fromJust (zipSameLength (fst <$> matchInputs matchSeq) ins)
   testResult <- compileMatchSequence parent portTbl matchSeq
 

From f194222dafaf81fe2b63fc06b618d0f521e85a3a Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 15:09:08 +0000
Subject: [PATCH 160/182] Fix warnings

---
 brat/Brat/Checker.hs              | 9 ++++-----
 brat/Brat/Checker/Helpers.hs      | 1 +
 brat/Brat/Checker/SolveNumbers.hs | 2 +-
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 0b5f2aaa..54cd65a4 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -770,7 +770,6 @@ checkClause my fnName cty clause = modily my $ do
     -- Here we're relying too much on the implementation of typeEq, counting on
     -- the fact that it'll define the first argument in the flex-flex case that
     -- would arise if we've not yet defined the outer src
-
     let vars = fst <$> sol
     let ?my = my in do
       env <- mkEnv vars rhsOvers
@@ -797,8 +796,8 @@ checkClause my fnName cty clause = modily my $ do
          pure ({-(patVar, (src, Left k)):-}sol, ((patVar, k), def):defs)
     -- Pat vars beginning with '_' aren't in scope, we can ignore them
     -- (but if they're kinded they might come up later as the dependency of something else)
-    worker zx (('_':_, (src, ty)):sol) = worker zx sol
-    worker zx (entry@(patVar, (src, Right ty)):sol) = do
+    worker zx (('_':_, _):sol) = worker zx sol
+    worker zx (entry@(_patVar, (_src, Right ty)):sol) = do
       trackM ("processSol (typed): " ++ show entry)
       ty <- eval S0 ty
       outPorts <- depOutPorts ty
@@ -816,8 +815,8 @@ checkClause my fnName cty clause = modily my $ do
                -> [(Tgt, BinderType Brat)] -- Outputs we're searching for dependencies
                -> Checking [(String, (Src, BinderType Brat))]
     outputDeps sol _ [] = pure (sol <>> [])
-    outputDeps sol ignoredTgts ((tgt, Left k):rest) = outputDeps sol (tgt:ignoredTgts) rest
-    outputDeps sol ignoredTgts ((tgt, Right ty):rest) = do
+    outputDeps sol ignoredTgts ((tgt, Left _):rest) = outputDeps sol (tgt:ignoredTgts) rest
+    outputDeps sol ignoredTgts ((_tgt, Right ty):rest) = do
       ty <- eval S0 ty
       let deps = [ outport | ExEnd outport <- depEnds ty]
       depsWithTys <- for deps (\outport -> (NamedPort outport "",) <$> typeOfEnd Braty (ExEnd outport))
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 8e3cc859..09c3468d 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -42,6 +42,7 @@ simpleCheck my ty tm = case (my, ty) of
         Text _ -> defineEnd "simpleCheck" e TText
         Num n | n < 0 -> defineEnd "simpleCheck" e TInt
         Num _ -> typeErr $ "Can't determine whether Int or Nat: " ++ show tm
+        _ -> typeErr $ "Unimplemented: checking literal: " ++ show tm
     else isSkolem e >>= \case
       SkolemConst -> throwLeft $ helper Braty ty tm
       Definable -> do
diff --git a/brat/Brat/Checker/SolveNumbers.hs b/brat/Brat/Checker/SolveNumbers.hs
index 40be5804..8089c506 100644
--- a/brat/Brat/Checker/SolveNumbers.hs
+++ b/brat/Brat/Checker/SolveNumbers.hs
@@ -206,4 +206,4 @@ unifyNum' mine (NumValue lup lgro) (NumValue rup rgro)
     oddGro :: NumVal (VVar Z) -> Checking (NumVal (VVar Z))
     oddGro x = do
      pred <- demandSucc x
-     demandEven pred
\ No newline at end of file
+     demandEven pred

From e5d31c4a2e29e1beb6c78bb884c681292853b234 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Mon, 8 Dec 2025 16:58:35 +0000
Subject: [PATCH 161/182] Dynamics should only be InPorts

---
 brat/Brat/Checker.hs       |  5 ++---
 brat/Brat/Checker/Monad.hs | 18 ++++++++++--------
 brat/Brat/Syntax/Value.hs  |  2 +-
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index 54cd65a4..b59c35a5 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -707,11 +707,10 @@ check' (Hope ident) ((), (tgt@(NamedPort bang _), ty):unders) = case (?my, ty) o
     (_, [(hungry, _)], [(dangling, _)], _) <- anext ("$!" ++ ident) Id (S0, Some (Zy :* S0))
                                               (REx ("hope", k) R0) (REx ("hope", k) R0)
     fc <- req AskFC
-    req (ANewDynamic (toEnd bang) fc)
     wire (dangling, kindType k, NamedPort bang "")
     defineTgt' "check hope (tgt)" tgt (endVal k (toEnd hungry))
     defineSrc' "check hope (src)" dangling (endVal k (toEnd hungry))
-    req (ANewDynamic (toEnd hungry) fc)
+    req (ANewDynamic (end hungry) fc)
     pure (((), ()), ((), unders))
   (Braty, Right _ty) -> typeErr "Can only infer kinded things with !"
   (Kerny, _) -> typeErr "Won't infer kernel typed !"
@@ -1272,6 +1271,6 @@ run ve initStore ns m = do
     -- show multiple error locations
     hs@((_,fc):_) -> Left $ Err (Just fc) (RemainingNatHopes (show . fst <$> hs))
  where
-  isNatKinded tyMap e = case tyMap M.! e of
+  isNatKinded tyMap e = case tyMap M.! (InEnd e) of
     (EndType Braty (Left Nat), _) -> True
     _ -> False
diff --git a/brat/Brat/Checker/Monad.hs b/brat/Brat/Checker/Monad.hs
index 19809181..12f15aca 100644
--- a/brat/Brat/Checker/Monad.hs
+++ b/brat/Brat/Checker/Monad.hs
@@ -75,7 +75,7 @@ data Context = Ctx { globalVEnv :: VEnv
                    -- On the chopping block
                    , hopes :: Hopes
                    -- Ends which need to be solved because they affect runtime behaviour
-                   , dynamicSet :: M.Map End FC
+                   , dynamicSet :: M.Map InPort FC
                    , captureSets :: CaptureSets
                    }
 
@@ -117,8 +117,8 @@ data CheckingSig ty where
   KDone   :: CheckingSig ()
   AskVEnv :: CheckingSig CtxEnv
   Declare :: End -> Modey m -> BinderType m -> IsSkolem -> CheckingSig ()
-  ANewDynamic :: End -> FC -> CheckingSig ()
-  AskDynamics :: CheckingSig (M.Map End FC)
+  ANewDynamic :: InPort -> FC -> CheckingSig ()
+  AskDynamics :: CheckingSig (M.Map InPort FC)
   AddCapture :: Name -> (QualName, [(Src, BinderType Brat)]) -> CheckingSig ()
 
 wrapper :: (forall a. CheckingSig a -> Checking (Maybe a)) -> Checking v -> Checking v
@@ -334,16 +334,18 @@ handler (Define lbl end v k) ctx g = let st@Store{typeMap=tm, valueMap=vm} = sto
         -- to just "have another go".
         Just _ -> let news = News (M.singleton end Unstuck)
                       newDynamics = case v of
-                        VNum nv -> numVars nv
+                        VNum nv -> [ inport | InEnd inport <- depEnds nv ]
                         _ -> []
                   in handler (k news)
                      (ctx { store = st { valueMap = M.insert end v vm },
-                                    dynamicSet = case M.lookup end (dynamicSet ctx) of
-                                      Just fc -> track ("Replace " ++ show end ++ " with " ++ show newDynamics) $
+                                    dynamicSet = case end of
+                                      ExEnd _ -> dynamicSet ctx
+                                      InEnd inport -> case M.lookup inport (dynamicSet ctx) of
+                                        Just fc -> track ("Replace " ++ show end ++ " with " ++ show newDynamics) $
                                                  M.union
                                                  (M.fromList (zip newDynamics (repeat fc)))
-                                                 (M.delete end (dynamicSet ctx))
-                                      Nothing -> dynamicSet ctx
+                                                 (M.delete inport (dynamicSet ctx))
+                                        Nothing -> dynamicSet ctx
                           }) g
 handler (Yield Unstuck k) ctx g = handler (k mempty) ctx g
 handler (Yield (AwaitingAny ends) _k) ctx _ = Left $ dumbErr $ TypeErr $ unlines $
diff --git a/brat/Brat/Syntax/Value.hs b/brat/Brat/Syntax/Value.hs
index 3b95fad1..1af8b94e 100644
--- a/brat/Brat/Syntax/Value.hs
+++ b/brat/Brat/Syntax/Value.hs
@@ -648,7 +648,7 @@ instance DepEnds (Val n) where
   depEnds (VLam body) = depEnds body
   depEnds (VFun _ cty) = depEnds cty
   depEnds (VApp (VPar e) args) = e : depEnds args
-  depEnds x = error ("depEnds " ++ show x)
+  depEnds (VApp _ args) = depEnds args
 
 instance DepEnds t => DepEnds [t] where
   depEnds = concatMap depEnds

From 9e1390025e2661c71cf7c67161e5ba57373028dc Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Tue, 9 Dec 2025 10:41:09 +0000
Subject: [PATCH 162/182] wip: defs and stuff

---
 brat/Brat/Checker.hs         | 33 +++++++++++++++++++++++++--------
 brat/Brat/Checker/Helpers.hs |  8 +++++++-
 2 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index b59c35a5..a8787f4a 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -23,7 +23,7 @@ import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import qualified Data.Set as S
 import Data.Traversable (for)
-import Data.Type.Equality ((:~:)(..))
+import Data.Type.Equality ((:~:)(..), testEquality)
 import Prelude hiding (filter)
 
 import Brat.Checker.Helpers
@@ -766,16 +766,33 @@ checkClause my fnName cty clause = modily my $ do
 
   -- Now actually make a box for the RHS and check it
   ((boxPort, _ty), _) <- let ?my = my in makeBox (clauseName ++ "_rhs") rhsCty $ \(rhsOvers, rhsUnders) -> do
-    -- Here we're relying too much on the implementation of typeEq, counting on
-    -- the fact that it'll define the first argument in the flex-flex case that
-    -- would arise if we've not yet defined the outer src
-    let vars = fst <$> sol
-    let ?my = my in do
-      env <- mkEnv vars rhsOvers
-      localEnv env $ "$rhs" -! (check @m (rhs clause) ((), rhsUnders))
+     defs :: Env (EnvData m) <- case my of
+       Braty -> do
+         let kindedRhsOvers = [ toEnd src | (src, Left _) <- rhsOvers ]
+         case Some S0 <><< kindedRhsOvers of
+           Some stk -> foldMap (\((name, k), Some (stk' :* val)) -> case (stkLen stk, testEquality (stkLen stk) (stkLen stk')) of
+             (ny, Just Refl) -> do
+               src <- mkGraph k (changeVar (InxToPar (AddZ ny) stk) val)
+               singletonEnv name (src, Left k)
+             (_, Nothing) -> err $ InternalError "Invariant violated: Number of deps in defs") defs
+       Kerny -> pure emptyEnv
+     case my of
+       Braty -> trackM $ "Updated defs: " ++ show defs
+       _ -> pure ()
+
+     -- Here we're relying too much on the implementation of typeEq, counting on
+     -- the fact that it'll define the first argument in the flex-flex case that
+     -- would arise if we've not yet defined the outer src
+     let vars = fst <$> sol
+     env <- mkEnv vars rhsOvers
+     (localEnv (env <> defs) $ "$rhs" -! check @m (rhs clause) ((), rhsUnders))
   let NamedPort {end=Ex rhsNode _} = boxPort
   pure (match, rhsNode)
  where
+  (<><<) :: Some (Stack Z End) -> [End] -> Some (Stack Z End)
+  (Some stk) <><< [] = Some stk
+  (Some stk) <><< (x:xs) = Some (stk :<< x) <><< xs
+
   -- Process a solution, finding Ends that support the solved types, and return a list of definitions for substituting later on
   postProcessSolAndOuts :: [(String, (Src, BinderType Brat))] -> [(Tgt, BinderType Brat)] -> Checking ([(String, (Src, BinderType Brat))], [((String, TypeKind), Val Z)])
   postProcessSolAndOuts sol outputs = worker B0 sol
diff --git a/brat/Brat/Checker/Helpers.hs b/brat/Brat/Checker/Helpers.hs
index 09c3468d..38d78c63 100644
--- a/brat/Brat/Checker/Helpers.hs
+++ b/brat/Brat/Checker/Helpers.hs
@@ -468,7 +468,7 @@ runArith _ _ _ = Nothing
 
 buildArithOp :: ArithOp -> Checking ((Tgt, Tgt), Src)
 buildArithOp op = do
-  (_, [(lhs,_), (rhs,_)], [(out,_)], _) <- next (show op) (ArithNode op) (S0, Some (Zy :* S0)) (RPr ("lhs", TNat) (RPr ("rhs", TNat) R0)) (RPr ("value", TNat) R0)
+  (_, [(lhs,_), (rhs,_)], [(out,_)], _) <- next (show op) (ArithNode op) (S0, Some (Zy :* S0)) (REx ("lhs", Nat) (REx ("rhs", Nat) R0)) (REx ("value", Nat) R0)
   pure ((lhs, rhs), out)
 
 buildConst :: SimpleTerm -> Val Z -> Checking Src
@@ -730,3 +730,9 @@ awaitTypeDefinition :: Val Z -> Checking (Val Z)
 awaitTypeDefinition ty = eval S0 ty >>= \case
   VApp (VPar e) _ -> mkYield "awaitTypeDefinition" (S.singleton e) >> awaitTypeDefinition ty
   ty -> pure ty
+
+mkGraph :: TypeKind -> Val Z -> Checking Src
+mkGraph Nat (VNum nv) = buildNatVal nv
+mkGraph k _ = do
+ (_, [], [(src,_)], _) <- next "" (Const Unit) (S0, Some (Zy :* S0)) R0 (REx ("", k) R0)
+ pure src

From ab319617d72288764557fc723885db9dba5da454 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 09:48:37 +0000
Subject: [PATCH 163/182] Use `find` instead of glob in validation script

Because they have different behaviour when there's no matches!
---
 brat/tools/validate.sh | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/tools/validate.sh b/brat/tools/validate.sh
index d2d90975..cadde293 100755
--- a/brat/tools/validate.sh
+++ b/brat/tools/validate.sh
@@ -12,7 +12,7 @@ declare -a FAILED_TEST_MSGS
 UNEXPECTED_PASSES=
 NUM_FAILURES=0
 
-for json in test/compilation/output/*.json; do
+for json in $(find . -maxdepth 1 -name "test/compilation/output/*.json"); do
     echo Validating "$json"
     RESULT=$(cat "$json" | hugr_validator 2>&1)
     if [ $? -ne 0 ]; then
@@ -22,7 +22,7 @@ for json in test/compilation/output/*.json; do
     fi
 done
 
-for invalid_json in test/compilation/output/*.json.invalid; do
+for invalid_json in $(find . -maxdepth 1 -name "test/compilation/output/*.json.invalid"); do
     if (hugr_validator < $invalid_json 2>/dev/null > /dev/null); then
         UNEXPECTED_PASSES="$UNEXPECTED_PASSES $invalid_json"
     fi
@@ -51,4 +51,4 @@ if [ "$UNEXPECTED_PASSES" != "" ]; then
     echo -e $RED "There were unexpected passes: $UNEXPECTED_PASSES" $NO_COLOUR
     RESULT=1
 fi
-exit $RESULT
\ No newline at end of file
+exit $RESULT

From cece89f10dccb4147a23562df01feb71ab57cac3 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 10 Dec 2025 13:51:29 +0000
Subject: [PATCH 164/182] Comment out remaining tests (to follow up on in #92)

---
 brat/test/Test/Checking.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/brat/test/Test/Checking.hs b/brat/test/Test/Checking.hs
index 5b0fd0b2..bb996217 100644
--- a/brat/test/Test/Checking.hs
+++ b/brat/test/Test/Checking.hs
@@ -15,7 +15,11 @@ expectedCheckingFails = map ("examples" </>) ["nested-abstractors.brat"
                                              ,"karlheinz.brat"
                                              ,"karlheinz_alias.brat"
                                              ,"hea.brat"
-                                             ,"infer2.brat" -- https://github.com/Quantinuum/brat/issues/35
+                                             -- https://github.com/Quantinuum/brat/issues/35
+                                             ,"infer2.brat"
+                                             -- https://github.com/Quantinuum/brat/issues/92
+                                             ,"repeated_app.brat"
+                                             ,"adder.brat"
                                              ]
 
 parseAndCheckXF :: [FilePath] -> [TestTree]

From 25e4a026531ad7723f188f85bb6569023c35e7d9 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 10:19:09 +0000
Subject: [PATCH 165/182] infer2.brat passes now

---
 brat/test/Test/Checking.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/brat/test/Test/Checking.hs b/brat/test/Test/Checking.hs
index bb996217..8c8384b7 100644
--- a/brat/test/Test/Checking.hs
+++ b/brat/test/Test/Checking.hs
@@ -15,8 +15,6 @@ expectedCheckingFails = map ("examples" </>) ["nested-abstractors.brat"
                                              ,"karlheinz.brat"
                                              ,"karlheinz_alias.brat"
                                              ,"hea.brat"
-                                             -- https://github.com/Quantinuum/brat/issues/35
-                                             ,"infer2.brat"
                                              -- https://github.com/Quantinuum/brat/issues/92
                                              ,"repeated_app.brat"
                                              ,"adder.brat"

From 8e0f2c4eb1344fa49f7d2cc43f0ffeea968f14a4 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 10:19:19 +0000
Subject: [PATCH 166/182] Update golden value (matchOutputs -> rhsInputs)

---
 brat/test/golden/graph/kernel.brat.graph | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/brat/test/golden/graph/kernel.brat.graph b/brat/test/golden/graph/kernel.brat.graph
index e918270f..9bb8cea9 100644
--- a/brat/test/golden/graph/kernel.brat.graph
+++ b/brat/test/golden/graph/kernel.brat.graph
@@ -23,7 +23,7 @@ Nodes:
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("a1",Vec(Qubit, 3))] [])
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
 (check_defs_1_id3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
 (check_defs_1_id3_$rhs_check'Th_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
 (check_defs_1_id3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_id3_$rhs_check'Th_thunk/in check_defs_1_id3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])

From 7a61e38fb1974896be0a0f7b186605be6b28851b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 10 Dec 2025 13:51:09 +0000
Subject: [PATCH 167/182] Comment out compilation tests

---
 brat/test/Main.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index 2c67e0cb..d2d95475 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -4,7 +4,7 @@ import Test.Tasty.Silver.Interactive (defaultMain)
 import Test.Abstractor
 import Test.Checking
 import Test.Graph
-import Test.Compile.Hugr
+--import Test.Compile.Hugr
 import Test.Elaboration
 import Test.Failure
 import Test.Libs
@@ -62,7 +62,7 @@ main = do
   failureTests  <- getFailureTests
   checkingTests <- getCheckingTests
   parsingTests <- getParsingTests
-  compilationTests <- setupCompilationTests
+  -- compilationTests <- setupCompilationTests
   graphTests <- getGraphTests
   let coroTests = testGroup "coroutine"
        [testCase "coroT1" $ assertChecking coroT1
@@ -79,7 +79,7 @@ main = do
                                 ,elaborationTests
                                 ,substitutionTests
                                 ,abstractorTests
-                                ,compilationTests
+                                --,compilationTests
                                 ,typeArithTests
                                 ,coroTests
                                 ]

From 3b476e6ef3b1d11b6af7ced93322709f9e97c0a5 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 12 Dec 2025 12:07:11 +0000
Subject: [PATCH 168/182] whitespace

---
 brat/examples/infer.brat | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/brat/examples/infer.brat b/brat/examples/infer.brat
index 112c3cd7..f1eaf0bf 100644
--- a/brat/examples/infer.brat
+++ b/brat/examples/infer.brat
@@ -25,26 +25,26 @@ mapVec(_, _, f, _, x ,- xs) = f(x) ,- mapVec(!, !, f, !, xs)
 -- repeat(X :: *, n :: #, x :: X) -> Vec(X, n)
 -- repeat(_, 0, _) = []
 -- repeat(_, succ(_), x) = x ,- repeat(!, !, x) -- X can be inferred from x but n cannot
--- 
+--
 -- mapFirst(X :: *, Y :: *, { X -> Y}, n :: #, Vec(X, n)) -> Vec(Y, n)
 -- mapFirst(_, _, _, _, []) = []
 -- mapFirst(_, _, f, succ(_), x ,- _) = repeat(!, !, f(x)) -- first ! (X) is second _ (Y)
--- 
+--
 -- isfull(n :: #) -> Bool
 -- isfull(succ(doub(n))) = isfull(n)
 -- isfull(0) = true
 -- isfull(_) = false
--- 
+--
 -- hasfulllen(n :: #, Vec(Bool, n)) -> Bool
 -- hasfulllen(n, x ,- (xs =,= ys)) = hasfulllen(!, xs)
 -- hasfulllen(_, []) = true
 -- hasfulllen(_, _) = false
--- 
+--
 -- eatsfull(n :: #, xs :: Vec(Bool, full(n))) -> Nat
 -- eatsfull(n, _) = n
 -- mkftwo :: Nat
 -- mkftwo = eatsfull(!, [false,false,false])
--- 
+--
 -- eatsodd(n :: #, xs :: Vec(Bool, succ(doub(n)))) -> Nat
 -- eatsodd(n, _) = n
 -- mkotwo' :: Nat

From 7ad3d6336613816104787add3acfe5420849a119 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 12:07:18 +0000
Subject: [PATCH 169/182] Delete outdated comment

---
 brat/Brat/Checker/SolvePatterns.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/brat/Brat/Checker/SolvePatterns.hs b/brat/Brat/Checker/SolvePatterns.hs
index 4e7117e2..cd49a366 100644
--- a/brat/Brat/Checker/SolvePatterns.hs
+++ b/brat/Brat/Checker/SolvePatterns.hs
@@ -98,10 +98,6 @@ solve my ((src, PCon c abs):p) = do
   ty <- typeOfSrc my src
   mine <- mineToSolve
   case (my, ty) of
-    -- TODO: When solving constructors, we need to provide actual wiring to get
-    -- from the fully applied constructor to the bound pattern variables.
-    -- E.g. for cons(x, xs), we need to actually take apart a Vec to get the x
-    -- and xs to put in the environment
     (Kerny, ty) -> solveConstructor Kerny src (c, abs) ty p
     (Braty, Right ty) -> solveConstructor Braty src (c, abs) ty p
     (Braty, Left Nat) -> case c of

From 749e7a34e11aa8f25e5a35a66befc0d597f865ba Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 12:22:55 +0000
Subject: [PATCH 170/182] Revert "Comment out compilation tests"

This reverts commit 7a61e38fb1974896be0a0f7b186605be6b28851b.
---
 brat/test/Main.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/brat/test/Main.hs b/brat/test/Main.hs
index d2d95475..2c67e0cb 100644
--- a/brat/test/Main.hs
+++ b/brat/test/Main.hs
@@ -4,7 +4,7 @@ import Test.Tasty.Silver.Interactive (defaultMain)
 import Test.Abstractor
 import Test.Checking
 import Test.Graph
---import Test.Compile.Hugr
+import Test.Compile.Hugr
 import Test.Elaboration
 import Test.Failure
 import Test.Libs
@@ -62,7 +62,7 @@ main = do
   failureTests  <- getFailureTests
   checkingTests <- getCheckingTests
   parsingTests <- getParsingTests
-  -- compilationTests <- setupCompilationTests
+  compilationTests <- setupCompilationTests
   graphTests <- getGraphTests
   let coroTests = testGroup "coroutine"
        [testCase "coroT1" $ assertChecking coroT1
@@ -79,7 +79,7 @@ main = do
                                 ,elaborationTests
                                 ,substitutionTests
                                 ,abstractorTests
-                                --,compilationTests
+                                ,compilationTests
                                 ,typeArithTests
                                 ,coroTests
                                 ]

From 3cbe1b74c8e7cf959c744bb379fe877fe753e383 Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Fri, 12 Dec 2025 12:31:14 +0000
Subject: [PATCH 171/182] validate: Fix dodgy find in bash script

---
 brat/tools/validate.sh | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/tools/validate.sh b/brat/tools/validate.sh
index cadde293..2a4342a0 100755
--- a/brat/tools/validate.sh
+++ b/brat/tools/validate.sh
@@ -12,7 +12,7 @@ declare -a FAILED_TEST_MSGS
 UNEXPECTED_PASSES=
 NUM_FAILURES=0
 
-for json in $(find . -maxdepth 1 -name "test/compilation/output/*.json"); do
+for json in $(find test/compilation/output -maxdepth 1 -name "*.json"); do
     echo Validating "$json"
     RESULT=$(cat "$json" | hugr_validator 2>&1)
     if [ $? -ne 0 ]; then
@@ -22,7 +22,7 @@ for json in $(find . -maxdepth 1 -name "test/compilation/output/*.json"); do
     fi
 done
 
-for invalid_json in $(find . -maxdepth 1 -name "test/compilation/output/*.json.invalid"); do
+for invalid_json in $(find test/compilation/output -maxdepth 1 -name "*.json.invalid"); do
     if (hugr_validator < $invalid_json 2>/dev/null > /dev/null); then
         UNEXPECTED_PASSES="$UNEXPECTED_PASSES $invalid_json"
     fi

From 88cc21f8e8045ded12926f0c4bdc357e11674206 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 12 Dec 2025 12:47:31 +0000
Subject: [PATCH 172/182] Stop using assert, it seems unreliable

---
 brat/Brat/Checker.hs      | 5 +++--
 brat/Brat/Compile/Hugr.hs | 7 ++++---
 brat/Brat/Load.hs         | 3 +--
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index a8787f4a..6bc2643a 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -10,7 +10,6 @@ module Brat.Checker (checkBody
                     ,CheckConstraints
                     ) where
 
-import Control.Exception (assert)
 import Control.Monad (foldM, forM, zipWithM_)
 import Control.Monad.Freer
 import Data.Bifunctor
@@ -644,9 +643,11 @@ check' (Of n e) ((), unders) = case ?my of
               -- Wire up the outputs of the replicate nodes to the _used_ vec
               -- unders. The remainder of the replicate nodes don't get used.
               -- (their inputs live in `elemRightUnders`)
-              assert (length repOvers >= length usedVecUnders) $ do
+              if length repOvers >= length usedVecUnders
+              then do
                 zipWithM_ (\(dangling, _) (hungry, ty) -> wire (dangling, ty, hungry)) repOvers usedVecUnders
                 pure (((), ()), ((), (second Right <$> unusedVecUnders) ++ rightUnders))
+              else error $ "repOvers " ++ show repOvers ++ "should be >= usedVecUnders " ++ show usedVecUnders
 
             _ -> localFC (fcOf e) $ typeErr "No type dependency allowed when using `of`"
       Syny -> do
diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index dbc78221..06d13101 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -27,7 +27,6 @@ import Data.Hugr
 import Hasochism
 import Util
 
-import Control.Exception (assert)
 import Control.Monad (unless)
 import Data.Aeson
 import Data.Bifunctor (first, second)
@@ -692,8 +691,10 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
     allMatched parent = makeRowTag "AllMatched" parent 1 sumTy
 
 makeRowTag :: String -> NodeId -> Int -> SumOfRows -> [TypedPort] -> Compile [TypedPort]
-makeRowTag hint parent tag sor@(SoR sumRows) ins = assert (sumRows !! tag == (snd <$> ins)) $ do
-  addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!0))])) ins [compileSumOfRows sor]
+makeRowTag hint parent tag sor@(SoR sumRows) ins =
+  if sumRows !! tag == (snd <$> ins)
+  then addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!0))])) ins [compileSumOfRows sor]
+  else error "Elements do not match tag"
 
 getSumVariants :: HugrType -> [[HugrType]]
 getSumVariants (HTSum (SU (UnitSum n))) = replicate n []
diff --git a/brat/Brat/Load.hs b/brat/Brat/Load.hs
index 41f56d06..75570454 100644
--- a/brat/Brat/Load.hs
+++ b/brat/Brat/Load.hs
@@ -24,7 +24,6 @@ import Brat.QualName
 import Util (duplicates,duplicatesWith)
 import Hasochism
 
-import Control.Exception (assert)
 import Control.Monad (filterM, foldM, forM, forM_, unless)
 import Control.Monad.Except
 import Control.Monad.Trans.Class (lift)
@@ -166,7 +165,7 @@ loadStmtsWithEnv ns (venv, oldDecls, oldEndData) (fname, pre, stmts, cts) = addS
   venv <- pure $ venv <> M.fromList [(name, overs) | ((name, _), (_, overs)) <- entries]
   ((), (holes, newEndData, graph, capSets)) <- run venv kcStore newRoot $ withAliases aliases $ do
     remaining <- "check_defs" -! foldM checkDecl' to_define vdecls
-    pure $ assert (M.null remaining) () -- all to_defines were defined
+    if M.null remaining then pure () else error $ "loadStmtsWithEnv: expected to define " ++ show (M.keys remaining)
   pure (venv, oldDecls <> vdecls, holes, oldEndData <> newEndData, kcGraph <> graph, capSets)
  where
   checkDecl' :: M.Map QualName [(Tgt, BinderType Brat)]

From df99998003eff1b91a19d99023b924c657300270 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 12 Dec 2025 13:03:21 +0000
Subject: [PATCH 173/182] Improve error message in MakeRowTag, and row metadata

---
 brat/Brat/Compile/Hugr.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 06d13101..6d9874c9 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -693,8 +693,8 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
 makeRowTag :: String -> NodeId -> Int -> SumOfRows -> [TypedPort] -> Compile [TypedPort]
 makeRowTag hint parent tag sor@(SoR sumRows) ins =
   if sumRows !! tag == (snd <$> ins)
-  then addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!0))])) ins [compileSumOfRows sor]
-  else error "Elements do not match tag"
+  then addNodeWithInputs (hint ++ "_Tag") (OpTag (TagOp parent tag sumRows [("hint", hint), ("tag", show tag), ("row", show (sumRows!!tag))])) ins [compileSumOfRows sor]
+  else error $ "In makeRowTag " ++ hint ++ ", Elements " ++ show (snd <$> ins) ++ " do not match tag " ++ show tag ++ " of " ++ show sumRows
 
 getSumVariants :: HugrType -> [[HugrType]]
 getSumVariants (HTSum (SU (UnitSum n))) = replicate n []

From 104fac594d8d77c0569ce2dd163dceebf380f9e1 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Fri, 12 Dec 2025 13:08:22 +0000
Subject: [PATCH 174/182] xfail test/compilation tests too, for issue #94

---
 brat/test/Test/Compile/Hugr.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index 1c31066b..c299eff2 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -35,6 +35,7 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"let"
   ,"patterns"
   ,"qft"
+  ,"infer2" -- https://github.com/Quantinuum/brat/issues/94
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
   ,"vector_solve" -- Generates "Pow" nodes which aren't implemented yet
@@ -51,6 +52,11 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"vlup_covering"
   ]
 
+nonCompilingTests = map ((++ ".brat") . ("test" </>) . ("compilation" </>))
+  ["closures" -- https://github.com/Quantinuum/brat/issues/94
+  ,"parity" -- https://github.com/Quantinuum/brat/issues/94
+  ]
+
 compileToOutput :: FilePath -> TestTree
 compileToOutput file = testCaseInfo (show file) $ compileFile [] file >>= \case
     Right bs -> do
@@ -65,7 +71,7 @@ setupCompilationTests = do
   tests <- findByExtension [".brat"] prefix
   examples <- findByExtension [".brat"] examplesPrefix
   createDirectoryIfMissing False outputDir
-  let compileTests = compileToOutput <$> tests
+  let compileTests = expectFailForPaths nonCompilingTests compileToOutput tests
   let examplesTests = testGroup "examples" $ expectFailForPaths nonCompilingExamples compileToOutput examples
 
   pure $ testGroup "compilation" (examplesTests:compileTests)

From f58f8f8e583bbfee309d25310359c42f2a3c93c9 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:05:03 +0000
Subject: [PATCH 175/182] Revert "Delete commented code"

This reverts commit 0d01dc0a20280cc76fbe7a6ff9f3784511a21a64.
---
 brat/Brat/Compile/Hugr.hs | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 6d9874c9..4dbaafa3 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -286,6 +286,40 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   let TestMatchData my matchSeq = matchData
   matchSeq <- compileGraphTypes (fmap (binderToValue my) matchSeq)
 
+{-
+  -- Dilemma: we want to compile this extra stuff *if we use it* and put it in
+  -- the port table. Otherwise it causes problems *because* the stuff isn't used.
+  extraStuff <- for extraInps $ \(src@(NamedPort out@(Ex bratNode port) _), ty) -> do
+       hugrNode <- compileWithInputs parent bratNode >>= \case
+         Just node -> pure (Port node port)
+         Nothing -> error $ "Couldn't compile " ++ show bratNode
+       -- TODO: This probably isn't working hard enough - might the type have deps?
+       let hugrTy = compileType (binderToValue my ty)
+       pure (src, (hugrNode, hugrTy))
+-}
+
+{-
+       case [ bang "wee" ns tgtEnd | (src', _, In tgtEnd _) <- es, out == src'] of
+--         [BratNode Hypo _ _] -> pure []
+--         [KernelNode Hypo _ _] -> pure []
+         _ -> do
+          compiledMap <- gets compiled
+          hugrNode <- case M.lookup bratNode compiledMap of
+            Nothing -> error $ show bratNode ++ " not found in\n" ++ intercalate "\n" (show <$> M.toList compiledMap)
+            Just node -> pure (Port node port)
+
+
+          -- IS THIS WHERE THE EXTRA INPUT IS COMING FROM
+          let hugrTy = compileType (binderToValue my ty)
+          traceM ("EXTRA INPUT:\n" ++ show src ++ "\n" ++ show hugrTy)
+          hugrNode <- compileWithInputs parent bratNode >>= \case
+            Just node -> pure (Port node port)
+            Nothing -> error $ "Couldn't compile " ++ show bratNode
+          -- TODO: This probably isn't working hard enough - might the type have deps?
+          let hugrTy = compileType (binderToValue my ty)
+          pure [(src, (hugrNode, hugrTy))])
+-}
+
   let portTbl = fromJust (zipSameLength (fst <$> matchInputs matchSeq) ins)
   testResult <- compileMatchSequence parent portTbl matchSeq
 

From 8e7496b20a317a6415cd36240ba2fa789dc03ff1 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:05:24 +0000
Subject: [PATCH 176/182] Revert "Feed extra inputs into undo node"

This reverts commit 8f55383d8a1ddc0e287b59a5ae7743254407c7ce.
---
 brat/Brat/Compile/Hugr.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 4dbaafa3..873dc850 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -698,11 +698,9 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
                -> [TypedPort]
                -> Compile [TypedPort]
   didMatchCase ix (prevTest, oldTy) ms@(MatchSequence{..}) sumTy parent ins = do
-    -- We want to add the stuff generated by tests to the port table
-    let extraInputs = case prevTest of
-          PrimCtorTest _ _ _ newSrcs -> zip (fst <$> newSrcs) ins
-          PrimLitTest _ -> []
-    didAllTestsSucceed <- compileMatchSequence parent (portTable <> extraInputs) ms
+    -- Remember which port a src corresponds to
+    let portTable = zip (fst <$> matchInputs) ins
+    didAllTestsSucceed <- compileMatchSequence parent portTable ms
     makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed
       [("Undo", undo)
       ,("AllMatched", allMatched)

From 905659de132d30805ffe8e40b750b1071771af73 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:06:08 +0000
Subject: [PATCH 177/182] Revert "Ditch extra inputs in pattern match; inline
 undo"

This reverts commit 4d1e055e56d53c8230276a4d8a936337f1a6bf51.
---
 brat/Brat/Compile/Hugr.hs               | 104 +++++++++---------------
 brat/Brat/Graph.hs                      |   9 +-
 brat/test/golden/graph/addN.brat.graph  |   2 +-
 brat/test/golden/graph/addN2.brat.graph |   2 +-
 brat/test/golden/graph/id.brat.graph    |   2 +-
 brat/test/golden/graph/rx.brat.graph    |   2 +-
 brat/test/golden/graph/swap.brat.graph  |   2 +-
 7 files changed, 45 insertions(+), 78 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 873dc850..744a43b3 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -25,13 +25,12 @@ import Bwd
 import Control.Monad.Freer
 import Data.Hugr
 import Hasochism
-import Util
 
 import Control.Monad (unless)
 import Data.Aeson
 import Data.Bifunctor (first, second)
 import qualified Data.ByteString.Lazy as BS
-import Data.Foldable (for_)
+import Data.Foldable (traverse_, for_)
 import Data.Functor ((<&>), ($>))
 import Data.List (partition, sort, sortBy)
 import qualified Data.Map as M
@@ -286,47 +285,13 @@ compileClauses parent ins ((matchData, rhs) :| clauses) = do
   let TestMatchData my matchSeq = matchData
   matchSeq <- compileGraphTypes (fmap (binderToValue my) matchSeq)
 
-{-
-  -- Dilemma: we want to compile this extra stuff *if we use it* and put it in
-  -- the port table. Otherwise it causes problems *because* the stuff isn't used.
-  extraStuff <- for extraInps $ \(src@(NamedPort out@(Ex bratNode port) _), ty) -> do
-       hugrNode <- compileWithInputs parent bratNode >>= \case
-         Just node -> pure (Port node port)
-         Nothing -> error $ "Couldn't compile " ++ show bratNode
-       -- TODO: This probably isn't working hard enough - might the type have deps?
-       let hugrTy = compileType (binderToValue my ty)
-       pure (src, (hugrNode, hugrTy))
--}
-
-{-
-       case [ bang "wee" ns tgtEnd | (src', _, In tgtEnd _) <- es, out == src'] of
---         [BratNode Hypo _ _] -> pure []
---         [KernelNode Hypo _ _] -> pure []
-         _ -> do
-          compiledMap <- gets compiled
-          hugrNode <- case M.lookup bratNode compiledMap of
-            Nothing -> error $ show bratNode ++ " not found in\n" ++ intercalate "\n" (show <$> M.toList compiledMap)
-            Just node -> pure (Port node port)
-
-
-          -- IS THIS WHERE THE EXTRA INPUT IS COMING FROM
-          let hugrTy = compileType (binderToValue my ty)
-          traceM ("EXTRA INPUT:\n" ++ show src ++ "\n" ++ show hugrTy)
-          hugrNode <- compileWithInputs parent bratNode >>= \case
-            Just node -> pure (Port node port)
-            Nothing -> error $ "Couldn't compile " ++ show bratNode
-          -- TODO: This probably isn't working hard enough - might the type have deps?
-          let hugrTy = compileType (binderToValue my ty)
-          pure [(src, (hugrNode, hugrTy))])
--}
-
-  let portTbl = fromJust (zipSameLength (fst <$> matchInputs matchSeq) ins)
+  let portTbl = zip (fst <$> matchInputs matchSeq) ins
   testResult <- compileMatchSequence parent portTbl matchSeq
 
   -- Feed the test result into a conditional
-  makeConditional ("clause of " ++ show rhs) parent testResult [("didntMatch", didntMatch outTys)
-                                                               ,("didMatch", didMatch outTys)
-                                                               ]
+  makeConditional ("clause of " ++ show rhs) parent testResult [] [("didntMatch", didntMatch outTys)
+                                                                  ,("didMatch", didMatch outTys)
+                                                                  ]
  where
   didntMatch :: [HugrType] -> NodeId -> [TypedPort] -> Compile [TypedPort]
   didntMatch outTys parent ins = case nonEmpty clauses of
@@ -647,7 +612,7 @@ compileKernBox parent name contents cty = do
 -- Return a sum whose first component is the types we started with in the order
 -- specified by the portTable argument.
 --
--- In the happy path we return wires in the order of `rhsInputs`
+-- In the happy path we return wires in the order of `matchOutputs`
 -- otherwise, the order is the same as how they came in via the portTable
 compileMatchSequence :: NodeId -- The parent node
                      -> [(Src  -- Things we've matched or passed through, coming from an Input node
@@ -655,7 +620,10 @@ compileMatchSequence :: NodeId -- The parent node
                      -> MatchSequence HugrType
                      -> Compile TypedPort
 compileMatchSequence parent portTable (MatchSequence {..}) = do
-  let sumTy = SoR [snd <$> matchInputs, snd <$> rhsInputs]
+  unless
+    ((second snd <$> portTable) == matchInputs)
+    (error "compileMatchSequence assert failed")
+  let sumTy = SoR [snd <$> matchInputs, snd <$> matchOutputs]
   case matchTests of
     (src, primTest):tests -> do
       -- Pick the port corresponding to the source we want to test
@@ -666,20 +634,17 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
       -- other inputs
       testResult <- compilePrimTest parent typedPort primTest
       let testIx = length left
-      let remainingMatchTests = MatchSequence (primTestOuts primTest ++ (second snd <$> others)) tests rhsInputs
-      ports <- makeConditional ("matching " ++ show (src, primTest)) parent testResult
-               [("didNotMatch", \parent _ -> makeRowTag "DidNotMatch" parent 0 sumTy (reorderPortTbl portTable (fst <$> matchInputs)))
+      let remainingMatchTests = MatchSequence (primTestOuts primTest ++ (second snd <$> others)) tests matchOutputs
+      ports <- makeConditional ("matching " ++ show (src, primTest)) parent testResult (snd <$> others)
+               [("didNotMatch", didNotMatchCase testIx sumTy)
                ,("didMatch",    didMatchCase testIx (primTest, snd typedPort) remainingMatchTests sumTy)]
       case ports of
         (port:_) -> pure port
         _ -> error $ "Expected at least one output port from makeConditional: got\n  " ++ show ports
 
     [] -> do
-      -- Reorder into `rhsInputs` order
-      rhsInputsRefinedFromUnification <- for rhsInputs $ \input@(src, hugrTy) -> compileWithInputs parent (endName (toEnd src)) >>= \case
-        Nothing -> error $ "Failed to compile rhsInput: " ++ show input
-        Just nodeId -> pure (src, (Port nodeId 0, hugrTy))
-      let ins = reorderPortTbl (portTable <> rhsInputsRefinedFromUnification) (fst <$> rhsInputs)
+      -- Reorder into `matchOutputs` order
+      let ins = reorderPortTbl portTable (fst <$> matchOutputs)
       -- Need to pack inputs into a tuple before feeding them into a tag node
       ports <- makeRowTag "Success" parent 1 sumTy ins
       case ports of
@@ -701,7 +666,7 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
     -- Remember which port a src corresponds to
     let portTable = zip (fst <$> matchInputs) ins
     didAllTestsSucceed <- compileMatchSequence parent portTable ms
-    makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed
+    makeConditional ("all matched (" ++ show ix ++ ")") parent didAllTestsSucceed []
       [("Undo", undo)
       ,("AllMatched", allMatched)
       ]
@@ -712,16 +677,29 @@ compileMatchSequence parent portTable (MatchSequence {..}) = do
          -> Compile [TypedPort]
     undo parent ins = do
       -- Test results, and the rest of the inputs
-      let (refined, others) = splitAt (length (primTestOuts prevTest)) ins
+      let (refined, other) = splitAt (length (primTestOuts prevTest)) ins
       undoPort <- undoPrimTest parent refined oldTy prevTest
       -- Put it back in the right place
-      let (as, bs) = splitAt ix others
+      let (as, bs) = splitAt ix other
       let ins = as ++ undoPort : bs
       makeRowTag "Fail_Undo" parent 0 sumTy ins
 
     allMatched :: NodeId -> [TypedPort] -> Compile [TypedPort]
     allMatched parent = makeRowTag "AllMatched" parent 1 sumTy
 
+  didNotMatchCase :: Int -- The index at which to put the thing we inspected in outputs
+                  -> SumOfRows
+                  -> NodeId
+                  -> [TypedPort]
+                  -> Compile [TypedPort]
+  didNotMatchCase _ _ _ [] = error "No scrutinee input in didNotMatchCase"
+  didNotMatchCase ix sumTy parent (scrutinee:ins) = do
+    let (as, bs) = splitAt ix ins
+    -- We need to wire inputs to a `Tag0`, but bringing the tested src back to
+    -- the original position
+    let ins = as ++ scrutinee:bs
+    makeRowTag "DidNotMatch" parent 0 sumTy ins
+
 makeRowTag :: String -> NodeId -> Int -> SumOfRows -> [TypedPort] -> Compile [TypedPort]
 makeRowTag hint parent tag sor@(SoR sumRows) ins =
   if sumRows !! tag == (snd <$> ins)
@@ -747,19 +725,20 @@ addNodeWithInputs name op inWires outTys = do
 makeConditional :: String    -- Label
                 -> NodeId    -- Parent node id
                 -> TypedPort -- The discriminator
+                -> [TypedPort] -- Other inputs
                 -> [(String, NodeId -> [TypedPort] -> Compile [TypedPort])] -- Must be ordered
                 -> Compile [TypedPort]
-makeConditional lbl _ discrim cases | track ("makeConditional(" ++ show lbl ++ ")\n  " ++ unlines (fst <$> cases) ++ "\n  " ++ show (snd discrim)) False = undefined
-makeConditional lbl parent discrim cases = do
+makeConditional lbl parent discrim otherInputs cases = do
   condId <- freshNode "Conditional"
   let rows = getSumVariants (snd discrim)
-  outTyss <- for (fromJust $ zipSameLength (zip [0..] cases) rows) (\((ix, (name, f)), row) -> makeCase condId name ix row f)
+  outTyss <- for (zip (zip [0..] cases) rows) (\((ix, (name, f)), row) -> makeCase condId name ix (row ++ (snd <$> otherInputs)) f)
   unless
     (allRowsEqual outTyss)
     (error "Conditional output types didn't match")
-  let condOp = OpConditional (Conditional parent rows [] (head outTyss) [("label", lbl)])
+  let condOp = OpConditional (Conditional parent rows (snd <$> otherInputs) (head outTyss) [("label", lbl)])
   addOp condOp condId
   addEdge (fst discrim, Port condId 0)
+  traverse_ addEdge (zip (fst <$> otherInputs) (Port condId <$> [1..]))
   pure $ zip (Port condId <$> [0..]) (head outTyss)
  where
   makeCase :: NodeId -> String -> Int -> [HugrType] -> (NodeId -> [TypedPort] -> Compile [TypedPort]) -> Compile [HugrType]
@@ -783,8 +762,6 @@ compilePrimTest :: NodeId
                 -> PrimTest HugrType -- The test to run
                 -> Compile TypedPort
 compilePrimTest parent (port, ty) (PrimCtorTest c tycon unpackingNode outputs) = do
-  -- PrimCtorTest returns the `outputs` specified in the happy case, else the
-  -- thing that was originally being tested, unchanged.
   let sumOut = HTSum (SG (GeneralSum [[ty], snd <$> outputs]))
   let sig = FunctionType [ty] [sumOut] ["BRAT"]
   testId <- addNode ("PrimCtorTest " ++ show c)
@@ -802,8 +779,7 @@ compilePrimTest parent port@(_, ty) (PrimLitTest tm) = do
   constId <- addNode "LitConst" (OpConst (ConstOp parent (valFromSimple tm)))
   loadPort <- head <$> addNodeWithInputs "LitLoad" (OpLoadConstant (LoadConstantOp parent ty))
                        [(Port constId 0, ty)] [ty]
-  -- PrimLitTest returns an empty sum in the happy case (no extra info), else
-  -- the thing that was originally being tested, unchanged.
+  -- Connect to a test node
   let sumOut = HTSum (SG (GeneralSum [[ty], []]))
   let sig = FunctionType [ty, ty] [sumOut] ["BRAT"]
   head <$> addNodeWithInputs ("PrimLitTest " ++ show tm)
@@ -814,12 +790,6 @@ compilePrimTest parent port@(_, ty) (PrimLitTest tm) = do
 constructorOp :: NodeId -> QualName -> QualName -> FunctionType -> HugrOp NodeId
 constructorOp parent tycon c sig = OpCustom (CustomOp parent "BRAT" ("Ctor::" ++ show tycon ++ "::" ++ show c) sig [])
 
--- undoPrimTest, reconstructs the scrutinee of a test after the test has been run.
--- For literal tests, the literal is recorded in the test, so we can just put it
--- in a const node.
--- For constructor tests, we assume that the outputs of the test are the
--- arguments of the constructor, so we can apply them to the constructor in the
--- same order to reproduce the scrutinee.
 undoPrimTest :: NodeId
              -> [TypedPort] -- The inputs we have to put back together
              -> HugrType -- The type of the thing we're making
diff --git a/brat/Brat/Graph.hs b/brat/Brat/Graph.hs
index 8097feb2..62c4619b 100644
--- a/brat/Brat/Graph.hs
+++ b/brat/Brat/Graph.hs
@@ -59,10 +59,7 @@ deriving instance Show (NodeType a)
 -- tag 0 with the function's inputs returned as they were
 -- tag 1 with the environment of pattern variables from a successful
 data TestMatchData (m :: Mode) where
-  TestMatchData :: Show (BinderType m)
-                => Modey m
-                -> MatchSequence (BinderType m)
-                -> TestMatchData m
+  TestMatchData :: Show (BinderType m) => Modey m -> MatchSequence (BinderType m) -> TestMatchData m
 
 deriving instance Show (TestMatchData a)
 
@@ -70,11 +67,11 @@ deriving instance Show (TestMatchData a)
 -- Invariants:
 --    1. Each src in `matchTests` has been mentioned earlier (either in `matchInputs`
 --       or in the srcs outputted by a previous `PrimCtorTest`
---    2. The same goes for the sources in `rhsInputs`
+--    2. The same goes for the sources in `matchOutputs`
 data MatchSequence ty = MatchSequence
   { matchInputs :: [(Src, ty)]
   , matchTests :: [(Src, PrimTest ty)]
-  , rhsInputs ::[(Src, ty)]
+  , matchOutputs ::[(Src, ty)]
   } deriving (Foldable, Functor, Traversable)
 deriving instance Show ty => Show (MatchSequence ty)
 
diff --git a/brat/test/golden/graph/addN.brat.graph b/brat/test/golden/graph/addN.brat.graph
index 09df6df5..84504c1e 100644
--- a/brat/test/golden/graph/addN.brat.graph
+++ b/brat/test/golden/graph/addN.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
diff --git a/brat/test/golden/graph/addN2.brat.graph b/brat/test/golden/graph/addN2.brat.graph
index 27acb69a..a481cd0d 100644
--- a/brat/test/golden/graph/addN2.brat.graph
+++ b/brat/test/golden/graph/addN2.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1,BratNode Source [] [("n",Int)])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (n :: Int) -> (out :: Int) })])
-(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
+(check_defs_1_addN_LambdaChk_9_lambda,BratNode (PatternMatch ((TestMatchData Braty (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_addN_LambdaChk_9_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "inp"},Int)]}),check_defs_1_addN_LambdaChk_9_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("inp",Int)] [("out",Int)])
 (check_defs_1_addN_addN.box/in,BratNode Source [] [("inp",Int)])
 (check_defs_1_addN_addN.box/out_1,BratNode Target [("out",Int)] [])
 (check_defs_1_addN_addN.box_thunk_2,BratNode (Box check_defs_1_addN_addN.box/in check_defs_1_addN_addN.box/out_1) [] [("thunk",{ (inp :: Int) -> (out :: Int) })])
diff --git a/brat/test/golden/graph/id.brat.graph b/brat/test/golden/graph/id.brat.graph
index 92a147c9..8467bd30 100644
--- a/brat/test/golden/graph/id.brat.graph
+++ b/brat/test/golden/graph/id.brat.graph
@@ -5,7 +5,7 @@ Nodes:
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
diff --git a/brat/test/golden/graph/rx.brat.graph b/brat/test/golden/graph/rx.brat.graph
index 15d6678f..e3ff04df 100644
--- a/brat/test/golden/graph/rx.brat.graph
+++ b/brat/test/golden/graph/rx.brat.graph
@@ -6,7 +6,7 @@ Nodes:
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q :: Qubit) -o (b :: Qubit) })])
-(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
+(check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit)]}),check_defs_1_main_3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit)] [("b",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit)])
 (check_defs_1_main_3_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit)] [])
 (check_defs_1_main_3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_3_$rhs_check'Th_thunk/in check_defs_1_main_3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit) -o (b :: Qubit) })])
diff --git a/brat/test/golden/graph/swap.brat.graph b/brat/test/golden/graph/swap.brat.graph
index 45a8f41d..f0c3319e 100644
--- a/brat/test/golden/graph/swap.brat.graph
+++ b/brat/test/golden/graph/swap.brat.graph
@@ -5,7 +5,7 @@ Nodes:
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit)])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("b",Qubit),("a",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit) -o (b :: Qubit), (a :: Qubit) })])
-(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
+(check_defs_1_main_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a"},Qubit),(NamedPort {end = Ex check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b"},Qubit)]}),check_defs_1_main_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a",Qubit),("b",Qubit)] [("b",Qubit),("a",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/in,KernelNode Source [] [("a",Qubit),("b",Qubit)])
 (check_defs_1_main_$rhs_check'Th_thunk/out_1,KernelNode Target [("b",Qubit),("a",Qubit)] [])
 (check_defs_1_main_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_main_$rhs_check'Th_thunk/in check_defs_1_main_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a :: Qubit), (b :: Qubit) -o (b :: Qubit), (a :: Qubit) })])

From a393b3573a05f2ac3b64a2dbc43f9da1a0b90744 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:13:11 +0000
Subject: [PATCH 178/182] Revert "xfail test/compilation tests too, for issue
 #94"

This reverts commit 104fac594d8d77c0569ce2dd163dceebf380f9e1.
---
 brat/test/Test/Compile/Hugr.hs | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index c299eff2..1c31066b 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -35,7 +35,6 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"let"
   ,"patterns"
   ,"qft"
-  ,"infer2" -- https://github.com/Quantinuum/brat/issues/94
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
   ,"vector_solve" -- Generates "Pow" nodes which aren't implemented yet
@@ -52,11 +51,6 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"vlup_covering"
   ]
 
-nonCompilingTests = map ((++ ".brat") . ("test" </>) . ("compilation" </>))
-  ["closures" -- https://github.com/Quantinuum/brat/issues/94
-  ,"parity" -- https://github.com/Quantinuum/brat/issues/94
-  ]
-
 compileToOutput :: FilePath -> TestTree
 compileToOutput file = testCaseInfo (show file) $ compileFile [] file >>= \case
     Right bs -> do
@@ -71,7 +65,7 @@ setupCompilationTests = do
   tests <- findByExtension [".brat"] prefix
   examples <- findByExtension [".brat"] examplesPrefix
   createDirectoryIfMissing False outputDir
-  let compileTests = expectFailForPaths nonCompilingTests compileToOutput tests
+  let compileTests = compileToOutput <$> tests
   let examplesTests = testGroup "examples" $ expectFailForPaths nonCompilingExamples compileToOutput examples
 
   pure $ testGroup "compilation" (examplesTests:compileTests)

From 0e2174f8acbfb501a7a95f429f71b3b666a2421f Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:27:23 +0000
Subject: [PATCH 179/182] Update golden test, xfail compilation infer{,2},
 invalid infer_thunks{1,2}

---
 brat/test/Test/Compile/Hugr.hs           | 4 ++++
 brat/test/golden/graph/kernel.brat.graph | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index 1c31066b..539fe377 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -23,6 +23,8 @@ invalidExamples = map ((++ ".brat") . ("examples" </>))
   ,"app"
   ,"dollar_kind"
   ,"portpulling"
+  ,"infer_thunks"
+  ,"infer_thunks2"
   ,"repeated_app" -- missing coercions, https://github.com/quantinuum-dev/brat/issues/413
   ,"thunks"]
 
@@ -35,6 +37,8 @@ nonCompilingExamples = expectedCheckingFails ++ expectedParsingFails ++
   ,"let"
   ,"patterns"
   ,"qft"
+  ,"infer" -- problems with undoing pattern tests
+  ,"infer2" -- problems with undoing pattern tests
   ,"fanout" -- Contains Selectors
   ,"vectorise" -- Generates MapFun nodes which aren't implemented yet
   ,"vector_solve" -- Generates "Pow" nodes which aren't implemented yet
diff --git a/brat/test/golden/graph/kernel.brat.graph b/brat/test/golden/graph/kernel.brat.graph
index 9bb8cea9..e918270f 100644
--- a/brat/test/golden/graph/kernel.brat.graph
+++ b/brat/test/golden/graph/kernel.brat.graph
@@ -23,7 +23,7 @@ Nodes:
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1,KernelNode Source [] [("q0",Qubit),("q1",Qubit),("q2",Qubit)])
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2,KernelNode Target [("a1",Vec(Qubit, 3))] [])
 (check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3,BratNode (Box check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/in_1 check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs/out_2) [] [("thunk",{ (q0 :: Qubit), (q1 :: Qubit), (q2 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])
-(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], rhsInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
+(check_defs_1_id3_$rhs_check'Th_LambdaChk_6_lambda,KernelNode (PatternMatch ((TestMatchData Kerny (MatchSequence {matchInputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)], matchTests = [], matchOutputs = [(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 0, portName = "a1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 1, portName = "b1"},Qubit),(NamedPort {end = Ex check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_$lhs_lambda.0_setup/in 2, portName = "c1"},Qubit)]}),check_defs_1_id3_$rhs_check'Th_LambdaChk_6_checkClauses_1_lambda.0_rhs_thunk_3) :| [])) [("a1",Qubit),("b1",Qubit),("c1",Qubit)] [("a1",Vec(Qubit, 3))])
 (check_defs_1_id3_$rhs_check'Th_thunk/in,KernelNode Source [] [("a1",Qubit),("b1",Qubit),("c1",Qubit)])
 (check_defs_1_id3_$rhs_check'Th_thunk/out_1,KernelNode Target [("a1",Vec(Qubit, 3))] [])
 (check_defs_1_id3_$rhs_check'Th_thunk_thunk_2,BratNode (Box check_defs_1_id3_$rhs_check'Th_thunk/in check_defs_1_id3_$rhs_check'Th_thunk/out_1) [] [("thunk",{ (a1 :: Qubit), (b1 :: Qubit), (c1 :: Qubit) -o (a1 :: Vec(Qubit, 3)) })])

From c7196c259bf264679c3f8209aa8ec3d34eacfdef Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Sat, 13 Dec 2025 09:38:40 +0000
Subject: [PATCH 180/182] Oops xfail more

---
 brat/test/Test/Compile/Hugr.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index 539fe377..fb66937b 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -23,6 +23,8 @@ invalidExamples = map ((++ ".brat") . ("examples" </>))
   ,"app"
   ,"dollar_kind"
   ,"portpulling"
+  ,"eatsfull"
+  ,"map"
   ,"infer_thunks"
   ,"infer_thunks2"
   ,"repeated_app" -- missing coercions, https://github.com/quantinuum-dev/brat/issues/413

From cc81e33893d1a2d82014438c896c47d68608410e Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Tue, 16 Dec 2025 17:15:34 +0000
Subject: [PATCH 181/182] Simplify var-passing in compileConstDfg

---
 brat/Brat/Compile/Hugr.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Compile/Hugr.hs b/brat/Brat/Compile/Hugr.hs
index 744a43b3..6c169733 100644
--- a/brat/Brat/Compile/Hugr.hs
+++ b/brat/Brat/Compile/Hugr.hs
@@ -527,17 +527,16 @@ compileConstDfg parent desc (inTys, outTys) contents = do
   st <- gets store
   g <- gets bratGraph
   cs <- gets capSets
+  let funTy = FunctionType inTys outTys bratExts
   -- First, we fork off a new namespace
-  ((funTy, a), cs) <- desc -! do
+  (a, cs) <- desc -! do
     ns <- gets nameSupply
     pure $ flip runState (emptyCS g cs ns st) $ do
       -- make a DFG node at the root. We can't use `addNode` since the
       -- DFG needs itself as parent
       dfg_id <- freshNode ("Box_" ++ show desc)
-      a <- contents dfg_id
-      let funTy = FunctionType inTys outTys bratExts
       addOp (OpDFG $ DFG dfg_id funTy []) dfg_id
-      pure (funTy, a)
+      contents dfg_id
   let nestedHugr = renameAndSortHugr (nodes cs) (edges cs)
   let ht = HTFunc $ PolyFuncType [] funTy
 

From 394bd73c584624377e39b646c0ebb3dc3df9b67b Mon Sep 17 00:00:00 2001
From: Craig Roy <craig.roy@quantinuum.com>
Date: Wed, 17 Dec 2025 10:41:46 +0000
Subject: [PATCH 182/182] Add comments to newly failing compilation tests

---
 brat/test/Test/Compile/Hugr.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/brat/test/Test/Compile/Hugr.hs b/brat/test/Test/Compile/Hugr.hs
index fb66937b..0f3d7bd9 100644
--- a/brat/test/Test/Compile/Hugr.hs
+++ b/brat/test/Test/Compile/Hugr.hs
@@ -23,10 +23,10 @@ invalidExamples = map ((++ ".brat") . ("examples" </>))
   ,"app"
   ,"dollar_kind"
   ,"portpulling"
-  ,"eatsfull"
-  ,"map"
-  ,"infer_thunks"
-  ,"infer_thunks2"
+  ,"eatsfull" -- Compiling hopes #96
+  ,"map" -- Compiling hopes #96
+  ,"infer_thunks" -- Weird: Mismatch between caller and callee signatures in map call
+  ,"infer_thunks2" -- Weird: Mismatch between caller and callee signatures in map call
   ,"repeated_app" -- missing coercions, https://github.com/quantinuum-dev/brat/issues/413
   ,"thunks"]