From e21a958bcb309ca4c428ed8e97ac6e723dbce7d8 Mon Sep 17 00:00:00 2001
From: Ben Price <ben@hackworthltd.com>
Date: Wed, 12 Jul 2023 16:23:34 +0100
Subject: [PATCH] refactor: special 'subst' handling is now unneeded

This is because we "push down lets", rather than doing long-range substitutions.

Signed-off-by: Ben Price <ben@hackworthltd.com>
---
 primer/src/Primer/Eval.hs             |  6 +-----
 primer/src/Primer/Eval/NormalOrder.hs | 17 ++++-------------
 2 files changed, 5 insertions(+), 18 deletions(-)

diff --git a/primer/src/Primer/Eval.hs b/primer/src/Primer/Eval.hs
index d29ec41ad..2e7610715 100644
--- a/primer/src/Primer/Eval.hs
+++ b/primer/src/Primer/Eval.hs
@@ -54,7 +54,7 @@ import Primer.Eval.Detail (
  )
 import Primer.Eval.EvalError (EvalError (..))
 import Primer.Eval.NormalOrder (
-  FMExpr (FMExpr, expr, subst, substTy, ty),
+  FMExpr (FMExpr, expr, ty),
   foldMapExpr,
   singletonCxt,
  )
@@ -113,8 +113,6 @@ findNodeByID i =
     FMExpr
       { expr = \ez d c -> if getID ez == i then Just (c, Left (d, ez)) else Nothing
       , ty = \tz c -> if getID tz == i then Just (c, Right tz) else Nothing
-      , subst = Nothing
-      , substTy = Nothing
       }
 
 -- | Return the IDs of nodes which are reducible.
@@ -135,8 +133,6 @@ redexes tydefs globals =
       FMExpr
         { expr = \ez d -> liftMaybeT . runReaderT (getID ez <$ viewRedex tydefs globals d (target ez))
         , ty = \tz -> runReader (whenJust (getID tz) <$> viewRedexType (target tz))
-        , subst = Nothing
-        , substTy = Nothing
         }
   where
     liftMaybeT :: Monad m' => MaybeT m' a -> ListT m' a
diff --git a/primer/src/Primer/Eval/NormalOrder.hs b/primer/src/Primer/Eval/NormalOrder.hs
index a925a9d39..20ea66aa8 100644
--- a/primer/src/Primer/Eval/NormalOrder.hs
+++ b/primer/src/Primer/Eval/NormalOrder.hs
@@ -25,8 +25,6 @@ import Primer.Core (
     LetType,
     Letrec
   ),
-  TyVarName,
-  Type,
   Type' (
     TLet
   ),
@@ -114,11 +112,10 @@ foldMapExpr extract topDir = go mempty . (topDir,) . focus
     go :: Cxt -> (Dir, ExprZ) -> f a
     go lets dez@(d, ez) =
       extract.expr ez d lets
-        <|> case (extract.subst, viewLet dez) of
-          (Just goSubst, Just (ViewLet{bindingVL, bodyVL = (d', b)})) -> goSubst bindingVL b d' $ cxtAddLet bindingVL lets
+        <|> case viewLet dez of
           -- Prefer to compute inside the body of a let, but otherwise compute in the binding
           -- NB: we never push lets into lets, so the Cxt is reset for non-body children
-          (Nothing, Just (ViewLet{bindingVL, bodyVL, typeChildrenVL, termChildrenVL})) ->
+          Just (ViewLet{bindingVL, bodyVL, typeChildrenVL, termChildrenVL}) ->
             msum $
               go (cxtAddLet bindingVL lets) bodyVL
                 : map (goType mempty) typeChildrenVL
@@ -133,10 +130,8 @@ foldMapExpr extract topDir = go mempty . (topDir,) . focus
     goType :: Cxt -> TypeZ -> f a
     goType lets tz =
       extract.ty tz lets
-        <|> case (extract.substTy, target tz) of
-          (Just goSubstTy, TLet _ a t _body)
-            | [_, bz] <- typeChildren tz -> goSubstTy a t bz lets
-          (Nothing, TLet _ a t _body)
+        <|> case target tz of
+          TLet _ a t _body
             -- Prefer to compute inside the body of a let, but otherwise compute in the binding
             | [tz', bz] <- typeChildren tz -> goType (cxtAddLet (LetTyBind $ LetTypeBind a t) lets) bz <|> goType mempty tz'
           _ -> msum $ map (goType mempty) $ typeChildren tz
@@ -144,8 +139,6 @@ foldMapExpr extract topDir = go mempty . (topDir,) . focus
 data FMExpr m = FMExpr
   { expr :: ExprZ -> Dir -> Cxt -> m
   , ty :: TypeZ -> Cxt -> m
-  , subst :: Maybe (LetBinding -> ExprZ {- The body of the let-} -> Dir -> Cxt -> m)
-  , substTy :: Maybe (TyVarName -> Type -> TypeZ -> Cxt -> m)
   }
 
 focusType' :: MonadPlus m => ExprZ -> m TypeZ
@@ -165,8 +158,6 @@ findRedex tydefs globals =
     ( FMExpr
         { expr = \ez d -> runReaderT (RExpr ez <$> viewRedex tydefs globals d (target ez))
         , ty = \tz -> hoistMaybe . runReader (RType tz <<$>> viewRedexType (target tz))
-        , subst = Nothing
-        , substTy = Nothing
         }
     )