Remove fails from Data.Syntax.Literal.

src/Analysis/Abstract/BadValues.hs

@@ -32,16 +32,16 @@ instance ( Effectful m
           (ScopedEnvironmentError _) -> do
             env <- getEnv
             yield (Env.push env)
-          CallError val     -> yield val
-          StringError val   -> yield (pack $ show val)
-          BoolError{}       -> yield True
-          NumericError{}    -> unit >>= yield
-          Numeric2Error{}   -> unit >>= yield
-          ComparisonError{} -> unit >>= yield
-          NamespaceError{}  -> getEnv >>= yield
-          BitwiseError{}    -> unit >>= yield
-          Bitwise2Error{}   -> unit >>= yield
-          KeyValueError{}   -> unit >>= \x -> yield (x, x)
+          CallError val        -> yield val
+          StringError val      -> yield (pack $ show val)
+          BoolError{}          -> yield True
+          NumericError{}       -> unit >>= yield
+          Numeric2Error{}      -> unit >>= yield
+          ComparisonError{}    -> unit >>= yield
+          NamespaceError{}     -> getEnv >>= yield
+          BitwiseError{}       -> unit >>= yield
+          Bitwise2Error{}      -> unit >>= yield
+          KeyValueError{}      -> unit >>= \x -> yield (x, x)
           )
 
   analyzeModule = liftAnalyze analyzeModule

src/Analysis/Abstract/BadVariables.hs

@@ -28,7 +28,10 @@ instance ( Effectful m
 
   analyzeTerm eval term = resumeException @(EvalError value) (liftAnalyze analyzeTerm eval term) (
         \yield err -> case err of
-          (FreeVariableError name) -> raise (modify' (name :)) >> unit >>= yield
-          (FreeVariablesError names) -> raise (modify' (names <>)) >> yield (fromMaybeLast "unknown" names))
+          IntegerFormatError{}     -> yield 0
+          FloatFormatError{}       -> yield 0
+          RationalFormatError{}    -> yield 0
+          FreeVariableError name   -> raise (modify' (name :)) >> unit >>= yield
+          FreeVariablesError names -> raise (modify' (names <>)) >> yield (fromMaybeLast "unknown" names))
 
   analyzeModule = liftAnalyze analyzeModule

src/Control/Abstract/Value.hs

@@ -190,14 +190,14 @@ class ValueRoots location value where
 -- The type of exceptions that can be thrown when constructing values in `MonadValue`.
 data ValueError location value resume where
   StringError            :: value          -> ValueError location value ByteString
+  BoolError              :: value          -> ValueError location value Bool
   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
   NumericError           :: value          -> ValueError location value value
-  Numeric2Error          :: value          -> value -> ValueError location value value
-  ComparisonError        :: value          -> value -> ValueError location value value
-  BitwiseError           :: value -> ValueError location value value
+  Numeric2Error          :: value -> value -> ValueError location value value
+  ComparisonError        :: value -> value -> ValueError location value value
+  BitwiseError           :: value          -> ValueError location value value
   Bitwise2Error          :: value -> value -> ValueError location value value
   KeyValueError          :: value          -> ValueError location value (value, value)
 

src/Data/Abstract/Evaluatable.hs

@@ -33,6 +33,7 @@ import           Data.Abstract.Module
 import           Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Origin (SomeOrigin, packageOrigin)
 import           Data.Abstract.Package as Package
+import           Data.Scientific (Scientific)
 import           Data.Semigroup.App
 import           Data.Semigroup.Foldable
 import           Data.Semigroup.Reducer hiding (unit)
@@ -85,6 +86,11 @@ data EvalError value resume where
   -- Indicates we weren't able to dereference a name from the evaluated environment.
   FreeVariableError :: Name -> EvalError value value
   FreeVariablesError :: [Name] -> EvalError value Name
+  -- Indicates that our evaluator wasn't able to make sense of these literals.
+  IntegerFormatError  :: ByteString -> EvalError value Integer
+  FloatFormatError    :: ByteString -> EvalError value Scientific
+  RationalFormatError :: ByteString -> EvalError value Rational
+
 
 -- | Look up and dereference the given 'Name', throwing an exception for free variables.
 variable :: MonadEvaluatable location term value m => Name -> m value

src/Data/Abstract/Value.hs

@@ -245,9 +245,9 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
 
   liftNumeric f arg
     | Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i
-    | Just (Float (Number.Decimal d))          <- prjValue arg = float   $ f d
-    | Just (Rational (Number.Ratio r))         <- prjValue arg = rational $ f r
-    | otherwise = throwValueError (NumericError f)
+    | Just (Float (Number.Decimal d))   <- prjValue arg = float   $ f d
+    | Just (Rational (Number.Ratio r))  <- prjValue arg = rational $ f r
+    | otherwise = throwValueError (NumericError arg)
 
   liftNumeric2 f left right
     | Just (Integer  i, Integer j)  <- prjPair pair = f i j & specialize

src/Data/Syntax/Literal.hs

@@ -7,7 +7,7 @@ import Data.ByteString.Char8 (readInteger, unpack)
 import qualified Data.ByteString.Char8 as B
 import Data.Scientific.Exts
 import Diffing.Algorithm
-import Prelude hiding (Float, fail, null)
+import Prelude hiding (Float, null)
 import Prologue hiding (Set, hash, null)
 import Text.Read (readMaybe)
 
@@ -42,7 +42,8 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
 
 instance Evaluatable Data.Syntax.Literal.Integer where
   -- TODO: This instance probably shouldn't have readInteger?
-  eval (Data.Syntax.Literal.Integer x) = integer (maybe 0 fst (readInteger x))
+  eval (Data.Syntax.Literal.Integer x) =
+    integer =<< maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x)
 
 
 -- TODO: Should IntegerLiteral hold an Integer instead of a ByteString?
@@ -59,9 +60,7 @@ instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsP
 
 instance Evaluatable Data.Syntax.Literal.Float where
   eval (Float s) =
-    case parseScientific s of
-      Right num -> float num
-      Left  err -> fail ("Parse error: " <> err)
+    float =<< either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s)
 
 -- Rational literals e.g. `2/3r`
 newtype Rational a = Rational ByteString
@@ -72,10 +71,11 @@ instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompar
 instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Data.Syntax.Literal.Rational where
-  eval (Rational r) = let trimmed = B.takeWhile (/= 'r') r in
-    case readMaybe @Prelude.Integer (unpack trimmed) of
-      Just i  -> rational (toRational i)
-      Nothing -> fail ("Bug: invalid rational " <> show r)
+  eval (Rational r) =
+    let
+      trimmed = B.takeWhile (/= 'r') r
+      parsed = readMaybe @Prelude.Integer (unpack trimmed)
+    in rational =<< maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed
 
 
 -- Complex literals e.g. `3 + 2i`