From 6f9a6cb6b8b93876c840cb2f8c06c47b8793bca7 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 13 Mar 2018 14:45:20 -0400
Subject: [PATCH 1/6] Evaluatable instance for symbols.

Deferring the decision on whether to intern symbols to some later date
when we really get into the weeds re. Ruby semantics.
---
 src/Control/Abstract/Value.hs |  6 ++++++
 src/Data/Abstract/Type.hs     |  1 +
 src/Data/Abstract/Value.hs    | 10 ++++++++++
 src/Data/Syntax/Literal.hs    |  5 ++---
 4 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index e26b52ff3..f74c69d50 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -41,6 +41,10 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Construct an abstract string value.
   string :: ByteString -> m value
 
+  -- | Construct a self-evaluating symbol value.
+  --   TODO: Should these be interned in some table to provide stronger uniqueness guarantees?
+  symbol :: ByteString -> m value
+
   -- | Construct a floating-point value.
   float :: Scientific -> m value
 
@@ -78,6 +82,7 @@ instance ( MonadAddressable location (Value location term) m
   boolean = pure . injValue . Boolean
   string  = pure . injValue . Value.String
   float   = pure . injValue . Value.Float
+  symbol  = pure . injValue . Value.Symbol
   multiple vals =
     pure . injValue $ Value.Tuple vals
 
@@ -139,6 +144,7 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
   boolean _ = pure Bool
   string _  = pure Type.String
   float _   = pure Type.Float
+  symbol _  = pure Type.Symbol
   multiple  = pure . Type.Product
   -- TODO
   interface = undefined
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index 9709d087a..29ce8f3e9 100644
--- a/src/Data/Abstract/Type.hs
+++ b/src/Data/Abstract/Type.hs
@@ -12,6 +12,7 @@ data Type
   = Int            -- ^ Primitive int type.
   | Bool           -- ^ Primitive boolean type.
   | String         -- ^ Primitive string type.
+  | Symbol         -- ^ Type of unique symbols.
   | Unit           -- ^ The unit type.
   | Float          -- ^ Floating-point type.
   | Type :-> Type  -- ^ Binary function types.
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 621c9820b..ca18156a0 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -21,6 +21,7 @@ type ValueConstructors location term
     , Float
     , Integer
     , String
+    , Symbol
     , Tuple
     ]
 
@@ -94,6 +95,15 @@ instance Eq1 String where liftEq = genericLiftEq
 instance Ord1 String where liftCompare = genericLiftCompare
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
+-- | Possibly-interned Symbol values.
+--   TODO: Should this store a 'Text'?
+newtype Symbol value = Symbol ByteString
+  deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Symbol where liftEq = genericLiftEq
+instance Ord1 Symbol where liftCompare = genericLiftCompare
+instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
+
 -- | Float values.
 newtype Float value = Float Scientific
   deriving (Eq, Generic1, Ord, Show)
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 310d13396..0fa42cbab 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -176,9 +176,8 @@ instance Eq1 Symbol where liftEq = genericLiftEq
 instance Ord1 Symbol where liftCompare = genericLiftCompare
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 
--- TODO: Implement Eval instance for Symbol
-instance Evaluatable Symbol
-
+instance Evaluatable Symbol where
+  eval (Symbol s) = symbol (B.dropWhile (== ':') s)
 
 newtype Regex a = Regex { regexContent :: ByteString }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)

From 92a7b4ca93f32494492c23adc9b64e86a96ce7f3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 13 Mar 2018 18:13:38 -0400
Subject: [PATCH 2/6] Add Evaluatable instance for Rational and unify numerical
 interface.

This one's kind of a doozy. We pull in a GADT that wraps an `Integer`,
`Rational`, or `String`, and change the interpreted value types to
hold instances of this GADT (`Number`). We also provide a rank-2
wrapper that hides the type parameter when necessary.

The upshot of this patch is that we get support for rational numbers
and a cleaner interface in MonadValue, without sacrificing a mote of
type safety: interpreted `Integer` values are guaranteed to contain a
Haskell `Integer`.

On the other hand, it's kind of a monstrosity. Please let me know if
you spot any places where I can simplify these constructs or document
the code more fully.

To test in Ruby, evaluate `3r ** 4r`.
---
 src/Control/Abstract/Value.hs | 60 +++++++++++++-----------
 src/Data/Abstract/Type.hs     |  1 +
 src/Data/Abstract/Value.hs    | 88 ++++++++++++++++++++++++++++++++---
 src/Data/Syntax/Expression.hs | 13 +++---
 src/Data/Syntax/Literal.hs    |  6 ++-
 5 files changed, 129 insertions(+), 39 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 2db0a067a..8df79c220 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -7,7 +7,7 @@ import Data.Abstract.Environment
 import Data.Abstract.FreeVariables
 import Data.Abstract.Type as Type
 import Data.Abstract.Value as Value
-import Data.Scientific (Scientific, fromFloatDigits, toRealFloat)
+import Data.Scientific (Scientific)
 import Prelude hiding (fail)
 import Prologue
 
