[Haskell-cafe] what does @ mean?.....
Nicholls, Mark
Nicholls.Mark at mtvne.com
Fri Dec 28 06:05:55 EST 2007
Hello, I wonder if someone could answer the following...
The short question is what does @ mean in
mulNat a b
| a <= b = mulNat' a b b
| otherwise = mulNat' b a a
where
mulNat' x@(S a) y orig
| x == one = y
| otherwise = mulNat' a (addNat orig y) orig
The long version, explaining what everything means is....
here's a definition of multiplication on natural numbers I'm reading
on a blog....
data Nat = Z | S Nat
deriving Show
one :: Nat
one = (S Z)
mulNat :: Nat -> Nat -> Nat
mulNat _ Z = Z
mulNat Z _ = Z
mulNat a b
| a <= b = mulNat' a b b
| otherwise = mulNat' b a a
where
mulNat' x@(S a) y orig
| x == one = y
| otherwise = mulNat' a (addNat orig y) orig
Haskell programmers seem to have a very irritating habit of trying to
be overly concise...which makes learnign the language extremely
hard...this example is actually relatively verbose....but anyway...
Z looks like Zero...S is the successor function...Nat are the
"Natural" numbers.....
mulNat _ Z = Z
mulNat Z _ = Z
translates to...
x * 0 = 0....fine...
0 * x = 0....fine..
mulNat a b
| a <= b = mulNat' a b b
| otherwise = mulNat' b a a
where
mulNat' x@(S a) y orig
| x == one = y
| otherwise = mulNat' a (addNat orig y) orig
is a bit more problematic...
lets take a as 3 and b as 5...
so now we have
mulNat' 3 5 5
but what does the "x@(S a)" mean? in
mulNat' x@(S a) y orig
________________________________
From: haskell-cafe-bounces at haskell.org
[mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Nicholls, Mark
Sent: 21 December 2007 17:47
To: David Menendez
Cc: Jules Bean; haskell-cafe at haskell.org
Subject: RE: [Haskell-cafe] nice simple problem for someone
struggling....
Let me resend the code...as it stands....
module Main where
data SquareType numberType = Num numberType => SquareConstructor
numberType
class ShapeInterface shape where
area :: Num numberType => shape->numberType
data ShapeType = forall a. ShapeInterface a => ShapeType a
instance (Num a) => ShapeInterface (SquareType a) where
area (SquareConstructor side) = side * side
and the errors are for the instance declaration.......
[1 of 1] Compiling Main ( Main.hs, C:\Documents and
Settings\nichom\Haskell\Shapes2\out/Main.o )
Main.hs:71:36:
Couldn't match expected type `numberType' against inferred type `a'
`numberType' is a rigid type variable bound by
the type signature for `area' at Main.hs:38:15
`a' is a rigid type variable bound by
the instance declaration at Main.hs:70:14
In the expression: side * side
In the definition of `area':
area (SquareConstructor side) = side * side
I'm becoming lost in errors I don't comprehend....
What bamboozles me is it seemed such a minor enhancement.
________________________________
From: d4ve.menendez at gmail.com [mailto:d4ve.menendez at gmail.com] On Behalf
Of David Menendez
Sent: 21 December 2007 17:05
To: Nicholls, Mark
Cc: Jules Bean; haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] nice simple problem for someone
struggling....
On Dec 21, 2007 11:50 AM, Nicholls, Mark <Nicholls.Mark at mtvne.com>
wrote:
Now I have....
module Main where
data SquareType numberType = Num numberType => SquareConstructor
numberType
This is a valid declaration, but I don't think it does what you want it
to. The constraint on numberType applies only to the data constructor.
That is, given an unknown value of type SquareType a for some a, we do
not have enough information to infer Num a.
For your code, you want something like:
instance (Num a) => ShapeInterface (SquareType a) where
area (SquareConstructor side) = side * side
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/ >
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20071228/4d6c7dda/attachment-0001.htm
More information about the Haskell-Cafe
mailing list