diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2008 Iavor S. Diatchki + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,8 @@ +#! /usr/bin/env runhaskell + +> module Main (main) where +> +> import Distribution.Simple (defaultMain) +> +> main :: IO () +> main = defaultMain diff --git a/Text/Show/Parser.y b/Text/Show/Parser.y new file mode 100644 --- /dev/null +++ b/Text/Show/Parser.y @@ -0,0 +1,93 @@ +{ +-- We use these options because Happy generates code with a lot of warnings. +{-# OPTIONS_GHC -w #-} +module Text.Show.Parser (parseValue) where + +import Text.Show.Value +import Language.Haskell.Lexer +} + +%token + + '=' { (Reservedop, (_,"=")) } + '(' { (Special, (_,"(")) } + ')' { (Special, (_,")")) } + '{' { (Special, (_,"{")) } + '}' { (Special, (_,"}")) } + '[' { (Special, (_,"[")) } + ']' { (Special, (_,"]")) } + ',' { (Special, (_,",")) } + + INT { (IntLit, (_,$$)) } + FLOAT { (FloatLit, (_,$$)) } + STRING { (StringLit, (_,$$)) } + CHAR { (CharLit, (_,$$)) } + + VARID { (Varid, (_,$$)) } + QVARID { (Qvarid, (_,$$)) } + CONID { (Conid, (_,$$)) } + QCONID { (Qconid, (_,$$)) } + CONSYM { (Consym, (_,$$)) } + QCONSYM { (Qconsym, (_,$$)) } + + +%monad { Maybe } { (>>=) } { return } +%name parseValue value +%tokentype { PosToken } + + +%% + +value :: { Value } + : con list1(avalue) { Con $1 $2 } + | avalue { $1 } + +avalue :: { Value } + : '(' value ')' { $2 } + | '[' sep(value,',') ']' { List $2 } + | '(' tuple ')' { Tuple $2 } + | con '{' sep(field,',') '}' { Rec $1 $3 } + | con { Con $1 [] } + | INT { Other $1 } + | FLOAT { Other $1 } + | STRING { Other $1 } + | CHAR { Other $1 } + +con :: { String } + : CONID { $1 } + | QCONID { $1 } + -- to support things like "fromList x" + | VARID { $1 } + | QVARID { $1 } + +field :: { (Name,Value) } + : VARID '=' value { ($1,$3) } + +tuple :: { [Value] } + : { [] } + | value ',' sep1(value,',') { $1 : $3 } + + +-- Common Rule Patterns -------------------------------------------------------- + +sep1(p,q) : p list(snd(q,p)) { $1 : $2 } +sep(p,q) : sep1(p,q) { $1 } + | { [] } + +snd(p,q) : p q { $2 } + +list1(p) : rev_list1(p) { reverse $1 } +list(p) : list1(p) { $1 } + | { [] } + +rev_list1(p) : p { [$1] } + | rev_list1(p) p { $2 : $1 } + + + + +{ +happyError :: [PosToken] -> Maybe a +happyError ((_,(p,_)) : _) = Nothing -- error ("Parser error at: " ++ show p) +happyError [] = Nothing -- error ("Parser error at EOF") +} diff --git a/Text/Show/Pretty.hs b/Text/Show/Pretty.hs new file mode 100644 --- /dev/null +++ b/Text/Show/Pretty.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Text.Show.Pretty +-- Copyright : (c) Iavor S. Diatchki 2009 +-- License : BSD3 +-- +-- Maintainer : iavor.diatchki@gmail.com +-- Stability : provisional +-- Portability : Haskell 98 +-- +-- Functions for human-readable derived show instances. +-------------------------------------------------------------------------------- + + +module Text.Show.Pretty + ( Name, Value(..) + , parseValue, ppValue, ppDoc, ppShow + ) where + +import Text.PrettyPrint +import qualified Text.Show.Parser as P +import Text.Show.Value +import Language.Haskell.Lexer(rmSpace,lexerPass0) + +parseValue :: String -> Maybe Value +parseValue = P.parseValue . rmSpace . lexerPass0 + +-- | Convert a generic value into a pretty String, if possible. +ppShow :: Show a => a -> String +ppShow = show . ppDoc + +-- | Try to show a value, prettily. +-- If we do not undertant the value, then we just use its +-- standard show instance. +ppDoc :: Show a => a -> Doc +ppDoc a = case parseValue txt of + Just v -> ppValue v + Nothing -> text txt + where txt = show a + + +-- | Pretty print a generic value. +-- Our intention is that the result is equivalent to the show +-- insrnace for the origianl value, except possivly easier to +-- unserstand by a human. +ppValue :: Value -> Doc +ppValue val = case val of + Con c vs -> ppCon c vs + Rec c fs -> hang (text c) 2 $ block '{' '}' (map ppField fs) + where ppField (x,v) = text x <+> char '=' <+> ppValue v + + List vs -> block '[' ']' (map ppValue vs) + Tuple vs -> block '(' ')' (map ppValue vs) + Other cs -> text cs + + +-- Private --------------------------------------------------------------------- + +ppCon :: Name -> [Value] -> Doc +ppCon c [] = text c +ppCon c (v : vs) = hang line1 2 (foldl addParam doc1 vs) + where (line1,doc1) + | isAtom v = (text c, ppValue v) + | otherwise = (text c <+> char '(', ppValue v <+> char ')') + + addParam d p + | isAtom p = d $$ ppValue p + | otherwise = (d <+> char '(') $$ (ppValue p <+> char ')') + +isAtom :: Value -> Bool +isAtom (Con _ (_:_)) = False +isAtom _ = True + +block :: Char -> Char -> [Doc] -> Doc +block a b [] = char a <> char b +block a b (d:ds) = char a <+> d + $$ vcat [ char ',' <+> x | x <- ds ] + $$ char b + + diff --git a/Text/Show/Value.hs b/Text/Show/Value.hs new file mode 100644 --- /dev/null +++ b/Text/Show/Value.hs @@ -0,0 +1,28 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Text.Show.Value +-- Copyright : (c) Iavor S. Diatchki 2009 +-- License : BSD3 +-- +-- Maintainer : iavor.diatchki@gmail.com +-- Stability : provisional +-- Portability : Haskell 98 +-- +-- Generic representation of Showable values. +-------------------------------------------------------------------------------- + + +module Text.Show.Value ( Name, Value(..) ) where + +-- | A name. +type Name = String + +-- | Generic Haskell values +data Value = Con Name [Value] -- ^ Data constructor + | Rec Name [ (Name,Value) ] -- ^ Record value + | Tuple [Value] -- ^ Tuple + | List [Value] -- ^ List + | Other String -- ^ Something else (e.g. number) + deriving (Eq,Show) + + diff --git a/dist/build/Text/Show/Parser.hs b/dist/build/Text/Show/Parser.hs new file mode 100644 --- /dev/null +++ b/dist/build/Text/Show/Parser.hs @@ -0,0 +1,814 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +-- We use these options because Happy generates code with a lot of warnings. +{-# OPTIONS_GHC -w #-} +module Text.Show.Parser (parseValue) where + +import Text.Show.Value +import Language.Haskell.Lexer +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +#else +import Array +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.18.2 + +newtype HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = GHC.Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (Value) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn4 x = unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (Value) +happyOut4 x = unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: (Value) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (Value) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (String) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (String) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: ((Name,Value)) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> ((Name,Value)) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: ([Value]) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> ([Value]) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: t9 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t9 +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: t10 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t10 +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: t11 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t11 +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: t12 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t12 +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: t13 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t13 +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: t14 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t14 +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: t15 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t15 +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: t16 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t16 +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: t17 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t17 +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: t18 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t18 +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: t19 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t19 +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: t20 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t20 +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: t21 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t21 +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: t22 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t22 +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyInTok :: (PosToken) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (PosToken) +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x0e\x00\x35\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x00\x00\xff\xff\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x4a\x00\x00\x00\x1f\x00\x3e\x00\x00\x00\x38\x00\x00\x00\x0e\x00\x42\x00\x2b\x00\x33\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x4c\x00\x27\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x11\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x34\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x49\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\xf1\xff\xf0\xff\xf3\xff\xf2\xff\x00\x00\xfd\xff\xf8\xff\xee\xff\xe8\xff\xf7\xff\xf6\xff\xf5\xff\xf4\xff\xe5\xff\x00\x00\xe9\xff\x00\x00\x00\x00\xe4\xff\xf8\xff\xfe\xff\xec\xff\xea\xff\xdf\xff\x00\x00\xeb\xff\x00\x00\xe3\xff\xfa\xff\xfc\xff\x00\x00\xfb\xff\xe7\xff\xdb\xff\xe6\xff\xde\xff\x00\x00\xe1\xff\xda\xff\xed\xff\x00\x00\xf9\xff\xe2\xff\xd9\xff\xe0\xff\xdc\xff\x00\x00\xdd\xff\xd8\xff\xef\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x02\x00\x0f\x00\x04\x00\x03\x00\x06\x00\x01\x00\x02\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x02\x00\x00\x00\x01\x00\x02\x00\x06\x00\x04\x00\x0c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x01\x00\x02\x00\x0d\x00\x03\x00\x05\x00\x00\x00\x01\x00\x02\x00\x08\x00\x0a\x00\x02\x00\x08\x00\x07\x00\x08\x00\x00\x00\x01\x00\x02\x00\x01\x00\x09\x00\x08\x00\x08\x00\x0c\x00\x08\x00\x0e\x00\x03\x00\x05\x00\x11\x00\x06\x00\x0d\x00\x04\x00\x0f\x00\x10\x00\x0b\x00\x12\x00\x03\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x00\x00\x01\x00\x02\x00\x00\x00\x01\x00\x02\x00\x00\x00\x01\x00\x02\x00\x0d\x00\x08\x00\x07\x00\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x0b\x00\x33\x00\x1a\x00\x32\x00\x0c\x00\x1e\x00\x16\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x0b\x00\x13\x00\x08\x00\x09\x00\x0c\x00\x14\x00\x29\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x15\x00\x16\x00\x1e\x00\x21\x00\x17\x00\x10\x00\x08\x00\x09\x00\x22\x00\x18\x00\x02\x00\x32\x00\x11\x00\x12\x00\x10\x00\x08\x00\x09\x00\x2c\x00\x23\x00\x28\x00\x32\x00\x24\x00\x2a\x00\x25\x00\x1a\x00\x2d\x00\x26\x00\x1b\x00\x2d\x00\x1a\x00\x2e\x00\x2f\x00\x1c\x00\x30\x00\x20\x00\x04\x00\x05\x00\x06\x00\x07\x00\x34\x00\x08\x00\x09\x00\x28\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\x1e\x00\x28\x00\x23\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = array (1, 39) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39) + ] + +happy_n_terms = 20 :: Int +happy_n_nonterms = 19 :: Int + +happyReduce_1 = happySpecReduce_2 0# happyReduction_1 +happyReduction_1 happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn4 + (Con happy_var_1 happy_var_2 + )}} + +happyReduce_2 = happySpecReduce_1 0# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_3 = happySpecReduce_3 1# happyReduction_3 +happyReduction_3 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn5 + (happy_var_2 + )} + +happyReduce_4 = happySpecReduce_3 1# happyReduction_4 +happyReduction_4 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn5 + (List happy_var_2 + )} + +happyReduce_5 = happySpecReduce_3 1# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn5 + (Tuple happy_var_2 + )} + +happyReduce_6 = happyReduce 4# 1# happyReduction_6 +happyReduction_6 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn5 + (Rec happy_var_1 happy_var_3 + ) `HappyStk` happyRest}} + +happyReduce_7 = happySpecReduce_1 1# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn5 + (Con happy_var_1 [] + )} + +happyReduce_8 = happySpecReduce_1 1# happyReduction_8 +happyReduction_8 happy_x_1 + = case happyOutTok happy_x_1 of { ((IntLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_9 = happySpecReduce_1 1# happyReduction_9 +happyReduction_9 happy_x_1 + = case happyOutTok happy_x_1 of { ((FloatLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_10 = happySpecReduce_1 1# happyReduction_10 +happyReduction_10 happy_x_1 + = case happyOutTok happy_x_1 of { ((StringLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_11 = happySpecReduce_1 1# happyReduction_11 +happyReduction_11 happy_x_1 + = case happyOutTok happy_x_1 of { ((CharLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 2# happyReduction_12 +happyReduction_12 happy_x_1 + = case happyOutTok happy_x_1 of { ((Conid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_13 = happySpecReduce_1 2# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOutTok happy_x_1 of { ((Qconid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_14 = happySpecReduce_1 2# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOutTok happy_x_1 of { ((Varid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_15 = happySpecReduce_1 2# happyReduction_15 +happyReduction_15 happy_x_1 + = case happyOutTok happy_x_1 of { ((Qvarid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_16 = happySpecReduce_3 3# happyReduction_16 +happyReduction_16 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { ((Varid, (_,happy_var_1))) -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn7 + ((happy_var_1,happy_var_3) + )}} + +happyReduce_17 = happySpecReduce_0 4# happyReduction_17 +happyReduction_17 = happyIn8 + ([] + ) + +happyReduce_18 = happySpecReduce_3 4# happyReduction_18 +happyReduction_18 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (happy_var_1 : happy_var_3 + )}} + +happyReduce_19 = happySpecReduce_1 5# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn9 + (reverse happy_var_1 + )} + +happyReduce_20 = happySpecReduce_1 6# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOut15 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_21 = happySpecReduce_0 6# happyReduction_21 +happyReduction_21 = happyIn10 + ([] + ) + +happyReduce_22 = happySpecReduce_1 7# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_0 7# happyReduction_23 +happyReduction_23 = happyIn11 + ([] + ) + +happyReduce_24 = happySpecReduce_2 8# happyReduction_24 +happyReduction_24 happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_2 of { happy_var_2 -> + happyIn12 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_25 = happySpecReduce_1 9# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn13 + (happy_var_1 + )} + +happyReduce_26 = happySpecReduce_0 9# happyReduction_26 +happyReduction_26 = happyIn13 + ([] + ) + +happyReduce_27 = happySpecReduce_1 10# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn14 + ([happy_var_1] + )} + +happyReduce_28 = happySpecReduce_2 10# happyReduction_28 +happyReduction_28 happy_x_2 + happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn14 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_29 = happySpecReduce_2 11# happyReduction_29 +happyReduction_29 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn15 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_30 = happySpecReduce_2 12# happyReduction_30 +happyReduction_30 happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn16 + (happy_var_2 + )} + +happyReduce_31 = happySpecReduce_1 13# happyReduction_31 +happyReduction_31 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn17 + (happy_var_1 + )} + +happyReduce_32 = happySpecReduce_0 13# happyReduction_32 +happyReduction_32 = happyIn17 + ([] + ) + +happyReduce_33 = happySpecReduce_1 14# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn18 + (reverse happy_var_1 + )} + +happyReduce_34 = happySpecReduce_2 15# happyReduction_34 +happyReduction_34 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn19 + (happy_var_2 + )} + +happyReduce_35 = happySpecReduce_1 16# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn20 + (reverse happy_var_1 + )} + +happyReduce_36 = happySpecReduce_1 17# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOut16 happy_x_1 of { happy_var_1 -> + happyIn21 + ([happy_var_1] + )} + +happyReduce_37 = happySpecReduce_2 17# happyReduction_37 +happyReduction_37 happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn21 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_38 = happySpecReduce_1 18# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn22 + ([happy_var_1] + )} + +happyReduce_39 = happySpecReduce_2 18# happyReduction_39 +happyReduction_39 happy_x_2 + happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { happy_var_2 -> + happyIn22 + (happy_var_2 : happy_var_1 + )}} + +happyNewToken action sts stk [] = + happyDoAction 19# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + (Reservedop, (_,"=")) -> cont 1#; + (Special, (_,"(")) -> cont 2#; + (Special, (_,")")) -> cont 3#; + (Special, (_,"{")) -> cont 4#; + (Special, (_,"}")) -> cont 5#; + (Special, (_,"[")) -> cont 6#; + (Special, (_,"]")) -> cont 7#; + (Special, (_,",")) -> cont 8#; + (IntLit, (_,happy_dollar_dollar)) -> cont 9#; + (FloatLit, (_,happy_dollar_dollar)) -> cont 10#; + (StringLit, (_,happy_dollar_dollar)) -> cont 11#; + (CharLit, (_,happy_dollar_dollar)) -> cont 12#; + (Varid, (_,happy_dollar_dollar)) -> cont 13#; + (Qvarid, (_,happy_dollar_dollar)) -> cont 14#; + (Conid, (_,happy_dollar_dollar)) -> cont 15#; + (Qconid, (_,happy_dollar_dollar)) -> cont 16#; + (Consym, (_,happy_dollar_dollar)) -> cont 17#; + (Qconsym, (_,happy_dollar_dollar)) -> cont 18#; + _ -> happyError' (tk:tks) + } + +happyError_ tk tks = happyError' (tk:tks) + +happyThen :: () => Maybe a -> (a -> Maybe b) -> Maybe b +happyThen = ((>>=)) +happyReturn :: () => a -> Maybe a +happyReturn = (return) +happyThen1 m k tks = ((>>=)) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Maybe a +happyReturn1 = \a tks -> (return) a +happyError' :: () => [(PosToken)] -> Maybe a +happyError' = happyError + +parseValue tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +happyError :: [PosToken] -> Maybe a +happyError ((_,(p,_)) : _) = Nothing -- error ("Parser error at: " ++ show p) +happyError [] = Nothing -- error ("Parser error at EOF") +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 28 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + +{-# LINE 49 "templates/GenericTemplate.hs" #-} + +{-# LINE 59 "templates/GenericTemplate.hs" #-} + +{-# LINE 68 "templates/GenericTemplate.hs" #-} + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- 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 +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | (n <# (0# :: Int#)) -> {- nothing -} + + (happyReduceArr ! rule) i tk st + where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n -# (1# :: Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off +# i) + check = if (off_i >=# (0# :: Int#)) + then (indexShortOffAddr happyCheck off_i ==# i) + else False + action | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + +{-# LINE 127 "templates/GenericTemplate.hs" #-} + + +indexShortOffAddr (HappyA# arr) off = +#if __GLASGOW_HASKELL__ > 500 + narrow16Int# i +#elif __GLASGOW_HASKELL__ == 500 + intToInt16# i +#else + (i `iShiftL#` 16#) `iShiftRA#` 16# +#endif + where +#if __GLASGOW_HASKELL__ >= 503 + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) +#else + i = word2Int# ((high `shiftL#` 8#) `or#` low) +#endif + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# + + + + + +data HappyAddr = HappyA# Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k -# (1# :: 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) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off +# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off +# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk = +-- trace "failing" $ + happyError_ tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- 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)) +-} + +-- 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 ( (unsafeCoerce# (I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. diff --git a/dist/build/ppsh/ppsh-tmp/Text/Show/Parser.hs b/dist/build/ppsh/ppsh-tmp/Text/Show/Parser.hs new file mode 100644 --- /dev/null +++ b/dist/build/ppsh/ppsh-tmp/Text/Show/Parser.hs @@ -0,0 +1,814 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +-- We use these options because Happy generates code with a lot of warnings. +{-# OPTIONS_GHC -w #-} +module Text.Show.Parser (parseValue) where + +import Text.Show.Value +import Language.Haskell.Lexer +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +#else +import Array +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.18.2 + +newtype HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = GHC.Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (Value) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn4 x = unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (Value) +happyOut4 x = unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: (Value) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (Value) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (String) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (String) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: ((Name,Value)) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> ((Name,Value)) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: ([Value]) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> ([Value]) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: t9 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t9 +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: t10 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t10 +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: t11 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t11 +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: t12 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t12 +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: t13 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t13 +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: t14 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t14 +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: t15 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t15 +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: t16 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t16 +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: t17 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t17 +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: t18 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t18 +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: t19 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t19 +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: t20 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t20 +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: t21 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t21 +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: t22 -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> t22 +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyInTok :: (PosToken) -> (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22) -> (PosToken) +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x0e\x00\x35\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x00\x00\xff\xff\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x4a\x00\x00\x00\x1f\x00\x3e\x00\x00\x00\x38\x00\x00\x00\x0e\x00\x42\x00\x2b\x00\x33\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x4c\x00\x27\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x11\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x34\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x49\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\xf1\xff\xf0\xff\xf3\xff\xf2\xff\x00\x00\xfd\xff\xf8\xff\xee\xff\xe8\xff\xf7\xff\xf6\xff\xf5\xff\xf4\xff\xe5\xff\x00\x00\xe9\xff\x00\x00\x00\x00\xe4\xff\xf8\xff\xfe\xff\xec\xff\xea\xff\xdf\xff\x00\x00\xeb\xff\x00\x00\xe3\xff\xfa\xff\xfc\xff\x00\x00\xfb\xff\xe7\xff\xdb\xff\xe6\xff\xde\xff\x00\x00\xe1\xff\xda\xff\xed\xff\x00\x00\xf9\xff\xe2\xff\xd9\xff\xe0\xff\xdc\xff\x00\x00\xdd\xff\xd8\xff\xef\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x02\x00\x0f\x00\x04\x00\x03\x00\x06\x00\x01\x00\x02\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x02\x00\x00\x00\x01\x00\x02\x00\x06\x00\x04\x00\x0c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x01\x00\x02\x00\x0d\x00\x03\x00\x05\x00\x00\x00\x01\x00\x02\x00\x08\x00\x0a\x00\x02\x00\x08\x00\x07\x00\x08\x00\x00\x00\x01\x00\x02\x00\x01\x00\x09\x00\x08\x00\x08\x00\x0c\x00\x08\x00\x0e\x00\x03\x00\x05\x00\x11\x00\x06\x00\x0d\x00\x04\x00\x0f\x00\x10\x00\x0b\x00\x12\x00\x03\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x00\x00\x01\x00\x02\x00\x00\x00\x01\x00\x02\x00\x00\x00\x01\x00\x02\x00\x0d\x00\x08\x00\x07\x00\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x0b\x00\x33\x00\x1a\x00\x32\x00\x0c\x00\x1e\x00\x16\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x0b\x00\x13\x00\x08\x00\x09\x00\x0c\x00\x14\x00\x29\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x15\x00\x16\x00\x1e\x00\x21\x00\x17\x00\x10\x00\x08\x00\x09\x00\x22\x00\x18\x00\x02\x00\x32\x00\x11\x00\x12\x00\x10\x00\x08\x00\x09\x00\x2c\x00\x23\x00\x28\x00\x32\x00\x24\x00\x2a\x00\x25\x00\x1a\x00\x2d\x00\x26\x00\x1b\x00\x2d\x00\x1a\x00\x2e\x00\x2f\x00\x1c\x00\x30\x00\x20\x00\x04\x00\x05\x00\x06\x00\x07\x00\x34\x00\x08\x00\x09\x00\x28\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\x1e\x00\x28\x00\x23\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = array (1, 39) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39) + ] + +happy_n_terms = 20 :: Int +happy_n_nonterms = 19 :: Int + +happyReduce_1 = happySpecReduce_2 0# happyReduction_1 +happyReduction_1 happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn4 + (Con happy_var_1 happy_var_2 + )}} + +happyReduce_2 = happySpecReduce_1 0# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_3 = happySpecReduce_3 1# happyReduction_3 +happyReduction_3 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn5 + (happy_var_2 + )} + +happyReduce_4 = happySpecReduce_3 1# happyReduction_4 +happyReduction_4 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn5 + (List happy_var_2 + )} + +happyReduce_5 = happySpecReduce_3 1# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn5 + (Tuple happy_var_2 + )} + +happyReduce_6 = happyReduce 4# 1# happyReduction_6 +happyReduction_6 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn5 + (Rec happy_var_1 happy_var_3 + ) `HappyStk` happyRest}} + +happyReduce_7 = happySpecReduce_1 1# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn5 + (Con happy_var_1 [] + )} + +happyReduce_8 = happySpecReduce_1 1# happyReduction_8 +happyReduction_8 happy_x_1 + = case happyOutTok happy_x_1 of { ((IntLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_9 = happySpecReduce_1 1# happyReduction_9 +happyReduction_9 happy_x_1 + = case happyOutTok happy_x_1 of { ((FloatLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_10 = happySpecReduce_1 1# happyReduction_10 +happyReduction_10 happy_x_1 + = case happyOutTok happy_x_1 of { ((StringLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_11 = happySpecReduce_1 1# happyReduction_11 +happyReduction_11 happy_x_1 + = case happyOutTok happy_x_1 of { ((CharLit, (_,happy_var_1))) -> + happyIn5 + (Other happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 2# happyReduction_12 +happyReduction_12 happy_x_1 + = case happyOutTok happy_x_1 of { ((Conid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_13 = happySpecReduce_1 2# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOutTok happy_x_1 of { ((Qconid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_14 = happySpecReduce_1 2# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOutTok happy_x_1 of { ((Varid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_15 = happySpecReduce_1 2# happyReduction_15 +happyReduction_15 happy_x_1 + = case happyOutTok happy_x_1 of { ((Qvarid, (_,happy_var_1))) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_16 = happySpecReduce_3 3# happyReduction_16 +happyReduction_16 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { ((Varid, (_,happy_var_1))) -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn7 + ((happy_var_1,happy_var_3) + )}} + +happyReduce_17 = happySpecReduce_0 4# happyReduction_17 +happyReduction_17 = happyIn8 + ([] + ) + +happyReduce_18 = happySpecReduce_3 4# happyReduction_18 +happyReduction_18 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (happy_var_1 : happy_var_3 + )}} + +happyReduce_19 = happySpecReduce_1 5# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn9 + (reverse happy_var_1 + )} + +happyReduce_20 = happySpecReduce_1 6# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOut15 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_21 = happySpecReduce_0 6# happyReduction_21 +happyReduction_21 = happyIn10 + ([] + ) + +happyReduce_22 = happySpecReduce_1 7# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_0 7# happyReduction_23 +happyReduction_23 = happyIn11 + ([] + ) + +happyReduce_24 = happySpecReduce_2 8# happyReduction_24 +happyReduction_24 happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_2 of { happy_var_2 -> + happyIn12 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_25 = happySpecReduce_1 9# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn13 + (happy_var_1 + )} + +happyReduce_26 = happySpecReduce_0 9# happyReduction_26 +happyReduction_26 = happyIn13 + ([] + ) + +happyReduce_27 = happySpecReduce_1 10# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn14 + ([happy_var_1] + )} + +happyReduce_28 = happySpecReduce_2 10# happyReduction_28 +happyReduction_28 happy_x_2 + happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn14 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_29 = happySpecReduce_2 11# happyReduction_29 +happyReduction_29 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn15 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_30 = happySpecReduce_2 12# happyReduction_30 +happyReduction_30 happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn16 + (happy_var_2 + )} + +happyReduce_31 = happySpecReduce_1 13# happyReduction_31 +happyReduction_31 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn17 + (happy_var_1 + )} + +happyReduce_32 = happySpecReduce_0 13# happyReduction_32 +happyReduction_32 = happyIn17 + ([] + ) + +happyReduce_33 = happySpecReduce_1 14# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn18 + (reverse happy_var_1 + )} + +happyReduce_34 = happySpecReduce_2 15# happyReduction_34 +happyReduction_34 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn19 + (happy_var_2 + )} + +happyReduce_35 = happySpecReduce_1 16# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn20 + (reverse happy_var_1 + )} + +happyReduce_36 = happySpecReduce_1 17# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOut16 happy_x_1 of { happy_var_1 -> + happyIn21 + ([happy_var_1] + )} + +happyReduce_37 = happySpecReduce_2 17# happyReduction_37 +happyReduction_37 happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn21 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_38 = happySpecReduce_1 18# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn22 + ([happy_var_1] + )} + +happyReduce_39 = happySpecReduce_2 18# happyReduction_39 +happyReduction_39 happy_x_2 + happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { happy_var_2 -> + happyIn22 + (happy_var_2 : happy_var_1 + )}} + +happyNewToken action sts stk [] = + happyDoAction 19# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + (Reservedop, (_,"=")) -> cont 1#; + (Special, (_,"(")) -> cont 2#; + (Special, (_,")")) -> cont 3#; + (Special, (_,"{")) -> cont 4#; + (Special, (_,"}")) -> cont 5#; + (Special, (_,"[")) -> cont 6#; + (Special, (_,"]")) -> cont 7#; + (Special, (_,",")) -> cont 8#; + (IntLit, (_,happy_dollar_dollar)) -> cont 9#; + (FloatLit, (_,happy_dollar_dollar)) -> cont 10#; + (StringLit, (_,happy_dollar_dollar)) -> cont 11#; + (CharLit, (_,happy_dollar_dollar)) -> cont 12#; + (Varid, (_,happy_dollar_dollar)) -> cont 13#; + (Qvarid, (_,happy_dollar_dollar)) -> cont 14#; + (Conid, (_,happy_dollar_dollar)) -> cont 15#; + (Qconid, (_,happy_dollar_dollar)) -> cont 16#; + (Consym, (_,happy_dollar_dollar)) -> cont 17#; + (Qconsym, (_,happy_dollar_dollar)) -> cont 18#; + _ -> happyError' (tk:tks) + } + +happyError_ tk tks = happyError' (tk:tks) + +happyThen :: () => Maybe a -> (a -> Maybe b) -> Maybe b +happyThen = ((>>=)) +happyReturn :: () => a -> Maybe a +happyReturn = (return) +happyThen1 m k tks = ((>>=)) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Maybe a +happyReturn1 = \a tks -> (return) a +happyError' :: () => [(PosToken)] -> Maybe a +happyError' = happyError + +parseValue tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +happyError :: [PosToken] -> Maybe a +happyError ((_,(p,_)) : _) = Nothing -- error ("Parser error at: " ++ show p) +happyError [] = Nothing -- error ("Parser error at EOF") +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 28 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + +{-# LINE 49 "templates/GenericTemplate.hs" #-} + +{-# LINE 59 "templates/GenericTemplate.hs" #-} + +{-# LINE 68 "templates/GenericTemplate.hs" #-} + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- 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 +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | (n <# (0# :: Int#)) -> {- nothing -} + + (happyReduceArr ! rule) i tk st + where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n -# (1# :: Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off +# i) + check = if (off_i >=# (0# :: Int#)) + then (indexShortOffAddr happyCheck off_i ==# i) + else False + action | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + +{-# LINE 127 "templates/GenericTemplate.hs" #-} + + +indexShortOffAddr (HappyA# arr) off = +#if __GLASGOW_HASKELL__ > 500 + narrow16Int# i +#elif __GLASGOW_HASKELL__ == 500 + intToInt16# i +#else + (i `iShiftL#` 16#) `iShiftRA#` 16# +#endif + where +#if __GLASGOW_HASKELL__ >= 503 + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) +#else + i = word2Int# ((high `shiftL#` 8#) `or#` low) +#endif + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# + + + + + +data HappyAddr = HappyA# Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k -# (1# :: 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) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off +# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off +# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk = +-- trace "failing" $ + happyError_ tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- 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)) +-} + +-- 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 ( (unsafeCoerce# (I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. diff --git a/ppsh.hs b/ppsh.hs new file mode 100644 --- /dev/null +++ b/ppsh.hs @@ -0,0 +1,27 @@ +import Text.Show.Pretty +import System.Environment +import System.IO(hPutStrLn,stderr) + +main :: IO () +main = + do as <- getArgs + case as of + ["--test"] -> interact (show . selftest1) + [] -> interact $ \s -> case parseValue s of + Just v -> show (ppValue v) + Nothing -> s + _ -> hPutStrLn stderr $ unlines + [ "usage: ppsh < showed_value > pretty_value" + , " --test Self test: True means we passed." + ] + +selftest :: Value -> Bool +selftest v = case parseValue $ show $ ppValue v of + Just v1 -> v1 == v + Nothing -> False + +selftest1 :: String -> Bool +selftest1 txt = case parseValue txt of + Just v -> selftest v + Nothing -> True + diff --git a/pretty-show.cabal b/pretty-show.cabal new file mode 100644 --- /dev/null +++ b/pretty-show.cabal @@ -0,0 +1,60 @@ +name: pretty-show +version: 1 +synopsis: Tools for working with derived Show instances. + +license: BSD3 +license-file: LICENSE +author: Iavor S. Diatchki +maintainer: iavor.diatchki@gmail.com + +category: Text +homepage: http://wiki.github.com/yav/pretty-show +description: + We provide a library and an executable for + working with derived Show instances. By using + the library, we can parse derived Show instances + into a generic data structure. The tool uses + the library to produce human-readable versions + of Show instances, which can be quite handy + for debugging Haskell programs. + +cabal-version: >= 1.2 +build-type: Simple + +library + exposed-modules: + Text.Show.Pretty + other-modules: + Text.Show.Parser + Text.Show.Value + build-depends: + base >= 3 && < 5, + array >= 0.2 && < 2, + haskell-lexer >= 1 && < 2, + pretty >= 1 && < 2 + ghc-options: -Wall + + source-repository head + type: git + location: git://github.com/yav/pretty-show.git + + + +executable ppsh + main-is: ppsh.hs + + -- Silly. Our real dependency is on 'pretty-show'. + other-modules: + Text.Show.Pretty + Text.Show.Parser + Text.Show.Value + build-depends: + base >= 3 && < 5, + array >= 0.2 && < 2, + haskell-lexer >= 1 && < 2, + pretty >= 1 && < 2 + ghc-options: -Wall + + source-repository head + type: git + location: git://github.com/yav/pretty-show.git