
Trying my Haskell Integer code I'm working on has triggered four (4) bugs in Yhc, one (1) of which also exists in a similar fashion in Hugs. See attached file. Luckily, I was able to find workarounds (none of which I want to keep) for all of them so that I run Catch on the module and get past the _Yhc_ errors (I had _successfully_ run Catch before with an earlier, buggier version of my code and got no useful information, but I figured I'd try again...). So: ]catch IntegerInTermsOfInt.hs Executing: IntegerInTermsOfInt.hs Compiling Compiling IntegerInTermsOfInt ( IntegerInTermsOfInt.hs ) Loading Core for YHC.Internal Loading Core for YHC.Primitive Loading Core for Data.Ratio Loading Core for Prelude Loading Core for Foreign.C Loading Core for Foreign.C.String Loading Core for Foreign.Util Loading Core for Foreign.C.Error Loading Core for YHC.ErrNo Loading Core for Foreign.C.Types Loading Core for Control.Monad Loading Core for Foreign.Word Loading Core for Numeric Loading Core for Data._CharNumeric Loading Core for Data.Char Loading Core for Data.Array Loading Core for YHC.Exception Loading Core for Data.Ix Loading Core for Foreign.Storable Loading Core for Foreign.Ptr Loading Core for Foreign.Int Loading Core for System.IO Loading Core for System.IO.Unsafe Loading Core for Data.IORef Loading Core for YHC.IORef Loading Core for Foreign Loading Core for Foreign.Marshal Loading Core for Foreign.Marshal.Alloc Loading Core for Foreign.Marshal.Utils Loading Core for Foreign.StablePtr Loading Core for Foreign.ForeignPtr Loading Core for Debug.Trace Loading Core for System.Exit Loading Core for PreludeAux Linking... catch: user error (invalid binary data found) ]catch IntegerInTermsOfInt.hs Executing: IntegerInTermsOfInt.hs Compiling catch: user error (invalid binary data found) In case it makes a difference, I've compiled and installed latest Yhc-darcs, and Catch-0.1.1, to prefix=$HOME, and have $HOME/bin in my PATH (and have neither installed anywhere else on my system). IntegerInTermsOfInt is the only module, in a file of the same name, and it only imports Prelude and Numeric. Isaac module YhcBugs where -- Bug: the "--_" sequence isn't considered to begin a comment by Yhc. -- I had to put a space between them. Try either of these lines and see the -- ridiculous incorrect errors they create: -- --_ `fd` dsjfkl = dfjs -- --_ `fd` dsjfkl = -- Bug: parenthesized patterns break: -- (which I use in order to make monomorphism clear in either -- H98 m-r or mono-pat-binds) {- test :: Eq a => a -> Bool test a = f a where (f) = \a -> (==) a a -} --Bug: removing the default, breaks things: {- default () iente :: Integral a => a -> Int iente = fromIntegral -} --Bug: Always specifying an import list when importing Prelude, --breaks handling of some built-in syntax. However, Hugs also has --this bug so I'll keep my workaround. {- import Prelude ( ) simple :: () simple = () -} --workaround (don't you hate it? :-) : --With Yhc, I could put 'qualified' on the following import too, --but Hugs needs them imported _unqualified_ and without being named. {- --For hugs to import (:) (and 2-tuples? other list bits?) we have to import --Prelude unqualified, and not like import Prelude () -- -- conformant implementations like GHC will not even --accept explicit imports of those things. --Also a June 19 2007 YHC from darcs seems quite broken without this import. --But we don't want to import anything but [](..), ()(..), (,)(..), -- (,,)(..) and so on --so we hide everything that according to Haskell98 would be importable. import Prelude hiding --manually copied down everything from :browse Prelude in ghci ((++),error,foldr,seq,concat,filter,zip,print,fst,snd,otherwise,(&&),(||) ,Bounded(..),Enum(..),Eq(..),Floating(..),Fractional(..),Integral(..) ,Monad(..),Functor(..),Num(..),Ord(..),Read(..),Real(..),RealFloat(..) ,RealFrac(..),Show(..),Bool(..),Char,Double,Float,Int ,Integer,Ordering(..),Rational,IO,Either(..) ,putChar,putStr,putStrLn,getChar,getLine,getContents,interact,readFile ,writeFile,appendFile,readLn,readIO,($!),String,map,not,id,const,(.),flip,($) ,until,asTypeOf,IOError,FilePath,ioError,userError,ReadS,catch,unwords ,unlines,words,lines,minimum,maximum,product,sum,foldl1,either,lex,read ,readParen,reads,ShowS,showParen,showString,showChar,shows,subtract ,realToFrac,fromIntegral,(^^),(^),lcm,gcd,odd,even,unzip3,unzip,zipWith3 ,zipWith,zip3,lookup,notElem,elem,break,span,dropWhile,takeWhile,splitAt ,drop,take,cycle,replicate,repeat,iterate,scanr1,scanr,scanl1,scanl,concatMap ,all,any,or,and,foldr1,foldl,reverse,(!!),length,null,init,tail,last,head ,undefined,uncurry,curry,maybe,(=<<),sequence_,sequence,mapM_,mapM,Maybe(..)) -}