@@ -40,8 +40,7 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   --   You usually pass the same operator as both arguments, except in the cases where
   --   Haskell provides different functions for integral and fractional operations, such
   --   as division, exponentiation, and modulus.
-  liftNumeric2 :: (forall a . (Real a, Floating a) => a -> a -> a)
-               -> (forall b . Integral b           => b -> b -> b)
+  liftNumeric2 :: (forall a b. Number a -> Number b -> SomeNumber)
                -> (value -> value -> m value)
 
   -- | Lift a Comparator (usually wrapping a function like == or <=) to a function on values.
@@ -56,6 +55,9 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Construct a floating-point value.
   float :: Scientific -> m value
 
+  -- | Construct a rational value.
+  rational :: Prelude.Rational -> m value
+
   -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
   multiple :: [value] -> m value
 
@@ -115,10 +117,11 @@ instance ( MonadAddressable location (Value location term) m
          => MonadValue term (Value location term) m where
 
   unit    = pure . injValue $ Value.Unit
-  integer = pure . injValue . Integer
+  integer = pure . injValue . Integer . Whole
   boolean = pure . injValue . Boolean
   string  = pure . injValue . Value.String
-  float   = pure . injValue . Value.Float
+  float   = pure . injValue . Value.Float . Decim
+  rational = pure . injValue . Value.Rational . Ratio
   multiple vals =
     pure . injValue $ Value.Tuple vals
 
@@ -129,33 +132,37 @@ instance ( MonadAddressable location (Value location term) m
     | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
 
   liftNumeric f arg
-    | Just (Integer i)     <- prjValue arg = pure . injValue . Integer     $ f i
-    | Just (Value.Float i) <- prjValue arg = pure . injValue . Value.Float $ f i
+    | Just (Integer (Whole i))     <- prjValue arg = integer $ f i
+    | Just (Value.Float (Decim d)) <- prjValue arg = float   $ f d
     | otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
 
-  liftNumeric2 f g left right
-    | Just (Integer i, Integer j)         <- prjPair pair = pure . injValue . Integer $ g i j
-    | Just (Integer i, Value.Float j)     <- prjPair pair = pure . injValue . float   $ f (fromIntegral i) (munge j)
-    | Just (Value.Float i, Value.Float j) <- prjPair pair = pure . injValue . float   $ f (munge i) (munge j)
-    | Just (Value.Float i, Integer j)     <- prjPair pair = pure . injValue . float   $ f (munge i) (fromIntegral j)
+  liftNumeric2 f left right
+    | Just (Integer i, Integer j)               <- prjPair pair = f i j & specialize
+    | Just (Integer i, Value.Rational j)        <- prjPair pair = f i j & specialize
+    | Just (Integer i, Value.Float j)           <- prjPair pair = f i j & specialize
+    | Just (Value.Rational i, Integer j)        <- prjPair pair = f i j & specialize
+    | Just (Value.Rational i, Value.Rational j) <- prjPair pair = f i j & specialize
+    | Just (Value.Rational i, Value.Float j)    <- prjPair pair = f i j & specialize
+    | Just (Value.Float i, Integer j)           <- prjPair pair = f i j & specialize
+    | Just (Value.Float i, Value.Rational j)    <- prjPair pair = f i j & specialize
+    | Just (Value.Float i, Value.Float j)       <- prjPair pair = f i j & specialize
     | otherwise = fail ("Invalid operands to liftNumeric2: " <> show pair)
       where
-        -- Yucky hack to work around the lack of a Floating instance for Scientific.
-        -- This may possibly lose precision, but there's little we can do about that.
-        munge :: Scientific -> Double
-        munge = toRealFloat
-        float :: Double -> Value.Float a
-        float = Value.Float . fromFloatDigits
+        -- Dispatch whatever's contained inside a 'SomeNumber' to its appropriate 'MonadValue' ctor
+        specialize :: MonadValue term value m => SomeNumber -> m value
+        specialize (SomeNumber (Whole i)) = integer i
+        specialize (SomeNumber (Ratio r)) = rational r
+        specialize (SomeNumber (Decim d)) = float d
         pair = (left, right)
 
   liftComparison comparator left right
-    | Just (Integer i, Integer j)           <- prjPair pair = go i j
-    | Just (Integer i, Value.Float j)       <- prjPair pair = go (fromIntegral i) j
-    | Just (Value.Float i, Integer j)       <- prjPair pair = go i (fromIntegral j)
-    | Just (Value.Float i, Value.Float j)   <- prjPair pair = go i j
-    | Just (Value.String i, Value.String j) <- prjPair pair = go i j
-    | Just (Boolean i, Boolean j)           <- prjPair pair = go i j
-    | Just (Value.Unit, Value.Unit)         <- prjPair pair = boolean True
+    | Just (Integer (Whole i), Integer (Whole j))         <- prjPair pair = go i j
+    | Just (Integer (Whole i), Value.Float (Decim j))     <- prjPair pair = go (fromIntegral i) j
+    | Just (Value.Float (Decim i), Integer (Whole j))     <- prjPair pair = go i (fromIntegral j)
+    | Just (Value.Float (Decim i), Value.Float (Decim j)) <- prjPair pair = go i j
+    | Just (Value.String i, Value.String j)               <- prjPair pair = go i j
+    | Just (Boolean i, Boolean j)                         <- prjPair pair = go i j
+    | Just (Value.Unit, Value.Unit)                       <- prjPair pair = boolean True
     | otherwise = fail ("Type error: invalid arguments to liftComparison: " <> show pair)
       where
         -- Explicit type signature is necessary here because we're passing all sorts of things
@@ -203,6 +210,7 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
   boolean _ = pure Bool
   string _  = pure Type.String
   float _   = pure Type.Float
+  rational _ = pure Type.Rational
   multiple  = pure . Type.Product
   -- TODO
   interface = undefined
@@ -213,7 +221,7 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
   liftNumeric _ Int        = pure Int
   liftNumeric _ _          = fail "Invalid type in unary numeric operation"
 
-  liftNumeric2 _ _ left right = case (left, right) of
+  liftNumeric2 _ left right = case (left, right) of
     (Type.Float, Int) -> pure Type.Float
     (Int, Type.Float) -> pure Type.Float
     _                 -> unify left right
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index 423f23ebe..217bb48d1 100644
--- a/src/Data/Abstract/Type.hs
+++ b/src/Data/Abstract/Type.hs
@@ -14,6 +14,7 @@ data Type
   | String         -- ^ Primitive string type.
   | Unit           -- ^ The unit type.
   | Float          -- ^ Floating-point type.
+  | Rational       -- ^ Rational 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 621c9820b..9b65b2736 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-}
 module Data.Abstract.Value where
 
 import Data.Abstract.Address
@@ -8,9 +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 Data.Scientific (Scientific, toRealFloat, fromFloatDigits)
 import Prologue
-import Prelude hiding (Float, Integer, String, fail)
+import Prelude hiding (Float, Integer, String, Rational, fail)
 import qualified Prelude
 
 type ValueConstructors location term
@@ -21,6 +21,7 @@ type ValueConstructors location term
     , Float
     , Integer
     , String
+    , Rational
     , Tuple
     ]
 
