From ad4e7e83f4c2eda565dfa2337c760a34a17cfbac Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 7 Mar 2018 14:38:02 -0500
Subject: [PATCH] Ensure that floats can be evaluated.

---
 src/Control/Abstract/Value.hs     |  6 ++++++
 src/Data/Abstract/Type.hs         |  1 +
 src/Data/Abstract/Value.hs        | 12 +++++++++++-
 src/Data/Syntax/Literal.hs        |  5 ++---
 src/Language/Python/Assignment.hs |  1 -
 src/Language/Ruby/Assignment.hs   |  1 -
 6 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 8120eb47c..da3ef8881 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -10,6 +10,7 @@ import Data.Abstract.Environment
 import Data.Abstract.FreeVariables
 import Data.Abstract.Value as Value
 import Data.Abstract.Type as Type
+import Data.Scientific (Scientific)
 import Prologue
 import Prelude hiding (fail)
 
@@ -29,6 +30,9 @@ class (MonadEvaluator t v m) => MonadValue t v m where
   -- | Construct an abstract string value.
   string :: ByteString -> m v
 
+  -- | Construct a floating-point value.
+  float :: Scientific -> m v
+
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: v -> m v -> m v -> m v
 
@@ -51,6 +55,7 @@ instance ( FreeVariables t
   integer = pure . inj . Integer
   boolean = pure . inj . Boolean
   string  = pure . inj . Value.String
+  float   = pure . inj . Value.Float
 
   ifthenelse cond if' else'
     | Just (Boolean b) <- prj cond = if b then if' else else'
@@ -83,6 +88,7 @@ instance (Alternative m, MonadEvaluator t Type m, MonadFresh m) => MonadValue t
   integer _ = pure Int
   boolean _ = pure Bool
   string _  = pure Type.String
+  float _   = pure Type.Float
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
 
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index c0b352bce..9709d087a 100644
--- a/src/Data/Abstract/Type.hs
+++ b/src/Data/Abstract/Type.hs
@@ -13,6 +13,7 @@ data Type
   | Bool           -- ^ Primitive boolean type.
   | String         -- ^ Primitive string type.
   | Unit           -- ^ The unit type.
+  | Float          -- ^ Floating-point type.
   | Type :-> Type  -- ^ Binary function types.
   | Var TName      -- ^ A type variable.
   | Product [Type] -- ^ N-ary products.
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 9f798baf2..62a406bad 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -8,8 +8,9 @@ import Data.Abstract.FreeVariables
 import Data.Abstract.Live
 import qualified Data.Abstract.Type as Type
 import qualified Data.Set as Set
+import Data.Scientific (Scientific)
 import Prologue
-import Prelude hiding (Integer, String, fail)
+import Prelude hiding (Float, Integer, String, fail)
 import qualified Prelude
 
 type ValueConstructors location
@@ -17,6 +18,7 @@ type ValueConstructors location
     , Interface location
     , Unit
     , Boolean
+    , Float
     , Integer
     , String
     ]
@@ -75,6 +77,14 @@ instance Eq1 String where liftEq = genericLiftEq
 instance Ord1 String where liftCompare = genericLiftCompare
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
+-- | Float values.
+newtype Float term = Float Scientific
+  deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Float where liftEq = genericLiftEq
+instance Ord1 Float where liftCompare = genericLiftCompare
+instance Show1 Float where liftShowsPrec = genericLiftShowsPrec
+
 -- | The environment for an abstract value type.
 type EnvironmentFor v = Environment (LocationFor v) v
 
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index aab6558e0..2ab2b9991 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -6,7 +6,6 @@ import Data.ByteString.Char8 (readInteger, unpack)
 import qualified Data.ByteString.Char8 as B
 import Data.Monoid (Endo (..), appEndo)
 import Data.Scientific (Scientific)
-import Data.Word (Word8)
 import Diffing.Algorithm
 import Prelude hiding (Float, fail)
 import Prologue hiding (Set)
@@ -87,8 +86,8 @@ buildFloat preds val =
     Nothing -> fail ("Invalid floating-point value: " <> show val)
     Just s  -> pure (Float s val)
 
--- TODO: Implement Eval instance for Float
-instance Evaluatable Data.Syntax.Literal.Float
+instance Evaluatable Data.Syntax.Literal.Float where
+  eval (Float s _) = float s
 
 -- Rational literals e.g. `2/3r`
 newtype Rational a = Rational ByteString
diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs
index 3c71292db..a22905507 100644
--- a/src/Language/Python/Assignment.hs
+++ b/src/Language/Python/Assignment.hs
@@ -17,7 +17,6 @@ import GHC.Stack
 import Language.Python.Grammar as Grammar
 import Language.Python.Syntax as Python.Syntax
 import qualified Assigning.Assignment as Assignment
-import qualified Data.ByteString as B
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs
index 8242d1175..1cf03032a 100644
--- a/src/Language/Ruby/Assignment.hs
+++ b/src/Language/Ruby/Assignment.hs
@@ -12,7 +12,6 @@ import Data.Record
 import Data.List (elem)
 import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
 import qualified Assigning.Assignment as Assignment
-import qualified Data.ByteString as B
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration