Hi,

After attempting to build Haksell programm (through KDevelop),
i have got such a message:


....

Chasing modules from: hask1.hs
Compiling Main ( hask1.hs, hask1.o )
ghc-6.4: panic! (the `impossible' happened, GHC version 6.4):
ds_app_type Main.Tree{tc r16z} [a{tv a1a9}]

Please report it as a compiler bug to glasgow-haskell-bugs@haskell.org,
or http://sourceforge.net/projects/ghc/.

....


File hask.hs (with little comment) is attached.

Please wright back if you have accepted this signal or 
if you are not interested in such a feedback.

Best regards, Paul.



module Main
    where

import IO
import Random
import Monad

data TypeOfLexem = Variable | Number | Plus | Minus

data Lexem = Lexem {t::TypeOfLexem, branches::Int}

data Node a = Nil | Node a [Tree a]
{-
	This line caused compiler panic.
	Previously it was was:

data Tree a = Nil | Node a [Tree a]

-}

class Tree a where


 (-) :: Tree a -> Tree a -> Tree a

 (-) a1 a2 = Node Lexem{t=Minus,branches=2} (a1:a2:[])





{-

	All the rest doesn,t make sense (i suppose)

-}
main = do
 hSetBuffering stdin LineBuffering
 num <- randomRIO (1::Int, 100)
 putStrLn "I'm thinking of a number between 1 and 100"
 doGuessing num


doGuessing num = do
 putStrLn "Enter your guess:"
 guess <- getLine
 let guessNum = read guess
 if guessNum < num
   then do putStrLn "Too low!"
           doGuessing num
   else if read guess > num
          then do putStrLn "Too high!"
                  doGuessing num
          else do putStrLn "You Win!"
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to