@@ -43,8 +44,75 @@ prjPair :: ( f :< ValueConstructors loc term1 , g :< ValueConstructors loc term2
         -> Maybe (f (Value loc term1), g (Value loc term2))
 prjPair = bitraverse prjValue prjValue
 
+-- | A generalized number type that unifies all interpretable numeric types.
+--   This is a GADT, so you can specialize the 'a' parameter and be confident
+--   that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
+--   in disguise.
+data Number a where
+  Whole :: Prelude.Integer  -> Number Prelude.Integer
+  Ratio :: Prelude.Rational -> Number Prelude.Rational
+  Decim :: Scientific       -> Number Scientific
 
--- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
+deriving instance Eq a => Eq (Number a)
+
+instance Show (Number a) where
+  show (Whole i) = show i
+  show (Ratio r) = show r
+  show (Decim d) = show d
+
+-- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance.
+collapse :: Number a -> Scientific
+collapse (Whole i) = fromInteger i
+collapse (Ratio r) = fromRational r
+collapse (Decim s) = s
+
+instance Eq a => Ord (Number a) where compare = compare `on` collapse
+
+-- | A box that hides the @a@ parameter to a given 'Number'. Pattern-match
+--   on it to extract the information contained.
+data SomeNumber = forall a . SomeNumber (Number a)
+
+-- | Smart constructors for 'SomeNumber'.
+whole :: Prelude.Integer -> SomeNumber
+whole = SomeNumber . Whole
+
+ratio :: Prelude.Rational -> SomeNumber
+ratio = SomeNumber . Ratio
+
+decim :: Scientific -> SomeNumber
+decim = SomeNumber . Decim
+
+-- | Promote a function on 'Real' values into one operating on 'Number's.
+--   You pass things like @+@ and @-@ here.
+liftSimple :: (forall n . Real n => n -> n -> n)
+           -> (Number a -> Number b -> SomeNumber)
+liftSimple f = liftThorny f f
+
+-- | Promote two functions, one on 'Integral' and one on 'Fractional' and 'Real' values,
+--   to operate on 'Numbers'. Examples of this: 'mod' and 'mod'', 'div' and '/'.
+liftThorny :: (forall n . Integral n             => n -> n -> n)
+           -> (forall f . (Fractional f, Real f) => f -> f -> f)
+           -> (Number a -> Number b -> SomeNumber)
+liftThorny f _ (Whole i) (Whole j) = whole (f i j)
+liftThorny _ g (Whole i) (Ratio j) = ratio (g (toRational i) j)
+liftThorny _ g (Whole i) (Decim j) = decim (g (fromIntegral i) j)
+liftThorny _ g (Ratio i) (Ratio j) = ratio (g i j)
+liftThorny _ g (Ratio i) (Whole j) = ratio (g i (fromIntegral j))
+liftThorny _ g (Ratio i) (Decim j) = decim (g (fromRational i) j)
+liftThorny _ g (Decim i) (Whole j) = decim (g i (fromIntegral j))
+liftThorny _ g (Decim i) (Ratio j) = decim (g i (fromRational j))
+liftThorny _ g (Decim i) (Decim j) = decim (g i j)
+
+-- | Exponential behavior is too hard to generalize, so here's a manually implemented version.
+--   TODO: Given a 'Ratio' raised to some 'Whole', we could check to see if it's an integer
+--   and round it before the exponentiation, giving back a 'Whole'.
+safeExp :: Number a -> Number b -> SomeNumber
+safeExp (Whole i) (Whole j) = whole (i ^ j)
+safeExp (Ratio i) (Whole j) = ratio (i ^^ j)
+safeExp i j                 = decim (fromFloatDigits ((munge i) ** (munge j)))
+  where munge = (toRealFloat . collapse) :: Number a -> Double
+
+-- TODO: Parameerize Value by the set of constructors s.t. each language can have a distinct value union.
 
 -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
 data Closure location term value = Closure [Name] term (Environment location value)
@@ -79,13 +147,21 @@ instance Ord1 Boolean where liftCompare = genericLiftCompare
 instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 
 -- | Arbitrary-width integral values.
-newtype Integer value = Integer Prelude.Integer
+newtype Integer value = Integer (Number Prelude.Integer)
   deriving (Eq, Generic1, Ord, Show)
 
 instance Eq1 Integer where liftEq = genericLiftEq
 instance Ord1 Integer where liftCompare = genericLiftCompare
 instance Show1 Integer where liftShowsPrec = genericLiftShowsPrec
 
+-- | Arbitrary-width rational values values.
+newtype Rational value = Rational (Number Prelude.Rational)
+  deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Rational where liftEq = genericLiftEq
+instance Ord1 Rational where liftCompare = genericLiftCompare
+instance Show1 Rational where liftShowsPrec = genericLiftShowsPrec
+
 -- | String values.
 newtype String value = String ByteString
   deriving (Eq, Generic1, Ord, Show)
@@ -95,7 +171,7 @@ instance Ord1 String where liftCompare = genericLiftCompare
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
 -- | Float values.
-newtype Float value = Float Scientific
+newtype Float value = Float (Number Scientific)
   deriving (Eq, Generic1, Ord, Show)
 
 instance Eq1 Float where liftEq = genericLiftEq
diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs
index 6779bed53..bc32e83f4 100644
--- a/src/Data/Syntax/Expression.hs
+++ b/src/Data/Syntax/Expression.hs
@@ -6,6 +6,7 @@ import Data.Fixed
 import Diffing.Algorithm
 import Prelude hiding (fail)
 import Prologue hiding (apply)
+import Data.Abstract.Value (liftThorny, liftSimple, safeExp)
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
@@ -61,12 +62,12 @@ instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for Arithmetic
 instance Evaluatable Arithmetic where
   eval = traverse subtermValue >=> go where
-    go (Plus a b)      = liftNumeric2 (+) (+) a b
-    go (Minus a b)     = liftNumeric2 (-) (-) a b
-    go (Times a b)     = liftNumeric2 (*) (*) a b
-    go (DividedBy a b) = liftNumeric2 (/) div a b
-    go (Modulo a b)    = liftNumeric2 mod' mod a b
-    go (Power a b)     = liftNumeric2 (**) (^) a b
+    go (Plus a b)      = liftNumeric2 add a b  where add    = liftSimple (+)
+    go (Minus a b)     = liftNumeric2 sub a b  where sub    = liftSimple (-)
+    go (Times a b)     = liftNumeric2 mul a b  where mul    = liftSimple (*)
+    go (DividedBy a b) = liftNumeric2 div' a b where div'   = liftThorny div (/)
+    go (Modulo a b)    = liftNumeric2 mod'' a b where mod'' = liftThorny mod mod'
+    go (Power a b)     = liftNumeric2 safeExp a b
     go (Negate a)      = liftNumeric negate a
 
 -- | Boolean operators.
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 310d13396..1fb5a7bca 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -106,7 +106,11 @@ instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompar
 instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for Rational
-instance Evaluatable Data.Syntax.Literal.Rational
+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)
 
 
 -- Complex literals e.g. `3 + 2i`

