
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(..)) -}

Hi
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...
]catch IntegerInTermsOfInt.hs Executing: IntegerInTermsOfInt.hs Compiling Compiling IntegerInTermsOfInt ( IntegerInTermsOfInt.hs ) Loading Core for YHC.Internal Linking... 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
This is the problem, Catch has a copy of the Yhc libraries, and since this morning me and Tom have changed the binary format for Yhc.Core - which means that Catch won't work with Yhc. Both Catch-darcs and Catch-0.1.1 are both broken with respect to the new library interfaces. I will come back and fix up Catch in a short while, but am working on another project at the moment, and am a little busy. If you (or anyone else) has a strong pressing need for Catch, then I may be able to hack it back up quickly, otherwise I'd like to take my time and get a very polished Catch-0.2 out.
-- 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 =
That seems like a nhc shared bug, probably in the lexer. I suspect its a moments Haskell foo for Malcolm or Tom, and an interested developer could probably fix it in half an hour - see src/compiler/Parse, and add a test :-)
-- 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 -}
Again, an nhc common bug. I've no idea where this should be fixed, but I'm sure Malcolm will know - and it should be possible to fix.
--Bug: removing the default, breaks things: {- default ()
iente :: Integral a => a -> Int iente = fromIntegral -}
No clue, only Malcolm will know, and it may be a nightmare to fix.
--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 = () -}
We are aware that importing Prelude () is broken, this is because the renaming code in Yhc/nhc isn't very neat. Me and Tom both had a go at fixing this once, and we got absolutely nowhere. See http://code.google.com/p/yhc/issues/detail?id=81&q=Prelude - which I think might even be from you originally :-) If anyone wants to make the first three into proper issues in the issue tracker, that would be handy. Thanks Neil

Neil Mitchell wrote:
This is the problem, Catch has a copy of the Yhc libraries, and since this morning me and Tom have changed the binary format for Yhc.Core - which means that Catch won't work with Yhc. Both Catch-darcs and Catch-0.1.1 are both broken with respect to the new library interfaces.
I was thinking that, but yhc wouldn't build with the most recent (august 5 and 6) patches unpulled, with errors like src/compiler/Core/Convert.hs:170:27: Not in scope: data constructor `CoreLit' So I tried just building the newest yhc, which worked, but didn't work with catch - oh well.
I will come back and fix up Catch in a short while, but am working on another project at the moment, and am a little busy. If you (or anyone else) has a strong pressing need for Catch
Not me... QuickCheck with a million iterations on each test is pretty reassuring too. (as well as testing with various other parameters varied too, ghc -Wall, etc)
--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 = () -}
We are aware that importing Prelude () is broken, this is because the renaming code in Yhc/nhc isn't very neat. Me and Tom both had a go at fixing this once, and we got absolutely nowhere. See http://code.google.com/p/yhc/issues/detail?id=81&q=Prelude - which I think might even be from you originally :-)
Alas :-) Maybe some of the above bugs will be fixable by someone sometime. Isaac

Hi
I was thinking that, but yhc wouldn't build with the most recent (august 5 and 6) patches unpulled, with errors like src/compiler/Core/Convert.hs:170:27: Not in scope: data constructor `CoreLit' So I tried just building the newest yhc, which worked, but didn't work with catch - oh well.
Not me... QuickCheck with a million iterations on each test is pretty reassuring too. (as well as testing with various other parameters varied too, ghc -Wall, etc)
You might need to unpull more like 15, we've been quite busy today. Honestly though, I wouldn't bother - its probably not worth the effort. Catch is a nice box to check, and it can expose flaws in the API, and find real bugs, but its clearly a 0.1 project so far.
Maybe some of the above bugs will be fixable by someone sometime.
I think that of those 4 you gave, 2 will be fixed sometime shortly, and are both useful finds. Thanks Neil

--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 = () -}
Maybe implicitly always adding import qualified Prelude as SecretNameNoOneWillEverUse would be a hack that would fix that? It relies on: (1) the instances in Prelude are always imported in every module anyway, in standard Haskell. (2) Another Yhc bug!!! : module Test where import Prelude hiding ( (==) ) data Foo = Bar instance Eq Foo where (==) = undefined compiles. It should not compile because (==) has not been imported, even qualified. In standard Haskell, you would have to add at least import qualified Prelude ( (==) ) . So maybe, to prevent incorrect programs from compiling after the other bug is no more, it is preferably import qualified Prelude as SecretNameNoOneWillEverUse hiding (Eq(..), Ord(..) and the rest) or if possible, name those elusive things (), [] etc, to import... But none of that is necessary for the basic hack - IS IT POSSIBLE? (even if so, is it too hacky? I believe Jhc *always* implicitly imports something like Jhc.Prelude that contains definitions of [] and a few other things, in addition to the standard Prelude stuff, and that feels *right*, to me) Isaac

Hi
Maybe implicitly always adding import qualified Prelude as SecretNameNoOneWillEverUse would be a hack that would fix that?
It is definitely a hack, in an area of the compiler which feels like a pile of hacks has built up until they are almost ready to topple over :-)
But none of that is necessary for the basic hack - IS IT POSSIBLE? (even if so, is it too hacky? I believe Jhc *always* implicitly imports something like Jhc.Prelude that contains definitions of [] and a few other things, in addition to the standard Prelude stuff, and that feels *right*, to me)
We came to the decision that the right thing is to always import qualified Prelude, regardless of if the user does import Prelude(), then always bind to fully qualified names. This is the solution we tried, and we failed completely. Thanks Neil

On Tue, Aug 07, 2007 at 12:30:20AM +0100, Neil Mitchell wrote:
But none of that is necessary for the basic hack - IS IT POSSIBLE? (even if so, is it too hacky? I believe Jhc *always* implicitly imports something like Jhc.Prelude that contains definitions of [] and a few other things, in addition to the standard Prelude stuff, and that feels *right*, to me)
We came to the decision that the right thing is to always import qualified Prelude, regardless of if the user does import Prelude(), then always bind to fully qualified names. This is the solution we tried, and we failed completely.
Thanks
I don't know if it's even remotely possible to implement something of this scale in modern nyhc by anyone but Röjemo, but the scheme I've settled on in my Haskell compiler project is to: 1. Create a special module QhcPrimitives containing the tuples, etc 2. In every module, do the equivalent of "import qualified QhcPrimitives as $QhcPrimitives" 3. Bind special syntax to $QhcPrimitives.(,,,), etc I *believe* this implements the H98 rules exactly, and seems a bit simpler since it doesn't involve checking for Prelude imports and the like. Stefan
participants (3)
-
Isaac Dupree
-
Neil Mitchell
-
Stefan O'Rear