Happy bug

[Stefan O'Rear]

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.

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.
-------------- next part --------------
-- -*- 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 = []

}