Mis-understanding something in Haskell interpretation

Hi, I am new to Haskell and am learning Haskell on my own with "The Haskell School of Expression". Unfortunately there is no teacher that comes along with the book. I am having a problem with loading an excerise. I get this message from ghci on a :l Shapes.hs Shapes.hs:40:40: Couldn't match `Side' against `Int' Expected type: Side Inferred type: Int In the first argument of `sin', namely `angle' In the second argument of `(*)', namely `(sin angle)' Failed, modules loaded: none. The source is below. Side is types as Float. My assumption was that Haskell would know how to convert the Int to a float and all would be well. I am I mistaken somewhere? The problem is with the last line. Tips would be appreciated. Source Shapes.hs: module Shapes where data Shape = Rectangle Side Side | Ellipse Radius Radius | RtTriangle Side Side | Polygon [Vertex] deriving Show type Radius = Float type Side = Float type Vertex = (Float, Float) type Angle = Float rectangle :: Shape -> Shape rectangle (Rectangle width height )= Polygon [(0, 0),(0, height), (width, height), (width, 0)] rtTriangle :: Shape -> Shape rtTriangle (RtTriangle width height) = Polygon [(0,0),(0,height), (width, height)] regularPolygon :: Int -> Side -> Shape regularPolygon totalSides sideLength = let initial = (0.0,0.0) in Polygon (initial : vertices initial 1 totalSides sideLength ) vertices :: Vertex -> Int -> Int -> Side -> [Vertex] vertices _ 0 _ _ = [] vertices lastVertex currentSide totalSides length = let currentVertex = vertex lastVertex currentSide totalSides length in currentVertex: vertices currentVertex (totalSides - (currentSide + 1)) totalSides length vertex :: Vertex -> Int -> Int -> Side -> Vertex vertex (a ,b) currentSide totalSides length = let angle = 1.0 * (360 / totalSides) * currentSide in ( a + ( length * (sin angle)), b + ( (*) (cos angle) length ) )

On 10/3/06, Edward Ing
The source is below. Side is types as Float. My assumption was that Haskell would know how to convert the Int to a float and all would be well. I am I mistaken somewhere? The problem is with the last line.
Yes - Haskell does not automatically promote numeric types. In this case, the following code compiles: vertex :: Vertex -> Int -> Int -> Side -> Vertex vertex (a ,b) currentSide totalSides length = let angle = (360 / fromIntegral totalSides) * fromIntegral currentSide in ( a + ( length * (sin angle)), b + ( (*) (cos angle) length ) ) although I'm not sure it's exactly what you want. /g

Hello Edward, Tuesday, October 3, 2006, 9:44:27 PM, you wrote:
Couldn't match `Side' against `Int' In the first argument of `sin', namely `angle'
The source is below. Side is types as Float. My assumption was that Haskell would know how to convert the Int to a float and all would be well. I am I mistaken somewhere? The problem is with the last line.
yes, Haskell don't make automatic conversions because together with bi-directional type inferring it will make a headache.
let angle = 1.0 * (360 / totalSides) * currentSide in
as Garret said, you should make conversions explicitly, hopefully the 'fromIntegral' function is enough in most cases -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com
participants (3)
-
Bulat Ziganshin
-
Edward Ing
-
J. Garrett Morris