Fix broken Semigroup instance for Imperative

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

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

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 -- ^ Initial statement
-        -> m value -- | Condition
+        -> m value -- ^ Condition
-        -> m value -- | Increment/stepper
+        -> m value -- ^ Increment/stepper
-        -> m value -- | Body
+        -> m value -- ^ Body
         -> m value
-forLoop initial cond step body = do
+forLoop initial cond step body =
-  void initial
+  localEnv id (initial *> while cond (body *> step))
-  env <- getGlobalEnv
-  localEnv (mappend env) (while cond (body *> step))
 
 -- | The fundamental looping primitive, built on top of ifthenelse.
 while :: MonadValue value m

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
+  Imperative a <> Imperative b = Imperative (a *> b)
-    env <- getGlobalEnv
-    localEnv (<> env) b
 
 instance (MonadEnvironment value m, MonadValue value m) => Monoid (Imperative m value) where
   mempty = Imperative unit

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] }