[project @ 1997-07-26 22:48:58 by sof]

ghc/tests/typecheck/should_compile/tc053.hs

+module ShouldSucceed where
+
+class Eq' a where
+ deq :: a -> a -> Bool
+
+instance Eq' Int where
+ deq x y = True
+
+instance (Eq' a) => Eq' [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+f x = deq x [1]

ghc/tests/typecheck/should_compile/tc054.hs

+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance Ord' Int where
+ lt x y = True
+
+f x y | lt x 1 = True
+      | otherwise = False

ghc/tests/typecheck/should_compile/tc055.hs

+module ShouldSucceed where
+
+(x,y) = (\p -> p,\q -> q)

ghc/tests/typecheck/should_compile/tc056.hs

+--!!! Duplicate class assertion
+
+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance (Eq' a, Eq' a) => Eq' [a] where
+ doubleeq x y = True
+
+f x y = doubleeq x [1]

ghc/tests/typecheck/should_compile/tc057.hi

+interface ShouldSucceed where {
+class Eq' a where { deq }
+instance <Eq' Int>
+instance Eq' a => <Eq' [a]>
+dand  ::  Bool -> Bool -> Bool
+f  ::  Eq' t93 => t93 -> t93 -> Bool
+}

ghc/tests/typecheck/should_compile/tc057.hs

+module ShouldSucceed where
+
+-- See also tcfail060.hs
+
+class Eq' a where
+ deq :: a -> a -> Bool
+
+instance Eq' Int where
+  deq x y = True
+
+instance (Eq' a) => Eq' [a] where
+   deq (a:as) (b:bs) = dand (f a b) (f as bs)
+
+dand True True = True
+dand x y = False
+
+f :: Eq' a => a -> a -> Bool
+f p q = dand (deq p q) (deq [1::Int] [2::Int])

ghc/tests/typecheck/should_compile/tc058.hs

+module ShouldSucceed where
+
+class Eq2 a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq2 a) => Ord2 a where
+ lt :: a -> a -> Bool
+
+instance Eq2 Int where
+ doubleeq x y = True
+
+instance Ord2 Int where
+ lt x y = True
+
+instance (Eq2 a,Ord2 a) => Eq2 [a] where
+ doubleeq xs ys = True
+
+f x y = doubleeq x [1] 

ghc/tests/typecheck/should_compile/tc059.hs

+module ShouldSucceed where
+
+class Eq2 a where
+ deq :: a -> a -> Bool
+ foo :: a -> a
+
+instance Eq2 Int where
+ deq x y = True
+ foo x = x
+
+instance (Eq2 a) => Eq2 [a] where
+ deq (a:as) (b:bs) = if (deq a (foo b)) then (deq as (foo bs)) else False
+ foo x = x
+
+f x = deq x [1]

ghc/tests/typecheck/should_compile/tc060.hs

+module ShouldSucceed where
+
+class Eq2 a where
+ deq :: a -> a -> Bool
+
+instance (Eq2 a) => Eq2 [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+
+instance Eq2 Int where
+ deq x y = True
+

ghc/tests/typecheck/should_compile/tc061.hs

+module ShouldSucceed where
+
+class Eq1 a where
+ deq :: a -> a -> Bool
+
+instance (Eq1 a) => Eq1 [a] where
+ deq (a:as) (b:bs) = deq a b
+
+instance Eq1 Int where
+ deq x y = True
+

ghc/tests/typecheck/should_compile/tc062.hs

+module ShouldSucceed where
+
+class Eq1 a where
+ deq :: a -> a -> Bool
+
+instance Eq1 Int where
+ deq x y = True
+
+instance (Eq1 a) => Eq1 [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+f x (y:ys) = deq x ys

ghc/tests/typecheck/should_compile/tc063.hs

+module ShouldSucceed where
+
+data X a = Tag a 
+
+class Reps r where
+ f :: r -> r -> r
+
+instance Reps (X q) where
+-- f (Tag x) (Tag y) = Tag y
+ f x y = y
+
+instance Reps Bool where
+ f True True = True
+ f x y = False
+
+g x = f x x
+
+

ghc/tests/typecheck/should_compile/tc064.hs

+module ShouldSucceed where
+
+data Boolean = FF | TT
+
+idb :: Boolean -> Boolean
+idb x = x      
+

ghc/tests/typecheck/should_compile/tc065.hs

+module Digraphs where
+
+import TheUtils
+import Set
+import List (partition )
+
+data Digraph vertex = MkDigraph [vertex]
+
+type Edge  vertex = (vertex, vertex)
+type Cycle vertex = [vertex]
+
+mkDigraph = MkDigraph
+
+stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
+stronglyConnComp es vs
+  = snd (span_tree (new_range reversed_edges)
+		    ([],[])
+                   ( snd (dfs (new_range es) ([],[]) vs) )
+	 )
+ where
+   reversed_edges = map swap es
+
+   swap :: Edge v -> Edge v
+   swap (x,y) = (y, x)
+
+   new_range    []       w = []
+   new_range ((x,y):xys) w
+	= if x==w
+	  then (y : (new_range xys w))
+	  else (new_range xys w)
+
+   span_tree r (vs,ns) []   = (vs,ns)
+   span_tree r (vs,ns) (x:xs)
+	| x `elem` vs = span_tree r (vs,ns) xs
+	| otherwise = span_tree r (vs',(x:ns'):ns) xs
+	  where
+	    (vs',ns') = dfs r (x:vs,[]) (r x)
+
+dfs r (vs,ns)   []   = (vs,ns)
+dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
+                     | otherwise = dfs r (vs',(x:ns')++ns) xs
+                                   where
+                                     (vs',ns') = dfs r (x:vs,[]) (r x)
+
+
+isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
+isCyclic edges [v] = (v,v) `elem` edges
+isCyclic edges vs = True
+
+
+topSort :: (Eq vertex) => [Edge vertex] -> [vertex]
+              -> MaybeErr [vertex] [[vertex]]
+
+
+topSort edges vertices
+ = case cycles of
+	[] -> Succeeded [v | [v] <- singletons]
+	_  -> Failed cycles
+   where
+   sccs = stronglyConnComp edges vertices
+   (cycles, singletons) = partition (isCyclic edges) sccs
+
+
+type FlattenedDependencyInfo vertex name code
+   = [(vertex, Set name, Set name, code)]
+
+mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]
+mkVertices info = [ vertex | (vertex,_,_,_) <- info]
+
+mkEdges :: (Eq vertex, Ord name) =>
+	    [vertex]
+	 -> FlattenedDependencyInfo vertex name code
+	 -> [Edge vertex]
+
+mkEdges vertices flat_info
+ = [ (source_vertex, target_vertex)
+   | (source_vertex, _, used_names, _) <- flat_info,
+     target_name   <- setToList used_names,
+     target_vertex <- vertices_defining target_name flat_info
+   ]
+ where
+   vertices_defining name flat_info
+    = [ vertex |  (vertex, names_defined, _, _) <- flat_info,
+   		name `elementOf` names_defined
+      ]
+
+lookupVertex :: (Eq vertex, Ord name) =>
+	    	 FlattenedDependencyInfo vertex name code
+	      -> vertex
+	      -> code
+
+lookupVertex flat_info vertex
+ = head code_list
+ where
+   code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']
+
+
+isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool
+isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges
+isRecursiveCycle cycle    edges = True
+
+
+
+-- may go to TheUtils
+
+data MaybeErr a b = Succeeded a | Failed b
+

ghc/tests/typecheck/should_compile/tc066.hs

+module ShouldSucceed where
+
+data Pair a b = MkPair a b
+f x = [ a | (MkPair c a) <- x ]

ghc/tests/typecheck/should_compile/tc067.hs

+module ShouldSucc where
+
+f [] = []
+f (x:xs) = x : (f xs)

ghc/tests/typecheck/should_compile/tc068.hs

+module ShouldSucc where
+
+data T a = D (B a) | C
+data B b = X | Y b
+
+instance (Eq a) => Eq (T a) where
+ (D x) == (D y) = x == y
+ C == C = True
+ a == b = False
+
+ a /= b = not (a == b)
+
+instance (Eq b) => Eq (B b) where
+ X == X = True
+ (Y a) == (Y b) = a == b
+ a == b = False
+
+ a /= b = not (a == b)

ghc/tests/typecheck/should_compile/tc069.hs

+module ShouldSucceed where
+
+x = 'a'
+(y:ys) = ['a','b','c'] where p = x

ghc/tests/typecheck/should_compile/tc070.hs

+module ShouldSucceed where
+
+
+data Boolean = FF | TT
+
+
+idb :: Boolean -> Boolean
+idb x = x      
+

ghc/tests/typecheck/should_compile/tc073.hs

+
+module ShouldSucc where
+
+f [] = []
+f (x:xs) = x : (f xs)