[Haskell-beginners] pattern matching on function names or algebraic type data constructors
TP
paratribulations at free.fr
Sun Jun 23 11:34:41 CEST 2013
Hi,
I ask myself if there is a way to make the following code work.
I would like to pattern match on function names:
-----------
f :: Float -> Int
f x = 1
g :: Float -> Int
g x = 2
pat :: (Float -> Int) -> Bool
pat t = case t of
f -> True
g -> False
main = do
print $ pat f
print $ pat g
-----------
I don't understand the output:
-----------
$ runghc test_pattern_match_on_function_2.hs
test_pattern_match_on_function_2.hs:8:9: Warning:
Pattern match(es) are overlapped
In a case alternative: g -> ...
True
True
-----------
What is the reason for this message?
Now, I want to do it on data constructors in a GADT (which are functions if
I am right):
-----------
{-# LANGUAGE GADTs #-}
data Foobar where
Mult :: Float -> Foobar
Plus :: Float -> Foobar
pat :: (Float -> Foobar) -> Bool
pat t = case t of
Mult -> True
Plus -> False
main = do
print $ pat Mult
print $ pat Plus
-----------
I obtain:
-----------
$ runghc test_pattern_match_on_function.hs
test_pattern_match_on_function.hs:9:9:
Constructor `Mult' should have 1 argument, but has been given none
In the pattern: Mult
In a case alternative: Mult -> True
In the expression:
case t of {
Mult -> True
Plus -> False }
test_pattern_match_on_function.hs:9:9:
Couldn't match expected type `Float -> Foobar'
with actual type `Foobar'
In the pattern: Mult
In a case alternative: Mult -> True
In the expression:
case t of {
Mult -> True
Plus -> False }
-----------
Why does it not work? If Mult and Plus are functions, then I should not need
to put their arguments in pattern matching.
Thanks in advance,
TP
More information about the Beginners
mailing list