From b9634e5530769fcc09955b3cda8de58d3aa2489f Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Thu, 28 Mar 2024 11:32:34 -0600
Subject: [PATCH] gulp

---
 src/Rlp/HindleyMilner.hs                   | 8 ++++++--
 visualisers/hmvis/src/hmvis/annotated.cljs | 5 +++++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/Rlp/HindleyMilner.hs b/src/Rlp/HindleyMilner.hs
index 687fa5f..6850710 100644
--- a/src/Rlp/HindleyMilner.hs
+++ b/src/Rlp/HindleyMilner.hs
@@ -364,7 +364,7 @@ inferProg p = do
     (p',csroot) <- annotateProg (etaExpandAll p)
     traceM $ "p' : " <> show p'
     let (cs,as) = foldMap finalJudgement p' ^. lensProduct constraints assumptions
-    cs' <- (\a -> csroot <> cs <> a) <$> elimAssumptionsG g0 as
+    cs' <- (\a -> cs <> csroot <> a) <$> elimAssumptionsG g0 as
     traceM $ "cs' : " <> show cs'
     sub <- solve cs'
     pure $ p' & programDecls . traversed . _FunD . _3
@@ -388,8 +388,12 @@ annotateProg p = do
     -- we only wipe the memo here as a temporary solution to the memo shadowing
     -- problem
     p' <- (thenWipeMemo . annotate) `traverse` p
+    p'' <- forOf (traversed . traversed . _2) p' \ j -> do
+        c <- elimWithBinds (ks `zip` txs) (j ^. assumptions)
+        pure $ j & constraints <>~ c
+                 & assumptions %~ deleteKeys ks
     -- TODO: any remaining assumptions should be errors at this point
-    pure (p',cs)
+    pure (p'',cs)
   where
     thenWipeMemo a = (hmMemo .= mempty) *> a
 
diff --git a/visualisers/hmvis/src/hmvis/annotated.cljs b/visualisers/hmvis/src/hmvis/annotated.cljs
index 40d417f..3ab9d40 100644
--- a/visualisers/hmvis/src/hmvis/annotated.cljs
+++ b/visualisers/hmvis/src/hmvis/annotated.cljs
@@ -100,6 +100,9 @@
        " in "
        (Expr colours 0 e)])
 
+(defn LitExpr [_ l]
+  [:code (str l)])
+
 (defn Expr [[c & colours] p {e :e t :type}]
   (match e
     {:InL {:tag "LamF" :contents [bs body & _]}}
@@ -113,6 +116,8 @@
     {:InR {:tag "LetEF" :contents [r bs body]}}
       (maybe-parens (< ppr/app-prec1 p)
                     [Typed c t [LetExpr colours r bs body]])
+    {:InL {:tag "LitF" :contents l}}
+      [Typed c t [LitExpr colours l]]
     :else [:code "<expr>"]))
 
 (def rainbow-cycle (cycle ["red"