Happy bug

[Simon Marlow]

Stefan O'Rear wrote:
> stefan at stefans:~/cadt/src$ happy Parser.y
> happy: parE
> stefan at stefans:~/cadt/src$
> 
> A little code examination seems to show that this error cannot occur
> for correct grammars.  But still - it's not helpful.  I would prefer
> to see the actual first error rather than none of the errors.

Yes, this is on my list to fix sometime.  Looking at the code, I can't believe I 
wrote something that fragile, but fixing it properly isn't a quick job.

Thanks for letting me know about the email rejection.

Cheers,
	Simon

> 
> Parser.y is attached.
> 
> 
> I tried to send this to the bug report address, but SimonM's email
> system rejected it as spam, even with a 25-bit hashcash stamp!
> 
> So now all of g-h-u is annoyed.
> 
> 
> ------------------------------------------------------------------------
> 
> -- -*- Haskell -*-
> {
> module Parser where
> }
> 
> %tokentype { Token }
> %error { parse_error }
> %token ID     { T_Id $$ }
>        '\n'   { T_NL }
>        '{'    { T_OB }
>        '}'    { T_CB }
>        '('    { T_OP }
>        ')'    { T_CP }
>        '*'    { T_St }
>        ';'    { T_Se }
>        '|'    { T_Pi }
>        "::="  { T_Sum }
>        "=="   { T_Prod }
>        DERIVE { T_Deriv }
> 
> %%
> 
> spec   :: { State -> State }
> spec    : {- empty -}         { id }
>         | spec line '\n'      { $1 >>> $2 }
> 
> line   :: { State -> State }
> line    : {- empty -}         { id }
>         | DERIVE derivat      { second $2 }
>         | lhs derivat
>           { \(txt, st) -> (txt `cat_st` derive ($2 st) $1, st) }
> 
> lhs    :: { Type }
> lhs     : ID "==" fields      { Prod_T (Product $1 ($3 [])) }
>         | ID "::=" cases      { Sum_T (Sum $1 ($3 [])) }
> 
> cases  :: { [Product] -> [Product] } -- difference list
> cases   : ID fields           { (: Product $1 ($2 [])]) }
>         | cases '|' ID fields { $1 . (: Product $3 ($4 [])) }
> 
> fields :: { [Field] -> [Field] }
> fields  : {- empty -}         { id }
>         | fields field        { $1 . $2 }
> 
> field  :: { Field }
> field   : spquals declars ';' { $2 $1 }
> 
> -- this comes out reversed which is good - c types are written backward
> spquals:: { R_Type }
> spquals : ID                  { R_Tag $1 R_Nil }
>         | spquals ID          { R_Tag $2 $1 }
> 
> declars:: { R_Type -> ([Field] -> [Field]) }
> declars : declar              { (:) . $1 }
>         | declars ',' declar  { \ty -> $1 ty . ($2 ty :) }
> 
> declar :: { R_Type -> Field }
> declar  : '*' declar          { $2 . R_Star }
>         | ID declar           { $2 . R_Tag $1 }
>         | ddeclar             { $1 }
> 
> ddeclar:: { R_Type -> Field }
> ddeclar : ID                  { Field $1 }
>         | '(' declar ')'      { $2 }
> 
> 
> 
> {
> data Token = T_Id String | T_NL | T_OB | T_CB | T_OP | T_CP | T_St
>            | T_Se | T_Pi | T_Sum | T_Prod | T_Deriv
> 
> parseError :: [b] -> a
> parseError _ = error "Parse error"
> 
> lexer [] = []
> lexer ('(':xs) = T_OP : lexer xs
> lexer (')':xs) = T_CP : lexer xs
> lexer ('{':xs) = T_OB : lexer xs
> lexer ('}':xs) = T_CB : lexer xs
> lexer ('*':xs) = T_St : lexer xs
> lexer (';':xs) = T_Se : lexer xs
> lexer ('|':xs) = T_Pi : lexer xs
> lexer (x:xs) | x `elem` " \t\v\r" = lexer xs
> lexer ('\n':x:xs) | isSpace x = lexer (x:xs)
>                   | otherwise = T_NL : lexer (x:xs)
> lexer (x:xs) | isID x = lexID (x:xs)
> 
> lexID (x:xs) | isID x = T_Id (x:name) : rest
>              where (name, rest) = case lexID xs of
>                                         T_Id nam : res -> (nam, res)
>                                         res            -> ("", res)
> lexID cs = lexer cs
> 
> isID x = isAlphaNum x || x == '_'
> 
> -- | The type of supported derivations.
> data Derivation = forall s. Derivation
>     { der_gentext :: Type -> s -> Either String Sect_bag
>     , der_parse   :: Parser Char (s -> s)
>     , der_initial :: s
>     }
> 
> -- |
> -- Types for the sectioned-text output format.
> data Section = Decl_Sect | Defn_Sect deriving(Eq,Enum,Bounded)
> 
> data Sect_bag = ST (Section -> [Char] -> [Char])
> 
> nil_st :: Sect_bag
> nil_st = ST $ \_ -> id
> 
> cat_st :: Sect_bag -> Sect_bag -> Sect_bag
> cat_st (ST f1) (ST f2) = ST $ \s -> f1 s . f2 s
> 
> emit :: Section -> [Char] -> Sect_bag
> emit sec txt = ST $ \sec' -> if sec == sec' then (txt++) else id
> 
> -- |
> -- The central data type used by CADT.  This type represents one CADT
> -- type.  The CADT parser generates a set of these from the input.
> -- The CADT derivers use this to generate code.
> module Type where
> 
> -- | Represents one data type.
> data Type = Sum_T Sum
>           | Prod_T Product
> 
> -- | A sum type; that is, a type consisting of multiple mutually
> -- exclusive cases, each of which is a product, like a discriminated
> -- union.
> data Sum = Sum { s_name  :: String    -- ^ The name of the sum type as
>                                       -- a whole
>                , s_cases :: [Product] -- ^ The set of cases (in source
>                                       -- order)
>                }
> 
> -- | A product type - a set of fields all of which exist.  A C struct.
> data Product = Product { p_name   :: String
>                        , p_fields :: [Field]
>                        }
> 
> -- | A field within a product type.
> data Field = Field { f_name :: String
>                    , f_type :: R_Type
>                    }
> 
> -- | A referencing type, as used in 'Field' definitions to specify the
> -- field type.  While a 'Type' specifies how to build a new type, a
> -- 'R_Type' gives the method for referencing an /existing/ type; in
> -- terms of C 'R_Type' corresponds to specifier, qualifier, and
> -- declarator syntax.
> --
> -- We currently do very little semantic analysis; a R_Type is
> -- represented as a list of words and stars.
> data R_Type = R_Star RType
>             | R_Tag String RType
>             | R_Nil
> 
> 
> all_derivations :: [Derivation]
> all_derivations = []
> 
> }
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> Glasgow-haskell-users mailing list
> Glasgow-haskell-users at haskell.org
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users