From 086bbf3e65a435b171481065fb345a2d23f368b6 Mon Sep 17 00:00:00 2001
From: "Barak A. Pearlmutter" <barak+git@cs.nuim.ie>
Date: Thu, 23 Apr 2009 19:51:54 +0100
Subject: [PATCH] get [x..] construct (and friends) working

---
 Numeric/FAD.hs | 15 ++++++++++++---
 Test.hs        | 13 +++++++------
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/Numeric/FAD.hs b/Numeric/FAD.hs
index e3d35c3..2f9bb8d 100644
--- a/Numeric/FAD.hs
+++ b/Numeric/FAD.hs
@@ -476,11 +476,20 @@ instance (Ord a, Num a) => Ord (Tower tag a) where
   0                                   -- Incorrect!
 -}
 
-instance (Enum a, Num a) => Enum (Tower tag a) where
+instance (Enum a, Num a, Ord a) => Enum (Tower tag a) where
     succ	= liftA1 succ (const 1)
     pred	= liftA1 pred (const 1)
-    fromEnum	= liftA1disc fromEnum
-    toEnum	= lift . toEnum
+    -- this would be a bug, as it would discard the tower:
+    --  fromEnum	= liftA1disc fromEnum
+    fromEnum (Tower [])   = 0
+    fromEnum (Tower [x0]) = fromEnum x0
+    fromEnum _		  = error "fromEnum of Dual number with tower"
+    toEnum		  = lift . toEnum
+    enumFrom		  = iterate succ			-- [n..]
+    enumFromThen n n'	  = iterate (+(n'-n)) n			-- [n,n'..]
+    enumFromTo n m	  = takeWhile (<=m) (enumFrom n)	-- [n..m]
+    enumFromThenTo n n' m					-- [n,n'..m]
+        = takeWhile (if n' >= n then (<= m) else (>= m)) (enumFromThen n n')
 
 -- First-Order Differentiation Operators
 
diff --git a/Test.hs b/Test.hs
index 6c4a0a7..84e6852 100644
--- a/Test.hs
+++ b/Test.hs
@@ -185,7 +185,7 @@ main = do
   onceCheck  $ taylor_accurate   cos 40 0 (2*pi)
   quickCheck $ taylor_accurate_p cos 40 (-2.5*pi) (2.5*pi)
   -- tan
-  onceCheck $ taylor_accurate tan 15 0 (pi/8)
+  onceCheck  $ taylor_accurate tan 15 0 (pi/8)
   -- trig identity
   quickCheck $ taylor_accurate_p (\x -> sin x * cos x - sin (2*x) / 2) 10 (-5) 5
   -- asin
@@ -206,7 +206,7 @@ main = do
   -- atanh
   onceCheck  $ taylor_accurate atanh 15 0.1 0.2
   -- atan2
-  quickCheck prop_atan2_shouldBeOne
+  quickCheck $ prop_atan2_shouldBeOne
   onceCheck  $ prop_atan2_shouldBeOne (pi/2)
   -- (==)
   onceCheck  $ diffs (id_c 7) 3 == [3,1]
@@ -215,7 +215,8 @@ main = do
   onceCheck  $ diffs succ 17 == [18,1]
   -- pred
   onceCheck  $ diffs pred 17 == [16,1]
-  -- The [x..] bug:
-  onceCheck          $ diff (\x->[x]   !! 0) 7 == 1
-  --BUG-- onceCheck  $ diff (\x->[x..] !! 0) 7 == 1     -- actually returns 0
-  --BUG-- onceCheck  $ diff (\x->[0,x..] !! 2) 13 == 26 -- actually returns 0
+  -- The [x..] construct
+  onceCheck  $ diff (\x->[x]   !! 0) 7 == 1
+  onceCheck  $ diff (\x->[x..] !! 0) 7 == 1
+  onceCheck  $ diff (\x->[0,x..] !! 2) 7 == 2
+  -- onceCheck  $ diffsUF (\x->[1,x..4.5]) 2 !! 0 == (\x->[1,x..4.5]) 2 -- BUG?