Wrap EvalError with BaseError

src/Data/Abstract/Evaluatable.hs

@@ -61,7 +61,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           , Member (Reader Span) effects
           , Member (Resumable (EnvironmentError address)) effects
           , Member (Resumable (Unspecialized value)) effects
-          , Member (Resumable EvalError) effects
+          , Member (Resumable (BaseError EvalError)) effects
           , Member (Resumable ResolutionError) effects
           , Member Fresh effects
           , Member Trace effects
@@ -90,7 +90,7 @@ evaluate :: ( AbstractValue address value valueEffects
             , Member (Reader Span) effects
             , Member (Resumable (BaseError (AddressError address value))) effects
             , Member (Resumable (EnvironmentError address)) effects
-            , Member (Resumable EvalError) effects
+            , Member (Resumable (BaseError EvalError)) effects
             , Member (Resumable ResolutionError) effects
             , Member (Resumable (Unspecialized value)) effects
             , Member (State (Heap address (Cell address) value)) effects
@@ -239,15 +239,15 @@ instance Eq1 EvalError where
 instance Show1 EvalError where
   liftShowsPrec _ _ = showsPrec
 
-throwEvalError :: (Effectful m, Member (Resumable EvalError) effects) => EvalError resume -> m effects resume
-throwEvalError = throwResumable
-
-runEvalError :: (Effectful m, Effects effects) => m (Resumable EvalError ': effects) a -> m effects (Either (SomeExc EvalError) a)
+runEvalError :: (Effectful m, Effects effects) => m (Resumable (BaseError EvalError) ': effects) a -> m effects (Either (SomeExc (BaseError EvalError)) a)
 runEvalError = runResumable
 
-runEvalErrorWith :: (Effectful m, Effects effects) => (forall resume . EvalError resume -> m effects resume) -> m (Resumable EvalError ': effects) a -> m effects a
+runEvalErrorWith :: (Effectful m, Effects effects) => (forall resume . (BaseError EvalError) resume -> m effects resume) -> m (Resumable (BaseError EvalError) ': effects) a -> m effects a
 runEvalErrorWith = runResumableWith
 
+throwEvalError :: (Monad (m effects), Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects, Member (Resumable (BaseError EvalError)) effects) => EvalError resume -> m effects resume
+throwEvalError err = currentErrorContext >>= \ errorContext -> throwResumable $ BaseError errorContext err
+
 
 data Unspecialized a b where
   Unspecialized :: String -> Unspecialized value value

src/Language/PHP/Syntax.hs

@@ -375,12 +375,12 @@ instance Evaluatable Namespace where
     where
       -- Each namespace name creates a closure over the subsequent namespace closures
       go (n:x:xs) = do
-        name <- maybeM (throwResumable NoNameError) n
+        name <- maybeM (throwEvalError NoNameError) n
         letrec' name $ \addr ->
           box =<< makeNamespace name addr Nothing (void $ go (x:xs))
       -- The last name creates a closure over the namespace body.
       go [n] = do
-        name <- maybeM (throwResumable NoNameError) n
+        name <- maybeM (throwEvalError NoNameError) n
         letrec' name $ \addr ->
           box =<< makeNamespace name addr Nothing (void $ subtermAddress namespaceBody)
       -- The absence of names implies global scope, cf http://php.net/manual/en/language.namespaces.definitionmultiple.php

src/Semantic/Graph.hs

@@ -199,7 +199,7 @@ newtype ImportGraphEff address outerEffects a = ImportGraphEff
                              ': Resumable (BaseError (ValueError address (ImportGraphEff address outerEffects)))
                              ': Resumable (BaseError (AddressError address (Value address (ImportGraphEff address outerEffects))))
                              ': Resumable ResolutionError
-                             ': Resumable EvalError
+                             ': Resumable (BaseError EvalError)
                              ': Resumable (EnvironmentError address)
                              ': Resumable (Unspecialized (Value address (ImportGraphEff address outerEffects)))
                              ': Resumable (LoadError address)
@@ -251,8 +251,8 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr
 resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a
 resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole))
 
-resumingEvalError :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable EvalError ': effects) a -> m effects a
-resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of
+resumingEvalError :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable (BaseError EvalError) ': effects) a -> m effects a
+resumingEvalError = runEvalErrorWith (\ (BaseError context err) -> trace ("EvalError:" <> prettyShow context <> prettyShow err) *> case err of
   DefaultExportError{}  -> pure ()
   ExportError{}         -> pure ()
   IntegerFormatError{}  -> pure 0

src/Semantic/Util.hs

@@ -69,7 +69,7 @@ newtype UtilEff address a = UtilEff
                        , Resumable (BaseError (ValueError address (UtilEff address)))
                        , Resumable (BaseError (AddressError address (Value address (UtilEff address))))
                        , Resumable ResolutionError
-                       , Resumable EvalError
+                       , Resumable (BaseError EvalError)
                        , Resumable (EnvironmentError address)
                        , Resumable (Unspecialized (Value address (UtilEff address)))
                        , Resumable (LoadError address)