From 3d04ee01533eeaee17492d0054504cc2e8837fcb Mon Sep 17 00:00:00 2001
From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Mon, 17 Jun 2013 22:12:19 -0400
Subject: [PATCH] Rescue ctxFromBindings for aliased case

Use it in the test suite, just like for the unaliased machinery.
This is cherry-picked from 4e0fc1726ab4abf1326ea61ae5225f0bb5167707.
---
 src/Dyna/Analysis/Mode/Execution/Context.hs |  6 +++++-
 src/Dyna/Analysis/Mode/Selftest/Contexts.hs | 12 +++---------
 2 files changed, 8 insertions(+), 10 deletions(-)

diff --git a/src/Dyna/Analysis/Mode/Execution/Context.hs b/src/Dyna/Analysis/Mode/Execution/Context.hs
index 863c7b0..ffde52a 100644
--- a/src/Dyna/Analysis/Mode/Execution/Context.hs
+++ b/src/Dyna/Analysis/Mode/Execution/Context.hs
@@ -34,13 +34,14 @@ module Dyna.Analysis.Mode.Execution.Context (
     -- ** Monad
     SIMCT(..), runSIMCT,
     -- *** And its context
-    SIMCtx(..), emptySIMCtx, allFreeSIMCtx,
+    SIMCtx(..), emptySIMCtx, allFreeSIMCtx, ctxFromBindings,
 
     -- ** Internal helper functions
     e2x, q2y, aliasN, aliasV, aliasX, aliasY, kUpUniq,
 )where
 
 import           Control.Applicative (Applicative)
+import           Control.Arrow (second)
 import           Control.Exception(assert)
 import           Control.Lens
 import           Control.Monad
@@ -202,6 +203,9 @@ allFreeSIMCtx :: [DVar] -> SIMCtx f
 allFreeSIMCtx fs = SIMCtx 0 IM.empty
                  $ M.fromList $ map (\x -> (x, VRStruct IFree)) fs
 
+ctxFromBindings :: [(DVar, NIX f)] -> SIMCtx f
+ctxFromBindings = SIMCtx 0 IM.empty . M.fromList . map (second VRName)
+
 runSIMCT :: SIMCT m f a -> SIMCtx f -> m (Either UnifFail (a, SIMCtx f))
 runSIMCT q x = runEitherT (runStateT (unSIMCT q) x)
 
diff --git a/src/Dyna/Analysis/Mode/Selftest/Contexts.hs b/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
index a1268aa..2a3bf27 100644
--- a/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
+++ b/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
@@ -89,10 +89,9 @@ prop_alias_unifyUnaliasedNV = unifProp nWFN' alias_unifyUnaliasedNV nLeqGLBRL
  where
   alias_unifyUnaliasedNV n1 n2 =
     fmap fst $ runIdentity
-             $ flip CA.runSIMCT (CA.allFreeSIMCtx [v])
+             $ flip CA.runSIMCT (CA.ctxFromBindings [(v,n1)])
              $ flip runReaderT (UnifParams True False)
              $ do
-                _ <- FA.unifyUnaliasedNV n1 v
                 _ <- FA.unifyUnaliasedNV n2 v
                 FA.expandV v
    where v = "A"
@@ -102,11 +101,9 @@ prop_alias_unify = unifProp nWFN' alias_unify nLeqGLBRL
  where
   alias_unify n1 n2 =
     fmap fst $ runIdentity
-             $ flip CA.runSIMCT (CA.allFreeSIMCtx [vA,vB])
+             $ flip CA.runSIMCT (CA.ctxFromBindings [(vA,n1),(vB,n2)])
              $ flip runReaderT (UnifParams True False)
              $ do
-                _ <- FA.unifyUnaliasedNV n1 vA
-                _ <- FA.unifyUnaliasedNV n2 vB
                 _ <- FA.unifyVV vA vB
                 FA.expandV vA
    where vA = "A"
@@ -126,11 +123,8 @@ prop_alias_unifyVF = unifProp nWFN' alias_unifyVF gold
 
   alias_unifyVF n1 n2 =
     fmap fst $ runIdentity
-             $ flip CA.runSIMCT (CA.allFreeSIMCtx [vA,vB])
+             $ flip CA.runSIMCT (CA.ctxFromBindings [(vA,n1),(vB,n2)])
              $ do
-                _ <- flip runReaderT (UnifParams True False) $ do
-                  _ <- FA.unifyUnaliasedNV n1 vA
-                  FA.unifyUnaliasedNV n2 vB
                 _ <- FA.unifyVF True (const $ return True) vA G [vB]
                 FA.expandV vA
    where
-- 
2.50.1