Merge pull request #1821 from github/evaluator-dsl

Evaluator DSL
2024-12-19 21:01:35 +03:00 · 2018-05-08 11:33:14 -04:00 · 2018-05-08 11:33:14 -04:00 · faefc52b08
commit faefc52b08
parent 3f1694b475 8ca53beab7
15 changed files with 172 additions and 58 deletions
--- a/semantic.cabal
+++ b/semantic.cabal
@ -236,12 +236,13 @@ test-suite test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
-  other-modules:       Assigning.Assignment.Spec
-                     , Analysis.Go.Spec
+  other-modules:       Analysis.Go.Spec
                     , Analysis.PHP.Spec
                     , Analysis.Python.Spec
                     , Analysis.Ruby.Spec
                     , Analysis.TypeScript.Spec
+                     , Assigning.Assignment.Spec
+                     , Control.Abstract.Evaluator.Spec
                     , Data.Diff.Spec
                     , Data.Abstract.Path.Spec
                     , Data.Functor.Classes.Generic.Spec
--- a/src/Control/Abstract/Addressable.hs
+++ b/src/Control/Abstract/Addressable.hs
@ -58,6 +58,21 @@ letrec' name body = do
  v <- localEnv id (body addr)
  v <$ modifyEnv (insert name addr)

+
+-- | Look up and dereference the given 'Name', throwing an exception for free variables.
+variable :: ( Addressable location effects
+            , Members '[ Reader (Environment location value)
+                       , Resumable (AddressError location value)
+                       , Resumable (EnvironmentError value)
+                       , State (Environment location value)
+                       , State (Heap location value)
+                       ] effects
+            )
+         => Name
+         -> Evaluator location term value effects value
+variable name = lookupEnv name >>= maybe (freeVariableError name) deref
+
+
 -- Instances

 -- | 'Precise' locations are always 'alloc'ated a fresh 'Address', and 'deref'erence to the 'Latest' value written.
--- a/src/Control/Abstract/Environment.hs
+++ b/src/Control/Abstract/Environment.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs, RankNTypes, TypeOperators #-}
 module Control.Abstract.Environment
 ( Environment
 , getEnv
@ -10,7 +11,10 @@ module Control.Abstract.Environment
 , localEnv
 , localize
 , lookupEnv
-, lookupWith
+, EnvironmentError(..)
+, freeVariableError
+, runEnvironmentError
+, runEnvironmentErrorWith
 ) where

 import Control.Abstract.Evaluator
@ -65,8 +69,21 @@ localize = localEnv id
 lookupEnv :: Members '[Reader (Environment location value), State (Environment location value)] effects => Name -> Evaluator location term value effects (Maybe (Address location value))
 lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment)