From ca96b02869b33da9a5b707756360585f226be445 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 13 Mar 2018 19:03:00 -0400
Subject: [PATCH 3/6] strictness annotations. will this do anything? only time
 will tell

---
 src/Data/Abstract/Value.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 48c521c6e..7af5c9ec2 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -49,9 +49,9 @@ prjPair = bitraverse prjValue prjValue
 --   that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
 --   in disguise.
 data Number a where
-  Whole :: Prelude.Integer  -> Number Prelude.Integer
-  Ratio :: Prelude.Rational -> Number Prelude.Rational
-  Decim :: Scientific       -> Number Scientific
+  Whole :: !Prelude.Integer  -> Number Prelude.Integer
+  Ratio :: !Prelude.Rational -> Number Prelude.Rational
+  Decim :: !Scientific       -> Number Scientific
 
 deriving instance Eq a => Eq (Number a)
 

From 0d248e2aab6e2dcf857ba3432e4e067d547eccf3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 13 Mar 2018 20:55:46 -0400
Subject: [PATCH 4/6] Make sure we match Rationals in liftNumeric.

---
 src/Control/Abstract/Value.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 1792d1aa1..f12e59b06 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -140,8 +140,9 @@ instance ( MonadAddressable location (Value location term) m
     | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
 
   liftNumeric f arg
-    | Just (Integer (Whole i))     <- prjValue arg = integer $ f i
-    | Just (Value.Float (Decim d)) <- prjValue arg = float   $ f d
+    | Just (Integer (Whole i))        <- prjValue arg = integer $ f i
+    | Just (Value.Float (Decim d))    <- prjValue arg = float   $ f d
+    | Just (Value.Rational (Ratio r)) <- prjValue arg = rational $ f r
     | otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
 
   liftNumeric2 f left right

From 81aab6572e998805674d8ece5e17c86271736641 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 14 Mar 2018 10:36:56 -0400
Subject: [PATCH 5/6] Address Rob's changes.

---
 semantic.cabal                |  1 +
 src/Control/Abstract/Value.hs | 51 +++++++++---------
 src/Data/Abstract/Number.hs   | 98 +++++++++++++++++++++++++++++++++++
 src/Data/Abstract/Value.hs    | 75 ++-------------------------
 src/Data/Syntax/Expression.hs | 14 ++---
 src/Data/Syntax/Literal.hs    |  1 -
 6 files changed, 136 insertions(+), 104 deletions(-)
 create mode 100644 src/Data/Abstract/Number.hs

diff --git a/semantic.cabal b/semantic.cabal
index 4d91706a5..1617b1351 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -49,6 +49,7 @@ library
                      , Data.Abstract.FreeVariables
                      , Data.Abstract.Live
                      , Data.Abstract.ModuleTable
+                     , Data.Abstract.Number
                      , Data.Abstract.Store
                      , Data.Abstract.Type
                      , Data.Abstract.Value
diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index f12e59b06..30f7dc8bf 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -5,6 +5,7 @@ import Control.Abstract.Addressable
 import Control.Abstract.Analysis
 import Data.Abstract.Environment
 import Data.Abstract.FreeVariables
+import Data.Abstract.Number as Number
 import Data.Abstract.Type as Type
 import Data.Abstract.Value as Value
 import qualified Data.Map as Map
@@ -117,14 +118,14 @@ instance ( MonadAddressable location (Value location term) m
          )
          => MonadValue term (Value location term) m where
 
-  unit    = pure . injValue $ Value.Unit
-  integer = pure . injValue . Integer . Whole
-  boolean = pure . injValue . Boolean
-  string  = pure . injValue . Value.String
-  float   = pure . injValue . Value.Float . Decim
+  unit     = pure . injValue $ Value.Unit
+  integer  = pure . injValue . Value.Integer . Number.Integer
+  boolean  = pure . injValue . Boolean
+  string   = pure . injValue . Value.String
+  float    = pure . injValue . Value.Float . Decimal
   rational = pure . injValue . Value.Rational . Ratio
-  multiple vals =
-    pure . injValue $ Value.Tuple vals
+
+  multiple = pure . injValue . Value.Tuple
 
   interface v = do
     -- TODO: If the set of exports is empty because no exports have been
@@ -140,38 +141,38 @@ instance ( MonadAddressable location (Value location term) m
     | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
 
   liftNumeric f arg
-    | Just (Integer (Whole i))        <- prjValue arg = integer $ f i
-    | Just (Value.Float (Decim d))    <- prjValue arg = float   $ f d
-    | Just (Value.Rational (Ratio r)) <- prjValue arg = rational $ f r
+    | Just (Value.Integer (Number.Integer i)) <- prjValue arg = integer $ f i
+    | Just (Value.Float (Decimal d))          <- prjValue arg = float   $ f d
+    | Just (Value.Rational (Ratio r))         <- prjValue arg = rational $ f r
     | otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
 
   liftNumeric2 f left right
-    | Just (Integer i, Integer j)               <- prjPair pair = f i j & specialize
-    | Just (Integer i, Value.Rational j)        <- prjPair pair = f i j & specialize
-    | Just (Integer i, Value.Float j)           <- prjPair pair = f i j & specialize
-    | Just (Value.Rational i, Integer j)        <- prjPair pair = f i j & specialize
+    | Just (Value.Integer i, Value.Integer j)   <- prjPair pair = f i j & specialize
+    | Just (Value.Integer i, Value.Rational j)  <- prjPair pair = f i j & specialize
+    | Just (Value.Integer i, Value.Float j)     <- prjPair pair = f i j & specialize
+    | Just (Value.Rational i, Value.Integer j)  <- prjPair pair = f i j & specialize
     | Just (Value.Rational i, Value.Rational j) <- prjPair pair = f i j & specialize
     | Just (Value.Rational i, Value.Float j)    <- prjPair pair = f i j & specialize
-    | Just (Value.Float i, Integer j)           <- prjPair pair = f i j & specialize
+    | Just (Value.Float i, Value.Integer j)     <- prjPair pair = f i j & specialize
     | Just (Value.Float i, Value.Rational j)    <- prjPair pair = f i j & specialize
     | Just (Value.Float i, Value.Float j)       <- prjPair pair = f i j & specialize
     | otherwise = fail ("Invalid operands to liftNumeric2: " <> show pair)
       where
         -- Dispatch whatever's contained inside a 'SomeNumber' to its appropriate 'MonadValue' ctor
         specialize :: MonadValue term value m => SomeNumber -> m value
-        specialize (SomeNumber (Whole i)) = integer i
-        specialize (SomeNumber (Ratio r)) = rational r
-        specialize (SomeNumber (Decim d)) = float d
+        specialize (SomeNumber (Number.Integer i)) = integer i
+        specialize (SomeNumber (Ratio r))          = rational r
+        specialize (SomeNumber (Decimal d))        = float d
         pair = (left, right)
 
   liftComparison comparator left right
-    | Just (Integer (Whole i), Integer (Whole j))         <- prjPair pair = go i j
-    | Just (Integer (Whole i), Value.Float (Decim j))     <- prjPair pair = go (fromIntegral i) j
-    | Just (Value.Float (Decim i), Integer (Whole j))     <- prjPair pair = go i (fromIntegral j)
-    | Just (Value.Float (Decim i), Value.Float (Decim j)) <- prjPair pair = go i j
-    | Just (Value.String i, Value.String j)               <- prjPair pair = go i j
-    | Just (Boolean i, Boolean j)                         <- prjPair pair = go i j
-    | Just (Value.Unit, Value.Unit)                       <- prjPair pair = boolean True
+    | Just (Value.Integer (Number.Integer i), Value.Integer (Number.Integer j)) <- prjPair pair = go i j
+    | Just (Value.Integer (Number.Integer i), Value.Float (Decimal j))          <- prjPair pair = go (fromIntegral i) j
+    | Just (Value.Float (Decimal i), Value.Integer (Number.Integer j))          <- prjPair pair = go i (fromIntegral j)
+    | Just (Value.Float (Decimal i), Value.Float (Decimal j))                   <- prjPair pair = go i j
+    | Just (Value.String i, Value.String j)                                     <- prjPair pair = go i j
+    | Just (Boolean i, Boolean j)                                               <- prjPair pair = go i j
+    | Just (Value.Unit, Value.Unit)                                             <- prjPair pair = boolean True
     | otherwise = fail ("Type error: invalid arguments to liftComparison: " <> show pair)
       where
         -- Explicit type signature is necessary here because we're passing all sorts of things
diff --git a/src/Data/Abstract/Number.hs b/src/Data/Abstract/Number.hs
new file mode 100644
index 000000000..9470aa99f
--- /dev/null
+++ b/src/Data/Abstract/Number.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE GADTs, StandaloneDeriving, Rank2Types #-}
+
+module Data.Abstract.Number
+    ( Number (..)
+    , SomeNumber (..)
+    , liftReal
+    , liftIntegralFrac
+    , liftedExponent
+    ) where
+
+import Data.Scientific
+import qualified Prelude
+import Prelude hiding (Integer)
+import Prologue
+
+-- | A generalized number type that unifies all interpretable numeric types.
+--   This is a GADT, so you can specialize the 'a' parameter and be confident
+--   that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
+--   in disguise. This unified type is used to provide mathematical operations
+--   that can change their representation based on an operation's operands—e.g.
+--   raising a rational number to a ratio may not produce another rational number.
+--   This also neatly encapsulates the "coalescing" behavior of adding numbers
+--   of different type in dynamic languages: operating on a whole and a rational
+--   produces a rational, operating on a rational and a decimal produces a decimal,
+--   and so on and so forth. When we add complex numbers, they will in turn subsume
+--   the other numeric types.
+data Number a where
+  Integer :: !Prelude.Integer  -> Number Prelude.Integer
+  Ratio   :: !Prelude.Rational -> Number Prelude.Rational
+  Decimal :: !Scientific       -> Number Scientific
+
+deriving instance Eq a => Eq (Number a)
+
+instance Show (Number a) where
+  show (Integer i) = show i
+  show (Ratio r) = show r
+  show (Decimal d) = show d
+
+-- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance.
+toScientific :: Number a -> Scientific
+toScientific (Integer i) = fromInteger i
+toScientific (Ratio r) = fromRational r
+toScientific (Decimal s) = s
+
+instance Eq a => Ord (Number a) where compare = compare `on` toScientific
+
+-- | A box that hides the @a@ parameter to a given 'Number'. Pattern-match
+--   on it to extract the information contained; because there are only three
+--   possible constructors, pattern-matching all three cases is possible.
+data SomeNumber = forall a . SomeNumber (Number a)
+
+-- | Smart constructors for 'SomeNumber'.
+whole :: Prelude.Integer -> SomeNumber
+whole = SomeNumber . Integer
+
+ratio :: Prelude.Rational -> SomeNumber
+ratio = SomeNumber . Ratio
+
+decim :: Scientific -> SomeNumber
+decim = SomeNumber . Decimal
+
+-- | In order to provide truly generic math operations, where functions like
+--   exponentiation handle the fact that they are not closed over the rational
+--   numbers, we must promote standard Haskell math functions from operations
+--   on 'Real', 'Integral', and 'Fractional' numbers into functions that operate
+--   on two 'Number' values and return a temporarily-indeterminate 'SomeNumber'
+--   value. At the callsite, we can then unwrap the 'SomeNumber' and handle the
+--   specific cases.
+--   
+--   Promote a function on 'Real' values into one operating on 'Number's.
+--   You pass things like @+@ and @-@ here.
+liftReal :: (forall n . Real n => n -> n -> n)
+         -> (Number a -> Number b -> SomeNumber)
+liftReal f = liftIntegralFrac f f
+
+-- | Promote two functions, one on 'Integral' and one on 'Fractional' and 'Real' values,
+--   to operate on 'Numbers'. Examples of this: 'mod' and 'mod'', 'div' and '/'.
+liftIntegralFrac :: (forall n . Integral n             => n -> n -> n)
+                 -> (forall f . (Fractional f, Real f) => f -> f -> f)
+                 -> (Number a -> Number b -> SomeNumber)
+liftIntegralFrac f _ (Integer i) (Integer j) = whole (f i j)
+liftIntegralFrac _ g (Integer i) (Ratio j)   = ratio (g (toRational i) j)
+liftIntegralFrac _ g (Integer i) (Decimal j) = decim (g (fromIntegral i) j)
+liftIntegralFrac _ g (Ratio i) (Ratio j)     = ratio (g i j)
+liftIntegralFrac _ g (Ratio i) (Integer j)   = ratio (g i (fromIntegral j))
+liftIntegralFrac _ g (Ratio i) (Decimal j)   = decim (g (fromRational i) j)
+liftIntegralFrac _ g (Decimal i) (Integer j) = decim (g i (fromIntegral j))
+liftIntegralFrac _ g (Decimal i) (Ratio j)   = decim (g i (fromRational j))
+liftIntegralFrac _ g (Decimal i) (Decimal j) = decim (g i j)
+
+-- | Exponential behavior is too hard to generalize, so here's a manually implemented version.
+--   TODO: Given a 'Ratio' raised to some 'Integer', we could check to see if it's an integer
+--   and round it before the exponentiation, giving back a 'Integer'.
+liftedExponent :: Number a -> Number b -> SomeNumber
+liftedExponent (Integer i) (Integer j) = whole (i ^ j)
+liftedExponent (Ratio i) (Integer j)   = ratio (i ^^ j)
+liftedExponent i j                     = decim (fromFloatDigits ((munge i) ** (munge j)))
+  where munge = (toRealFloat . toScientific) :: Number a -> Double
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 7af5c9ec2..90868824e 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
 module Data.Abstract.Value where
 
 import Data.Abstract.Address
@@ -6,9 +6,10 @@ import Data.Abstract.Environment
 import Data.Abstract.Store
 import Data.Abstract.FreeVariables
 import Data.Abstract.Live
+import Data.Abstract.Number
 import qualified Data.Abstract.Type as Type
 import qualified Data.Set as Set
-import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)
+import Data.Scientific (Scientific)
 import Prologue
 import Prelude hiding (Float, Integer, String, Rational, fail)
 import qualified Prelude
@@ -44,75 +45,7 @@ prjPair :: ( f :< ValueConstructors loc term1 , g :< ValueConstructors loc term2
         -> Maybe (f (Value loc term1), g (Value loc term2))
 prjPair = bitraverse prjValue prjValue
 
--- | A generalized number type that unifies all interpretable numeric types.
---   This is a GADT, so you can specialize the 'a' parameter and be confident
---   that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
---   in disguise.
-data Number a where
-  Whole :: !Prelude.Integer  -> Number Prelude.Integer
-  Ratio :: !Prelude.Rational -> Number Prelude.Rational
-  Decim :: !Scientific       -> Number Scientific
-
-deriving instance Eq a => Eq (Number a)
-
-instance Show (Number a) where
-  show (Whole i) = show i
-  show (Ratio r) = show r
-  show (Decim d) = show d
-
--- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance.
-collapse :: Number a -> Scientific
-collapse (Whole i) = fromInteger i
-collapse (Ratio r) = fromRational r
-collapse (Decim s) = s
-
-instance Eq a => Ord (Number a) where compare = compare `on` collapse
-
--- | A box that hides the @a@ parameter to a given 'Number'. Pattern-match
---   on it to extract the information contained.
-data SomeNumber = forall a . SomeNumber (Number a)
-
--- | Smart constructors for 'SomeNumber'.
-whole :: Prelude.Integer -> SomeNumber
-whole = SomeNumber . Whole
-
-ratio :: Prelude.Rational -> SomeNumber
-ratio = SomeNumber . Ratio
-
-decim :: Scientific -> SomeNumber
-decim = SomeNumber . Decim
-
--- | Promote a function on 'Real' values into one operating on 'Number's.
---   You pass things like @+@ and @-@ here.
-liftSimple :: (forall n . Real n => n -> n -> n)
-           -> (Number a -> Number b -> SomeNumber)
-liftSimple f = liftThorny f f
-
--- | Promote two functions, one on 'Integral' and one on 'Fractional' and 'Real' values,
---   to operate on 'Numbers'. Examples of this: 'mod' and 'mod'', 'div' and '/'.
-liftThorny :: (forall n . Integral n             => n -> n -> n)
-           -> (forall f . (Fractional f, Real f) => f -> f -> f)
-           -> (Number a -> Number b -> SomeNumber)
-liftThorny f _ (Whole i) (Whole j) = whole (f i j)
-liftThorny _ g (Whole i) (Ratio j) = ratio (g (toRational i) j)
-liftThorny _ g (Whole i) (Decim j) = decim (g (fromIntegral i) j)
-liftThorny _ g (Ratio i) (Ratio j) = ratio (g i j)
-liftThorny _ g (Ratio i) (Whole j) = ratio (g i (fromIntegral j))
-liftThorny _ g (Ratio i) (Decim j) = decim (g (fromRational i) j)
-liftThorny _ g (Decim i) (Whole j) = decim (g i (fromIntegral j))
-liftThorny _ g (Decim i) (Ratio j) = decim (g i (fromRational j))
-liftThorny _ g (Decim i) (Decim j) = decim (g i j)
-
--- | Exponential behavior is too hard to generalize, so here's a manually implemented version.
---   TODO: Given a 'Ratio' raised to some 'Whole', we could check to see if it's an integer
---   and round it before the exponentiation, giving back a 'Whole'.
-safeExp :: Number a -> Number b -> SomeNumber
-safeExp (Whole i) (Whole j) = whole (i ^ j)
-safeExp (Ratio i) (Whole j) = ratio (i ^^ j)
-safeExp i j                 = decim (fromFloatDigits ((munge i) ** (munge j)))
-  where munge = (toRealFloat . collapse) :: Number a -> Double
-
--- TODO: Parameerize Value by the set of constructors s.t. each language can have a distinct value union.
+-- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
 
 -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
 data Closure location term value = Closure [Name] term (Environment location value)
diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs
index bc32e83f4..9ec8d333a 100644
--- a/src/Data/Syntax/Expression.hs
+++ b/src/Data/Syntax/Expression.hs
@@ -2,11 +2,11 @@
 module Data.Syntax.Expression where
 
 import Data.Abstract.Evaluatable
+import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent)
 import Data.Fixed
 import Diffing.Algorithm
 import Prelude hiding (fail)
 import Prologue hiding (apply)
-import Data.Abstract.Value (liftThorny, liftSimple, safeExp)
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
@@ -62,12 +62,12 @@ instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for Arithmetic
 instance Evaluatable Arithmetic where
   eval = traverse subtermValue >=> go where
-    go (Plus a b)      = liftNumeric2 add a b  where add    = liftSimple (+)
-    go (Minus a b)     = liftNumeric2 sub a b  where sub    = liftSimple (-)
-    go (Times a b)     = liftNumeric2 mul a b  where mul    = liftSimple (*)
-    go (DividedBy a b) = liftNumeric2 div' a b where div'   = liftThorny div (/)
-    go (Modulo a b)    = liftNumeric2 mod'' a b where mod'' = liftThorny mod mod'
-    go (Power a b)     = liftNumeric2 safeExp a b
+    go (Plus a b)      = liftNumeric2 add a b  where add    = liftReal (+)
+    go (Minus a b)     = liftNumeric2 sub a b  where sub    = liftReal (-)
+    go (Times a b)     = liftNumeric2 mul a b  where mul    = liftReal (*)
+    go (DividedBy a b) = liftNumeric2 div' a b where div'   = liftIntegralFrac div (/)
+    go (Modulo a b)    = liftNumeric2 mod'' a b where mod'' = liftIntegralFrac mod mod'
+    go (Power a b)     = liftNumeric2 liftedExponent a b
     go (Negate a)      = liftNumeric negate a
 
 -- | Boolean operators.
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 1fb5a7bca..96328a7d0 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -105,7 +105,6 @@ instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
 instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
 
--- TODO: Implement Eval instance for Rational
 instance Evaluatable Data.Syntax.Literal.Rational where
   eval (Rational r) = let trimmed = B.takeWhile (/= 'r') r in
     case readMaybe @Prelude.Integer (unpack trimmed) of

From 99d4815d3add26b2fb44560e0b842dae9024b5c1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 14 Mar 2018 10:42:50 -0400
Subject: [PATCH 6/6] Don't do anything clever with stripping colons from
 symbols.

---
 src/Data/Syntax/Literal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 0fa42cbab..8e6b0cc34 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -177,7 +177,7 @@ instance Ord1 Symbol where liftCompare = genericLiftCompare
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Symbol where
-  eval (Symbol s) = symbol (B.dropWhile (== ':') s)
+  eval (Symbol s) = symbol s
 
 newtype Regex a = Regex { regexContent :: ByteString }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)