diff --git a/preludes/ruby.rb b/preludes/ruby.rb index af3f8721d..37c7e6000 100644 --- a/preludes/ruby.rb +++ b/preludes/ruby.rb @@ -1,3 +1,7 @@ +def require_dependency(path) + require_relative(path) +end + class Object def new self diff --git a/src/Analysis/Abstract/BadValues.hs b/src/Analysis/Abstract/BadValues.hs index a2d9c6407..efc3c55f7 100644 --- a/src/Analysis/Abstract/BadValues.hs +++ b/src/Analysis/Abstract/BadValues.hs @@ -34,6 +34,8 @@ instance ( Effectful m yield (Env.push env) (CallError val) -> yield val (StringError val) -> yield (pack $ show val) - (BoolError val) -> yield True) + BoolError{} -> yield True + Numeric2Error{} -> unit >>= yield + ) analyzeModule = liftAnalyze analyzeModule diff --git a/src/Analysis/Abstract/BadVariables.hs b/src/Analysis/Abstract/BadVariables.hs index 75e7c57b7..a7a484fff 100644 --- a/src/Analysis/Abstract/BadVariables.hs +++ b/src/Analysis/Abstract/BadVariables.hs @@ -27,7 +27,8 @@ instance ( Effectful m type Effects location term value (BadVariables m effects) = State [Name] ': Effects location term value (m effects) analyzeTerm eval term = resumeException @(EvalError value) (liftAnalyze analyzeTerm eval term) ( - \yield (FreeVariableError name) -> - raise (modify' (name :)) >> unit >>= yield) + \yield err -> case err of + (FreeVariableError name) -> raise (modify' (name :)) >> unit >>= yield + (FreeVariablesError names) -> raise (modify' (names <>)) >> yield (last names) ) analyzeModule = liftAnalyze analyzeModule diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 378a2463d..cb22e1b5b 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -189,20 +189,20 @@ class ValueRoots location value where -- The type of exceptions that can be thrown when constructing values in `MonadValue`. data ValueError location value resume where - TypeError :: Prelude.String -> ValueError location value value StringError :: value -> ValueError location value ByteString NamespaceError :: Prelude.String -> ValueError location value (Environment location value) ScopedEnvironmentError :: Prelude.String -> ValueError location value (Environment location value) CallError :: value -> ValueError location value value BoolError :: value -> ValueError location value Bool + Numeric2Error :: value -> value -> ValueError location value value instance Eq value => Eq1 (ValueError location value) where - liftEq _ (TypeError a) (TypeError b) = a == b liftEq _ (StringError a) (StringError b) = a == b liftEq _ (NamespaceError a) (NamespaceError b) = a == b liftEq _ (ScopedEnvironmentError a) (ScopedEnvironmentError b) = a == b liftEq _ (CallError a) (CallError b) = a == b - liftEq _ (BoolError a) (BoolError c) = (a == c) + liftEq _ (BoolError a) (BoolError c) = a == c + liftEq _ (Numeric2Error a b) (Numeric2Error c d) = (a == c) && (b == d) liftEq _ _ _ = False deriving instance (Show value) => Show (ValueError location value resume) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index d1e64fbb5..88508783a 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -15,6 +15,7 @@ module Data.Abstract.Evaluatable , evaluatePackageBody , throwLoadError , throwEvalError +, throwValueError , resolve , listModulesInDir , require @@ -95,6 +96,10 @@ instance Eq1 (EvalError term) where liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b liftEq _ _ _ = False + +throwValueError :: MonadEvaluatable location term value m => ValueError location value resume -> m resume +throwValueError = throwException + throwLoadError :: MonadEvaluatable location term value m => LoadError term value resume -> m resume throwLoadError = throwException diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index fc67b7ed4..0aa986b64 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -259,7 +259,7 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value | Just (Float i, Integer j) <- prjPair pair = f i j & specialize | Just (Float i, Rational j) <- prjPair pair = f i j & specialize | Just (Float i, Float j) <- prjPair pair = f i j & specialize - | otherwise = fail ("Invalid operands to liftNumeric2: " <> show pair) + | otherwise = throwValueError (Numeric2Error left right) where -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor specialize :: MonadValue location value m => Number.SomeNumber -> m value