diff --git a/Language/Haskell/ParseMonad.hs b/Language/Haskell/ParseMonad.hs --- a/Language/Haskell/ParseMonad.hs +++ b/Language/Haskell/ParseMonad.hs @@ -27,7 +27,9 @@ import Language.Haskell.Syntax(SrcLoc(..)) import Control.Applicative +import Control.Monad (ap, liftM) import Data.Monoid +import Prelude -- | The result of a parse. data ParseResult a @@ -111,6 +113,13 @@ runParser :: P a -> String -> ParseResult a runParser = runParserWithMode defaultParseMode +instance Functor P where + fmap = liftM + +instance Applicative P where + pure = return + (<*>) = ap + instance Monad P where return a = P $ \_i _x _y _l s _m -> Ok s a P m >>= k = P $ \i x y l s mode -> @@ -155,6 +164,13 @@ -- a continuation-passing version of the parsing monad newtype Lex r a = Lex { runL :: (a -> P r) -> P r } + +instance Functor (Lex r) where + fmap = liftM + +instance Applicative (Lex r) where + pure = return + (<*>) = ap instance Monad (Lex r) where return a = Lex $ \k -> k a diff --git a/Language/Haskell/Pretty.hs b/Language/Haskell/Pretty.hs --- a/Language/Haskell/Pretty.hs +++ b/Language/Haskell/Pretty.hs @@ -24,6 +24,9 @@ import Language.Haskell.Syntax +import Control.Applicative (Applicative(..)) +import Control.Monad (ap) + import qualified Text.PrettyPrint as P infixl 5 $$$ @@ -90,6 +93,10 @@ instance Functor (DocM s) where fmap f xs = do x <- xs; return (f x) + +instance Applicative (DocM s) where + pure = return + (<*>) = ap instance Monad (DocM s) where (>>=) = thenDocM diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,6 @@ +# 1.0.2.0 + + - Add support for GHC 7.10 & base-4.8) + + - Add missing `Functor` & `Applicative` instances for `P` and `Lex` + monads needed for AMP compatibility. diff --git a/dist/build/Language/Haskell/Parser.hs b/dist/build/Language/Haskell/Parser.hs --- a/dist/build/Language/Haskell/Parser.hs +++ b/dist/build/Language/Haskell/Parser.hs @@ -22,8 +22,10 @@ import Language.Haskell.ParseUtils import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) --- parser produced by Happy Version 1.19.0 +-- parser produced by Happy Version 1.19.5 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 @@ -3803,6 +3805,73 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} +{-# LINE 11 "" #-} +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LINE 11 "" #-} +{-# LINE 1 "/opt/ghc/7.10.1/lib/ghc-7.10.0.20150123/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 11 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp @@ -3812,6 +3881,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) @@ -3821,7 +3891,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 @@ -3830,11 +3900,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) @@ -3851,9 +3921,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 @@ -3861,35 +3931,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#))) @@ -3908,7 +3978,7 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 169 "templates/GenericTemplate.hs" #-} +{-# LINE 170 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token @@ -3950,9 +4020,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 @@ -4004,7 +4074,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 @@ -4013,16 +4083,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: @@ -4040,9 +4110,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 --git a/haskell-src.cabal b/haskell-src.cabal --- a/haskell-src.cabal +++ b/haskell-src.cabal @@ -1,10 +1,12 @@ name: haskell-src -version: 1.0.1.6 +-- don't forget to update the changelog.md! +version: 1.0.2.0 license: BSD3 license-file: LICENSE author: Simon Marlow, Sven Panne and Noel Winstanley -- Maintained through https://github.com/haskell-pkg-janitors. Join us! -maintainer: Conrad Parker +maintainer: Herbert Valerio Riedel +bug-reports: https://github.com/haskell-pkg-janitors/haskell-src/issues category: Language synopsis: Support for manipulating Haskell source code description: @@ -16,11 +18,13 @@ build-type: Simple cabal-version: >=1.6 +extra-source-files: changelog.md + flag split-base source-repository head type: git - location: git://github.com/haskell-pkg-janitors/haskell-src.git + location: https://github.com/haskell-pkg-janitors/haskell-src.git library exposed-modules: @@ -30,10 +34,14 @@ Language.Haskell.Pretty, Language.Haskell.Syntax, Language.Haskell.ParseUtils + if flag(split-base) build-depends: base >= 4 && < 5, syb, pretty, array else build-depends: base < 3 + + build-tools: happy + extensions: CPP nhc98-options: -K11M ghc-options: -Wall -O2