-- | Look up a 'Name' in the environment, running an action with the resolved address (if any).
-lookupWith :: Members '[Reader (Environment location value), State (Environment location value)] effects => (Address location value -> Evaluator location term value effects a) -> Name -> Evaluator location term value effects (Maybe a)
-lookupWith with name = do
-  addr <- lookupEnv name
-  maybe (pure Nothing) (fmap Just . with) addr
+
+-- | Errors involving the environment.
+data EnvironmentError value return where
+  FreeVariable :: Name -> EnvironmentError value value
+
+deriving instance Eq (EnvironmentError value return)
+deriving instance Show (EnvironmentError value return)
+instance Show1 (EnvironmentError value) where liftShowsPrec _ _ = showsPrec
+instance Eq1 (EnvironmentError value) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2
+
+freeVariableError :: Member (Resumable (EnvironmentError value)) effects => Name -> Evaluator location term value effects value
+freeVariableError = throwResumable . FreeVariable
+
+runEnvironmentError :: Evaluator location term value (Resumable (EnvironmentError value) ': effects) a -> Evaluator location term value effects (Either (SomeExc (EnvironmentError value)) a)
+runEnvironmentError = raiseHandler runError
+
+runEnvironmentErrorWith :: (forall resume . EnvironmentError value resume -> Evaluator location term value effects resume) -> Evaluator location term value (Resumable (EnvironmentError value) ': effects) a -> Evaluator location term value effects a
+runEnvironmentErrorWith = runResumableWith
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE FunctionalDependencies, GADTs, KindSignatures, Rank2Types #-}
+{-# LANGUAGE GADTs, KindSignatures, Rank2Types #-}
 module Control.Abstract.Value
 ( AbstractValue(..)
 , AbstractHole(..)
@ -40,7 +40,7 @@ class AbstractHole value where
 -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
 --
 --   This allows us to abstract the choice of whether to evaluate under binders for different value types.
-class Show value => AbstractValue location term value (effects :: [* -> *]) | effects value -> location where
+class Show value => AbstractValue location term value (effects :: [* -> *]) where
  -- | Construct an abstract unit value.
  --   TODO: This might be the same as the empty tuple for some value types
  unit :: Evaluator location term value effects value
--- a/src/Control/Effect.hs
+++ b/src/Control/Effect.hs
@ -8,6 +8,7 @@ module Control.Effect
 , throwResumable
 -- * Handlers
 , run
+, runM
 , runEffect
 , raiseHandler
 , runReader
@ -53,6 +54,9 @@ throwResumable = raise . throwError
 run :: Effectful m => m '[] a -> a
 run = Eff.run . lower

+runM :: (Effectful m, Monad f) => m '[f] a -> f a
+runM = Eff.runM . lower
+
 runEffect :: Effectful m => (forall v . effect v -> (v -> m effects a) -> m effects a) -> m (effect ': effects) a -> m effects a
 runEffect handler = raiseHandler (Eff.relay pure (\ effect yield -> lower (handler effect (raise . yield))))

--- a/src/Data/Abstract/Evaluatable.hs
+++ b/src/Data/Abstract/Evaluatable.hs
@ -8,7 +8,6 @@ module Data.Abstract.Evaluatable
 , EvalError(..)
 , runEvalError
 , runEvalErrorWith
-, variable
 , evaluateInScopedEnv
 , evaluatePackageWith
 , evaluatePackageBodyWith
@ -59,6 +58,7 @@ type EvaluatableConstraints location term value effects =
             , Reader (ModuleTable [Module term])
             , Reader PackageInfo
             , Resumable (AddressError location value)
+             , Resumable (EnvironmentError value)
             , Resumable (EvalError value)
             , Resumable (LoadError term)
             , Resumable ResolutionError
@ -76,8 +76,6 @@ type EvaluatableConstraints location term value effects =

 -- | The type of error thrown when failing to evaluate a term.
 data EvalError value resume where
-  -- Indicates we weren't able to dereference a name from the evaluated environment.
-  FreeVariableError :: Name -> EvalError value value
  FreeVariablesError :: [Name] -> EvalError value Name
  -- Indicates that our evaluator wasn't able to make sense of these literals.
  IntegerFormatError  :: ByteString -> EvalError value Integer
@ -108,25 +106,11 @@ evaluateInScopedEnv scopedEnvTerm term = do
  scopedEnv <- scopedEnvironment value
  maybe (throwEvalError (EnvironmentLookupError value)) (flip localEnv term . mergeEnvs) scopedEnv

-- | Look up and dereference the given 'Name', throwing an exception for free variables.
-variable :: ( Addressable location effects
-            , Members '[ Reader (Environment location value)
-                       , Resumable (AddressError location value)
-                       , Resumable (EvalError value)
-                       , State (Environment location value)
-                       , State (Heap location value)
-                       ] effects
-            )
-         => Name
-         -> Evaluator location term value effects value
-variable name = lookupWith deref name >>= maybeM (throwResumable (FreeVariableError name))
-
 deriving instance Eq a => Eq (EvalError a b)
 deriving instance Show a => Show (EvalError a b)
 instance Show value => Show1 (EvalError value) where
  liftShowsPrec _ _ = showsPrec
 instance Eq term => Eq1 (EvalError term) where
-  liftEq _ (FreeVariableError a) (FreeVariableError b)     = a == b
  liftEq _ (FreeVariablesError a) (FreeVariablesError b)   = a == b
  liftEq _ DefaultExportError DefaultExportError           = True
  liftEq _ (ExportError a b) (ExportError c d)             = (a == c) && (b == d)
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@ -222,7 +222,6 @@ instance ( Addressable location effects
                    , State (Heap location (Value location))
                    , State (JumpTable term)
                    ] effects
-         , Recursive term
         , Reducer (Value location) (Cell location (Value location))
         , Show location
         )
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@ -5,6 +5,7 @@ import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Effect (runIgnoringTraces)
 import qualified Control.Exception as Exc
+import           Control.Monad.Effect (relayState)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Located
@ -48,6 +49,7 @@ graph graphType renderer project
            . resumingLoadError
            . resumingUnspecialized
            . resumingValueError
+            . resumingEnvironmentError
            . resumingEvalError
            . resumingResolutionError
            . resumingAddressError
@ -89,18 +91,15 @@ resumingResolutionError = runResolutionErrorWith (\ err -> traceM ("ResolutionEr
 resumingLoadError :: Evaluator location term value (Resumable (LoadError term) ': effects) a -> Evaluator location term value effects a
 resumingLoadError = runLoadErrorWith (\ (LoadError _) -> pure [])

-resumingEvalError :: (AbstractHole value, Show value) => Evaluator location term value (Resumable (EvalError value) ': State [Name] ': effects) a -> Evaluator location term value effects (a, [Name])
-resumingEvalError
-  = runState []
-  . runEvalErrorWith (\ err -> traceM ("EvalError" <> show err) *> case err of
+resumingEvalError :: (AbstractHole value, Show value) => Evaluator location term value (Resumable (EvalError value) ': effects) a -> Evaluator location term value effects a
+resumingEvalError = runEvalErrorWith (\ err -> traceM ("EvalError" <> show err) *> case err of
  EnvironmentLookupError{} -> pure hole
  DefaultExportError{}     -> pure ()
  ExportError{}            -> pure ()
  IntegerFormatError{}     -> pure 0
  FloatFormatError{}       -> pure 0
  RationalFormatError{}    -> pure 0
-    FreeVariableError name   -> raise (modify' (name :)) $> hole
-    FreeVariablesError names -> raise (modify' (names <>)) $> fromMaybeLast "unknown" names)
+  FreeVariablesError names -> pure (fromMaybeLast "unknown" names))

 resumingUnspecialized :: AbstractHole value => Evaluator location term value (Resumable (Unspecialized value) ': effects) a -> Evaluator location term value effects a
 resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> traceM ("Unspecialized:" <> show err) $> hole)
@ -125,3 +124,6 @@ resumingValueError = runValueErrorWith (\ err -> traceM ("ValueError" <> show er
  Bitwise2Error{}   -> pure hole
  KeyValueError{}   -> pure (hole, hole)
  ArithmeticError{} -> pure hole)
+
+resumingEnvironmentError :: AbstractHole value => Evaluator location term value (Resumable (EnvironmentError value) ': effects) a -> Evaluator location term value effects (a, [Name])
+resumingEnvironmentError = raiseHandler (relayState [] (fmap pure . flip (,)) (\ names (Resumable (FreeVariable name)) yield -> yield (name : names) hole))
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@ -7,7 +7,6 @@ import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Evaluating as X
 import           Control.Abstract.Evaluator
 import           Control.Effect (runPrintingTraces)
-import           Control.Monad.Effect (runM)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Value
@ -27,38 +26,43 @@ import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby

 justEvaluating
-  = runM . lower
+  = runM
+  . fmap (first reassociate)
  . evaluating
  . runPrintingTraces
  . runLoadError
  . runValueError
  . runUnspecialized
  . runResolutionError
+  . runEnvironmentError
  . runEvalError
  . runAddressError
  . constrainedToValuePrecise

 evaluatingWithHoles
-  = runM . lower
+  = runM
  . evaluating
  . runPrintingTraces
  . resumingLoadError
  . resumingUnspecialized
  . resumingValueError
+  . resumingEnvironmentError
  . resumingEvalError
  . resumingResolutionError
-  . resumingAddressError @(Value Precise)
+  . resumingAddressError @(Value Precise) @Precise
  . constrainedToValuePrecise

 -- The order is significant here: caching has to run before typeChecking, or else we’ll nondeterministically produce TypeErrors as part of the result set. While this is probably actually correct, it will require us to have an Ord instance for TypeError, which we don’t have yet.
 checking
-  = runM . lower
+  = runM
+  . fmap (first reassociate)
  . evaluating
  . runPrintingTraces
  . providingLiveSet
  . runLoadError
  . runUnspecialized
  . runResolutionError
+  . runEnvironmentError
  . runEvalError
  . runAddressError
  . runTypeError
@ -93,3 +97,12 @@ parseFile parser = runTask . (parse parser <=< readBlob . file)

 blob :: FilePath -> IO Blob
 blob = runTask . readBlob . file
+
+
+injectConst :: a -> SomeExc (Sum '[Const a])
+injectConst = SomeExc . injectSum . Const
+
+mergeExcs :: Either (SomeExc (Sum excs)) (Either (SomeExc exc) result) -> Either (SomeExc (Sum (exc ': excs))) result
+mergeExcs = either (\ (SomeExc sum) -> Left (SomeExc (weakenSum sum))) (either (\ (SomeExc exc) -> Left (SomeExc (injectSum exc))) Right)
+
+reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . first injectConst
--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@ -40,11 +40,11 @@ spec = parallel $ do

    it "subclasses" $ do
      v <- fst <$> evaluate "subclass.py"
-      v `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (String "\"bar\"")))))))))
+      v `shouldBe` Right [injValue (String "\"bar\"")]

    it "handles multiple inheritance left-to-right" $ do
      v <- fst <$> evaluate "multiple_inheritance.py"
-      v `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (String "\"foo!\"")))))))))
+      v `shouldBe` Right [injValue (String "\"foo!\"")]

  where
    ns n = Just . Latest . Just . injValue . Namespace n
--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@ -9,6 +9,7 @@ import Control.Monad.Effect (SomeExc(..))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Map
 import Data.Map.Monoidal as Map
+import Data.Sum
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Data.Language as Language

@ -30,12 +31,12 @@ spec = parallel $ do

    it "evaluates load with wrapper" $ do
      res <- evaluate "load-wrap.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Left (SomeExc (FreeVariableError "foo")))))))
+      fst res `shouldBe` Left (SomeExc (injectSum (FreeVariable "foo" :: EnvironmentError (Value Precise) (Value Precise))))
      environment (snd res) `shouldBe` [ ("Object", addr 0) ]

    it "evaluates subclass" $ do
      res <- evaluate "subclass.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (String "\"<bar>\"")))))))))
