From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Fri, 12 Apr 2013 15:39:53 +0000 (+0100)
Subject: Add negate implementation for Literal and Expr.
X-Git-Url: https://git.unchartedbackwaters.co.uk/w/?a=commitdiff_plain;h=76c67988d1797f1946495d4cbc2285205bf92caf;p=francis%2Flta.git

Add negate implementation for Literal and Expr.
---

diff --git a/LTA/Symbolic.hs b/LTA/Symbolic.hs
index e14b09c..a46846a 100644
--- a/LTA/Symbolic.hs
+++ b/LTA/Symbolic.hs
@@ -163,9 +163,11 @@ instance Num Literal where
   (*) (FloatLiteral a) (RationalLiteral b) = FloatLiteral $ a * (fromRational b)
   abs (RationalLiteral a) = RationalLiteral $ abs a
   abs (FloatLiteral a) = FloatLiteral $ abs a
+  fromInteger = RationalLiteral . fromInteger
+  negate (FloatLiteral a) = FloatLiteral $ - a
+  negate (RationalLiteral a) = RationalLiteral $ - a
   signum (RationalLiteral a) = RationalLiteral $ signum a
   signum (FloatLiteral a) = FloatLiteral $ signum a
-  fromInteger = RationalLiteral . fromInteger
 
 -- The special cases for multiplication by 1 are needed as a base case to avoid
 -- infinite recursion when simplifying products.
@@ -178,6 +180,7 @@ instance Num Expr where
   (*) 1 n = n
   (*) n 1 = n
   (*) a b = simplify $ Product $ empty `addPair` (a, 1) `addPair` (b, 1)
-  fromInteger = Literal . fromInteger
   abs = UnaryFunction Abs
+  fromInteger = Literal . fromInteger
+  negate a = simplify $ Sum $ empty `addPair` (a, -1)
   signum = UnaryFunction Signum