get [x..] construct (and friends) working

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
 

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?