+      fst res `shouldBe` Right [injValue (String "\"<bar>\"")]
      environment (snd res) `shouldBe` [ ("Bar", addr 6)
                                       , ("Foo", addr 3)
                                       , ("Object", addr 0) ]
@ -47,29 +48,29 @@ spec = parallel $ do

    it "evaluates modules" $ do
      res <- evaluate "modules.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (String "\"<hello>\"")))))))))
+      fst res `shouldBe` Right [injValue (String "\"<hello>\"")]
      environment (snd res) `shouldBe` [ ("Object", addr 0)
                                       , ("Bar", addr 3) ]

    it "handles break correctly" $ do
      res <- evaluate "break.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (Value.Integer (Number.Integer 3))))))))))
+      fst res `shouldBe` Right [injValue (Value.Integer (Number.Integer 3))]

    it "handles break correctly" $ do
      res <- evaluate "next.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (Value.Integer (Number.Integer 8))))))))))
+      fst res `shouldBe` Right [injValue (Value.Integer (Number.Integer 8))]

    it "calls functions with arguments" $ do
      res <- evaluate "call.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (Value.Integer (Number.Integer 579))))))))))
+      fst res `shouldBe` Right [injValue (Value.Integer (Number.Integer 579))]

    it "evaluates early return statements" $ do
      res <- evaluate "early-return.rb"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (Value.Integer (Number.Integer 123))))))))))
