[add stub typeable library
John Meacham <john@repetae.net>**20090227104245
 Ignore-this: a9d832a8180070f3f4454f94fbf212eb
] hunk ./lib/base/Data/Typeable.hs 1
-{-# OPTIONS_JHC -fffi #-}
-module Data.Typeable(TypeRep,typeOf) where
+{-# OPTIONS_JHC -fffi -funboxed-values  #-}
+module Data.Typeable(TypeRep(),Typeable(..),Typeable1(..),Typeable2(..)) where
hunk ./lib/base/Data/Typeable.hs 5
-import Maybe
hunk ./lib/base/Data/Typeable.hs 6
+import Jhc.String
hunk ./lib/base/Data/Typeable.hs 9
-data TypeRep
+data TypeRep = TypeRep Addr__ [TypeRep]
+
+
+showsAddr__ :: Addr__ -> [Char] -> [Char]
+showsAddr__ a xs = unpackStringFoldr a (:) xs
+
+instance Show TypeRep where
+    showsPrec _ (TypeRep a []) = showsAddr__ a
+    showsPrec n (TypeRep a xs) = showParen (n > 9) $ spacesep (showsAddr__ a:map (showsPrec 10) xs) where
+        spacesep [] = id
+        spacesep [x] = x
+        spacesep (x:xs) = x . showChar ' ' . spacesep xs
+
hunk ./lib/base/Data/Typeable.hs 23
---instance Eq TypeRep where
---    (==) = primTypeRepEq
+instance Eq TypeRep where
+    TypeRep a xs == TypeRep b ys = case c_strcmp a b of
+        0 -> xs == ys
+        _ -> False
+
+
+foreign import ccall "strcmp" c_strcmp :: Addr__ -> Addr__ -> Int
hunk ./lib/base/Data/Typeable.hs 31
-foreign import primitive typeOf :: a -> TypeRep
-foreign import primitive typeOf1 :: t a -> TypeRep
-foreign import primitive typeOf2 :: t a b -> TypeRep
-foreign import primitive typeOf3 :: t a b c -> TypeRep
-foreign import primitive typeOf4 :: t a b c d -> TypeRep
-foreign import primitive typeOf5 :: t a b c d e -> TypeRep
-foreign import primitive typeOf6 :: t a b c d e f -> TypeRep
-foreign import primitive typeOf7 :: t a b c d e f g -> TypeRep
+{-
+foreign import primitive ptypeOf :: a -> TypeRep
+foreign import primitive ptypeOf1 :: t a -> TypeRep
+foreign import primitive ptypeOf2 :: t a b -> TypeRep
+foreign import primitive ptypeOf3 :: t a b c -> TypeRep
+foreign import primitive ptypeOf4 :: t a b c d -> TypeRep
+foreign import primitive ptypeOf5 :: t a b c d e -> TypeRep
+foreign import primitive ptypeOf6 :: t a b c d e f -> TypeRep
+foreign import primitive ptypeOf7 :: t a b c d e f g -> TypeRep
hunk ./lib/base/Data/Typeable.hs 41
+-}
hunk ./lib/base/Data/Typeable.hs 44
+class Typeable a where
+    typeOf :: a -> TypeRep
+
+class Typeable1 f where
+    typeOf1 :: f a -> TypeRep
+
+class Typeable2 f where
+    typeOf2 :: f a b -> TypeRep
+
+instance Typeable1 [] where
+    typeOf1 _ = TypeRep "[]"# []
+
+instance Typeable a => Typeable [a] where
+    typeOf x = typeOfDefault x
+
+{-
+instance (Typeable a,Typeable b) => Typeable (a -> b) where
+    typeOf x = (typeOf2 x `mkAppTy` arg1 x) `mkAppTy` arg2 x where
+        arg1 :: (x -> y) -> x
+        arg2 :: (x -> y) -> y
+        arg1 = undefined
+        arg2 = undefined
+
+instance (Typeable a) => Typeable1 ((->) a) where
+    typeOf1 x = typeOf1Default x
+
+instance Typeable2 (->) where
+    typeOf2 _ = TypeRep "->"# []
+-}
+
+instance Typeable2 (,) where
+    typeOf2 _ = TypeRep "(,)"# []
+
+instance Typeable a => Typeable1 ((,) a) where
+    typeOf1 x = typeOf1Default x
+
+instance (Typeable b,Typeable a) => Typeable (a,b) where
+    typeOf x = typeOfDefault x
+
+instance Typeable Char where
+    typeOf _ = TypeRep "Char"# []
+
+instance Typeable () where
+    typeOf _ = TypeRep "()"# []
+
+instance Typeable Int where
+    typeOf _ = TypeRep "Int"# []
+
+--instance (Typeable1 f,Typeable a) => Typeable (f a) where
+--    typeOf x = typeOf1 x `mkAppTy` typeOf (argType x) where
+--        argType :: a b -> b
+--        argType = undefined
+
+mkAppTy :: TypeRep -> TypeRep -> TypeRep
+mkAppTy (TypeRep x xs) tr = TypeRep x (xs ++ [tr])
+
hunk ./lib/base/Data/Typeable.hs 106
+unsafeCoerce :: a -> b
hunk ./lib/base/Data/Typeable.hs 110
-cast ::  a -> Maybe b
-cast x = r
-       where
-	 r = if typeOf x == typeOf (fromJust r)
+cast :: (Typeable a, Typeable b) => a -> Maybe b
+cast x = r where
+    fromJust (Just x) = x
+    r = if typeOf x == typeOf (fromJust r)
hunk ./lib/base/Data/Typeable.hs 117
+{-
hunk ./lib/base/Data/Typeable.hs 119
-gcast :: c a -> Maybe (c b)
+gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
hunk ./lib/base/Data/Typeable.hs 129
-gcast1 ::  c (t a) -> Maybe (c (t' a))
+gcast1 :: (Typeable1 t, Typeable1 t') c (t a) -> Maybe (c (t' a))
hunk ./lib/base/Data/Typeable.hs 139
-gcast2 ::  c (t a b) -> Maybe (c (t' a b))
+gcast2 :: (Typeable2 t, Typeable2 t') c (t a b) -> Maybe (c (t' a b))
hunk ./lib/base/Data/Typeable.hs 147
+  -}
+
+-- | For defining a 'Typeable' instance from any 'Typeable1' instance.
+typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep
+typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x)
+ where
+   argType :: t a -> a
+   argType =  undefined
+
+
+-- | For defining a 'Typeable1' instance from any 'Typeable2' instance.
+typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep
+typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x)
+ where
+   argType :: t a b -> a
+   argType =  undefined
+
hunk ./lib/base/base.cabal 64
+                 Data.Typeable,