Hi, I have recently started learning Haskell and, in writing a HUGS module to generate permutations, have been told I have an error but I don't understand why.
The module is: module Arrange where -- -- perms :: [a] -> [[a]] perms [] = [[]] perms (a:as) = concatMap (\b -> fst b:perms (snd b)) (del (a:as)) del :: [a] -> [(a,[a])] del [] = [] del (a:as) = (a,as):(map (\b -> (fst b,a:(snd b))) (del as)) and it comes back with error message: Type checking ERROR Arrange.hs:6 - Type error in application *** Expression : concatMap (\b -> fst b : perms (snd b)) (del (a : as)) *** Term : \b -> fst b : perms (snd b) *** Type : ([a],[a]) -> [[a]] *** Does not match : (a,[a]) -> [[a]] *** Because : unification would give infinite type But why does it say that the term "\b -> fst b : perms (snd b)" has type "([a],[a]) -> [[a]]"? perms requires a type "[a]" as input so "snd b" should be of type "[a]" but "fst b" should be allowed to be anything. What's going on? Any help would be much appreciated. Thanks, Mark. -- Dr Mark H Phillips Research Analyst (Mathematician) AUSTRICS - Smarter Scheduling Solutions - www.austrics.com Level 2, 50 Pirie Street, Adelaide SA 5000, Australia Phone +61 8 8226 9850 Fax +61 8 8231 4821 Email [EMAIL PROTECTED] _______________________________________________ Haskell mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell
