--- happy-1.18.9-orig/happy.cabal 2012-02-06 20:49:56.000000000 +1100 +++ happy-1.18.9/happy.cabal 2012-02-07 20:50:33.859004968 +1100 @@ -100,10 +100,13 @@ templates/GLR_Base.hs templates/GenericTemplate.hs templates/GLR_Lib.hs + tests/AttrGrammar001.y + tests/AttrGrammar002.y tests/error001.y tests/error001.stdout tests/error001.stderr tests/monad001.y + tests/monaderror.y tests/Makefile tests/TestMulti.ly tests/Partial.ly --- happy-1.18.9-orig/tests/Makefile 2012-02-06 20:49:55.000000000 +1100 +++ happy-1.18.9/tests/Makefile 2012-02-07 20:50:33.859004968 +1100 @@ -1,5 +1,5 @@ HAPPY=../dist/build/happy/happy -HC=ghc +HC=ghc -hide-all-packages -package base -package array -package mtl TESTS = Test.ly TestMulti.ly TestPrecedence.ly bug001.ly \ monad001.y monad002.ly precedence001.ly precedence002.y \ --- /dev/null 2012-02-07 10:04:42.144206507 +1100 +++ happy-1.18.9/tests/AttrGrammar001.y 2012-02-07 20:50:47.013316418 +1100 @@ -0,0 +1,68 @@ +{ +import Control.Monad (unless) +} + +%tokentype { Char } + +%token a { 'a' } +%token b { 'b' } +%token c { 'c' } + +%attributetype { Attrs a } +%attribute value { a } +%attribute len { Int } + +%name parse abcstring + +%monad { Maybe } + +%% + +abcstring + : alist blist clist + { $$ = $1 ++ $2 ++ $3 + ; $2.len = $1.len + ; $3.len = $1.len + } + +alist + : a alist + { $$ = $1 : $> + ; $$.len = $>.len + 1 + } + | { $$ = []; $$.len = 0 } + +blist + : b blist + { $$ = $1 : $> + ; $>.len = $$.len - 1 + } + | { $$ = [] + ; where failUnless ($$.len == 0) "blist wrong length" + } + +clist + : c clist + { $$ = $1 : $> + ; $>.len = $$.len - 1 + } + | { $$ = [] + ; where failUnless ($$.len == 0) "clist wrong length" + } + +{ +happyError = error "parse error" +failUnless b msg = unless b (fail msg) + +main = case parse "" of { Just _ -> + case parse "abc" of { Just _ -> + case parse "aaaabbbbcccc" of { Just _ -> + case parse "abbcc" of { Nothing -> + case parse "aabcc" of { Nothing -> + case parse "aabbc" of { Nothing -> + putStrLn "Test works"; + _ -> quit } ; _ -> quit }; _ -> quit }; + _ -> quit } ; _ -> quit }; _ -> quit } + +quit = putStrLn "Test failed" +} --- /dev/null 2012-02-07 10:04:42.144206507 +1100 +++ happy-1.18.9/tests/AttrGrammar002.y 2012-02-07 20:50:47.013316418 +1100 @@ -0,0 +1,58 @@ + +%tokentype { Char } + +%token minus { '-' } +%token plus { '+' } +%token one { '1' } +%token zero { '0' } + +%attributetype { Attrs } +%attribute value { Integer } +%attribute pos { Int } + +%name parse start + +%monad { Maybe } + +%% + +start + : num { $$ = $1 } + +num + : bits { $$ = $1 ; $1.pos = 0 } + | plus bits { $$ = $2 ; $2.pos = 0 } + | minus bits { $$ = negate $2; $2.pos = 0 } + +bits + : bit { $$ = $1 + ; $1.pos = $$.pos + } + + | bits bit { $$ = $1 + $2 + ; $1.pos = $$.pos + 1 + ; $2.pos = $$.pos + } + +bit + : zero { $$ = 0 } + | one { $$ = 2^($$.pos) } + + +{ +happyError msg = fail $ "parse error: "++msg + +main = case parse "" of { Nothing -> + case parse "abc" of { Nothing -> + case parse "0" of { Just 0 -> + case parse "1" of { Just 1 -> + case parse "101" of { Just 5 -> + case parse "111" of { Just 7 -> + case parse "10001" of { Just 17 -> + putStrLn "Test worked"; + _ -> quit }; _ -> quit }; _ -> quit }; + _ -> quit }; _ -> quit }; _ -> quit }; + _ -> quit } + +quit = putStrLn "Test Failed" +} --- /dev/null 2012-02-07 10:04:42.144206507 +1100 +++ happy-1.18.9/tests/ParGF.y 2012-02-07 20:50:47.014316443 +1100 @@ -0,0 +1,40 @@ +{- + +With Happy 1.17 this file produces "Internal Happy error" when run: + +$ happy ParGF.y && runghc ParGF.hs +ParGF.hs: Internal Happy error + +The problem is that we always pass around the "current token". When not +using %lexer and we've run out of tokens, the current token is notHappyAtAll, +which gets passed to happyError when there's an error. + +-} + +{ +} + +%name pGrammar + +%tokentype { String } +%error { parseError } + +%token + 'a' { "a" } + +%% + +Grammar :: { () } +Grammar : 'a' 'a' { () } + +{ + +parseError :: [String] -> a +-- commenting out the below line gets rid of the "Internal Happy Error" +parseError ("":_) = error "bar" +parseError _ = error "foo" + +main :: IO () +main = print $ pGrammar ["a"] + +} --- /dev/null 2012-02-07 10:04:42.144206507 +1100 +++ happy-1.18.9/tests/monaderror.y 2012-02-07 20:50:47.015316467 +1100 @@ -0,0 +1,57 @@ +{ +module Main where + +import Data.Char +import Control.Monad.Error +import System.Exit +} + +%name parseFoo +%tokentype { Token } +%error { handleError } + +%monad { ParseM } { (>>=) } { return } + +%token + 'S' { TokenSucc } + 'Z' { TokenZero } + +%% + +Exp : 'Z' { 0 } + | 'S' Exp { $2 + 1 } + +{ + +type ParseM a = Either ParseError a +data ParseError + = ParseError (Maybe Token) + | StringError String + deriving (Eq,Show) +instance Error ParseError where + strMsg = StringError + +data Token + = TokenSucc + | TokenZero + deriving (Eq,Show) + +handleError :: [Token] -> ParseM a +handleError [] = throwError $ ParseError Nothing +handleError ts = throwError $ ParseError $ Just $ head ts + +lexer :: String -> [Token] +lexer [] = [] +lexer (c:cs) + | isSpace c = lexer cs + | c == 'S' = TokenSucc:(lexer cs) + | c == 'Z' = TokenZero:(lexer cs) + | otherwise = error "lexer error" + +main :: IO () +main = do + let tokens = lexer "S S" + when (parseFoo tokens /= Left (ParseError Nothing)) $ do + print (parseFoo tokens) + exitWith (ExitFailure 1) +}