[lots of library reorganization, use of new primitives, make deriving smarter for enumerated types
John Meacham <john@repetae.net>**20061104061436] hunk ./DerivingDrift/Drift.hs 5
+import Control.Monad.Identity
+import Data.FunctorM
hunk ./DerivingDrift/Drift.hs 16
+import Name.VConsts
hunk ./DerivingDrift/Drift.hs 38
-enumDontDerive :: [HsName]
-enumDontDerive = [nameName class_Eq,nameName class_Ord,nameName class_Enum]
+enumDontDerive :: [(HsName,[HsName])]
+enumDontDerive = [
+    (f class_Eq, [func_equals fns]),
+    (f class_Ord, [func_geq fns, func_leq fns, func_lt fns, func_gt fns]),
+    (f class_Enum, [func_toEnum fns,func_fromEnum fns])
+    ]  where
+        Identity fns = fmapM (return . f) sFuncNames
+        f n = nameName (toUnqualified n)
+
+
hunk ./DerivingDrift/Drift.hs 53
-        xs <- return $  map (derive d . show) derives -- (if isEnum then derives List.\\ enumDontDerive else derives )
+        xs <- return $  map (derive isEnum d) derives -- (if isEnum then derives List.\\ enumDontDerive else derives )
hunk ./DerivingDrift/Drift.hs 57
-        xs <- return $ map (derive d . show) derives
+        xs <- return $ map (derive False d) derives
hunk ./DerivingDrift/Drift.hs 73
-derive d wh | Just fn <- Map.lookup wh rulesMap = render $ fn d
-            | otherwise                         =
-  error ("derive: Tried to use non-existing rule "++wh++" for "++name d)
+derive True d wh | Just fns <- lookup wh enumDontDerive = inst fns where
+    dummy = "{- This is a dummy instance, it will be rewritten internally -}\n"
+    inst fns = dummy ++ "instance " ++ show wh ++ " " ++ name d ++ " where\n" ++ concat (intersperse "\n" (map f fns))
+    f n = "    " ++ g (show n) ++ " = " ++ g (show n)
+    g (c:cs) | c == '_' || c == '\'' || isAlpha c = c:cs
+    g x = "(" ++ x ++ ")"
+
+derive _ d wh | Just fn <- Map.lookup (show wh) rulesMap = render $ fn d
+              | otherwise  = error ("derive: Tried to use non-existing rule "++show wh++" for "++name d)
hunk ./Name/Names.hs 66
-dc_Unit = toName DataConstructor ("Prelude","()")
-dc_Boolzh = toName DataConstructor ("Prelude","Bool#")
+dc_Unit = toName DataConstructor ("Jhc.Basics","()")
+dc_Boolzh = toName DataConstructor ("Jhc.Order","Bool#")
hunk ./Name/Names.hs 80
-tc_Bool = toName TypeConstructor ("Prelude","Bool")
+tc_Bool = toName TypeConstructor ("Jhc.Order","Bool")
hunk ./Name/Names.hs 84
-tc_Unit = toName TypeConstructor  ("Prelude","()")
+tc_Unit = toName TypeConstructor  ("Jhc.Basics","()")
hunk ./Name/Names.hs 94
-v_toEnum = toName Val ("Prelude","toEnum")
-v_fromEnum = toName Val ("Prelude","fromEnum")
-v_minBound = toName Val ("Prelude","minBound")
-v_maxBound = toName Val ("Prelude","maxBound")
+v_toEnum = toName Val ("Jhc.Enum","toEnum")
+v_fromEnum = toName Val ("Jhc.Enum","fromEnum")
+v_minBound = toName Val ("Jhc.Enum","minBound")
+v_maxBound = toName Val ("Jhc.Enum","maxBound")
hunk ./Name/Names.hs 101
-v_and = toName Val ("Prelude","&&")
+v_and = toName Val ("Jhc.Order","&&")
hunk ./Name/Names.hs 104
-v_undefined = toName Val ("Prelude","undefined")
+v_undefined = toName Val ("Jhc.Basics","undefined")
hunk ./Name/Names.hs 112
-    func_equals = toName Val ("Prelude","=="),
hunk ./Name/Names.hs 116
-    func_leq = toName Val ("Prelude","<="),
-    func_geq = toName Val ("Prelude",">="),
-    func_lt = toName Val ("Prelude","<"),
-    func_gt = toName Val ("Prelude",">"),
-    func_compare = toName Val ("Prelude","compare"),
-    func_neq = toName Val ("Prelude","/="),
-    func_fromEnum = toName Val ("Prelude","fromEnum"),
-    func_toEnum = toName Val ("Prelude","toEnum"),
-    func_minBound = toName Val ("Prelude","minBound"),
-    func_maxBound = toName Val ("Prelude","maxBound"),
-    func_enumFrom = toName Val ("Prelude","enumFrom"),
-    func_enumFromThen = toName Val ("Prelude","enumFromThen"),
+    func_leq = toName Val ("Jhc.Order","<="),
+    func_geq = toName Val ("Jhc.Order",">="),
+    func_lt = toName Val ("Jhc.Order","<"),
+    func_gt = toName Val ("Jhc.Order",">"),
+    func_compare = toName Val ("Jhc.Order","compare"),
+    func_equals = toName Val ("Jhc.Order","=="),
+    func_neq = toName Val ("Jhc.Order","/="),
+    func_fromEnum = toName Val ("Jhc.Enum","fromEnum"),
+    func_toEnum = toName Val ("Jhc.Enum","toEnum"),
+    func_minBound = toName Val ("Jhc.Enum","minBound"),
+    func_maxBound = toName Val ("Jhc.Enum","maxBound"),
+    func_enumFrom = toName Val ("Jhc.Enum","enumFrom"),
+    func_enumFromThen = toName Val ("Jhc.Enum","enumFromThen"),
hunk ./Name/Names.hs 140
-class_Eq = toName ClassName ("Prelude","Eq")
-class_Ord = toName ClassName ("Prelude","Ord")
-class_Enum = toName ClassName ("Prelude","Enum")
-class_Bounded = toName ClassName ("Prelude","Bounded")
+class_Eq = toName ClassName ("Jhc.Order","Eq")
+class_Ord = toName ClassName ("Jhc.Order","Ord")
+class_Enum = toName ClassName ("Jhc.Enum","Enum")
+class_Bounded = toName ClassName ("Jhc.Enum","Bounded")
hunk ./data/operators.txt 5
-aaB, ==, Prelude.Eq, ==
-# aaB, /=, Prelude.Eq, !=
-aaB, >=, Prelude.Ord, >=
-aaB, <=, Prelude.Ord, <=
-aaB, >, Prelude.Ord, >
-aaB, <, Prelude.Ord, <
+aaB, ==, Jhc.Order.Eq, ==
+# aaB, /=, Jhc.Order.Eq, !=
+aaB, >=, Jhc.Order.Ord, >=
+aaB, <=, Jhc.Order.Ord, <=
+aaB, >, Jhc.Order.Ord, >
+aaB, <, Jhc.Order.Ord, <
hunk ./lib/base/Data/Char.hs 16
+import Jhc.Basics
hunk ./lib/base/Data/Char.hs 72
--- Character code functions
---foreign import primitive ord :: Char -> Int
---ord  =  fromEnum
-
---foreign import primitive chr :: Int  -> Char
---chr  =  toEnum
-
-foreign import primitive "integralCast" ord :: Char -> Int
-foreign import primitive "integralCast" chr :: Int -> Char
hunk ./lib/base/Jhc/Basics.hs 4
+import Data.Int(Int())
hunk ./lib/base/Jhc/Basics.hs 16
+data () = ()
hunk ./lib/base/Jhc/Basics.hs 162
+foreign import primitive "integralCast" ord :: Char -> Int
+foreign import primitive "integralCast" chr :: Int -> Char
addfile ./lib/base/Jhc/Enum.hs
hunk ./lib/base/Jhc/Enum.hs 1
+{-# OPTIONS_JHC -N #-}
+module Jhc.Enum(Enum(..),Bounded(..)) where
+-- Enumeration and Bounded classes
+
+import Data.Int
+import Jhc.Basics
+import Jhc.Order
+
+class  Enum a  where
+    succ, pred       :: a -> a
+    toEnum           :: Int -> a
+    fromEnum         :: a -> Int
+    enumFrom         :: a -> [a]             -- [n..]
+    enumFromThen     :: a -> a -> [a]        -- [n,n'..]
+    enumFromTo       :: a -> a -> [a]        -- [n..m]
+    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]
+
+        -- Minimal complete definition:
+        --      toEnum, fromEnum
+--
+-- NOTE: these default methods only make sense for types
+--   that map injectively into Int using fromEnum
+--  and toEnum.
+    succ             =  toEnum . increment . fromEnum
+    pred             =  toEnum . decrement . fromEnum
+    enumFrom x       =  map toEnum [fromEnum x ..]
+    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
+    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y ..]
+    enumFromThenTo x y z =
+                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]
+
+
+class Bounded a  where
+    minBound         :: a
+    maxBound         :: a
+
+instance Enum Int where
+    succ = increment
+    pred = decrement
+    toEnum x = x
+    fromEnum x = x
+
+    enumFrom x       =  x:enumFrom (increment x)
+    enumFromTo x y = f x where
+        f x | x > y = []
+            | otherwise = x:f (increment x)
+    enumFromThen x y = f x where
+        z = y `minus` x
+        f x = x:f (x `plus` z)
+    enumFromThenTo x y z | y >= x = f x where
+        inc = y `minus` x
+        f x | x <= z = x:f (x `plus` inc)
+            | otherwise = []
+    enumFromThenTo x y z  = f x where
+        inc = y `minus` x
+        f x | x >= z = x:f (x `plus` inc)
+            | otherwise = []
+
+foreign import primitive increment :: Int -> Int
+foreign import primitive decrement :: Int -> Int
+foreign import primitive plus :: Int -> Int -> Int
+foreign import primitive minus :: Int -> Int -> Int
addfile ./lib/base/Jhc/Order.hs
hunk ./lib/base/Jhc/Order.hs 1
+{-# OPTIONS_JHC -N #-}
+
+module Jhc.Order where
+
+import Jhc.Enum
+import Jhc.Basics
+
+data Bool = False | True
+    deriving (Eq, Ord, Bounded, Enum)
+
+data  Ordering    =  LT | EQ | GT
+    deriving (Eq, Ord, Bounded, Enum)
+
+infix  4  ==, /=, <, <=, >=, >
+
+class Eq a where
+    (==) :: a -> a -> Bool
+    (/=) :: a -> a -> Bool
+    x == y = case x /= y of
+        True -> False
+        False -> True
+    x /= y = case x == y of
+        True -> False
+        False -> True
+
+class  (Eq a) => Ord a  where
+    compare              :: a -> a -> Ordering
+    (<), (<=), (>=), (>) :: a -> a -> Bool
+    max, min             :: a -> a -> a
+
+    compare x y | x == y    = EQ
+                | x <= y    = LT
+                | otherwise = GT
+
+    x <= y  = compare x y /= GT
+    x <  y  = compare x y == LT
+    x >= y  = compare x y /= LT
+    x >  y  = compare x y == GT
+
+    -- Note that (min x y, max x y) = (x,y) or (y,x)
+    max x y | x <= y    =  y
+            | otherwise =  x
+    min x y | x <= y    =  x
+            | otherwise =  y
+
+instance Enum Char where
+    toEnum = chr
+    fromEnum = ord
+    enumFrom c        = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
+    enumFromThen c c' = map toEnum [fromEnum c, fromEnum c' .. fromEnum lastChar]
+                      where lastChar :: Char
+                            lastChar | c' < c    = minBound
+                                     | otherwise = maxBound
+
+instance Eq () where
+    () == () = True
+    () /= () = False
+
+instance Ord () where
+    () <= () = True
+    () <  () = False
+    () >= () = True
+    () >  () = False
+    max () () = ()
+    min () () = ()
+    compare () () = EQ
+
+instance Bounded () where
+    minBound = ()
+    maxBound = ()
+
+instance Eq a => Eq [a] where
+    [] == [] = True
+    (x:xs) == (y:ys) | x == y = xs == ys
+    _ == _ = False
+
+instance Ord a => Ord [a] where
+    compare (x:xs) (y:ys) = case compare x y of
+        EQ -> compare xs ys
+        z -> z
+    compare [] [] = EQ
+    compare [] _ = LT
+    compare _ [] = GT
+
+infixr 3  &&
+infixr 2  ||
+
+{-# INLINE (&&), (||), not, otherwise #-}
+(&&), (||)       :: Bool -> Bool -> Bool
+True  && x       =  x
+False && _       =  False
+True  || _       =  True
+False || x       =  x
+
+
+not              :: Bool -> Bool
+not x = if x then False else True
+
+
+otherwise        :: Bool
+otherwise        =  True
+
hunk ./lib/base/Prelude.hs 25
+    module Jhc.Enum,
+    module Jhc.Order,
hunk ./lib/base/Prelude.hs 47
+import Jhc.Enum
+import Jhc.Order
hunk ./lib/base/Prelude.hs 56
-infix  4  ==, /=, <, <=, >=, >
-infixr 3  &&
-infixr 2  ||
+--infix  4  ==, /=, <, <=, >=, >
+--infixr 3  &&
+--infixr 2  ||
hunk ./lib/base/Prelude.hs 65
-data Bool = False | True
-    deriving (Eq, Ord, Bounded, Enum, Read, Show)
hunk ./lib/base/Prelude.hs 66
-data () = ()
-    deriving (Eq, Ord, Bounded, Enum)  -- Read declared in Prelude.Text
hunk ./lib/base/Prelude.hs 68
-data  Ordering    =  LT | EQ | GT
-    deriving (Eq, Ord, Bounded, Enum, Read, Show)
-
-
-
--- Enumeration and Bounded classes
-
-class  Enum a  where
-    succ, pred       :: a -> a
-    toEnum           :: Int -> a
-    fromEnum         :: a -> Int
-    enumFrom         :: a -> [a]             -- [n..]
-    enumFromThen     :: a -> a -> [a]        -- [n,n'..]
-    enumFromTo       :: a -> a -> [a]        -- [n..m]
-    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]
-
-        -- Minimal complete definition:
-        --      toEnum, fromEnum
---
--- NOTE: these default methods only make sense for types
---   that map injectively into Int using fromEnum
---  and toEnum.
-    succ             =  toEnum . (+1) . fromEnum
-    pred             =  toEnum . (subtract 1) . fromEnum
-    enumFrom x       =  map toEnum [fromEnum x ..]
-    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
-    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y ..]
-    enumFromThenTo x y z =
-                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]
-
-
-class Bounded a  where
-    minBound         :: a
-    maxBound         :: a
hunk ./lib/base/Prelude.hs 215
+instance Enum () where
+    succ _      = error "Prelude.Enum.().succ: bad argument"
+    pred _      = error "Prelude.Enum.().pred: bad argument"
+
+    toEnum x | x == 0 = ()
+             | otherwise    = error "Prelude.Enum.().toEnum: bad argument"
+
+    fromEnum () = 0
+    enumFrom () 	= [()]
+    enumFromThen () () 	= let many = ():many in many
+    enumFromTo () () 	= [()]
+    enumFromThenTo () () () = let many = ():many in many
hunk ./lib/base/Prelude.hs 350
-class Eq a where
-    (==) :: a -> a -> Bool
-    (/=) :: a -> a -> Bool
-    x == y = case x /= y of
-        True -> False
-        False -> True
-    x /= y = case x == y of
-        True -> False
-        False -> True
-
-class  (Eq a) => Ord a  where
-    compare              :: a -> a -> Ordering
-    (<), (<=), (>=), (>) :: a -> a -> Bool
-    max, min             :: a -> a -> a
-
-    compare x y | x == y    = EQ
-                | x <= y    = LT
-                | otherwise = GT
-
-    x <= y  = compare x y /= GT
-    x <  y  = compare x y == LT
-    x >= y  = compare x y /= LT
-    x >  y  = compare x y == GT
-
-    -- Note that (min x y, max x y) = (x,y) or (y,x)
-    max x y | x <= y    =  y
-            | otherwise =  x
-    min x y | x <= y    =  x
-            | otherwise =  y
-
-
hunk ./lib/base/Prelude.hs 358
-{-# INLINE (&&), (||), not, otherwise #-}
-(&&), (||)       :: Bool -> Bool -> Bool
-True  && x       =  x
-False && _       =  False
-True  || _       =  True
-False || x       =  x
-
-
-not              :: Bool -> Bool
-not x = if x then False else True
-
-
-otherwise        :: Bool
-otherwise        =  True
hunk ./lib/base/Prelude.hs 724
-instance Enum Int where
-    succ = (+ 1)
-    pred = (+ -1)
-    toEnum x = x
-    fromEnum x = x
-
-    enumFrom x       =  x:enumFrom (x + 1)
-    enumFromTo x y = f x where
-        f x | x > y = []
-            | otherwise = x:f (x + 1)
-    enumFromThen x y = f x where
-        z = y - x
-        f x = x:f (x + z)
-    enumFromThenTo x y z | y >= x = f x where
-        inc = y - x
-        f x | x <= z = x:f (x + inc)
-            | otherwise = []
-    enumFromThenTo x y z  = f x where
-        inc = y - x
-        f x | x >= z = x:f (x + inc)
-            | otherwise = []
-
-instance Enum Char where
-    toEnum = Char.chr
-    fromEnum = Char.ord
-    enumFrom c        = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
-    enumFromThen c c' = map toEnum [fromEnum c, fromEnum c' .. fromEnum lastChar]
-                      where lastChar :: Char
-                            lastChar | c' < c    = minBound
-                                     | otherwise = maxBound
-
-
hunk ./lib/base/Prelude.hs 753
-instance Ord a => Ord [a] where
-    compare (x:xs) (y:ys) = case compare x y of
-        EQ -> compare xs ys
-        z -> z
-    compare [] [] = EQ
-    compare [] _ = LT
-    compare _ [] = GT
hunk ./lib/base/Prelude.hs 754
-instance Eq a => Eq [a] where
-    [] == [] = True
-    (x:xs) == (y:ys) | x == y = xs == ys
-    _ == _ = False
hunk ./lib/base/Prelude/Text.hs 195
+
+
+instance Read Bool where
+    readsPrec d input =
+              (\ inp -> [((False) , rest) | ("False" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((True) , rest) | ("True" , rest) <- lex inp]) input
+
+instance Show Bool where
+    showsPrec d (False) = showString "False"
+    showsPrec d (True) = showString "True"
+
+instance Read Ordering where
+    readsPrec d input =
+              (\ inp -> [((LT) , rest) | ("LT" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((EQ) , rest) | ("EQ" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((GT) , rest) | ("GT" , rest) <- lex inp]) input
+
+instance Show Ordering where
+    showsPrec d (LT) = showString "LT"
+    showsPrec d (EQ) = showString "EQ"
+    showsPrec d (GT) = showString "GT"
+
+
hunk ./utils/op_process.prl 127
-    my $prelude_bounded = hsname("Prelude.Bounded");
+    my $prelude_bounded = hsname("Jhc.Enum.Bounded");
hunk ./utils/op_process.prl 136
-    push @cmeth, "($prelude_bounded, toInstName \"Prelude.maxBound.$d->[0]\", " . const($cncons, $d->[3],$t,"$d->[1]") . ")";
-    push @cmeth, "($prelude_bounded, toInstName \"Prelude.minBound.$d->[0]\", " . const($cncons,$d->[4],$t,"$d->[1]") . ")";
+    push @cmeth, "($prelude_bounded, toInstName \"Jhc.Enum.maxBound.$d->[0]\", " . const($cncons, $d->[3],$t,"$d->[1]") . ")";
+    push @cmeth, "($prelude_bounded, toInstName \"Jhc.Enum.minBound.$d->[0]\", " . const($cncons,$d->[4],$t,"$d->[1]") . ")";