Ralf Hinze writes:
> Dear bug chasers,
> 
> ghc's latest version sometimes misses conflicting function definitions.
> Consider the following *wrong* program:
> 

Hi,

thanks for the report - this is due to a parser problem of signalling
when a toplevel value declaration ends. To fix, apply the following
patch in ghc/compiler and re-make `hsc' (you'll need to have `bison'
installed to do this):

*** parser/hsparser.y.orig      1997/06/05 20:43:54
--- parser/hsparser.y   1997/06/12 05:10:27
***************
*** 475,486 ****
                }
          ;
  
! topdecl       :  typed                                { $$ = $1; }
!       |  datad                                { $$ = $1; }
!       |  newtd                                { $$ = $1; }
!       |  classd                               { $$ = $1; }
!       |  instd                                { $$ = $1; }
!       |  defaultd                             { $$ = $1; }
        |  decl                                 { $$ = $1; }
        ;
  
--- 475,486 ----
                }
          ;
  
! topdecl       :  typed                                { $$ = $1; FN = NULL; SAMEFN = 
0; }
!       |  datad                                { $$ = $1; FN = NULL; SAMEFN = 0; }
!       |  newtd                                { $$ = $1; FN = NULL; SAMEFN = 0; }
!       |  classd                               { $$ = $1; FN = NULL; SAMEFN = 0; }
!       |  instd                                { $$ = $1; FN = NULL; SAMEFN = 0; }
!       |  defaultd                             { $$ = $1; FN = NULL; SAMEFN = 0; }
        |  decl                                 { $$ = $1; }
        ;
  

--Sigbjorn


Faulting program:

> %------------------------------------------------------------------------------
> 
> > module Small                        (  module Small  )
> > where
> 
> > data MinView t a              =  Min a (t a)
> >                             |  Infty
> 
> > newtype ToppedTree a                =  P (MinView BinTree a)
> > data BinTree a              =  Bin a (BinTree a) (BinTree a)
> >                             |  Empty
> 
> > P Infty         /\ u                =  P Infty
> > t@(P (Min _ _)) /\ P Infty  =  P Infty
> > P (Min a t)     /\ P (Min b u)
> >     | a <= b                        =  P (Min a (Bin b u t))
> >     | otherwise             =  P (Min b (Bin a t u))
> 
> > data Tree a                 =  Root a (Forest a)
> >                             |  Void
> > type Forest a                       =  [Tree a]
> 
> > Void          /\ u          =  Void
> > t@(Root _ _)  /\ Void               =  Void
> > t@(Root a ts) /\ u@(Root b us)
> >     | a <= b                        =  Root a (u : ts)
> >     | otherwise             =  Root b (t : us)
> 
> %------------------------------------------------------------------------------
> 
> Note that /\ is defined twice at different types. 

Reply via email to