Hello community,
here is the log from the commit of package happy for openSUSE:Factory checked
in at 2015-05-13 07:12:41
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/happy (Old)
and /work/SRC/openSUSE:Factory/.happy.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "happy"
Changes:
--------
--- /work/SRC/openSUSE:Factory/happy/happy.changes 2015-02-10
20:23:46.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.happy.new/happy.changes 2015-05-13
07:12:42.000000000 +0200
@@ -1,0 +2,5 @@
+Thu Apr 9 16:46:01 UTC 2015 - mimi...@gmail.com
+
+- update to 1.19.5
+
+-------------------------------------------------------------------
Old:
----
happy-1.19.4.tar.gz
New:
----
happy-1.19.5.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ happy.spec ++++++
--- /var/tmp/diff_new_pack.TWwAyN/_old 2015-05-13 07:12:43.000000000 +0200
+++ /var/tmp/diff_new_pack.TWwAyN/_new 2015-05-13 07:12:43.000000000 +0200
@@ -1,7 +1,7 @@
#
# spec file for package happy
#
-# Copyright (c) 2015 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
%global debug_package %{nil}
%bcond_without tests
Name: happy
-Version: 1.19.4
+Version: 1.19.5
Release: 0
Summary: The LALR(1) Parser Generator for Haskell
License: BSD-2-Clause
++++++ happy-1.19.4.tar.gz -> happy-1.19.5.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/CHANGES new/happy-1.19.5/CHANGES
--- old/happy-1.19.4/CHANGES 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/CHANGES 2015-01-06 22:04:19.000000000 +0100
@@ -1,4 +1,9 @@
-----------------------------------------------------------------------------
+1.19.5
+ * fixes for GHC 7.10
+ * Code cleanups (thanks Index Int <vlad.z.4...@gmail.com>)
+
+-----------------------------------------------------------------------------
1.19.4
* fix for GHC 7.10 (Applicative/Monad, #19, #21)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/README new/happy-1.19.5/README
--- old/happy-1.19.4/README 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/README 2015-01-06 22:04:19.000000000 +0100
@@ -11,7 +11,7 @@
Complete documentation can be found in the directory 'doc', in
DocBook XML format. To format the documentation, the DocBook-Tools
-suite (see http://www.http://sourceware.cygnus.com/docbook-tools/)
+suite (see http://sourceware.cygnus.com/docbook-tools/)
provides all the bits & pieces you need. Alternatively, pre-formatted
documentation is available from Happy's homepage (URL above).
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/happy-1.19.4/dist/build/happy/happy-tmp/AttrGrammarParser.hs
new/happy-1.19.5/dist/build/happy/happy-tmp/AttrGrammarParser.hs
--- old/happy-1.19.4/dist/build/happy/happy-tmp/AttrGrammarParser.hs
2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/dist/build/happy/happy-tmp/AttrGrammarParser.hs
2015-01-06 22:04:19.000000000 +0100
@@ -6,8 +6,9 @@
import AttrGrammar
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
+import Control.Applicative(Applicative(..))
--- parser produced by Happy Version 1.19.0
+-- parser produced by Happy Version 1.19.4
newtype HappyAbsSyn = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
@@ -352,6 +353,7 @@
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and
a clang-compiled alex.
#if __GLASGOW_HASKELL__ > 706
#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
@@ -361,7 +363,7 @@
#define GTE(n,m) (n Happy_GHC_Exts.>=# m)
#define EQ(n,m) (n Happy_GHC_Exts.==# m)
#endif
-{-# LINE 45 "templates/GenericTemplate.hs" #-}
+{-# LINE 46 "templates/GenericTemplate.hs" #-}
data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
@@ -370,11 +372,11 @@
-{-# LINE 66 "templates/GenericTemplate.hs" #-}
+{-# LINE 67 "templates/GenericTemplate.hs" #-}
-{-# LINE 76 "templates/GenericTemplate.hs" #-}
+{-# LINE 77 "templates/GenericTemplate.hs" #-}
-{-# LINE 85 "templates/GenericTemplate.hs" #-}
+{-# LINE 86 "templates/GenericTemplate.hs" #-}
infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)
@@ -391,9 +393,9 @@
-- parse (a %partial parser). We must ignore the saved token on the top of
-- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
- happyReturn1 ans
+ happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
- (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+ (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
-----------------------------------------------------------------------------
-- Arrays only: do the next action
@@ -401,35 +403,35 @@
happyDoAction i tk st
- = {- nothing -}
+ = {- nothing -}
- case action of
- 0# -> {- nothing -}
- happyFail i tk st
- -1# -> {- nothing -}
- happyAccept i tk st
- n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+ case action of
+ 0# -> {- nothing -}
+ happyFail i tk st
+ -1# -> {- nothing -}
+ happyAccept i tk st
+ n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
- (happyReduceArr Happy_Data_Array.! rule) i
tk st
- where rule = (Happy_GHC_Exts.I#
((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# ::
Happy_GHC_Exts.Int#))))))
- n -> {- nothing -}
+ (happyReduceArr
Happy_Data_Array.! rule) i tk st
+ where rule =
(Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# ::
Happy_GHC_Exts.Int#))))))
+ n -> {- nothing -}
- happyShift new_state i tk st
+ happyShift new_state i tk st
where new_state = (n Happy_GHC_Exts.-#
(1# :: Happy_GHC_Exts.Int#))
where off = indexShortOffAddr happyActOffsets st
off_i = (off Happy_GHC_Exts.+# i)
- check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
+ check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
then EQ(indexShortOffAddr happyCheck off_i, i)
- else False
+ else False
action
| check = indexShortOffAddr happyTable off_i
| otherwise = indexShortOffAddr happyDefActions st
indexShortOffAddr (HappyA# arr) off =
- Happy_GHC_Exts.narrow16Int# i
+ Happy_GHC_Exts.narrow16Int# i
where
i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or#
(Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord#
(Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
@@ -448,7 +450,7 @@
-----------------------------------------------------------------------------
-- HappyState data type (not arrays)
-{-# LINE 169 "templates/GenericTemplate.hs" #-}
+{-# LINE 170 "templates/GenericTemplate.hs" #-}
-----------------------------------------------------------------------------
-- Shifting a token
@@ -490,9 +492,9 @@
= happyFail 0# tk st sts stk
happyReduce k nt fn j tk st sts stk
= case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
- sts1@((HappyCons (st1@(action)) (_))) ->
- let r = fn stk in -- it doesn't hurt to always seq here...
- happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+ sts1@((HappyCons (st1@(action)) (_))) ->
+ let r = fn stk in -- it doesn't hurt to always seq here...
+ happyDoSeq r (happyGoto nt j tk st1 sts1 r)
happyMonadReduce k nt fn 0# tk st sts stk
= happyFail 0# tk st sts stk
@@ -544,7 +546,7 @@
-- parse error if we are in recovery and we fail again
happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i))
-> i }) in
--- trace "failing" $
+-- trace "failing" $
happyError_ i tk
{- We don't need state discarding for our restricted implementation of
@@ -553,16 +555,16 @@
-- discard a state
happyFail 0# tk old_st (HappyCons ((action)) (sts))
- (saved_tok `HappyStk` _
`HappyStk` stk) =
--- trace ("discarding state, depth " ++ show (length stk)) $
- happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+ (saved_tok `HappyStk` _
`HappyStk` stk) =
+-- trace ("discarding state, depth " ++ show (length stk)) $
+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
-}
-- Enter error recovery: generate an error token,
-- save the old token and carry on.
happyFail i tk (action) sts stk =
-- trace "entering error recovery" $
- happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce#
(Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce#
(Happy_GHC_Exts.I# (i))) `HappyStk` stk)
-- Internal happy errors:
@@ -580,9 +582,9 @@
-----------------------------------------------------------------------------
-- Seq-ing. If the --strict flag is given, then Happy emits
--- happySeq = happyDoSeq
+-- happySeq = happyDoSeq
-- otherwise it emits
--- happySeq = happyDontSeq
+-- happySeq = happyDontSeq
happyDoSeq, happyDontSeq :: a -> b -> b
happyDoSeq a b = a `seq` b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/dist/build/happy/happy-tmp/Parser.hs
new/happy-1.19.5/dist/build/happy/happy-tmp/Parser.hs
--- old/happy-1.19.4/dist/build/happy/happy-tmp/Parser.hs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/dist/build/happy/happy-tmp/Parser.hs 2015-01-06
22:04:19.000000000 +0100
@@ -7,8 +7,9 @@
import Lexer
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
+import Control.Applicative(Applicative(..))
--- parser produced by Happy Version 1.19.0
+-- parser produced by Happy Version 1.19.4
newtype HappyAbsSyn = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
@@ -739,6 +740,7 @@
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and
a clang-compiled alex.
#if __GLASGOW_HASKELL__ > 706
#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
@@ -748,7 +750,7 @@
#define GTE(n,m) (n Happy_GHC_Exts.>=# m)
#define EQ(n,m) (n Happy_GHC_Exts.==# m)
#endif
-{-# LINE 45 "templates/GenericTemplate.hs" #-}
+{-# LINE 46 "templates/GenericTemplate.hs" #-}
data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
@@ -757,11 +759,11 @@
-{-# LINE 66 "templates/GenericTemplate.hs" #-}
+{-# LINE 67 "templates/GenericTemplate.hs" #-}
-{-# LINE 76 "templates/GenericTemplate.hs" #-}
+{-# LINE 77 "templates/GenericTemplate.hs" #-}
-{-# LINE 85 "templates/GenericTemplate.hs" #-}
+{-# LINE 86 "templates/GenericTemplate.hs" #-}
infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)
@@ -778,9 +780,9 @@
-- parse (a %partial parser). We must ignore the saved token on the top of
-- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
- happyReturn1 ans
+ happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
- (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+ (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
-----------------------------------------------------------------------------
-- Arrays only: do the next action
@@ -788,35 +790,35 @@
happyDoAction i tk st
- = {- nothing -}
+ = {- nothing -}
- case action of
- 0# -> {- nothing -}
- happyFail i tk st
- -1# -> {- nothing -}
- happyAccept i tk st
- n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+ case action of
+ 0# -> {- nothing -}
+ happyFail i tk st
+ -1# -> {- nothing -}
+ happyAccept i tk st
+ n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
- (happyReduceArr Happy_Data_Array.! rule) i
tk st
- where rule = (Happy_GHC_Exts.I#
((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# ::
Happy_GHC_Exts.Int#))))))
- n -> {- nothing -}
+ (happyReduceArr
Happy_Data_Array.! rule) i tk st
+ where rule =
(Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# ::
Happy_GHC_Exts.Int#))))))
+ n -> {- nothing -}
- happyShift new_state i tk st
+ happyShift new_state i tk st
where new_state = (n Happy_GHC_Exts.-#
(1# :: Happy_GHC_Exts.Int#))
where off = indexShortOffAddr happyActOffsets st
off_i = (off Happy_GHC_Exts.+# i)
- check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
+ check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
then EQ(indexShortOffAddr happyCheck off_i, i)
- else False
+ else False
action
| check = indexShortOffAddr happyTable off_i
| otherwise = indexShortOffAddr happyDefActions st
indexShortOffAddr (HappyA# arr) off =
- Happy_GHC_Exts.narrow16Int# i
+ Happy_GHC_Exts.narrow16Int# i
where
i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or#
(Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord#
(Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
@@ -835,7 +837,7 @@
-----------------------------------------------------------------------------
-- HappyState data type (not arrays)
-{-# LINE 169 "templates/GenericTemplate.hs" #-}
+{-# LINE 170 "templates/GenericTemplate.hs" #-}
-----------------------------------------------------------------------------
-- Shifting a token
@@ -877,9 +879,9 @@
= happyFail 0# tk st sts stk
happyReduce k nt fn j tk st sts stk
= case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
- sts1@((HappyCons (st1@(action)) (_))) ->
- let r = fn stk in -- it doesn't hurt to always seq here...
- happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+ sts1@((HappyCons (st1@(action)) (_))) ->
+ let r = fn stk in -- it doesn't hurt to always seq here...
+ happyDoSeq r (happyGoto nt j tk st1 sts1 r)
happyMonadReduce k nt fn 0# tk st sts stk
= happyFail 0# tk st sts stk
@@ -931,7 +933,7 @@
-- parse error if we are in recovery and we fail again
happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i))
-> i }) in
--- trace "failing" $
+-- trace "failing" $
happyError_ i tk
{- We don't need state discarding for our restricted implementation of
@@ -940,16 +942,16 @@
-- discard a state
happyFail 0# tk old_st (HappyCons ((action)) (sts))
- (saved_tok `HappyStk` _
`HappyStk` stk) =
--- trace ("discarding state, depth " ++ show (length stk)) $
- happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+ (saved_tok `HappyStk` _
`HappyStk` stk) =
+-- trace ("discarding state, depth " ++ show (length stk)) $
+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
-}
-- Enter error recovery: generate an error token,
-- save the old token and carry on.
happyFail i tk (action) sts stk =
-- trace "entering error recovery" $
- happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce#
(Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce#
(Happy_GHC_Exts.I# (i))) `HappyStk` stk)
-- Internal happy errors:
@@ -967,9 +969,9 @@
-----------------------------------------------------------------------------
-- Seq-ing. If the --strict flag is given, then Happy emits
--- happySeq = happyDoSeq
+-- happySeq = happyDoSeq
-- otherwise it emits
--- happySeq = happyDontSeq
+-- happySeq = happyDontSeq
happyDoSeq, happyDontSeq :: a -> b -> b
happyDoSeq a b = a `seq` b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/doc/happy.xml
new/happy-1.19.5/doc/happy.xml
--- old/happy-1.19.4/doc/happy.xml 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/doc/happy.xml 2015-01-06 22:04:19.000000000 +0100
@@ -3970,6 +3970,94 @@
</listitem>
</itemizedlist>
</sect1>
+
+ <sect1 id="sec-monad-alex">
+ <title>Basic monadic Happy use with Alex</title>
+ <indexterm>
+ <primary><application>Alex</application></primary>
+ <secondary>monad</secondary>
+ </indexterm>
+
+ <para>
+ <application>Alex</application> lexers are often used by
+ <application>Happy</application> parsers, for example in
+ GHC. While many of these applications are quite sophisticated,
+ it is still quite useful to combine the basic
+ <application>Happy</application> <literal>%monad</literal>
+ directive with the <application>Alex</application>
+ <literal>monad</literal> wrapper. By using monads for both,
+ the resulting parser and lexer can handle errors far more
+ gracefully than by throwing an exception.
+ </para>
+
+ <para>
+ The most straightforward way to use a monadic
+ <application>Alex</application> lexer is to simply use the
+ <literal>Alex</literal> monad as the
+ <application>Happy</application> monad:
+ </para>
+
+ <example><title>Lexer.x</title>
+<programlisting>{
+module Lexer where
+}
+
+%wrapper "monad"
+
+tokens :-
+ ...
+
+{
+data Token = ... | EOF
+ deriving (Eq, Show)
+
+alexEOF = return EOF
+}</programlisting></example>
+ <example><title>Parser.y</title>
+<programlisting>{
+module Parser where
+
+import Lexer
+}
+
+%name pFoo
+%tokentype { Token }
+%error { parseError }
+%monad { Alex } { >>= } { return }
+%lexer { lexer } { EOF }
+
+%token
+ ...
+
+%%
+ ...
+
+parseError :: Token -> Alex a
+parseError _ = do
+ ((AlexPn _ line column), _, _, _) <- alexGetInput
+ alexError ("parse error at line " ++ (show line) ++ ", column " ++ (show
column))
+
+lexer :: (Token -> Alex a) -> Alex a
+lexer = (alexMonadScan >>=)
+}</programlisting></example>
+
+ <para>
+ We can then run the finished parser in the
+ <literal>Alex</literal> monad using
+ <literal>runAlex</literal>, which returns an
+ <literal>Either</literal> value rather than throwing an
+ exception in case of a parse or lexical error:
+ </para>
+
+<programlisting>
+import qualified Lexer as Lexer
+import qualified Parser as Parser
+
+parseFoo :: String -> Either String Foo
+parseFoo s = Lexer.runAlex s Parser.pFoo
+</programlisting>
+
+ </sect1>
</chapter>
<index/>
</book>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/Makefile.defs
new/happy-1.19.5/examples/glr/Makefile.defs
--- old/happy-1.19.4/examples/glr/Makefile.defs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/examples/glr/Makefile.defs 2015-01-06 22:04:19.000000000
+0100
@@ -1,7 +1,7 @@
.SUFFIXES: .y .hs .exe
OPT=
-GHC=ghc -I../common -i../common ${OPT}
+GHC=ghc -rtsopts -I../common -i../common ${OPT}
# -dshow-passes
HAPPY=happy
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/bio-eg/Bio.y
new/happy-1.19.5/examples/glr/bio-eg/Bio.y
--- old/happy-1.19.4/examples/glr/bio-eg/Bio.y 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/examples/glr/bio-eg/Bio.y 2015-01-06 22:04:19.000000000
+0100
@@ -3,7 +3,7 @@
-- (c) 2004 University of Durham, Julia Fischer
-- Portions of the grammar are derived from work by Leung/Mellish/Robertson
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/bio-eg/Main.lhs
new/happy-1.19.5/examples/glr/bio-eg/Main.lhs
--- old/happy-1.19.4/examples/glr/bio-eg/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/bio-eg/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import Bio
> import qualified Data.Map as Map
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-eval/Expr.y
new/happy-1.19.5/examples/glr/expr-eval/Expr.y
--- old/happy-1.19.4/examples/glr/expr-eval/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-eval/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-eval/Main.lhs
new/happy-1.19.5/examples/glr/expr-eval/Main.lhs
--- old/happy-1.19.4/examples/glr/expr-eval/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-eval/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-monad/Expr.y
new/happy-1.19.5/examples/glr/expr-monad/Expr.y
--- old/happy-1.19.4/examples/glr/expr-monad/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-monad/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-monad/Main.lhs
new/happy-1.19.5/examples/glr/expr-monad/Main.lhs
--- old/happy-1.19.4/examples/glr/expr-monad/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-monad/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,6 @@
> module Main where
-> import System(getArgs)
+> import System.IO.Error(catchIOError)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
@@ -16,7 +17,7 @@
> putStrLn $ "Ok " ++ show r ++ "\n"
> ++ unlines (map show $
> Map.toList f)
> let ms = decode (forest_lookup f) r ::[IO Int]
-> mapM_ (\ma -> catch ma (\_ -> return 0) >>= print)
ms
+> mapM_ (\ma -> catchIOError ma (\_ -> return 0) >>=
print) ms
> toDV $ Map.toList f
> ParseEOF f -> do
> putStrLn $ "Premature end of input:\n"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-tree/Expr.y
new/happy-1.19.5/examples/glr/expr-tree/Expr.y
--- old/happy-1.19.4/examples/glr/expr-tree/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-tree/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
import Tree
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/expr-tree/Main.lhs
new/happy-1.19.5/examples/glr/expr-tree/Main.lhs
--- old/happy-1.19.4/examples/glr/expr-tree/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/expr-tree/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/hidden-leftrec/Expr.y
new/happy-1.19.5/examples/glr/hidden-leftrec/Expr.y
--- old/happy-1.19.4/examples/glr/hidden-leftrec/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/hidden-leftrec/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/hidden-leftrec/Main.lhs
new/happy-1.19.5/examples/glr/hidden-leftrec/Main.lhs
--- old/happy-1.19.4/examples/glr/hidden-leftrec/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/hidden-leftrec/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/highly-ambiguous/Expr.y
new/happy-1.19.5/examples/glr/highly-ambiguous/Expr.y
--- old/happy-1.19.4/examples/glr/highly-ambiguous/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/highly-ambiguous/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/highly-ambiguous/Main.lhs
new/happy-1.19.5/examples/glr/highly-ambiguous/Main.lhs
--- old/happy-1.19.4/examples/glr/highly-ambiguous/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/highly-ambiguous/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/highly-ambiguous/Makefile
new/happy-1.19.5/examples/glr/highly-ambiguous/Makefile
--- old/happy-1.19.4/examples/glr/highly-ambiguous/Makefile 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/highly-ambiguous/Makefile 2015-01-06
22:04:19.000000000 +0100
@@ -7,7 +7,6 @@
NUM=20
run : expr
./expr +RTS -s -RTS ${NUM} | grep ^Ok
- egrep '' expr.stat > out${NUM}
run30 :
make run NUM=30
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/nlp/English.y
new/happy-1.19.5/examples/glr/nlp/English.y
--- old/happy-1.19.4/examples/glr/nlp/English.y 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/examples/glr/nlp/English.y 2015-01-06 22:04:19.000000000
+0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/nlp/Main.lhs
new/happy-1.19.5/examples/glr/nlp/Main.lhs
--- old/happy-1.19.4/examples/glr/nlp/Main.lhs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/examples/glr/nlp/Main.lhs 2015-01-06 22:04:19.000000000
+0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import English
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/packing/Expr.y
new/happy-1.19.5/examples/glr/packing/Expr.y
--- old/happy-1.19.4/examples/glr/packing/Expr.y 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/packing/Expr.y 2015-01-06
22:04:19.000000000 +0100
@@ -1,6 +1,6 @@
{
-- only list imports here
-import Char
+import Data.Char
}
%tokentype { Token }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/examples/glr/packing/Main.lhs
new/happy-1.19.5/examples/glr/packing/Main.lhs
--- old/happy-1.19.4/examples/glr/packing/Main.lhs 2014-07-07
13:05:53.000000000 +0200
+++ new/happy-1.19.5/examples/glr/packing/Main.lhs 2015-01-06
22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
> module Main where
-> import System(getArgs)
+> import System.Environment(getArgs)
> import Data.Maybe(fromJust)
> import qualified Data.Map as Map
> import Expr
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/happy.cabal new/happy-1.19.5/happy.cabal
--- old/happy-1.19.4/happy.cabal 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/happy.cabal 2015-01-06 22:04:19.000000000 +0100
@@ -1,5 +1,5 @@
name: happy
-version: 1.19.4
+version: 1.19.5
license: BSD3
license-file: LICENSE
copyright: (c) Andy Gill, Simon Marlow
@@ -125,18 +125,16 @@
location: http://github.com/simonmar/happy.git
flag small_base
- description: Choose the new smaller, split-up base package.
+ description: Deprecated. Does nothing.
executable happy
hs-source-dirs: src
main-is: Main.lhs
- if flag(small_base)
- build-depends: base >= 2.1, array, containers
- else
- build-depends: base >= 1.0 && < 2.1
-
- build-depends: base < 5, mtl >= 1.0
+ build-depends: base < 5,
+ array,
+ containers,
+ mtl >= 1.0
extensions: CPP, MagicHash, FlexibleContexts
ghc-options: -Wall -fno-warn-type-defaults
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/AttrGrammar.lhs
new/happy-1.19.5/src/AttrGrammar.lhs
--- old/happy-1.19.4/src/AttrGrammar.lhs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/src/AttrGrammar.lhs 2015-01-06 22:04:19.000000000
+0100
@@ -65,12 +65,12 @@
> type Pfunc a = String -> Int -> ParseResult a
> agLexAll :: P [AgToken]
-> agLexAll = P $ aux []
-> where aux toks [] _ = OkP (reverse toks)
+> agLexAll = mkP $ aux []
+> where aux toks [] _ = Right (reverse toks)
> aux toks s l = agLexer' (\t -> aux (t:toks)) s l
> agLexer :: (AgToken -> P a) -> P a
-> agLexer m = P $ agLexer' (\x -> runP (m x))
+> agLexer m = mkP $ agLexer' (\x -> runP (m x))
> agLexer' :: (AgToken -> Pfunc a) -> Pfunc a
> agLexer' cont [] = cont AgTok_EOF []
@@ -103,5 +103,5 @@
> agLexAttribute :: (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
> agLexAttribute cont k ('.':x:xs)
> | isLower x = let (ident,rest) = span (\c -> isAlphaNum c || c ==
> '\'') xs in cont (k (x:ident)) rest
-> | otherwise = \_ -> FailP "bad attribute identifier"
+> | otherwise = \_ -> Left "bad attribute identifier"
> agLexAttribute cont k rest = cont (k "") rest
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/First.lhs
new/happy-1.19.5/src/First.lhs
--- old/happy-1.19.4/src/First.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/First.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -15,19 +15,11 @@
\subsection{Utilities}
> joinSymSets :: (a -> NameSet) -> [a] -> NameSet
-> joinSymSets f = foldr
-> (\ h b -> let
-> h' = f h
-> in
-> if incEmpty h'
-> then Set.filter (not. isEmpty) h' `Set.union` b
-> else h')
-> (Set.singleton epsilonTok)
-
-Does the Set include the $\epsilon$ symbol ?
-
-> incEmpty :: NameSet -> Bool
-> incEmpty set = any isEmpty (Set.toAscList set)
+> joinSymSets f = foldr go (Set.singleton epsilonTok) . map f
+> where
+> go h b
+> | Set.member epsilonTok h = Set.delete epsilonTok h `Set.union` b
+> | otherwise = h
\subsection{Implementation of FIRST}
@@ -37,9 +29,7 @@
> , lookupProdsOfName = prodsOfName
> , non_terminals = nts
> })
-> = joinSymSets (\ h -> case lookup h env of
-> Nothing -> Set.singleton h
-> Just ix -> ix)
+> = joinSymSets (\ h -> maybe (Set.singleton h) id (lookup h env) )
> where
> env = mkClosure (==) (getNext fst_term prodNo prodsOfName)
> [ (name,Set.empty) | name <- nts ]
@@ -50,14 +40,11 @@
> [ (nm, next nm) | (nm,_) <- env ]
> where
> fn t | t == errorTok || t >= fst_term = Set.singleton t
-> fn x = case lookup x env of
-> Just t -> t
-> Nothing -> error "attempted FIRST(e) :-("
+> fn x = maybe (error "attempted FIRST(e) :-(") id (lookup x env)
> next :: Name -> NameSet
> next t | t >= fst_term = Set.singleton t
-> next n =
-> foldb Set.union
+> next n = Set.unions
> [ joinSymSets fn (snd4 (prodNo rl)) |
> rl <- prodsOfName n ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/GenUtils.lhs
new/happy-1.19.5/src/GenUtils.lhs
--- old/happy-1.19.4/src/GenUtils.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/GenUtils.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -6,28 +6,8 @@
> module GenUtils (
-> partition', tack,
-> assocMaybeErr,
-> arrElem,
-> memoise,
-> returnMaybe,handleMaybe, findJust,
-> MaybeErr(..),
-> mapMaybe,
-> maybeMap,
-> joinMaybe,
> mkClosure,
-> foldb,
-> listArray',
-> cjustify,
-> ljustify,
-> rjustify,
-> space,
-> copy,
> combinePairs,
-> --trace, -- re-export it
-> fst3,
-> snd3,
-> thd3,
> mapDollarDollar,
> str, char, nl, brack, brack',
> interleave, interleave',
@@ -35,33 +15,11 @@
> ) where
> import Data.Char (isAlphaNum)
+> import Data.Ord (comparing)
> import Data.List
-> import Data.Ix ( Ix(..) )
-> import Data.Array ( Array, listArray, array, (!) )
%------------------------------------------------------------------------------
-Here are two defs that everyone seems to define ...
-HBC has it in one of its builtin modules
-
-> mapMaybe :: (a -> Maybe b) -> [a] -> [b]
-> mapMaybe _ [] = []
-> mapMaybe f (a:r) = case f a of
-> Nothing -> mapMaybe f r
-> Just b -> b : mapMaybe f r
-
-> maybeMap :: (a -> b) -> Maybe a -> Maybe b
-> maybeMap f (Just a) = Just (f a)
-> maybeMap _ Nothing = Nothing
-
-> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
-> joinMaybe _ Nothing Nothing = Nothing
-> joinMaybe _ (Just g) Nothing = Just g
-> joinMaybe _ Nothing (Just g) = Just g
-> joinMaybe f (Just g) (Just h) = Just (f g h)
-
-> data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Show)
-
@mkClosure@ makes a closure, when given a comparison and iteration loop.
Be careful, because if the functional always makes the object different,
This will never terminate.
@@ -73,107 +31,18 @@
> match (_:c) = match c
> match [] = error "Can't happen: match []"
-> foldb :: (a -> a -> a) -> [a] -> a
-> foldb _ [] = error "can't reduce an empty list using foldb"
-> foldb _ [x] = x
-> foldb f l = foldb f (foldb' l)
-> where
-> foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs
-> foldb' (x:y:xs) = f x y : foldb' xs
-> foldb' xs = xs
-
-> returnMaybe :: a -> Maybe a
-> returnMaybe = Just
-
-> handleMaybe :: Maybe a -> Maybe a -> Maybe a
-> handleMaybe m k = case m of
-> Nothing -> k
-> _ -> m
-
-> findJust :: (a -> Maybe b) -> [a] -> Maybe b
-> findJust f = foldr handleMaybe Nothing . map f
-
Gofer-like stuff:
-> fst3 :: (a, b, c) -> a
-> fst3 (a,_,_) = a
-> snd3 :: (a, b, c) -> b
-> snd3 (_,a,_) = a
-> thd3 :: (a, b, c) -> c
-> thd3 (_,_,a) = a
-
-> cjustify, ljustify, rjustify :: Int -> String -> String
-> cjustify n s = space halfm ++ s ++ space (m - halfm)
-> where m = n - length s
-> halfm = m `div` 2
-> ljustify n s = s ++ space (max 0 (n - length s))
-> rjustify n s = space (n - length s) ++ s
-
-> space :: Int -> String
-> space n = copy n ' '
-
-> copy :: Int -> a -> [a] -- make list of n copies of x
-> copy n x = take n xs where xs = x:xs
-
-> partition' :: (Eq b) => (a -> b) -> [a] -> [[a]]
-> partition' _ [] = []
-> partition' _ [x] = [[x]]
-> partition' f (x:x':xs) | f x == f x'
-> = tack x (partition' f (x':xs))
-> | otherwise
-> = [x] : partition' f (x':xs)
-
-> tack :: a -> [[a]] -> [[a]]
-> tack x xss = (x : head xss) : tail xss
-
> combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
> combinePairs xs =
-> combine [ (a,[b]) | (a,b) <- sortBy (\ (a,_) (b,_) -> compare a b) xs]
+> combine [ (a,[b]) | (a,b) <- sortBy (comparing fst) xs]
> where
> combine [] = []
> combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)
> combine (a:r) = a : combine r
>
-> assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String
-> assocMaybeErr env k = case [ val | (key,val) <- env, k == key] of
-> [] -> Failed "assoc: "
-> (val:_) -> Succeeded val
->
-
-Now some utilties involving arrays. Here is a version of @elem@ that
-uses partial application to optimise lookup.
-
-> arrElem :: (Ix a, Ord a) => [a] -> a -> Bool
-> arrElem obj = \x -> inRange size x && arr ! x
-> where
-> obj' = sort obj
-> size = (head obj',last obj')
-> arr = listArray size [ i `elem` obj | i <- range size ]
-
-
-You can use this function to simulate memoisation. For example:
-
- > fib = memoise (0,100) fib'
- > where
- > fib' 0 = 0
- > fib' 1 = 0
- > fib' n = fib (n-1) + fib (n-2)
-
-will give a very efficent variation of the fib function.
-
-
-> memoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b
-> memoise bds f = (!) arr
-> where arr = array bds [ (t, f t) | t <- range bds ]
-
-> listArray' :: (Int,Int) -> [a] -> Array Int a
-> listArray' (low,up) elems =
-> if length elems /= up-low+1 then error "wibble" else
-> listArray (low,up) elems
-
-
Replace $$ with an arbitrary string, being careful to avoid ".." and '.'.
@@ -220,5 +89,3 @@
> brack s = str ('(' : s) . char ')'
> brack' :: (String -> String) -> String -> String
> brack' s = char '(' . s . char ')'
-
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/Grammar.lhs
new/happy-1.19.5/src/Grammar.lhs
--- old/happy-1.19.4/src/Grammar.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/Grammar.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -7,7 +7,7 @@
Here is our mid-section datatype
> module Grammar (
-> Name, isEmpty,
+> Name,
>
> Production, Grammar(..), mangler,
>
@@ -159,10 +159,6 @@
> errorTok = 1
> epsilonTok = 0
-> isEmpty :: Name -> Bool
-> isEmpty n | n == epsilonTok = True
-> | otherwise = False
-
-----------------------------------------------------------------------------
-- The Mangler
@@ -174,10 +170,10 @@
> addErr :: ErrMsg -> M ()
> addErr e = tell [e]
-> mangler :: FilePath -> AbsSyn -> MaybeErr Grammar [ErrMsg]
+> mangler :: FilePath -> AbsSyn -> Either [ErrMsg] Grammar
> mangler file abssyn
-> | null errs = Succeeded g
-> | otherwise = Failed errs
+> | null errs = Right g
+> | otherwise = Left errs
> where (g, errs) = runWriter (manglerM file abssyn)
> manglerM :: FilePath -> AbsSyn -> M Grammar
@@ -325,7 +321,7 @@
> lookup_prods _ = error "lookup_prods"
>
> productions' = start_prods ++ concat rules2
-> prod_array = listArray' (0,length productions' - 1) productions'
+> prod_array = listArray (0,length productions' - 1) productions'
> -- in
> return (Grammar {
@@ -395,9 +391,9 @@
first we need to parse the body of the code block
> case runP agParser code 0 of
-> FailP msg -> do addErr ("error in attribute grammar rules: "++msg)
-> return ("",[])
-> OkP rules ->
+> Left msg -> do addErr ("error in attribute grammar rules: "++msg)
+> return ("",[])
+> Right rules ->
now we break the rules into three lists, one for synthesized attributes,
one for inherited attributes, and one for conditionals
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/Info.lhs
new/happy-1.19.5/src/Info.lhs
--- old/happy-1.19.4/src/Info.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/Info.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -8,7 +8,7 @@
> import Paths_happy ( version )
> import LALR ( Lr0Item(..) )
-> import GenUtils ( str, interleave, interleave', ljustify )
+> import GenUtils ( str, interleave, interleave' )
> import Data.Set ( Set )
> import qualified Data.Set as Set hiding ( Set )
> import Grammar
@@ -202,6 +202,9 @@
> showName = str . nameOf
> showJName j = str . ljustify j . nameOf
+> ljustify :: Int -> String -> String
+> ljustify n s = s ++ replicate (max 0 (n - length s)) ' '
+
> ljuststr :: Int -> (String -> String) -> String -> String
> ljuststr n s = str (ljustify n (s ""))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/LALR.lhs
new/happy-1.19.5/src/LALR.lhs
--- old/happy-1.19.4/src/LALR.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/LALR.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -18,16 +18,18 @@
> import NameSet ( NameSet )
> import Grammar
+> import Control.Monad (guard)
> import Control.Monad.ST
> import Data.Array.ST
> import Data.Array as Array
> import Data.List (nub)
+> import Data.Maybe (listToMaybe, maybeToList)
> unionMap :: (Ord b) => (a -> Set b) -> Set a -> Set b
-> unionMap f = Set.fold (Set.union . f) Set.empty
+> unionMap f = Set.foldr (Set.union . f) Set.empty
> unionNameMap :: (Name -> NameSet) -> NameSet -> NameSet
-> unionNameMap f = NameSet.fold (NameSet.union . f) NameSet.empty
+> unionNameMap f = NameSet.foldr (NameSet.union . f) NameSet.empty
This means rule $a$, with dot at $b$ (all starting at 0)
@@ -45,9 +47,7 @@
> precalcClosure0 :: Grammar -> Name -> RuleList
> precalcClosure0 g =
-> \n -> case lookup n info' of
-> Nothing -> []
-> Just c -> c
+> \n -> maybe [] id (lookup n info')
> where
>
> info' :: [(Name, RuleList)]
@@ -64,16 +64,14 @@
> followNT f rule =
> case findRule g rule 0 of
> Just nt | nt >= firstStartTok && nt < fst_term ->
-> case lookup nt f of
-> Just rs -> rs
-> Nothing -> error "followNT"
+> maybe (error "followNT") id (lookup nt f)
> _ -> NameSet.empty
> nts = non_terminals g
> fst_term = first_term g
> closure0 :: Grammar -> (Name -> RuleList) -> Set Lr0Item -> Set Lr0Item
-> closure0 g closureOfNT set = Set.fold addRules Set.empty set
+> closure0 g closureOfNT set = Set.foldr addRules Set.empty set
> where
> fst_term = first_term g
> addRules rule set' = Set.union (Set.fromList (rule : closureOfRule
> rule)) set'
@@ -102,16 +100,14 @@
> new_old_items
> fn :: Lr1Item -> [Lr1Item]
-> fn (Lr1 rule dot as) =
-> case lookupProdNo g rule of { (_name,lhs,_,_) ->
-> case drop dot lhs of
+> fn (Lr1 rule dot as) = case drop dot lhs of
> (b:beta) | b >= firstStartTok && b < fst_term ->
> let terms = unionNameMap
> (\a -> first (beta ++ [a])) as
> in
> [ (Lr1 rule' 0 terms) | rule' <- lookupProdsOfName
> g b ]
> _ -> []
-> }
+> where (_name,lhs,_,_) = lookupProdNo g rule
Subtract the first set of items from the second.
@@ -184,7 +180,7 @@
> genLR0items :: Grammar -> (Name -> RuleList) -> [ItemSetWithGotos]
> genLR0items g precalcClosures
-> = fst (mkClosure (\(_old,new) _ -> null new)
+> = fst (mkClosure (\(_,new) _ -> null new)
> addItems
> (([],startRules)))
> where
@@ -289,34 +285,33 @@
> start_spont = [ (start, (Lr0 start 0),
> NameSet.singleton (startLookahead gram partial))
> | (start, (_,_,_,partial)) <-
-> zip [ 0 .. length start_info - 1] start_info]
+> zip [0..] start_info]
> propLAItem :: Lr0Item -> ([(Int, Lr0Item, NameSet)], [(Lr0Item, Int,
> Lr0Item)])
> propLAItem item@(Lr0 rule dot) = (spontaneous, propagated)
> where
+> lookupGoto msg x = maybe (error msg) id (lookup x goto)
> j = closure1 gram first [Lr1 rule dot (NameSet.singleton
> dummyTok)]
> spontaneous :: [(Int, Lr0Item, NameSet)]
-> spontaneous = concat [
-> (case findRule gram rule' dot' of
-> Nothing -> []
-> Just x -> case lookup x goto of
-> Nothing -> error "spontaneous"
-> Just k ->
-> case NameSet.filter (/= dummyTok) ts of
-> ts' | NameSet.null ts' -> []
-> | otherwise -> [(k, Lr0 rule'
(dot' + 1), ts')])
-> | (Lr1 rule' dot' ts) <- j ]
+> spontaneous = do
+> (Lr1 rule' dot' ts) <- j
+> let ts' = NameSet.delete dummyTok ts
+> guard (not $ NameSet.null ts')
+> maybeToList $ do r <- findRule gram rule' dot'
+> return ( lookupGoto "spontaneous" r
+> , Lr0 rule' (dot' + 1)
+> , ts' )
> propagated :: [(Lr0Item, Int, Lr0Item)]
-> propagated = concat [
-> (case findRule gram rule' dot' of
-> Nothing -> []
-> Just x -> case lookup x goto of
-> Nothing -> error "propagated"
-> Just k -> [(item, k, Lr0 rule' (dot' + 1))])
-> | (Lr1 rule' dot' ts) <- j, dummyTok `elem`
(NameSet.toAscList ts) ]
+> propagated = do
+> (Lr1 rule' dot' ts) <- j
+> guard $ NameSet.member dummyTok ts
+> maybeToList $ do r <- findRule gram rule' dot'
+> return ( item
+> , lookupGoto "propagated" r
+> , Lr0 rule' (dot' + 1) )
The lookahead for a start rule depends on whether it was declared
with %name or %partial: a %name parser is assumed to parse the whole
@@ -338,11 +333,10 @@
> -> Array Int [(Lr0Item, NameSet)]
> calcLookaheads n_states spont prop
-> = runST (do
+> = runST $ do
> arr <- newArray (0,n_states) []
> propagate arr (foldr fold_lookahead [] spont)
> freeze arr
-> )
> where
> propagate :: STArray s Int [(Lr0Item, NameSet)]
@@ -364,11 +358,9 @@
> add_lookaheads :: STArray s Int [(Lr0Item, NameSet)]
> -> [(Int, Lr0Item, NameSet)]
> -> ST s ()
-> add_lookaheads _ [] = return ()
-> add_lookaheads arr ((i,item,s) : lookaheads) = do
-> las <- readArray arr i
-> writeArray arr i (add_lookahead item s las)
-> add_lookaheads arr lookaheads
+> add_lookaheads arr = mapM_ $ \(i,item,s)
+> -> do las <- readArray arr i
+> writeArray arr i (add_lookahead item s las)
> get_new :: STArray s Int [(Lr0Item, NameSet)]
> -> [(Int, Lr0Item, NameSet)]
@@ -391,9 +383,8 @@
> get_new' l [] new = l : new
> get_new' l@(i,item,s) ((item',s') : las) new
> | item == item' =
-> let s'' = NameSet.filter (\x -> not (NameSet.member x s')) s in
-> if NameSet.null s'' then new else
-> ((i,item,s''):new)
+> let s'' = s NameSet.\\ s' in
+> if NameSet.null s'' then new else (i,item,s'') : new
> | otherwise =
> get_new' l las new
@@ -405,52 +396,6 @@
> | i < i' = (i,item,s):m:las
> | otherwise = m : fold_lookahead l las
-Normal version:
-
-calcLookaheads
- :: Int -- number of states
- -> [(Int, Lr0Item, Set Name)] -- spontaneous lookaheads
- -> Array Int [(Lr0Item, Int, Lr0Item)] -- propagated lookaheads
- -> Array Int [(Lr0Item, Set Name)]
-
-calcLookaheads n_states spont prop
- = rebuildArray $ fst (mkClosure (\(_,new) _ -> null new) propagate
- ([], foldr addLookahead [] spont))
- where
-
- rebuildArray :: [(Int, Lr0Item, Set Name)] -> Array Int [(Lr0Item, Set
Name)]
- rebuildArray xs = accumArray (++) [] (0,n_states-1)
- [ (a, [(b,c)]) | (a,b,c) <- xs ]
-
- propagate (las,new) =
- let
- items = [ (i,item'',s) | (j,item,s) <- new,
- (item',i,item'') <- prop ! j,
- item == item' ]
- new_new = foldr (\i new -> getNew i las new) [] items
- new_las = foldr addLookahead las new
- in
- (new_las, new_new)
-
-addLookahead :: (Int,Lr0Item,Set Name) -> [(Int,Lr0Item,Set Name)]
- -> [(Int,Lr0Item,Set Name)]
-addLookahead l [] = [l]
-addLookahead l@(i,item,s) (m@(i',item',s'):las)
- | i == i' && item == item' = (i,item, s `Set.union` s'):las
- | i < i' = (i,item,s):m:las
- | otherwise = m : addLookahead l las
-
-getNew :: (Int,Lr0Item,Set Name) -> [(Int,Lr0Item,Set Name)]
- -> [(Int,Lr0Item,Set Name)] -> [(Int,Lr0Item,Set Name)]
-getNew l [] new = l:new
-getNew l@(i,item,s) (m@(i',item',s'):las) new
- | i == i' && item == item' =
- let s'' = filter (`notElem` s') s in
- if null s'' then new else
- ((i,item,s''):new)
- | i < i' = (i,item,s):new
- | otherwise = getNew l las new
-
-----------------------------------------------------------------------------
Merge lookaheads
@@ -467,12 +412,11 @@
> mergeIntoSet :: (Set Lr0Item, [(Name, Int)]) -> Int -> ([Lr1Item],
> [(Name, Int)])
> mergeIntoSet (items, goto) i
-> = (concat (map mergeIntoItem (Set.toAscList items)), goto)
+> = (map mergeIntoItem (Set.toAscList items), goto)
> where
-> mergeIntoItem :: Lr0Item -> [Lr1Item]
-> mergeIntoItem item@(Lr0 rule dot)
-> = [Lr1 rule dot la]
+> mergeIntoItem :: Lr0Item -> Lr1Item
+> mergeIntoItem item@(Lr0 rule dot) = Lr1 rule dot la
> where la = case [ s | (item',s) <- lookaheads ! i,
> item == item' ] of
> [] -> NameSet.empty
@@ -498,9 +442,7 @@
> gotoTable = listArray (0,length sets-1)
> [
> (array (fst_nonterm, fst_term-1) [
-> (n, case lookup n goto of
-> Nothing -> NoGoto
-> Just s -> Goto s)
+> (n, maybe NoGoto Goto (lookup n goto))
> | n <- non_terms,
> n >= fst_nonterm, n < fst_term ])
> | (_set,goto) <- sets ]
@@ -530,24 +472,20 @@
> possAction goto _set (Lr1 rule pos la) =
> case findRule g rule pos of
> Just t | t >= fst_term || t == errorTok ->
-> case lookup t goto of
-> Nothing -> []
-> Just j ->
-> case lookup t prios of
-> Nothing -> [ (t,LR'Shift j{-'-} No) ]
-> Just p -> [ (t,LR'Shift j{-'-} p) ]
+> let f j = (t,LR'Shift j p)
+> p = maybe No id (lookup t prios)
+> in map f $ maybeToList (lookup t goto)
> Nothing
> | isStartRule rule
> -> let (_,_,_,partial) = starts' !! rule in
> [ (startLookahead g partial, LR'Accept{-'-}) ]
> | otherwise
> -> case lookupProdNo g rule of
-> (_,_,_,p) -> zip (NameSet.toAscList la) (repeat
(LR'Reduce rule p))
+> (_,_,_,p) -> NameSet.toAscList la `zip` repeat
(LR'Reduce rule p)
> _ -> []
-> possActions goto coll =
-> (concat [ possAction goto coll item |
-> item <- closure1 g first coll ])
+> possActions goto coll = do item <- closure1 g first coll
+> possAction goto coll item
These comments are now out of date! /JS
@@ -590,7 +528,7 @@
> | x == x' = LR'Multiple (nub $ as ++ bs) x
> -- merge dropped reductions for identical action
-> res (LR'Multiple as x) (LR'Multiple bs x')
+> | otherwise
> = case res x x' of
> LR'Multiple cs a
> | a == x -> LR'Multiple (nub $ x' : as ++ bs ++ cs) x
@@ -655,8 +593,5 @@
-----------------------------------------------------------------------------
> findRule :: Grammar -> Int -> Int -> Maybe Name
-> findRule g rule dot =
-> case lookupProdNo g rule of
-> (_,lhs,_,_) -> case drop dot lhs of
-> (a:_) -> Just a
-> _ -> Nothing
+> findRule g rule dot = listToMaybe (drop dot lhs)
+> where (_,lhs,_,_) = lookupProdNo g rule
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/Lexer.lhs
new/happy-1.19.5/src/Lexer.lhs
--- old/happy-1.19.4/src/Lexer.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/Lexer.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -71,7 +71,7 @@
ToDo: proper text instance here, for use in parser error messages.
> lexer :: (Token -> P a) -> P a
-> lexer cont = P lexer'
+> lexer cont = mkP lexer'
> where lexer' "" = returnToken cont TokenEOF ""
> lexer' ('-':'-':r) = lexer' (dropWhile (/= '\n') r)
> lexer' ('{':'-':r) = \line -> lexNestedComment line lexer' r line
@@ -218,8 +218,8 @@
> || c == '_'
> lexReadSingleChar :: String -> (String -> String -> a) -> a
-> lexReadSingleChar (c:'\'':r) fn = fn (c:"'") r
> lexReadSingleChar ('\\':c:'\'':r) fn = fn ('\\':c:"'") r
+> lexReadSingleChar (c:'\'':r) fn = fn (c:"'") r
> lexReadSingleChar r fn = fn "" r
> lexReadChar :: String -> (String -> String -> a) -> a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/Main.lhs
new/happy-1.19.5/src/Main.lhs
--- old/happy-1.19.4/src/Main.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/Main.lhs 2015-01-06 22:04:19.000000000 +0100
@@ -12,7 +12,6 @@
> import Paths_happy
> import ParseMonad
-> import GenUtils
> import AbsSyn
> import Grammar
> import Parser
@@ -89,14 +88,14 @@
Parse, using bootstrapping parser.
> case coerceParser (runP ourParser file 1) of {
-> FailP err -> die (fl_name ++ ':' : err);
-> OkP abssyn@(AbsSyn hd _ _ tl) ->
+> Left err -> die (fl_name ++ ':' : err);
+> Right abssyn@(AbsSyn hd _ _ tl) ->
Mangle the syntax into something useful.
> case {-# SCC "Mangler" #-} (mangler fl_name abssyn) of {
-> Failed s -> die (unlines s ++ "\n");
-> Succeeded g ->
+> Left s -> die (unlines s ++ "\n");
+> Right g ->
#ifdef DEBUG
@@ -518,7 +517,8 @@
> "import qualified Debug.Trace as Happy_Debug_Trace\n"
> import_applicative :: String
-> import_applicative = "import Control.Applicative(Applicative(..))\n"
+> import_applicative = "import Control.Applicative(Applicative(..))\n" ++
+> "import Control.Monad (ap)\n"
------------------------------------------------------------------------------
Extract various command-line options.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/NameSet.hs
new/happy-1.19.5/src/NameSet.hs
--- old/happy-1.19.4/src/NameSet.hs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/NameSet.hs 2015-01-06 22:04:19.000000000 +0100
@@ -1,10 +1,8 @@
module NameSet (
- NameSet, null, member, empty, singleton,
- union, difference, filter, fold,
- fromList, toAscList
+ NameSet,
+ module Data.IntSet
) where
-import Prelude hiding ( null, filter )
import Data.IntSet
type NameSet = IntSet
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/ParseMonad.hs
new/happy-1.19.5/src/ParseMonad.hs
--- old/happy-1.19.4/src/ParseMonad.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/happy-1.19.5/src/ParseMonad.hs 2015-01-06 22:04:19.000000000 +0100
@@ -0,0 +1,15 @@
+module ParseMonad where
+
+import Control.Monad.Reader
+
+type ParseResult = Either String
+type P a = ReaderT (String, Int) ParseResult a
+
+mkP :: (String -> Int -> ParseResult a) -> P a
+mkP = ReaderT . uncurry
+
+runP :: P a -> String -> Int -> ParseResult a
+runP f s l = runReaderT f (s, l)
+
+lineP :: P Int
+lineP = asks snd >>= return
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/ParseMonad.lhs
new/happy-1.19.5/src/ParseMonad.lhs
--- old/happy-1.19.4/src/ParseMonad.lhs 2014-07-07 13:05:53.000000000 +0200
+++ new/happy-1.19.5/src/ParseMonad.lhs 1970-01-01 01:00:00.000000000 +0100
@@ -1,22 +0,0 @@
------------------------------------------------------------------------------
-The parser monad.
-
-(c) 2001 Simon Marlow
------------------------------------------------------------------------------
-
-> module ParseMonad where
-
-> data ParseResult a = OkP a | FailP String
-> newtype P a = P (String -> Int -> ParseResult a)
-> runP :: P a -> String -> Int -> ParseResult a
-> runP (P f) = f
-
-> lineP :: P Int
-> lineP = P $ \_ l -> OkP l
-
-> instance Monad P where
-> return m = P $ \ _ _ -> OkP m
-> m >>= k = P $ \s l -> case runP m s l of
-> OkP a -> runP (k a) s l
-> FailP err -> FailP err
-> fail s = P $ \ _ _ -> FailP s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/ProduceCode.lhs
new/happy-1.19.5/src/ProduceCode.lhs
--- old/happy-1.19.4/src/ProduceCode.lhs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/src/ProduceCode.lhs 2015-01-06 22:04:19.000000000
+0100
@@ -685,8 +685,8 @@
> . str "instance Functor HappyIdentity where\n"
> . str " fmap f (HappyIdentity a) = HappyIdentity (f a)\n\n"
> . str "instance Applicative HappyIdentity where\n"
-> . str " pure = return\n"
-> . str " a <*> b = (fmap id a) <*> b\n"
+> . str " pure = return\n"
+> . str " (<*>) = ap\n"
> . str "instance Monad HappyIdentity where\n"
> . str " return = HappyIdentity\n"
> . str " (HappyIdentity p) >>= q = q p\n\n"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/src/ProduceGLRCode.lhs
new/happy-1.19.5/src/ProduceGLRCode.lhs
--- old/happy-1.19.4/src/ProduceGLRCode.lhs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/src/ProduceGLRCode.lhs 2015-01-06 22:04:19.000000000
+0100
@@ -15,7 +15,7 @@
> ) where
> import Paths_happy ( version )
-> import GenUtils ( thd3, mapDollarDollar )
+> import GenUtils ( mapDollarDollar )
> import GenUtils ( str, char, nl, brack, brack', interleave, maybestr )
> import Grammar
> import Data.Array
@@ -118,7 +118,7 @@
> mkFiles basename tables start templdir header trailer (debug,options) g
> = do
> let debug_ext = if debug then "-debug" else ""
-> let (ext,imps,opts) = case thd3 options of
+> let (ext,imps,opts) = case ghcExts_opt of
> UseGhcExts is os -> ("-ghc", is, os)
> _ -> ("", "", "")
> base <- readFile (base_template templdir)
@@ -128,11 +128,13 @@
> lib <- readFile (lib_template templdir ++ ext ++ debug_ext)
> writeFile (basename ++ ".hs") (lib_content imps opts lib)
> where
+> (_,_,ghcExts_opt) = options
+
> mod_name = reverse $ takeWhile (`notElem` "\\/") $ reverse basename
> data_mod = mod_name ++ "Data"
> (sem_def, sem_info) = mkGSemType options g
-> table_text = mkTbls tables sem_info (thd3 options) g
+> table_text = mkTbls tables sem_info (ghcExts_opt) g
> header_parts = fmap (span (\x -> take 3 (dropWhile isSpace x) == "{-#")
> . lines)
@@ -695,6 +697,6 @@
---
> mkHappyVar :: Int -> String -> String
-> mkHappyVar n = showString "happy_var_" . shows n
+> mkHappyVar n = str "happy_var_" . shows n
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/happy-1.19.4/templates/GLR_Lib.hs
new/happy-1.19.5/templates/GLR_Lib.hs
--- old/happy-1.19.4/templates/GLR_Lib.hs 2014-07-07 13:05:53.000000000
+0200
+++ new/happy-1.19.5/templates/GLR_Lib.hs 2015-01-06 22:04:19.000000000
+0100
@@ -40,7 +40,6 @@
where
import Data.Char
-import System
import qualified Data.Map as Map
import Control.Monad (foldM)