+      fst res `shouldBe` Right [injValue (Value.Integer (Number.Integer 123))]

    it "has prelude" $ do
      res <- fst <$> evaluate "preluded.rb"
-      res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (String "\"<foo>\"")))))))))
+      res `shouldBe` Right [injValue (String "\"<foo>\"")]

  where
    ns n = Just . Latest . Just . injValue . Namespace n
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@ -6,6 +6,7 @@ import qualified Language.TypeScript.Assignment as TypeScript
 import Data.Abstract.Value as Value
 import Data.Abstract.Number as Number
 import qualified Data.Language as Language
+import Data.Sum

 import SpecHelpers

@ -34,11 +35,11 @@ spec = parallel $ do

    it "fails exporting symbols not defined in the module" $ do
      v <- fst <$> evaluate "bad-export.ts"
-      v `shouldBe` Right (Right (Right (Right (Right (Left (SomeExc (ExportError "foo.ts" (Name "pip"))))))))
+      v `shouldBe` Left (SomeExc (injectSum (ExportError "foo.ts" (Name "pip") :: EvalError (Value Precise) ())))

    it "evaluates early return statements" $ do
      res <- evaluate "early-return.ts"
-      fst res `shouldBe` Right (Right (Right (Right (Right (Right (Right (pure (injValue (Value.Float (Number.Decimal 123.0))))))))))
+      fst res `shouldBe` Right [injValue (Value.Float (Number.Decimal 123.0))]

  where
    fixtures = "test/fixtures/typescript/analysis/"
