From bd997d8564a820cb4d7ecddd8c7c978d93830fa4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Sun, 6 May 2018 13:50:58 -0400
Subject: [PATCH] Handle Return locally to evalTerm.

---
 src/Analysis/Abstract/Evaluating.hs | 6 ++----
 src/Data/Abstract/Evaluatable.hs    | 7 ++++---
 2 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs
index dfb6c22e5..b378f02c4 100644
--- a/src/Analysis/Abstract/Evaluating.hs
+++ b/src/Analysis/Abstract/Evaluating.hs
@@ -28,8 +28,7 @@ deriving instance (Show (Cell location value), Show location, Show term, Show va
 
 -- | Effects necessary for evaluating (whether concrete or abstract).
 type EvaluatingEffects location term value
-  = '[ Return value
-     , LoopControl value
+  = '[ LoopControl value
      , Fail                                -- Failure with an error message
      , Fresh                               -- For allocating new addresses and/or type variables.
      , Reader (Environment location value) -- Default environment used as a fallback in lookupEnv
@@ -59,6 +58,5 @@ evaluating
     -- In general, it’s expected that none of the following effects will remain by the time 'interpret' is called—they should have been handled by local 'interpose's—but if they do, we’ll at least trace.
     . Eff.interpret (\ control -> case control of
       Break value -> traceM ("Evaluating.interpret: resuming uncaught break with " <> show value) $> value
-      Continue    -> traceM "Evaluating.interpret: resuming uncaught continue with hole" $> hole)
-    . Eff.interpret (\ (Return value) -> traceM ("Evaluating.interpret: resuming uncaught return with " <> show value) $> value))
+      Continue    -> traceM "Evaluating.interpret: resuming uncaught continue with hole" $> hole))
     -- TODO: Replace 'traceM's with e.g. 'Telemetry'.
diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs
index 5fee146a8..3d4f277a8 100644
--- a/src/Data/Abstract/Evaluatable.hs
+++ b/src/Data/Abstract/Evaluatable.hs
@@ -324,7 +324,7 @@ evaluatePackageWith :: ( Evaluatable (Base term)
                                   , State (Environment location value)
                                   ] effects
                        , Recursive term
-                       , termEffects ~ (EvalClosure term value ': moduleEffects)
+                       , termEffects ~ (Return value ': EvalClosure term value ': moduleEffects)
                        , moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects)
                        , packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': packageEffects)
                        , packageEffects ~ (Reader PackageInfo ': effects)
@@ -344,7 +344,7 @@ evaluatePackageBodyWith :: forall location term value effects termEffects module
                                       , State (Environment location value)
                                       ] effects
                            , Recursive term
-                           , termEffects ~ (EvalClosure term value ': moduleEffects)
+                           , termEffects ~ (Return value ': EvalClosure term value ': moduleEffects)
                            , moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects)
                            , packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': effects)
                            )
@@ -369,9 +369,10 @@ evaluatePackageBodyWith perModule perTerm body
         handleEvalClosures = raiseHandler (relay pure (\ (EvalClosure term) yield -> lower (evalTerm term) >>= yield))
         evalTerm
           = handleEvalClosures
+          . runReturn
           . foldSubterms (perTerm eval)
 
-        evaluateEntryPoint m sym = handleReader (ModuleInfo m) . handleEvalClosures $ do
+        evaluateEntryPoint m sym = handleReader (ModuleInfo m) . handleEvalClosures . runReturn $ do
           v <- maybe unit (pure . snd) <$> require m
           maybe v ((`call` []) <=< variable) sym