From 96df75d5a35af21baede3ad7f9e42838d138fea0 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 16 Mar 2018 15:55:25 -0400
Subject: [PATCH] Fix broken Semigroup instance for Imperative

---
 src/Analysis/Abstract/Evaluating.hs |  3 +++
 src/Control/Abstract/Evaluator.hs   |  1 +
 src/Control/Abstract/Value.hs       | 14 ++++++--------
 src/Data/Abstract/Evaluatable.hs    |  5 ++---
 src/Data/Syntax/Declaration.hs      |  1 -
 5 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs
index fbf5f6aa4..11740e577 100644
--- a/src/Analysis/Abstract/Evaluating.hs
+++ b/src/Analysis/Abstract/Evaluating.hs
@@ -35,6 +35,7 @@ evaluate :: forall value term effects
             , MonadAddressable (LocationFor value) value (Evaluating term value effects)
             , MonadValue value (Evaluating term value effects)
             , Recursive term
+            , Show (LocationFor value)
             )
          => term
          -> Final effects value
@@ -48,6 +49,7 @@ evaluates :: forall value term effects
              , MonadAddressable (LocationFor value) value (Evaluating term value effects)
              , MonadValue value (Evaluating term value effects)
              , Recursive term
+             , Show (LocationFor value)
              )
           => [(Blob, term)] -- List of (blob, term) pairs that make up the program to be evaluated
           -> (Blob, term)   -- Entrypoint
@@ -131,6 +133,7 @@ instance ( Evaluatable (Base term)
          , MonadAddressable (LocationFor value) value (Evaluating term value effects)
          , MonadValue value (Evaluating term value effects)
          , Recursive term
+         , Show (LocationFor value)
          )
          => MonadAnalysis term value (Evaluating term value effects) where
   type RequiredEffects term value (Evaluating term value effects) = EvaluatingEffects term value
diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs
index bccfaa03f..108d7691e 100644
--- a/src/Control/Abstract/Evaluator.hs
+++ b/src/Control/Abstract/Evaluator.hs
@@ -74,6 +74,7 @@ class Monad m => MonadEnvironment value m | m -> value where
     maybe (pure Nothing) (fmap Just . with) addr
 
 -- | Update the global environment.
+-- TODO: RENAME ME BECAUSE MY NAME IS A LIE
 modifyGlobalEnv :: MonadEnvironment value m => (EnvironmentFor value -> EnvironmentFor value) -> m ()
 modifyGlobalEnv f = do
   env <- getGlobalEnv
diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 6299fda65..75fcf6338 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -103,15 +103,13 @@ toBool :: MonadValue value m => value -> m Bool
 toBool v = ifthenelse v (pure True) (pure False)
 
 forLoop :: (MonadEnvironment value m, MonadValue value m)
-        => m value -- | Initial statement
-        -> m value -- | Condition
-        -> m value -- | Increment/stepper
-        -> m value -- | Body
+        => m value -- ^ Initial statement
+        -> m value -- ^ Condition
+        -> m value -- ^ Increment/stepper
+        -> m value -- ^ Body
         -> m value
-forLoop initial cond step body = do
-  void initial
-  env <- getGlobalEnv
-  localEnv (mappend env) (while cond (body *> step))
+forLoop initial cond step body =
+  localEnv id (initial *> while cond (body *> step))
 
 -- | The fundamental looping primitive, built on top of ifthenelse.
 while :: MonadValue value m
diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs
index 5455f0e0c..adf41de29 100644
--- a/src/Data/Abstract/Evaluatable.hs
+++ b/src/Data/Abstract/Evaluatable.hs
@@ -27,6 +27,7 @@ class Evaluatable constr where
           , MonadAddressable (LocationFor value) value m
           , MonadAnalysis term value m
           , MonadValue value m
+          , Show (LocationFor value)
           )
        => SubtermAlgebra constr term (m value)
   default eval :: (MonadFail m, Show1 constr) => SubtermAlgebra constr term (m value)
@@ -56,9 +57,7 @@ instance Evaluatable [] where
 newtype Imperative m a = Imperative { runImperative :: m a }
 
 instance MonadEnvironment value m => Semigroup (Imperative m a) where
-  Imperative a <> Imperative b = Imperative $ a *> do
-    env <- getGlobalEnv
-    localEnv (<> env) b
+  Imperative a <> Imperative b = Imperative (a *> b)
 
 instance (MonadEnvironment value m, MonadValue value m) => Monoid (Imperative m value) where
   mempty = Imperative unit
diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs
index 792f48990..925809258 100644
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@@ -150,7 +150,6 @@ instance Evaluatable Class where
       void $ subtermValue classBody
       classEnv <- Env.head <$> askLocalEnv
       klass name classEnv
-
     v <$ modifyGlobalEnv (Env.insert name addr)
 
 data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] }