--- a/test/Control/Abstract/Evaluator/Spec.hs
+++ b/test/Control/Abstract/Evaluator/Spec.hs
@ -0,0 +1,73 @@
+module Control.Abstract.Evaluator.Spec where
+
+import Analysis.Abstract.Evaluating (evaluating)
+import Control.Abstract
+import Data.Abstract.Module
+import qualified Data.Abstract.Number as Number
+import Data.Abstract.Package
+import qualified Data.Abstract.Value as Value
+import Data.Algebra
+import Data.Bifunctor (first)
+import Data.Functor.Const
+import Data.Sum
+import SpecHelpers hiding (Term, reassociate)
+
+spec :: Spec
+spec = parallel $ do
+  it "constructs integers" $ do
+    (expected, _) <- evaluate (integer 123)
+    expected `shouldBe` Right (Value.injValue (Value.Integer (Number.Integer 123)))
+
+  it "calls functions" $ do
+    (expected, _) <- evaluate $ do
+      identity <- lambda [name "x"] (term (variable (name "x")))
+      call identity [integer 123]
+    expected `shouldBe` Right (Value.injValue (Value.Integer (Number.Integer 123)))
+
+evaluate
+  = runM
+  . fmap (first reassociate)
+  . evaluating
+  . runReader (PackageInfo (name "test") Nothing)
+  . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
+  . Value.runValueError
+  . runEnvironmentError
+  . runAddressError
+  . runValue
+runValue = runEvalClosure (runValue . runTerm) . runReturn . runLoopControl
+
+reassociate :: Either String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const String, exc1, exc2, exc3])) result
+reassociate (Left s) = Left (SomeExc (injectSum (Const s)))
+reassociate (Right (Right (Right (Right a)))) = Right a
+
+term :: TermEvaluator Value -> Subterm Term (TermEvaluator Value)
+term eval = Subterm (Term eval) eval
+
+type TermEffects
+  = '[ LoopControl Value
+     , Return Value
+     , EvalClosure Term Value
+     , Resumable (AddressError Precise Value)
+     , Resumable (EnvironmentError Value)
+     , Resumable (Value.ValueError Precise Value)
+     , Reader ModuleInfo
+     , Reader PackageInfo
+     , Fail
+     , Fresh
+     , Reader (Environment Precise Value)
+     , State (Environment Precise Value)
+     , State (Heap Precise Value)
+     , State (ModuleTable (Environment Precise Value, Value))
+     , State (Exports Precise Value)
+     , State (JumpTable Term)
+     , IO
+     ]
+
+type TermEvaluator = Evaluator Precise Term Value TermEffects
+
+type Value = Value.Value Precise
+newtype Term = Term { runTerm :: TermEvaluator Value }
+
+instance Show Term where showsPrec d _ = showParen (d > 10) $ showString "Term _"
+
+instance FreeVariables Term where freeVariables _ = []
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -6,6 +6,7 @@ import qualified Analysis.Python.Spec
 import qualified Analysis.Ruby.Spec
 import qualified Analysis.TypeScript.Spec
 import qualified Assigning.Assignment.Spec
+import qualified Control.Abstract.Evaluator.Spec
 import qualified Data.Diff.Spec
 import qualified Data.Abstract.Path.Spec
 import qualified Data.Functor.Classes.Generic.Spec
@ -35,6 +36,7 @@ main = hspec $ do
    describe "Analysis.Ruby" Analysis.Ruby.Spec.spec
    describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec
    describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
+    describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec
    describe "Data.Diff" Data.Diff.Spec.spec
    describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
    describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
 module SpecHelpers
 ( module X
 , diffFilePaths
@ -22,6 +21,7 @@ import Data.Abstract.FreeVariables as X hiding (dropExtension)
 import Data.Abstract.Heap as X
 import Data.Abstract.ModuleTable as X hiding (lookup)
 import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, runValueError)
+import Data.Bifunctor (first)
 import Data.Blob as X
 import Data.File as X
 import Data.Functor.Listable as X
@ -70,12 +70,14 @@ readFilePair paths = let paths' = fmap file paths in

 testEvaluating
  = run
+  . fmap (first reassociate)
  . evaluating
  . runIgnoringTraces
  . runLoadError
  . runValueError
  . runUnspecialized
  . runResolutionError
+  . runEnvironmentError
  . runEvalError
  . runAddressError
  . constrainedToValuePrecise