diff --git a/C2HS.hs b/C2HS.hs new file mode 100644 --- /dev/null +++ b/C2HS.hs @@ -0,0 +1,220 @@ +-- C->Haskell Compiler: Marshalling library +-- +-- Copyright (c) [1999...2005] Manuel M T Chakravarty +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- 1. Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- 2. Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- 3. The name of the author may not be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- This module provides the marshaling routines for Haskell files produced by +-- C->Haskell for binding to C library interfaces. It exports all of the +-- low-level FFI (language-independent plus the C-specific parts) together +-- with the C->HS-specific higher-level marshalling routines. +-- + +module C2HS ( + + -- * Re-export the language-independent component of the FFI + module Foreign, + + -- * Re-export the C language component of the FFI + module CForeign, + + -- * Composite marshalling functions + withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv, + peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum, + + -- * Conditional results using 'Maybe' + nothingIf, nothingIfNull, + + -- * Bit masks + combineBitMasks, containsBitMask, extractBitMasks, + + -- * Conversion between C and Haskell types + cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum +) where + + +import Foreign + hiding (Word) + -- Should also hide the Foreign.Marshal.Pool exports in + -- compilers that export them +import CForeign + +import Monad (when, liftM) + + +-- Composite marshalling functions +-- ------------------------------- + +-- Strings with explicit length +-- +withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n) +peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n) + +-- Marshalling of numerals +-- + +withIntConv :: (Storable b, Integral a, Integral b) + => a -> (Ptr b -> IO c) -> IO c +withIntConv = with . cIntConv + +withFloatConv :: (Storable b, RealFloat a, RealFloat b) + => a -> (Ptr b -> IO c) -> IO c +withFloatConv = with . cFloatConv + +peekIntConv :: (Storable a, Integral a, Integral b) + => Ptr a -> IO b +peekIntConv = liftM cIntConv . peek + +peekFloatConv :: (Storable a, RealFloat a, RealFloat b) + => Ptr a -> IO b +peekFloatConv = liftM cFloatConv . peek + +-- Passing Booleans by reference +-- + +withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b +withBool = with . fromBool + +peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool +peekBool = liftM toBool . peek + + +-- Passing enums by reference +-- + +withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c +withEnum = with . cFromEnum + +peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a +peekEnum = liftM cToEnum . peek + + +-- Storing of 'Maybe' values +-- ------------------------- + +instance Storable a => Storable (Maybe a) where + sizeOf _ = sizeOf (undefined :: Ptr ()) + alignment _ = alignment (undefined :: Ptr ()) + + peek p = do + ptr <- peek (castPtr p) + if ptr == nullPtr + then return Nothing + else liftM Just $ peek ptr + + poke p v = do + ptr <- case v of + Nothing -> return nullPtr + Just v' -> new v' + poke (castPtr p) ptr + + +-- Conditional results using 'Maybe' +-- --------------------------------- + +-- Wrap the result into a 'Maybe' type. +-- +-- * the predicate determines when the result is considered to be non-existing, +-- ie, it is represented by `Nothing' +-- +-- * the second argument allows to map a result wrapped into `Just' to some +-- other domain +-- +nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b +nothingIf p f x = if p x then Nothing else Just $ f x + +-- |Instance for special casing null pointers. +-- +nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b +nothingIfNull = nothingIf (== nullPtr) + + +-- Support for bit masks +-- --------------------- + +-- Given a list of enumeration values that represent bit masks, combine these +-- masks using bitwise disjunction. +-- +combineBitMasks :: (Enum a, Bits b) => [a] -> b +combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum) + +-- Tests whether the given bit mask is contained in the given bit pattern +-- (i.e., all bits set in the mask are also set in the pattern). +-- +containsBitMask :: (Bits a, Enum b) => a -> b -> Bool +bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm + in + bm' .&. bits == bm' + +-- |Given a bit pattern, yield all bit masks that it contains. +-- +-- * This does *not* attempt to compute a minimal set of bit masks that when +-- combined yield the bit pattern, instead all contained bit masks are +-- produced. +-- +extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b] +extractBitMasks bits = + [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm] + + +-- Conversion routines +-- ------------------- + +-- |Integral conversion +-- +cIntConv :: (Integral a, Integral b) => a -> b +cIntConv = fromIntegral + +-- |Floating conversion +-- +cFloatConv :: (RealFloat a, RealFloat b) => a -> b +cFloatConv = realToFrac +-- As this conversion by default goes via `Rational', it can be very slow... +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x + #-} + +-- |Obtain C value from Haskell 'Bool'. +-- +cFromBool :: Num a => Bool -> a +cFromBool = fromBool + +-- |Obtain Haskell 'Bool' from C value. +-- +cToBool :: Num a => a -> Bool +cToBool = toBool + +-- |Convert a C enumeration to Haskell. +-- +cToEnum :: (Integral i, Enum e) => i -> e +cToEnum = toEnum . cIntConv + +-- |Convert a Haskell enumeration to C. +-- +cFromEnum :: (Enum e, Integral i) => e -> i +cFromEnum = cIntConv . fromEnum diff --git a/CLexer.hs b/CLexer.hs new file mode 100644 --- /dev/null +++ b/CLexer.hs @@ -0,0 +1,504 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# LINE 63 "c2hs/c/CLexer.x" #-} + +module CLexer (lexC, parseError) where + +import Data.Char (isDigit) +import Numeric (readDec, readOct, readHex) + +import Position (Position(..), Pos(posOf)) +import Idents (lexemeToIdent) + +import CTokens +import CParserMonad + + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#else +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_base :: AlexAddr +alex_base = AlexA# "\xf8\xff\xff\xff\x6e\x00\x00\x00\x73\x00\x00\x00\x00\x00\x00\x00\x78\x00\x00\x00\x82\x00\x00\x00\x9c\x00\x00\x00\xb6\x00\x00\x00\xbf\x00\x00\x00\xd9\x00\x00\x00\xf3\x00\x00\x00\xfc\x00\x00\x00\x16\x01\x00\x00\x30\x01\x00\x00\x39\x01\x00\x00\x53\x01\x00\x00\x6d\x01\x00\x00\xbe\x01\x00\x00\x1e\x02\x00\x00\x7e\x02\x00\x00\xde\x02\x00\x00\x3e\x03\x00\x00\x9e\x03\x00\x00\xfc\x03\x00\x00\x45\x04\x00\x00\x00\x00\x00\x00\xfc\xff\xff\xff\xfd\xff\xff\xff\xa7\xff\xff\xff\x9c\xff\xff\xff\xa3\xff\xff\xff\xaa\xff\xff\xff\x9a\xff\xff\xff\x00\x00\x00\x00\x03\x00\x00\x00\x04\x00\x00\x00\x9b\xff\xff\xff\xa2\xff\xff\xff\xac\xff\xff\xff\xae\xff\xff\xff\x6b\x04\x00\x00\xc4\x04\x00\x00\x0f\x05\x00\x00\x62\x01\x00\x00\x5c\x05\x00\x00\xae\x00\x00\x00\xcc\x00\x00\x00\x00\x00\x00\x00\x82\x05\x00\x00\xa8\x05\x00\x00\x08\x01\x00\x00\x09\x01\x00\x00\x00\x00\x00\x00\xee\x05\x00\x00\x34\x06\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\xff\xff\xff\x0d\x04\x00\x00\x15\x04\x00\x00\xed\xff\xff\xff\x7a\x06\x00\x00\x80\x00\x00\x00\x92\x06\x00\x00\xdb\x06\x00\x00\x00\x00\x00\x00\xee\xff\xff\xff\x5c\x04\x00\x00\xce\x05\x00\x00\xef\xff\xff\xff\xf2\x06\x00\x00\xb9\x00\x00\x00\x29\x07\x00\x00\x72\x07\x00\x00\x00\x00\x00\x00\x94\x07\x00\x00\xb1\x07\x00\x00\x15\x06\x00\x00\x46\x07\x00\x00\x5a\x06\x00\x00\x3b\x07\x00\x00\xd1\x07\x00\x00\x1d\x04\x00\x00\xee\x07\x00\x00\x66\x05\x00\x00\x00\x00\x00\x00\x7b\x00\x00\x00\xb8\x00\x00\x00\xe5\x05\x00\x00\x06\x08\x00\x00\xf5\x00\x00\x00\x22\x08\x00\x00\x3a\x08\x00\x00\x83\x08\x00\x00\x00\x00\x00\x00\xf7\x00\x00\x00\x6f\x01\x00\x00\x9c\x08\x00\x00\xca\x08\x00\x00\x17\x04\x00\x00\xd2\x08\x00\x00\xea\x08\x00\x00\x33\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\xda\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\xdf\xff\xff\xff\xfb\xff\xff\xff\x17\x00\x00\x00\x63\x00\x00\x00\x1b\x00\x00\x00\x53\x00\x00\x00\x46\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5f\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\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\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\x00\x69\x00\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# "\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x19\x00\x19\x00\x1a\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x21\x00\x21\x00\x22\x00\x24\x00\x25\x00\x26\x00\x3a\x00\x3a\x00\x43\x00\x43\x00\x80\x00\x02\x00\x6f\x00\x58\x00\x0f\x00\x89\x00\x76\x00\x77\x00\x40\x00\x69\x00\x6a\x00\x74\x00\x72\x00\x91\x00\x6e\x00\x51\x00\x75\x00\x2b\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x86\x00\x92\x00\x79\x00\x7f\x00\x7b\x00\x85\x00\x8a\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x29\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x6b\x00\x8b\x00\x6c\x00\x81\x00\x28\x00\x8f\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x93\x00\x82\x00\x94\x00\x70\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x08\x00\x03\x00\x90\x00\x73\x00\xff\xff\x7e\x00\x71\x00\xff\xff\x83\x00\xff\xff\x08\x00\x03\x00\xff\xff\x02\x00\x78\x00\x7c\x00\x7d\x00\x7a\x00\x02\x00\x88\x00\x6d\x00\x8d\x00\x95\x00\x08\x00\x87\x00\x11\x00\x00\x00\x8e\x00\x57\x00\x00\x00\x00\x00\x8c\x00\x00\x00\x08\x00\x00\x00\x11\x00\x09\x00\x03\x00\xff\xff\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x09\x00\x00\x00\x11\x00\x09\x00\x03\x00\x00\x00\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\x00\x00\x08\x00\x03\x00\x00\x00\x00\x00\x07\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x09\x00\x5e\x00\x11\x00\x00\x00\x57\x00\x84\x00\x41\x00\x00\x00\x00\x00\x08\x00\xff\xff\x11\x00\x09\x00\x03\x00\x00\x00\x00\x00\x07\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x09\x00\x2e\x00\x11\x00\x0b\x00\x03\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\x2e\x00\xff\xff\x0b\x00\x03\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0b\x00\x5e\x00\x4a\x00\x00\x00\x57\x00\x2f\x00\x60\x00\x2e\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0e\x00\x03\x00\x2f\x00\x00\x00\x2e\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0e\x00\x00\x00\x2f\x00\x0e\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x0e\x00\x03\x00\x00\x00\x00\x00\x0d\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0e\x00\x5e\x00\x00\x00\x67\x00\x33\x00\x34\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x10\x00\x33\x00\x34\x00\x00\x00\x0d\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x10\x00\x33\x00\x34\x00\x10\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x33\x00\x34\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x10\x00\x00\x00\x00\x00\x4d\x00\x60\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x52\x00\x52\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x55\x00\x38\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x38\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x35\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x55\x00\x38\x00\x39\x00\x00\x00\x67\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x38\x00\x39\x00\x00\x00\x00\x00\x00\x00\x27\x00\x2d\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x20\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x0a\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x17\x00\x12\x00\x12\x00\x12\x00\x12\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x00\x00\xff\xff\x00\x00\x12\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x12\x00\x3a\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x00\x00\x00\x00\x12\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x12\x00\x00\x00\x12\x00\x67\x00\x18\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x4d\x00\x00\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x52\x00\x52\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x2d\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x32\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x00\x32\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x32\x00\x43\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x32\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x37\x00\x00\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x37\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x00\x37\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x00\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\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\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x3b\x00\x00\x00\x00\x00\x3b\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3b\x00\x00\x00\x3b\x00\x00\x00\x42\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x4d\x00\x00\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x52\x00\x00\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x44\x00\x4c\x00\x00\x00\x44\x00\x44\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x44\x00\x00\x00\x44\x00\x55\x00\x4b\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x53\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x4c\x00\x00\x00\x53\x00\x4c\x00\x00\x00\x54\x00\x4c\x00\x54\x00\x00\x00\x4c\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x53\x00\x4c\x00\x00\x00\x56\x00\x00\x00\x56\x00\x00\x00\x4c\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x57\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\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\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5e\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\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\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x59\x00\x00\x00\x00\x00\x59\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x59\x00\xff\xff\x00\x00\x00\x00\x59\x00\x00\x00\x59\x00\x00\x00\x59\x00\x00\x00\x5f\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x00\x00\x64\x00\x64\x00\x64\x00\x64\x00\x64\x00\x64\x00\x64\x00\x64\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\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\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x62\x00\x00\x00\x00\x00\x62\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x62\x00\x00\x00\x62\x00\x00\x00\x68\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\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\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\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\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\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\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\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\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\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\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\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\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\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\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0a\x00\x61\x00\x6d\x00\x67\x00\x61\x00\x72\x00\x0a\x00\x0a\x00\x74\x00\x6e\x00\x65\x00\x64\x00\x27\x00\x27\x00\x27\x00\x27\x00\x3d\x00\x20\x00\x21\x00\x22\x00\x23\x00\x3d\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x3d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x3d\x00\x5d\x00\x5e\x00\x5f\x00\x3d\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x3d\x00\x2d\x00\x0a\x00\x3d\x00\x2b\x00\x0d\x00\x26\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x20\x00\x3c\x00\x3d\x00\x3d\x00\x3e\x00\x20\x00\x3d\x00\x3e\x00\x3d\x00\x2e\x00\x20\x00\x3d\x00\x22\x00\xff\xff\x3d\x00\x22\x00\xff\xff\xff\xff\x3d\x00\xff\xff\x20\x00\xff\xff\x22\x00\x09\x00\x0a\x00\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\xff\xff\x22\x00\x09\x00\x0a\x00\xff\xff\x0a\x00\x0a\x00\xff\xff\x0d\x00\x0d\x00\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x5c\x00\x22\x00\xff\xff\x22\x00\x7c\x00\x5c\x00\xff\xff\xff\xff\x20\x00\x27\x00\x22\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x4c\x00\x22\x00\x09\x00\x0a\x00\xff\xff\x0a\x00\xff\xff\x0a\x00\x0d\x00\x55\x00\x0d\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x5c\x00\x5c\x00\xff\xff\x22\x00\x4c\x00\x22\x00\x6c\x00\xff\xff\x20\x00\xff\xff\xff\xff\x09\x00\x0a\x00\x55\x00\xff\xff\x75\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\xff\xff\x6c\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x5c\x00\xff\xff\x5c\x00\x4c\x00\x4c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x09\x00\x55\x00\x55\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x6c\x00\x6c\x00\x09\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x0d\x00\x75\x00\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\xff\xff\xff\xff\x2e\x00\x22\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x45\x00\x4c\x00\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x55\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\x55\x00\xff\xff\xff\xff\x58\x00\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x65\x00\x6c\x00\x6c\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x6c\x00\xff\xff\xff\xff\x75\x00\x75\x00\xff\xff\xff\xff\xff\xff\x69\x00\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x70\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x22\x00\xff\xff\xff\xff\x0a\x00\xff\xff\x27\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\x3f\x00\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\x5c\x00\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x55\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x55\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6c\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\x4c\x00\x27\x00\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x55\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x75\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x55\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6c\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\x75\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x55\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6c\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x46\x00\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\x65\x00\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6c\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x46\x00\xff\xff\x65\x00\x66\x00\xff\xff\x2b\x00\x4c\x00\x2d\x00\xff\xff\x6c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\x6c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x5c\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\x6e\x00\x0d\x00\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\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\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\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\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\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\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\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\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\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\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\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# "\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\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\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x23\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\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\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\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\xff\xff\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\xff\xff\xff\xff\xff\xff\x62\x00\x62\x00\x62\x00\x62\x00\x62\x00\x62\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,150) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[],[],[],[],[],[],[],[(AlexAccSkip)],[],[],[],[],[],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_9))],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_18))],[],[],[],[],[],[(AlexAcc (alex_action_11))],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_12))],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_24))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_20))],[(AlexAcc (alex_action_21))],[(AlexAcc (alex_action_23))],[(AlexAcc (alex_action_22))],[(AlexAcc (alex_action_25))],[(AlexAcc (alex_action_26))],[(AlexAcc (alex_action_27))],[(AlexAcc (alex_action_28))],[(AlexAcc (alex_action_29))],[(AlexAcc (alex_action_31))],[(AlexAcc (alex_action_30))],[(AlexAcc (alex_action_33))],[(AlexAcc (alex_action_32))],[(AlexAcc (alex_action_34))],[(AlexAcc (alex_action_35))],[(AlexAcc (alex_action_43))],[(AlexAcc (alex_action_36))],[(AlexAcc (alex_action_37))],[(AlexAcc (alex_action_38))],[(AlexAcc (alex_action_39))],[(AlexAcc (alex_action_40))],[(AlexAcc (alex_action_41))],[(AlexAcc (alex_action_42))],[(AlexAcc (alex_action_44))],[(AlexAcc (alex_action_45))],[(AlexAcc (alex_action_46))],[(AlexAcc (alex_action_47))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_49))],[(AlexAcc (alex_action_50))],[(AlexAcc (alex_action_51))],[(AlexAcc (alex_action_52))],[(AlexAcc (alex_action_53))],[(AlexAcc (alex_action_54))],[(AlexAcc (alex_action_55))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_57))],[(AlexAcc (alex_action_58))],[]] +{-# LINE 226 "c2hs/c/CLexer.x" #-} + +-- We use the odd looking list of string patterns here rather than normal +-- string literals since GHC converts the latter into a sequence of string +-- comparisons (ie a linear search) but it translates the former using its +-- effecient pattern matching which gives us the expected radix-style search. +-- This gives change makes a significant performance difference. +-- +idkwtok :: String -> Position -> P CToken +idkwtok ('a':'l':'i':'g':'n':'o':'f':[]) = tok CTokAlignof +idkwtok ('_':'_':'a':'l':'i':'g':'n':'o':'f':[]) = tok CTokAlignof +idkwtok ('_':'_':'a':'l':'i':'g':'n':'o':'f':'_':'_':[]) = tok CTokAlignof +idkwtok ('a':'s':'m':[]) = tok CTokAsm +idkwtok ('_':'_':'a':'s':'m':[]) = tok CTokAsm +idkwtok ('_':'_':'a':'s':'m':'_':'_':[]) = tok CTokAsm +idkwtok ('a':'u':'t':'o':[]) = tok CTokAuto +idkwtok ('b':'r':'e':'a':'k':[]) = tok CTokBreak +idkwtok ('_':'B':'o':'o':'l':[]) = tok CTokBool +idkwtok ('c':'a':'s':'e':[]) = tok CTokCase +idkwtok ('c':'h':'a':'r':[]) = tok CTokChar +idkwtok ('c':'o':'n':'s':'t':[]) = tok CTokConst +idkwtok ('_':'_':'c':'o':'n':'s':'t':[]) = tok CTokConst +idkwtok ('_':'_':'c':'o':'n':'s':'t':'_':'_':[]) = tok CTokConst +idkwtok ('c':'o':'n':'t':'i':'n':'u':'e':[]) = tok CTokContinue +idkwtok ('_':'C':'o':'m':'p':'l':'e':'x':[]) = tok CTokComplex +idkwtok ('d':'e':'f':'a':'u':'l':'t':[]) = tok CTokDefault +idkwtok ('d':'o':[]) = tok CTokDo +idkwtok ('d':'o':'u':'b':'l':'e':[]) = tok CTokDouble +idkwtok ('e':'l':'s':'e':[]) = tok CTokElse +idkwtok ('e':'n':'u':'m':[]) = tok CTokEnum +idkwtok ('e':'x':'t':'e':'r':'n':[]) = tok CTokExtern +idkwtok ('f':'l':'o':'a':'t':[]) = tok CTokFloat +idkwtok ('f':'o':'r':[]) = tok CTokFor +idkwtok ('g':'o':'t':'o':[]) = tok CTokGoto +idkwtok ('i':'f':[]) = tok CTokIf +idkwtok ('i':'n':'l':'i':'n':'e':[]) = tok CTokInline +idkwtok ('_':'_':'i':'n':'l':'i':'n':'e':[]) = tok CTokInline +idkwtok ('_':'_':'i':'n':'l':'i':'n':'e':'_':'_':[]) = tok CTokInline +idkwtok ('i':'n':'t':[]) = tok CTokInt +idkwtok ('l':'o':'n':'g':[]) = tok CTokLong +idkwtok ('r':'e':'g':'i':'s':'t':'e':'r':[]) = tok CTokRegister +idkwtok ('r':'e':'s':'t':'r':'i':'c':'t':[]) = tok CTokRestrict +idkwtok ('_':'_':'r':'e':'s':'t':'r':'i':'c':'t':[]) = tok CTokRestrict +idkwtok ('_':'_':'r':'e':'s':'t':'r':'i':'c':'t':'_':'_':[]) = tok CTokRestrict +idkwtok ('r':'e':'t':'u':'r':'n':[]) = tok CTokReturn +idkwtok ('s':'h':'o':'r':'t':[]) = tok CTokShort +idkwtok ('s':'i':'g':'n':'e':'d':[]) = tok CTokSigned +idkwtok ('_':'_':'s':'i':'g':'n':'e':'d':[]) = tok CTokSigned +idkwtok ('_':'_':'s':'i':'g':'n':'e':'d':'_':'_':[]) = tok CTokSigned +idkwtok ('s':'i':'z':'e':'o':'f':[]) = tok CTokSizeof +idkwtok ('s':'t':'a':'t':'i':'c':[]) = tok CTokStatic +idkwtok ('s':'t':'r':'u':'c':'t':[]) = tok CTokStruct +idkwtok ('s':'w':'i':'t':'c':'h':[]) = tok CTokSwitch +idkwtok ('t':'y':'p':'e':'d':'e':'f':[]) = tok CTokTypedef +idkwtok ('t':'y':'p':'e':'o':'f':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'y':'p':'e':'o':'f':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'y':'p':'e':'o':'f':'_':'_':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'h':'r':'e':'a':'d':[]) = tok CTokThread +idkwtok ('u':'n':'i':'o':'n':[]) = tok CTokUnion +idkwtok ('u':'n':'s':'i':'g':'n':'e':'d':[]) = tok CTokUnsigned +idkwtok ('v':'o':'i':'d':[]) = tok CTokVoid +idkwtok ('v':'o':'l':'a':'t':'i':'l':'e':[]) = tok CTokVolatile +idkwtok ('_':'_':'v':'o':'l':'a':'t':'i':'l':'e':[]) = tok CTokVolatile +idkwtok ('_':'_':'v':'o':'l':'a':'t':'i':'l':'e':'_':'_':[]) = tok CTokVolatile +idkwtok ('w':'h':'i':'l':'e':[]) = tok CTokWhile +idkwtok ('_':'_':'l':'a':'b':'e':'l':'_':'_':[]) = tok CTokLabel +idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':[]) = tok (CTokGnuC GnuCAttrTok) +-- ignoreAttribute >> lexToken +idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':'_':'_':[]) = tok (CTokGnuC GnuCAttrTok) +-- ignoreAttribute >> lexToken +idkwtok ('_':'_':'e':'x':'t':'e':'n':'s':'i':'o':'n':'_':'_':[]) = + tok (CTokGnuC GnuCExtTok) +idkwtok ('_':'_':'b':'u':'i':'l':'t':'i':'n':'_':rest) + | rest == "va_arg" = tok (CTokGnuC GnuCVaArg) + | rest == "offsetof" = tok (CTokGnuC GnuCOffsetof) + | rest == "types_compatible_p" = tok (CTokGnuC GnuCTyCompat) + +idkwtok cs = \pos -> do + name <- getNewName + let ident = lexemeToIdent pos cs name + tyident <- isTypeIdent ident + if tyident + then return (CTokTyIdent pos ident) + else return (CTokIdent pos ident) + +ignoreAttribute :: P () +ignoreAttribute = skipTokens 0 + where skipTokens n = do + tok <- lexToken + case tok of + CTokRParen _ | n == 1 -> return () + | otherwise -> skipTokens (n-1) + CTokLParen _ -> skipTokens (n+1) + _ -> skipTokens n + +tok :: (Position -> CToken) -> Position -> P CToken +tok tc pos = return (tc pos) + +-- converts the first character denotation of a C-style string to a character +-- and the remaining string +-- +oneChar :: String -> (Char, String) +oneChar ('\\':c:cs) = case c of + 'n' -> ('\n', cs) + 't' -> ('\t', cs) + 'v' -> ('\v', cs) + 'b' -> ('\b', cs) + 'r' -> ('\r', cs) + 'f' -> ('\f', cs) + 'a' -> ('\a', cs) + 'e' -> ('\ESC', cs) --GNU C extension + '\\' -> ('\\', cs) + '?' -> ('?', cs) + '\'' -> ('\'', cs) + '"' -> ('"', cs) + 'x' -> case head (readHex cs) of + (i, cs') -> (toEnum i, cs') + _ -> case head (readOct (c:cs)) of + (i, cs') -> (toEnum i, cs') +oneChar (c :cs) = (c, cs) + +normalizeEscapes [] = [] +normalizeEscapes cs = case oneChar cs of + (c, cs') -> c : normalizeEscapes cs' + +adjustPos :: String -> Position -> Position +adjustPos str (Position fname row _) = Position fname' row' 0 + where + str' = dropWhite . drop 1 $ str + (rowStr, str'') = span isDigit str' + row' = read rowStr + str''' = dropWhite str'' + fnameStr = takeWhile (/= '"') . drop 1 $ str''' + fname' | null str''' || head str''' /= '"' = fname + -- try and get more sharing of file name strings + | fnameStr == fname = fname + | otherwise = fnameStr + -- + dropWhite = dropWhile (\c -> c == ' ' || c == '\t') + +{-# INLINE token_ #-} +-- token that ignores the string +token_ :: (Position -> CToken) -> Position -> Int -> String -> P CToken +token_ tok pos _ _ = return (tok pos) + +{-# INLINE token #-} +-- token that uses the string +token :: (Position -> a -> CToken) -> (String -> a) + -> Position -> Int -> String -> P CToken +token tok read pos len str = return (tok pos (read $ take len str)) + + +-- ----------------------------------------------------------------------------- +-- The input type + +type AlexInput = (Position, -- current position, + String) -- current input string + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar _ = error "alexInputPrevChar not used" + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p,[]) = Nothing +alexGetChar (p,(c:s)) = let p' = alexMove p c in p' `seq` + Just (c, (p', s)) + +alexMove :: Position -> Char -> Position +alexMove (Position f l c) '\t' = Position f l (((c+7) `div` 8)*8+1) +alexMove (Position f l c) '\n' = Position f (l+1) 1 +alexMove (Position f l c) _ = Position f l (c+1) + +lexicalError :: P a +lexicalError = do + pos <- getPos + (c:cs) <- getInput + failP pos + ["Lexical error!", + "The character " ++ show c ++ " does not fit here."] + +parseError :: P a +parseError = do + tok <- getLastToken + failP (posOf tok) + ["Syntax error!", + "The symbol `" ++ show tok ++ "' does not fit here."] + +lexToken :: P CToken +lexToken = do + pos <- getPos + inp <- getInput + case alexScan (pos, inp) 0 of + AlexEOF -> return CTokEof + AlexError inp' -> lexicalError + AlexSkip (pos', inp') len -> do + setPos pos' + setInput inp' + lexToken + AlexToken (pos', inp') len action -> do + setPos pos' + setInput inp' + tok <- action pos len inp + setLastToken tok + return tok + +lexC :: (CToken -> P a) -> P a +lexC cont = do + tok <- lexToken + cont tok + +alex_action_1 = \pos len str -> setPos (adjustPos (take len str) pos) >> lexToken +alex_action_4 = \pos len str -> idkwtok (take len str) pos +alex_action_5 = token CTokILit (fst . head . readOct) +alex_action_6 = token CTokILit (fst . head . readDec) +alex_action_7 = token CTokILit (fst . head . readHex . drop 2) +alex_action_8 = token CTokCLit (fst . oneChar . tail) +alex_action_9 = token CTokCLit (fst . oneChar . tail . tail) +alex_action_10 = token CTokFLit id +alex_action_11 = token CTokSLit normalizeEscapes +alex_action_12 = token CTokSLit (normalizeEscapes . tail) +alex_action_13 = token_ CTokLParen +alex_action_14 = token_ CTokRParen +alex_action_15 = token_ CTokLBracket +alex_action_16 = token_ CTokRBracket +alex_action_17 = token_ CTokArrow +alex_action_18 = token_ CTokDot +alex_action_19 = token_ CTokExclam +alex_action_20 = token_ CTokTilde +alex_action_21 = token_ CTokInc +alex_action_22 = token_ CTokDec +alex_action_23 = token_ CTokPlus +alex_action_24 = token_ CTokMinus +alex_action_25 = token_ CTokStar +alex_action_26 = token_ CTokSlash +alex_action_27 = token_ CTokPercent +alex_action_28 = token_ CTokAmper +alex_action_29 = token_ CTokShiftL +alex_action_30 = token_ CTokShiftR +alex_action_31 = token_ CTokLess +alex_action_32 = token_ CTokLessEq +alex_action_33 = token_ CTokHigh +alex_action_34 = token_ CTokHighEq +alex_action_35 = token_ CTokEqual +alex_action_36 = token_ CTokUnequal +alex_action_37 = token_ CTokHat +alex_action_38 = token_ CTokBar +alex_action_39 = token_ CTokAnd +alex_action_40 = token_ CTokOr +alex_action_41 = token_ CTokQuest +alex_action_42 = token_ CTokColon +alex_action_43 = token_ CTokAssign +alex_action_44 = token_ CTokPlusAss +alex_action_45 = token_ CTokMinusAss +alex_action_46 = token_ CTokStarAss +alex_action_47 = token_ CTokSlashAss +alex_action_48 = token_ CTokPercAss +alex_action_49 = token_ CTokAmpAss +alex_action_50 = token_ CTokHatAss +alex_action_51 = token_ CTokBarAss +alex_action_52 = token_ CTokSLAss +alex_action_53 = token_ CTokSRAss +alex_action_54 = token_ CTokComma +alex_action_55 = token_ CTokSemic +alex_action_56 = token_ CTokLBrace +alex_action_57 = token_ CTokRBrace +alex_action_58 = token_ CTokEllipsis +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 35 "GenericTemplate.hs" #-} + +{-# LINE 45 "GenericTemplate.hs" #-} + + +data AlexAddr = AlexA# Addr# + +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input (I# (sc)) + = alexScanUser undefined input (I# (sc)) + +alexScanUser user input (I# (sc)) + = case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, input') -> + case alexGetChar input of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input' + + (AlexLastSkip input len, _) -> + + + + AlexSkip input len + + (AlexLastAcc k input len, _) -> + + + + AlexToken input len k + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user orig_input len input s last_acc = + input `seq` -- strict in the input + let + new_acc = check_accs (alex_accept `quickIndex` (I# (s))) + in + new_acc `seq` + case alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + base = alexIndexInt32OffAddr alex_base s + (I# (ord_c)) = ord c + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if (offset >=# 0#) && (check ==# ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + -1# -> (new_acc, input) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user orig_input (len +# 1#) + new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) + check_accs (AlexAccPred a pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkipPred pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastSkip input (I# (len)) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (I# (i)) = i diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,347 @@ +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + + + + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. + diff --git a/CParser.hs b/CParser.hs new file mode 100644 --- /dev/null +++ b/CParser.hs @@ -0,0 +1,5712 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +module CParser (parseC) where + +import Prelude hiding (reverse) +import qualified Data.List as List + +import Position (Position, Pos(..), nopos) +import UNames (names) +import Idents (Ident) +import Attributes (Attrs, newAttrs, newAttrsOnlyPos) + +import State (PreCST, raiseFatal, getNameSupply) +import CLexer (lexC, parseError) +import CAST (CHeader(..), CExtDecl(..), CFunDef(..), CStat(..), + CBlockItem(..), CDecl(..), CDeclSpec(..), CStorageSpec(..), + CTypeSpec(..), CTypeQual(..), CStructUnion(..), + CStructTag(..), CEnum(..), CDeclr(..), CInit(..), CInitList, + CDesignator(..), CExpr(..), CAssignOp(..), CBinaryOp(..), + CUnaryOp(..), CConst (..)) +import CBuiltin (builtinTypeNames) +import CTokens (CToken(..), GnuCTok(..)) +import CParserMonad (P, execParser, getNewName, addTypedef, shadowTypedef, + enterScope, leaveScope ) +#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.16 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn4 :: (CHeader) -> (HappyAbsSyn ) +happyIn4 x = unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> (CHeader) +happyOut4 x = unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: (Reversed [CExtDecl]) -> (HappyAbsSyn ) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (Reversed [CExtDecl]) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (CExtDecl) -> (HappyAbsSyn ) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> (CExtDecl) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (CFunDef) -> (HappyAbsSyn ) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (CFunDef) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (CDeclr) -> (HappyAbsSyn ) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (CDeclr) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (Reversed [CDecl]) -> (HappyAbsSyn ) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (Reversed [CDecl]) +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (CStat) -> (HappyAbsSyn ) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (CStat) +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (CStat) -> (HappyAbsSyn ) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (CStat) +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (CStat) -> (HappyAbsSyn ) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (CStat) +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: (()) -> (HappyAbsSyn ) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn ) -> (()) +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: (()) -> (HappyAbsSyn ) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn ) -> (()) +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: (Reversed [CBlockItem]) -> (HappyAbsSyn ) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn ) -> (Reversed [CBlockItem]) +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: (CBlockItem) -> (HappyAbsSyn ) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> (CBlockItem) +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: (CBlockItem) -> (HappyAbsSyn ) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> (CBlockItem) +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: (CFunDef) -> (HappyAbsSyn ) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> (CFunDef) +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: (()) -> (HappyAbsSyn ) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> (()) +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: (CStat) -> (HappyAbsSyn ) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> (CStat) +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: (CStat) -> (HappyAbsSyn ) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> (CStat) +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: (CStat) -> (HappyAbsSyn ) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> (CStat) +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: (CStat) -> (HappyAbsSyn ) +happyIn23 x = unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> (CStat) +happyOut23 x = unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: (CStat) -> (HappyAbsSyn ) +happyIn24 x = unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> (CStat) +happyOut24 x = unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: (()) -> (HappyAbsSyn ) +happyIn25 x = unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> (()) +happyOut25 x = unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (()) -> (HappyAbsSyn ) +happyIn26 x = unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> (()) +happyOut26 x = unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: (()) -> (HappyAbsSyn ) +happyIn27 x = unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> (()) +happyOut27 x = unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: (()) -> (HappyAbsSyn ) +happyIn28 x = unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> (()) +happyOut28 x = unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: (()) -> (HappyAbsSyn ) +happyIn29 x = unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> (()) +happyOut29 x = unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: (CDecl) -> (HappyAbsSyn ) +happyIn30 x = unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> (CDecl) +happyOut30 x = unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (CDecl) -> (HappyAbsSyn ) +happyIn31 x = unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> (CDecl) +happyOut31 x = unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: (CDecl) -> (HappyAbsSyn ) +happyIn32 x = unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> (CDecl) +happyOut32 x = unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: ([CDeclSpec]) -> (HappyAbsSyn ) +happyIn33 x = unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> ([CDeclSpec]) +happyOut33 x = unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn34 x = unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut34 x = unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: (CDeclSpec) -> (HappyAbsSyn ) +happyIn35 x = unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> (CDeclSpec) +happyOut35 x = unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: (CStorageSpec) -> (HappyAbsSyn ) +happyIn36 x = unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> (CStorageSpec) +happyOut36 x = unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: ([CDeclSpec]) -> (HappyAbsSyn ) +happyIn37 x = unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> ([CDeclSpec]) +happyOut37 x = unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: (CTypeSpec) -> (HappyAbsSyn ) +happyIn38 x = unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> (CTypeSpec) +happyOut38 x = unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn39 x = unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut39 x = unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn40 x = unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut40 x = unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn41 x = unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut41 x = unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn42 x = unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut42 x = unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn43 x = unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut43 x = unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) +happyIn44 x = unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) +happyOut44 x = unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: (CTypeSpec) -> (HappyAbsSyn ) +happyIn45 x = unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> (CTypeSpec) +happyOut45 x = unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: (CStructUnion) -> (HappyAbsSyn ) +happyIn46 x = unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> (CStructUnion) +happyOut46 x = unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: (Located CStructTag) -> (HappyAbsSyn ) +happyIn47 x = unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> (Located CStructTag) +happyOut47 x = unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: (Reversed [CDecl]) -> (HappyAbsSyn ) +happyIn48 x = unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> (Reversed [CDecl]) +happyOut48 x = unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyIn49 :: (CDecl) -> (HappyAbsSyn ) +happyIn49 x = unsafeCoerce# x +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> (CDecl) +happyOut49 x = unsafeCoerce# x +{-# INLINE happyOut49 #-} +happyIn50 :: (CDecl) -> (HappyAbsSyn ) +happyIn50 x = unsafeCoerce# x +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> (CDecl) +happyOut50 x = unsafeCoerce# x +{-# INLINE happyOut50 #-} +happyIn51 :: (CDecl) -> (HappyAbsSyn ) +happyIn51 x = unsafeCoerce# x +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> (CDecl) +happyOut51 x = unsafeCoerce# x +{-# INLINE happyOut51 #-} +happyIn52 :: ((Maybe CDeclr, Maybe CExpr)) -> (HappyAbsSyn ) +happyIn52 x = unsafeCoerce# x +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn ) -> ((Maybe CDeclr, Maybe CExpr)) +happyOut52 x = unsafeCoerce# x +{-# INLINE happyOut52 #-} +happyIn53 :: ((Maybe CDeclr, Maybe CExpr)) -> (HappyAbsSyn ) +happyIn53 x = unsafeCoerce# x +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn ) -> ((Maybe CDeclr, Maybe CExpr)) +happyOut53 x = unsafeCoerce# x +{-# INLINE happyOut53 #-} +happyIn54 :: (CEnum) -> (HappyAbsSyn ) +happyIn54 x = unsafeCoerce# x +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn ) -> (CEnum) +happyOut54 x = unsafeCoerce# x +{-# INLINE happyOut54 #-} +happyIn55 :: (Reversed [(Ident, Maybe CExpr)]) -> (HappyAbsSyn ) +happyIn55 x = unsafeCoerce# x +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn ) -> (Reversed [(Ident, Maybe CExpr)]) +happyOut55 x = unsafeCoerce# x +{-# INLINE happyOut55 #-} +happyIn56 :: ((Ident, Maybe CExpr)) -> (HappyAbsSyn ) +happyIn56 x = unsafeCoerce# x +{-# INLINE happyIn56 #-} +happyOut56 :: (HappyAbsSyn ) -> ((Ident, Maybe CExpr)) +happyOut56 x = unsafeCoerce# x +{-# INLINE happyOut56 #-} +happyIn57 :: (CTypeQual) -> (HappyAbsSyn ) +happyIn57 x = unsafeCoerce# x +{-# INLINE happyIn57 #-} +happyOut57 :: (HappyAbsSyn ) -> (CTypeQual) +happyOut57 x = unsafeCoerce# x +{-# INLINE happyOut57 #-} +happyIn58 :: (CDeclr) -> (HappyAbsSyn ) +happyIn58 x = unsafeCoerce# x +{-# INLINE happyIn58 #-} +happyOut58 :: (HappyAbsSyn ) -> (CDeclr) +happyOut58 x = unsafeCoerce# x +{-# INLINE happyOut58 #-} +happyIn59 :: (()) -> (HappyAbsSyn ) +happyIn59 x = unsafeCoerce# x +{-# INLINE happyIn59 #-} +happyOut59 :: (HappyAbsSyn ) -> (()) +happyOut59 x = unsafeCoerce# x +{-# INLINE happyOut59 #-} +happyIn60 :: (CDeclr) -> (HappyAbsSyn ) +happyIn60 x = unsafeCoerce# x +{-# INLINE happyIn60 #-} +happyOut60 :: (HappyAbsSyn ) -> (CDeclr) +happyOut60 x = unsafeCoerce# x +{-# INLINE happyOut60 #-} +happyIn61 :: (CDeclr) -> (HappyAbsSyn ) +happyIn61 x = unsafeCoerce# x +{-# INLINE happyIn61 #-} +happyOut61 :: (HappyAbsSyn ) -> (CDeclr) +happyOut61 x = unsafeCoerce# x +{-# INLINE happyOut61 #-} +happyIn62 :: (CDeclr) -> (HappyAbsSyn ) +happyIn62 x = unsafeCoerce# x +{-# INLINE happyIn62 #-} +happyOut62 :: (HappyAbsSyn ) -> (CDeclr) +happyOut62 x = unsafeCoerce# x +{-# INLINE happyOut62 #-} +happyIn63 :: (CDeclr) -> (HappyAbsSyn ) +happyIn63 x = unsafeCoerce# x +{-# INLINE happyIn63 #-} +happyOut63 :: (HappyAbsSyn ) -> (CDeclr) +happyOut63 x = unsafeCoerce# x +{-# INLINE happyOut63 #-} +happyIn64 :: (CDeclr) -> (HappyAbsSyn ) +happyIn64 x = unsafeCoerce# x +{-# INLINE happyIn64 #-} +happyOut64 :: (HappyAbsSyn ) -> (CDeclr) +happyOut64 x = unsafeCoerce# x +{-# INLINE happyOut64 #-} +happyIn65 :: (CDeclr) -> (HappyAbsSyn ) +happyIn65 x = unsafeCoerce# x +{-# INLINE happyIn65 #-} +happyOut65 :: (HappyAbsSyn ) -> (CDeclr) +happyOut65 x = unsafeCoerce# x +{-# INLINE happyOut65 #-} +happyIn66 :: (CDeclr) -> (HappyAbsSyn ) +happyIn66 x = unsafeCoerce# x +{-# INLINE happyIn66 #-} +happyOut66 :: (HappyAbsSyn ) -> (CDeclr) +happyOut66 x = unsafeCoerce# x +{-# INLINE happyOut66 #-} +happyIn67 :: (CDeclr) -> (HappyAbsSyn ) +happyIn67 x = unsafeCoerce# x +{-# INLINE happyIn67 #-} +happyOut67 :: (HappyAbsSyn ) -> (CDeclr) +happyOut67 x = unsafeCoerce# x +{-# INLINE happyOut67 #-} +happyIn68 :: (CDeclr) -> (HappyAbsSyn ) +happyIn68 x = unsafeCoerce# x +{-# INLINE happyIn68 #-} +happyOut68 :: (HappyAbsSyn ) -> (CDeclr) +happyOut68 x = unsafeCoerce# x +{-# INLINE happyOut68 #-} +happyIn69 :: (CDeclr) -> (HappyAbsSyn ) +happyIn69 x = unsafeCoerce# x +{-# INLINE happyIn69 #-} +happyOut69 :: (HappyAbsSyn ) -> (CDeclr) +happyOut69 x = unsafeCoerce# x +{-# INLINE happyOut69 #-} +happyIn70 :: (CDeclr) -> (HappyAbsSyn ) +happyIn70 x = unsafeCoerce# x +{-# INLINE happyIn70 #-} +happyOut70 :: (HappyAbsSyn ) -> (CDeclr) +happyOut70 x = unsafeCoerce# x +{-# INLINE happyOut70 #-} +happyIn71 :: (CDeclr) -> (HappyAbsSyn ) +happyIn71 x = unsafeCoerce# x +{-# INLINE happyIn71 #-} +happyOut71 :: (HappyAbsSyn ) -> (CDeclr) +happyOut71 x = unsafeCoerce# x +{-# INLINE happyOut71 #-} +happyIn72 :: (CDeclr) -> (HappyAbsSyn ) +happyIn72 x = unsafeCoerce# x +{-# INLINE happyIn72 #-} +happyOut72 :: (HappyAbsSyn ) -> (CDeclr) +happyOut72 x = unsafeCoerce# x +{-# INLINE happyOut72 #-} +happyIn73 :: (Reversed [CTypeQual]) -> (HappyAbsSyn ) +happyIn73 x = unsafeCoerce# x +{-# INLINE happyIn73 #-} +happyOut73 :: (HappyAbsSyn ) -> (Reversed [CTypeQual]) +happyOut73 x = unsafeCoerce# x +{-# INLINE happyOut73 #-} +happyIn74 :: (([CDecl], Bool)) -> (HappyAbsSyn ) +happyIn74 x = unsafeCoerce# x +{-# INLINE happyIn74 #-} +happyOut74 :: (HappyAbsSyn ) -> (([CDecl], Bool)) +happyOut74 x = unsafeCoerce# x +{-# INLINE happyOut74 #-} +happyIn75 :: (Reversed [CDecl]) -> (HappyAbsSyn ) +happyIn75 x = unsafeCoerce# x +{-# INLINE happyIn75 #-} +happyOut75 :: (HappyAbsSyn ) -> (Reversed [CDecl]) +happyOut75 x = unsafeCoerce# x +{-# INLINE happyOut75 #-} +happyIn76 :: (CDecl) -> (HappyAbsSyn ) +happyIn76 x = unsafeCoerce# x +{-# INLINE happyIn76 #-} +happyOut76 :: (HappyAbsSyn ) -> (CDecl) +happyOut76 x = unsafeCoerce# x +{-# INLINE happyOut76 #-} +happyIn77 :: (Reversed [Ident]) -> (HappyAbsSyn ) +happyIn77 x = unsafeCoerce# x +{-# INLINE happyIn77 #-} +happyOut77 :: (HappyAbsSyn ) -> (Reversed [Ident]) +happyOut77 x = unsafeCoerce# x +{-# INLINE happyOut77 #-} +happyIn78 :: (CDecl) -> (HappyAbsSyn ) +happyIn78 x = unsafeCoerce# x +{-# INLINE happyIn78 #-} +happyOut78 :: (HappyAbsSyn ) -> (CDecl) +happyOut78 x = unsafeCoerce# x +{-# INLINE happyOut78 #-} +happyIn79 :: (CDeclr) -> (HappyAbsSyn ) +happyIn79 x = unsafeCoerce# x +{-# INLINE happyIn79 #-} +happyOut79 :: (HappyAbsSyn ) -> (CDeclr) +happyOut79 x = unsafeCoerce# x +{-# INLINE happyOut79 #-} +happyIn80 :: (CDeclr -> CDeclr) -> (HappyAbsSyn ) +happyIn80 x = unsafeCoerce# x +{-# INLINE happyIn80 #-} +happyOut80 :: (HappyAbsSyn ) -> (CDeclr -> CDeclr) +happyOut80 x = unsafeCoerce# x +{-# INLINE happyOut80 #-} +happyIn81 :: (CDeclr -> CDeclr) -> (HappyAbsSyn ) +happyIn81 x = unsafeCoerce# x +{-# INLINE happyIn81 #-} +happyOut81 :: (HappyAbsSyn ) -> (CDeclr -> CDeclr) +happyOut81 x = unsafeCoerce# x +{-# INLINE happyOut81 #-} +happyIn82 :: (CDeclr -> CDeclr) -> (HappyAbsSyn ) +happyIn82 x = unsafeCoerce# x +{-# INLINE happyIn82 #-} +happyOut82 :: (HappyAbsSyn ) -> (CDeclr -> CDeclr) +happyOut82 x = unsafeCoerce# x +{-# INLINE happyOut82 #-} +happyIn83 :: (CDeclr) -> (HappyAbsSyn ) +happyIn83 x = unsafeCoerce# x +{-# INLINE happyIn83 #-} +happyOut83 :: (HappyAbsSyn ) -> (CDeclr) +happyOut83 x = unsafeCoerce# x +{-# INLINE happyOut83 #-} +happyIn84 :: (CDeclr) -> (HappyAbsSyn ) +happyIn84 x = unsafeCoerce# x +{-# INLINE happyIn84 #-} +happyOut84 :: (HappyAbsSyn ) -> (CDeclr) +happyOut84 x = unsafeCoerce# x +{-# INLINE happyOut84 #-} +happyIn85 :: (CInit) -> (HappyAbsSyn ) +happyIn85 x = unsafeCoerce# x +{-# INLINE happyIn85 #-} +happyOut85 :: (HappyAbsSyn ) -> (CInit) +happyOut85 x = unsafeCoerce# x +{-# INLINE happyOut85 #-} +happyIn86 :: (Maybe CInit) -> (HappyAbsSyn ) +happyIn86 x = unsafeCoerce# x +{-# INLINE happyIn86 #-} +happyOut86 :: (HappyAbsSyn ) -> (Maybe CInit) +happyOut86 x = unsafeCoerce# x +{-# INLINE happyOut86 #-} +happyIn87 :: (Reversed CInitList) -> (HappyAbsSyn ) +happyIn87 x = unsafeCoerce# x +{-# INLINE happyIn87 #-} +happyOut87 :: (HappyAbsSyn ) -> (Reversed CInitList) +happyOut87 x = unsafeCoerce# x +{-# INLINE happyOut87 #-} +happyIn88 :: ([CDesignator]) -> (HappyAbsSyn ) +happyIn88 x = unsafeCoerce# x +{-# INLINE happyIn88 #-} +happyOut88 :: (HappyAbsSyn ) -> ([CDesignator]) +happyOut88 x = unsafeCoerce# x +{-# INLINE happyOut88 #-} +happyIn89 :: (Reversed [CDesignator]) -> (HappyAbsSyn ) +happyIn89 x = unsafeCoerce# x +{-# INLINE happyIn89 #-} +happyOut89 :: (HappyAbsSyn ) -> (Reversed [CDesignator]) +happyOut89 x = unsafeCoerce# x +{-# INLINE happyOut89 #-} +happyIn90 :: (CDesignator) -> (HappyAbsSyn ) +happyIn90 x = unsafeCoerce# x +{-# INLINE happyIn90 #-} +happyOut90 :: (HappyAbsSyn ) -> (CDesignator) +happyOut90 x = unsafeCoerce# x +{-# INLINE happyOut90 #-} +happyIn91 :: (CDesignator) -> (HappyAbsSyn ) +happyIn91 x = unsafeCoerce# x +{-# INLINE happyIn91 #-} +happyOut91 :: (HappyAbsSyn ) -> (CDesignator) +happyOut91 x = unsafeCoerce# x +{-# INLINE happyOut91 #-} +happyIn92 :: (CExpr) -> (HappyAbsSyn ) +happyIn92 x = unsafeCoerce# x +{-# INLINE happyIn92 #-} +happyOut92 :: (HappyAbsSyn ) -> (CExpr) +happyOut92 x = unsafeCoerce# x +{-# INLINE happyOut92 #-} +happyIn93 :: (()) -> (HappyAbsSyn ) +happyIn93 x = unsafeCoerce# x +{-# INLINE happyIn93 #-} +happyOut93 :: (HappyAbsSyn ) -> (()) +happyOut93 x = unsafeCoerce# x +{-# INLINE happyOut93 #-} +happyIn94 :: (CExpr) -> (HappyAbsSyn ) +happyIn94 x = unsafeCoerce# x +{-# INLINE happyIn94 #-} +happyOut94 :: (HappyAbsSyn ) -> (CExpr) +happyOut94 x = unsafeCoerce# x +{-# INLINE happyOut94 #-} +happyIn95 :: (Reversed [CExpr]) -> (HappyAbsSyn ) +happyIn95 x = unsafeCoerce# x +{-# INLINE happyIn95 #-} +happyOut95 :: (HappyAbsSyn ) -> (Reversed [CExpr]) +happyOut95 x = unsafeCoerce# x +{-# INLINE happyOut95 #-} +happyIn96 :: (CExpr) -> (HappyAbsSyn ) +happyIn96 x = unsafeCoerce# x +{-# INLINE happyIn96 #-} +happyOut96 :: (HappyAbsSyn ) -> (CExpr) +happyOut96 x = unsafeCoerce# x +{-# INLINE happyOut96 #-} +happyIn97 :: (Located CUnaryOp) -> (HappyAbsSyn ) +happyIn97 x = unsafeCoerce# x +{-# INLINE happyIn97 #-} +happyOut97 :: (HappyAbsSyn ) -> (Located CUnaryOp) +happyOut97 x = unsafeCoerce# x +{-# INLINE happyOut97 #-} +happyIn98 :: (CExpr) -> (HappyAbsSyn ) +happyIn98 x = unsafeCoerce# x +{-# INLINE happyIn98 #-} +happyOut98 :: (HappyAbsSyn ) -> (CExpr) +happyOut98 x = unsafeCoerce# x +{-# INLINE happyOut98 #-} +happyIn99 :: (CExpr) -> (HappyAbsSyn ) +happyIn99 x = unsafeCoerce# x +{-# INLINE happyIn99 #-} +happyOut99 :: (HappyAbsSyn ) -> (CExpr) +happyOut99 x = unsafeCoerce# x +{-# INLINE happyOut99 #-} +happyIn100 :: (CExpr) -> (HappyAbsSyn ) +happyIn100 x = unsafeCoerce# x +{-# INLINE happyIn100 #-} +happyOut100 :: (HappyAbsSyn ) -> (CExpr) +happyOut100 x = unsafeCoerce# x +{-# INLINE happyOut100 #-} +happyIn101 :: (CExpr) -> (HappyAbsSyn ) +happyIn101 x = unsafeCoerce# x +{-# INLINE happyIn101 #-} +happyOut101 :: (HappyAbsSyn ) -> (CExpr) +happyOut101 x = unsafeCoerce# x +{-# INLINE happyOut101 #-} +happyIn102 :: (CExpr) -> (HappyAbsSyn ) +happyIn102 x = unsafeCoerce# x +{-# INLINE happyIn102 #-} +happyOut102 :: (HappyAbsSyn ) -> (CExpr) +happyOut102 x = unsafeCoerce# x +{-# INLINE happyOut102 #-} +happyIn103 :: (CExpr) -> (HappyAbsSyn ) +happyIn103 x = unsafeCoerce# x +{-# INLINE happyIn103 #-} +happyOut103 :: (HappyAbsSyn ) -> (CExpr) +happyOut103 x = unsafeCoerce# x +{-# INLINE happyOut103 #-} +happyIn104 :: (CExpr) -> (HappyAbsSyn ) +happyIn104 x = unsafeCoerce# x +{-# INLINE happyIn104 #-} +happyOut104 :: (HappyAbsSyn ) -> (CExpr) +happyOut104 x = unsafeCoerce# x +{-# INLINE happyOut104 #-} +happyIn105 :: (CExpr) -> (HappyAbsSyn ) +happyIn105 x = unsafeCoerce# x +{-# INLINE happyIn105 #-} +happyOut105 :: (HappyAbsSyn ) -> (CExpr) +happyOut105 x = unsafeCoerce# x +{-# INLINE happyOut105 #-} +happyIn106 :: (CExpr) -> (HappyAbsSyn ) +happyIn106 x = unsafeCoerce# x +{-# INLINE happyIn106 #-} +happyOut106 :: (HappyAbsSyn ) -> (CExpr) +happyOut106 x = unsafeCoerce# x +{-# INLINE happyOut106 #-} +happyIn107 :: (CExpr) -> (HappyAbsSyn ) +happyIn107 x = unsafeCoerce# x +{-# INLINE happyIn107 #-} +happyOut107 :: (HappyAbsSyn ) -> (CExpr) +happyOut107 x = unsafeCoerce# x +{-# INLINE happyOut107 #-} +happyIn108 :: (CExpr) -> (HappyAbsSyn ) +happyIn108 x = unsafeCoerce# x +{-# INLINE happyIn108 #-} +happyOut108 :: (HappyAbsSyn ) -> (CExpr) +happyOut108 x = unsafeCoerce# x +{-# INLINE happyOut108 #-} +happyIn109 :: (CExpr) -> (HappyAbsSyn ) +happyIn109 x = unsafeCoerce# x +{-# INLINE happyIn109 #-} +happyOut109 :: (HappyAbsSyn ) -> (CExpr) +happyOut109 x = unsafeCoerce# x +{-# INLINE happyOut109 #-} +happyIn110 :: (CExpr) -> (HappyAbsSyn ) +happyIn110 x = unsafeCoerce# x +{-# INLINE happyIn110 #-} +happyOut110 :: (HappyAbsSyn ) -> (CExpr) +happyOut110 x = unsafeCoerce# x +{-# INLINE happyOut110 #-} +happyIn111 :: (Located CAssignOp) -> (HappyAbsSyn ) +happyIn111 x = unsafeCoerce# x +{-# INLINE happyIn111 #-} +happyOut111 :: (HappyAbsSyn ) -> (Located CAssignOp) +happyOut111 x = unsafeCoerce# x +{-# INLINE happyOut111 #-} +happyIn112 :: (CExpr) -> (HappyAbsSyn ) +happyIn112 x = unsafeCoerce# x +{-# INLINE happyIn112 #-} +happyOut112 :: (HappyAbsSyn ) -> (CExpr) +happyOut112 x = unsafeCoerce# x +{-# INLINE happyOut112 #-} +happyIn113 :: (Reversed [CExpr]) -> (HappyAbsSyn ) +happyIn113 x = unsafeCoerce# x +{-# INLINE happyIn113 #-} +happyOut113 :: (HappyAbsSyn ) -> (Reversed [CExpr]) +happyOut113 x = unsafeCoerce# x +{-# INLINE happyOut113 #-} +happyIn114 :: (Maybe CExpr) -> (HappyAbsSyn ) +happyIn114 x = unsafeCoerce# x +{-# INLINE happyIn114 #-} +happyOut114 :: (HappyAbsSyn ) -> (Maybe CExpr) +happyOut114 x = unsafeCoerce# x +{-# INLINE happyOut114 #-} +happyIn115 :: (Maybe CExpr) -> (HappyAbsSyn ) +happyIn115 x = unsafeCoerce# x +{-# INLINE happyIn115 #-} +happyOut115 :: (HappyAbsSyn ) -> (Maybe CExpr) +happyOut115 x = unsafeCoerce# x +{-# INLINE happyOut115 #-} +happyIn116 :: (CExpr) -> (HappyAbsSyn ) +happyIn116 x = unsafeCoerce# x +{-# INLINE happyIn116 #-} +happyOut116 :: (HappyAbsSyn ) -> (CExpr) +happyOut116 x = unsafeCoerce# x +{-# INLINE happyOut116 #-} +happyIn117 :: (CConst) -> (HappyAbsSyn ) +happyIn117 x = unsafeCoerce# x +{-# INLINE happyIn117 #-} +happyOut117 :: (HappyAbsSyn ) -> (CConst) +happyOut117 x = unsafeCoerce# x +{-# INLINE happyOut117 #-} +happyIn118 :: (CConst) -> (HappyAbsSyn ) +happyIn118 x = unsafeCoerce# x +{-# INLINE happyIn118 #-} +happyOut118 :: (HappyAbsSyn ) -> (CConst) +happyOut118 x = unsafeCoerce# x +{-# INLINE happyOut118 #-} +happyIn119 :: (Reversed [String]) -> (HappyAbsSyn ) +happyIn119 x = unsafeCoerce# x +{-# INLINE happyIn119 #-} +happyOut119 :: (HappyAbsSyn ) -> (Reversed [String]) +happyOut119 x = unsafeCoerce# x +{-# INLINE happyOut119 #-} +happyIn120 :: (Ident) -> (HappyAbsSyn ) +happyIn120 x = unsafeCoerce# x +{-# INLINE happyIn120 #-} +happyOut120 :: (HappyAbsSyn ) -> (Ident) +happyOut120 x = unsafeCoerce# x +{-# INLINE happyOut120 #-} +happyIn121 :: (()) -> (HappyAbsSyn ) +happyIn121 x = unsafeCoerce# x +{-# INLINE happyIn121 #-} +happyOut121 :: (HappyAbsSyn ) -> (()) +happyOut121 x = unsafeCoerce# x +{-# INLINE happyOut121 #-} +happyIn122 :: (()) -> (HappyAbsSyn ) +happyIn122 x = unsafeCoerce# x +{-# INLINE happyIn122 #-} +happyOut122 :: (HappyAbsSyn ) -> (()) +happyOut122 x = unsafeCoerce# x +{-# INLINE happyOut122 #-} +happyIn123 :: (()) -> (HappyAbsSyn ) +happyIn123 x = unsafeCoerce# x +{-# INLINE happyIn123 #-} +happyOut123 :: (HappyAbsSyn ) -> (()) +happyOut123 x = unsafeCoerce# x +{-# INLINE happyOut123 #-} +happyIn124 :: (()) -> (HappyAbsSyn ) +happyIn124 x = unsafeCoerce# x +{-# INLINE happyIn124 #-} +happyOut124 :: (HappyAbsSyn ) -> (()) +happyOut124 x = unsafeCoerce# x +{-# INLINE happyOut124 #-} +happyIn125 :: (()) -> (HappyAbsSyn ) +happyIn125 x = unsafeCoerce# x +{-# INLINE happyIn125 #-} +happyOut125 :: (HappyAbsSyn ) -> (()) +happyOut125 x = unsafeCoerce# x +{-# INLINE happyOut125 #-} +happyIn126 :: (()) -> (HappyAbsSyn ) +happyIn126 x = unsafeCoerce# x +{-# INLINE happyIn126 #-} +happyOut126 :: (HappyAbsSyn ) -> (()) +happyOut126 x = unsafeCoerce# x +{-# INLINE happyOut126 #-} +happyInTok :: CToken -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> CToken +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x00\x00\x00\x00\x4a\x01\x0e\x07\x00\x00\x3f\x0c\x00\x00\x6f\x07\x1e\x00\x00\x00\x13\x07\x00\x00\x40\x07\x00\x00\x14\x04\x03\x04\x50\x04\x10\x0c\x00\x00\x50\x04\x00\x00\xf7\x12\xf7\x12\x4e\x12\x3e\x12\x07\x13\x07\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x02\x00\x00\x00\x00\xe1\x0b\x00\x00\x1f\x04\x1c\x0d\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x07\x52\x07\x06\x0a\x23\x03\x00\x00\x00\x00\x1c\x0d\x05\x0d\x00\x00\x45\x07\x68\x07\x44\x07\x02\x04\x17\x07\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x41\x07\x00\x00\x75\x12\x00\x00\x2d\x07\x00\x00\x9b\x12\x6e\x07\xf5\x02\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x06\xf3\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x06\x00\x00\x29\x04\xfa\x0c\x68\x01\xf4\x06\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x1d\x07\x00\x00\xeb\x06\xe4\x06\x00\x00\x22\x04\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x0f\x07\xc0\x06\xba\x06\x00\x00\xe1\x06\xc3\x06\xda\x06\x68\x01\x02\x04\x05\x0d\xda\x06\x00\x00\xfa\x03\xe9\x0c\x75\x12\x00\x00\x06\x07\x00\x00\x06\x0a\x75\x12\x00\x00\x00\x00\x00\x00\xc9\x12\x00\x00\x00\x00\xc6\x0c\xbd\x0c\x76\x01\x00\x07\xff\x06\x68\x01\x52\x00\x76\x01\x00\x00\x75\x12\x00\x00\x00\x00\xd2\x06\x00\x00\x00\x00\x00\x00\x77\x06\x00\x00\x90\x06\x14\x19\x06\x0a\x00\x00\x58\x07\x28\x04\xf7\x03\xaf\x03\xe8\x03\xe5\x06\xcf\x06\xd6\x06\xcc\x06\xc6\x03\x00\x00\x00\x00\xd7\x06\x00\x00\x00\x00\x08\x09\x00\x00\x00\x00\xaa\x09\xaa\x09\x00\x00\x00\x00\xca\x06\x00\x00\x5f\x03\x92\x09\x7b\x09\xeb\x07\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x09\xc7\x06\xbd\x06\xbb\x06\xe8\x00\xc7\x0a\xe8\x00\x07\x13\x07\x13\x98\x0a\xb9\x06\x85\x06\x00\x00\x35\x01\xc9\x12\x00\x00\x00\x00\x00\x00\x00\x00\x22\x04\xb2\x0b\x22\x04\x83\x0b\x1f\x09\x75\x12\x00\x00\x00\x00\xaa\x06\x68\x01\x00\x00\x68\x01\x00\x00\x68\x01\x00\x00\x05\x0d\x00\x00\x00\x00\x73\x06\x5f\x03\x9c\x06\x6a\x06\x8e\x06\xae\x13\x00\x00\xef\x00\x11\x01\x00\x00\x00\x00\x8c\x06\xfb\x00\xec\x13\xc5\x04\xc5\x04\xa4\x0c\x00\x00\x1f\x09\x00\x00\x5c\x02\x00\x00\x70\x06\x5f\x03\x00\x00\x00\x00\x00\x00\x68\x01\x0f\x00\x00\x00\x8a\x06\x86\x06\x59\x06\x59\x06\x00\x00\x00\x00\x2a\x06\x57\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x05\x69\x0a\x55\x06\x00\x00\x00\x00\x00\x00\x3a\x0a\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x09\x00\x00\x00\x00\x4d\x07\x79\x06\x00\x00\x08\x09\x00\x00\x08\x09\x00\x00\x00\x00\x00\x00\x08\x09\x00\x00\x6e\x06\x6d\x06\x66\x06\x00\x00\x1f\x09\xf0\x08\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x1f\x09\x00\x00\x1f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x08\x1f\x09\x5f\x03\x5f\x03\x00\x00\x00\x00\x63\x06\x60\x06\x1f\x09\xfc\x00\x00\x00\x0f\x00\x00\x00\xc9\x06\x5e\x06\x52\x00\xfd\x08\x4e\x06\x68\x01\x68\x01\xc4\x06\x00\x00\x00\x00\x2a\x07\x73\x01\x00\x00\x00\x00\xa6\x00\x0f\x00\x00\x00\x4d\x06\x4b\x06\xed\x05\x0f\x00\x00\x00\xbc\x06\x2e\x00\xbf\x06\x2e\x00\x00\x00\x05\x0d\x00\x00\x97\x04\x05\x06\xeb\x05\x00\x00\x00\x00\x95\x03\x97\x04\xeb\x05\x00\x00\x00\x00\x00\x00\xf3\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x04\x54\x0b\x22\x04\x25\x0b\x19\x06\x0b\x06\xc9\x12\x00\x00\xc7\x04\x13\x06\x1f\x09\x12\x06\x0a\x06\x1a\x06\x1e\x06\xf9\xff\x02\x06\x1f\x09\x01\x06\xfe\x05\xe2\x05\xd9\x05\xf9\x04\x0f\x00\x0f\x00\x2e\x00\x00\x00\x7c\x08\x09\x00\x00\x00\x00\x00\x00\x00\xb6\x06\x69\x06\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x06\x58\x06\x68\x01\x00\x00\x00\x00\xd0\x00\x00\x00\x74\x03\x34\x03\xae\x13\x00\x00\x00\x00\x91\x05\xea\x05\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x05\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x06\x50\x06\x2c\x03\x2c\x03\x07\x03\x07\x03\x07\x03\x07\x03\xaf\x03\xaf\x03\xe2\x02\xdb\x05\xb9\x05\xcb\x05\xb7\x05\x1f\x09\xb3\x05\x00\x00\x65\x08\x00\x00\xc5\x05\xb0\x05\xa8\x05\x00\x00\xa0\x05\x77\x05\x6d\x05\x6b\x05\x34\x05\x34\x05\x34\x05\x04\x00\x00\x00\x04\x00\x8d\x05\x8b\x05\x0e\x00\x3a\x0a\x27\x05\x27\x05\x54\x06\x54\x06\xfb\x09\x00\x00\x27\x05\x27\x05\xc9\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x02\x1f\x09\x24\x02\x00\x00\x00\x00\x61\x05\x00\x00\xf6\x0a\xb1\x00\x00\x00\x30\x04\x81\x05\xef\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\xb1\x00\xb1\x00\xf6\x0a\x1f\x09\x00\x00\x00\x00\x00\x00\x1b\x02\x00\x00\x00\x00\x80\x05\x7e\x05\x0d\x00\x54\x06\x00\x00\x00\x00\x00\x00\x68\x01\x00\x00\x04\x00\x00\x00\x1f\x05\x00\x00\x00\x00\x46\x05\x46\x05\x46\x05\x00\x00\xd0\x07\x00\x00\x1f\x09\x00\x00\x1f\x09\x00\x00\x00\x00\x00\x00\x0d\x05\x78\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x9a\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x07\x00\x00\x00\x00\x00\x00\x1f\x09\x1f\x09\x00\x00\x49\x05\x1f\x09\x44\x05\x1f\x09\x5b\x05\x0a\x05\x1a\x06\x00\x00\xcc\x00\x00\x00\x5f\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x05\x24\x05\x24\x05\x24\x05\x00\x00\x8e\x02\x15\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x05\x1f\x09\x1a\x06\x1f\x09\x00\x00\x3e\x05\x29\x13\x10\x05\x08\x05\x00\x00\x33\x05\x00\x00\x30\x05\x2e\x05\x00\x00\xfd\x01\x09\x08\x5a\x03\x00\x00\x6b\x02\x0f\x05\x1f\x09\x96\x02\x00\x00\x69\x01\x2b\x00\x00\x00\x0b\x05\x1f\x09\x00\x00\x03\x05\x1f\x09\x00\x00\x00\x00\xc0\x01\x1c\x05\x6d\x01\x00\x00\x1a\x05\x00\x00\x00\x00\x00\x00\x68\x01\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x1f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x09\xc3\x04\x00\x00\xf0\x06\x00\x00\x00\x00\x1f\x09\xba\x04\x00\x00\x1f\x09\xba\x04\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x06\x00\x00\x1a\x06\x1a\x06\x1a\x06\x00\x00\x1f\x09\x1f\x09\x1f\x09\xfb\x04\x00\x00\x52\x02\x00\x00\xe5\x04\x39\x00\x1a\x06\xfa\x04\xdc\x04\xd4\x04\xc2\x04\x00\x00\x00\x00\x00\x00\x09\x08\x00\x00\x00\x00\x1f\x09\x7f\x04\x7f\x04\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x04\x00\x00\xc0\x04\x00\x00\x1a\x06\x1f\x09\x1f\x09\x90\x04\x00\x00\x48\x02\x8a\x04\x00\x00\xb0\x04\x73\x02\x00\x00\xac\x04\xa7\x04\x1f\x09\x39\x00\x7b\x04\x39\x00\x00\x00\xa3\x04\x94\x04\x00\x00\x00\x00\x1a\x06\x1a\x06\x5b\x01\x00\x00\x00\x00\x92\x04\x33\x04\x33\x04\x8c\x04\x83\x04\x00\x00\x4f\x04\x27\x04\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x1f\x09\x1f\x09\x53\x04\x52\x04\x25\x04\xf4\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x92\x02\x48\x04\x06\x00\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x01\x00\x00\x00\xd5\x03\x00\x00\x1c\x04\x00\x00\x00\x00\x00\x00\xba\x10\x26\x00\x00\x00\x7d\x04\x00\x00\x62\x00\x43\x03\x62\x01\x10\x02\x48\x01\xf5\x00\x00\x00\x00\x00\xbb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x05\x24\x04\x00\x00\x4e\x00\x00\x00\xfd\x06\xc9\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaa\x03\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x13\xb1\x01\x00\x00\x00\x00\x74\x08\x4c\x07\x00\x00\x00\x00\xf5\x05\x00\x00\x01\x01\x19\x04\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x03\xff\x03\x00\x00\x00\x00\x00\x00\xe5\x11\x00\x00\x9d\x03\x00\x00\xa2\x0e\xc3\x10\x07\x01\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x03\xa5\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x03\x07\x12\xf7\x05\xe1\x05\xc0\x03\x00\x00\x00\x00\x00\x00\x8f\x03\xb2\x03\x00\x00\x00\x00\x00\x00\x9f\x03\x6e\x03\x81\x03\x98\x19\x00\x00\x1a\x03\x00\x00\x00\x00\x7b\x03\x00\x00\x0f\x03\x00\x00\x00\x00\x00\x00\xe7\x00\x46\x03\xd0\x05\xdc\x03\xce\x06\x20\x03\x00\x00\x12\x12\x6d\x0e\xbf\x11\x05\x03\x00\x00\x00\x00\x4c\x13\x99\x11\xec\x02\x00\x00\x00\x00\xcf\x0e\x00\x00\x00\x00\xe3\x09\xe7\x0e\xfc\x11\x00\x00\x00\x00\xaf\x05\xd1\x04\xf1\x11\x00\x00\x73\x11\xca\x02\x00\x00\x00\x00\x11\x03\x00\x00\x00\x00\x94\x0f\x00\x00\x00\x00\xd0\x02\x7a\x11\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\x00\x00\x00\x00\x00\x00\x90\x03\x00\x00\x00\x00\xa0\x11\x76\x0d\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x02\x47\x0c\xf5\x0a\x10\x11\x00\x00\x00\x00\x00\x00\x00\x00\x54\x11\x00\x00\x00\x00\x00\x00\x70\x19\x22\x0f\x58\x19\x8a\x00\x24\x00\x65\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x15\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x19\x54\x0f\xd6\x10\xb4\x05\x2b\x13\x26\x11\xae\x02\x00\x00\x00\x00\x94\x05\x00\x00\x31\x05\x00\x00\x20\x05\x00\x00\x8d\x08\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x95\x0f\x00\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x05\x71\x00\xfc\xff\xd4\xff\x76\x0f\x00\x00\xb1\x16\x00\x00\x00\x00\x00\x00\x00\x00\xe3\xff\x00\x00\x00\x00\x00\x00\x11\x05\xb2\x01\x00\x00\x00\x00\x00\x00\xe8\x02\xdf\x02\x00\x00\x00\x00\x00\x00\x9e\x02\x00\x00\x99\x02\x00\x00\x89\x02\x00\x00\x71\x02\x96\x0d\x3a\x10\x87\x02\x7b\x02\x00\x00\x5e\x0d\x93\x0f\x78\x02\x00\x00\x63\x02\x5d\x02\x00\x00\x24\x01\xc0\x00\x46\x18\x00\x00\x00\x00\xb5\x0f\x00\x00\x00\x00\x6f\x03\x00\x00\x4c\x03\x00\x00\x00\x00\x00\x00\x2b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\x18\x96\x16\xb2\x18\xcd\x18\xe8\x18\xf5\x18\x04\x12\x87\x09\x2b\x19\x1e\x19\x10\x19\x03\x19\x42\x07\x3d\x04\x1c\x08\xc8\x04\x2e\x11\xda\x0c\x32\x09\x00\x00\x2b\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\x16\x60\x16\x59\x02\x47\x02\x00\x00\x00\x00\x00\x00\x00\x00\x10\x18\x07\x00\x83\x02\x99\x01\x00\x00\xc9\x04\x00\x00\x21\x07\x19\x08\x00\x00\x5c\x04\x17\x04\x0d\x04\x00\x00\x00\x00\x96\x10\xc5\x10\x00\x00\x00\x00\xe1\x11\x88\x01\x00\x00\x00\x00\x00\x00\x4a\x02\x2a\x01\x00\x00\xed\x06\xa7\x08\xda\x03\xc7\x07\x3d\x02\x47\x05\x37\x02\x2c\x01\x9c\x02\x4e\x02\x00\x00\x00\x00\x00\x00\xba\x00\x4c\x02\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\xa0\x0e\x76\x00\x2f\x0d\x7a\x00\x00\x00\x00\x00\x4e\x04\x00\x00\x6a\x01\x00\x00\xf5\x17\x00\x00\x00\x00\x0a\x03\x00\x00\x14\x02\x00\x00\x37\x15\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\x0e\x01\xfb\xff\x67\x06\x00\x00\xb0\x14\x00\x00\x00\x00\x00\x00\x00\x00\x99\x03\x99\x03\x00\x00\x00\x00\x8f\x05\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x10\x89\x09\x91\x03\x00\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x4f\x05\x00\x00\x00\x00\xdf\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\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\x00\x00\x00\x00\x7c\x18\x00\x00\x00\x00\xa9\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x01\xdf\x01\xdf\x01\x28\x10\x00\x00\xef\x0f\x00\x00\x00\x00\xdb\x01\xce\x0d\xd4\x01\xd4\x01\x7a\x10\x4c\x10\x3a\x0e\x00\x00\xd4\x01\xd4\x01\xe8\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x17\xe9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x02\x0e\x93\x01\x00\x00\x57\x14\x00\x00\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x06\x21\x09\x6e\x0e\xbf\x17\x00\x00\x00\x00\x00\x00\xe9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9a\x01\x68\x10\x00\x00\x00\x00\x00\x00\x55\x03\x00\x00\x0b\x10\x79\x00\xae\x01\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x14\x00\x00\x61\x18\x00\x00\xa4\x17\x00\x00\x00\x00\x00\x00\x24\x11\x27\x0f\x7a\x01\x00\x00\x6f\x01\x00\x00\x00\x00\x00\x00\xae\x07\x4d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x13\x00\x00\x00\x00\x00\x00\x45\x16\x2a\x16\x00\x00\x00\x00\x0f\x16\x00\x00\xf4\x15\xc8\x02\x00\x00\xe4\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x00\x00\x00\xb5\x01\xa3\x01\x65\x01\x54\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x01\xd9\x15\xa3\x02\x89\x17\x00\x00\x00\x00\xf3\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x95\x14\x27\x02\x00\x00\x00\x00\x00\x00\x6e\x17\x9d\x00\x00\x00\x3a\x02\x00\x0e\x96\x00\x00\x00\x53\x17\x7b\x00\x00\x00\x38\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x01\x00\x00\x00\x00\x00\x00\xf6\x03\x00\x00\x1d\x17\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x15\x00\x00\x00\x00\x3c\x14\x00\x00\x00\x00\x02\x17\x80\x00\x00\x00\xe7\x16\x80\x00\x2d\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x14\x00\x00\x7d\x02\x62\x02\x3c\x02\x00\x00\x1c\x15\x01\x15\xa3\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\xfb\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x14\x00\x00\x00\x00\xcc\x16\xe5\xff\xe5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x01\xe6\x14\xcb\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x15\xec\xff\x00\x00\xfd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x01\x94\x01\x00\x00\x00\x00\x00\x00\x00\x00\xc7\xff\xc0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xff\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x15\x52\x15\x00\x00\x00\x00\x00\x00\xa0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xfd\xff\x00\x00\x58\xfe\x00\x00\xfb\xff\x00\x00\xfc\xff\x00\x00\x58\xfe\xf8\xff\x00\x00\xfa\xff\x00\x00\xf9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa1\xff\x00\x00\x82\xff\xa4\xff\x95\xff\xa3\xff\x94\xff\xa2\xff\x93\xff\x79\xff\x67\xff\x58\xfe\x66\xff\x0e\xff\xec\xff\x22\xff\x20\xff\x21\xff\xeb\xff\x14\xff\x00\x00\x57\xfe\x00\x00\x00\x00\x98\xff\x89\xff\x91\xff\x46\xff\x88\xff\x8c\xff\x58\xfe\x9a\xff\x8d\xff\x43\xff\x8f\xff\x8e\xff\x97\xff\x44\xff\x90\xff\x8b\xff\x99\xff\x62\xff\x9b\xff\x00\x00\x96\xff\x61\xff\x8a\xff\x92\xff\x45\xff\x16\xff\x6f\xff\x00\x00\x00\x00\x58\xfe\x00\x00\x1f\xff\x13\xff\x00\x00\x00\x00\x56\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\xff\x81\xff\x78\xff\x0d\xff\x40\xff\xeb\xff\x0c\xff\x00\x00\x6c\xff\x00\x00\x1b\xff\xee\xfe\xec\xfe\x0b\xff\x64\xfe\x00\x00\x75\xff\x69\xff\x68\xff\x71\xff\x9d\xff\x9c\xff\x70\xff\x7c\xff\x77\xff\x76\xff\xad\xff\x7b\xff\x7a\xff\xae\xff\x86\xff\x7f\xff\x80\xff\x7e\xff\x85\xff\x84\xff\x83\xff\x00\x00\x40\xff\x41\xff\x3d\xff\x3a\xff\x39\xff\x3e\xff\x30\xff\x42\xff\xeb\xff\x00\x00\x00\x00\x3c\xff\x00\x00\x9f\xff\x87\xff\x7d\xff\x40\xff\xeb\xff\x9e\xff\x00\x00\x74\xff\x00\x00\x40\xff\xeb\xff\x00\x00\xac\xff\x00\x00\xab\xff\xf6\xff\xdc\xff\x00\x00\x5e\xfe\x5d\xfe\x5c\xfe\x00\x00\xda\xff\x40\xff\x21\xff\x00\x00\x00\x00\x40\xff\x42\xff\x00\x00\x00\x00\x00\x00\x58\xfe\x00\x00\xf5\xff\x58\xfe\x00\x00\x58\xfe\xf3\xff\x3b\xff\x0b\xff\x38\xff\x2d\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\xff\x00\x00\x58\xfe\xf4\xff\x63\xff\x60\xff\x5a\xfe\x59\xfe\x64\xfe\xb4\xfe\xa8\xfe\x98\xfe\x00\x00\x96\xfe\x92\xfe\x8f\xfe\x8c\xfe\x87\xfe\x84\xfe\x82\xfe\x80\xfe\x7e\xfe\x7c\xfe\x7a\xfe\x77\xfe\x63\xfe\x00\x00\xbe\xfe\xbd\xfe\x58\xfe\x99\xfe\x9a\xfe\x00\x00\x00\x00\x9c\xfe\x9b\xfe\x9d\xfe\x9e\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x60\xfe\x61\xfe\x5f\xfe\xbf\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x05\xff\x01\xff\xfe\xfe\xa3\xff\x94\xff\xfa\xfe\x00\x00\x0a\xff\x08\xff\x00\x00\x00\x00\xf7\xfe\xeb\xfe\xf1\xff\xea\xff\x00\x00\x00\x00\x00\x00\x00\x00\x58\xfe\x00\x00\x58\xfe\xf2\xff\x00\x00\x00\x00\x55\xfe\x10\xff\x15\xff\x1a\xff\x1d\xff\x00\x00\x1e\xff\x12\xff\x4b\xff\x00\x00\x00\x00\x6a\xfe\x00\x00\x00\x00\x9d\xfe\x51\xfe\x00\x00\x53\xfe\x4f\xfe\x50\xfe\xf5\xfe\x95\xff\x94\xff\x93\xff\xf3\xfe\x6e\xff\x00\x00\x6d\xff\x00\x00\x4a\xff\x48\xff\x00\x00\x1c\xff\x19\xff\x0f\xff\x18\xff\xcf\xfe\xed\xff\x00\x00\x00\x00\x40\xff\x40\xff\x07\xff\x11\xff\x00\x00\x58\xfe\xed\xfe\x58\xfe\xf9\xfe\x58\xfe\xf1\xfe\xf0\xfe\x0b\xff\xe3\xfe\x58\xfe\x58\xfe\xfd\xfe\x0b\xff\xe3\xfe\x58\xfe\x00\xff\x58\xfe\x58\xfe\x04\xff\x58\xfe\x58\xfe\x00\x00\x98\xfe\xa5\xfe\x00\x00\x00\x00\xa3\xfe\x58\xfe\xa1\xfe\x58\xfe\x9f\xfe\xe5\xfe\xa6\xfe\x58\xfe\xa7\xfe\x00\x00\x00\x00\x00\x00\xea\xfe\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\xfe\x00\x00\x75\xfe\x71\xfe\x70\xfe\x74\xfe\x73\xfe\x72\xfe\x6d\xfe\x6c\xfe\x6b\xfe\x6f\xfe\x6e\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xae\xfe\xad\xfe\x00\x00\x9d\xfe\x00\x00\x58\xfe\x60\xff\xcf\xfe\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\xff\x34\xff\x00\x00\x36\xff\x29\xff\x00\x00\x00\x00\x37\xff\x2c\xff\x00\x00\xcf\xfe\xee\xff\x00\x00\x00\x00\x00\x00\xcf\xfe\xf0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x58\xfe\x00\x00\x58\xfe\xdb\xff\xda\xff\x00\x00\xf7\xff\x5b\xfe\x00\x00\xdb\xff\x00\x00\xd8\xff\xe9\xff\xe8\xff\x00\x00\xd9\xff\xd7\xff\xd4\xff\xe7\xff\xe6\xff\xe5\xff\xe4\xff\xe3\xff\xd6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\xff\xb9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\xfe\x00\x00\x00\x00\xbf\xfe\x6f\xff\x00\x00\xcf\xfe\xcf\xfe\x00\x00\xa7\xff\x00\x00\x00\x00\x73\xff\x72\xff\xaa\xff\x00\x00\x00\x00\x35\xff\x28\xff\x00\x00\x2f\xff\x32\xff\x25\xff\x26\xff\x00\x00\x00\x00\x33\xff\x23\xff\xa6\xff\x58\xfe\x5e\xff\x00\x00\x00\x00\x00\x00\x5f\xff\x64\xff\x58\xfe\x00\x00\xe4\xfe\xe9\xfe\xb0\xfe\xaf\xfe\x00\x00\x00\x00\xaa\xfe\xb2\xfe\x76\xfe\x93\xfe\x94\xfe\x95\xfe\x90\xfe\x91\xfe\x8d\xfe\x8e\xfe\x88\xfe\x8a\xfe\x89\xfe\x8b\xfe\x85\xfe\x86\xfe\x83\xfe\x81\xfe\x7f\xfe\x7d\xfe\x00\x00\x00\x00\x7b\xfe\xbc\xfe\x00\x00\xbb\xfe\x00\x00\x00\x00\x00\x00\xe8\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x03\xff\x02\xff\xff\xfe\xe2\xfe\xe1\xfe\xdf\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xfe\xfb\xfe\xe2\xfe\xdf\xfe\x00\x00\xd3\xfe\xef\xfe\xf8\xfe\x00\x00\x09\xff\xf6\xfe\x6b\xff\x6a\xff\xa9\xff\x17\xff\x00\x00\x00\x00\x00\x00\x4f\xff\x68\xfe\x69\xfe\xf2\xfe\x0b\xff\xe3\xfe\xf4\xfe\x00\x00\x00\x00\x51\xfe\x52\xfe\x54\xfe\x62\xfe\x4c\xfe\x00\x00\x4d\xfe\xe2\xfe\xdf\xfe\x00\x00\x00\x00\x49\xff\x4e\xff\x47\xff\x00\x00\x4d\xff\x06\xff\x00\x00\x00\x00\x00\x00\xde\xfe\xdd\xfe\xe0\xfe\xda\xfe\xdb\xfe\xd9\xfe\xde\xfe\x58\xfe\x00\x00\x58\xfe\xe7\xfe\xa2\xfe\xa0\xfe\x00\x00\x97\xfe\xcd\xfe\x78\xfe\x00\x00\xb1\xfe\x00\x00\xb3\xfe\xe6\xfe\x5b\xff\x56\xff\x00\x00\x58\xfe\x5d\xff\x58\xfe\x5c\xff\x65\xff\x31\xff\x00\x00\x00\x00\x2b\xff\x2e\xff\x3f\xff\xce\xfe\xd2\xfe\xcd\xfe\xa5\xff\xa8\xff\xd2\xff\x00\x00\x00\x00\x65\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x66\xfe\x00\x00\x00\x00\xc0\xff\x00\x00\xbf\xff\x00\x00\xb8\xff\xd3\xff\xd5\xff\x58\xfe\xca\xff\x00\x00\x00\x00\x00\x00\x00\x00\xde\xff\x00\x00\x00\x00\xcd\xff\xdd\xff\xcc\xff\xd1\xff\xcf\xff\xd0\xff\xce\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xff\x00\x00\xbe\xff\x00\x00\x00\x00\xcc\xfe\x00\x00\x00\x00\x00\x00\xc5\xfe\xc6\xfe\x00\x00\x00\x00\x00\x00\x2a\xff\x00\x00\x00\x00\x58\xfe\x52\xff\x00\x00\x58\xfe\x55\xff\x00\x00\xa9\xfe\x79\xfe\x00\x00\x00\x00\x00\x00\xb7\xfe\x00\x00\xdc\xfe\xd8\xfe\xd6\xfe\xd7\xfe\xd5\xfe\x4c\xff\x67\xfe\xde\xfe\x4e\xfe\x00\x00\x4b\xfe\xd4\xfe\xb8\xfe\xb9\xfe\x00\x00\x00\x00\xba\xfe\x00\x00\xac\xfe\x54\xff\x00\x00\x58\xff\x51\xff\x00\x00\x5a\xff\x58\xfe\x58\xfe\xc2\xfe\x00\x00\xc7\xfe\xc4\xfe\xc1\xfe\xc8\xfe\xcb\xfe\x00\x00\xd1\xfe\x00\x00\x00\x00\x00\x00\xc1\xff\x66\xfe\x66\xfe\x00\x00\x00\x00\xe1\xff\x00\x00\xe2\xff\x00\x00\xb7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc9\xff\xc7\xff\xc6\xff\xca\xfe\x00\x00\xd0\xfe\xc3\xfe\x00\x00\x59\xff\x57\xff\x50\xff\x53\xff\xab\xfe\xb6\xfe\x00\x00\xb5\xfe\x00\x00\xc9\xfe\x00\x00\x66\xfe\x66\xfe\x00\x00\xdf\xff\x00\x00\xb6\xff\xb5\xff\x00\x00\x00\x00\xbd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xff\xc5\xff\x00\x00\x00\x00\xc8\xff\xc0\xfe\x00\x00\x00\x00\x00\x00\xbc\xff\xb4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\xff\x00\x00\x00\x00\xdb\xff\xc4\xff\xc3\xff\x00\x00\xb0\xff\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xff\xba\xff\xb1\xff\xb2\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x02\x00\x18\x00\x01\x00\x0d\x00\x03\x00\x02\x00\x35\x00\x19\x00\x02\x00\x2d\x00\x2e\x00\x2f\x00\x02\x00\x02\x00\x0d\x00\x72\x00\x16\x00\x17\x00\x18\x00\x33\x00\x34\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x34\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x04\x00\x01\x00\x01\x00\x0a\x00\x1f\x00\x01\x00\x32\x00\x35\x00\x72\x00\x35\x00\x2d\x00\x2e\x00\x2f\x00\x0d\x00\x0d\x00\x72\x00\x36\x00\x0d\x00\x03\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x20\x00\x1f\x00\x20\x00\x43\x00\x22\x00\x1e\x00\x04\x00\x77\x00\x48\x00\x52\x00\x30\x00\x29\x00\x2a\x00\x2b\x00\x04\x00\x01\x00\x75\x00\x5c\x00\x5d\x00\x74\x00\x32\x00\x35\x00\x56\x00\x35\x00\x77\x00\x74\x00\x72\x00\x0d\x00\x5c\x00\x5d\x00\x5e\x00\x72\x00\x5b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5e\x00\x5e\x00\x5e\x00\x20\x00\x72\x00\x22\x00\x02\x00\x77\x00\x77\x00\x2e\x00\x77\x00\x75\x00\x29\x00\x2a\x00\x2b\x00\x04\x00\x75\x00\x75\x00\x5f\x00\x04\x00\x75\x00\x32\x00\x1f\x00\x20\x00\x35\x00\x22\x00\x02\x00\x5c\x00\x5c\x00\x5d\x00\x5e\x00\x5c\x00\x5d\x00\x5e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x22\x00\x5b\x00\x1f\x00\x20\x00\x35\x00\x22\x00\x2a\x00\x20\x00\x77\x00\x22\x00\x77\x00\x4a\x00\x29\x00\x2a\x00\x2b\x00\x75\x00\x29\x00\x2a\x00\x2b\x00\x35\x00\x01\x00\x32\x00\x1f\x00\x20\x00\x35\x00\x32\x00\x2a\x00\x5c\x00\x35\x00\x5e\x00\x01\x00\x01\x00\x0d\x00\x03\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x0d\x00\x0d\x00\x35\x00\x06\x00\x07\x00\x08\x00\x4a\x00\x0a\x00\x77\x00\x0c\x00\x0d\x00\x0e\x00\x75\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x33\x00\x34\x00\x16\x00\x17\x00\x18\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x77\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x36\x00\x36\x00\x77\x00\x01\x00\x1e\x00\x03\x00\x32\x00\x77\x00\x75\x00\x35\x00\x75\x00\x77\x00\x0b\x00\x43\x00\x43\x00\x0d\x00\x0f\x00\x77\x00\x48\x00\x48\x00\x2e\x00\x2b\x00\x01\x00\x2d\x00\x03\x00\x45\x00\x02\x00\x77\x00\x5c\x00\x5d\x00\x5e\x00\x2c\x00\x56\x00\x56\x00\x0d\x00\x30\x00\x4a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5e\x00\x74\x00\x74\x00\x58\x00\x02\x00\x5a\x00\x20\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x36\x00\x6c\x00\x2b\x00\x2a\x00\x2d\x00\x35\x00\x71\x00\x72\x00\x72\x00\x74\x00\x5f\x00\x76\x00\x77\x00\x06\x00\x07\x00\x08\x00\x75\x00\x0a\x00\x02\x00\x0c\x00\x0d\x00\x0e\x00\x2a\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x40\x00\x41\x00\x42\x00\x5c\x00\x5d\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x5c\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x06\x00\x07\x00\x08\x00\x5f\x00\x08\x00\x02\x00\x32\x00\x2a\x00\x52\x00\x35\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x1f\x00\x20\x00\x01\x00\x01\x00\x03\x00\x77\x00\x08\x00\x4a\x00\x02\x00\x03\x00\x45\x00\x75\x00\x06\x00\x01\x00\x2b\x00\x0d\x00\x01\x00\x77\x00\x1e\x00\x30\x00\x74\x00\x52\x00\x35\x00\x77\x00\x15\x00\x0d\x00\x1f\x00\x20\x00\x0d\x00\x58\x00\x77\x00\x5a\x00\x1e\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x35\x00\x6c\x00\x75\x00\x06\x00\x07\x00\x08\x00\x71\x00\x72\x00\x35\x00\x74\x00\x77\x00\x76\x00\x77\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5f\x00\x58\x00\x08\x00\x5a\x00\x63\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x08\x00\x6c\x00\x77\x00\x06\x00\x07\x00\x08\x00\x71\x00\x72\x00\x5c\x00\x74\x00\x5e\x00\x35\x00\x77\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5c\x00\x5d\x00\x5e\x00\x5c\x00\x5d\x00\x5e\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x77\x00\x52\x00\x06\x00\x07\x00\x08\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x75\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2a\x00\x52\x00\x58\x00\x2d\x00\x5a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x77\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x52\x00\x71\x00\x72\x00\x59\x00\x74\x00\x76\x00\x77\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x77\x00\x77\x00\x58\x00\x01\x00\x5a\x00\x03\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x74\x00\x6c\x00\x2a\x00\x77\x00\x77\x00\x2d\x00\x71\x00\x72\x00\x58\x00\x74\x00\x5a\x00\x20\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x79\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x35\x00\x71\x00\x72\x00\x2d\x00\x74\x00\x02\x00\x77\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2d\x00\x77\x00\x58\x00\x02\x00\x5a\x00\x77\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x1e\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x31\x00\x71\x00\x72\x00\x03\x00\x74\x00\x1e\x00\x06\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5c\x00\x5d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x56\x00\x57\x00\x2a\x00\x5c\x00\x5d\x00\x2d\x00\x06\x00\x07\x00\x08\x00\x2a\x00\x77\x00\x74\x00\x2d\x00\x1f\x00\x78\x00\x79\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x01\x00\x58\x00\x49\x00\x5a\x00\x49\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x0b\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x75\x00\x71\x00\x72\x00\x2c\x00\x74\x00\x77\x00\x75\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2a\x00\x2b\x00\x58\x00\x74\x00\x5a\x00\x73\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x74\x00\x6c\x00\x5c\x00\x5d\x00\x09\x00\x75\x00\x71\x00\x72\x00\x58\x00\x74\x00\x5a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x77\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x75\x00\x71\x00\x72\x00\x75\x00\x74\x00\x5c\x00\x5d\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x17\x00\x18\x00\x58\x00\x75\x00\x5a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x75\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x75\x00\x71\x00\x72\x00\x37\x00\x74\x00\x11\x00\x12\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x37\x00\x58\x00\x2c\x00\x5a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x08\x00\x6c\x00\x74\x00\x6e\x00\x0b\x00\x0c\x00\x71\x00\x72\x00\x6b\x00\x58\x00\x2c\x00\x5a\x00\x75\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x2c\x00\x6c\x00\x5c\x00\x5d\x00\x5e\x00\x08\x00\x71\x00\x72\x00\x37\x00\x74\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x03\x00\x2a\x00\x2b\x00\x06\x00\x75\x00\x58\x00\x20\x00\x5a\x00\x22\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x4a\x00\x6c\x00\x08\x00\x35\x00\x1f\x00\x75\x00\x71\x00\x72\x00\x37\x00\x74\x00\x5c\x00\x5d\x00\x5e\x00\x73\x00\x58\x00\x09\x00\x5a\x00\x05\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x4a\x00\x6c\x00\x08\x00\x4c\x00\x4d\x00\x4e\x00\x71\x00\x72\x00\x2a\x00\x2b\x00\x75\x00\x4c\x00\x4d\x00\x4e\x00\x58\x00\x37\x00\x5a\x00\x08\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x05\x00\x6c\x00\x4a\x00\x77\x00\x5c\x00\x5d\x00\x71\x00\x72\x00\x2a\x00\x2b\x00\x75\x00\x13\x00\x14\x00\x15\x00\x16\x00\x37\x00\x58\x00\x08\x00\x5a\x00\x05\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x4a\x00\x6c\x00\x37\x00\x4c\x00\x4d\x00\x4e\x00\x71\x00\x72\x00\x1c\x00\x1d\x00\x75\x00\x4c\x00\x4d\x00\x4e\x00\x58\x00\x08\x00\x5a\x00\x4e\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x01\x00\x6c\x00\x0d\x00\x0e\x00\x17\x00\x18\x00\x71\x00\x72\x00\x01\x00\x05\x00\x75\x00\x37\x00\x0d\x00\x11\x00\x12\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x0d\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x40\x00\x41\x00\x42\x00\x75\x00\x01\x00\x08\x00\x32\x00\x01\x00\x08\x00\x35\x00\x4c\x00\x4d\x00\x4e\x00\x05\x00\x01\x00\x35\x00\x0d\x00\x2a\x00\x2b\x00\x0d\x00\x75\x00\x01\x00\x02\x00\x0b\x00\x0c\x00\x45\x00\x0d\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x2b\x00\x10\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x72\x00\x58\x00\x01\x00\x5a\x00\x1b\x00\x5c\x00\x5d\x00\x5e\x00\x5b\x00\x2b\x00\x01\x00\x76\x00\x77\x00\x02\x00\x02\x00\x5c\x00\x5d\x00\x5e\x00\x4c\x00\x4d\x00\x4e\x00\x0e\x00\x0d\x00\x5c\x00\x2f\x00\x5e\x00\x71\x00\x72\x00\x4c\x00\x4d\x00\x4e\x00\x76\x00\x77\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x77\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2b\x00\x5c\x00\x4c\x00\x5e\x00\x5c\x00\x5d\x00\x32\x00\x04\x00\x5b\x00\x35\x00\x01\x00\x5c\x00\x5d\x00\x5e\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\x5b\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x45\x00\x02\x00\x58\x00\x02\x00\x5a\x00\x01\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x02\x00\x2b\x00\x10\x00\x4c\x00\x4d\x00\x4e\x00\x04\x00\x5c\x00\x5d\x00\x71\x00\x72\x00\x04\x00\x01\x00\x1b\x00\x36\x00\x2a\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x2b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x2b\x00\x2c\x00\x04\x00\x77\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x04\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x5e\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x36\x00\x02\x00\x36\x00\x3c\x00\x2b\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2b\x00\x43\x00\x10\x00\x43\x00\x3a\x00\x3b\x00\x48\x00\x01\x00\x48\x00\x2b\x00\x40\x00\x41\x00\x42\x00\x1b\x00\x4c\x00\x4d\x00\x4e\x00\x5e\x00\x1e\x00\x0d\x00\x56\x00\x02\x00\x56\x00\x02\x00\x5c\x00\x58\x00\x1e\x00\x5a\x00\x5e\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x2f\x00\x1e\x00\x31\x00\x1e\x00\x33\x00\x1e\x00\x35\x00\x36\x00\x02\x00\x38\x00\x02\x00\x2b\x00\x3b\x00\x02\x00\x3d\x00\x3e\x00\x3f\x00\x71\x00\x72\x00\x2b\x00\x43\x00\x44\x00\x45\x00\x01\x00\x47\x00\x48\x00\x2d\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x77\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x2c\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x4c\x00\x4d\x00\x4e\x00\x01\x00\x57\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5c\x00\x5d\x00\x10\x00\x4c\x00\x4d\x00\x4e\x00\x2b\x00\x21\x00\x22\x00\x2c\x00\x24\x00\x2b\x00\x26\x00\x1b\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x5c\x00\x35\x00\x4c\x00\x4d\x00\x4e\x00\x02\x00\x32\x00\x02\x00\x02\x00\x35\x00\x5e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x2f\x00\x2a\x00\x31\x00\x02\x00\x33\x00\x02\x00\x35\x00\x36\x00\x5e\x00\x38\x00\x45\x00\x2a\x00\x3b\x00\x2a\x00\x3d\x00\x3e\x00\x3f\x00\x01\x00\x02\x00\x03\x00\x43\x00\x44\x00\x45\x00\x2a\x00\x47\x00\x48\x00\x04\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x02\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x02\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x01\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x77\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x77\x00\x02\x00\x10\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x1b\x00\x40\x00\x41\x00\x42\x00\x19\x00\x1b\x00\x20\x00\x1e\x00\x22\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x29\x00\x2a\x00\x2b\x00\x4c\x00\x4d\x00\x4e\x00\x2b\x00\x2c\x00\x1a\x00\x32\x00\x2f\x00\x30\x00\x35\x00\x32\x00\x10\x00\x34\x00\x04\x00\x04\x00\x37\x00\x5f\x00\x39\x00\x3a\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x1e\x00\x40\x00\x41\x00\x42\x00\x4c\x00\x4d\x00\x4e\x00\x35\x00\x01\x00\x1e\x00\x49\x00\x01\x00\x01\x00\x4c\x00\x76\x00\x77\x00\x4f\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x4c\x00\x4d\x00\x4e\x00\x01\x00\x2d\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1e\x00\x1e\x00\x10\x00\x77\x00\x35\x00\x4c\x00\x4d\x00\x4e\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x1b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x2b\x00\x2b\x00\x76\x00\x77\x00\x4c\x00\x4d\x00\x4e\x00\x2b\x00\x2b\x00\x2c\x00\x5c\x00\x5b\x00\x2f\x00\x30\x00\x46\x00\x32\x00\x02\x00\x34\x00\x02\x00\x02\x00\x37\x00\x5e\x00\x39\x00\x3a\x00\x01\x00\x01\x00\x03\x00\x03\x00\x01\x00\x40\x00\x41\x00\x42\x00\x0d\x00\x0e\x00\x0f\x00\x02\x00\x0d\x00\x0d\x00\x49\x00\x04\x00\x0d\x00\x4c\x00\x04\x00\x02\x00\x4f\x00\x01\x00\x02\x00\x03\x00\x76\x00\x77\x00\x02\x00\x02\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x01\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x04\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2e\x00\x5c\x00\x10\x00\x02\x00\x30\x00\x36\x00\x36\x00\x02\x00\x01\x00\x36\x00\x1f\x00\x02\x00\x01\x00\x1b\x00\x03\x00\x2a\x00\x05\x00\x06\x00\x43\x00\x43\x00\x09\x00\x0a\x00\x43\x00\x48\x00\x48\x00\x02\x00\x2c\x00\x48\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x2f\x00\x40\x00\x41\x00\x42\x00\x56\x00\x56\x00\x02\x00\x36\x00\x56\x00\x2a\x00\x5c\x00\x5c\x00\x5e\x00\x5e\x00\x5c\x00\x5d\x00\x5e\x00\x01\x00\x02\x00\x03\x00\x43\x00\x02\x00\x01\x00\x01\x00\x01\x00\x48\x00\x01\x00\x02\x00\x03\x00\x4c\x00\x4d\x00\x01\x00\x02\x00\x03\x00\x01\x00\x0d\x00\x01\x00\x02\x00\x03\x00\x56\x00\x04\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x35\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x04\x00\x03\x00\x76\x00\x77\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1b\x00\x19\x00\x10\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1a\x00\x01\x00\x36\x00\x03\x00\x1b\x00\x10\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2c\x00\x43\x00\x10\x00\x02\x00\x02\x00\x35\x00\x48\x00\x2c\x00\x2d\x00\x01\x00\x2f\x00\x46\x00\x30\x00\x1b\x00\x2b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x02\x00\x56\x00\x45\x00\x30\x00\x5b\x00\x77\x00\x2c\x00\x5c\x00\x5d\x00\x5e\x00\x5b\x00\x2c\x00\x2d\x00\x01\x00\x2f\x00\x2c\x00\x2c\x00\x35\x00\x30\x00\x2c\x00\x4c\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x01\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x03\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x0d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x4c\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x01\x00\x2c\x00\x76\x00\x77\x00\x02\x00\x02\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x01\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3a\x00\x3b\x00\x10\x00\x01\x00\x01\x00\x36\x00\x40\x00\x41\x00\x42\x00\x77\x00\x0d\x00\x0e\x00\x0f\x00\x1b\x00\x01\x00\x02\x00\x03\x00\x2c\x00\x43\x00\x5b\x00\x01\x00\x01\x00\x63\x00\x48\x00\x76\x00\x77\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2f\x00\xff\xff\x10\x00\xff\xff\x56\x00\x35\x00\xff\xff\x36\x00\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x1b\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x43\x00\x45\x00\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\x76\x00\x77\x00\x4c\x00\x58\x00\xff\xff\x5a\x00\x2f\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x56\x00\x36\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\xff\xff\x43\x00\xff\xff\x71\x00\x72\x00\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\xff\xff\x1b\x00\x01\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x1b\x00\x40\x00\x41\x00\x42\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2f\x00\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\xff\xff\x1b\x00\x77\x00\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x43\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x48\x00\xff\xff\x2c\x00\xff\xff\x4c\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\x4c\x00\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x58\x00\x10\x00\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\x01\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x71\x00\x72\x00\x76\x00\x77\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x01\x00\x02\x00\x1b\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x2c\x00\x35\x00\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\x4c\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x35\x00\x2f\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x4c\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\xff\xff\x4c\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\xff\xff\x77\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x01\x00\xff\xff\x10\x00\x58\x00\xff\xff\x5a\x00\x77\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\x01\x00\x0d\x00\x1b\x00\xff\xff\xff\xff\x1e\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x71\x00\x72\x00\xff\xff\x76\x00\x77\x00\x2f\x00\x01\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x36\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x2f\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x56\x00\x4c\x00\xff\xff\x35\x00\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x45\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x4c\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x58\x00\x10\x00\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x77\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x01\x00\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\x2f\x00\x39\x00\x3a\x00\x3b\x00\x1b\x00\xff\xff\x4c\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x2f\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x4c\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\xff\xff\x4c\x00\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\xff\xff\x77\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\x0d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x1b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\x2f\x00\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\x01\x00\xff\xff\x03\x00\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\x0d\x00\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x77\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\xff\xff\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x71\x00\x72\x00\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\x01\x00\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\x0d\x00\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x0d\x00\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\x71\x00\x72\x00\xff\xff\x43\x00\x44\x00\x45\x00\x01\x00\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x01\x00\xff\xff\x51\x00\x0d\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x5c\x00\x5d\x00\x5e\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\x01\x00\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x36\x00\xff\xff\x51\x00\x0d\x00\x53\x00\x54\x00\x55\x00\x56\x00\x01\x00\x36\x00\xff\xff\xff\xff\xff\xff\x43\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\x48\x00\x01\x00\x0d\x00\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x0d\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x56\x00\x01\x00\xff\xff\x36\x00\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\x36\x00\x48\x00\x58\x00\x04\x00\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\x36\x00\xff\xff\x43\x00\xff\xff\x56\x00\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x43\x00\xff\xff\xff\xff\x71\x00\x72\x00\x48\x00\xff\xff\xff\xff\x56\x00\xff\xff\x36\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x48\x00\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x76\x00\x77\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x71\x00\x72\x00\xff\xff\xff\xff\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x3b\x00\xff\xff\xff\xff\x76\x00\x77\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x30\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x36\x00\x35\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x77\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x76\x00\x77\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x35\x00\x35\x00\x04\x00\xff\xff\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x77\x00\x45\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x36\x00\x35\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x76\x00\x77\x00\x77\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x45\x00\x46\x00\x47\x00\x48\x00\x76\x00\x77\x00\x32\x00\xff\xff\x35\x00\x35\x00\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x1f\x00\x20\x00\xff\xff\x22\x00\x76\x00\x77\x00\x32\x00\xff\xff\x22\x00\x35\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\x31\x00\x32\x00\x45\x00\xff\xff\x35\x00\x48\x00\x77\x00\x77\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1f\x00\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x32\x00\x22\x00\xff\xff\x35\x00\xff\xff\xff\xff\x77\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x32\x00\x22\x00\x77\x00\x35\x00\xff\xff\xff\xff\xff\xff\x77\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x21\x00\x22\x00\xff\xff\x24\x00\xff\xff\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x32\x00\x35\x00\x35\x00\x35\x00\x77\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\x45\x00\xff\xff\x77\x00\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x35\x00\xff\xff\x58\x00\x77\x00\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6f\x00\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\x76\x00\x77\x00\x77\x00\x77\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x35\x00\xff\xff\x71\x00\x72\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\x77\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\x77\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\x35\x00\x77\x00\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x35\x00\xff\xff\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\x35\x00\x76\x00\x77\x00\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x35\x00\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\x77\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x00\x77\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x35\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\x45\x00\xff\xff\xff\xff\xff\xff\x36\x00\x77\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\x77\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x08\x00\xff\xff\xff\xff\xff\xff\x6f\x00\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x35\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x30\x00\x45\x00\xff\xff\xff\xff\x32\x00\xff\xff\x36\x00\x35\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x58\x00\xff\xff\x5a\x00\x45\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x71\x00\x72\x00\x08\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x45\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x71\x00\x72\x00\x08\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x45\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x71\x00\x72\x00\x08\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x45\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x35\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x76\x00\x77\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\xff\xff\x76\x00\x77\x00\x36\x00\x71\x00\x72\x00\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\x3e\x00\x76\x00\x77\x00\x31\x00\xff\xff\x43\x00\xff\xff\xff\xff\x36\x00\x47\x00\x48\x00\xff\xff\x76\x00\x77\x00\xff\xff\x4d\x00\x3e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x43\x00\xff\xff\xff\xff\x56\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x5e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x2c\x00\xff\xff\xff\xff\x56\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x5e\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x5d\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\x31\x00\xff\xff\x43\x00\x44\x00\x45\x00\x36\x00\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x3e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x43\x00\x54\x00\x55\x00\x56\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x5e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x31\x00\xff\xff\x33\x00\x56\x00\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x5e\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\x4a\x00\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\x5d\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x4a\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x4a\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\xff\xff\x33\x00\x75\x00\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x32\x00\xff\xff\x3b\x00\x35\x00\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x51\x00\x5e\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x51\x00\x74\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x51\x00\x74\x00\xff\xff\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\xff\xff\x51\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7a\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x51\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x51\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x71\x00\x72\x00\x58\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x71\x00\x72\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\x00\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\x41\x00\x42\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\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x0b\x00\x0c\x00\x09\x00\x22\x03\x3e\x01\x80\x02\x62\x00\x04\x00\x64\x00\x2e\x03\x73\x02\x65\x02\xe7\x01\xe8\x01\xc4\x02\x53\x02\x3f\x01\x37\x03\x20\x03\x0e\x03\x0f\x03\x2f\x02\x21\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x46\x02\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x85\x00\xa0\x00\xa4\x00\x2d\x03\xd3\x01\x9f\x01\x1e\x00\x6b\x00\x26\x03\x1f\x00\xe6\x01\xe7\x01\xe8\x01\xa1\x00\xa5\x00\x27\x03\x2e\x00\xa5\x00\x12\x03\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x6a\x00\x86\x00\x67\x00\x34\x00\x87\x00\xba\x02\xfd\x02\x65\x00\x38\x00\x76\x02\x08\x00\x88\x00\x1c\x00\x1d\x00\x52\x00\x88\x01\xe9\x01\xc0\x00\xc1\x00\x22\x01\x1e\x00\x6b\x00\x43\x00\x68\x00\x27\x00\x22\x01\x10\x03\x89\x01\x44\x00\x85\x00\x46\x00\x2f\x03\xa7\x01\x89\x00\x21\x00\x22\x00\x23\x00\x8a\x00\x25\x00\x46\x00\x46\x00\x46\x00\x53\x00\x10\x03\x54\x00\x36\x03\x27\x00\x6c\x00\xfe\x02\x27\x00\x05\x00\x55\x00\x1c\x00\x1d\x00\x8e\x02\x05\x00\xe9\x01\x09\x00\x8c\x02\xfe\x02\x1e\x00\x75\x00\x67\x00\x56\x00\x76\x00\xca\x02\x44\x00\x44\x00\x85\x00\x46\x00\x44\x00\xba\x00\x46\x00\x57\x00\x21\x00\x22\x00\x23\x00\x58\x00\x25\x00\x72\x00\x99\x00\x86\x00\x67\x00\x68\x00\x87\x00\x37\x03\x53\x00\x6c\x00\x54\x00\x8b\x00\xbd\x02\x88\x00\x1c\x00\x1d\x00\xff\x02\x55\x00\x1c\x00\x1d\x00\x73\x00\xb9\x00\x1e\x00\x6e\x00\x67\x00\x68\x00\x1e\x00\xcb\x02\x44\x00\x56\x00\x46\x00\x88\x01\x37\x02\x84\x00\x62\x00\x89\x00\x21\x00\x22\x00\x9e\x00\x57\x00\x21\x00\x22\x00\x9e\x00\x89\x01\x38\x02\x68\x00\xaa\x01\xab\x01\xac\x01\xc0\x02\x92\x02\x59\x00\xae\x01\xaf\x01\xb0\x01\x11\x01\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x20\x01\x21\x01\x0d\x03\x0e\x03\x0f\x03\xb6\x01\x0e\x00\x0f\x00\xb7\x01\xb8\x01\x77\x00\x12\x00\xb9\x01\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x2e\x00\x2e\x00\x74\x00\x3e\x01\x9d\x02\x62\x00\x1e\x00\x8b\x00\x11\x01\x1f\x00\xd6\x02\x59\x00\xa2\x01\x34\x00\x34\x00\x3f\x01\xa3\x01\x27\x00\x38\x00\x38\x00\x9e\x02\xeb\x01\x37\x02\x6d\x02\x62\x00\xba\x01\x62\x02\x6f\x00\x44\x00\xba\x00\x46\x00\xec\xff\x43\x00\x43\x00\x38\x02\xa8\x00\x14\x02\xd9\x02\x44\x00\x85\x00\x46\x00\x46\x00\x22\x01\xdc\x02\xc2\x00\x3b\x02\xc3\x00\x63\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x17\x01\xbb\x01\xeb\x01\x63\x02\xec\x01\x64\x00\xd4\x00\xd5\x00\x10\x03\xbc\x01\xed\x01\xbd\x01\x4d\x00\xaa\x01\xab\x01\xac\x01\x11\x01\xad\x01\x30\x01\xae\x01\xaf\x01\xb0\x01\x3c\x02\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x02\x01\x22\x00\x03\x01\x44\x00\x85\x00\xb6\x01\x0e\x00\x0f\x00\xb7\x01\xb8\x01\x18\x01\x12\x00\xb9\x01\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xef\x02\xab\x01\xac\x01\xed\x01\x96\x02\x2a\x03\x1e\x00\x31\x01\x77\x02\x1f\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x66\x00\x67\x00\xaf\x00\xa0\x00\x62\x00\x65\x00\x97\x02\x15\x02\xcf\x02\xd0\x02\xba\x01\x9a\x02\xd1\x02\x9f\x01\x07\x00\xa1\x00\xb9\x00\x04\x01\x2b\x03\x08\x00\xbd\x00\xd1\x01\x68\x00\x27\x00\x86\x02\xa5\x00\x6e\x00\x67\x00\x84\x00\xc2\x00\x27\x00\xc3\x00\xb7\x02\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x68\x00\xbb\x01\x11\x01\x2b\x03\xab\x01\xac\x01\xd4\x00\xd5\x00\x87\x02\xbc\x01\x27\x00\xbd\x01\x4d\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x09\x00\xc2\x00\x98\x02\xc3\x00\xfe\xff\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x99\x02\xbb\x01\x69\x00\x2c\x03\xab\x01\xac\x01\xd4\x00\xd5\x00\x44\x00\xbc\x01\x46\x00\x1f\x00\x27\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x44\x00\xba\x00\x46\x00\x44\x00\xba\x00\x46\x00\xcc\x02\x5e\x00\x5f\x00\x42\x02\x6f\x00\xd6\x01\x1c\x03\xab\x01\xac\x01\x1a\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\xb2\x02\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\xd3\x02\xe4\x01\xc2\x00\xd4\x02\xc3\x00\xb3\x02\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x27\x00\xbb\x01\x0c\x03\xab\x01\xac\x01\x2d\x02\xd4\x00\xd5\x00\xbe\x02\xbc\x01\x43\x02\x4d\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x27\x00\x25\x02\xc2\x00\x61\x00\xc3\x00\x62\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x0c\x01\xbb\x01\xe4\x02\x27\x00\x27\x00\xe5\x02\xd4\x00\xd5\x00\xc2\x00\xbc\x01\xc3\x00\x6a\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x3c\x02\xbb\x01\xf6\x02\xab\x01\xac\x01\x6b\x00\xd4\x00\xd5\x00\xc7\x02\xbc\x01\x18\x03\x27\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x48\x02\x25\x02\xc2\x00\xf1\x02\xc3\x00\x27\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x19\x03\xbb\x01\xf7\x02\xab\x01\xac\x01\xdb\x02\xd4\x00\xd5\x00\xc1\xfe\xbc\x01\xf2\x02\xc1\xfe\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\xc0\x00\xc1\x00\xb5\x02\x21\x00\x22\x00\x9e\x00\xdf\x02\xe0\x02\x4a\x02\xc0\x00\xc1\x00\x4b\x02\xf8\x02\xab\x01\xac\x01\x32\x02\x6c\x00\x7e\x02\x33\x02\xc1\xfe\x14\x01\x15\x01\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x03\x00\x02\x00\xc2\x00\x91\x02\xc3\x00\xa7\x01\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\xa8\x01\xbb\x01\xed\x02\xab\x01\xac\x01\xce\x01\xd4\x00\xd5\x00\xe5\x01\xbc\x01\x27\x00\xcf\x01\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x31\x01\x96\x02\xc2\x00\xf0\x01\xc3\x00\xd3\x01\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\xf1\x01\xbb\x01\x14\x03\x15\x03\xa0\x02\x16\x02\xd4\x00\xd5\x00\xc2\x00\xbc\x01\xc3\x00\x17\x02\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x25\x02\xbb\x01\x9e\x02\xab\x01\xac\x01\x18\x02\xd4\x00\xd5\x00\x20\x02\xbc\x01\xc0\x00\xc1\x00\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x5f\x01\x60\x01\xc2\x00\x21\x02\xc3\x00\x26\x02\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x27\x02\xbb\x01\x81\x02\xab\x01\xac\x01\x28\x02\xd4\x00\xd5\x00\xab\x00\xbc\x01\x65\x01\x66\x01\xb1\x01\xb2\x01\xb3\x01\xb4\x01\xb5\x01\x00\x01\xc2\x00\xbf\x00\xc3\x00\x28\x01\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x54\x01\x7b\x02\x4f\x01\xa1\x02\x67\x01\x68\x01\xd4\x00\xd5\x00\x6c\x01\xc2\x00\x81\x01\xc3\x00\x83\x01\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x0e\x01\xbb\x01\xc0\x00\xc1\x00\x46\x00\x54\x01\xd4\x00\xd5\x00\x9f\x01\xbc\x01\x9d\x00\x21\x00\x22\x00\x9e\x00\xb0\x02\x69\x02\x6a\x02\xb1\x02\x94\x01\xc2\x00\x71\x00\xc3\x00\x72\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x0e\x02\xbb\x01\x54\x01\x73\x00\xe2\x02\x99\x01\xd4\x00\xd5\x00\xa1\x01\xbc\x01\xc0\x00\xc1\x00\x46\x00\x99\x00\xc2\x00\x9c\x00\xc3\x00\xa5\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x0f\x02\x56\x01\x54\x01\x89\x01\x5e\x00\x5f\x00\xd4\x00\xd5\x00\x6b\x02\x6c\x02\x11\x01\xc2\x02\x5e\x00\x5f\x00\xc2\x00\xa6\x00\xc3\x00\xa8\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\xaa\x00\x56\x01\x10\x02\x74\x00\xc0\x00\xc1\x00\xd4\x00\xd5\x00\x31\x01\x94\x02\x11\x01\x61\x01\x62\x01\x63\x01\x64\x01\xab\x00\xc2\x00\xac\x00\xc3\x00\xba\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x55\x01\x56\x01\xbb\x00\x6d\x02\x5e\x00\x5f\x00\xd4\x00\xd5\x00\x59\x01\x5a\x01\x11\x01\x89\x01\x5e\x00\x5f\x00\xc2\x00\xbc\x00\xc3\x00\xf7\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x9f\x01\x56\x01\x78\x02\xb0\x01\x5f\x01\x60\x01\xd4\x00\xd5\x00\xa0\x00\xff\x00\x11\x01\x00\x01\xa5\x00\x65\x01\x66\x01\xb6\x01\x0e\x00\x0f\x00\xb7\x01\xb8\x01\xa1\x00\x12\x00\xb9\x01\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x4e\x00\x22\x00\x9d\x01\x48\x00\x29\x00\x01\x01\x1e\x00\xa4\x00\x95\x00\x1f\x00\x5d\x00\x5e\x00\x5f\x00\x5c\x00\xb9\x00\x56\x00\x2a\x00\x92\x00\x93\x00\xa5\x00\x62\x00\xd7\x00\x42\x02\x67\x01\x68\x01\xba\x01\x84\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x94\x00\x95\x00\xdf\x00\xc1\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x97\x00\xc2\x00\x02\x00\xc3\x00\xe0\x00\x47\x01\xc5\x00\x48\x01\x99\x00\x39\x03\x83\x00\x51\x00\x4d\x00\x3a\x03\x3b\x03\x44\x00\xba\x00\x46\x00\x89\x01\x5e\x00\x5f\x00\x88\x02\x84\x00\x44\x00\xe1\x00\x46\x00\xd4\x00\xd5\x00\xdd\x01\x5e\x00\x5f\x00\xbd\x01\x4d\x00\x89\x02\x0e\x00\x0f\x00\xb7\x01\xb8\x01\x59\x00\x12\x00\xb9\x01\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x31\x03\x44\x00\xe2\x00\x46\x00\x44\x00\x85\x00\x1e\x00\x78\x00\x99\x00\x1f\x00\x32\x03\x44\x00\xba\x00\x46\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x33\x03\x99\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xba\x01\x29\x03\xc2\x00\x1f\x03\xc3\x00\xd7\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xfc\x01\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x20\x03\x22\x03\xdf\x00\xde\x01\x5e\x00\x5f\x00\x25\x03\x44\x00\x85\x00\xd4\x00\xd5\x00\x26\x03\x16\x03\xe0\x00\x79\x00\x17\x03\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x1a\x03\x80\x00\x21\x00\x22\x00\x23\x00\x81\x00\x25\x00\xbf\x01\x97\x00\x1e\x03\x04\x01\xe1\x00\xc0\x01\x2b\x00\xc1\x01\x2c\x00\xc2\x01\x2d\x00\x2e\x00\xc3\x01\x2f\x00\xc4\x01\xc5\x01\x30\x00\x06\x03\x31\x00\x32\x00\x33\x00\xc6\x01\xc7\x01\xc8\x01\x34\x00\x35\x00\x36\x00\x46\x00\x37\x00\x38\x00\xc9\x01\x39\x00\x3a\x00\xe2\x00\x3b\x00\x3c\x00\xca\x01\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\xcb\x01\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xcd\x01\x46\x00\xce\x01\xe9\x00\xea\x00\xeb\x00\xd7\x00\x2e\x00\x0c\x03\x2e\x00\x09\x03\x0a\x03\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x0b\x03\x34\x00\xdf\x00\x34\x00\x86\x01\x7d\x00\x38\x00\xa4\x00\x38\x00\x13\x03\x02\x01\x22\x00\x03\x01\xe0\x00\x89\x01\x5e\x00\x5f\x00\x46\x00\xf3\x02\xa5\x00\x43\x00\xce\x02\x43\x00\xd2\x02\x04\x03\xc2\x00\xd6\x02\xc3\x00\x46\x00\x47\x01\xc5\x00\xc6\x00\xfa\x01\xe1\x00\xd9\x02\x2b\x00\xba\x02\x2c\x00\xdf\x02\x2d\x00\x2e\x00\xe6\x02\x2f\x00\xe7\x02\xe9\x02\x30\x00\xe8\x02\x31\x00\x32\x00\x33\x00\xd4\x00\xd5\x00\xea\x02\x34\x00\x35\x00\x36\x00\xec\x02\x37\x00\x38\x00\x95\x02\x39\x00\x3a\x00\xe2\x00\x3b\x00\x3c\x00\x04\x01\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x97\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x45\x00\x46\x00\xce\x01\xe9\x00\xea\x00\xeb\x00\xd7\x00\x2e\x02\x5e\x00\x5f\x00\x9c\x02\xa0\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x44\x00\x85\x00\xdf\x00\x25\x01\x5e\x00\x5f\x00\xa4\x02\x66\x02\x14\x00\x5f\x02\x19\x01\xa6\x02\x1a\x01\xe0\x00\x1b\x01\x1b\x00\x1c\x00\x1d\x00\xc0\x02\x56\x00\x26\x01\x5e\x00\x5f\x00\xc5\x02\x1e\x00\xc6\x02\x3e\x02\x1f\x00\x46\x00\x0a\x01\x21\x00\x22\x00\x9e\x00\xe1\x00\x46\x02\xdc\xff\x54\x02\xdc\xff\x55\x02\xdc\xff\xdc\xff\x46\x00\xdc\xff\x67\x02\x57\x02\xdc\xff\x58\x02\xdc\xff\xdc\xff\xdc\xff\xaf\x00\xb2\x02\x62\x00\xdc\xff\xdc\xff\xdc\xff\x59\x02\xdc\xff\xdc\xff\x5a\x02\xdc\xff\xdc\xff\xe2\x00\xdc\xff\xdc\xff\x5b\x02\xdc\xff\xdc\xff\xdc\xff\xdc\xff\xdc\xff\xdc\xff\xdc\xff\x5c\x02\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\xdc\xff\xd7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x59\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x27\x00\x5d\x02\xdf\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\x6f\x02\x5b\x01\x4e\x00\x22\x00\x9d\x01\x5d\x01\xe0\x00\x53\x00\x61\x02\x54\x00\x38\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x55\x00\x1c\x00\x1d\x00\x5d\x00\x5e\x00\x5f\x00\xbf\x01\x97\x00\x5c\x01\x1e\x00\xe1\x00\xc0\x01\x56\x00\xc1\x01\x5e\x01\xc2\x01\x64\x02\x65\x02\xc3\x01\xed\x01\xc4\x01\xc5\x01\x2c\x01\x21\x00\x22\x00\x9e\x00\x59\xfe\xc6\x01\xc7\x01\xc8\x01\x89\x01\x5e\x00\x5f\x00\x1f\x00\x7a\x02\x5a\xfe\xc9\x01\x7b\x02\x7e\x02\xe2\x00\xb7\x00\x4d\x00\xca\x01\x49\x00\x21\x00\x22\x00\x23\x00\x4a\x00\x25\x00\x4b\x00\xcb\x01\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xc1\x00\x46\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd7\x00\x5d\x00\x5e\x00\x5f\x00\x81\x02\x91\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x83\x02\x8b\x02\xdf\x00\x59\x00\x1f\x00\xad\x00\x5e\x00\x5f\x00\xaf\x00\x7c\x00\x7d\x00\xb0\x00\x7f\x00\xe0\x00\x49\x00\x21\x00\x22\x00\x23\x00\x4a\x00\x25\x00\xb1\x00\x84\x02\x86\x02\x4c\x00\x4d\x00\x5d\x00\x5e\x00\x5f\x00\x8c\x02\xbf\x01\x97\x00\xf7\x00\x9b\x00\xe1\x00\xc0\x01\xaa\x01\xc1\x01\xd5\x01\xc2\x01\xd6\x01\xe0\x01\xc3\x01\x46\x00\xc4\x01\xc5\x01\x39\x01\x39\x01\x62\x00\x62\x00\x88\x01\xc6\x01\xc7\x01\xc8\x01\x69\x01\x6a\x01\x6b\x01\xe3\x01\x3a\x01\x3a\x01\xc9\x01\xef\x01\x89\x01\xe2\x00\xf0\x01\x0c\x02\xca\x01\xaf\x00\x71\x02\x62\x00\xb2\x00\x4d\x00\x0d\x02\x0e\x02\xcb\x01\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xc1\x00\xd7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x12\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x80\x01\x2a\x02\x2b\x02\xdf\x00\x2c\x02\xa8\x00\x2e\x00\x2e\x00\x2d\x02\x3a\x02\x2e\x00\x31\x02\x1e\x01\x79\x01\xe0\x00\x7a\x01\x1f\x01\x7b\x01\x7c\x01\x34\x00\x34\x00\x7d\x01\x7e\x01\x34\x00\x38\x00\x38\x00\x20\x01\x24\x01\x38\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\xd7\x01\xe1\x00\x4e\x00\x22\x00\x9d\x01\x43\x00\x43\x00\x28\x01\x2e\x00\x43\x00\x32\x01\x44\x00\x44\x00\x46\x00\x46\x00\x44\x00\x85\x00\x46\x00\xaf\x00\x72\x02\x62\x00\x34\x00\x33\x01\x45\x01\xd1\x01\x46\x01\x38\x00\xaf\x00\x07\x01\x62\x00\xe2\x00\x81\x01\xaf\x00\xdd\x01\x62\x00\x47\x01\xa5\x00\xaf\x00\xe4\x01\x62\x00\x43\x00\x51\x01\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x56\x00\x46\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd7\x00\x58\x01\xb0\x02\xb7\x00\x4d\x00\xb1\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x5b\x01\x5d\x01\xdf\x00\x51\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x5c\x01\xd7\x00\x2e\x00\xb0\x02\xe0\x00\x5e\x01\xb1\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x83\x01\x34\x00\xdf\x00\x8b\x01\x8c\x01\x1f\x00\x38\x00\x76\x02\xfc\x02\x99\x01\xe1\x00\xa5\x01\xa8\x00\xe0\x00\xa6\x01\x49\x00\x21\x00\x22\x00\x9e\x00\x9c\x00\x43\x00\xa0\x01\xa8\x00\xa7\x01\x59\x00\x97\x00\x44\x00\x85\x00\x46\x00\x9b\x00\x76\x02\x03\x03\xaa\x00\xe1\x00\x97\x00\xec\xff\x56\x00\xa8\x00\x97\x00\xe2\x00\x91\x01\x7c\x00\x7d\x00\x92\x01\x7f\x00\xdc\x01\x0a\x01\x21\x00\x22\x00\x9e\x00\x62\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xc1\x00\xa5\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xe2\x00\x4e\x00\x22\x00\x4f\x00\x50\x00\x25\x00\xff\x00\x97\x00\x4c\x00\x4d\x00\x06\x01\x08\x01\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xc1\x00\xd7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x14\x01\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\xb4\x00\x7d\x00\xdf\x00\x47\x00\x48\x00\x2e\x00\x4e\x00\x22\x00\x9d\x01\x59\x00\x69\x01\x6a\x01\x6b\x01\xe0\x00\x61\x00\x07\x01\x62\x00\x97\x00\x34\x00\x99\x00\xd7\x00\x0b\x00\xff\xff\x38\x00\x51\x00\x4d\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xe1\x00\x00\x00\xdf\x00\x00\x00\x43\x00\x1f\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\xe0\x00\x00\x00\x08\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x34\x00\x09\x01\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\xb7\x00\x4d\x00\xe2\x00\xc2\x00\x00\x00\xc3\x00\xe1\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xfd\x01\x43\x00\x2e\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x46\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x00\x00\x34\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\xe2\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x01\x43\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd7\x00\x00\x00\xb0\x02\x00\x00\x00\x00\xb1\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x7c\x00\x7d\x00\x00\x00\xe0\x00\xd7\x00\x24\x01\x21\x00\x22\x00\x9e\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x76\x02\x00\x00\x00\x00\xe1\x00\x00\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\x85\x01\xe0\x00\x4e\x00\x22\x00\x9d\x01\xd7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\xe1\x00\x00\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\xe0\x00\x59\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xcc\x01\xc1\x00\x34\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x38\x00\x00\x00\x76\x02\x00\x00\xe2\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x4d\x00\x00\x00\x00\x00\x43\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x1f\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x7c\x00\x7d\x00\xe2\x00\x00\x00\x00\x00\x49\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\xd7\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\xc2\x00\xdf\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xfb\x01\x00\x00\xd7\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\xd4\x00\xd5\x00\xe1\x01\x4d\x00\x5f\x02\x00\x00\x00\x00\xe1\x00\xd7\x00\xf6\x01\xe0\x00\x00\x00\x00\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x76\x02\x56\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\xe2\x00\x00\x00\x0a\x01\x21\x00\x22\x00\x23\x00\x0b\x01\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x56\x00\xe1\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x24\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x00\x00\xe2\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\x8c\x01\x00\x00\x4e\x00\x22\x00\x9d\x01\x00\x00\x59\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\xd7\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x88\x01\x00\x00\xdf\x00\xc2\x00\x00\x00\xc3\x00\x59\x00\x47\x01\xc5\x00\x5d\x02\x00\x00\xd7\x00\x89\x01\xe0\x00\x00\x00\x00\x00\x0a\x02\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\xb7\x00\x4d\x00\xe1\x00\xd7\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x97\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\xe0\x00\x00\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\xe1\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x43\x00\xe2\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\xc8\x02\xe8\x00\xe9\x00\xea\x00\xeb\x00\xe2\x00\x50\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x4d\x01\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\xc2\x00\xdf\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xf7\x01\x00\x00\x00\x00\x4f\x01\x00\x00\x00\x00\xe0\x00\x00\x00\x04\x01\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x53\x01\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\xe1\x00\x8d\x01\x7c\x00\x7d\x00\xe0\x00\x00\x00\xe2\x00\x08\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x6e\x02\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\xe1\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xe2\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\x02\x02\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x00\x00\xe2\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x39\x01\x00\x00\x62\x00\x00\x00\x04\x01\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\xd7\x00\x3a\x01\xe8\x00\xe9\x00\xea\x00\xeb\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\x13\x01\x00\x00\x00\x00\xdf\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x91\x01\x7c\x00\x7d\x00\x92\x01\x7f\x00\xe0\x00\x0a\x01\x21\x00\x22\x00\x23\x00\x0b\x01\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\xe1\x00\x30\x00\x00\x00\x31\x00\x32\x00\x33\x00\x3e\x01\x00\x00\x62\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x3f\x01\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x59\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe5\x00\xe6\x00\x99\x00\xe7\x00\x00\x00\x00\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\x00\x00\x39\x01\x2b\x00\x62\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x3a\x01\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x39\x01\x2b\x00\x62\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x3a\x01\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x39\x01\x2b\x00\x62\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x3a\x01\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x5b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x5c\x00\x46\x00\x37\x02\x2b\x00\x62\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x38\x02\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x8d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x8e\x00\x46\x00\xa0\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\xa1\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x4b\x01\xc5\x00\x45\x00\x46\x00\xa0\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\xa1\x00\x31\x00\x32\x00\x33\x00\x00\x00\xd4\x00\xd5\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x5b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x5c\x00\x46\x00\xa0\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\xa1\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x8d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x8e\x00\x46\x00\xa0\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\xa1\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x5b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x5c\x00\x46\x00\x29\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x2a\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x8d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x8e\x00\x46\x00\x29\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x2a\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x5b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x5c\x00\x46\x00\x29\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x2a\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x8d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x8e\x00\x46\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\xa0\x00\x30\x00\x00\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\xa1\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\xb7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x4d\x01\xc5\x00\x37\x02\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x38\x02\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x33\x00\xd4\x00\xd5\x00\x00\x00\x34\x00\x35\x00\x36\x00\x91\x01\x00\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x00\x00\x3c\x00\x94\x01\x00\x00\x5b\x00\xa5\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x44\x00\x5c\x00\x46\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x9d\x01\x00\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x00\x00\x3c\x00\x2e\x00\x00\x00\x5b\x00\xa5\x00\x40\x00\x41\x00\x42\x00\x43\x00\xb4\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x34\x00\x5c\x00\x46\x00\x00\x00\x00\x00\x38\x00\xa0\x00\x84\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\x43\x00\x29\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x38\x00\xc2\x00\x8d\x02\xc3\x00\x00\x00\x47\x01\xc5\x00\xf8\x01\x00\x00\x00\x00\x2e\x00\x00\x00\x34\x00\x00\x00\x43\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\x34\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x38\x00\x00\x00\x00\x00\x43\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x44\x00\x85\x00\x46\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x44\x00\x00\x00\x46\x00\x38\x00\x79\x00\x00\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x80\x00\x21\x00\x22\x00\x9e\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x46\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x22\x00\x9d\x01\x00\x00\x00\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x5e\x00\x5f\x00\x1d\x02\x1e\x02\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x51\x01\xc5\x00\x1f\x02\x4d\x00\x4e\x00\x22\x00\x9d\x01\x00\x00\x00\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x5e\x00\x5f\x00\x1d\x02\x1e\x02\xd4\x00\xd5\x00\x00\x00\x00\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x01\x7d\x00\x00\x00\x00\x00\x24\x02\x4d\x00\x02\x01\x22\x00\x03\x01\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x2e\x01\x00\x00\x00\x00\x00\x00\x4c\x02\x5e\x00\x5f\x00\x4d\x02\x4e\x02\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\xda\x02\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\xb8\x02\x1f\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\xa2\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x04\x01\x00\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x5e\x00\x5f\x00\x1d\x02\x1e\x02\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x44\x02\x4d\x00\x02\x01\x22\x00\x03\x01\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x2e\x01\x00\x00\x00\x00\x00\x00\x4c\x02\x5e\x00\x5f\x00\x4d\x02\x4e\x02\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1f\x00\x1f\x00\x8f\x02\x00\x00\xaf\x00\x7c\x00\x7d\x00\xb0\x00\x7f\x00\x00\x00\x49\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x04\x01\x9b\x01\xf0\x00\x00\x00\x00\x00\x2e\x01\x00\x00\x00\x00\x00\x00\x4c\x02\x5e\x00\x5f\x00\x4d\x02\x4e\x02\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x8f\x00\x1f\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x80\x00\x21\x00\x22\x00\x9e\x00\xb2\x00\x4d\x00\x04\x01\x00\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf5\x00\x4d\x00\x1e\x00\x00\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x8d\x01\x7c\x00\x7d\x00\x8e\x01\x7f\x00\x00\x00\x08\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x8f\x01\xf0\x00\x00\x00\x00\x00\x4b\x02\x00\x00\xeb\x00\xec\x00\x00\x00\x12\x00\xed\x00\x14\x00\x15\x00\x16\x00\xee\x00\xef\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x86\x00\x67\x00\x00\x00\x87\x00\xf5\x00\x4d\x00\x1e\x00\x00\x00\x54\x00\x1f\x00\x88\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x55\x00\x1c\x00\x1d\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x68\x00\xb4\x02\x1e\x00\xf0\x00\x00\x00\x56\x00\x2e\x01\x04\x01\x27\x00\x00\x00\x3f\x01\x21\x00\x22\x00\x9e\x00\x00\x00\xb5\x02\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x40\x01\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x86\x00\x67\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x1e\x00\x54\x00\x00\x00\x68\x00\x00\x00\x00\x00\x04\x01\x00\x00\x55\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x2d\x01\x21\x00\x22\x00\x9e\x00\x1e\x00\x54\x00\x8b\x00\x56\x00\x00\x00\x00\x00\x00\x00\x59\x00\x55\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x33\x01\x21\x00\x22\x00\x9e\x00\x1e\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x01\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x18\x01\x14\x00\x00\x00\x19\x01\x00\x00\x1a\x01\x00\x00\x1b\x01\x1b\x00\x1c\x00\x1d\x00\x35\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x1e\x00\x1f\x00\x56\x00\x1f\x00\x8b\x00\xaf\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x49\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x19\x02\x00\x00\x1c\x01\x00\x00\x59\x00\x00\x00\x1a\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\xc2\x00\x59\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x01\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x1b\x02\x4d\x00\x59\x00\x27\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x12\x02\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\xd4\x00\xd5\x00\x8d\x01\x7c\x00\x7d\x00\x00\x00\x59\x00\x00\x00\x08\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x55\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x56\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x7c\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x24\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x91\x01\x7c\x00\x7d\x00\x00\x00\x00\x00\x04\x01\x0a\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x51\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x49\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x22\x02\x00\x00\x1f\x00\x59\x00\x00\x00\x00\x00\x1a\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x08\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x4f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x56\x00\x00\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x23\x02\x4d\x00\x00\x00\xc1\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x0a\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x01\x00\x00\x51\x02\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x56\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x7c\x00\x7d\x00\xda\x01\x7f\x00\x00\x00\x24\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x59\x00\x91\x01\x7c\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x0a\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x59\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x1f\x00\x80\x00\x21\x00\x22\x00\x23\x00\x90\x00\x25\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\xd8\x01\x00\x00\x4e\x00\x22\x00\x9d\x01\xc1\x00\x00\x00\x00\x00\x00\x00\x79\x00\x59\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\xa2\x00\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x59\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x29\x01\x00\x00\x00\x00\x00\x00\xd3\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x4d\x00\x00\x00\x00\x00\x00\x00\xf9\x00\x0e\x00\x0f\x00\xfa\x00\xfb\x00\x1f\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\xb7\x02\x49\x01\x00\x00\x00\x00\x1e\x00\x00\x00\xb8\x02\x1f\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\xa2\x00\x21\x00\x22\x00\x9e\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\xfd\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x4a\x01\x84\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xf9\x01\xf9\x00\x0e\x00\x0f\x00\xfa\x00\xfb\x00\x00\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xd4\x00\xd5\x00\x95\x01\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\x48\x01\xf9\x00\x0e\x00\x0f\x00\xfa\x00\xfb\x00\xfd\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xd4\x00\xd5\x00\x9a\x01\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\x6b\x01\xf9\x00\x0e\x00\x0f\x00\xfa\x00\xfb\x00\xfd\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xd4\x00\xd5\x00\xf8\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x53\x01\xc5\x00\x00\x00\xf9\x00\x0e\x00\x0f\x00\xfa\x00\xfb\x00\xfd\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1f\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\xd7\x01\x00\x00\x4e\x00\x22\x00\x4f\x00\x50\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\x85\x01\x00\x00\x4e\x00\x22\x00\x4f\x00\x50\x00\x25\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\x8c\x01\x00\x00\x4e\x00\x22\x00\x4f\x00\x50\x00\x25\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\xb6\x00\x00\x00\x4e\x00\x22\x00\x4f\x00\x50\x00\x25\x00\xb4\x00\x7d\x00\xb5\x00\x7f\x00\xb6\x00\x00\x00\x4e\x00\x22\x00\x9d\x01\x00\x00\x00\x00\xb7\x00\x4d\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\x03\x02\xb7\x00\x4d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\xb7\x00\x4d\x00\x2e\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x71\x00\x00\x00\x00\x00\x32\x00\xb7\x00\x4d\x00\x2b\x00\x00\x00\x34\x00\x00\x00\x00\x00\x2e\x00\x37\x00\x38\x00\x00\x00\xb7\x00\x4d\x00\x00\x00\x3b\x00\x32\x00\x00\x00\x3d\x00\x00\x00\x3f\x00\x34\x00\x00\x00\x00\x00\x43\x00\x37\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x46\x00\x00\x00\x3d\x00\x00\x00\x3f\x00\x97\x00\x00\x00\x00\x00\x43\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x46\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x45\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\x00\x45\x00\x46\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x32\x00\x33\x00\x00\x00\x2b\x00\x00\x00\x34\x00\x35\x00\x36\x00\x2e\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x3b\x00\x32\x00\x00\x00\x3d\x00\x00\x00\x3f\x00\x34\x00\x41\x00\x42\x00\x43\x00\x37\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x46\x00\x00\x00\x3d\x00\x00\x00\x3f\x00\x2b\x00\x00\x00\x2c\x00\x43\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x46\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x37\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x2a\x01\x3b\x00\x3c\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x45\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x96\x01\x2b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x11\x01\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x0e\x01\x97\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x11\x01\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x2c\x00\x11\x01\x2d\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x00\x00\x38\x00\x00\x00\x39\x00\x3a\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x40\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\xea\x02\x0e\x00\x0f\x00\xfa\x00\xfb\x00\x00\x00\x12\x00\xfc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x2c\x00\x00\x00\x2d\x00\x2e\x00\x00\x00\x2f\x00\x1e\x00\x00\x00\x30\x00\x1f\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x34\x00\x35\x00\x36\x00\x00\x00\x00\x00\x38\x00\x00\x00\x39\x00\x3a\x00\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x02\x46\x00\xa9\x02\xaa\x02\xab\x02\xac\x02\xad\x02\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xa8\x02\xae\x02\xbc\x02\xaa\x02\xab\x02\xac\x02\xad\x02\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xf9\x02\xae\x02\x00\x00\xfa\x02\xab\x02\xac\x02\xad\x02\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\xae\x02\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x02\xd4\x00\xd5\x00\x00\x00\x07\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\xe2\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\x73\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x74\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x7b\x02\x00\x00\x1a\x03\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x7b\x02\x00\x00\x1b\x03\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x7b\x02\x00\x00\xf4\x02\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x7b\x02\x00\x00\xf5\x02\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x7b\x02\x00\x00\x7c\x02\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x33\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x34\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x23\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xf3\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x04\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xee\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xa2\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xa4\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xa6\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xa7\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\xf2\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\xf3\x01\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xf4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x0f\x01\x00\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x33\x02\x00\x00\x00\x00\x34\x02\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x03\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x03\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xba\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xc7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x3e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xed\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xf6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xbb\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x5f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\x0a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x07\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\x06\x02\x6e\x01\x6f\x01\x70\x01\x71\x01\x72\x01\x73\x01\x74\x01\x75\x01\x76\x01\x77\x01\x78\x01\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\x05\x02\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x04\x02\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xfe\x01\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xff\x01\x00\x00\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\x00\x02\x00\x00\xd4\x00\xd5\x00\xc2\x00\x00\x00\xc3\x00\x00\x00\x47\x01\xc5\x00\xc6\x00\xc7\x00\xc8\x00\x01\x02\x00\x00\x00\x00\xd4\x00\xd5\x00\x3a\x01\x7c\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x3b\x01\x21\x00\x22\x00\x9e\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x01\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x41\x01\x7c\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x42\x01\x21\x00\x22\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x01\x35\x01\x5e\x00\x5f\x00\x36\x01\x37\x01\x8f\x00\x00\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\xa2\x00\x21\x00\x22\x00\x9e\x00\xa1\x00\x00\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\xa2\x00\x21\x00\x22\x00\x9e\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\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\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\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = array (1, 436) [ + (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), + (40 , happyReduce_40), + (41 , happyReduce_41), + (42 , happyReduce_42), + (43 , happyReduce_43), + (44 , happyReduce_44), + (45 , happyReduce_45), + (46 , happyReduce_46), + (47 , happyReduce_47), + (48 , happyReduce_48), + (49 , happyReduce_49), + (50 , happyReduce_50), + (51 , happyReduce_51), + (52 , happyReduce_52), + (53 , happyReduce_53), + (54 , happyReduce_54), + (55 , happyReduce_55), + (56 , happyReduce_56), + (57 , happyReduce_57), + (58 , happyReduce_58), + (59 , happyReduce_59), + (60 , happyReduce_60), + (61 , happyReduce_61), + (62 , happyReduce_62), + (63 , happyReduce_63), + (64 , happyReduce_64), + (65 , happyReduce_65), + (66 , happyReduce_66), + (67 , happyReduce_67), + (68 , happyReduce_68), + (69 , happyReduce_69), + (70 , happyReduce_70), + (71 , happyReduce_71), + (72 , happyReduce_72), + (73 , happyReduce_73), + (74 , happyReduce_74), + (75 , happyReduce_75), + (76 , happyReduce_76), + (77 , happyReduce_77), + (78 , happyReduce_78), + (79 , happyReduce_79), + (80 , happyReduce_80), + (81 , happyReduce_81), + (82 , happyReduce_82), + (83 , happyReduce_83), + (84 , happyReduce_84), + (85 , happyReduce_85), + (86 , happyReduce_86), + (87 , happyReduce_87), + (88 , happyReduce_88), + (89 , happyReduce_89), + (90 , happyReduce_90), + (91 , happyReduce_91), + (92 , happyReduce_92), + (93 , happyReduce_93), + (94 , happyReduce_94), + (95 , happyReduce_95), + (96 , happyReduce_96), + (97 , happyReduce_97), + (98 , happyReduce_98), + (99 , happyReduce_99), + (100 , happyReduce_100), + (101 , happyReduce_101), + (102 , happyReduce_102), + (103 , happyReduce_103), + (104 , happyReduce_104), + (105 , happyReduce_105), + (106 , happyReduce_106), + (107 , happyReduce_107), + (108 , happyReduce_108), + (109 , happyReduce_109), + (110 , happyReduce_110), + (111 , happyReduce_111), + (112 , happyReduce_112), + (113 , happyReduce_113), + (114 , happyReduce_114), + (115 , happyReduce_115), + (116 , happyReduce_116), + (117 , happyReduce_117), + (118 , happyReduce_118), + (119 , happyReduce_119), + (120 , happyReduce_120), + (121 , happyReduce_121), + (122 , happyReduce_122), + (123 , happyReduce_123), + (124 , happyReduce_124), + (125 , happyReduce_125), + (126 , happyReduce_126), + (127 , happyReduce_127), + (128 , happyReduce_128), + (129 , happyReduce_129), + (130 , happyReduce_130), + (131 , happyReduce_131), + (132 , happyReduce_132), + (133 , happyReduce_133), + (134 , happyReduce_134), + (135 , happyReduce_135), + (136 , happyReduce_136), + (137 , happyReduce_137), + (138 , happyReduce_138), + (139 , happyReduce_139), + (140 , happyReduce_140), + (141 , happyReduce_141), + (142 , happyReduce_142), + (143 , happyReduce_143), + (144 , happyReduce_144), + (145 , happyReduce_145), + (146 , happyReduce_146), + (147 , happyReduce_147), + (148 , happyReduce_148), + (149 , happyReduce_149), + (150 , happyReduce_150), + (151 , happyReduce_151), + (152 , happyReduce_152), + (153 , happyReduce_153), + (154 , happyReduce_154), + (155 , happyReduce_155), + (156 , happyReduce_156), + (157 , happyReduce_157), + (158 , happyReduce_158), + (159 , happyReduce_159), + (160 , happyReduce_160), + (161 , happyReduce_161), + (162 , happyReduce_162), + (163 , happyReduce_163), + (164 , happyReduce_164), + (165 , happyReduce_165), + (166 , happyReduce_166), + (167 , happyReduce_167), + (168 , happyReduce_168), + (169 , happyReduce_169), + (170 , happyReduce_170), + (171 , happyReduce_171), + (172 , happyReduce_172), + (173 , happyReduce_173), + (174 , happyReduce_174), + (175 , happyReduce_175), + (176 , happyReduce_176), + (177 , happyReduce_177), + (178 , happyReduce_178), + (179 , happyReduce_179), + (180 , happyReduce_180), + (181 , happyReduce_181), + (182 , happyReduce_182), + (183 , happyReduce_183), + (184 , happyReduce_184), + (185 , happyReduce_185), + (186 , happyReduce_186), + (187 , happyReduce_187), + (188 , happyReduce_188), + (189 , happyReduce_189), + (190 , happyReduce_190), + (191 , happyReduce_191), + (192 , happyReduce_192), + (193 , happyReduce_193), + (194 , happyReduce_194), + (195 , happyReduce_195), + (196 , happyReduce_196), + (197 , happyReduce_197), + (198 , happyReduce_198), + (199 , happyReduce_199), + (200 , happyReduce_200), + (201 , happyReduce_201), + (202 , happyReduce_202), + (203 , happyReduce_203), + (204 , happyReduce_204), + (205 , happyReduce_205), + (206 , happyReduce_206), + (207 , happyReduce_207), + (208 , happyReduce_208), + (209 , happyReduce_209), + (210 , happyReduce_210), + (211 , happyReduce_211), + (212 , happyReduce_212), + (213 , happyReduce_213), + (214 , happyReduce_214), + (215 , happyReduce_215), + (216 , happyReduce_216), + (217 , happyReduce_217), + (218 , happyReduce_218), + (219 , happyReduce_219), + (220 , happyReduce_220), + (221 , happyReduce_221), + (222 , happyReduce_222), + (223 , happyReduce_223), + (224 , happyReduce_224), + (225 , happyReduce_225), + (226 , happyReduce_226), + (227 , happyReduce_227), + (228 , happyReduce_228), + (229 , happyReduce_229), + (230 , happyReduce_230), + (231 , happyReduce_231), + (232 , happyReduce_232), + (233 , happyReduce_233), + (234 , happyReduce_234), + (235 , happyReduce_235), + (236 , happyReduce_236), + (237 , happyReduce_237), + (238 , happyReduce_238), + (239 , happyReduce_239), + (240 , happyReduce_240), + (241 , happyReduce_241), + (242 , happyReduce_242), + (243 , happyReduce_243), + (244 , happyReduce_244), + (245 , happyReduce_245), + (246 , happyReduce_246), + (247 , happyReduce_247), + (248 , happyReduce_248), + (249 , happyReduce_249), + (250 , happyReduce_250), + (251 , happyReduce_251), + (252 , happyReduce_252), + (253 , happyReduce_253), + (254 , happyReduce_254), + (255 , happyReduce_255), + (256 , happyReduce_256), + (257 , happyReduce_257), + (258 , happyReduce_258), + (259 , happyReduce_259), + (260 , happyReduce_260), + (261 , happyReduce_261), + (262 , happyReduce_262), + (263 , happyReduce_263), + (264 , happyReduce_264), + (265 , happyReduce_265), + (266 , happyReduce_266), + (267 , happyReduce_267), + (268 , happyReduce_268), + (269 , happyReduce_269), + (270 , happyReduce_270), + (271 , happyReduce_271), + (272 , happyReduce_272), + (273 , happyReduce_273), + (274 , happyReduce_274), + (275 , happyReduce_275), + (276 , happyReduce_276), + (277 , happyReduce_277), + (278 , happyReduce_278), + (279 , happyReduce_279), + (280 , happyReduce_280), + (281 , happyReduce_281), + (282 , happyReduce_282), + (283 , happyReduce_283), + (284 , happyReduce_284), + (285 , happyReduce_285), + (286 , happyReduce_286), + (287 , happyReduce_287), + (288 , happyReduce_288), + (289 , happyReduce_289), + (290 , happyReduce_290), + (291 , happyReduce_291), + (292 , happyReduce_292), + (293 , happyReduce_293), + (294 , happyReduce_294), + (295 , happyReduce_295), + (296 , happyReduce_296), + (297 , happyReduce_297), + (298 , happyReduce_298), + (299 , happyReduce_299), + (300 , happyReduce_300), + (301 , happyReduce_301), + (302 , happyReduce_302), + (303 , happyReduce_303), + (304 , happyReduce_304), + (305 , happyReduce_305), + (306 , happyReduce_306), + (307 , happyReduce_307), + (308 , happyReduce_308), + (309 , happyReduce_309), + (310 , happyReduce_310), + (311 , happyReduce_311), + (312 , happyReduce_312), + (313 , happyReduce_313), + (314 , happyReduce_314), + (315 , happyReduce_315), + (316 , happyReduce_316), + (317 , happyReduce_317), + (318 , happyReduce_318), + (319 , happyReduce_319), + (320 , happyReduce_320), + (321 , happyReduce_321), + (322 , happyReduce_322), + (323 , happyReduce_323), + (324 , happyReduce_324), + (325 , happyReduce_325), + (326 , happyReduce_326), + (327 , happyReduce_327), + (328 , happyReduce_328), + (329 , happyReduce_329), + (330 , happyReduce_330), + (331 , happyReduce_331), + (332 , happyReduce_332), + (333 , happyReduce_333), + (334 , happyReduce_334), + (335 , happyReduce_335), + (336 , happyReduce_336), + (337 , happyReduce_337), + (338 , happyReduce_338), + (339 , happyReduce_339), + (340 , happyReduce_340), + (341 , happyReduce_341), + (342 , happyReduce_342), + (343 , happyReduce_343), + (344 , happyReduce_344), + (345 , happyReduce_345), + (346 , happyReduce_346), + (347 , happyReduce_347), + (348 , happyReduce_348), + (349 , happyReduce_349), + (350 , happyReduce_350), + (351 , happyReduce_351), + (352 , happyReduce_352), + (353 , happyReduce_353), + (354 , happyReduce_354), + (355 , happyReduce_355), + (356 , happyReduce_356), + (357 , happyReduce_357), + (358 , happyReduce_358), + (359 , happyReduce_359), + (360 , happyReduce_360), + (361 , happyReduce_361), + (362 , happyReduce_362), + (363 , happyReduce_363), + (364 , happyReduce_364), + (365 , happyReduce_365), + (366 , happyReduce_366), + (367 , happyReduce_367), + (368 , happyReduce_368), + (369 , happyReduce_369), + (370 , happyReduce_370), + (371 , happyReduce_371), + (372 , happyReduce_372), + (373 , happyReduce_373), + (374 , happyReduce_374), + (375 , happyReduce_375), + (376 , happyReduce_376), + (377 , happyReduce_377), + (378 , happyReduce_378), + (379 , happyReduce_379), + (380 , happyReduce_380), + (381 , happyReduce_381), + (382 , happyReduce_382), + (383 , happyReduce_383), + (384 , happyReduce_384), + (385 , happyReduce_385), + (386 , happyReduce_386), + (387 , happyReduce_387), + (388 , happyReduce_388), + (389 , happyReduce_389), + (390 , happyReduce_390), + (391 , happyReduce_391), + (392 , happyReduce_392), + (393 , happyReduce_393), + (394 , happyReduce_394), + (395 , happyReduce_395), + (396 , happyReduce_396), + (397 , happyReduce_397), + (398 , happyReduce_398), + (399 , happyReduce_399), + (400 , happyReduce_400), + (401 , happyReduce_401), + (402 , happyReduce_402), + (403 , happyReduce_403), + (404 , happyReduce_404), + (405 , happyReduce_405), + (406 , happyReduce_406), + (407 , happyReduce_407), + (408 , happyReduce_408), + (409 , happyReduce_409), + (410 , happyReduce_410), + (411 , happyReduce_411), + (412 , happyReduce_412), + (413 , happyReduce_413), + (414 , happyReduce_414), + (415 , happyReduce_415), + (416 , happyReduce_416), + (417 , happyReduce_417), + (418 , happyReduce_418), + (419 , happyReduce_419), + (420 , happyReduce_420), + (421 , happyReduce_421), + (422 , happyReduce_422), + (423 , happyReduce_423), + (424 , happyReduce_424), + (425 , happyReduce_425), + (426 , happyReduce_426), + (427 , happyReduce_427), + (428 , happyReduce_428), + (429 , happyReduce_429), + (430 , happyReduce_430), + (431 , happyReduce_431), + (432 , happyReduce_432), + (433 , happyReduce_433), + (434 , happyReduce_434), + (435 , happyReduce_435), + (436 , happyReduce_436) + ] + +happy_n_terms = 100 :: Int +happy_n_nonterms = 123 :: Int + +happyReduce_1 = happyMonadReduce 1# 0# happyReduction_1 +happyReduction_1 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut5 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CHeader (reverse happy_var_1))} + ) (\r -> happyReturn (happyIn4 r)) + +happyReduce_2 = happySpecReduce_0 1# happyReduction_2 +happyReduction_2 = happyIn5 + (empty + ) + +happyReduce_3 = happySpecReduce_2 1# happyReduction_3 +happyReduction_3 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn5 + (happy_var_1 + )} + +happyReduce_4 = happySpecReduce_2 1# happyReduction_4 +happyReduction_4 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_5 = happySpecReduce_2 2# happyReduction_5 +happyReduction_5 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn6 + (CFDefExt happy_var_2 + )} + +happyReduce_6 = happySpecReduce_2 2# happyReduction_6 +happyReduction_6 happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn6 + (CDeclExt happy_var_2 + )} + +happyReduce_7 = happySpecReduce_2 2# happyReduction_7 +happyReduction_7 happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6 + (happy_var_2 + )} + +happyReduce_8 = happyMonadReduce 5# 2# happyReduction_8 +happyReduction_8 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 CAsmExt)} + ) (\r -> happyReturn (happyIn6 r)) + +happyReduce_9 = happyMonadReduce 2# 3# happyReduction_9 +happyReduction_9 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_2 of { happy_var_2 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef [] happy_var_1 [] happy_var_2))}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_10 = happyMonadReduce 3# 3# happyReduction_10 +happyReduction_10 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_11 = happyMonadReduce 3# 3# happyReduction_11 +happyReduction_11 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_12 = happyMonadReduce 3# 3# happyReduction_12 +happyReduction_12 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_13 = happyMonadReduce 3# 3# happyReduction_13 +happyReduction_13 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_14 = happyMonadReduce 3# 3# happyReduction_14 +happyReduction_14 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut71 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CFunDef [] happy_var_1 (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_15 = happyMonadReduce 4# 3# happyReduction_15 +happyReduction_15 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)}}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_16 = happyMonadReduce 4# 3# happyReduction_16 +happyReduction_16 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)}}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_17 = happyMonadReduce 4# 3# happyReduction_17 +happyReduction_17 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)}}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_18 = happyMonadReduce 4# 3# happyReduction_18 +happyReduction_18 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)}}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_19 = happyMonadReduce 1# 4# happyReduction_19 +happyReduction_19 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut67 happy_x_1 of { happy_var_1 -> + ( enterScope >> doFuncParamDeclIdent happy_var_1 >> return happy_var_1)} + ) (\r -> happyReturn (happyIn8 r)) + +happyReduce_20 = happySpecReduce_0 5# happyReduction_20 +happyReduction_20 = happyIn9 + (empty + ) + +happyReduce_21 = happySpecReduce_2 5# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn9 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_22 = happySpecReduce_1 6# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_1 6# happyReduction_23 +happyReduction_23 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_24 = happySpecReduce_1 6# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_25 = happySpecReduce_1 6# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_26 = happySpecReduce_1 6# happyReduction_26 +happyReduction_26 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_27 = happySpecReduce_1 6# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_28 = happySpecReduce_1 6# happyReduction_28 +happyReduction_28 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_29 = happyMonadReduce 4# 7# happyReduction_29 +happyReduction_29 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut120 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut10 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_2 $ CLabel happy_var_1 happy_var_4)}}} + ) (\r -> happyReturn (happyIn11 r)) + +happyReduce_30 = happyMonadReduce 4# 7# happyReduction_30 +happyReduction_30 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_2 of { happy_var_2 -> + case happyOut10 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CCase happy_var_2 happy_var_4)}}} + ) (\r -> happyReturn (happyIn11 r)) + +happyReduce_31 = happyMonadReduce 3# 7# happyReduction_31 +happyReduction_31 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CDefault happy_var_3)}} + ) (\r -> happyReturn (happyIn11 r)) + +happyReduce_32 = happyMonadReduce 6# 7# happyReduction_32 +happyReduction_32 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_2 of { happy_var_2 -> + case happyOut116 happy_x_4 of { happy_var_4 -> + case happyOut10 happy_x_6 of { happy_var_6 -> + ( withAttrs happy_var_1 $ CCases happy_var_2 happy_var_4 happy_var_6)}}}} + ) (\r -> happyReturn (happyIn11 r)) + +happyReduce_33 = happyMonadReduce 5# 8# happyReduction_33 +happyReduction_33 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut15 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CCompound (reverse happy_var_3))}} + ) (\r -> happyReturn (happyIn12 r)) + +happyReduce_34 = happyMonadReduce 6# 8# happyReduction_34 +happyReduction_34 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut15 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CCompound (reverse happy_var_4))}} + ) (\r -> happyReturn (happyIn12 r)) + +happyReduce_35 = happyMonadReduce 0# 9# happyReduction_35 +happyReduction_35 (happyRest) tk + = happyThen (( enterScope) + ) (\r -> happyReturn (happyIn13 r)) + +happyReduce_36 = happyMonadReduce 0# 10# happyReduction_36 +happyReduction_36 (happyRest) tk + = happyThen (( leaveScope) + ) (\r -> happyReturn (happyIn14 r)) + +happyReduce_37 = happySpecReduce_0 11# happyReduction_37 +happyReduction_37 = happyIn15 + (empty + ) + +happyReduce_38 = happySpecReduce_2 11# happyReduction_38 +happyReduction_38 happy_x_2 + happy_x_1 + = case happyOut15 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn15 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_39 = happySpecReduce_1 12# happyReduction_39 +happyReduction_39 happy_x_1 + = case happyOut10 happy_x_1 of { happy_var_1 -> + happyIn16 + (CBlockStmt happy_var_1 + )} + +happyReduce_40 = happySpecReduce_1 12# happyReduction_40 +happyReduction_40 happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn16 + (happy_var_1 + )} + +happyReduce_41 = happySpecReduce_1 13# happyReduction_41 +happyReduction_41 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn17 + (CBlockDecl happy_var_1 + )} + +happyReduce_42 = happySpecReduce_2 13# happyReduction_42 +happyReduction_42 happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn17 + (CBlockDecl happy_var_2 + )} + +happyReduce_43 = happySpecReduce_1 13# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn17 + (CNestedFunDef happy_var_1 + )} + +happyReduce_44 = happySpecReduce_2 13# happyReduction_44 +happyReduction_44 happy_x_2 + happy_x_1 + = case happyOut18 happy_x_2 of { happy_var_2 -> + happyIn17 + (CNestedFunDef happy_var_2 + )} + +happyReduce_45 = happySpecReduce_2 13# happyReduction_45 +happyReduction_45 happy_x_2 + happy_x_1 + = case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn17 + (happy_var_2 + )} + +happyReduce_46 = happyMonadReduce 3# 14# happyReduction_46 +happyReduction_46 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn18 r)) + +happyReduce_47 = happyMonadReduce 3# 14# happyReduction_47 +happyReduction_47 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn18 r)) + +happyReduce_48 = happyMonadReduce 3# 14# happyReduction_48 +happyReduction_48 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn18 r)) + +happyReduce_49 = happyMonadReduce 3# 14# happyReduction_49 +happyReduction_49 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + ( leaveScope >> (withAttrs happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))}}} + ) (\r -> happyReturn (happyIn18 r)) + +happyReduce_50 = happySpecReduce_3 15# happyReduction_50 +happyReduction_50 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn19 + (() + ) + +happyReduce_51 = happyReduce 4# 15# happyReduction_51 +happyReduction_51 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn19 + (() + ) `HappyStk` happyRest + +happyReduce_52 = happyMonadReduce 1# 16# happyReduction_52 +happyReduction_52 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CExpr Nothing)} + ) (\r -> happyReturn (happyIn20 r)) + +happyReduce_53 = happyMonadReduce 2# 16# happyReduction_53 +happyReduction_53 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut112 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CExpr (Just happy_var_1))} + ) (\r -> happyReturn (happyIn20 r)) + +happyReduce_54 = happyMonadReduce 5# 17# happyReduction_54 +happyReduction_54 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CIf happy_var_3 happy_var_5 Nothing)}}} + ) (\r -> happyReturn (happyIn21 r)) + +happyReduce_55 = happyMonadReduce 7# 17# happyReduction_55 +happyReduction_55 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_5 of { happy_var_5 -> + case happyOut10 happy_x_7 of { happy_var_7 -> + ( withAttrs happy_var_1 $ CIf happy_var_3 happy_var_5 (Just happy_var_7))}}}} + ) (\r -> happyReturn (happyIn21 r)) + +happyReduce_56 = happyMonadReduce 5# 17# happyReduction_56 +happyReduction_56 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CSwitch happy_var_3 happy_var_5)}}} + ) (\r -> happyReturn (happyIn21 r)) + +happyReduce_57 = happyMonadReduce 5# 18# happyReduction_57 +happyReduction_57 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CWhile happy_var_3 happy_var_5 False)}}} + ) (\r -> happyReturn (happyIn22 r)) + +happyReduce_58 = happyMonadReduce 7# 18# happyReduction_58 +happyReduction_58 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + case happyOut112 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CWhile happy_var_5 happy_var_2 True)}}} + ) (\r -> happyReturn (happyIn22 r)) + +happyReduce_59 = happyMonadReduce 9# 18# happyReduction_59 +happyReduction_59 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut114 happy_x_3 of { happy_var_3 -> + case happyOut114 happy_x_5 of { happy_var_5 -> + case happyOut114 happy_x_7 of { happy_var_7 -> + case happyOut10 happy_x_9 of { happy_var_9 -> + ( withAttrs happy_var_1 $ CFor (Left happy_var_3) happy_var_5 happy_var_7 happy_var_9)}}}}} + ) (\r -> happyReturn (happyIn22 r)) + +happyReduce_60 = happyMonadReduce 10# 18# happyReduction_60 +happyReduction_60 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + case happyOut114 happy_x_5 of { happy_var_5 -> + case happyOut114 happy_x_7 of { happy_var_7 -> + case happyOut10 happy_x_9 of { happy_var_9 -> + ( withAttrs happy_var_1 $ CFor (Right happy_var_4) happy_var_5 happy_var_7 happy_var_9)}}}}} + ) (\r -> happyReturn (happyIn22 r)) + +happyReduce_61 = happyMonadReduce 3# 19# happyReduction_61 +happyReduction_61 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CGoto happy_var_2)}} + ) (\r -> happyReturn (happyIn23 r)) + +happyReduce_62 = happyMonadReduce 4# 19# happyReduction_62 +happyReduction_62 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CGotoPtr happy_var_3)}} + ) (\r -> happyReturn (happyIn23 r)) + +happyReduce_63 = happyMonadReduce 2# 19# happyReduction_63 +happyReduction_63 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CCont)} + ) (\r -> happyReturn (happyIn23 r)) + +happyReduce_64 = happyMonadReduce 2# 19# happyReduction_64 +happyReduction_64 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CBreak)} + ) (\r -> happyReturn (happyIn23 r)) + +happyReduce_65 = happyMonadReduce 3# 19# happyReduction_65 +happyReduction_65 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut114 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CReturn happy_var_2)}} + ) (\r -> happyReturn (happyIn23 r)) + +happyReduce_66 = happyMonadReduce 6# 20# happyReduction_66 +happyReduction_66 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CAsm)} + ) (\r -> happyReturn (happyIn24 r)) + +happyReduce_67 = happyMonadReduce 8# 20# happyReduction_67 +happyReduction_67 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CAsm)} + ) (\r -> happyReturn (happyIn24 r)) + +happyReduce_68 = happyMonadReduce 10# 20# happyReduction_68 +happyReduction_68 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CAsm)} + ) (\r -> happyReturn (happyIn24 r)) + +happyReduce_69 = happyMonadReduce 12# 20# happyReduction_69 +happyReduction_69 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CAsm)} + ) (\r -> happyReturn (happyIn24 r)) + +happyReduce_70 = happySpecReduce_0 21# happyReduction_70 +happyReduction_70 = happyIn25 + (() + ) + +happyReduce_71 = happySpecReduce_1 21# happyReduction_71 +happyReduction_71 happy_x_1 + = happyIn25 + (() + ) + +happyReduce_72 = happySpecReduce_0 22# happyReduction_72 +happyReduction_72 = happyIn26 + (() + ) + +happyReduce_73 = happySpecReduce_1 22# happyReduction_73 +happyReduction_73 happy_x_1 + = happyIn26 + (() + ) + +happyReduce_74 = happySpecReduce_1 23# happyReduction_74 +happyReduction_74 happy_x_1 + = happyIn27 + (() + ) + +happyReduce_75 = happySpecReduce_3 23# happyReduction_75 +happyReduction_75 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn27 + (() + ) + +happyReduce_76 = happyReduce 4# 24# happyReduction_76 +happyReduction_76 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn28 + (() + ) `HappyStk` happyRest + +happyReduce_77 = happyReduce 7# 24# happyReduction_77 +happyReduction_77 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn28 + (() + ) `HappyStk` happyRest + +happyReduce_78 = happyReduce 7# 24# happyReduction_78 +happyReduction_78 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn28 + (() + ) `HappyStk` happyRest + +happyReduce_79 = happySpecReduce_1 25# happyReduction_79 +happyReduction_79 happy_x_1 + = happyIn29 + (() + ) + +happyReduce_80 = happySpecReduce_3 25# happyReduction_80 +happyReduction_80 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn29 + (() + ) + +happyReduce_81 = happyMonadReduce 2# 26# happyReduction_81 +happyReduction_81 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl (reverse happy_var_1) [])} + ) (\r -> happyReturn (happyIn30 r)) + +happyReduce_82 = happyMonadReduce 2# 26# happyReduction_82 +happyReduction_82 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut42 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl (reverse happy_var_1) [])} + ) (\r -> happyReturn (happyIn30 r)) + +happyReduce_83 = happySpecReduce_2 26# happyReduction_83 +happyReduction_83 happy_x_2 + happy_x_1 + = case happyOut32 happy_x_1 of { happy_var_1 -> + happyIn30 + (case happy_var_1 of + CDecl declspecs dies attr -> + CDecl declspecs (List.reverse dies) attr + )} + +happyReduce_84 = happySpecReduce_2 26# happyReduction_84 +happyReduction_84 happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + happyIn30 + (case happy_var_1 of + CDecl declspecs dies attr -> + CDecl declspecs (List.reverse dies) attr + )} + +happyReduce_85 = happyMonadReduce 5# 27# happyReduction_85 +happyReduction_85 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + case happyOut86 happy_x_5 of { happy_var_5 -> + ( let declspecs = reverse happy_var_1 in + doDeclIdent declspecs happy_var_2 + >> (withAttrs happy_var_1 $ CDecl declspecs [(Just happy_var_2, happy_var_5, Nothing)]))}}} + ) (\r -> happyReturn (happyIn31 r)) + +happyReduce_86 = happyMonadReduce 5# 27# happyReduction_86 +happyReduction_86 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + case happyOut86 happy_x_5 of { happy_var_5 -> + ( let declspecs = liftTypeQuals happy_var_1 in + doDeclIdent declspecs happy_var_2 + >> (withAttrs happy_var_1 $ CDecl declspecs [(Just happy_var_2, happy_var_5, Nothing)]))}}} + ) (\r -> happyReturn (happyIn31 r)) + +happyReduce_87 = happyMonadReduce 6# 27# happyReduction_87 +happyReduction_87 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut31 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_3 of { happy_var_3 -> + case happyOut86 happy_x_6 of { happy_var_6 -> + ( case happy_var_1 of + CDecl declspecs dies attr -> do + doDeclIdent declspecs happy_var_3 + return (CDecl declspecs ((Just happy_var_3, happy_var_6, Nothing) : dies) attr))}}} + ) (\r -> happyReturn (happyIn31 r)) + +happyReduce_88 = happyMonadReduce 5# 28# happyReduction_88 +happyReduction_88 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut58 happy_x_2 of { happy_var_2 -> + case happyOut86 happy_x_5 of { happy_var_5 -> + ( doDeclIdent happy_var_1 happy_var_2 + >> (withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, happy_var_5, Nothing)]))}}} + ) (\r -> happyReturn (happyIn32 r)) + +happyReduce_89 = happyMonadReduce 5# 28# happyReduction_89 +happyReduction_89 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut58 happy_x_2 of { happy_var_2 -> + case happyOut86 happy_x_5 of { happy_var_5 -> + ( doDeclIdent happy_var_1 happy_var_2 + >> (withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, happy_var_5, Nothing)]))}}} + ) (\r -> happyReturn (happyIn32 r)) + +happyReduce_90 = happyMonadReduce 6# 28# happyReduction_90 +happyReduction_90 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut32 happy_x_1 of { happy_var_1 -> + case happyOut58 happy_x_3 of { happy_var_3 -> + case happyOut86 happy_x_6 of { happy_var_6 -> + ( case happy_var_1 of + CDecl declspecs dies attr -> do + doDeclIdent declspecs happy_var_3 + return (CDecl declspecs ((Just happy_var_3, happy_var_6, Nothing) : dies) attr))}}} + ) (\r -> happyReturn (happyIn32 r)) + +happyReduce_91 = happySpecReduce_1 29# happyReduction_91 +happyReduction_91 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn33 + (reverse happy_var_1 + )} + +happyReduce_92 = happySpecReduce_1 29# happyReduction_92 +happyReduction_92 happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + happyIn33 + (reverse happy_var_1 + )} + +happyReduce_93 = happySpecReduce_1 29# happyReduction_93 +happyReduction_93 happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + happyIn33 + (reverse happy_var_1 + )} + +happyReduce_94 = happySpecReduce_1 30# happyReduction_94 +happyReduction_94 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn34 + (singleton (CStorageSpec happy_var_1) + )} + +happyReduce_95 = happySpecReduce_2 30# happyReduction_95 +happyReduction_95 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn34 + (rmap CTypeQual happy_var_1 `snoc` CStorageSpec happy_var_2 + )}} + +happyReduce_96 = happySpecReduce_2 30# happyReduction_96 +happyReduction_96 happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut35 happy_x_2 of { happy_var_2 -> + happyIn34 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_97 = happySpecReduce_2 30# happyReduction_97 +happyReduction_97 happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + happyIn34 + (happy_var_1 + )} + +happyReduce_98 = happySpecReduce_1 31# happyReduction_98 +happyReduction_98 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn35 + (CStorageSpec happy_var_1 + )} + +happyReduce_99 = happySpecReduce_1 31# happyReduction_99 +happyReduction_99 happy_x_1 + = case happyOut57 happy_x_1 of { happy_var_1 -> + happyIn35 + (CTypeQual happy_var_1 + )} + +happyReduce_100 = happyMonadReduce 1# 32# happyReduction_100 +happyReduction_100 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CTypedef)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_101 = happyMonadReduce 1# 32# happyReduction_101 +happyReduction_101 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CExtern)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_102 = happyMonadReduce 1# 32# happyReduction_102 +happyReduction_102 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CStatic)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_103 = happyMonadReduce 1# 32# happyReduction_103 +happyReduction_103 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CAuto)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_104 = happyMonadReduce 1# 32# happyReduction_104 +happyReduction_104 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CRegister)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_105 = happyMonadReduce 1# 32# happyReduction_105 +happyReduction_105 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CThread)} + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_106 = happySpecReduce_1 33# happyReduction_106 +happyReduction_106 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn37 + (reverse happy_var_1 + )} + +happyReduce_107 = happySpecReduce_1 33# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn37 + (reverse happy_var_1 + )} + +happyReduce_108 = happySpecReduce_1 33# happyReduction_108 +happyReduction_108 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn37 + (reverse happy_var_1 + )} + +happyReduce_109 = happyMonadReduce 1# 34# happyReduction_109 +happyReduction_109 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CVoidType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_110 = happyMonadReduce 1# 34# happyReduction_110 +happyReduction_110 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CCharType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_111 = happyMonadReduce 1# 34# happyReduction_111 +happyReduction_111 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CShortType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_112 = happyMonadReduce 1# 34# happyReduction_112 +happyReduction_112 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CIntType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_113 = happyMonadReduce 1# 34# happyReduction_113 +happyReduction_113 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CLongType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_114 = happyMonadReduce 1# 34# happyReduction_114 +happyReduction_114 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CFloatType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_115 = happyMonadReduce 1# 34# happyReduction_115 +happyReduction_115 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDoubleType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_116 = happyMonadReduce 1# 34# happyReduction_116 +happyReduction_116 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CSignedType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_117 = happyMonadReduce 1# 34# happyReduction_117 +happyReduction_117 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CUnsigType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_118 = happyMonadReduce 1# 34# happyReduction_118 +happyReduction_118 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CBoolType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_119 = happyMonadReduce 1# 34# happyReduction_119 +happyReduction_119 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CComplexType)} + ) (\r -> happyReturn (happyIn38 r)) + +happyReduce_120 = happySpecReduce_2 35# happyReduction_120 +happyReduction_120 happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut38 happy_x_2 of { happy_var_2 -> + happyIn39 + (happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_121 = happySpecReduce_2 35# happyReduction_121 +happyReduction_121 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn39 + (happy_var_1 `snoc` CStorageSpec happy_var_2 + )}} + +happyReduce_122 = happySpecReduce_2 35# happyReduction_122 +happyReduction_122 happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut35 happy_x_2 of { happy_var_2 -> + happyIn39 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_123 = happySpecReduce_2 35# happyReduction_123 +happyReduction_123 happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut38 happy_x_2 of { happy_var_2 -> + happyIn39 + (happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_124 = happySpecReduce_2 35# happyReduction_124 +happyReduction_124 happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn39 + (happy_var_1 + )} + +happyReduce_125 = happySpecReduce_1 36# happyReduction_125 +happyReduction_125 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn40 + (singleton (CTypeSpec happy_var_1) + )} + +happyReduce_126 = happySpecReduce_2 36# happyReduction_126 +happyReduction_126 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut38 happy_x_2 of { happy_var_2 -> + happyIn40 + (rmap CTypeQual happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_127 = happySpecReduce_2 36# happyReduction_127 +happyReduction_127 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut57 happy_x_2 of { happy_var_2 -> + happyIn40 + (happy_var_1 `snoc` CTypeQual happy_var_2 + )}} + +happyReduce_128 = happySpecReduce_2 36# happyReduction_128 +happyReduction_128 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut38 happy_x_2 of { happy_var_2 -> + happyIn40 + (happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_129 = happySpecReduce_2 36# happyReduction_129 +happyReduction_129 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn40 + (happy_var_1 + )} + +happyReduce_130 = happySpecReduce_2 37# happyReduction_130 +happyReduction_130 happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut45 happy_x_2 of { happy_var_2 -> + happyIn41 + (happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_131 = happySpecReduce_2 37# happyReduction_131 +happyReduction_131 happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn41 + (happy_var_1 `snoc` CStorageSpec happy_var_2 + )}} + +happyReduce_132 = happySpecReduce_2 37# happyReduction_132 +happyReduction_132 happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut35 happy_x_2 of { happy_var_2 -> + happyIn41 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_133 = happySpecReduce_2 37# happyReduction_133 +happyReduction_133 happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + happyIn41 + (happy_var_1 + )} + +happyReduce_134 = happySpecReduce_1 38# happyReduction_134 +happyReduction_134 happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + happyIn42 + (singleton (CTypeSpec happy_var_1) + )} + +happyReduce_135 = happySpecReduce_2 38# happyReduction_135 +happyReduction_135 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut45 happy_x_2 of { happy_var_2 -> + happyIn42 + (rmap CTypeQual happy_var_1 `snoc` CTypeSpec happy_var_2 + )}} + +happyReduce_136 = happySpecReduce_2 38# happyReduction_136 +happyReduction_136 happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut57 happy_x_2 of { happy_var_2 -> + happyIn42 + (happy_var_1 `snoc` CTypeQual happy_var_2 + )}} + +happyReduce_137 = happySpecReduce_2 38# happyReduction_137 +happyReduction_137 happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn42 + (happy_var_1 + )} + +happyReduce_138 = happySpecReduce_2 39# happyReduction_138 +happyReduction_138 happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn43 + (happy_var_1 `snoc` CStorageSpec happy_var_2 + )}} + +happyReduce_139 = happyMonadReduce 2# 39# happyReduction_139 +happyReduction_139 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> + ( withAttrs happy_var_1 $ \attr -> happy_var_1 `snoc` CTypeSpec (CTypeDef happy_var_2 attr))}} + ) (\r -> happyReturn (happyIn43 r)) + +happyReduce_140 = happyMonadReduce 5# 39# happyReduction_140 +happyReduction_140 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ \attr -> happy_var_1 `snoc` CTypeSpec (CTypeOfExpr happy_var_4 attr))}} + ) (\r -> happyReturn (happyIn43 r)) + +happyReduce_141 = happyMonadReduce 5# 39# happyReduction_141 +happyReduction_141 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut78 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ \attr -> happy_var_1 `snoc` CTypeSpec (CTypeOfType happy_var_4 attr))}} + ) (\r -> happyReturn (happyIn43 r)) + +happyReduce_142 = happySpecReduce_2 39# happyReduction_142 +happyReduction_142 happy_x_2 + happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + case happyOut35 happy_x_2 of { happy_var_2 -> + happyIn43 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_143 = happySpecReduce_2 39# happyReduction_143 +happyReduction_143 happy_x_2 + happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + happyIn43 + (happy_var_1 + )} + +happyReduce_144 = happyMonadReduce 1# 40# happyReduction_144 +happyReduction_144 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> + ( withAttrs happy_var_1 $ \attr -> singleton (CTypeSpec (CTypeDef happy_var_1 attr)))} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_145 = happyMonadReduce 4# 40# happyReduction_145 +happyReduction_145 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ \attr -> singleton (CTypeSpec (CTypeOfExpr happy_var_3 attr)))}} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_146 = happyMonadReduce 4# 40# happyReduction_146 +happyReduction_146 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut78 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ \attr -> singleton (CTypeSpec (CTypeOfType happy_var_3 attr)))}} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_147 = happyMonadReduce 2# 40# happyReduction_147 +happyReduction_147 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> + ( withAttrs happy_var_2 $ \attr -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeDef happy_var_2 attr))}} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_148 = happyMonadReduce 5# 40# happyReduction_148 +happyReduction_148 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut112 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_2 $ \attr -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeOfExpr happy_var_4 attr))}}} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_149 = happyMonadReduce 5# 40# happyReduction_149 +happyReduction_149 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut78 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_2 $ \attr -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeOfType happy_var_4 attr))}}} + ) (\r -> happyReturn (happyIn44 r)) + +happyReduce_150 = happySpecReduce_2 40# happyReduction_150 +happyReduction_150 happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut57 happy_x_2 of { happy_var_2 -> + happyIn44 + (happy_var_1 `snoc` CTypeQual happy_var_2 + )}} + +happyReduce_151 = happySpecReduce_2 40# happyReduction_151 +happyReduction_151 happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn44 + (happy_var_1 + )} + +happyReduce_152 = happyMonadReduce 1# 41# happyReduction_152 +happyReduction_152 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut46 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CSUType happy_var_1)} + ) (\r -> happyReturn (happyIn45 r)) + +happyReduce_153 = happyMonadReduce 1# 41# happyReduction_153 +happyReduction_153 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut54 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CEnumType happy_var_1)} + ) (\r -> happyReturn (happyIn45 r)) + +happyReduce_154 = happyMonadReduce 6# 42# happyReduction_154 +happyReduction_154 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut47 happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + case happyOut48 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CStruct (unL happy_var_1) (Just happy_var_3) (reverse happy_var_5))}}} + ) (\r -> happyReturn (happyIn46 r)) + +happyReduce_155 = happyMonadReduce 5# 42# happyReduction_155 +happyReduction_155 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut47 happy_x_1 of { happy_var_1 -> + case happyOut48 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CStruct (unL happy_var_1) Nothing (reverse happy_var_4))}} + ) (\r -> happyReturn (happyIn46 r)) + +happyReduce_156 = happyMonadReduce 3# 42# happyReduction_156 +happyReduction_156 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut47 happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CStruct (unL happy_var_1) (Just happy_var_3) [])}} + ) (\r -> happyReturn (happyIn46 r)) + +happyReduce_157 = happySpecReduce_1 43# happyReduction_157 +happyReduction_157 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn47 + (L CStructTag (posOf happy_var_1) + )} + +happyReduce_158 = happySpecReduce_1 43# happyReduction_158 +happyReduction_158 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn47 + (L CUnionTag (posOf happy_var_1) + )} + +happyReduce_159 = happySpecReduce_0 44# happyReduction_159 +happyReduction_159 = happyIn48 + (empty + ) + +happyReduce_160 = happySpecReduce_2 44# happyReduction_160 +happyReduction_160 happy_x_2 + happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + happyIn48 + (happy_var_1 + )} + +happyReduce_161 = happySpecReduce_2 44# happyReduction_161 +happyReduction_161 happy_x_2 + happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + case happyOut49 happy_x_2 of { happy_var_2 -> + happyIn48 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_162 = happySpecReduce_2 45# happyReduction_162 +happyReduction_162 happy_x_2 + happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + happyIn49 + (case happy_var_1 of CDecl declspecs dies attr -> CDecl declspecs (List.reverse dies) attr + )} + +happyReduce_163 = happySpecReduce_2 45# happyReduction_163 +happyReduction_163 happy_x_2 + happy_x_1 + = case happyOut50 happy_x_1 of { happy_var_1 -> + happyIn49 + (case happy_var_1 of CDecl declspecs dies attr -> CDecl declspecs (List.reverse dies) attr + )} + +happyReduce_164 = happySpecReduce_2 45# happyReduction_164 +happyReduction_164 happy_x_2 + happy_x_1 + = case happyOut49 happy_x_2 of { happy_var_2 -> + happyIn49 + (happy_var_2 + )} + +happyReduce_165 = happyMonadReduce 4# 46# happyReduction_165 +happyReduction_165 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut53 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ case happy_var_3 of (d,s) -> CDecl (liftTypeQuals happy_var_2) [(d,Nothing,s)])}} + ) (\r -> happyReturn (happyIn50 r)) + +happyReduce_166 = happyReduce 5# 46# happyReduction_166 +happyReduction_166 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut50 happy_x_1 of { happy_var_1 -> + case happyOut53 happy_x_4 of { happy_var_4 -> + happyIn50 + (case happy_var_1 of + CDecl declspecs dies attr -> + case happy_var_4 of + (d,s) -> CDecl declspecs ((d,Nothing,s) : dies) attr + ) `HappyStk` happyRest}} + +happyReduce_167 = happyMonadReduce 4# 47# happyReduction_167 +happyReduction_167 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut52 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ case happy_var_3 of (d,s) -> CDecl happy_var_2 [(d,Nothing,s)])}} + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_168 = happyReduce 5# 47# happyReduction_168 +happyReduction_168 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut51 happy_x_1 of { happy_var_1 -> + case happyOut52 happy_x_4 of { happy_var_4 -> + happyIn51 + (case happy_var_1 of + CDecl declspecs dies attr -> + case happy_var_4 of + (d,s) -> CDecl declspecs ((d,Nothing,s) : dies) attr + ) `HappyStk` happyRest}} + +happyReduce_169 = happyMonadReduce 2# 47# happyReduction_169 +happyReduction_169 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CDecl happy_var_2 [])} + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_170 = happySpecReduce_1 48# happyReduction_170 +happyReduction_170 happy_x_1 + = case happyOut58 happy_x_1 of { happy_var_1 -> + happyIn52 + ((Just happy_var_1, Nothing) + )} + +happyReduce_171 = happySpecReduce_2 48# happyReduction_171 +happyReduction_171 happy_x_2 + happy_x_1 + = case happyOut116 happy_x_2 of { happy_var_2 -> + happyIn52 + ((Nothing, Just happy_var_2) + )} + +happyReduce_172 = happySpecReduce_3 48# happyReduction_172 +happyReduction_172 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut58 happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_3 of { happy_var_3 -> + happyIn52 + ((Just happy_var_1, Just happy_var_3) + )}} + +happyReduce_173 = happySpecReduce_1 49# happyReduction_173 +happyReduction_173 happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + happyIn53 + ((Just happy_var_1, Nothing) + )} + +happyReduce_174 = happySpecReduce_2 49# happyReduction_174 +happyReduction_174 happy_x_2 + happy_x_1 + = case happyOut116 happy_x_2 of { happy_var_2 -> + happyIn53 + ((Nothing, Just happy_var_2) + )} + +happyReduce_175 = happySpecReduce_3 49# happyReduction_175 +happyReduction_175 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_3 of { happy_var_3 -> + happyIn53 + ((Just happy_var_1, Just happy_var_3) + )}} + +happyReduce_176 = happyMonadReduce 5# 50# happyReduction_176 +happyReduction_176 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut55 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CEnum Nothing (reverse happy_var_4))}} + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_177 = happyMonadReduce 6# 50# happyReduction_177 +happyReduction_177 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut55 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CEnum Nothing (reverse happy_var_4))}} + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_178 = happyMonadReduce 6# 50# happyReduction_178 +happyReduction_178 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + case happyOut55 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CEnum (Just happy_var_3) (reverse happy_var_5))}}} + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_179 = happyMonadReduce 7# 50# happyReduction_179 +happyReduction_179 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + case happyOut55 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CEnum (Just happy_var_3) (reverse happy_var_5))}}} + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_180 = happyMonadReduce 3# 50# happyReduction_180 +happyReduction_180 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CEnum (Just happy_var_3) [])}} + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_181 = happySpecReduce_1 51# happyReduction_181 +happyReduction_181 happy_x_1 + = case happyOut56 happy_x_1 of { happy_var_1 -> + happyIn55 + (singleton happy_var_1 + )} + +happyReduce_182 = happySpecReduce_3 51# happyReduction_182 +happyReduction_182 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { happy_var_1 -> + case happyOut56 happy_x_3 of { happy_var_3 -> + happyIn55 + (happy_var_1 `snoc` happy_var_3 + )}} + +happyReduce_183 = happySpecReduce_1 52# happyReduction_183 +happyReduction_183 happy_x_1 + = case happyOut120 happy_x_1 of { happy_var_1 -> + happyIn56 + ((happy_var_1, Nothing) + )} + +happyReduce_184 = happySpecReduce_3 52# happyReduction_184 +happyReduction_184 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut120 happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_3 of { happy_var_3 -> + happyIn56 + ((happy_var_1, Just happy_var_3) + )}} + +happyReduce_185 = happyMonadReduce 1# 53# happyReduction_185 +happyReduction_185 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CConstQual)} + ) (\r -> happyReturn (happyIn57 r)) + +happyReduce_186 = happyMonadReduce 1# 53# happyReduction_186 +happyReduction_186 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CVolatQual)} + ) (\r -> happyReturn (happyIn57 r)) + +happyReduce_187 = happyMonadReduce 1# 53# happyReduction_187 +happyReduction_187 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CRestrQual)} + ) (\r -> happyReturn (happyIn57 r)) + +happyReduce_188 = happyMonadReduce 1# 53# happyReduction_188 +happyReduction_188 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CInlinQual)} + ) (\r -> happyReturn (happyIn57 r)) + +happyReduce_189 = happySpecReduce_1 54# happyReduction_189 +happyReduction_189 happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + happyIn58 + (happy_var_1 + )} + +happyReduce_190 = happySpecReduce_1 54# happyReduction_190 +happyReduction_190 happy_x_1 + = case happyOut60 happy_x_1 of { happy_var_1 -> + happyIn58 + (happy_var_1 + )} + +happyReduce_191 = happySpecReduce_0 55# happyReduction_191 +happyReduction_191 = happyIn59 + (() + ) + +happyReduce_192 = happyReduce 4# 55# happyReduction_192 +happyReduction_192 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn59 + (() + ) `HappyStk` happyRest + +happyReduce_193 = happySpecReduce_1 56# happyReduction_193 +happyReduction_193 happy_x_1 + = case happyOut64 happy_x_1 of { happy_var_1 -> + happyIn60 + (happy_var_1 + )} + +happyReduce_194 = happySpecReduce_1 56# happyReduction_194 +happyReduction_194 happy_x_1 + = case happyOut61 happy_x_1 of { happy_var_1 -> + happyIn60 + (happy_var_1 + )} + +happyReduce_195 = happyMonadReduce 1# 57# happyReduction_195 +happyReduction_195 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> + ( withAttrs happy_var_1 $ CVarDeclr (Just happy_var_1))} + ) (\r -> happyReturn (happyIn61 r)) + +happyReduce_196 = happyMonadReduce 2# 57# happyReduction_196 +happyReduction_196 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> + case happyOut80 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ \attrs -> happy_var_2 (CVarDeclr (Just happy_var_1) attrs))}} + ) (\r -> happyReturn (happyIn61 r)) + +happyReduce_197 = happySpecReduce_1 57# happyReduction_197 +happyReduction_197 happy_x_1 + = case happyOut62 happy_x_1 of { happy_var_1 -> + happyIn61 + (happy_var_1 + )} + +happyReduce_198 = happySpecReduce_1 58# happyReduction_198 +happyReduction_198 happy_x_1 + = case happyOut63 happy_x_1 of { happy_var_1 -> + happyIn62 + (happy_var_1 + )} + +happyReduce_199 = happyMonadReduce 2# 58# happyReduction_199 +happyReduction_199 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut61 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_2)}} + ) (\r -> happyReturn (happyIn62 r)) + +happyReduce_200 = happyMonadReduce 3# 58# happyReduction_200 +happyReduction_200 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut61 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn62 r)) + +happyReduce_201 = happyMonadReduce 3# 58# happyReduction_201 +happyReduction_201 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut61 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_3)}} + ) (\r -> happyReturn (happyIn62 r)) + +happyReduce_202 = happyMonadReduce 4# 58# happyReduction_202 +happyReduction_202 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut61 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) happy_var_4)}}} + ) (\r -> happyReturn (happyIn62 r)) + +happyReduce_203 = happySpecReduce_3 59# happyReduction_203 +happyReduction_203 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut62 happy_x_2 of { happy_var_2 -> + happyIn63 + (happy_var_2 + )} + +happyReduce_204 = happyReduce 4# 59# happyReduction_204 +happyReduction_204 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut62 happy_x_3 of { happy_var_3 -> + happyIn63 + (happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_205 = happyReduce 4# 59# happyReduction_205 +happyReduction_205 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut62 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_4 of { happy_var_4 -> + happyIn63 + (happy_var_4 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_206 = happyReduce 5# 59# happyReduction_206 +happyReduction_206 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut62 happy_x_3 of { happy_var_3 -> + case happyOut80 happy_x_5 of { happy_var_5 -> + happyIn63 + (happy_var_5 happy_var_3 + ) `HappyStk` happyRest}} + +happyReduce_207 = happySpecReduce_1 60# happyReduction_207 +happyReduction_207 happy_x_1 + = case happyOut65 happy_x_1 of { happy_var_1 -> + happyIn64 + (happy_var_1 + )} + +happyReduce_208 = happyMonadReduce 4# 60# happyReduction_208 +happyReduction_208 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut66 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_3)}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_209 = happyMonadReduce 5# 60# happyReduction_209 +happyReduction_209 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut66 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_4)}}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_210 = happyMonadReduce 2# 60# happyReduction_210 +happyReduction_210 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut64 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_2)}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_211 = happyMonadReduce 3# 60# happyReduction_211 +happyReduction_211 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut64 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_212 = happyMonadReduce 5# 60# happyReduction_212 +happyReduction_212 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut66 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_4)}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_213 = happyMonadReduce 6# 60# happyReduction_213 +happyReduction_213 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut66 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) happy_var_5)}}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_214 = happyMonadReduce 3# 60# happyReduction_214 +happyReduction_214 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut64 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_3)}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_215 = happyMonadReduce 4# 60# happyReduction_215 +happyReduction_215 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut64 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) happy_var_4)}}} + ) (\r -> happyReturn (happyIn64 r)) + +happyReduce_216 = happySpecReduce_3 61# happyReduction_216 +happyReduction_216 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut64 happy_x_2 of { happy_var_2 -> + happyIn65 + (happy_var_2 + )} + +happyReduce_217 = happyReduce 4# 61# happyReduction_217 +happyReduction_217 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut66 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_3 of { happy_var_3 -> + happyIn65 + (happy_var_3 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_218 = happyReduce 4# 61# happyReduction_218 +happyReduction_218 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut64 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_4 of { happy_var_4 -> + happyIn65 + (happy_var_4 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_219 = happyMonadReduce 1# 62# happyReduction_219 +happyReduction_219 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> + ( withAttrs happy_var_1 $ CVarDeclr (Just happy_var_1))} + ) (\r -> happyReturn (happyIn66 r)) + +happyReduce_220 = happySpecReduce_3 62# happyReduction_220 +happyReduction_220 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut66 happy_x_2 of { happy_var_2 -> + happyIn66 + (happy_var_2 + )} + +happyReduce_221 = happySpecReduce_1 63# happyReduction_221 +happyReduction_221 happy_x_1 + = case happyOut68 happy_x_1 of { happy_var_1 -> + happyIn67 + (happy_var_1 + )} + +happyReduce_222 = happySpecReduce_1 63# happyReduction_222 +happyReduction_222 happy_x_1 + = case happyOut70 happy_x_1 of { happy_var_1 -> + happyIn67 + (happy_var_1 + )} + +happyReduce_223 = happySpecReduce_1 64# happyReduction_223 +happyReduction_223 happy_x_1 + = case happyOut69 happy_x_1 of { happy_var_1 -> + happyIn68 + (happy_var_1 + )} + +happyReduce_224 = happyMonadReduce 2# 64# happyReduction_224 +happyReduction_224 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_2)}} + ) (\r -> happyReturn (happyIn68 r)) + +happyReduce_225 = happyMonadReduce 3# 64# happyReduction_225 +happyReduction_225 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut67 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn68 r)) + +happyReduce_226 = happyMonadReduce 3# 64# happyReduction_226 +happyReduction_226 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_3)}} + ) (\r -> happyReturn (happyIn68 r)) + +happyReduce_227 = happyMonadReduce 4# 64# happyReduction_227 +happyReduction_227 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut67 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) happy_var_4)}}} + ) (\r -> happyReturn (happyIn68 r)) + +happyReduce_228 = happySpecReduce_2 65# happyReduction_228 +happyReduction_228 happy_x_2 + happy_x_1 + = case happyOut70 happy_x_1 of { happy_var_1 -> + case happyOut80 happy_x_2 of { happy_var_2 -> + happyIn69 + (happy_var_2 happy_var_1 + )}} + +happyReduce_229 = happySpecReduce_3 65# happyReduction_229 +happyReduction_229 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut68 happy_x_2 of { happy_var_2 -> + happyIn69 + (happy_var_2 + )} + +happyReduce_230 = happyReduce 4# 65# happyReduction_230 +happyReduction_230 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut68 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_4 of { happy_var_4 -> + happyIn69 + (happy_var_4 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_231 = happyReduce 4# 65# happyReduction_231 +happyReduction_231 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut68 happy_x_3 of { happy_var_3 -> + happyIn69 + (happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_232 = happyReduce 5# 65# happyReduction_232 +happyReduction_232 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut68 happy_x_3 of { happy_var_3 -> + case happyOut80 happy_x_5 of { happy_var_5 -> + happyIn69 + (happy_var_5 happy_var_3 + ) `HappyStk` happyRest}} + +happyReduce_233 = happyMonadReduce 1# 66# happyReduction_233 +happyReduction_233 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> + ( withAttrs happy_var_1 $ CVarDeclr (Just happy_var_1))} + ) (\r -> happyReturn (happyIn70 r)) + +happyReduce_234 = happySpecReduce_3 66# happyReduction_234 +happyReduction_234 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut70 happy_x_2 of { happy_var_2 -> + happyIn70 + (happy_var_2 + )} + +happyReduce_235 = happySpecReduce_1 67# happyReduction_235 +happyReduction_235 happy_x_1 + = case happyOut72 happy_x_1 of { happy_var_1 -> + happyIn71 + (happy_var_1 + )} + +happyReduce_236 = happyMonadReduce 2# 67# happyReduction_236 +happyReduction_236 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_2)}} + ) (\r -> happyReturn (happyIn71 r)) + +happyReduce_237 = happyMonadReduce 3# 67# happyReduction_237 +happyReduction_237 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut71 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn71 r)) + +happyReduce_238 = happyMonadReduce 4# 68# happyReduction_238 +happyReduction_238 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut70 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CFunDeclr happy_var_1 [] False)}} + ) (\r -> happyReturn (happyIn72 r)) + +happyReduce_239 = happySpecReduce_3 68# happyReduction_239 +happyReduction_239 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut71 happy_x_2 of { happy_var_2 -> + happyIn72 + (happy_var_2 + )} + +happyReduce_240 = happyReduce 4# 68# happyReduction_240 +happyReduction_240 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut71 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_4 of { happy_var_4 -> + happyIn72 + (happy_var_4 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_241 = happySpecReduce_1 69# happyReduction_241 +happyReduction_241 happy_x_1 + = case happyOut57 happy_x_1 of { happy_var_1 -> + happyIn73 + (singleton happy_var_1 + )} + +happyReduce_242 = happySpecReduce_2 69# happyReduction_242 +happyReduction_242 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut57 happy_x_2 of { happy_var_2 -> + happyIn73 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_243 = happySpecReduce_2 69# happyReduction_243 +happyReduction_243 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + happyIn73 + (happy_var_1 + )} + +happyReduce_244 = happySpecReduce_0 70# happyReduction_244 +happyReduction_244 = happyIn74 + (([], False) + ) + +happyReduce_245 = happySpecReduce_1 70# happyReduction_245 +happyReduction_245 happy_x_1 + = case happyOut75 happy_x_1 of { happy_var_1 -> + happyIn74 + ((reverse happy_var_1, False) + )} + +happyReduce_246 = happySpecReduce_3 70# happyReduction_246 +happyReduction_246 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut75 happy_x_1 of { happy_var_1 -> + happyIn74 + ((reverse happy_var_1, True) + )} + +happyReduce_247 = happySpecReduce_1 71# happyReduction_247 +happyReduction_247 happy_x_1 + = case happyOut76 happy_x_1 of { happy_var_1 -> + happyIn75 + (singleton happy_var_1 + )} + +happyReduce_248 = happySpecReduce_2 71# happyReduction_248 +happyReduction_248 happy_x_2 + happy_x_1 + = case happyOut76 happy_x_2 of { happy_var_2 -> + happyIn75 + (singleton happy_var_2 + )} + +happyReduce_249 = happyReduce 4# 71# happyReduction_249 +happyReduction_249 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut75 happy_x_1 of { happy_var_1 -> + case happyOut76 happy_x_4 of { happy_var_4 -> + happyIn75 + (happy_var_1 `snoc` happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_250 = happyMonadReduce 1# 72# happyReduction_250 +happyReduction_250 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [])} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_251 = happyMonadReduce 2# 72# happyReduction_251 +happyReduction_251 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_252 = happyMonadReduce 3# 72# happyReduction_252 +happyReduction_252 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_253 = happyMonadReduce 3# 72# happyReduction_253 +happyReduction_253 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut61 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_254 = happyMonadReduce 1# 72# happyReduction_254 +happyReduction_254 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl (reverse happy_var_1) [])} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_255 = happyMonadReduce 2# 72# happyReduction_255 +happyReduction_255 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl (reverse happy_var_1) [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_256 = happyMonadReduce 3# 72# happyReduction_256 +happyReduction_256 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl (reverse happy_var_1) [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_257 = happyMonadReduce 1# 72# happyReduction_257 +happyReduction_257 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [])} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_258 = happyMonadReduce 2# 72# happyReduction_258 +happyReduction_258 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_259 = happyMonadReduce 3# 72# happyReduction_259 +happyReduction_259 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_260 = happyMonadReduce 3# 72# happyReduction_260 +happyReduction_260 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut61 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl happy_var_1 [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_261 = happyMonadReduce 1# 72# happyReduction_261 +happyReduction_261 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [])} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_262 = happyMonadReduce 2# 72# happyReduction_262 +happyReduction_262 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_263 = happyMonadReduce 3# 72# happyReduction_263 +happyReduction_263 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut67 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [(Just happy_var_2, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_264 = happySpecReduce_1 73# happyReduction_264 +happyReduction_264 happy_x_1 + = case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> + happyIn77 + (singleton happy_var_1 + )} + +happyReduce_265 = happySpecReduce_3 73# happyReduction_265 +happyReduction_265 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut77 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_3 of { (CTokIdent _ happy_var_3) -> + happyIn77 + (happy_var_1 `snoc` happy_var_3 + )}} + +happyReduce_266 = happyMonadReduce 2# 74# happyReduction_266 +happyReduction_266 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CDecl happy_var_2 [])} + ) (\r -> happyReturn (happyIn78 r)) + +happyReduce_267 = happyMonadReduce 3# 74# happyReduction_267 +happyReduction_267 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut79 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CDecl happy_var_2 [(Just happy_var_3, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn78 r)) + +happyReduce_268 = happyMonadReduce 2# 74# happyReduction_268 +happyReduction_268 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CDecl (liftTypeQuals happy_var_2) [])} + ) (\r -> happyReturn (happyIn78 r)) + +happyReduce_269 = happyMonadReduce 3# 74# happyReduction_269 +happyReduction_269 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut79 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CDecl (liftTypeQuals happy_var_2) [(Just happy_var_3, Nothing, Nothing)])}} + ) (\r -> happyReturn (happyIn78 r)) + +happyReduce_270 = happySpecReduce_1 75# happyReduction_270 +happyReduction_270 happy_x_1 + = case happyOut83 happy_x_1 of { happy_var_1 -> + happyIn79 + (happy_var_1 + )} + +happyReduce_271 = happySpecReduce_1 75# happyReduction_271 +happyReduction_271 happy_x_1 + = case happyOut84 happy_x_1 of { happy_var_1 -> + happyIn79 + (happy_var_1 + )} + +happyReduce_272 = happySpecReduce_2 75# happyReduction_272 +happyReduction_272 happy_x_2 + happy_x_1 + = case happyOut80 happy_x_1 of { happy_var_1 -> + happyIn79 + (happy_var_1 emptyDeclr + )} + +happyReduce_273 = happySpecReduce_1 76# happyReduction_273 +happyReduction_273 happy_x_1 + = case happyOut81 happy_x_1 of { happy_var_1 -> + happyIn80 + (happy_var_1 + )} + +happyReduce_274 = happyMonadReduce 3# 76# happyReduction_274 +happyReduction_274 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut74 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ \attrs declr -> case happy_var_2 of + (params, variadic) -> CFunDeclr declr params variadic attrs)}} + ) (\r -> happyReturn (happyIn80 r)) + +happyReduce_275 = happySpecReduce_1 77# happyReduction_275 +happyReduction_275 happy_x_1 + = case happyOut82 happy_x_1 of { happy_var_1 -> + happyIn81 + (happy_var_1 + )} + +happyReduce_276 = happySpecReduce_2 77# happyReduction_276 +happyReduction_276 happy_x_2 + happy_x_1 + = case happyOut81 happy_x_1 of { happy_var_1 -> + case happyOut82 happy_x_2 of { happy_var_2 -> + happyIn81 + (\decl -> happy_var_2 (happy_var_1 decl) + )}} + +happyReduce_277 = happyMonadReduce 3# 78# happyReduction_277 +happyReduction_277 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut115 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr [] happy_var_2 attrs)}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_278 = happyMonadReduce 4# 78# happyReduction_278 +happyReduction_278 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut115 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr (reverse happy_var_2) happy_var_3 attrs)}}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_279 = happyMonadReduce 4# 78# happyReduction_279 +happyReduction_279 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut110 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr [] (Just happy_var_3) attrs)}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_280 = happyMonadReduce 5# 78# happyReduction_280 +happyReduction_280 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut110 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr (reverse happy_var_3) (Just happy_var_4) attrs)}}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_281 = happyMonadReduce 5# 78# happyReduction_281 +happyReduction_281 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut110 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr (reverse happy_var_2) (Just happy_var_4) attrs)}}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_282 = happyMonadReduce 3# 78# happyReduction_282 +happyReduction_282 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr [] Nothing attrs)} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_283 = happyMonadReduce 4# 78# happyReduction_283 +happyReduction_283 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ \attrs declr -> CArrDeclr declr (reverse happy_var_2) Nothing attrs)}} + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_284 = happyMonadReduce 1# 79# happyReduction_284 +happyReduction_284 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] emptyDeclr)} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_285 = happyMonadReduce 2# 79# happyReduction_285 +happyReduction_285 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) emptyDeclr)}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_286 = happyMonadReduce 2# 79# happyReduction_286 +happyReduction_286 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_2)}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_287 = happyMonadReduce 3# 79# happyReduction_287 +happyReduction_287 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_2 of { happy_var_2 -> + case happyOut79 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_2) happy_var_3)}}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_288 = happyMonadReduce 2# 79# happyReduction_288 +happyReduction_288 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] emptyDeclr)} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_289 = happyMonadReduce 3# 79# happyReduction_289 +happyReduction_289 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) emptyDeclr)}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_290 = happyMonadReduce 3# 79# happyReduction_290 +happyReduction_290 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut79 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CPtrDeclr [] happy_var_3)}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_291 = happyMonadReduce 4# 79# happyReduction_291 +happyReduction_291 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + case happyOut79 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CPtrDeclr (reverse happy_var_3) happy_var_4)}}} + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_292 = happySpecReduce_3 80# happyReduction_292 +happyReduction_292 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut83 happy_x_2 of { happy_var_2 -> + happyIn84 + (happy_var_2 + )} + +happyReduce_293 = happySpecReduce_3 80# happyReduction_293 +happyReduction_293 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut84 happy_x_2 of { happy_var_2 -> + happyIn84 + (happy_var_2 + )} + +happyReduce_294 = happySpecReduce_3 80# happyReduction_294 +happyReduction_294 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut80 happy_x_2 of { happy_var_2 -> + happyIn84 + (happy_var_2 emptyDeclr + )} + +happyReduce_295 = happyReduce 4# 80# happyReduction_295 +happyReduction_295 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut83 happy_x_2 of { happy_var_2 -> + case happyOut80 happy_x_4 of { happy_var_4 -> + happyIn84 + (happy_var_4 happy_var_2 + ) `HappyStk` happyRest}} + +happyReduce_296 = happyReduce 4# 80# happyReduction_296 +happyReduction_296 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut83 happy_x_3 of { happy_var_3 -> + happyIn84 + (happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_297 = happyReduce 4# 80# happyReduction_297 +happyReduction_297 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut84 happy_x_3 of { happy_var_3 -> + happyIn84 + (happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_298 = happyReduce 4# 80# happyReduction_298 +happyReduction_298 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut80 happy_x_3 of { happy_var_3 -> + happyIn84 + (happy_var_3 emptyDeclr + ) `HappyStk` happyRest} + +happyReduce_299 = happyReduce 5# 80# happyReduction_299 +happyReduction_299 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut83 happy_x_3 of { happy_var_3 -> + case happyOut80 happy_x_5 of { happy_var_5 -> + happyIn84 + (happy_var_5 happy_var_3 + ) `HappyStk` happyRest}} + +happyReduce_300 = happySpecReduce_2 80# happyReduction_300 +happyReduction_300 happy_x_2 + happy_x_1 + = case happyOut84 happy_x_1 of { happy_var_1 -> + happyIn84 + (happy_var_1 + )} + +happyReduce_301 = happyMonadReduce 1# 81# happyReduction_301 +happyReduction_301 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut110 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CInitExpr happy_var_1)} + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_302 = happyMonadReduce 3# 81# happyReduction_302 +happyReduction_302 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut87 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CInitList (reverse happy_var_2))}} + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_303 = happyMonadReduce 4# 81# happyReduction_303 +happyReduction_303 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut87 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CInitList (reverse happy_var_2))}} + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_304 = happySpecReduce_0 82# happyReduction_304 +happyReduction_304 = happyIn86 + (Nothing + ) + +happyReduce_305 = happySpecReduce_2 82# happyReduction_305 +happyReduction_305 happy_x_2 + happy_x_1 + = case happyOut85 happy_x_2 of { happy_var_2 -> + happyIn86 + (Just happy_var_2 + )} + +happyReduce_306 = happySpecReduce_0 83# happyReduction_306 +happyReduction_306 = happyIn87 + (empty + ) + +happyReduce_307 = happySpecReduce_1 83# happyReduction_307 +happyReduction_307 happy_x_1 + = case happyOut85 happy_x_1 of { happy_var_1 -> + happyIn87 + (singleton ([],happy_var_1) + )} + +happyReduce_308 = happySpecReduce_2 83# happyReduction_308 +happyReduction_308 happy_x_2 + happy_x_1 + = case happyOut88 happy_x_1 of { happy_var_1 -> + case happyOut85 happy_x_2 of { happy_var_2 -> + happyIn87 + (singleton (happy_var_1,happy_var_2) + )}} + +happyReduce_309 = happySpecReduce_3 83# happyReduction_309 +happyReduction_309 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut87 happy_x_1 of { happy_var_1 -> + case happyOut85 happy_x_3 of { happy_var_3 -> + happyIn87 + (happy_var_1 `snoc` ([],happy_var_3) + )}} + +happyReduce_310 = happyReduce 4# 83# happyReduction_310 +happyReduction_310 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut87 happy_x_1 of { happy_var_1 -> + case happyOut88 happy_x_3 of { happy_var_3 -> + case happyOut85 happy_x_4 of { happy_var_4 -> + happyIn87 + (happy_var_1 `snoc` (happy_var_3,happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_311 = happySpecReduce_2 84# happyReduction_311 +happyReduction_311 happy_x_2 + happy_x_1 + = case happyOut89 happy_x_1 of { happy_var_1 -> + happyIn88 + (reverse happy_var_1 + )} + +happyReduce_312 = happyMonadReduce 2# 84# happyReduction_312 +happyReduction_312 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut120 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ \at -> [CMemberDesig happy_var_1 at])} + ) (\r -> happyReturn (happyIn88 r)) + +happyReduce_313 = happySpecReduce_1 84# happyReduction_313 +happyReduction_313 happy_x_1 + = case happyOut91 happy_x_1 of { happy_var_1 -> + happyIn88 + ([happy_var_1] + )} + +happyReduce_314 = happySpecReduce_1 85# happyReduction_314 +happyReduction_314 happy_x_1 + = case happyOut90 happy_x_1 of { happy_var_1 -> + happyIn89 + (singleton happy_var_1 + )} + +happyReduce_315 = happySpecReduce_2 85# happyReduction_315 +happyReduction_315 happy_x_2 + happy_x_1 + = case happyOut89 happy_x_1 of { happy_var_1 -> + case happyOut90 happy_x_2 of { happy_var_2 -> + happyIn89 + (happy_var_1 `snoc` happy_var_2 + )}} + +happyReduce_316 = happyMonadReduce 3# 86# happyReduction_316 +happyReduction_316 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CArrDesig happy_var_2)}} + ) (\r -> happyReturn (happyIn90 r)) + +happyReduce_317 = happyMonadReduce 2# 86# happyReduction_317 +happyReduction_317 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CMemberDesig happy_var_2)}} + ) (\r -> happyReturn (happyIn90 r)) + +happyReduce_318 = happySpecReduce_1 86# happyReduction_318 +happyReduction_318 happy_x_1 + = case happyOut91 happy_x_1 of { happy_var_1 -> + happyIn90 + (happy_var_1 + )} + +happyReduce_319 = happyMonadReduce 5# 87# happyReduction_319 +happyReduction_319 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut116 happy_x_2 of { happy_var_2 -> + case happyOut116 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CRangeDesig happy_var_2 happy_var_4)}}} + ) (\r -> happyReturn (happyIn91 r)) + +happyReduce_320 = happyMonadReduce 1# 88# happyReduction_320 +happyReduction_320 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> + ( withAttrs happy_var_1 $ CVar happy_var_1)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_321 = happyMonadReduce 1# 88# happyReduction_321 +happyReduction_321 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut117 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CConst happy_var_1)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_322 = happyMonadReduce 1# 88# happyReduction_322 +happyReduction_322 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut118 happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ CConst happy_var_1)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_323 = happySpecReduce_3 88# happyReduction_323 +happyReduction_323 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut112 happy_x_2 of { happy_var_2 -> + happyIn92 + (happy_var_2 + )} + +happyReduce_324 = happyMonadReduce 3# 88# happyReduction_324 +happyReduction_324 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CStatExpr happy_var_2)}} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_325 = happyMonadReduce 6# 88# happyReduction_325 +happyReduction_325 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CBuiltinExpr)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_326 = happyMonadReduce 6# 88# happyReduction_326 +happyReduction_326 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CBuiltinExpr)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_327 = happyMonadReduce 6# 88# happyReduction_327 +happyReduction_327 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 CBuiltinExpr)} + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_328 = happySpecReduce_1 89# happyReduction_328 +happyReduction_328 happy_x_1 + = happyIn93 + (() + ) + +happyReduce_329 = happySpecReduce_3 89# happyReduction_329 +happyReduction_329 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn93 + (() + ) + +happyReduce_330 = happyReduce 4# 89# happyReduction_330 +happyReduction_330 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn93 + (() + ) `HappyStk` happyRest + +happyReduce_331 = happySpecReduce_1 90# happyReduction_331 +happyReduction_331 happy_x_1 + = case happyOut92 happy_x_1 of { happy_var_1 -> + happyIn94 + (happy_var_1 + )} + +happyReduce_332 = happyMonadReduce 4# 90# happyReduction_332 +happyReduction_332 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CIndex happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_333 = happyMonadReduce 3# 90# happyReduction_333 +happyReduction_333 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CCall happy_var_1 [])}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_334 = happyMonadReduce 4# 90# happyReduction_334 +happyReduction_334 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut95 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CCall happy_var_1 (reverse happy_var_3))}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_335 = happyMonadReduce 3# 90# happyReduction_335 +happyReduction_335 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CMember happy_var_1 happy_var_3 False)}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_336 = happyMonadReduce 3# 90# happyReduction_336 +happyReduction_336 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut120 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CMember happy_var_1 happy_var_3 True)}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_337 = happyMonadReduce 2# 90# happyReduction_337 +happyReduction_337 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CUnary CPostIncOp happy_var_1)}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_338 = happyMonadReduce 2# 90# happyReduction_338 +happyReduction_338 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut94 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_2 $ CUnary CPostDecOp happy_var_1)}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_339 = happyMonadReduce 6# 90# happyReduction_339 +happyReduction_339 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut78 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut87 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_4 $ CCompoundLit happy_var_2 (reverse happy_var_5))}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_340 = happyMonadReduce 7# 90# happyReduction_340 +happyReduction_340 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut78 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut87 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_4 $ CCompoundLit happy_var_2 (reverse happy_var_5))}}} + ) (\r -> happyReturn (happyIn94 r)) + +happyReduce_341 = happySpecReduce_1 91# happyReduction_341 +happyReduction_341 happy_x_1 + = case happyOut110 happy_x_1 of { happy_var_1 -> + happyIn95 + (singleton happy_var_1 + )} + +happyReduce_342 = happySpecReduce_3 91# happyReduction_342 +happyReduction_342 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut95 happy_x_1 of { happy_var_1 -> + case happyOut110 happy_x_3 of { happy_var_3 -> + happyIn95 + (happy_var_1 `snoc` happy_var_3 + )}} + +happyReduce_343 = happySpecReduce_1 92# happyReduction_343 +happyReduction_343 happy_x_1 + = case happyOut94 happy_x_1 of { happy_var_1 -> + happyIn96 + (happy_var_1 + )} + +happyReduce_344 = happyMonadReduce 2# 92# happyReduction_344 +happyReduction_344 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut96 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CUnary CPreIncOp happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_345 = happyMonadReduce 2# 92# happyReduction_345 +happyReduction_345 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut96 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CUnary CPreDecOp happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_346 = happySpecReduce_2 92# happyReduction_346 +happyReduction_346 happy_x_2 + happy_x_1 + = case happyOut98 happy_x_2 of { happy_var_2 -> + happyIn96 + (happy_var_2 + )} + +happyReduce_347 = happyMonadReduce 2# 92# happyReduction_347 +happyReduction_347 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut97 happy_x_1 of { happy_var_1 -> + case happyOut98 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CUnary (unL happy_var_1) happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_348 = happyMonadReduce 2# 92# happyReduction_348 +happyReduction_348 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut96 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CSizeofExpr happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_349 = happyMonadReduce 4# 92# happyReduction_349 +happyReduction_349 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut78 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CSizeofType happy_var_3)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_350 = happyMonadReduce 2# 92# happyReduction_350 +happyReduction_350 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut96 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CAlignofExpr happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_351 = happyMonadReduce 4# 92# happyReduction_351 +happyReduction_351 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut78 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_1 $ CAlignofType happy_var_3)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_352 = happyMonadReduce 2# 92# happyReduction_352 +happyReduction_352 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ CLabAddrExpr happy_var_2)}} + ) (\r -> happyReturn (happyIn96 r)) + +happyReduce_353 = happySpecReduce_1 93# happyReduction_353 +happyReduction_353 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CAdrOp (posOf happy_var_1) + )} + +happyReduce_354 = happySpecReduce_1 93# happyReduction_354 +happyReduction_354 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CIndOp (posOf happy_var_1) + )} + +happyReduce_355 = happySpecReduce_1 93# happyReduction_355 +happyReduction_355 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CPlusOp (posOf happy_var_1) + )} + +happyReduce_356 = happySpecReduce_1 93# happyReduction_356 +happyReduction_356 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CMinOp (posOf happy_var_1) + )} + +happyReduce_357 = happySpecReduce_1 93# happyReduction_357 +happyReduction_357 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CCompOp (posOf happy_var_1) + )} + +happyReduce_358 = happySpecReduce_1 93# happyReduction_358 +happyReduction_358 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn97 + (L CNegOp (posOf happy_var_1) + )} + +happyReduce_359 = happySpecReduce_1 94# happyReduction_359 +happyReduction_359 happy_x_1 + = case happyOut96 happy_x_1 of { happy_var_1 -> + happyIn98 + (happy_var_1 + )} + +happyReduce_360 = happyMonadReduce 4# 94# happyReduction_360 +happyReduction_360 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut78 happy_x_2 of { happy_var_2 -> + case happyOut98 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_1 $ CCast happy_var_2 happy_var_4)}}} + ) (\r -> happyReturn (happyIn98 r)) + +happyReduce_361 = happySpecReduce_1 95# happyReduction_361 +happyReduction_361 happy_x_1 + = case happyOut98 happy_x_1 of { happy_var_1 -> + happyIn99 + (happy_var_1 + )} + +happyReduce_362 = happyMonadReduce 3# 95# happyReduction_362 +happyReduction_362 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut98 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CMulOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn99 r)) + +happyReduce_363 = happyMonadReduce 3# 95# happyReduction_363 +happyReduction_363 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut98 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CDivOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn99 r)) + +happyReduce_364 = happyMonadReduce 3# 95# happyReduction_364 +happyReduction_364 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut98 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CRmdOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn99 r)) + +happyReduce_365 = happySpecReduce_1 96# happyReduction_365 +happyReduction_365 happy_x_1 + = case happyOut99 happy_x_1 of { happy_var_1 -> + happyIn100 + (happy_var_1 + )} + +happyReduce_366 = happyMonadReduce 3# 96# happyReduction_366 +happyReduction_366 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut100 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut99 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CAddOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn100 r)) + +happyReduce_367 = happyMonadReduce 3# 96# happyReduction_367 +happyReduction_367 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut100 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut99 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CSubOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn100 r)) + +happyReduce_368 = happySpecReduce_1 97# happyReduction_368 +happyReduction_368 happy_x_1 + = case happyOut100 happy_x_1 of { happy_var_1 -> + happyIn101 + (happy_var_1 + )} + +happyReduce_369 = happyMonadReduce 3# 97# happyReduction_369 +happyReduction_369 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut101 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut100 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CShlOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_370 = happyMonadReduce 3# 97# happyReduction_370 +happyReduction_370 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut101 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut100 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CShrOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_371 = happySpecReduce_1 98# happyReduction_371 +happyReduction_371 happy_x_1 + = case happyOut101 happy_x_1 of { happy_var_1 -> + happyIn102 + (happy_var_1 + )} + +happyReduce_372 = happyMonadReduce 3# 98# happyReduction_372 +happyReduction_372 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut101 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CLeOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn102 r)) + +happyReduce_373 = happyMonadReduce 3# 98# happyReduction_373 +happyReduction_373 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut101 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CGrOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn102 r)) + +happyReduce_374 = happyMonadReduce 3# 98# happyReduction_374 +happyReduction_374 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut101 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CLeqOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn102 r)) + +happyReduce_375 = happyMonadReduce 3# 98# happyReduction_375 +happyReduction_375 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut101 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CGeqOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn102 r)) + +happyReduce_376 = happySpecReduce_1 99# happyReduction_376 +happyReduction_376 happy_x_1 + = case happyOut102 happy_x_1 of { happy_var_1 -> + happyIn103 + (happy_var_1 + )} + +happyReduce_377 = happyMonadReduce 3# 99# happyReduction_377 +happyReduction_377 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut103 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut102 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CEqOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn103 r)) + +happyReduce_378 = happyMonadReduce 3# 99# happyReduction_378 +happyReduction_378 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut103 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut102 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CNeqOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn103 r)) + +happyReduce_379 = happySpecReduce_1 100# happyReduction_379 +happyReduction_379 happy_x_1 + = case happyOut103 happy_x_1 of { happy_var_1 -> + happyIn104 + (happy_var_1 + )} + +happyReduce_380 = happyMonadReduce 3# 100# happyReduction_380 +happyReduction_380 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut104 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut103 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CAndOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn104 r)) + +happyReduce_381 = happySpecReduce_1 101# happyReduction_381 +happyReduction_381 happy_x_1 + = case happyOut104 happy_x_1 of { happy_var_1 -> + happyIn105 + (happy_var_1 + )} + +happyReduce_382 = happyMonadReduce 3# 101# happyReduction_382 +happyReduction_382 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut105 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut104 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CXorOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn105 r)) + +happyReduce_383 = happySpecReduce_1 102# happyReduction_383 +happyReduction_383 happy_x_1 + = case happyOut105 happy_x_1 of { happy_var_1 -> + happyIn106 + (happy_var_1 + )} + +happyReduce_384 = happyMonadReduce 3# 102# happyReduction_384 +happyReduction_384 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut106 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut105 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary COrOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn106 r)) + +happyReduce_385 = happySpecReduce_1 103# happyReduction_385 +happyReduction_385 happy_x_1 + = case happyOut106 happy_x_1 of { happy_var_1 -> + happyIn107 + (happy_var_1 + )} + +happyReduce_386 = happyMonadReduce 3# 103# happyReduction_386 +happyReduction_386 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut106 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CLndOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn107 r)) + +happyReduce_387 = happySpecReduce_1 104# happyReduction_387 +happyReduction_387 happy_x_1 + = case happyOut107 happy_x_1 of { happy_var_1 -> + happyIn108 + (happy_var_1 + )} + +happyReduce_388 = happyMonadReduce 3# 104# happyReduction_388 +happyReduction_388 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut108 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut107 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CBinary CLorOp happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn108 r)) + +happyReduce_389 = happySpecReduce_1 105# happyReduction_389 +happyReduction_389 happy_x_1 + = case happyOut108 happy_x_1 of { happy_var_1 -> + happyIn109 + (happy_var_1 + )} + +happyReduce_390 = happyMonadReduce 5# 105# happyReduction_390 +happyReduction_390 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut108 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut112 happy_x_3 of { happy_var_3 -> + case happyOut109 happy_x_5 of { happy_var_5 -> + ( withAttrs happy_var_2 $ CCond happy_var_1 (Just happy_var_3) happy_var_5)}}}} + ) (\r -> happyReturn (happyIn109 r)) + +happyReduce_391 = happyMonadReduce 4# 105# happyReduction_391 +happyReduction_391 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut108 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut109 happy_x_4 of { happy_var_4 -> + ( withAttrs happy_var_2 $ CCond happy_var_1 Nothing happy_var_4)}}} + ) (\r -> happyReturn (happyIn109 r)) + +happyReduce_392 = happySpecReduce_1 106# happyReduction_392 +happyReduction_392 happy_x_1 + = case happyOut109 happy_x_1 of { happy_var_1 -> + happyIn110 + (happy_var_1 + )} + +happyReduce_393 = happyMonadReduce 3# 106# happyReduction_393 +happyReduction_393 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut96 happy_x_1 of { happy_var_1 -> + case happyOut111 happy_x_2 of { happy_var_2 -> + case happyOut110 happy_x_3 of { happy_var_3 -> + ( withAttrs happy_var_2 $ CAssign (unL happy_var_2) happy_var_1 happy_var_3)}}} + ) (\r -> happyReturn (happyIn110 r)) + +happyReduce_394 = happySpecReduce_1 107# happyReduction_394 +happyReduction_394 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CAssignOp (posOf happy_var_1) + )} + +happyReduce_395 = happySpecReduce_1 107# happyReduction_395 +happyReduction_395 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CMulAssOp (posOf happy_var_1) + )} + +happyReduce_396 = happySpecReduce_1 107# happyReduction_396 +happyReduction_396 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CDivAssOp (posOf happy_var_1) + )} + +happyReduce_397 = happySpecReduce_1 107# happyReduction_397 +happyReduction_397 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CRmdAssOp (posOf happy_var_1) + )} + +happyReduce_398 = happySpecReduce_1 107# happyReduction_398 +happyReduction_398 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CAddAssOp (posOf happy_var_1) + )} + +happyReduce_399 = happySpecReduce_1 107# happyReduction_399 +happyReduction_399 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CSubAssOp (posOf happy_var_1) + )} + +happyReduce_400 = happySpecReduce_1 107# happyReduction_400 +happyReduction_400 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CShlAssOp (posOf happy_var_1) + )} + +happyReduce_401 = happySpecReduce_1 107# happyReduction_401 +happyReduction_401 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CShrAssOp (posOf happy_var_1) + )} + +happyReduce_402 = happySpecReduce_1 107# happyReduction_402 +happyReduction_402 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CAndAssOp (posOf happy_var_1) + )} + +happyReduce_403 = happySpecReduce_1 107# happyReduction_403 +happyReduction_403 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L CXorAssOp (posOf happy_var_1) + )} + +happyReduce_404 = happySpecReduce_1 107# happyReduction_404 +happyReduction_404 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn111 + (L COrAssOp (posOf happy_var_1) + )} + +happyReduce_405 = happySpecReduce_1 108# happyReduction_405 +happyReduction_405 happy_x_1 + = case happyOut110 happy_x_1 of { happy_var_1 -> + happyIn112 + (happy_var_1 + )} + +happyReduce_406 = happyMonadReduce 3# 108# happyReduction_406 +happyReduction_406 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut110 happy_x_1 of { happy_var_1 -> + case happyOut113 happy_x_3 of { happy_var_3 -> + ( let es = reverse happy_var_3 in withAttrs es $ CComma (happy_var_1:es))}} + ) (\r -> happyReturn (happyIn112 r)) + +happyReduce_407 = happySpecReduce_1 109# happyReduction_407 +happyReduction_407 happy_x_1 + = case happyOut110 happy_x_1 of { happy_var_1 -> + happyIn113 + (singleton happy_var_1 + )} + +happyReduce_408 = happySpecReduce_3 109# happyReduction_408 +happyReduction_408 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut113 happy_x_1 of { happy_var_1 -> + case happyOut110 happy_x_3 of { happy_var_3 -> + happyIn113 + (happy_var_1 `snoc` happy_var_3 + )}} + +happyReduce_409 = happySpecReduce_0 110# happyReduction_409 +happyReduction_409 = happyIn114 + (Nothing + ) + +happyReduce_410 = happySpecReduce_1 110# happyReduction_410 +happyReduction_410 happy_x_1 + = case happyOut112 happy_x_1 of { happy_var_1 -> + happyIn114 + (Just happy_var_1 + )} + +happyReduce_411 = happySpecReduce_0 111# happyReduction_411 +happyReduction_411 = happyIn115 + (Nothing + ) + +happyReduce_412 = happySpecReduce_1 111# happyReduction_412 +happyReduction_412 happy_x_1 + = case happyOut110 happy_x_1 of { happy_var_1 -> + happyIn115 + (Just happy_var_1 + )} + +happyReduce_413 = happySpecReduce_1 112# happyReduction_413 +happyReduction_413 happy_x_1 + = case happyOut109 happy_x_1 of { happy_var_1 -> + happyIn116 + (happy_var_1 + )} + +happyReduce_414 = happyMonadReduce 1# 113# happyReduction_414 +happyReduction_414 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ case happy_var_1 of CTokILit _ i -> CIntConst i)} + ) (\r -> happyReturn (happyIn117 r)) + +happyReduce_415 = happyMonadReduce 1# 113# happyReduction_415 +happyReduction_415 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ case happy_var_1 of CTokCLit _ c -> CCharConst c)} + ) (\r -> happyReturn (happyIn117 r)) + +happyReduce_416 = happyMonadReduce 1# 113# happyReduction_416 +happyReduction_416 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ case happy_var_1 of CTokFLit _ f -> CFloatConst f)} + ) (\r -> happyReturn (happyIn117 r)) + +happyReduce_417 = happyMonadReduce 1# 114# happyReduction_417 +happyReduction_417 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( withAttrs happy_var_1 $ case happy_var_1 of CTokSLit _ s -> CStrConst s)} + ) (\r -> happyReturn (happyIn118 r)) + +happyReduce_418 = happyMonadReduce 2# 114# happyReduction_418 +happyReduction_418 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut119 happy_x_2 of { happy_var_2 -> + ( withAttrs happy_var_1 $ case happy_var_1 of CTokSLit _ s -> CStrConst (concat (s : reverse happy_var_2)))}} + ) (\r -> happyReturn (happyIn118 r)) + +happyReduce_419 = happySpecReduce_1 115# happyReduction_419 +happyReduction_419 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn119 + (case happy_var_1 of CTokSLit _ s -> singleton s + )} + +happyReduce_420 = happySpecReduce_2 115# happyReduction_420 +happyReduction_420 happy_x_2 + happy_x_1 + = case happyOut119 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn119 + (case happy_var_2 of CTokSLit _ s -> happy_var_1 `snoc` s + )}} + +happyReduce_421 = happySpecReduce_1 116# happyReduction_421 +happyReduction_421 happy_x_1 + = case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> + happyIn120 + (happy_var_1 + )} + +happyReduce_422 = happySpecReduce_1 116# happyReduction_422 +happyReduction_422 happy_x_1 + = case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> + happyIn120 + (happy_var_1 + )} + +happyReduce_423 = happySpecReduce_0 117# happyReduction_423 +happyReduction_423 = happyIn121 + (() + ) + +happyReduce_424 = happySpecReduce_2 117# happyReduction_424 +happyReduction_424 happy_x_2 + happy_x_1 + = happyIn121 + (() + ) + +happyReduce_425 = happySpecReduce_1 118# happyReduction_425 +happyReduction_425 happy_x_1 + = happyIn122 + (() + ) + +happyReduce_426 = happySpecReduce_2 118# happyReduction_426 +happyReduction_426 happy_x_2 + happy_x_1 + = happyIn122 + (() + ) + +happyReduce_427 = happyReduce 6# 119# happyReduction_427 +happyReduction_427 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn123 + (() + ) `HappyStk` happyRest + +happyReduce_428 = happySpecReduce_1 120# happyReduction_428 +happyReduction_428 happy_x_1 + = happyIn124 + (() + ) + +happyReduce_429 = happySpecReduce_3 120# happyReduction_429 +happyReduction_429 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn124 + (() + ) + +happyReduce_430 = happySpecReduce_0 121# happyReduction_430 +happyReduction_430 = happyIn125 + (() + ) + +happyReduce_431 = happySpecReduce_1 121# happyReduction_431 +happyReduction_431 happy_x_1 + = happyIn125 + (() + ) + +happyReduce_432 = happySpecReduce_1 121# happyReduction_432 +happyReduction_432 happy_x_1 + = happyIn125 + (() + ) + +happyReduce_433 = happyReduce 4# 121# happyReduction_433 +happyReduction_433 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn125 + (() + ) `HappyStk` happyRest + +happyReduce_434 = happySpecReduce_3 121# happyReduction_434 +happyReduction_434 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn125 + (() + ) + +happyReduce_435 = happySpecReduce_1 122# happyReduction_435 +happyReduction_435 happy_x_1 + = happyIn126 + (() + ) + +happyReduce_436 = happySpecReduce_3 122# happyReduction_436 +happyReduction_436 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn126 + (() + ) + +happyNewToken action sts stk + = lexC(\tk -> + let cont i = happyDoAction i tk action sts stk in + case tk of { + CTokEof -> happyDoAction 99# tk action sts stk; + CTokLParen _ -> cont 1#; + CTokRParen _ -> cont 2#; + CTokLBracket _ -> cont 3#; + CTokRBracket _ -> cont 4#; + CTokArrow _ -> cont 5#; + CTokDot _ -> cont 6#; + CTokExclam _ -> cont 7#; + CTokTilde _ -> cont 8#; + CTokInc _ -> cont 9#; + CTokDec _ -> cont 10#; + CTokPlus _ -> cont 11#; + CTokMinus _ -> cont 12#; + CTokStar _ -> cont 13#; + CTokSlash _ -> cont 14#; + CTokPercent _ -> cont 15#; + CTokAmper _ -> cont 16#; + CTokShiftL _ -> cont 17#; + CTokShiftR _ -> cont 18#; + CTokLess _ -> cont 19#; + CTokLessEq _ -> cont 20#; + CTokHigh _ -> cont 21#; + CTokHighEq _ -> cont 22#; + CTokEqual _ -> cont 23#; + CTokUnequal _ -> cont 24#; + CTokHat _ -> cont 25#; + CTokBar _ -> cont 26#; + CTokAnd _ -> cont 27#; + CTokOr _ -> cont 28#; + CTokQuest _ -> cont 29#; + CTokColon _ -> cont 30#; + CTokAssign _ -> cont 31#; + CTokPlusAss _ -> cont 32#; + CTokMinusAss _ -> cont 33#; + CTokStarAss _ -> cont 34#; + CTokSlashAss _ -> cont 35#; + CTokPercAss _ -> cont 36#; + CTokAmpAss _ -> cont 37#; + CTokHatAss _ -> cont 38#; + CTokBarAss _ -> cont 39#; + CTokSLAss _ -> cont 40#; + CTokSRAss _ -> cont 41#; + CTokComma _ -> cont 42#; + CTokSemic _ -> cont 43#; + CTokLBrace _ -> cont 44#; + CTokRBrace _ -> cont 45#; + CTokEllipsis _ -> cont 46#; + CTokAlignof _ -> cont 47#; + CTokAsm _ -> cont 48#; + CTokAuto _ -> cont 49#; + CTokBreak _ -> cont 50#; + CTokBool _ -> cont 51#; + CTokCase _ -> cont 52#; + CTokChar _ -> cont 53#; + CTokConst _ -> cont 54#; + CTokContinue _ -> cont 55#; + CTokComplex _ -> cont 56#; + CTokDefault _ -> cont 57#; + CTokDo _ -> cont 58#; + CTokDouble _ -> cont 59#; + CTokElse _ -> cont 60#; + CTokEnum _ -> cont 61#; + CTokExtern _ -> cont 62#; + CTokFloat _ -> cont 63#; + CTokFor _ -> cont 64#; + CTokGoto _ -> cont 65#; + CTokIf _ -> cont 66#; + CTokInline _ -> cont 67#; + CTokInt _ -> cont 68#; + CTokLong _ -> cont 69#; + CTokLabel _ -> cont 70#; + CTokRegister _ -> cont 71#; + CTokRestrict _ -> cont 72#; + CTokReturn _ -> cont 73#; + CTokShort _ -> cont 74#; + CTokSigned _ -> cont 75#; + CTokSizeof _ -> cont 76#; + CTokStatic _ -> cont 77#; + CTokStruct _ -> cont 78#; + CTokSwitch _ -> cont 79#; + CTokTypedef _ -> cont 80#; + CTokTypeof _ -> cont 81#; + CTokThread _ -> cont 82#; + CTokUnion _ -> cont 83#; + CTokUnsigned _ -> cont 84#; + CTokVoid _ -> cont 85#; + CTokVolatile _ -> cont 86#; + CTokWhile _ -> cont 87#; + CTokCLit _ _ -> cont 88#; + CTokILit _ _ -> cont 89#; + CTokFLit _ _ -> cont 90#; + CTokSLit _ _ -> cont 91#; + CTokIdent _ happy_dollar_dollar -> cont 92#; + CTokTyIdent _ happy_dollar_dollar -> cont 93#; + CTokGnuC GnuCAttrTok _ -> cont 94#; + CTokGnuC GnuCExtTok _ -> cont 95#; + CTokGnuC GnuCVaArg _ -> cont 96#; + CTokGnuC GnuCOffsetof _ -> cont 97#; + CTokGnuC GnuCTyCompat _ -> cont 98#; + _ -> happyError' tk + }) + +happyError_ tk = happyError' tk + +happyThen :: () => P a -> (a -> P b) -> P b +happyThen = (>>=) +happyReturn :: () => a -> P a +happyReturn = (return) +happyThen1 = happyThen +happyReturn1 :: () => a -> P a +happyReturn1 = happyReturn +happyError' :: () => CToken -> P a +happyError' tk = (\token -> happyError) tk + +header = happySomeParser where + happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +infixr 5 `snoc` + +-- Due to the way the grammar is constructed we very often have to build lists +-- in reverse. To make sure we do this consistently and correctly we have a +-- newtype to wrap the reversed style of list: +-- +newtype Reversed a = Reversed a + +empty :: Reversed [a] +empty = Reversed [] + +singleton :: a -> Reversed [a] +singleton x = Reversed [x] + +snoc :: Reversed [a] -> a -> Reversed [a] +snoc (Reversed xs) x = Reversed (x : xs) + +rmap :: (a -> b) -> Reversed [a] -> Reversed [b] +rmap f (Reversed xs) = Reversed (map f xs) + +reverse :: Reversed [a] -> [a] +reverse (Reversed xs) = List.reverse xs + +-- We occasionally need things to have a location when they don't naturally +-- have one built in as tokens and most AST elements do. +-- +data Located a = L !a !Position + +unL :: Located a -> a +unL (L a pos) = a + +instance Pos (Located a) where + posOf (L _ pos) = pos + +{-# INLINE withAttrs #-} +withAttrs :: Pos node => node -> (Attrs -> a) -> P a +withAttrs node mkAttributedNode = do + name <- getNewName + let attrs = newAttrs (posOf node) name + attrs `seq` return (mkAttributedNode attrs) + +-- this functions gets used repeatedly so take them out of line: +-- +liftTypeQuals :: Reversed [CTypeQual] -> [CDeclSpec] +liftTypeQuals (Reversed xs) = revmap [] xs + where revmap a [] = a + revmap a (x:xs) = revmap (CTypeQual x : a) xs + + +-- convenient instance, the position of a list of things is the position of +-- the first thing in the list +-- +instance Pos a => Pos [a] where + posOf (x:_) = posOf x + +instance Pos a => Pos (Reversed a) where + posOf (Reversed x) = posOf x + +emptyDeclr = CVarDeclr Nothing (newAttrsOnlyPos nopos) + +-- Take the identifiers and use them to update the typedef'ed identifier set +-- if the decl is defining a typedef then we add it to the set, +-- if it's a var decl then that shadows typedefed identifiers +-- +doDeclIdent :: [CDeclSpec] -> CDeclr -> P () +doDeclIdent declspecs declr = + case getCDeclrIdent declr of + Nothing -> return () + Just ident | any isTypeDef declspecs -> addTypedef ident + | otherwise -> shadowTypedef ident + + where isTypeDef (CStorageSpec (CTypedef _)) = True + isTypeDef _ = False + +doFuncParamDeclIdent :: CDeclr -> P () +doFuncParamDeclIdent (CFunDeclr _ params _ _) = + sequence_ + [ case getCDeclrIdent declr of + Nothing -> return () + Just ident -> shadowTypedef ident + | CDecl _ dle _ <- params + , (Just declr, _, _) <- dle ] +doFuncParamDeclIdent (CPtrDeclr _ declr _ ) = doFuncParamDeclIdent declr +doFuncParamDeclIdent _ = return () + +-- extract all identifiers +getCDeclrIdent :: CDeclr -> Maybe Ident +getCDeclrIdent (CVarDeclr optIde _) = optIde +getCDeclrIdent (CPtrDeclr _ declr _) = getCDeclrIdent declr +getCDeclrIdent (CArrDeclr declr _ _ _) = getCDeclrIdent declr +getCDeclrIdent (CFunDeclr declr _ _ _) = getCDeclrIdent declr + + +happyError :: P a +happyError = parseError + +parseC :: String -> Position -> PreCST s s' CHeader +parseC input initialPosition = do + nameSupply <- getNameSupply + let ns = names nameSupply + case execParser header input + initialPosition (map fst builtinTypeNames) ns of + Left header -> return header + Right (message, position) -> raiseFatal "Error in C header file." + position message +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 28 "GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + +{-# LINE 49 "GenericTemplate.hs" #-} + +{-# LINE 59 "GenericTemplate.hs" #-} + +{-# LINE 68 "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 "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 "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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/base/errors/Errors.hs b/base/errors/Errors.hs new file mode 100644 --- /dev/null +++ b/base/errors/Errors.hs @@ -0,0 +1,153 @@ +-- Compiler Toolkit: basic error management +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 20 February 95 +-- +-- Copyright (c) [1995..2000] Manuel M. T. Chakravarty +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Library General Public +-- License as published by the Free Software Foundation; either +-- version 2 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Library General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This modules exports some auxilliary routines for error handling. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * the single lines of error messages shouldn't be to long as file name +-- and position are prepended at each line +-- +--- TODO ---------------------------------------------------------------------- +-- + +module Errors ( + -- handling of internal error + -- + interr, todo, + -- + -- errors in the compiled program + -- + ErrorLvl(..), Error, makeError, errorLvl, showError, errorAtPos +) where + +import Position (Position(..), isInternalPos) + + +-- internal errors +-- --------------- + +-- raise a fatal internal error; message may have multiple lines (EXPORTED) +-- +interr :: String -> a +interr msg = error ("INTERNAL COMPILER ERROR:\n" + ++ indentMultilineString 2 msg + ++ "\n") + +-- raise a error due to a implementation restriction; message may have multiple +-- lines (EXPORTED) +-- +todo :: String -> a +todo msg = error ("Feature not yet implemented:\n" + ++ indentMultilineString 2 msg + ++ "\n") + + +-- errors in the compiled program +-- ------------------------------ + +-- the higher the level of an error, the more critical it is (EXPORTED) +-- +data ErrorLvl = WarningErr -- does not affect compilation + | ErrorErr -- cannot generate code + | FatalErr -- abort immediately + deriving (Eq, Ord) + +data Error = Error ErrorLvl Position [String] -- (EXPORTED ABSTRACTLY) + +-- note that the equality to on errors takes into account only the error level +-- and position (not the error text) +-- +-- note that these comparisions are expensive (the positions contain the file +-- names as strings) +-- +instance Eq Error where + (Error lvl1 pos1 _) == (Error lvl2 pos2 _) = lvl1 == lvl2 && pos1 == pos2 + +instance Ord Error where + (Error lvl1 pos1 _) < (Error lvl2 pos2 _) = pos1 < pos2 + || (pos1 == pos2 && lvl1 < lvl2) + e1 <= e2 = e1 < e2 || e1 == e2 + + +-- produce an `Error', given its level, position, and a list of lines of +-- the error message that must not be empty (EXPORTED) +-- +makeError :: ErrorLvl -> Position -> [String] -> Error +makeError = Error + +-- inquire the error level (EXPORTED) +-- +errorLvl :: Error -> ErrorLvl +errorLvl (Error lvl _ _) = lvl + +-- converts an error into a string using a fixed format (EXPORTED) +-- +-- * the list of lines of the error message must not be empty +-- +-- * the format is +-- +-- :: (column ) [] +-- >>> +-- +-- ... +-- +-- +-- * internal errors (identified by a special position value) are formatted as +-- +-- INTERNAL ERROR! +-- >>> +-- +-- ... +-- +-- +showError :: Error -> String +showError (Error _ pos (l:ls)) | isInternalPos pos = + "INTERNAL ERROR!\n" + ++ " >>> " ++ l ++ "\n" + ++ (indentMultilineString 2 . unlines) ls +showError (Error lvl (Position fname row col) (l:ls)) = + let + prefix = fname ++ ":" ++ show (row::Int) ++ ": " + ++ "(column " + ++ show (col::Int) + ++ ") [" + ++ showErrorLvl lvl + ++ "] " + showErrorLvl WarningErr = "WARNING" + showErrorLvl ErrorErr = "ERROR" + showErrorLvl FatalErr = "FATAL" + in + prefix ++ "\n" + ++ " >>> " ++ l ++ "\n" + ++ (indentMultilineString 2 . unlines) ls +showError (Error _ _ [] ) = interr "Errors: showError:\ + \ Empty error message!" + +errorAtPos :: Position -> [String] -> a +errorAtPos pos msg = (error . showError . makeError ErrorErr pos) msg + +-- indent the given multiline text by the given number of spaces +-- +indentMultilineString :: Int -> String -> String +indentMultilineString n = unlines . (map (spaces++)) . lines + where + spaces = take n (repeat ' ') diff --git a/base/general/DLists.hs b/base/general/DLists.hs new file mode 100644 --- /dev/null +++ b/base/general/DLists.hs @@ -0,0 +1,66 @@ +-- The Compiler Toolkit: difference lists +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 24 February 95 +-- +-- Copyright (c) [1995..2000] Manuel M. T. Chakravarty +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Library General Public +-- License as published by the Free Software Foundation; either +-- version 2 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Library General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides the functional equivalent of the difference lists +-- from logic programming. They provide an O(1) append. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +--- TODO ---------------------------------------------------------------------- +-- + +module DLists (DList, openDL, zeroDL, unitDL, snocDL, joinDL, closeDL) +where + +-- a difference list is a function that given a list returns the original +-- contents of the difference list prepended at the given list (EXPORTED) +-- +type DList a = [a] -> [a] + +-- open a list for use as a difference list (EXPORTED) +-- +openDL :: [a] -> DList a +openDL = (++) + +-- create a difference list containing no elements (EXPORTED) +-- +zeroDL :: DList a +zeroDL = id + +-- create difference list with given single element (EXPORTED) +-- +unitDL :: a -> DList a +unitDL = (:) + +-- append a single element at a difference list (EXPORTED) +-- +snocDL :: DList a -> a -> DList a +snocDL dl x = \l -> dl (x:l) + +-- appending difference lists (EXPORTED) +-- +joinDL :: DList a -> DList a -> DList a +joinDL = (.) + +-- closing a difference list into a normal list (EXPORTED) +-- +closeDL :: DList a -> [a] +closeDL = ($[]) diff --git a/base/general/Position.hs b/base/general/Position.hs new file mode 100644 --- /dev/null +++ b/base/general/Position.hs @@ -0,0 +1,113 @@ +-- Compiler Toolkit: some basic definitions used all over the place +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 16 February 95 +-- +-- Copyright (c) [1995..2000] Manuel M. T. Chakravarty +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Library General Public +-- License as published by the Free Software Foundation; either +-- version 2 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Library General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides some definitions used throughout all modules of a +-- compiler. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * May not import anything apart from `Config'. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module Position ( + -- + -- source text positions + -- + Position(Position), Pos (posOf), + nopos, isNopos, + dontCarePos, isDontCarePos, + builtinPos, isBuiltinPos, + internalPos, isInternalPos, + incPos, tabPos, retPos, +) where + + +-- uniform representation of source file positions; the order of the arguments +-- is important as it leads to the desired ordering of source positions +-- (EXPORTED) +-- +data Position = Position String -- file name + {-# UNPACK #-} !Int -- row + {-# UNPACK #-} !Int -- column + deriving (Eq, Ord) + +instance Show Position where + show (Position fname row col) = show (fname, row, col) + +-- no position (for unknown position information) (EXPORTED) +-- +nopos :: Position +nopos = Position "" (-1) (-1) + +isNopos :: Position -> Bool +isNopos (Position _ (-1) (-1)) = True +isNopos _ = False + +-- don't care position (to be used for invalid position information) (EXPORTED) +-- +dontCarePos :: Position +dontCarePos = Position "" (-2) (-2) + +isDontCarePos :: Position -> Bool +isDontCarePos (Position _ (-2) (-2)) = True +isDontCarePos _ = False + +-- position attached to objects that are hard-coded into the toolkit (EXPORTED) +-- +builtinPos :: Position +builtinPos = Position "" (-3) (-3) + +isBuiltinPos :: Position -> Bool +isBuiltinPos (Position _ (-3) (-3)) = True +isBuiltinPos _ = False + +-- position used for internal errors (EXPORTED) +-- +internalPos :: Position +internalPos = Position "" (-4) (-4) + +isInternalPos :: Position -> Bool +isInternalPos (Position _ (-4) (-4)) = True +isInternalPos _ = False + +-- instances of the class `Pos' are associated with some source text position +-- don't care position (to be used for invalid position information) (EXPORTED) +-- +class Pos a where + posOf :: a -> Position + +-- advance column +-- +incPos :: Position -> Int -> Position +incPos (Position fname row col) n = Position fname row (col + n) + +-- advance column to next tab positions (tabs are at every 8th column) +-- +tabPos :: Position -> Position +tabPos (Position fname row col) = + Position fname row (col + 8 - (col - 1) `mod` 8) + +-- advance to next line +-- +retPos :: Position -> Position +retPos (Position fname row col) = Position fname (row + 1) 1 diff --git a/base/general/UNames.hs b/base/general/UNames.hs new file mode 100644 --- /dev/null +++ b/base/general/UNames.hs @@ -0,0 +1,136 @@ +-- The HiPar Toolkit: generates unique names +-- +-- Author : Manuel M T Chakravarty +-- Created: 3 April 98 +-- +-- Copyright (C) [1998..2003] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Generates unqiue names according to a method of L. Augustsson, M. Rittri +-- & D. Synek ``Functional pearl: On generating unique names'', Journal of +-- Functional Programming 4(1), pp 117-123, 1994. +-- +-- WARNING: DON'T tinker with the implementation! It uses UNSAFE low-level +-- operations! +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * This module provides an ordering relation on names (e.g., for using +-- `FiniteMaps'), but no assumption maybe made on the order in which names +-- are generated from the name space. Furthermore, names are instances of +-- `Ix' to allow to use them as indicies. +-- +-- * A supply should be used *at most* once to *either* split it or extract a +-- stream of names. A supply used repeatedly will always generate the same +-- set of names (otherwise, the whole thing wouldn't be referential +-- transparent). +-- +-- * If you ignored the warning below, looked at the implementation, and lost +-- faith, consider that laziness means call-by-need *and* sharing, and that +-- sharing is realized by updating evaluated thunks. +-- +-- * ATTENTION: No clever CSE or unnecessary argument elimination may be +-- applied to the function `names'! +-- +--- TODO +-- + +module UNames (NameSupply, Name, + rootSupply, splitSupply, names) +where + +import Data.Ix +import System.IO.Unsafe (unsafePerformIO) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) + + +-- Name supply definition (EXPORTED ABSTRACTLY) +-- +newtype NameSupply = NameSupply (IORef Int) + +-- Name (EXPORTED ABSTRACTLY) +-- +newtype Name = Name Int +-- deriving (Show, Eq, Ord, Ix) +-- FIXME: nhc98, v1.08 can't derive Ix + deriving (Eq, Ord) +instance Ix Name where + range (Name from, Name to) = map Name (range (from, to)) + index (Name from, Name to) (Name idx) = index (from, to) idx + inRange (Name from, Name to) (Name idx) = inRange (from, to) idx + +-- we want to show the number only, to be useful for generating unqiue +-- printable names +-- +instance Show Name where + show (Name i) = show i + + +-- *** DON'T TOUCH THE FOLLOWING *** +-- and if you believe in the lambda calculus better also don't look at it +-- ! here lives the daemon of unordered destructive updates ! + +-- The initial supply (EXPORTED) +-- +rootSupply :: NameSupply +{-# NOINLINE rootSupply #-} +rootSupply = NameSupply (unsafeNewIntRef 1) + +-- Split a name supply into a stream of supplies (EXPORTED) +-- +splitSupply :: NameSupply -> [NameSupply] +splitSupply s = repeat s + +-- Given a name supply, yield a stream of names (EXPORTED) +-- +names :: NameSupply -> [Name] +-- +-- The recursion of `theNames' where `s' is passed as an argument is crucial, +-- as it forces the creation of a new closure for `unsafeReadAndIncIntRef s' +-- in each recursion step. Sharing a single closure or building a cyclic +-- graph for a nullary `theNames' would always result in the same name! If +-- the compiler ever gets clever enough to optimize this, we have to prevent +-- it from doing so. +-- +names (NameSupply s) = + theNames s + where + theNames s = Name (unsafeReadAndIncIntRef s) : theNames s + + +-- UNSAFE mutable variables +-- ------------------------ + +-- WARNING: The following does not exist, or at least, it belongs to another +-- world. And if you believe into the lambda calculus, you don't +-- want to know about this other world. +-- +-- *** DON'T TOUCH NOR USE THIS STUFF *** +-- (unless you really know what you are doing!) + +-- UNSAFELY create a mutable integer (EXPORTED) +-- +unsafeNewIntRef :: Int -> IORef Int +unsafeNewIntRef i = unsafePerformIO (newIORef i) + +-- UNSAFELY increment a mutable integer and yield its value before the +-- increment (EXPORTED) +-- +unsafeReadAndIncIntRef :: IORef Int -> Int +unsafeReadAndIncIntRef mv = unsafePerformIO $ do + v <- readIORef mv + writeIORef mv (v + 1) + return v diff --git a/base/state/CIO.hs b/base/state/CIO.hs new file mode 100644 --- /dev/null +++ b/base/state/CIO.hs @@ -0,0 +1,158 @@ +-- Compiler Toolkit: Compiler I/O +-- +-- Author : Manuel M T Chakravarty +-- Created: 2 November 95 +-- +-- Copyright (c) [1995...2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module lifts the Haskell I/O facilities into `STB' and provides some +-- useful extensions. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * the usage of the `...CIO' functions is exactly as that of the +-- corresponding `...' functions from the Haskell 98 prelude and library +-- +-- * error handling can be found in the module `StateTrans' and `State' +-- +-- * Also reexports constants, such as `stderr', and data types of `IO' to +-- avoid explicit imports of `IO' in the rest of the compiler. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CIO (-- (verbatim) re-exports + -- + Handle, HandlePosn, IOMode(..), BufferMode(..), SeekMode(..), + stdin, stdout, stderr, + isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, + isFullError, isEOFError, isIllegalOperation, isPermissionError, + isUserError, + ioeGetErrorString, ioeGetHandle, ioeGetFileName, + -- + -- file handling + -- + openFileCIO, hCloseCIO, + -- + -- text I/O + -- + putCharCIO, putStrCIO, putStrLnCIO, hPutStrCIO, hPutStrLnCIO, + writeFileCIO, readFileCIO, printCIO, getCharCIO, hFlushCIO, + hPutCharCIO, hSetBufferingCIO, hGetBufferingCIO, newlineCIO, + -- + -- `Directory' + -- + doesFileExistCIO, removeFileCIO, + -- + -- `System' + -- + ExitCode(..), exitWithCIO, getArgsCIO, getProgNameCIO, systemCIO, + ) +where + +import System.IO +import System.IO.Error +import System.Directory (doesFileExist, removeFile) +import System.Environment (getArgs, getProgName) +import System.Cmd (system) +import System.Exit (ExitCode(..), exitWith) + +import StateBase (PreCST, liftIO) + + +-- file handling +-- ------------- + +openFileCIO :: FilePath -> IOMode -> PreCST e s Handle +openFileCIO p m = liftIO (openFile p m) + +hCloseCIO :: Handle -> PreCST e s () +hCloseCIO h = liftIO (hClose h) + +-- text I/O +-- -------- + +putCharCIO :: Char -> PreCST e s () +putCharCIO c = liftIO (putChar c) + +putStrCIO :: String -> PreCST e s () +putStrCIO s = liftIO (putStr s) + +putStrLnCIO :: String -> PreCST e s () +putStrLnCIO s = liftIO (putStrLn s) + +hPutStrCIO :: Handle -> String -> PreCST e s () +hPutStrCIO h s = liftIO (hPutStr h s) + +hPutStrLnCIO :: Handle -> String -> PreCST e s () +hPutStrLnCIO h s = liftIO (hPutStrLn h s) + +writeFileCIO :: FilePath -> String -> PreCST e s () +writeFileCIO fname contents = liftIO (writeFile fname contents) + +readFileCIO :: FilePath -> PreCST e s String +readFileCIO fname = liftIO (readFile fname) + +printCIO :: Show a => a -> PreCST e s () +printCIO a = liftIO (print a) + +getCharCIO :: PreCST e s Char +getCharCIO = liftIO getChar + +hFlushCIO :: Handle -> PreCST e s () +hFlushCIO h = liftIO (hFlush h) + +hPutCharCIO :: Handle -> Char -> PreCST e s () +hPutCharCIO h ch = liftIO (hPutChar h ch) + +hSetBufferingCIO :: Handle -> BufferMode -> PreCST e s () +hSetBufferingCIO h m = liftIO (hSetBuffering h m) + +hGetBufferingCIO :: Handle -> PreCST e s BufferMode +hGetBufferingCIO h = liftIO (hGetBuffering h) + +-- derived functions +-- + +newlineCIO :: PreCST e s () +newlineCIO = putCharCIO '\n' + + +-- `Directory' +-- ----------- + +doesFileExistCIO :: FilePath -> PreCST e s Bool +doesFileExistCIO = liftIO . doesFileExist + +removeFileCIO :: FilePath -> PreCST e s () +removeFileCIO = liftIO . removeFile + + +-- `System' +-- -------- + +exitWithCIO :: ExitCode -> PreCST e s a +exitWithCIO = liftIO . exitWith + +getArgsCIO :: PreCST e s [String] +getArgsCIO = liftIO getArgs + +getProgNameCIO :: PreCST e s String +getProgNameCIO = liftIO getProgName + +systemCIO :: String -> PreCST e s ExitCode +systemCIO = liftIO . system diff --git a/base/state/State.hs b/base/state/State.hs new file mode 100644 --- /dev/null +++ b/base/state/State.hs @@ -0,0 +1,304 @@ +-- Compiler Toolkit: compiler state management +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 2 November 95 +-- +-- Copyright (c) [1995..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module forms the interface to the state base of the compiler. It is +-- used by all modules that are not directly involved in implementing the +-- state base. It provides a state transformer that is capable of doing I/O +-- and provides facilities such as error handling and compiler switch +-- management. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * The monad `PreCST' is reexported abstractly. +-- +-- * Errors are dumped to `stdout' to facilitate communication with other +-- processes (see `Interact'). +-- +--- TODO ---------------------------------------------------------------------- +-- + +module State (-- the PreCST monad + -- + PreCST, -- reexport ABSTRACT + throwExc, fatal, catchExc, fatalsHandledBy, -- reexport lifted + readCST, writeCST, transCST, run, runCST, + -- + -- reexport compiler I/O + -- + module CIO, + liftIO, + -- + -- error management + -- + raise, raiseWarning, raiseError, raiseFatal, showErrors, + errorsPresent, + -- + -- extra state management + -- + readExtra, updExtra, + -- + -- name supplies + -- + getNameSupply) +where + +import Control.Monad (when) +import Data.List (sort) + +import Position (Position) +import UNames (NameSupply, + rootSupply, splitSupply) +import StateTrans (readBase, transBase, runSTB) +import qualified + StateTrans (interleave, throwExc, fatal, catchExc, fatalsHandledBy) +import StateBase (PreCST(..), ErrorState(..), BaseState(..), + unpackCST, readCST, writeCST, transCST, + liftIO) +import CIO +import Errors (ErrorLvl(..), Error, makeError, errorLvl, showError) + + +-- state used in the whole compiler +-- -------------------------------- + +-- initialization +-- +-- * it gets the version information and the initial extra state as arguments +-- +initialBaseState :: e -> BaseState e +initialBaseState es = BaseState { + errorsBS = initialErrorState, + suppliesBS = splitSupply rootSupply, + extraBS = es + } + + +-- executing state transformers +-- ---------------------------- + +-- initiate a complete run of the ToolKit represented by a PreCST with a void +-- generic component (type `()') (EXPORTED) +-- +-- * fatals errors are explicitly caught and reported (instead of letting them +-- through to the runtime system) +-- +run :: e -> PreCST e () a -> IO a +run es cst = runSTB m (initialBaseState es) () + where + m = unpackCST ( + cst + `fatalsHandledBy` \err -> + putStrCIO ("Uncaught fatal error: " ++ show err) >> + exitWithCIO (ExitFailure 1) + ) + +-- run a PreCST in the context of another PreCST (EXPORTED) +-- +-- the generic state of the enclosing PreCST is preserved while the +-- computation of the PreCST passed as an argument is interleaved in the +-- execution of the enclosing one +-- +runCST :: PreCST e s a -> s -> PreCST e s' a +runCST m s = CST $ StateTrans.interleave (unpackCST m) s + + +-- exception handling +-- ------------------ + +-- throw an exception with the given tag and message (EXPORTED) +-- +throwExc :: String -> String -> PreCST e s a +throwExc s1 s2 = CST $ StateTrans.throwExc s1 s2 + +-- raise a fatal user-defined error (EXPORTED) +-- +-- * such an error my be caught and handled using `fatalsHandeledBy' +-- +fatal :: String -> PreCST e s a +fatal = CST . StateTrans.fatal + +-- the given state transformer is executed and exceptions with the given tag +-- are caught using the provided handler, which expects to get the exception +-- message (EXPORTED) +-- +-- * the state observed by the exception handler is *modified* by the failed +-- state transformer upto the point where the exception was thrown (this +-- semantics is the only reasonable when it should be possible to use +-- updating for maintaining the state) +-- +catchExc :: PreCST e s a + -> (String, String -> PreCST e s a) + -> PreCST e s a +catchExc m (s, h) = CST $ StateTrans.catchExc (unpackCST m) (s, unpackCST . h) + +-- given a state transformer that may raise fatal errors and an error handler +-- for fatal errors, execute the state transformer and apply the error handler +-- when a fatal error occurs (EXPORTED) +-- +-- * fatal errors are IO monad errors and errors raised by `fatal' as well as +-- uncaught exceptions +-- +-- * the base and generic state observed by the error handler is *in contrast +-- to `catch'* the state *before* the state transformer is applied +-- +fatalsHandledBy :: PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a +fatalsHandledBy m h = CST $ StateTrans.fatalsHandledBy m' h' + where + m' = unpackCST m + h' = unpackCST . h + + +-- manipulating the error state +-- ---------------------------- + +-- the lowest level of errors is `WarningErr', but it is meaningless as long as +-- the the list of errors is empty +-- +initialErrorState :: ErrorState +initialErrorState = ErrorState WarningErr 0 [] + +-- raise an error (EXPORTED) +-- +-- * a fatal error is reported immediately; see `raiseFatal' +-- +raise :: Error -> PreCST e s () +raise err = case errorLvl err of + WarningErr -> raise0 err + ErrorErr -> raise0 err + FatalErr -> raiseFatal0 "Generic fatal error." err + +-- raise a warning (see `raiseErr') (EXPORTED) +-- +raiseWarning :: Position -> [String] -> PreCST e s () +raiseWarning pos msg = raise0 (makeError WarningErr pos msg) + +-- raise an error (see `raiseErr') (EXPORTED) +-- +raiseError :: Position -> [String] -> PreCST e s () +raiseError pos msg = raise0 (makeError ErrorErr pos msg) + +-- raise a fatal compilation error (EXPORTED) +-- +-- * the error is together with the up-to-now accumulated errors are reported +-- as part of the error message of the fatal error exception +-- +-- * the current thread of control is discarded and control is passed to the +-- innermost handler for fatal errors +-- +-- * the first argument must contain a short description of the error, while +-- the second and third argument are like the two arguments to `raise' +-- +raiseFatal :: String -> Position -> [String] -> PreCST e s a +raiseFatal short pos long = raiseFatal0 short (makeError FatalErr pos long) + +-- raise a fatal error; internal version that gets an abstract error +-- +raiseFatal0 :: String -> Error -> PreCST e s a +raiseFatal0 short err = do + raise0 err + errmsgs <- showErrors + fatal (short ++ "\n\n" ++ errmsgs) + +-- raise an error; internal version, doesn't check whether the error is fatal +-- +-- * the error is entered into the compiler state and a fatal error is +-- triggered if the `errorLimit' is reached +-- +raise0 :: Error -> PreCST e s () +raise0 err = do + noOfErrs <- CST $ transBase doRaise + when (noOfErrs >= errorLimit) $ do + errmsgs <- showErrors + fatal ("Error limit of " ++ show errorLimit + ++ " errors has been reached.\n" ++ errmsgs) + where + errorLimit = 20 + + doRaise :: BaseState e -> (BaseState e, Int) + doRaise bs = let + lvl = errorLvl err + ErrorState wlvl no errs = errorsBS bs + wlvl' = max wlvl lvl + no' = no + if lvl > WarningErr + then 1 else 0 + errs' = err : errs + in + (bs {errorsBS = (ErrorState wlvl' no' errs')}, no') + +-- yield a string containing the collected error messages (EXPORTED) +-- +-- * the error state is reset in this process +-- +showErrors :: PreCST e s String +showErrors = CST $ do + ErrorState wlvl no errs <- transBase extractErrs + return $ foldr (.) id (map showString (errsToStrs errs)) "" + where + extractErrs :: BaseState e -> (BaseState e, ErrorState) + extractErrs bs = (bs {errorsBS = initialErrorState}, + errorsBS bs) + + errsToStrs :: [Error] -> [String] + errsToStrs errs = (map showError . sort) errs + +-- inquire if there was already an error of at least level `ErrorErr' raised +-- (EXPORTED) +-- +errorsPresent :: PreCST e s Bool +errorsPresent = CST $ do + ErrorState wlvl no _ <- readBase errorsBS + return $ wlvl >= ErrorErr + + +-- manipulating the extra state +-- ---------------------------- + +-- apply a reader function to the extra state and yield the reader's result +-- (EXPORTED) +-- +readExtra :: (e -> a) -> PreCST e s a +readExtra rf = CST $ readBase (\bs -> + (rf . extraBS) bs + ) + +-- apply an update function to the extra state (EXPORTED) +-- +updExtra :: (e -> e) -> PreCST e s () +updExtra uf = CST $ transBase (\bs -> + let + es = extraBS bs + in + (bs {extraBS = uf es}, ()) + ) + + +-- name supplies +-- ------------- + +-- Get a name supply out of the base state (EXPORTED) +-- +getNameSupply :: PreCST e s NameSupply +getNameSupply = CST $ transBase (\bs -> + let + supply : supplies = suppliesBS bs + in + (bs {suppliesBS = supplies}, supply) + ) diff --git a/base/state/StateBase.hs b/base/state/StateBase.hs new file mode 100644 --- /dev/null +++ b/base/state/StateBase.hs @@ -0,0 +1,136 @@ +-- Compiler Toolkit: compiler state management basics +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 7 November 97 +-- +-- Copyright (C) [1997..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides basic types and services used to realize the state +-- management of the compiler. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * The monad `PreCST' is an instance of `STB' where the base state is fixed. +-- However, the base state itself is parametrized by an extra state +-- component that can be instantiated by the compiler that uses the toolkit +-- (to store information like compiler switches) -- this is the reason for +-- adding the prefix `Pre'. +-- +-- * The module exports the details of the `BaseState' etc as they have to be +-- know by `State'. The latter ensures the necessary abstraction for +-- modules that do not belong to the state management. +-- +-- * Due to this module, the state management modules can share internal +-- information about the data types hidden to the rest of the system. +-- +-- * The following state components are maintained: +-- +-- + errorsBS (type `ErrorState') -- keeps track of raised errors +-- + namesBS (type `NameSupply') -- provides unique names +-- + extraBS (generic type) -- extra compiler-dependent state +-- information, e.g., for compiler +-- switches +-- +--- TODO ---------------------------------------------------------------------- +-- + +module StateBase (PreCST(..), ErrorState(..), BaseState(..), + unpackCST, readCST, writeCST, transCST, liftIO) +where + +import UNames (NameSupply) +import StateTrans (STB, readGeneric, writeGeneric, transGeneric) +import qualified + StateTrans (liftIO) +import Errors (ErrorLvl(..), Error) + + +-- state used in the whole compiler +-- -------------------------------- + +-- form of the error state +-- +-- * when no error was raised yet, the error level is the lowest possible one +-- +data ErrorState = ErrorState ErrorLvl -- worst error level that was raised + Int -- number of errors (excl warnings) + [Error] -- already raised errors + +-- base state (EXPORTED) +-- +data BaseState e = BaseState { + errorsBS :: ErrorState, + suppliesBS :: [NameSupply], + extraBS :: e -- extra state + } + +-- the compiler state transformer (EXPORTED) +-- + +newtype PreCST e s a = CST (STB (BaseState e) s a) + +instance Monad (PreCST e s) where + return = yield + (>>=) = (+>=) + + +-- unwrapper coercion function (EXPORTED) +-- +unpackCST :: PreCST e s a -> STB (BaseState e) s a +unpackCST m = let CST m' = m in m' + + +-- monad operations +-- ---------------- + +-- the monad's unit +-- +yield :: a -> PreCST e s a +yield a = CST $ return a + +-- the monad's bind +-- +(+>=) :: PreCST e s a -> (a -> PreCST e s b) -> PreCST e s b +m +>= k = CST $ unpackCST m >>= (\a -> unpackCST (k a)) + + +-- generic state manipulation +-- -------------------------- + +-- given a reader function for the state, wrap it into an CST monad (EXPORTED) +-- +readCST :: (s -> a) -> PreCST e s a +readCST f = CST $ readGeneric f + +-- given a new state, inject it into an CST monad (EXPORTED) +-- +writeCST :: s -> PreCST e s () +writeCST s' = CST $ writeGeneric s' + +-- given a transformer function for the state, wrap it into an CST monad +-- (EXPORTED) +-- +transCST :: (s -> (s, a)) -> PreCST e s a +transCST f = CST $ transGeneric f + +-- interaction with the encapsulated `IO' monad +-- -------------------------------------------- + +-- lifts an `IO' state transformer into `CST' +-- +liftIO :: IO a -> PreCST e s a +liftIO m = CST $ (StateTrans.liftIO m) diff --git a/base/state/StateTrans.hs b/base/state/StateTrans.hs new file mode 100644 --- /dev/null +++ b/base/state/StateTrans.hs @@ -0,0 +1,303 @@ +-- The HiPar Toolkit: state transformer routines +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 3 March 95 +-- +-- Copyright (C) [1995..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides basic support for the use of state transformers. +-- The state transformer is build around the `IO' monad to allow the +-- manipulation of external state. It encapsulated two separate states with +-- the intention to use the first one for the omnipresent compiler state +-- consisting of the accumulated error messages etc. and to use the second as +-- a generic component that can be used in different ways by the different +-- phases of the compiler. +-- +-- The module also supports the use of exceptions and fatal errors. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * We explicitly do not use any names for the monad types and functions +-- that are used by either Haskell's `IO' monad or GHC's `ST' monad. Since +-- Haskell 1.4, `STB' is an instance of the `Monad' constructor class. +-- +-- * To integrate the Haskell prelude `IO' monad into our `STB' monad we use +-- the technique from ``Composing monads'' by Mark P. Jones and Luc +-- Duponcheel (Report YALEU/DCS/RR-1004) from 1993, Section 8. +-- +-- * The use of GHC's inplace-update goodies within monads of kind `STB' is +-- possible, bacause `IO' is based on `ST' in the GHC. +-- +-- * In the following, we call the two kinds of state managed by the `STB' the +-- base state (the omnipresent state of the compiler) and generic state. +-- +-- * `STB' is a newtype, which requires careful wrapping and unwrapping of its +-- values in the following definitions. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * with constructor classes, the state transformer business can be made +-- more elegant (they weren't around when this module was initially written) +-- +-- * it would be possible to maintain the already applied changes to the base +-- and generic state even in the case of a fatal error, when in `listIO' +-- every IO operation is encapsulated into a handler that transforms IO +-- errors into exceptions +-- + +module StateTrans (-- the monad and the generic operations + -- + STB, + -- + -- monad specific operations + -- + readBase, writeBase, transBase, readGeneric, writeGeneric, + transGeneric, liftIO, runSTB, interleave, + -- + -- exception handling and fatal errors + -- + throwExc, fatal, catchExc, fatalsHandledBy) +where + + +-- BEWARE! You enter monad country. Read any of Wadler's or +-- Launchbury/Peyton-Jones' texts before entering. Otherwise, +-- your mental health my be in danger. You have been warned! + + +-- state transformer base and its monad operations +-- ----------------------------------------------- + +-- the generic form of a state transformer using the external state represented +-- by `IO'; `STB' is a abbreviation for state transformer base +-- +-- the first state component `bs' is provided for the omnipresent compiler +-- state and the, second, `gs' for the generic component +-- +-- the third component of the result distinguishes between erroneous and +-- successful computations where +-- +-- `Left (tag, msg)' -- stands for an exception identified by `tag' with +-- error message `msg', and +-- `Right a' -- is a successfully delivered result +-- + +newtype STB bs gs a = STB (bs -> gs -> IO (bs, gs, Either (String, String) a)) + +instance Monad (STB bs gs) where + return = yield + (>>=) = (+>=) + +-- the monad's unit +-- +yield :: a -> STB bs gs a +yield a = STB $ \bs gs -> return (bs, gs, Right a) + +-- the monad's bind +-- +-- * exceptions are propagated +-- +(+>=) :: STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b +m +>= k = let + STB m' = m + in + STB $ \bs gs -> m' bs gs >>= \(bs', gs', res) -> + case res of + Left exc -> return (bs', gs', Left exc) -- prop exc + Right a -> let + STB k' = k a + in + k' bs' gs' -- cont + + +-- generic state manipulation +-- -------------------------- + +-- base state: +-- + +-- given a reader function for the base state, wrap it into an STB monad +-- +readBase :: (bs -> a) -> STB bs gs a +readBase f = STB $ \bs gs -> return (bs, gs, Right (f bs)) + +-- given a new base state, inject it into an STB monad +-- +writeBase :: bs -> STB bs gs () +writeBase bs' = STB $ \_ gs -> return (bs', gs, Right ()) + +-- given a transformer function for the base state, wrap it into an STB monad +-- +transBase :: (bs -> (bs, a)) -> STB bs gs a +transBase f = STB $ \bs gs -> let + (bs', a) = f bs + in + return (bs', gs, Right a) + +-- generic state: +-- + +-- given a reader function for the generic state, wrap it into an STB monad +-- +readGeneric :: (gs -> a) -> STB bs gs a +readGeneric f = STB $ \bs gs -> return (bs, gs, Right (f gs)) + +-- given a new generic state, inject it into an STB monad +-- +writeGeneric :: gs -> STB bs gs () +writeGeneric gs' = STB $ \bs _ -> return (bs, gs', Right ()) + +-- given a transformer function for the generic state, wrap it into an STB +-- monad +-- +transGeneric :: (gs -> (gs, a)) -> STB bs gs a +transGeneric f = STB $ \bs gs -> let + (gs', a) = f gs + in + return (bs, gs', Right a) + + +-- interaction with the encapsulated `IO' monad +-- -------------------------------------------- + +-- lifts an `IO' state transformer into `STB' +-- +liftIO :: IO a -> STB bs gs a +liftIO m = STB $ \bs gs -> m >>= \r -> return (bs, gs, Right r) + +-- given an initial state, executes the `STB' state transformer yielding an +-- `IO' state transformer that must be placed into the context of the external +-- IO +-- +-- * uncaught exceptions become fatal errors +-- +runSTB :: STB bs gs a -> bs -> gs -> IO a +runSTB m bs gs = let + STB m' = m + in + m' bs gs >>= \(_, _, res) -> + case res of + Left (tag, msg) -> let + err = userError ("Exception `" + ++ tag ++ "': " + ++ msg) + in + ioError err + Right a -> return a + +-- interleave the (complete) execution of an `STB' with another generic state +-- component into an `STB' +-- +interleave :: STB bs gs' a -> gs' -> STB bs gs a +interleave m gs' = STB $ let + STB m' = m + in + \bs gs + -> (m' bs gs' >>= \(bs', _, a) -> return (bs', gs, a)) + + +-- error and exception handling +-- ---------------------------- + +-- * we exploit the `UserError' component of `IOError' for fatal errors +-- +-- * we distinguish exceptions and user-defined fatal errors +-- +-- - exceptions are meant to be caught in order to recover the currently +-- executed operation; they turn into fatal errors if they are not caught; +-- execeptions are tagged, which allows to deal with multiple kinds of +-- execeptions at the same time and to handle them differently +-- - user-defined fatal errors abort the currently executed operation, but +-- they may be caught at the top-level in order to terminate gracefully or +-- to invoke another operation; there is no special support for different +-- handling of different kinds of fatal-errors +-- +-- * the costs for fatal error handling are already incurred by the `IO' monad; +-- the costs for exceptions mainly is the case distinction in the definition +-- of `+>=' +-- + +-- throw an exception with the given tag and message (EXPORTED) +-- +throwExc :: String -> String -> STB bs gs a +throwExc tag msg = STB $ \bs gs -> return (bs, gs, Left (tag, msg)) + +-- raise a fatal user-defined error (EXPORTED) +-- +-- * such an error my be caught and handled using `fatalsHandeledBy' +-- +fatal :: String -> STB bs gs a +fatal s = liftIO (ioError (userError s)) + +-- the given state transformer is executed and exceptions with the given tag +-- are caught using the provided handler, which expects to get the exception +-- message (EXPORTED) +-- +-- * the base and generic state observed by the exception handler is *modified* +-- by the failed state transformer upto the point where the exception was +-- thrown (this semantics is the only reasonable when it should be possible +-- to use updating for maintaining the state) +-- +catchExc :: STB bs gs a + -> (String, String -> STB bs gs a) + -> STB bs gs a +catchExc m (tag, handler) = + STB $ \bs gs + -> let + STB m' = m + in + m' bs gs >>= \state@(bs', gs', res) -> + case res of + Left (tag', msg) -> if (tag == tag') -- exception with... + then + let + STB handler' = handler msg + in + handler' bs' gs' -- correct tag, catch + else + return state -- wrong tag, rethrow + Right _ -> return state -- no exception + +-- given a state transformer that may raise fatal errors and an error handler +-- for fatal errors, execute the state transformer and apply the error handler +-- when a fatal error occurs (EXPORTED) +-- +-- * fatal errors are IO monad errors and errors raised by `fatal' as well as +-- uncaught exceptions +-- +-- * the base and generic state observed by the error handler is *in contrast +-- to `catch'* the state *before* the state transformer is applied +-- +fatalsHandledBy :: STB bs gs a -> (IOError -> STB bs gs a) -> STB bs gs a +fatalsHandledBy m handler = + STB $ \bs gs + -> (let + STB m' = m + in + m' bs gs >>= \state@(gs', bs', res) -> + case res of + Left (tag, msg) -> let + err = userError ("Exception `" ++ tag + ++ "': " ++ msg) + in + ioError err + Right a -> return state + ) + `catch` (\err -> let + STB handler' = handler err + in + handler' bs gs) diff --git a/base/syms/Attributes.hs b/base/syms/Attributes.hs new file mode 100644 --- /dev/null +++ b/base/syms/Attributes.hs @@ -0,0 +1,390 @@ +-- Compiler Toolkit: general purpose attribute management +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 14 February 95 +-- +-- Copyright (c) [1995..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides an abstract notion of attributes (in the sense of +-- compiler construction). The collection of attributes that is attached to a +-- single node of the structure tree is referenced via an attributes +-- identifier. This is basically a reference into so-called attribute tables, +-- which manage attributes of one type and may use different representations. +-- There is also a position attribute managed via the attribute identifier +-- without needing a further table (it is already fixed on construction of +-- the structure tree). +-- +-- The `Attributed' class is based on a suggestion from Roman Lechtchinsky. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * Attribute identifiers are generated during parsing and whenever new +-- structure tree elements, possibly due to transformations, are generated. +-- +-- * New attributes can be added by simply providing a new attribute table +-- indexed by the attribute identifiers. Thus, adding or discarding an +-- attribute does not involve any change in the structure tree. +-- +-- * Consecutive sequences of names are used as attribute identifiers to +-- facilitate the use of arrays for attributes that are fixed; speeds up +-- read access. (See also TODO.) +-- +-- * Each attribute table can simultaneously provide melted (updatable) and +-- frozen (non-updatable) attributes. It also allows to dynamically grow the +-- table, i.e., cover a wider range of attribute identifiers. +-- +-- * There is a variant merely providing a position, which is used for +-- internal identifiers and such. +-- +-- * `StdAttr' provides standard undefined and don't care variants for +-- attribute values. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * When there are sparse attribute tables that we want to freeze (and they +-- will occur sooner or later), then introduce a third variant of tables +-- realized via hash table---depending on the type of attribute table, we +-- may even allow them to be soft. +-- +-- NOTE: Currently, if assertions are switched on, on freezing a table, its +-- density is calculate and, if it is below 33%, an internal error is +-- raised (only if there are more than 1000 entries in the table). +-- +-- * check whether it would increase the performance significantly if we use +-- a mixed finite map/array representation for soft tables (all attributes +-- defined before the last `soften' could be held in the array, changing +-- an attribute just means to update it in the FM; i.e., the FM entries take +-- precedence over the array entries) +-- + +module Attributes (-- attribute management + -- + Attrs, newAttrsOnlyPos, newAttrs, + Attributed(attrsOf), eqOfAttrsOf, posOfAttrsOf, + -- + -- attributes and attribute tables + -- + Attr(undef, isUndef, dontCare, isDontCare), + AttrTable, newAttrTable, getAttr, setAttr, updAttr, + copyAttr, freezeAttrTable, softenAttrTable, + StdAttr(..), getStdAttr, getStdAttrDft, isDontCareStdAttr, + isUndefStdAttr, setStdAttr, updStdAttr, + getGenAttr, setGenAttr, updGenAttr) +where + +import Data.Array +import Control.Exception (assert) +import Position (Position, Pos(posOf)) +import Errors (interr) +import UNames (Name) +import qualified Data.Map as Map (fromList, toList, insert, findWithDefault, empty) +import Data.Map (Map) + + +-- attribute management data structures and operations +-- --------------------------------------------------- + +-- abstract data structure used in the structure tree to represent the +-- attribute identifier and the position (EXPORTED) +-- +data Attrs = OnlyPos Position -- only pos (for internal stuff only) + | Attrs Position Name -- pos and unique name + +-- get the position associated with an attribute identifier (EXPORTED) +-- +instance Pos Attrs where + posOf (OnlyPos pos ) = pos + posOf (Attrs pos _) = pos + +-- equality of attributes is used to define the equality of objects (EXPORTED) +-- +instance Eq Attrs where + (Attrs _ id1) == (Attrs _ id2) = id1 == id2 + _ == _ = + interr "Attributes: Attempt to compare `OnlyPos' attributes!" + +-- attribute ordering is also lifted to objects (EXPORTED) +-- +instance Ord Attrs where + (Attrs _ id1) <= (Attrs _ id2) = id1 <= id2 + _ <= _ = + interr "Attributes: Attempt to compare `OnlyPos' attributes!" + +-- a class for convenient access to the attributes of an attributed object +-- (EXPORTED) +-- +class Attributed a where + attrsOf :: a -> Attrs + +-- equality induced by attribution (EXPORTED) +-- +eqOfAttrsOf :: Attributed a => a -> a -> Bool +eqOfAttrsOf obj1 obj2 = (attrsOf obj1) == (attrsOf obj2) + +-- position induced by attribution (EXPORTED) +-- +posOfAttrsOf :: Attributed a => a -> Position +posOfAttrsOf = posOf . attrsOf + + +-- attribute identifier creation +-- ----------------------------- + +-- Given only a source position, create a new attribute identifier (EXPORTED) +-- +newAttrsOnlyPos :: Position -> Attrs +newAttrsOnlyPos pos = OnlyPos pos + +-- Given a source position and a unique name, create a new attribute +-- identifier (EXPORTED) +-- +newAttrs :: Position -> Name -> Attrs +newAttrs pos name = Attrs pos name + + +-- attribute tables and operations on them +-- --------------------------------------- + +-- the type class `Attr' determines which types may be used as attributes +-- (EXPORTED) +-- +-- * such types have to provide values representing an undefined and a don't +-- care state, together with two functions to test for these values +-- +-- * an attribute in an attribute table is initially set to `undef' (before +-- some value is assigned to it) +-- +-- * an attribute with value `dontCare' participated in an already detected +-- error, it's value may not be used for further computations in order to +-- avoid error avalanches +-- +class Attr a where + undef :: a + isUndef :: a -> Bool + dontCare :: a + isDontCare :: a -> Bool + undef = interr "Attributes: Undefined `undef' method in `Attr' class!" + isUndef = interr "Attributes: Undefined `isUndef' method in `Attr' \ + \class!" + dontCare = interr "Attributes: Undefined `dontCare' method in `Attr' \ + \class!" + isDontCare = interr "Attributes: Undefined `isDontCare' method in `Attr' \ + \class!" + +-- attribute tables map attribute identifiers to attribute values +-- (EXPORTED ABSTRACT) +-- +-- * the attributes within a table can be soft or frozen, the former may by be +-- updated, but the latter can not be changed +-- +-- * the attributes in a frozen table are stored in an array for fast +-- lookup; consequently, the attribute identifiers must be *dense* +-- +-- * the table description string is used to emit better error messages (for +-- internal errors) +-- +data Attr a => + AttrTable a = -- for all attribute identifiers not contained in the + -- finite map the value is `undef' + -- + SoftTable (Map Name a) -- updated attr.s + String -- desc of the table + + -- the array contains `undef' attributes for the undefined + -- attributes; for all attribute identifiers outside the + -- bounds, the value is also `undef'; + -- + | FrozenTable (Array Name a) -- attribute values + String -- desc of the table + + + +-- create an attribute table, where all attributes are `undef' (EXPORTED) +-- +-- the description string is used to identify the table in error messages +-- (internal errors); a table is initially soft +-- +newAttrTable :: Attr a => String -> AttrTable a +newAttrTable desc = SoftTable Map.empty desc + +-- get the value of an attribute from the given attribute table (EXPORTED) +-- +getAttr :: Attr a => AttrTable a -> Attrs -> a +getAttr at (OnlyPos pos ) = onlyPosErr "getAttr" at pos +getAttr at (Attrs _ aid) = + case at of + (SoftTable fm _) -> Map.findWithDefault undef aid fm + (FrozenTable arr _) -> let (lbd, ubd) = bounds arr + in + if (aid < lbd || aid > ubd) then undef else arr!aid + +-- set the value of an, up to now, undefined attribute from the given +-- attribute table (EXPORTED) +-- +setAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a +setAttr at (OnlyPos pos ) av = onlyPosErr "setAttr" at pos +setAttr at (Attrs pos aid) av = + case at of + (SoftTable fm desc) -> assert (isUndef (Map.findWithDefault undef aid fm)) $ + SoftTable (Map.insert aid av fm) desc + (FrozenTable arr _) -> interr frozenErr + where + frozenErr = "Attributes.setAttr: Tried to write frozen attribute in\n" + ++ errLoc at pos + +-- update the value of an attribute from the given attribute table (EXPORTED) +-- +updAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a +updAttr at (OnlyPos pos ) av = onlyPosErr "updAttr" at pos +updAttr at (Attrs pos aid) av = + case at of + (SoftTable fm desc) -> SoftTable (Map.insert aid av fm) desc + (FrozenTable arr _) -> interr $ "Attributes.updAttr: Tried to\ + \ update frozen attribute in\n" + ++ errLoc at pos + +-- copy the value of an attribute to another one (EXPORTED) +-- +-- * undefined attributes are not copied, to avoid filling the table +-- +copyAttr :: Attr a => AttrTable a -> Attrs -> Attrs -> AttrTable a +copyAttr at ats ats' + | isUndef av = assert (isUndef (getAttr at ats')) + at + | otherwise = updAttr at ats' av + where + av = getAttr at ats + +-- auxiliary functions for error messages +-- +onlyPosErr :: Attr a => String -> AttrTable a -> Position -> b +onlyPosErr fctName at pos = + interr $ "Attributes." ++ fctName ++ ": No attribute identifier in\n" + ++ errLoc at pos +-- +errLoc :: Attr a => AttrTable a -> Position -> String +errLoc at pos = " table `" ++ tableDesc at ++ "' for construct at\n\ + \ position " ++ show pos ++ "!" + where + tableDesc (SoftTable _ desc) = desc + tableDesc (FrozenTable _ desc) = desc + +-- freeze a soft table; afterwards no more changes are possible until the +-- table is softened again (EXPORTED) +-- +freezeAttrTable :: Attr a => AttrTable a -> AttrTable a +freezeAttrTable (SoftTable fm desc) = + let contents = Map.toList fm + keys = map fst contents + lbd = minimum keys + ubd = maximum keys + in + assert (length keys < 1000 || (length . range) (lbd, ubd) > 3 * length keys) + (FrozenTable (array (lbd, ubd) contents) desc) +freezeAttrTable (FrozenTable arr desc) = + interr ("Attributes.freezeAttrTable: Attempt to freeze the already frozen\n\ + \ table `" ++ desc ++ "'!") + +-- soften a frozen table; afterwards changes are possible until the +-- table is frozen again (EXPORTED) +-- +softenAttrTable :: Attr a => AttrTable a -> AttrTable a +softenAttrTable (SoftTable fm desc) = + interr ("Attributes.softenAttrTable: Attempt to soften the already \ + \softened\n table `" ++ desc ++ "'!") +softenAttrTable (FrozenTable arr desc) = + SoftTable (Map.fromList . assocs $ arr) desc + + +-- standard attributes +-- ------------------- + +-- standard attribute variants (EXPORTED) +-- +data StdAttr a = UndefStdAttr + | DontCareStdAttr + | JustStdAttr a + +instance Attr (StdAttr a) where + undef = UndefStdAttr + + isUndef UndefStdAttr = True + isUndef _ = False + + dontCare = DontCareStdAttr + + isDontCare DontCareStdAttr = True + isDontCare _ = False + +-- get an attribute value from a standard attribute table (EXPORTED) +-- +-- * if the attribute can be "don't care", this should be checked before +-- calling this function (using `isDontCareStdAttr') +-- +getStdAttr :: AttrTable (StdAttr a) -> Attrs -> a +getStdAttr atab at = getStdAttrDft atab at err + where + err = interr $ "Attributes.getStdAttr: Don't care in\n" + ++ errLoc atab (posOf at) + +-- get an attribute value from a standard attribute table, where a default is +-- substituted if the table is don't care (EXPORTED) +-- +getStdAttrDft :: AttrTable (StdAttr a) -> Attrs -> a -> a +getStdAttrDft atab at dft = + case getAttr atab at of + DontCareStdAttr -> dft + JustStdAttr av -> av + UndefStdAttr -> interr $ "Attributes.getStdAttrDft: Undefined in\n" + ++ errLoc atab (posOf at) + +-- check if the attribue value is marked as "don't care" (EXPORTED) +-- +isDontCareStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool +isDontCareStdAttr atab at = isDontCare (getAttr atab at) + +-- check if the attribue value is still undefined (EXPORTED) +-- +-- * we also regard "don't care" attributes as undefined +-- +isUndefStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool +isUndefStdAttr atab at = isUndef (getAttr atab at) + +-- set an attribute value in a standard attribute table (EXPORTED) +-- +setStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a) +setStdAttr atab at av = setAttr atab at (JustStdAttr av) + +-- update an attribute value in a standard attribute table (EXPORTED) +-- +updStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a) +updStdAttr atab at av = updAttr atab at (JustStdAttr av) + + +-- generic attribute table access (EXPORTED) +-- ------------------------------ + +getGenAttr :: (Attr a, Attributed obj) => AttrTable a -> obj -> a +getGenAttr atab at = getAttr atab (attrsOf at) + +setGenAttr :: (Attr a, Attributed obj) + => AttrTable a -> obj -> a -> AttrTable a +setGenAttr atab at av = setAttr atab (attrsOf at) av + +updGenAttr :: (Attr a, Attributed obj) + => AttrTable a -> obj -> a -> AttrTable a +updGenAttr atab at av = updAttr atab (attrsOf at) av diff --git a/base/syms/Idents.hs b/base/syms/Idents.hs new file mode 100644 --- /dev/null +++ b/base/syms/Idents.hs @@ -0,0 +1,153 @@ +-- Compiler Toolkit: identifiers +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 14 February 95 +-- +-- Copyright (c) [1995..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides an abstract notion of identifiers. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * We speed up the equality test between identifiers by keeping a hash +-- +-- * The ordering relation on identifiers is also based on the hash and, +-- hence, does *not* follow the alphanumerical ordering of the lexemes of +-- the identifiers. Instead, it provides a fast ordering when identifiers +-- are used as keys in a `FiniteMap'. +-- +-- * Attributes may be associated to identifiers, except with `OnlyPos' +-- identifiers, which have a position as their only attribute (they do not +-- carry an attribute identifier, which can be used to index attribute +-- tables). +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * Hashing is not 8bit clean. +-- + +module Idents (Ident, lexemeToIdent, internalIdent, + onlyPosIdent, identToLexeme, getIdentAttrs) +where + +import Data.Char +import Position (Position, Pos(posOf), nopos) +import UNames (Name) +import Errors (interr) +import Attributes (Attrs, newAttrsOnlyPos, newAttrs, + Attributed(attrsOf), posOfAttrsOf) + + +-- simple identifier representation (EXPORTED) +-- +data Ident = Ident String -- lexeme + {-# UNBOXED #-} !Int -- hash to speed up equality check + Attrs -- attributes of this ident. incl. position + +-- the definition of the equality allows identifiers to be equal that are +-- defined at different source text positions, and aims at speeding up the +-- equality test, by comparing the lexemes only if the two numbers are equal +-- +instance Eq Ident where + (Ident s h _) == (Ident s' h' _) = (h == h') && (s == s') + +-- this does *not* follow the alphanumerical ordering of the lexemes +-- +instance Ord Ident where + compare (Ident s h _) (Ident s' h' _) = compare (h, s) (h', s') + +-- for displaying identifiers +-- +instance Show Ident where + showsPrec _ ide = showString ("`" ++ identToLexeme ide ++ "'") + +-- identifiers are attributed +-- +instance Attributed Ident where + attrsOf (Ident _ _ at) = at + +-- identifiers have a canonical position +-- +instance Pos Ident where + posOf = posOfAttrsOf + +-- to speed up the equality test we compute some hash-like value for each +-- identifiers lexeme and store it in the identifiers representation + +-- hash function from the dragon book pp437; assumes 7 bit characters and needs +-- the (nearly) full range of values guaranteed for `Int' by the Haskell +-- language definition; can handle 8 bit characters provided we have 29 bit +-- for the `Int's without sign +-- +quad :: String -> Int +quad (c1:c2:c3:c4:s) = ((ord c4 * bits21 + + ord c3 * bits14 + + ord c2 * bits7 + + ord c1) + `mod` bits28) + + (quad s `mod` bits28) +quad (c1:c2:c3:[] ) = ord c3 * bits14 + ord c2 * bits7 + ord c1 +quad (c1:c2:[] ) = ord c2 * bits7 + ord c1 +quad (c1:[] ) = ord c1 +quad ([] ) = 0 + +bits7 = 2^7 +bits14 = 2^14 +bits21 = 2^21 +bits28 = 2^28 + +-- given the lexeme of an identifier, yield the abstract identifier (EXPORTED) +-- +-- * the only attribute of the resulting identifier is its source text +-- position; as provided in the first argument of this function +-- +-- * only minimal error checking, e.g., the characters of the identifier are +-- not checked for being alphanumerical only; the correct lexis of the +-- identifier should be ensured by the caller, e.g., the scanner. +-- +-- * for reasons of simplicity the complete lexeme is hashed (with `quad') +-- +lexemeToIdent :: Position -> String -> Name -> Ident +lexemeToIdent pos s name = Ident s (quad s) (newAttrs pos name) + +-- generate an internal identifier (has no position and cannot be asccociated +-- with attributes) (EXPORTED) +-- +internalIdent :: String -> Ident +internalIdent s = Ident s (quad s) (newAttrsOnlyPos nopos) + +-- generate a `only pos' identifier (may not be used to index attribute +-- tables, but has a position value) (EXPORTED) +-- +onlyPosIdent :: Position -> String -> Ident +onlyPosIdent pos s = Ident s (quad s) (newAttrsOnlyPos pos) + +-- given an abstract identifier, yield its lexeme (EXPORTED) +-- +identToLexeme :: Ident -> String +identToLexeme (Ident s _ _) = s + +-- get the attribute identifier associated with the given identifier (EXPORTED) +-- +getIdentAttrs :: Ident -> Attrs +getIdentAttrs (Ident _ _ as) = as + +-- dump the lexeme and its positions into a string for debugging purposes +-- (EXPORTED) +-- +dumpIdent :: Ident -> String +dumpIdent ide = identToLexeme ide ++ " at " ++ show (posOf ide) diff --git a/base/syms/NameSpaces.hs b/base/syms/NameSpaces.hs new file mode 100644 --- /dev/null +++ b/base/syms/NameSpaces.hs @@ -0,0 +1,144 @@ +-- Compiler Toolkit: name space management +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 12 November 95 +-- +-- Copyright (c) [1995..1999] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module manages name spaces. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * A name space associates identifiers with their definition. +-- +-- * Each name space is organized in a hierarchical way using the notion of +-- ranges. A name space, at any moment, always has a global range and may +-- have several local ranges. Definitions in inner ranges hide definitions +-- of the same identifiert in outer ranges. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * evaluate the performance gain that a hashtable would bring +-- + +module NameSpaces (NameSpace, nameSpace, defGlobal, enterNewRange, leaveRange, + defLocal, find, nameSpaceToList) +where + +import qualified Data.Map as Map (empty, insert, lookup, toList) +import Data.Map (Map) +import Idents (Ident) +import Errors (interr) + + +-- name space (EXPORTED ABSTRACT) +-- +-- * the definitions in the global ranges are stored in a finite map, because +-- they tend to be a lot and are normally not updated after the global range +-- is constructed +-- +-- * the definitions of the local ranges are stored in a single list, usually +-- they are not very many and the definitions entered last are the most +-- frequently accessed ones; the list structure naturally hides older +-- definitions, i.e., definitions from outer ranges; adding new definitions +-- is done in time proportinal to the current size of the range; removing a +-- range is done in constant time (and the definitions of a range can be +-- returned as a result of leaving the range); lookup is proportional to the +-- number of definitions in the local ranges and the logarithm of the number +-- of definitions in the global range---i.e., efficiency relies on a +-- relatively low number of local definitions together with frequent lookup +-- of the most recently defined local identifiers +-- +data NameSpace a = NameSpace (Map Ident a) -- defs in global range + [[(Ident, a)]] -- stack of local ranges + +-- create a name space (EXPORTED) +-- +nameSpace :: NameSpace a +nameSpace = NameSpace Map.empty [] + +-- add global definition (EXPORTED) +-- +-- * returns the modfied name space +-- +-- * if the identfier is already declared, the resulting name space contains +-- the new binding and the second component of the result contains the +-- definition declared previosuly (which is henceforth not contained in the +-- name space anymore) +-- +defGlobal :: NameSpace a -> Ident -> a -> (NameSpace a, Maybe a) +defGlobal (NameSpace gs lss) id def = (NameSpace (Map.insert id def gs) lss, + Map.lookup id gs) + +-- add new range (EXPORTED) +-- +enterNewRange :: NameSpace a -> NameSpace a +enterNewRange (NameSpace gs lss) = NameSpace gs ([]:lss) + +-- pop topmost range and return its definitions (EXPORTED) +-- +leaveRange :: NameSpace a -> (NameSpace a, [(Ident, a)]) +leaveRange (NameSpace gs []) = interr "NameSpaces.leaveRange: \ + \No local range!" +leaveRange (NameSpace gs (ls:lss)) = (NameSpace gs lss, ls) + +-- add local definition (EXPORTED) +-- +-- * returns the modfied name space +-- +-- * if there is no local range, the definition is entered globally +-- +-- * if the identfier is already declared, the resulting name space contains +-- the new binding and the second component of the result contains the +-- definition declared previosuly (which is henceforth not contained in the +-- name space anymore) +-- +defLocal :: NameSpace a -> Ident -> a -> (NameSpace a, Maybe a) +defLocal ns@(NameSpace gs [] ) id def = defGlobal ns id def +defLocal (NameSpace gs (ls:lss)) id def = + (NameSpace gs (((id, def):ls):lss), + lookup ls) + where + lookup [] = Nothing + lookup ((id', def):ls) | id == id' = Just def + | otherwise = lookup ls + +-- search for a definition (EXPORTED) +-- +-- * the definition from the innermost range is returned, if any +-- +find :: NameSpace a -> Ident -> Maybe a +find (NameSpace gs lss) id = case (lookup lss) of + Nothing -> Map.lookup id gs + Just def -> Just def + where + lookup [] = Nothing + lookup (ls:lss) = case (lookup' ls) of + Nothing -> lookup lss + Just def -> Just def + + lookup' [] = Nothing + lookup' ((id', def):ls) + | id' == id = Just def + | otherwise = lookup' ls + +-- dump a name space into a list (EXPORTED) +-- +-- * local ranges are concatenated +-- +nameSpaceToList :: NameSpace a -> [(Ident, a)] +nameSpaceToList (NameSpace gs lss) = Map.toList gs ++ concat lss diff --git a/base/syntax/Lexers.hs b/base/syntax/Lexers.hs new file mode 100644 --- /dev/null +++ b/base/syntax/Lexers.hs @@ -0,0 +1,518 @@ +-- Compiler Toolkit: Self-optimizing lexers +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 2 March 99 +-- +-- Copyright (c) 1999 Manuel M. T. Chakravarty +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Library General Public +-- License as published by the Free Software Foundation; either +-- version 2 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Library General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Self-optimizing lexer combinators. +-- +-- For detailed information, see ``Lazy Lexing is Fast'', Manuel +-- M. T. Chakravarty, in A. Middeldorp and T. Sato, editors, Proceedings of +-- Fourth Fuji International Symposium on Functional and Logic Programming, +-- Springer-Verlag, LNCS 1722, 1999. (See my Web page for details.) +-- +-- Thanks to Simon L. Peyton Jones and Roman +-- Lechtchinsky for their helpful suggestions that +-- improved the design of this library. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- The idea is to combine the benefits of off-line generators with +-- combinators like in `Parsers.hs' (which builds on Swierstra/Duponcheel's +-- technique for self-optimizing parser combinators). In essence, a state +-- transition graph representing a lexer table is computed on the fly, to +-- make lexing deterministic and based on cheap table lookups. +-- +-- Regular expression map to Haskell expressions as follows. If `x' and `y' +-- are regular expressions, +-- +-- -> epsilon +-- xy -> x +> y +-- x*y -> x `star` y +-- x+y -> x `plus` y +-- x?y -> x `quest` y +-- +-- Given such a Haskelized regular expression `hre', we can use +-- +-- (1) hre `lexaction` \lexeme -> Nothing +-- (2) hre `lexaction` \lexeme -> Just token +-- (3) hre `lexmeta` \lexeme pos s -> (res, pos', s', Nothing) +-- (4) hre `lexmeta` \lexeme pos s -> (res, pos', s', Just l) +-- +-- where `epsilon' is required at the end of `hre' if it otherwise ends on +-- `star', `plus', or `quest', and then, we have +-- +-- (1) discards `lexeme' accepted by `hre', +-- (2) turns the `lexeme' accepted by `hre' into a token, +-- (3) while discarding the lexeme accepted by `hre', transforms the +-- position and/or user state, and +-- (4) while discarding the lexeme accepted by `hre', transforms the +-- position and/or user state and returns a lexer to be used for the +-- next lexeme. +-- +-- The component `res' in case of a meta action, can be `Nothing', `Just +-- (Left err)', or `Just (Right token)' to return nothing, an error, or a +-- token from a meta action, respectively. +-- +-- * By adding `ctrlLexer', `Positions' are properly handled in the presence +-- of layout control characters. +-- +-- * This module makes essential use of graphical data structures (for +-- representing the state transition graph) and laziness (for maintaining +-- the last action in `execLexer'. +-- +-- NOTES: +-- +-- * In this implementation, the combinators `quest`, `star`, and `plus` are +-- *right* associative - this was different in the ``Lazy Lexing is Fast'' +-- paper. This change was made on a suggestion by Martin Norbäck +-- . +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * error correction is missing +-- +-- * in (>||<) in the last case, `(addBoundsNum bn bn')' is too simple, as +-- the number of outgoing edges is not the sum of the numbers of the +-- individual states when there are conflicting edges, ie, ones labeled +-- with the same character; however, the number is only used to decide a +-- heuristic, so it is questionable whether it is worth spending the +-- additional effort of computing the accurate number +-- +-- * Unicode posses a problem as the character domain becomes too big for +-- using arrays to represent transition tables and even sparse structures +-- will posse a significant overhead when character ranges are naively +-- represented. So, it might be time for finite maps again. +-- +-- Regarding the character ranges, there seem to be at least two +-- possibilities. Doaitse explicitly uses ranges and avoids expanding +-- them. The problem with this approach is that we may only have +-- predicates such as `isAlphaNum' to determine whether a givne character +-- belongs to some character class. From this representation it is +-- difficult to efficiently compute a range. The second approach, as +-- proposed by Tom Pledger (on the Haskell list) +-- would be to actually use predicates directly and make the whole business +-- efficient by caching predicate queries. In other words, for any given +-- character after we have determined (in a given state) once what the +-- following state on accepting that character is, we need not consult the +-- predicates again if we memorise the successor state the first time +-- around. +-- +-- * Ken Shan writes ``Section 4.3 of your paper +-- computes the definition +-- +-- re1 `star` re2 = \l' -> let self = re1 self >||< re2 l' in self +-- +-- If we let re2 = epsilon, we get +-- +-- many :: Regexp s t -> Regexp s t +-- many re = \l' -> let self = re1 self >||< l' in self +-- +-- since epsilon = id.'' This should actually be as good as the current +-- definiton and it might be worthwhile to offer it as a variant. +-- + +module Lexers (Regexp, Lexer, Action, epsilon, char, (+>), lexaction, + lexactionErr, lexmeta, (>|<), (>||<), ctrlChars, ctrlLexer, + star, plus, quest, alt, string, LexerState, execLexer) +where + +import Data.Maybe (fromMaybe) +import Data.Array (Array, (!), assocs, accumArray) + +import Position (Position(..), incPos, tabPos, retPos) +import DLists (zeroDL, snocDL, closeDL) +import Errors (interr, ErrorLvl(..), Error, makeError) + + +infixr 4 `quest`, `star`, `plus` +infixl 3 +>, `lexaction`, `lexmeta` +infixl 2 >|<, >||< + + +-- constants +-- --------- + +-- we use the dense representation if a table has at least the given number of +-- (non-error) elements +-- +denseMin :: Int +denseMin = 20 + + +-- data structures +-- --------------- + +-- represents the number of (non-error) elements and the bounds of a table +-- +type BoundsNum = (Int, Char, Char) + +-- empty bounds +-- +nullBoundsNum :: BoundsNum +nullBoundsNum = (0, maxBound, minBound) + +-- combine two bounds +-- +addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum +addBoundsNum (n, lc, hc) (n', lc', hc') = (n + n', min lc lc', max hc hc') + +-- check whether a character is in the bounds +-- +inBounds :: Char -> BoundsNum -> Bool +inBounds c (_, lc, hc) = c >= lc && c <= hc + +-- Lexical actions take a lexeme with its position and may return a token; in +-- a variant, an error can be returned (EXPORTED) +-- +-- * if there is no token returned, the current lexeme is discarded lexing +-- continues looking for a token +-- +type Action t = String -> Position -> Maybe t +type ActionErr t = String -> Position -> Either Error t + +-- Meta actions transform the lexeme, position, and a user-defined state; they +-- may return a lexer, which is then used for accepting the next token (this +-- is important to implement non-regular behaviour like nested comments) +-- (EXPORTED) +-- +type Meta s t = String -> Position -> s -> (Maybe (Either Error t), -- err/tok? + Position, -- new pos + s, -- state + Maybe (Lexer s t)) -- lexer? + +-- tree structure used to represent the lexer table (EXPORTED ABSTRACTLY) +-- +-- * each node in the tree corresponds to a state of the lexer; the associated +-- actions are those that apply when the corresponding state is reached +-- +data Lexer s t = Lexer (LexAction s t) (Cont s t) + +-- represent the continuation of a lexer +-- +data Cont s t = -- on top of the tree, where entries are dense, we use arrays + -- + Dense BoundsNum (Array Char (Lexer s t)) + -- + -- further down, where the valid entries are sparse, we + -- use association lists, to save memory (the first argument + -- is the length of the list) + -- + | Sparse BoundsNum [(Char, Lexer s t)] + -- + -- end of a automaton + -- + | Done +-- deriving Show + +-- lexical action (EXPORTED ABSTRACTLY) +-- +data LexAction s t = Action (Meta s t) + | NoAction +-- deriving Show + +-- a regular expression (EXPORTED) +-- +type Regexp s t = Lexer s t -> Lexer s t + + +-- basic combinators +-- ----------------- + +-- Empty lexeme (EXPORTED) +-- +epsilon :: Regexp s t +epsilon = id + +-- One character regexp (EXPORTED) +-- +char :: Char -> Regexp s t +char c = \l -> Lexer NoAction (Sparse (1, c, c) [(c, l)]) + +-- Concatenation of regexps (EXPORTED) +-- +(+>) :: Regexp s t -> Regexp s t -> Regexp s t +(+>) = (.) + +-- Close a regular expression with an action that converts the lexeme into a +-- token (EXPORTED) +-- +-- * Note: After the application of the action, the position is advanced +-- according to the length of the lexeme. This implies that normal +-- actions should not be used in the case where a lexeme might contain +-- control characters that imply non-standard changes of the position, +-- such as newlines or tabs. +-- +lexaction :: Regexp s t -> Action t -> Lexer s t +lexaction re a = re `lexmeta` a' + where + a' lexeme pos@(Position fname row col) s = + let col' = col + length lexeme + in + col' `seq` case a lexeme pos of + Nothing -> (Nothing, (Position fname row col'), s, Nothing) + Just t -> (Just (Right t), (Position fname row col'), s, Nothing) + +-- Variant for actions that may returns an error (EXPORTED) +-- +lexactionErr :: Regexp s t -> ActionErr t -> Lexer s t +lexactionErr re a = re `lexmeta` a' + where + a' lexeme pos@(Position fname row col) s = + let col' = col + length lexeme + in + col' `seq` (Just (a lexeme pos), (Position fname row col'), s, Nothing) + +-- Close a regular expression with a meta action (EXPORTED) +-- +-- * Note: Meta actions have to advance the position in dependence of the +-- lexeme by themselves. +-- +lexmeta :: Regexp s t -> Meta s t -> Lexer s t +lexmeta re a = re (Lexer (Action a) Done) + +-- disjunctive combination of two regexps (EXPORTED) +-- +(>|<) :: Regexp s t -> Regexp s t -> Regexp s t +re >|< re' = \l -> re l >||< re' l + +-- disjunctive combination of two lexers (EXPORTED) +-- +(>||<) :: Lexer s t -> Lexer s t -> Lexer s t +(Lexer a c) >||< (Lexer a' c') = Lexer (joinActions a a') (joinConts c c') + +-- combine two disjunctive continuations +-- +joinConts :: Cont s t -> Cont s t -> Cont s t +joinConts Done c' = c' +joinConts c Done = c +joinConts c c' = let (bn , cls ) = listify c + (bn', cls') = listify c' + in + -- note: `addsBoundsNum' can, at this point, only + -- approx. the number of *non-overlapping* cases; + -- however, the bounds are correct + -- + aggregate (addBoundsNum bn bn') (cls ++ cls') + where + listify (Dense n arr) = (n, assocs arr) + listify (Sparse n cls) = (n, cls) + listify _ = interr "Lexers.listify: Impossible argument!" + +-- combine two actions +-- +joinActions :: LexAction s t -> LexAction s t -> LexAction s t +joinActions NoAction a' = a' +joinActions a NoAction = a +joinActions _ _ = interr "Lexers.>||<: Overlapping actions!" + +-- Note: `n' is only an upper bound of the number of non-overlapping cases +-- +aggregate :: BoundsNum -> ([(Char, Lexer s t)]) -> Cont s t +aggregate bn@(n, lc, hc) cls + | n >= denseMin = Dense bn (accumArray (>||<) noLexer (lc, hc) cls) + | otherwise = Sparse bn (accum (>||<) cls) + where + noLexer = Lexer NoAction Done + +-- combine the elements in the association list that have the same key +-- +accum :: Eq a => (b -> b -> b) -> [(a, b)] -> [(a, b)] +accum f [] = [] +accum f ((k, e):kes) = + let (ke, kes') = gather k e kes + in + ke : accum f kes' + where + gather k e [] = ((k, e), []) + gather k e (ke'@(k', e'):kes) | k == k' = gather k (f e e') kes + | otherwise = let + (ke'', kes') = gather k e kes + in + (ke'', ke':kes') + + +-- handling of control characters +-- ------------------------------ + +-- control characters recognized by `ctrlLexer' (EXPORTED) +-- +ctrlChars :: [Char] +ctrlChars = ['\n', '\r', '\f', '\t'] + +-- control lexer (EXPORTED) +-- +-- * implements proper `Position' management in the presence of the standard +-- layout control characters +-- +ctrlLexer :: Lexer s t +ctrlLexer = + char '\n' `lexmeta` newline + >||< char '\r' `lexmeta` newline + >||< char '\v' `lexmeta` newline + >||< char '\f' `lexmeta` formfeed + >||< char '\t' `lexmeta` tab + where + newline _ pos s = (Nothing, retPos pos , s, Nothing) + formfeed _ pos s = (Nothing, incPos pos 1, s, Nothing) + tab _ pos s = (Nothing, tabPos pos , s, Nothing) + + +-- non-basic combinators +-- --------------------- + +-- x `star` y corresponds to the regular expression x*y (EXPORTED) +-- +star :: Regexp s t -> Regexp s t -> Regexp s t +-- +-- The definition used below can be obtained by equational reasoning from this +-- one (which is much easier to understand): +-- +-- star re1 re2 = let self = (re1 +> self >|< epsilon) in self +> re2 +-- +-- However, in the above, `self' is of type `Regexp s t' (ie, a functional), +-- whereas below it is of type `Lexer s t'. Thus, below we have a graphical +-- body (finite representation of an infinite structure), which doesn't grow +-- with the size of the accepted lexeme - in contrast to the definition using +-- the functional recursion. +-- +star re1 re2 = \l -> let self = re1 self >||< re2 l + in + self + +-- x `plus` y corresponds to the regular expression x+y (EXPORTED) +-- +plus :: Regexp s t -> Regexp s t -> Regexp s t +plus re1 re2 = re1 +> (re1 `star` re2) + +-- x `quest` y corresponds to the regular expression x?y (EXPORTED) +-- +quest :: Regexp s t -> Regexp s t -> Regexp s t +quest re1 re2 = (re1 +> re2) >|< re2 + +-- accepts a non-empty set of alternative characters (EXPORTED) +-- +alt :: [Char] -> Regexp s t +-- +-- Equiv. to `(foldr1 (>|<) . map char) cs', but much faster +-- +alt [] = interr "Lexers.alt: Empty character set!" +alt cs = \l -> let bnds = (length cs, minimum cs, maximum cs) + in + Lexer NoAction (aggregate bnds [(c, l) | c <- cs]) + +-- accept a character sequence (EXPORTED) +-- +string :: String -> Regexp s t +string [] = interr "Lexers.string: Empty character set!" +string cs = (foldr1 (+>) . map char) cs + + +-- execution of a lexer +-- -------------------- + +-- threaded top-down during lexing (current input, current position, meta +-- state) (EXPORTED) +-- +type LexerState s = (String, Position, s) + +-- apply a lexer, yielding a token sequence and a list of errors (EXPORTED) +-- +-- * Currently, all errors are fatal; thus, the result is undefined in case of +-- an error (this changes when error correction is added). +-- +-- * The final lexer state is returned. +-- +-- * The order of the error messages is undefined. +-- +execLexer :: Lexer s t -> LexerState s -> ([t], LexerState s, [Error]) +-- +-- * the following is moderately tuned +-- +execLexer l state@([], _, _) = ([], state, []) +execLexer l state = + case lexOne l state of + (Nothing , _ , state') -> execLexer l state' + (Just res, l', state') -> let (ts, final, allErrs) = execLexer l' state' + in case res of + (Left err) -> (ts , final, err:allErrs) + (Right t ) -> (t:ts, final, allErrs) + where + -- accept a single lexeme + -- + -- lexOne :: Lexer s t -> LexerState s t + -- -> (Either Error (Maybe t), Lexer s t, LexerState s t) + lexOne l0 state = oneLexeme l0 state zeroDL lexErr + where + -- the result triple of `lexOne' that signals a lexical error; + -- the result state is advanced by one character for error correction + -- + lexErr = let (cs, pos@(Position fname row col), s) = state + err = makeError ErrorErr pos + ["Lexical error!", + "The character " ++ show (head cs) + ++ " does not fit here; skipping it."] + in + (Just (Left err), l, (tail cs, (Position fname row (col + 1)), s)) + + -- we take an open list of characters down, where we accumulate the + -- lexeme; this function returns maybe a token, the next lexer to use + -- (can be altered by a meta action), the new lexer state, and a list + -- of errors + -- + -- we implement the "principle of the longest match" by taking a + -- potential result quadruple down (in the last argument); the + -- potential result quadruple is updated whenever we pass by an action + -- (different from `NoAction'); initially it is an error result + -- + -- oneLexeme :: Lexer s t + -- -> LexerState + -- -> DList Char + -- -> (Maybe (Either Error t), Maybe (Lexer s t), + -- LexerState s t) + -- -> (Maybe (Either Error t), Maybe (Lexer s t), + -- LexerState s t) + oneLexeme (Lexer a cont) state@(cs, pos, s) csDL last = + let last' = action a csDL state last + in case cs of + [] -> last' + (c:cs') -> oneChar cont c (cs', pos, s) csDL last' + + oneChar Done c state csDL last = last + oneChar (Dense bn arr) c state csDL last + | c `inBounds` bn = cont (arr!c) c state csDL last + | otherwise = last + oneChar (Sparse bn cls) c state csDL last + | c `inBounds` bn = case lookup c cls of + Nothing -> last + Just l' -> cont l' c state csDL last + | otherwise = last + + -- continue within the current lexeme + -- + cont l' c state csDL last = oneLexeme l' state (csDL `snocDL` c) last + + -- execute the action if present and finalise the current lexeme + -- + action (Action f) csDL (cs, pos, s) last = + case f (closeDL csDL) pos s of + (Nothing, pos', s', l') + | not . null $ cs -> lexOne (fromMaybe l0 l') (cs, pos', s') + (res , pos', s', l') -> (res, (fromMaybe l0 l'), (cs, pos', s')) + action NoAction csDL state last = + last -- no change diff --git a/c2hs.cabal b/c2hs.cabal new file mode 100644 --- /dev/null +++ b/c2hs.cabal @@ -0,0 +1,70 @@ +Name: c2hs +Version: 0.15.0 +--Versnick: "Rainy Days" +--Versdate: "31 Aug 2007" +License: GPL +License-File: COPYING +Copyright: Copyright (c) [1999..2007] Manuel M T Chakravarty +Author: Manuel M T Chakravarty +Maintainer: chak@cse.unsw.edu.au, duncan@haskell.org +Stability: Stable +Homepage: http://www.cse.unsw.edu.au/~chak/haskell/c2hs/ +Synopsis: C->Haskell Interface Generator +Description: C->Haskell assists in the development of Haskell bindings to C + libraries. It extracts C interface information from vanilla header + files and generates marshaling and signature code in Haskell. +Category: Development tool +Build-Depends: base, filepath +Build-Tools: happy, alex +--TODO: Cabal should allow 'Data-Files' in the executable stanza +Data-Files: C2HS.hs +Extra-Source-Files: c2hs/toplevel/c2hs_config.h + +Executable: c2hs +Hs-Source-Dirs: base/admin + base/errors + base/general + base/state + base/syms + base/syntax + c2hs/c + c2hs/chs + c2hs/gen + c2hs/state + c2hs/toplevel +Main-Is: Main.hs +Other-Modules: Errors + DLists + UNames + CIO + StateBase + State + StateTrans + Position + Attributes + Idents + NameSpaces + Lexers + CAST + CAttrs + CBuiltin + C + CTokens + CParserMonad + CLexer + CNames + CParser + CPretty + CTrav + CHS + CHSLexer + CInfo + GBMonad + GenBind + GenHeader + C2HSState + Switches + C2HSConfig + Version +Extensions: ForeignFunctionInterface +C-Sources: c2hs/toplevel/c2hs_config.c diff --git a/c2hs/c/C.hs b/c2hs/c/C.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/C.hs @@ -0,0 +1,139 @@ +-- C->Haskell Compiler: interface to C processing routines +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 12 August 99 +-- +-- Copyright (c) 1999 Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This modules provides access to the C processing routines for the rest of +-- the compiler. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +--- TODO ---------------------------------------------------------------------- +-- +-- + +module C (-- interface to KL for all non-KL modules + -- + -- stuff from `Common' (reexported) + -- + Pos(posOf), + -- + -- structure tree + -- + module CAST, + -- + -- attributed structure tree with operations (reexported from + -- `CAttrs') + -- + AttrC, + CObj(..), CTag(..), CDef(..), lookupDefObjC, lookupDefTagC, + getDefOfIdentC, + -- + -- support for C structure tree traversals + -- + module CTrav, + -- + loadAttrC, -- locally defined + -- + -- misc. reexported stuff + -- + Ident, Attrs, Attr(..), + -- + -- misc. own stuff + -- + csuffix, hsuffix, isuffix) +where + +import Position (Position(..), Pos(posOf)) +import Idents (Ident) +import Attributes (Attrs, Attr(..)) + +import C2HSState (CST, + readFileCIO, + fatal, errorsPresent, showErrors, + Traces(..), putTraceStr) +import CAST +import CParser (parseC) +import CPretty () -- just Show instances +import CAttrs (AttrC, CObj(..), CTag(..), CDef(..), + lookupDefObjC, lookupDefTagC, getDefOfIdentC) +import CNames (nameAnalysis) +import CTrav + + +-- suffix for files containing C (EXPORTED) +-- +csuffix, hsuffix, isuffix :: String +csuffix = "c" +hsuffix = "h" +isuffix = "i" + +-- given a file name (with suffix), parse that file as a C header and do the +-- static analysis (collect defined names) (EXPORTED) +-- +-- * currently, lexical and syntactical errors are reported immediately and +-- abort the program; others are reported as part of the fatal error message; +-- warnings are returned together with the read unit +-- +loadAttrC :: String -> CST s (AttrC, String) +loadAttrC fname = do + -- read file + -- + traceInfoRead fname + contents <- readFileCIO fname + + -- parse + -- + traceInfoParse + header <- parseC contents (Position fname 1 1) + + -- name analysis + -- + traceInfoNA + headerWithAttrs <- nameAnalysis header + + -- check for errors and finalize + -- + errs <- errorsPresent + if errs + then do + traceInfoErr + errmsgs <- showErrors + fatal ("C header contains \ + \errors:\n\n" ++ errmsgs) -- fatal error + else do + traceInfoOK + warnmsgs <- showErrors + return (headerWithAttrs, warnmsgs) + where + traceInfoRead fname = putTraceStr tracePhasesSW + ("Attempting to read file `" + ++ fname ++ "'...\n") + traceInfoParse = putTraceStr tracePhasesSW + ("...parsing `" + ++ fname ++ "'...\n") + traceInfoNA = putTraceStr tracePhasesSW + ("...name analysis of `" + ++ fname ++ "'...\n") + traceInfoErr = putTraceStr tracePhasesSW + ("...error(s) detected in `" + ++ fname ++ "'.\n") + traceInfoOK = putTraceStr tracePhasesSW + ("...successfully loaded `" + ++ fname ++ "'.\n") diff --git a/c2hs/c/CAST.hs b/c2hs/c/CAST.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CAST.hs @@ -0,0 +1,672 @@ +-- C -> Haskell Compiler: Abstract Syntax for Header Files +-- +-- Author : Manuel M T Chakravarty +-- Created: 7 March 99 +-- +-- Copyright (c) [1999..2004] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Abstract syntax of C header files. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- The tree structure corresponds to the grammar in Appendix A of K&R. This +-- abstract syntax simplifies the concrete syntax by merging similar concrete +-- constructs into a single type of abstract tree structure: declarations are +-- merged with structure declarations, parameter declarations and type names, +-- and declarators are merged with abstract declarators. +-- +-- With K&R we refer to ``The C Programming Language'', second edition, Brain +-- W. Kernighan and Dennis M. Ritchie, Prentice Hall, 1988. This module +-- supports the C99 `restrict' extension +-- , `inline' functions, and also +-- the GNU C `alignof' extension. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CAST (CHeader(..), CExtDecl(..), CFunDef(..), CStat(..), CBlockItem(..), + CDecl(..), CDeclSpec(..), CStorageSpec(..), CTypeSpec(..), + CTypeQual(..), CStructUnion(..), CStructTag(..), CEnum(..), + CDeclr(..), CInit(..), CInitList, CDesignator(..), CExpr(..), + CAssignOp(..), CBinaryOp(..), CUnaryOp(..), CConst (..)) +where + +import Position (Pos(posOf)) +import Idents (Ident) +import Attributes (Attrs) + + +-- a complete C header file (K&R A10) (EXPORTED) +-- +data CHeader = CHeader [CExtDecl] + Attrs + +instance Pos CHeader where + posOf (CHeader _ at) = posOf at + +instance Eq CHeader where + (CHeader _ at1) == (CHeader _ at2) = at1 == at2 + +-- external C declaration (K&R A10) (EXPORTED) +-- +data CExtDecl = CDeclExt CDecl + | CFDefExt CFunDef + | CAsmExt Attrs -- a chunk of assembly code (which is + -- not itself recorded) + +instance Pos CExtDecl where + posOf (CDeclExt decl) = posOf decl + posOf (CFDefExt fdef) = posOf fdef + posOf (CAsmExt at) = posOf at + +instance Eq CExtDecl where + CDeclExt decl1 == CDeclExt decl2 = decl1 == decl2 + CFDefExt fdef1 == CFDefExt fdef2 = fdef1 == fdef2 + CAsmExt at1 == CAsmExt at2 = at1 == at2 + +-- C function definition (K&R A10.1) (EXPORTED) +-- +-- * The only type specifiers allowed are `extern' and `static'. +-- +-- * The declarator must specify explicitly that the declared identifier has +-- function type. +-- +-- * The optional declaration list is for old-style function declarations. +-- +-- * The statement must be a compound statement. +-- +data CFunDef = CFunDef [CDeclSpec] -- type specifier and qualifier + CDeclr -- declarator + [CDecl] -- optional declaration list + CStat -- compound statement + Attrs + +instance Pos CFunDef where + posOf (CFunDef _ _ _ _ at) = posOf at + +instance Eq CFunDef where + CFunDef _ _ _ _ at1 == CFunDef _ _ _ _ at2 = at1 == at2 + +-- C statement (A9) (EXPORTED) +-- +data CStat = CLabel Ident -- label + CStat + Attrs + | CCase CExpr -- constant expression + CStat + Attrs + | CCases CExpr -- case range + CExpr -- `case lower .. upper :' + CStat + Attrs + | CDefault CStat -- default case + Attrs + | CExpr (Maybe CExpr) -- expression statement, maybe empty + Attrs + | CCompound [CBlockItem] -- list of declarations and statements + Attrs + | CIf CExpr -- conditional expression + CStat + (Maybe CStat) -- optional "else" case + Attrs + | CSwitch CExpr -- selector + CStat + Attrs + | CWhile CExpr + CStat + Bool -- `True' implies "do-while" statement + Attrs + | CFor (Either (Maybe CExpr) + CDecl) + (Maybe CExpr) + (Maybe CExpr) + CStat + Attrs + | CGoto Ident -- label + Attrs + | CGotoPtr CExpr -- computed address + Attrs + | CCont Attrs -- continue statement + | CBreak Attrs -- break statement + | CReturn (Maybe CExpr) + Attrs + | CAsm Attrs -- a chunk of assembly code (which is + -- not itself recorded) + +instance Pos CStat where + posOf (CLabel _ _ at) = posOf at + posOf (CCase _ _ at) = posOf at + posOf (CCases _ _ _ at) = posOf at + posOf (CDefault _ at) = posOf at + posOf (CExpr _ at) = posOf at + posOf (CCompound _ at) = posOf at + posOf (CIf _ _ _ at) = posOf at + posOf (CSwitch _ _ at) = posOf at + posOf (CWhile _ _ _ at) = posOf at + posOf (CFor _ _ _ _ at) = posOf at + posOf (CGoto _ at) = posOf at + posOf (CGotoPtr _ at) = posOf at + posOf (CCont at) = posOf at + posOf (CBreak at) = posOf at + posOf (CReturn _ at) = posOf at + posOf (CAsm at) = posOf at + +instance Eq CStat where + (CLabel _ _ at1) == (CLabel _ _ at2) = at1 == at2 + (CCase _ _ at1) == (CCase _ _ at2) = at1 == at2 + (CCases _ _ _ at1) == (CCases _ _ _ at2) = at1 == at2 + (CDefault _ at1) == (CDefault _ at2) = at1 == at2 + (CExpr _ at1) == (CExpr _ at2) = at1 == at2 + (CCompound _ at1) == (CCompound _ at2) = at1 == at2 + (CIf _ _ _ at1) == (CIf _ _ _ at2) = at1 == at2 + (CSwitch _ _ at1) == (CSwitch _ _ at2) = at1 == at2 + (CWhile _ _ _ at1) == (CWhile _ _ _ at2) = at1 == at2 + (CFor _ _ _ _ at1) == (CFor _ _ _ _ at2) = at1 == at2 + (CGoto _ at1) == (CGoto _ at2) = at1 == at2 + (CGotoPtr _ at1) == (CGotoPtr _ at2) = at1 == at2 + (CCont at1) == (CCont at2) = at1 == at2 + (CBreak at1) == (CBreak at2) = at1 == at2 + (CReturn _ at1) == (CReturn _ at2) = at1 == at2 + (CAsm at1) == (CAsm at2) = at1 == at2 + +-- C99 Block items, things that may appear in compound statements +data CBlockItem = CBlockStmt CStat + | CBlockDecl CDecl + | CNestedFunDef CFunDef -- GNU C has nested functions + +instance Pos CBlockItem where + posOf (CBlockStmt stmt) = posOf stmt + posOf (CBlockDecl decl) = posOf decl + posOf (CNestedFunDef fdef) = posOf fdef + +instance Eq CBlockItem where + CBlockStmt stmt1 == CBlockStmt stmt2 = stmt1 == stmt2 + CBlockDecl decl1 == CBlockDecl decl2 = decl1 == decl2 + CNestedFunDef fdef1 == CNestedFunDef fdef2 = fdef1 == fdef2 + + +-- C declaration (K&R A8), structure declaration (K&R A8.3), parameter +-- declaration (K&R A8.6.3), and type name (K&R A8.8) (EXPORTED) +-- +-- * Toplevel declarations (K&R A8): +-- +-- - they require that the type specifier and qualifier list is not empty, +-- but gcc allows it and just issues a warning; for the time being, we +-- also allow it; +-- - at most one storage class specifier is allowed per declaration; +-- - declarators must be present and size expressions are not allowed, ie, +-- the elements of K&R's init-declarator-list are represented by triples +-- of the form `(Just declr, oinit, Nothing)', where `oinit' maybe +-- `Nothing' or `Just init'; and +-- - abstract declarators are not allowed. +-- +-- * Structure declarations (K&R A8.3): +-- +-- - do not allow storage specifiers; +-- - do not allow initializers; +-- - require a non-empty declarator-triple list, where abstract declarators +-- are not allowed; and +-- - each of the declarator-triples has to contain either a declarator or a +-- size expression, or both, ie, it has the form `(Just decl, Nothing, +-- Nothing)', `(Nothing, Nothing, Just size)', or `(Just decl, Nothing, +-- Just size)'. +-- +-- * Parameter declarations (K&R A8.6.3): +-- +-- - allow neither initializers nor size expressions; +-- - allow at most one declarator triple of the form `(Just declr, Nothing, +-- Nothing)' (in case of an empty declarator, the list must be empty); and +-- - allow abstract declarators. +-- +-- * Type names (A8.8): +-- +-- - do not allow storage specifiers; +-- - allow neither initializers nor size expressions; and +-- - allow at most one declarator triple of the form `(Just declr, Nothing, +-- Nothing)' (in case of an empty declarator, the list must be empty), +-- where the declarator must be abstract, ie, must not contain a declared +-- identifier. +-- +data CDecl = CDecl [CDeclSpec] -- type specifier and qualifier + [(Maybe CDeclr, -- declarator (may be omitted) + Maybe CInit, -- optional initializer + Maybe CExpr)] -- optional size (const expr) + Attrs + +instance Pos CDecl where + posOf (CDecl _ _ at) = posOf at + +instance Eq CDecl where + (CDecl _ _ at1) == (CDecl _ _ at2) = at1 == at2 + +-- C declaration specifiers and qualifiers (EXPORTED) +-- +data CDeclSpec = CStorageSpec CStorageSpec + | CTypeSpec CTypeSpec + | CTypeQual CTypeQual + deriving (Eq) + +instance Pos CDeclSpec where + posOf (CStorageSpec sspec) = posOf sspec + posOf (CTypeSpec tspec) = posOf tspec + posOf (CTypeQual tqual) = posOf tqual + +-- C storage class specifier (K&R A8.1) (EXPORTED) +-- +data CStorageSpec = CAuto Attrs + | CRegister Attrs + | CStatic Attrs + | CExtern Attrs + | CTypedef Attrs -- syntactic awkwardness of C + | CThread Attrs -- GNUC thread local storage + +instance Pos CStorageSpec where + posOf (CAuto at) = posOf at + posOf (CRegister at) = posOf at + posOf (CStatic at) = posOf at + posOf (CExtern at) = posOf at + posOf (CTypedef at) = posOf at + posOf (CThread at) = posOf at + +instance Eq CStorageSpec where + (CAuto at1) == (CAuto at2) = at1 == at2 + (CRegister at1) == (CRegister at2) = at1 == at2 + (CStatic at1) == (CStatic at2) = at1 == at2 + (CExtern at1) == (CExtern at2) = at1 == at2 + (CTypedef at1) == (CTypedef at2) = at1 == at2 + (CThread at1) == (CThread at2) = at1 == at2 + +-- C type specifier (K&R A8.2) (EXPORTED) +-- +data CTypeSpec = CVoidType Attrs + | CCharType Attrs + | CShortType Attrs + | CIntType Attrs + | CLongType Attrs + | CFloatType Attrs + | CDoubleType Attrs + | CSignedType Attrs + | CUnsigType Attrs + | CBoolType Attrs + | CComplexType Attrs + | CSUType CStructUnion + Attrs + | CEnumType CEnum + Attrs + | CTypeDef Ident -- typedef name + Attrs + | CTypeOfExpr CExpr + Attrs + | CTypeOfType CDecl + Attrs + +instance Pos CTypeSpec where + posOf (CVoidType at) = posOf at + posOf (CCharType at) = posOf at + posOf (CShortType at) = posOf at + posOf (CIntType at) = posOf at + posOf (CLongType at) = posOf at + posOf (CFloatType at) = posOf at + posOf (CDoubleType at) = posOf at + posOf (CSignedType at) = posOf at + posOf (CUnsigType at) = posOf at + posOf (CBoolType at) = posOf at + posOf (CComplexType at) = posOf at + posOf (CSUType _ at) = posOf at + posOf (CEnumType _ at) = posOf at + posOf (CTypeDef _ at) = posOf at + posOf (CTypeOfExpr _ at) = posOf at + posOf (CTypeOfType _ at) = posOf at + +instance Eq CTypeSpec where + (CVoidType at1) == (CVoidType at2) = at1 == at2 + (CCharType at1) == (CCharType at2) = at1 == at2 + (CShortType at1) == (CShortType at2) = at1 == at2 + (CIntType at1) == (CIntType at2) = at1 == at2 + (CLongType at1) == (CLongType at2) = at1 == at2 + (CFloatType at1) == (CFloatType at2) = at1 == at2 + (CDoubleType at1) == (CDoubleType at2) = at1 == at2 + (CSignedType at1) == (CSignedType at2) = at1 == at2 + (CUnsigType at1) == (CUnsigType at2) = at1 == at2 + (CBoolType at1) == (CBoolType at2) = at1 == at2 + (CComplexType at1) == (CComplexType at2) = at1 == at2 + (CSUType _ at1) == (CSUType _ at2) = at1 == at2 + (CEnumType _ at1) == (CEnumType _ at2) = at1 == at2 + (CTypeDef _ at1) == (CTypeDef _ at2) = at1 == at2 + (CTypeOfExpr _ at1) == (CTypeOfExpr _ at2) = at1 == at2 + (CTypeOfType _ at1) == (CTypeOfType _ at2) = at1 == at2 + +-- C type qualifier (K&R A8.2) (EXPORTED) +-- +-- * plus `restrict' from C99 and `inline' +-- +data CTypeQual = CConstQual Attrs + | CVolatQual Attrs + | CRestrQual Attrs + | CInlinQual Attrs + +instance Pos CTypeQual where + posOf (CConstQual at) = posOf at + posOf (CVolatQual at) = posOf at + posOf (CRestrQual at) = posOf at + posOf (CInlinQual at) = posOf at + +instance Eq CTypeQual where + (CConstQual at1) == (CConstQual at2) = at1 == at2 + (CVolatQual at1) == (CVolatQual at2) = at1 == at2 + (CRestrQual at1) == (CRestrQual at2) = at1 == at2 + (CInlinQual at1) == (CInlinQual at2) = at1 == at2 + +-- C structure of union declaration (K&R A8.3) (EXPORTED) +-- +-- * in both case, either the identifier is present or the list must be +-- non-empty +-- +data CStructUnion = CStruct CStructTag + (Maybe Ident) + [CDecl] -- *structure* declaration + Attrs + +instance Pos CStructUnion where + posOf (CStruct _ _ _ at) = posOf at + +instance Eq CStructUnion where + (CStruct _ _ _ at1) == (CStruct _ _ _ at2) = at1 == at2 + +-- (EXPORTED) +-- +data CStructTag = CStructTag + | CUnionTag + deriving (Eq) + +-- C enumeration declaration (K&R A8.4) (EXPORTED) +-- +data CEnum = CEnum (Maybe Ident) + [(Ident, -- variant name + Maybe CExpr)] -- explicit variant value + Attrs + +instance Pos CEnum where + posOf (CEnum _ _ at) = posOf at + +instance Eq CEnum where + (CEnum _ _ at1) == (CEnum _ _ at2) = at1 == at2 + +-- C declarator (K&R A8.5) and abstract declarator (K&R A8.8) (EXPORTED) +-- +-- * We have one type qualifer list `[CTypeQual]' for each indirection (ie, +-- each occurrence of `*' in the concrete syntax). +-- +-- * We unfold K&R's direct-declarators nonterminal into declarators. Note +-- that `*(*x)' is equivalent to `**x'. +-- +-- * Declarators (A8.5) and abstract declarators (A8.8) are represented in the +-- same structure. In the case of a declarator, the identifier in +-- `CVarDeclr' must be present; in an abstract declarator it misses. +-- `CVarDeclr Nothing ...' on its own is meaningless, it may only occur as +-- part of a larger type (ie, there must be a pointer, an array, or function +-- declarator around). +-- +-- * The qualifiers list in a `CPtrDeclr' may not be empty. +-- +-- * Old and new style function definitions are merged into a single case +-- `CFunDeclr'. In case of an old style definition, the parameter list is +-- empty and the variadic flag is `False' (ie, the parameter names are not +-- stored in the tree). Remember, a new style definition with no parameters +-- requires a single `void' in the argument list (according to the standard). +-- +-- * We unfold K&R's parameter-type-list nonterminal into the declarator +-- variant for functions. +-- +data CDeclr = CVarDeclr (Maybe Ident) -- declared identifier + Attrs + | CPtrDeclr [CTypeQual] -- indirections + CDeclr + Attrs + | CArrDeclr CDeclr + [CTypeQual] + (Maybe CExpr) -- array size + Attrs + | CFunDeclr CDeclr + [CDecl] -- *parameter* declarations + Bool -- is variadic? + Attrs + +instance Pos CDeclr where + posOf (CVarDeclr _ at) = posOf at + posOf (CPtrDeclr _ _ at) = posOf at + posOf (CArrDeclr _ _ _ at) = posOf at + posOf (CFunDeclr _ _ _ at) = posOf at + +instance Eq CDeclr where + (CVarDeclr _ at1) == (CVarDeclr _ at2) = at1 == at2 + (CPtrDeclr _ _ at1) == (CPtrDeclr _ _ at2) = at1 == at2 + (CArrDeclr _ _ _ at1) == (CArrDeclr _ _ _ at2) = at1 == at2 + (CFunDeclr _ _ _ at1) == (CFunDeclr _ _ _ at2) = at1 == at2 + +-- C initializer (K&R A8.7) (EXPORTED) +-- +data CInit = CInitExpr CExpr + Attrs -- assignment expression + | CInitList CInitList + Attrs + +type CInitList = [([CDesignator], CInit)] + +instance Pos CInit where + posOf (CInitExpr _ at) = posOf at + posOf (CInitList _ at) = posOf at + +instance Eq CInit where + (CInitExpr _ at1) == (CInitExpr _ at2) = at1 == at2 + (CInitList _ at1) == (CInitList _ at2) = at1 == at2 + +-- C initializer designator (EXPORTED) +-- +data CDesignator = CArrDesig CExpr + Attrs + | CMemberDesig Ident + Attrs + | CRangeDesig CExpr -- GNUC array range designator + CExpr + Attrs + +instance Pos CDesignator where + posOf (CArrDesig _ at) = posOf at + posOf (CMemberDesig _ at) = posOf at + posOf (CRangeDesig _ _ at) = posOf at + +instance Eq CDesignator where + (CArrDesig _ at1) == (CArrDesig _ at2) = at1 == at2 + (CMemberDesig _ at1) == (CMemberDesig _ at2) = at1 == at2 + (CRangeDesig _ _ at1) == (CRangeDesig _ _ at2) = at1 == at2 + +-- C expression (K&R A7) (EXPORTED) +-- +-- * these can be arbitrary expression, as the argument of `sizeof' can be +-- arbitrary, even if appearing in a constant expression +-- +-- * GNU C extension: `alignof' +-- +data CExpr = CComma [CExpr] -- comma expression list, n >= 2 + Attrs + | CAssign CAssignOp -- assignment operator + CExpr -- l-value + CExpr -- r-value + Attrs + | CCond CExpr -- conditional + (Maybe CExpr) -- true-expression (GNU allows omitting) + CExpr -- false-expression + Attrs + | CBinary CBinaryOp -- binary operator + CExpr -- lhs + CExpr -- rhs + Attrs + | CCast CDecl -- type name + CExpr + Attrs + | CUnary CUnaryOp -- unary operator + CExpr + Attrs + | CSizeofExpr CExpr + Attrs + | CSizeofType CDecl -- type name + Attrs + | CAlignofExpr CExpr + Attrs + | CAlignofType CDecl -- type name + Attrs + | CIndex CExpr -- array + CExpr -- index + Attrs + | CCall CExpr -- function + [CExpr] -- arguments + Attrs + | CMember CExpr -- structure + Ident -- member name + Bool -- deref structure? (True for `->') + Attrs + | CVar Ident -- identifier (incl. enumeration const) + Attrs + | CConst CConst -- includes strings + Attrs + | CCompoundLit CDecl -- C99 compound literal + CInitList -- type name & initialiser list + Attrs + | CStatExpr CStat -- GNUC compound statement as expr + Attrs + | CLabAddrExpr Ident -- GNUC address of label + Attrs + | CBuiltinExpr Attrs -- place holder for GNUC builtin exprs + +instance Pos CExpr where + posOf (CComma _ at) = posOf at + posOf (CAssign _ _ _ at) = posOf at + posOf (CCond _ _ _ at) = posOf at + posOf (CBinary _ _ _ at) = posOf at + posOf (CCast _ _ at) = posOf at + posOf (CUnary _ _ at) = posOf at + posOf (CSizeofExpr _ at) = posOf at + posOf (CSizeofType _ at) = posOf at + posOf (CAlignofExpr _ at) = posOf at + posOf (CAlignofType _ at) = posOf at + posOf (CIndex _ _ at) = posOf at + posOf (CCall _ _ at) = posOf at + posOf (CMember _ _ _ at) = posOf at + posOf (CVar _ at) = posOf at + posOf (CConst _ at) = posOf at + posOf (CCompoundLit _ _ at) = posOf at + posOf (CStatExpr _ at) = posOf at + posOf (CLabAddrExpr _ at) = posOf at + posOf (CBuiltinExpr at) = posOf at + +instance Eq CExpr where + (CComma _ at1) == (CComma _ at2) = at1 == at2 + (CAssign _ _ _ at1) == (CAssign _ _ _ at2) = at1 == at2 + (CCond _ _ _ at1) == (CCond _ _ _ at2) = at1 == at2 + (CBinary _ _ _ at1) == (CBinary _ _ _ at2) = at1 == at2 + (CCast _ _ at1) == (CCast _ _ at2) = at1 == at2 + (CUnary _ _ at1) == (CUnary _ _ at2) = at1 == at2 + (CSizeofExpr _ at1) == (CSizeofExpr _ at2) = at1 == at2 + (CSizeofType _ at1) == (CSizeofType _ at2) = at1 == at2 + (CAlignofExpr _ at1) == (CAlignofExpr _ at2) = at1 == at2 + (CAlignofType _ at1) == (CAlignofType _ at2) = at1 == at2 + (CIndex _ _ at1) == (CIndex _ _ at2) = at1 == at2 + (CCall _ _ at1) == (CCall _ _ at2) = at1 == at2 + (CMember _ _ _ at1) == (CMember _ _ _ at2) = at1 == at2 + (CVar _ at1) == (CVar _ at2) = at1 == at2 + (CConst _ at1) == (CConst _ at2) = at1 == at2 + (CCompoundLit _ _ at1) == (CCompoundLit _ _ at2) = at1 == at2 + (CStatExpr _ at1) == (CStatExpr _ at2) = at1 == at2 + (CLabAddrExpr _ at1) == (CLabAddrExpr _ at2) = at1 == at2 + (CBuiltinExpr at1) == (CBuiltinExpr at2) = at1 == at2 + +-- C assignment operators (K&R A7.17) (EXPORTED) +-- +data CAssignOp = CAssignOp + | CMulAssOp + | CDivAssOp + | CRmdAssOp -- remainder and assignment + | CAddAssOp + | CSubAssOp + | CShlAssOp + | CShrAssOp + | CAndAssOp + | CXorAssOp + | COrAssOp + deriving (Eq) + +-- C binary operators (K&R A7.6-15) (EXPORTED) +-- +data CBinaryOp = CMulOp + | CDivOp + | CRmdOp -- remainder of division + | CAddOp + | CSubOp + | CShlOp -- shift left + | CShrOp -- shift right + | CLeOp -- less + | CGrOp -- greater + | CLeqOp -- less or equal + | CGeqOp -- greater or equal + | CEqOp -- equal + | CNeqOp -- not equal + | CAndOp -- bitwise and + | CXorOp -- exclusive bitwise or + | COrOp -- inclusive bitwise or + | CLndOp -- logical and + | CLorOp -- logical or + deriving (Eq) + +-- C unary operator (K&R A7.3-4) (EXPORTED) +-- +data CUnaryOp = CPreIncOp -- prefix increment operator + | CPreDecOp -- prefix decrement operator + | CPostIncOp -- postfix increment operator + | CPostDecOp -- postfix decrement operator + | CAdrOp -- address operator + | CIndOp -- indirection operator + | CPlusOp -- prefix plus + | CMinOp -- prefix minus + | CCompOp -- one's complement + | CNegOp -- logical negation + deriving (Eq) + +-- C constant (K&R A2.5 & A7.2) (EXPORTED) +-- +-- * we do not list enumeration constants here, as they are identifiers +-- +data CConst = CIntConst Integer + Attrs + | CCharConst Char + Attrs + | CFloatConst String + Attrs + | CStrConst String + Attrs + +instance Pos CConst where + posOf (CIntConst _ at) = posOf at + posOf (CCharConst _ at) = posOf at + posOf (CFloatConst _ at) = posOf at + posOf (CStrConst _ at) = posOf at + +instance Eq CConst where + (CIntConst _ at1) == (CIntConst _ at2) = at1 == at2 + (CCharConst _ at1) == (CCharConst _ at2) = at1 == at2 + (CFloatConst _ at1) == (CFloatConst _ at2) = at1 == at2 + (CStrConst _ at1) == (CStrConst _ at2) = at1 == at2 diff --git a/c2hs/c/CAttrs.hs b/c2hs/c/CAttrs.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CAttrs.hs @@ -0,0 +1,391 @@ +-- C->Haskell Compiler: C attribute definitions and manipulation routines +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 12 August 99 +-- +-- Copyright (c) [1999..2001] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides the attributed version of the C structure tree. +-- +-- * C has several name spaces of which two are represented in this module: +-- - `CObj' in `defObjsAC': The name space of objects, functions, typedef +-- names, and enum constants. +-- - `CTag' in `defTagsAC': The name space of tags of structures, unions, +-- and enumerations. +-- +-- * The final state of the names spaces are preserved in the attributed +-- structure tree. This allows further fast lookups for globally defined +-- identifiers after the name anaysis is over. +-- +-- * In addition to the name spaces, the attribute structure tree contains +-- a ident-definition table, which for attribute handles of identifiers +-- refers to the identifiers definition. These are only used in usage +-- occurences, except for one exception: The tag identifiers in forward +-- definitions of structures or enums get a reference to the corresponding +-- full definition - see `CTrav' for full details. +-- +-- * We maintain a shadow definition table, it can be populated with aliases +-- to other objects and maps identifiers to identifiers. It is populated by +-- using the `applyPrefix' function. When looksup performed via the shadow +-- variant of a lookup function, shadow aliases are also considered, but +-- they are used only if no normal entry for the identifiers is present. +-- +-- * Only ranges delimited by a block open a new range for tags (see +-- `enterNewObjRangeC' and `leaveObjRangeC'). +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CAttrs (-- attributed C + -- + AttrC, emptyAttrC, enterNewRangeC, enterNewObjRangeC, + leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC, + lookupDefObjCShadow, addDefTagC, lookupDefTagC, + lookupDefTagCShadow, applyPrefix, getDefOfIdentC, + setDefOfIdentC, updDefOfIdentC, freezeDefOfIdentsAttrC, + softenDefOfIdentsAttrC, + -- + -- C objects + -- + CObj(..), CTag(..), CDef(..)) +where + +import Data.Char (toUpper) +import Data.Maybe (mapMaybe) + +import Position (Pos(posOf), nopos, dontCarePos, builtinPos) +import Errors (interr) +import Idents (Ident, getIdentAttrs, identToLexeme, onlyPosIdent) +import Attributes (Attr(..), AttrTable, getAttr, setAttr, updAttr, + newAttrTable, freezeAttrTable, softenAttrTable) +import NameSpaces (NameSpace, nameSpace, enterNewRange, leaveRange, defLocal, + defGlobal, find, nameSpaceToList) + +import CAST + + +-- attributed C structure tree +-- --------------------------- + +-- attributes relevant to the outside world gathjered from a C unit +-- (EXPORTED ABSTRACT) +-- +data AttrC = AttrC { + defObjsAC :: CObjNS, -- defined objects + defTagsAC :: CTagNS, -- defined tags + shadowsAC :: CShadowNS, -- shadow definitions (prefix) + defsAC :: CDefTable -- ident-def associations + } + +-- empty headder attribute set (EXPORTED) +-- +emptyAttrC :: AttrC +emptyAttrC = AttrC { + defObjsAC = cObjNS, + defTagsAC = cTagNS, + shadowsAC = cShadowNS, + defsAC = cDefTable + } + + +-- the name space operations +-- + +-- enter a new range (EXPORTED) +-- +enterNewRangeC :: AttrC -> AttrC +enterNewRangeC ac = ac { + defObjsAC = enterNewRange . defObjsAC $ ac, + defTagsAC = enterNewRange . defTagsAC $ ac + } + +-- enter a new range, only for objects (EXPORTED) +-- +enterNewObjRangeC :: AttrC -> AttrC +enterNewObjRangeC ac = ac { + defObjsAC = enterNewRange . defObjsAC $ ac + } + +-- leave the current range (EXPORTED) +-- +leaveRangeC :: AttrC -> AttrC +leaveRangeC ac = ac { + defObjsAC = fst . leaveRange . defObjsAC $ ac, + defTagsAC = fst . leaveRange . defTagsAC $ ac + } + +-- leave the current range, only for objects (EXPORTED) +-- +leaveObjRangeC :: AttrC -> AttrC +leaveObjRangeC ac = ac { + defObjsAC = fst . leaveRange . defObjsAC $ ac + } + +-- add another definitions to the object name space (EXPORTED) +-- +-- * if a definition of the same name was already present, it is returned +-- +addDefObjC :: AttrC -> Ident -> CObj -> (AttrC, Maybe CObj) +addDefObjC ac ide obj = let om = defObjsAC ac + (ac', obj') = defLocal om ide obj + in + (ac {defObjsAC = ac'}, obj') + +-- lookup an identifier in the object name space (EXPORTED) +-- +lookupDefObjC :: AttrC -> Ident -> Maybe CObj +lookupDefObjC ac ide = find (defObjsAC ac) ide + +-- lookup an identifier in the object name space; if nothing found, try +-- whether there is a shadow identifier that matches (EXPORTED) +-- +-- * the returned identifier is the _real_ identifier of the object +-- +lookupDefObjCShadow :: AttrC -> Ident -> Maybe (CObj, Ident) +lookupDefObjCShadow ac ide = + case lookupDefObjC ac ide of + Just obj -> Just (obj, ide) + Nothing -> case find (shadowsAC ac) ide of + Nothing -> Nothing + Just ide' -> case lookupDefObjC ac ide' of + Just obj -> Just (obj, ide') + Nothing -> Nothing + +-- add another definition to the tag name space (EXPORTED) +-- +-- * if a definition of the same name was already present, it is returned +-- +addDefTagC :: AttrC -> Ident -> CTag -> (AttrC, Maybe CTag) +addDefTagC ac ide obj = let tm = defTagsAC ac + (ac', obj') = defLocal tm ide obj + in + (ac {defTagsAC = ac'}, obj') + +-- lookup an identifier in the tag name space (EXPORTED) +-- +lookupDefTagC :: AttrC -> Ident -> Maybe CTag +lookupDefTagC ac ide = find (defTagsAC ac) ide + +-- lookup an identifier in the tag name space; if nothing found, try +-- whether there is a shadow identifier that matches (EXPORTED) +-- +-- * the returned identifier is the _real_ identifier of the tag +-- +lookupDefTagCShadow :: AttrC -> Ident -> Maybe (CTag, Ident) +lookupDefTagCShadow ac ide = + case lookupDefTagC ac ide of + Just tag -> Just (tag, ide) + Nothing -> case find (shadowsAC ac) ide of + Nothing -> Nothing + Just ide' -> case lookupDefTagC ac ide' of + Just tag -> Just (tag, ide') + Nothing -> Nothing + +-- enrich the shadow name space with identifiers obtained by dropping +-- the given prefix from the identifiers already in the object or tag name +-- space (EXPORTED) +-- +-- * in case of a collisions, a random entry is selected +-- +-- * case is not relevant in the prefix and underscores between the prefix and +-- the stem of an identifier are also dropped +-- +applyPrefix :: AttrC -> String -> AttrC +applyPrefix ac prefix = + let + shadows = shadowsAC ac + names = map fst (nameSpaceToList (defObjsAC ac)) + ++ map fst (nameSpaceToList (defTagsAC ac)) + newShadows = mapMaybe (strip prefix) names + in + ac {shadowsAC = foldl define shadows newShadows} + where + strip prefix ide = case eat prefix (identToLexeme ide) of + Nothing -> Nothing + Just "" -> Nothing + Just newName -> Just + (onlyPosIdent (posOf ide) newName, + ide) + -- + eat [] ('_':cs) = eat [] cs + eat [] cs = Just cs + eat (p:prefix) (c:cs) | toUpper p == toUpper c = eat prefix cs + | otherwise = Nothing + eat _ _ = Nothing + -- + define ns (ide, def) = fst (defGlobal ns ide def) + + +-- the attribute table operations on the attributes +-- + +-- get the definition associated with the given identifier (EXPORTED) +-- +getDefOfIdentC :: AttrC -> Ident -> CDef +getDefOfIdentC ac = getAttr (defsAC ac) . getIdentAttrs + +setDefOfIdentC :: AttrC -> Ident -> CDef -> AttrC +setDefOfIdentC ac id def = + let tot' = setAttr (defsAC ac) (getIdentAttrs id) def + in + ac {defsAC = tot'} + +updDefOfIdentC :: AttrC -> Ident -> CDef -> AttrC +updDefOfIdentC ac id def = + let tot' = updAttr (defsAC ac) (getIdentAttrs id) def + in + ac {defsAC = tot'} + +freezeDefOfIdentsAttrC :: AttrC -> AttrC +freezeDefOfIdentsAttrC ac = ac {defsAC = freezeAttrTable (defsAC ac)} + +softenDefOfIdentsAttrC :: AttrC -> AttrC +softenDefOfIdentsAttrC ac = ac {defsAC = softenAttrTable (defsAC ac)} + + +-- C objects including operations +-- ------------------------------ + +-- C objects data definition (EXPORTED) +-- +data CObj = TypeCO CDecl -- typedef declaration + | ObjCO CDecl -- object or function declaration + | EnumCO Ident CEnum -- enumerator + | BuiltinCO -- builtin object + +-- two C objects are equal iff they are defined by the same structure +-- tree node (i.e., the two nodes referenced have the same attribute +-- identifier) +-- +instance Eq CObj where + (TypeCO decl1 ) == (TypeCO decl2 ) = decl1 == decl2 + (ObjCO decl1 ) == (ObjCO decl2 ) = decl1 == decl2 + (EnumCO ide1 enum1) == (EnumCO ide2 enum2) = ide1 == ide2 && enum1 == enum2 + _ == _ = False + +instance Pos CObj where + posOf (TypeCO def ) = posOf def + posOf (ObjCO def ) = posOf def + posOf (EnumCO ide _) = posOf ide + posOf (BuiltinCO ) = builtinPos + + +-- C tagged objects including operations +-- ------------------------------------- + +-- C tagged objects data definition (EXPORTED) +-- +data CTag = StructUnionCT CStructUnion -- toplevel struct-union declaration + | EnumCT CEnum -- toplevel enum declaration + +-- two C tag objects are equal iff they are defined by the same structure +-- tree node (i.e., the two nodes referenced have the same attribute +-- identifier) +-- +instance Eq CTag where + (StructUnionCT struct1) == (StructUnionCT struct2) = struct1 == struct2 + (EnumCT enum1 ) == (EnumCT enum2 ) = enum1 == enum2 + _ == _ = False + +instance Pos CTag where + posOf (StructUnionCT def) = posOf def + posOf (EnumCT def) = posOf def + + +-- C general definition +-- -------------------- + +-- C general definition (EXPORTED) +-- +data CDef = UndefCD -- undefined object + | DontCareCD -- don't care object + | ObjCD CObj -- C object + | TagCD CTag -- C tag + +-- two C definitions are equal iff they are defined by the same structure +-- tree node (i.e., the two nodes referenced have the same attribute +-- identifier), but don't care objects are equal to everything and undefined +-- objects may not be compared +-- +instance Eq CDef where + (ObjCD obj1) == (ObjCD obj2) = obj1 == obj2 + (TagCD tag1) == (TagCD tag2) = tag1 == tag2 + DontCareCD == _ = True + _ == DontCareCD = True + UndefCD == _ = + interr "CAttrs: Attempt to compare an undefined C definition!" + _ == UndefCD = + interr "CAttrs: Attempt to compare an undefined C definition!" + _ == _ = False + +instance Attr CDef where + undef = UndefCD + dontCare = DontCareCD + + isUndef UndefCD = True + isUndef _ = False + + isDontCare DontCareCD = True + isDontCare _ = False + +instance Pos CDef where + posOf UndefCD = nopos + posOf DontCareCD = dontCarePos + posOf (ObjCD obj) = posOf obj + posOf (TagCD tag) = posOf tag + + +-- object tables (internal use only) +-- --------------------------------- + +-- the object name spavce +-- +type CObjNS = NameSpace CObj + +-- creating a new object name space +-- +cObjNS :: CObjNS +cObjNS = nameSpace + +-- the tag name space +-- +type CTagNS = NameSpace CTag + +-- creating a new tag name space +-- +cTagNS :: CTagNS +cTagNS = nameSpace + +-- the shadow name space +-- +type CShadowNS = NameSpace Ident + +-- creating a shadow name space +-- +cShadowNS :: CShadowNS +cShadowNS = nameSpace + +-- the general definition table +-- +type CDefTable = AttrTable CDef + +-- creating a new definition table +-- +cDefTable :: CDefTable +cDefTable = newAttrTable "C General Definition Table for Idents" diff --git a/c2hs/c/CBuiltin.hs b/c2hs/c/CBuiltin.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CBuiltin.hs @@ -0,0 +1,45 @@ +-- C->Haskell Compiler: C builtin information +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 12 February 01 +-- +-- Copyright (c) 2001 Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provides information about builtin entities. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Currently, only builtin type names are supported. The only builtin type +-- name is `__builtin_va_list', which is a builtin of GNU C. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CBuiltin ( + builtinTypeNames +) where + +import Position (builtinPos) +import Idents (Ident, onlyPosIdent) + +import CAttrs (CObj(BuiltinCO)) + + +-- predefined type names +-- +builtinTypeNames :: [(Ident, CObj)] +builtinTypeNames = [(onlyPosIdent builtinPos "__builtin_va_list", BuiltinCO)] diff --git a/c2hs/c/CLexer.x b/c2hs/c/CLexer.x new file mode 100644 --- /dev/null +++ b/c2hs/c/CLexer.x @@ -0,0 +1,434 @@ +-- C -> Haskell Compiler: Lexer for C Header Files +-- +-- Author : Manuel M T Chakravarty, Duncan Coutts +-- Created: 24 May 2005 +-- +-- Copyright (c) [1999..2004] Manuel M T Chakravarty +-- Copyright (c) 2005 Duncan Coutts +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Lexer for C header files after being processed by the C preprocessor +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- We assume that the input already went through cpp. Thus, we do not handle +-- comments and preprocessor directives here. The lexer recognizes all tokens +-- of ANCI C except those occuring only in function bodies. It supports the +-- C99 `restrict' extension: as +-- well as inline functions. +-- +-- Comments: +-- +-- * There is no support for the optional feature of extended characters (see +-- K&R A2.5.2) or the corresponding strings (A2.6). +-- +-- * We add `typedef-name' (K&R 8.9) as a token, as proposed in K&R A13. +-- However, as these tokens cannot be recognized lexically, but require a +-- context analysis, they are never produced by the lexer, but instead have +-- to be introduced in a later phase (by converting the corresponding +-- identifiers). +-- +-- * We also recognize GNU C `__attribute__', `__extension__', `__const', +-- `__const__', `__inline', `__inline__', `__restrict', and `__restrict__'. +-- +-- * Any line starting with `#pragma' is ignored. +-- +-- With K&R we refer to ``The C Programming Language'', second edition, Brain +-- W. Kernighan and Dennis M. Ritchie, Prentice Hall, 1988. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * `showsPrec' of `CTokCLit' should produce K&R-conforming escapes; +-- same for `CTokSLit' +-- +-- * There are more GNU C specific keywords. Add them and change `CParser' +-- correspondingly (in particular, most tokens within __attribute ((...)) +-- expressions are actually keywords, but we handle them as identifiers at +-- the moment). +-- + +{ + +module CLexer (lexC, parseError) where + +import Data.Char (isDigit) +import Numeric (readDec, readOct, readHex) + +import Position (Position(..), Pos(posOf)) +import Idents (lexemeToIdent) + +import CTokens +import CParserMonad + +} + +$space = [ \ \t ] -- horazontal white space +$eol = \n + +$letter = [a-zA-Z_] +$octdigit = 0-7 +$digit = 0-9 +$digitNZ = 1-9 +$hexdigit = [0-9a-fA-F] + +$inchar = \0-\255 # [ \\ \' \n \r ] +$instr = \0-\255 # [ \\ \" \n \r ] +$anyButNL = \0-\255 # \n +$infname = \ -\127 # [ \\ \" ] +$visible = \ -\127 + +@int = $digitNZ$digit* +@sp = $space* + +-- character escape sequence (follows K&R A2.5.2) +-- +-- * also used for strings +-- +@charesc = \\([ntvbrfae\\\?\'\"]|$octdigit{1,3}|x$hexdigit+) + +-- components of float constants (follows K&R A2.5.3) +-- +@digits = $digit+ +@intpart = @digits +@fractpart = @digits +@mantpart = @intpart?\.@fractpart|@intpart\. +@exppart = [eE][\+\-]?@digits +@suffix = [fFlL] + + +tokens :- + +-- whitespace (follows K&R A2.1) +-- +-- * horizontal and vertical tabs, newlines, and form feeds are filter out by +-- `Lexers.ctrlLexer' +-- +-- * comments are not handled, as we assume the input already went through cpp +-- +$white+ ; + +-- #line directive (K&R A12.6) +-- +-- * allows further ints after the file name a la GCC; as the GCC CPP docu +-- doesn't say how many ints there can be, we allow an unbound number +-- +\#$space*@int$space*(\"($infname|@charesc)*\"$space*)?(@int$space*)*$eol + { \pos len str -> setPos (adjustPos (take len str) pos) >> lexToken } + +-- #pragma directive (K&R A12.8) +-- +-- * we simply ignore any #pragma (but take care to update the position +-- information) +-- +\#$space*pragma$anyButNL*$eol ; + +-- #itent directive, eg used by rcs/cvs +-- +-- * we simply ignore any #itent (but take care to update the position +-- information) +-- +\#$space*ident$anyButNL*$eol ; + +-- identifiers and keywords (follows K&R A2.3 and A2.4) +-- +$letter($letter|$digit)* { \pos len str -> idkwtok (take len str) pos } + +-- constants (follows K&R A2.5) +-- +-- * K&R explicit mentions `enumeration-constants'; however, as they are +-- lexically identifiers, we do not have an extra case for them +-- + +-- integer constants (follows K&R A2.5.1) +-- +0$octdigit*[uUlL]{0,3} { token CTokILit (fst . head . readOct) } +$digitNZ$digit*[uUlL]{0,3} { token CTokILit (fst . head . readDec) } +0[xX]$hexdigit*[uUlL]{0,3} { token CTokILit (fst . head . readHex . drop 2) } + +-- character constants (follows K&R A2.5.2) +-- +\'($inchar|@charesc)\' { token CTokCLit (fst . oneChar . tail) } +L\'($inchar|@charesc)\' { token CTokCLit (fst . oneChar . tail . tail) } + +-- float constants (follows K&R A2.5.3) +-- +(@mantpart@exppart?|@intpart@exppart)@suffix? { token CTokFLit id } + +-- string literal (follows K&R A2.6) +-- +\"($instr|@charesc)*\" { token CTokSLit normalizeEscapes } +L\"($instr|@charesc)*\" { token CTokSLit (normalizeEscapes . tail) } + + +-- operators and separators +-- +"(" { token_ CTokLParen } +")" { token_ CTokRParen } +"[" { token_ CTokLBracket } +"]" { token_ CTokRBracket } +"->" { token_ CTokArrow } +"." { token_ CTokDot } +"!" { token_ CTokExclam } +"~" { token_ CTokTilde } +"++" { token_ CTokInc } +"--" { token_ CTokDec } +"+" { token_ CTokPlus } +"-" { token_ CTokMinus } +"*" { token_ CTokStar } +"/" { token_ CTokSlash } +"%" { token_ CTokPercent } +"&" { token_ CTokAmper } +"<<" { token_ CTokShiftL } +">>" { token_ CTokShiftR } +"<" { token_ CTokLess } +"<=" { token_ CTokLessEq } +">" { token_ CTokHigh } +">=" { token_ CTokHighEq } +"==" { token_ CTokEqual } +"!=" { token_ CTokUnequal } +"^" { token_ CTokHat } +"|" { token_ CTokBar } +"&&" { token_ CTokAnd } +"||" { token_ CTokOr } +"?" { token_ CTokQuest } +":" { token_ CTokColon } +"=" { token_ CTokAssign } +"+=" { token_ CTokPlusAss } +"-=" { token_ CTokMinusAss } +"*=" { token_ CTokStarAss } +"/=" { token_ CTokSlashAss } +"%=" { token_ CTokPercAss } +"&=" { token_ CTokAmpAss } +"^=" { token_ CTokHatAss } +"|=" { token_ CTokBarAss } +"<<=" { token_ CTokSLAss } +">>=" { token_ CTokSRAss } +"," { token_ CTokComma } +\; { token_ CTokSemic } +"{" { token_ CTokLBrace } +"}" { token_ CTokRBrace } +"..." { token_ CTokEllipsis } + + +{ + +-- We use the odd looking list of string patterns here rather than normal +-- string literals since GHC converts the latter into a sequence of string +-- comparisons (ie a linear search) but it translates the former using its +-- effecient pattern matching which gives us the expected radix-style search. +-- This gives change makes a significant performance difference. +-- +idkwtok :: String -> Position -> P CToken +idkwtok ('a':'l':'i':'g':'n':'o':'f':[]) = tok CTokAlignof +idkwtok ('_':'_':'a':'l':'i':'g':'n':'o':'f':[]) = tok CTokAlignof +idkwtok ('_':'_':'a':'l':'i':'g':'n':'o':'f':'_':'_':[]) = tok CTokAlignof +idkwtok ('a':'s':'m':[]) = tok CTokAsm +idkwtok ('_':'_':'a':'s':'m':[]) = tok CTokAsm +idkwtok ('_':'_':'a':'s':'m':'_':'_':[]) = tok CTokAsm +idkwtok ('a':'u':'t':'o':[]) = tok CTokAuto +idkwtok ('b':'r':'e':'a':'k':[]) = tok CTokBreak +idkwtok ('_':'B':'o':'o':'l':[]) = tok CTokBool +idkwtok ('c':'a':'s':'e':[]) = tok CTokCase +idkwtok ('c':'h':'a':'r':[]) = tok CTokChar +idkwtok ('c':'o':'n':'s':'t':[]) = tok CTokConst +idkwtok ('_':'_':'c':'o':'n':'s':'t':[]) = tok CTokConst +idkwtok ('_':'_':'c':'o':'n':'s':'t':'_':'_':[]) = tok CTokConst +idkwtok ('c':'o':'n':'t':'i':'n':'u':'e':[]) = tok CTokContinue +idkwtok ('_':'C':'o':'m':'p':'l':'e':'x':[]) = tok CTokComplex +idkwtok ('d':'e':'f':'a':'u':'l':'t':[]) = tok CTokDefault +idkwtok ('d':'o':[]) = tok CTokDo +idkwtok ('d':'o':'u':'b':'l':'e':[]) = tok CTokDouble +idkwtok ('e':'l':'s':'e':[]) = tok CTokElse +idkwtok ('e':'n':'u':'m':[]) = tok CTokEnum +idkwtok ('e':'x':'t':'e':'r':'n':[]) = tok CTokExtern +idkwtok ('f':'l':'o':'a':'t':[]) = tok CTokFloat +idkwtok ('f':'o':'r':[]) = tok CTokFor +idkwtok ('g':'o':'t':'o':[]) = tok CTokGoto +idkwtok ('i':'f':[]) = tok CTokIf +idkwtok ('i':'n':'l':'i':'n':'e':[]) = tok CTokInline +idkwtok ('_':'_':'i':'n':'l':'i':'n':'e':[]) = tok CTokInline +idkwtok ('_':'_':'i':'n':'l':'i':'n':'e':'_':'_':[]) = tok CTokInline +idkwtok ('i':'n':'t':[]) = tok CTokInt +idkwtok ('l':'o':'n':'g':[]) = tok CTokLong +idkwtok ('r':'e':'g':'i':'s':'t':'e':'r':[]) = tok CTokRegister +idkwtok ('r':'e':'s':'t':'r':'i':'c':'t':[]) = tok CTokRestrict +idkwtok ('_':'_':'r':'e':'s':'t':'r':'i':'c':'t':[]) = tok CTokRestrict +idkwtok ('_':'_':'r':'e':'s':'t':'r':'i':'c':'t':'_':'_':[]) = tok CTokRestrict +idkwtok ('r':'e':'t':'u':'r':'n':[]) = tok CTokReturn +idkwtok ('s':'h':'o':'r':'t':[]) = tok CTokShort +idkwtok ('s':'i':'g':'n':'e':'d':[]) = tok CTokSigned +idkwtok ('_':'_':'s':'i':'g':'n':'e':'d':[]) = tok CTokSigned +idkwtok ('_':'_':'s':'i':'g':'n':'e':'d':'_':'_':[]) = tok CTokSigned +idkwtok ('s':'i':'z':'e':'o':'f':[]) = tok CTokSizeof +idkwtok ('s':'t':'a':'t':'i':'c':[]) = tok CTokStatic +idkwtok ('s':'t':'r':'u':'c':'t':[]) = tok CTokStruct +idkwtok ('s':'w':'i':'t':'c':'h':[]) = tok CTokSwitch +idkwtok ('t':'y':'p':'e':'d':'e':'f':[]) = tok CTokTypedef +idkwtok ('t':'y':'p':'e':'o':'f':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'y':'p':'e':'o':'f':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'y':'p':'e':'o':'f':'_':'_':[]) = tok CTokTypeof +idkwtok ('_':'_':'t':'h':'r':'e':'a':'d':[]) = tok CTokThread +idkwtok ('u':'n':'i':'o':'n':[]) = tok CTokUnion +idkwtok ('u':'n':'s':'i':'g':'n':'e':'d':[]) = tok CTokUnsigned +idkwtok ('v':'o':'i':'d':[]) = tok CTokVoid +idkwtok ('v':'o':'l':'a':'t':'i':'l':'e':[]) = tok CTokVolatile +idkwtok ('_':'_':'v':'o':'l':'a':'t':'i':'l':'e':[]) = tok CTokVolatile +idkwtok ('_':'_':'v':'o':'l':'a':'t':'i':'l':'e':'_':'_':[]) = tok CTokVolatile +idkwtok ('w':'h':'i':'l':'e':[]) = tok CTokWhile +idkwtok ('_':'_':'l':'a':'b':'e':'l':'_':'_':[]) = tok CTokLabel +idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':[]) = tok (CTokGnuC GnuCAttrTok) +-- ignoreAttribute >> lexToken +idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':'_':'_':[]) = tok (CTokGnuC GnuCAttrTok) +-- ignoreAttribute >> lexToken +idkwtok ('_':'_':'e':'x':'t':'e':'n':'s':'i':'o':'n':'_':'_':[]) = + tok (CTokGnuC GnuCExtTok) +idkwtok ('_':'_':'b':'u':'i':'l':'t':'i':'n':'_':rest) + | rest == "va_arg" = tok (CTokGnuC GnuCVaArg) + | rest == "offsetof" = tok (CTokGnuC GnuCOffsetof) + | rest == "types_compatible_p" = tok (CTokGnuC GnuCTyCompat) + +idkwtok cs = \pos -> do + name <- getNewName + let ident = lexemeToIdent pos cs name + tyident <- isTypeIdent ident + if tyident + then return (CTokTyIdent pos ident) + else return (CTokIdent pos ident) + +ignoreAttribute :: P () +ignoreAttribute = skipTokens 0 + where skipTokens n = do + tok <- lexToken + case tok of + CTokRParen _ | n == 1 -> return () + | otherwise -> skipTokens (n-1) + CTokLParen _ -> skipTokens (n+1) + _ -> skipTokens n + +tok :: (Position -> CToken) -> Position -> P CToken +tok tc pos = return (tc pos) + +-- converts the first character denotation of a C-style string to a character +-- and the remaining string +-- +oneChar :: String -> (Char, String) +oneChar ('\\':c:cs) = case c of + 'n' -> ('\n', cs) + 't' -> ('\t', cs) + 'v' -> ('\v', cs) + 'b' -> ('\b', cs) + 'r' -> ('\r', cs) + 'f' -> ('\f', cs) + 'a' -> ('\a', cs) + 'e' -> ('\ESC', cs) --GNU C extension + '\\' -> ('\\', cs) + '?' -> ('?', cs) + '\'' -> ('\'', cs) + '"' -> ('"', cs) + 'x' -> case head (readHex cs) of + (i, cs') -> (toEnum i, cs') + _ -> case head (readOct (c:cs)) of + (i, cs') -> (toEnum i, cs') +oneChar (c :cs) = (c, cs) + +normalizeEscapes [] = [] +normalizeEscapes cs = case oneChar cs of + (c, cs') -> c : normalizeEscapes cs' + +adjustPos :: String -> Position -> Position +adjustPos str (Position fname row _) = Position fname' row' 0 + where + str' = dropWhite . drop 1 $ str + (rowStr, str'') = span isDigit str' + row' = read rowStr + str''' = dropWhite str'' + fnameStr = takeWhile (/= '"') . drop 1 $ str''' + fname' | null str''' || head str''' /= '"' = fname + -- try and get more sharing of file name strings + | fnameStr == fname = fname + | otherwise = fnameStr + -- + dropWhite = dropWhile (\c -> c == ' ' || c == '\t') + +{-# INLINE token_ #-} +-- token that ignores the string +token_ :: (Position -> CToken) -> Position -> Int -> String -> P CToken +token_ tok pos _ _ = return (tok pos) + +{-# INLINE token #-} +-- token that uses the string +token :: (Position -> a -> CToken) -> (String -> a) + -> Position -> Int -> String -> P CToken +token tok read pos len str = return (tok pos (read $ take len str)) + + +-- ----------------------------------------------------------------------------- +-- The input type + +type AlexInput = (Position, -- current position, + String) -- current input string + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar _ = error "alexInputPrevChar not used" + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p,[]) = Nothing +alexGetChar (p,(c:s)) = let p' = alexMove p c in p' `seq` + Just (c, (p', s)) + +alexMove :: Position -> Char -> Position +alexMove (Position f l c) '\t' = Position f l (((c+7) `div` 8)*8+1) +alexMove (Position f l c) '\n' = Position f (l+1) 1 +alexMove (Position f l c) _ = Position f l (c+1) + +lexicalError :: P a +lexicalError = do + pos <- getPos + (c:cs) <- getInput + failP pos + ["Lexical error!", + "The character " ++ show c ++ " does not fit here."] + +parseError :: P a +parseError = do + tok <- getLastToken + failP (posOf tok) + ["Syntax error!", + "The symbol `" ++ show tok ++ "' does not fit here."] + +lexToken :: P CToken +lexToken = do + pos <- getPos + inp <- getInput + case alexScan (pos, inp) 0 of + AlexEOF -> return CTokEof + AlexError inp' -> lexicalError + AlexSkip (pos', inp') len -> do + setPos pos' + setInput inp' + lexToken + AlexToken (pos', inp') len action -> do + setPos pos' + setInput inp' + tok <- action pos len inp + setLastToken tok + return tok + +lexC :: (CToken -> P a) -> P a +lexC cont = do + tok <- lexToken + cont tok +} diff --git a/c2hs/c/CNames.hs b/c2hs/c/CNames.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CNames.hs @@ -0,0 +1,215 @@ +-- C->Haskell Compiler: C name analysis +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 16 October 99 +-- +-- Copyright (c) 1999 Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Name analysis of C header files. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * Member names are not looked up, because this requires type information +-- about the expressions before the `.' or `->'. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * `defObjOrErr': currently, repeated declarations are completely ignored; +-- eventually, the consistency of the declarations should be checked +-- + +module CNames (nameAnalysis) +where + +import Control.Monad (mapM_) + +import Position (Position, posOf) +import Idents (Ident, identToLexeme) + +import C2HSState (CST) +import CAST +import CAttrs (AttrC, emptyAttrC, CObj(..), CTag(..), CDef(..)) +import CBuiltin (builtinTypeNames) +import CTrav (CT, runCT, enterObjs, leaveObjs, + ifCTExc, raiseErrorCTExc, defObj, findTypeObj, findValueObj, + defTag, refersToDef, isTypedef) + + +-- monad and wrapper +-- ----------------- + +-- local instance of the C traversal monad +-- +type NA a = CT () a + +-- name analysis of C header files (EXPORTED) +-- +nameAnalysis :: CHeader -> CST s AttrC +nameAnalysis headder = do + (ac', _) <- runCT (naCHeader headder) emptyAttrC () + return ac' + + +-- name analyis traversal +-- ---------------------- + +-- traverse a complete header file +-- +-- * in case of an error, back off the current declaration +-- +naCHeader :: CHeader -> NA () +naCHeader (CHeader decls _) = do + -- establish definitions for builtins + -- + mapM_ (uncurry defObjOrErr) builtinTypeNames + -- + -- analyse the header + -- + mapM_ (\decl -> naCExtDecl decl `ifCTExc` return ()) decls + +-- Processing of toplevel declarations +-- +-- * We turn function definitions into prototypes, as we are not interested in +-- function bodies. +-- +naCExtDecl :: CExtDecl -> NA () +naCExtDecl (CDeclExt decl ) = naCDecl decl +naCExtDecl (CFDefExt (CFunDef specs declr _ _ at)) = + naCDecl $ CDecl specs [(Just declr, Nothing, Nothing)] at +naCExtDecl (CAsmExt at ) = return () + +naCDecl :: CDecl -> NA () +naCDecl decl@(CDecl specs decls _) = + do + mapM_ naCDeclSpec specs + mapM_ naTriple decls + where + naTriple (odeclr, oinit, oexpr) = + do + let obj = if isTypedef decl then TypeCO decl else ObjCO decl + mapMaybeM_ (naCDeclr obj) odeclr + mapMaybeM_ naCInit oinit + mapMaybeM_ naCExpr oexpr + +naCDeclSpec :: CDeclSpec -> NA () +naCDeclSpec (CTypeSpec tspec) = naCTypeSpec tspec +naCDeclSpec _ = return () + +naCTypeSpec :: CTypeSpec -> NA () +naCTypeSpec (CSUType su _) = naCStructUnion (StructUnionCT su) su +naCTypeSpec (CEnumType enum _) = naCEnum (EnumCT enum) enum +naCTypeSpec (CTypeDef ide _) = do + (obj, _) <- findTypeObj ide False + ide `refersToDef` ObjCD obj +naCTypeSpec _ = return () + +naCStructUnion :: CTag -> CStructUnion -> NA () +naCStructUnion tag (CStruct _ oide decls _) = + do + mapMaybeM_ (`defTagOrErr` tag) oide + enterObjs -- enter local struct range for objects + mapM_ naCDecl decls + leaveObjs -- leave range + +naCEnum :: CTag -> CEnum -> NA () +naCEnum tag enum@(CEnum oide enumrs _) = + do + mapMaybeM_ (`defTagOrErr` tag) oide + mapM_ naEnumr enumrs + where + naEnumr (ide, oexpr) = do + ide `defObjOrErr` EnumCO ide enum + mapMaybeM_ naCExpr oexpr + +naCDeclr :: CObj -> CDeclr -> NA () +naCDeclr obj (CVarDeclr oide _) = + mapMaybeM_ (`defObjOrErr` obj) oide +naCDeclr obj (CPtrDeclr _ declr _ ) = + naCDeclr obj declr +naCDeclr obj (CArrDeclr declr _ oexpr _ ) = + do + naCDeclr obj declr + mapMaybeM_ naCExpr oexpr +naCDeclr obj (CFunDeclr declr decls _ _ ) = + do + naCDeclr obj declr + enterObjs -- enter range of function arguments + mapM_ naCDecl decls + leaveObjs -- end of function arguments + +naCInit :: CInit -> NA () +naCInit (CInitExpr expr _) = naCExpr expr +naCInit (CInitList inits _) = mapM_ (naCInit . snd) inits + +naCExpr :: CExpr -> NA () +naCExpr (CComma exprs _) = mapM_ naCExpr exprs +naCExpr (CAssign _ expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2 +naCExpr (CCond expr1 expr2 expr3 _) = naCExpr expr1 >> mapMaybeM_ naCExpr expr2 + >> naCExpr expr3 +naCExpr (CBinary _ expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2 +naCExpr (CCast decl expr _) = naCDecl decl >> naCExpr expr +naCExpr (CUnary _ expr _) = naCExpr expr +naCExpr (CSizeofExpr expr _) = naCExpr expr +naCExpr (CSizeofType decl _) = naCDecl decl +naCExpr (CAlignofExpr expr _) = naCExpr expr +naCExpr (CAlignofType decl _) = naCDecl decl +naCExpr (CIndex expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2 +naCExpr (CCall expr exprs _) = naCExpr expr >> mapM_ naCExpr exprs +naCExpr (CMember expr ide _ _) = naCExpr expr +naCExpr (CVar ide _) = do + (obj, _) <- findValueObj ide False + ide `refersToDef` ObjCD obj +naCExpr (CConst _ _) = return () +naCExpr (CCompoundLit _ inits _) = mapM_ (naCInit . snd) inits + + +-- auxilliary functions +-- -------------------- + +-- raise an error and exception if the identifier is defined twice +-- +defTagOrErr :: Ident -> CTag -> NA () +ide `defTagOrErr` tag = do + otag <- ide `defTag` tag + case otag of + Nothing -> return () + Just tag' -> declaredTwiceErr ide (posOf tag') + +-- associate an object with a referring identifier +-- +-- * currently, repeated declarations are completely ignored; eventually, the +-- consistency of the declarations should be checked +-- +defObjOrErr :: Ident -> CObj -> NA () +ide `defObjOrErr` obj = ide `defObj` obj >> return () + +-- maps some monad operation into a `Maybe', discarding the result +-- +mapMaybeM_ :: Monad m => (a -> m b) -> Maybe a -> m () +mapMaybeM_ m Nothing = return () +mapMaybeM_ m (Just a) = m a >> return () + + +-- error messages +-- -------------- + +declaredTwiceErr :: Ident -> Position -> NA a +declaredTwiceErr ide otherPos = + raiseErrorCTExc (posOf ide) + ["Identifier declared twice!", + "The identifier `" ++ identToLexeme ide ++ "' was already declared at " + ++ show otherPos ++ "."] diff --git a/c2hs/c/CParser.y b/c2hs/c/CParser.y new file mode 100644 --- /dev/null +++ b/c2hs/c/CParser.y @@ -0,0 +1,1926 @@ +-- C -> Haskell Compiler: Parser for C Header Files +-- +-- Author : Duncan Coutts, Manuel M T Chakravarty +-- Created: 29 May 2005 +-- +-- Copyright (c) 2005-2007 Duncan Coutts +-- Copyright (c) [1999..2004] Manuel M T Chakravarty +-- Portions Copyright (c) 1989, 1990 James A. Roskind +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Parser for C translation units, which have already been run through the C +-- preprocessor. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- The parser recognizes all of ISO C 99 and most common GNU C extensions. +-- +-- With C99 we refer to the ISO C99 standard, specifically the section numbers +-- used below refer to this report: +-- +-- http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1124.pdf +-- +-- +-- Since some of the grammar productions are quite difficult to read +-- (especially those involved with the decleration syntax) we document them +-- with an extended syntax that allows a more consise representation: +-- +-- Ordinary rules +-- +-- foo named terminal or non-terminal +-- +-- 'c' terminal, literal character token +-- +-- A B concatenation +-- +-- A | B alternation +-- +-- (A) grouping +-- +-- Extended rules +-- +-- A? optional, short hand for (A|) or [A]{ 0==A || 1==A } +-- +-- ... stands for some part of the grammar omitted for clarity +-- +-- [A] represents sequences, 0 or more. +-- +-- [A]{C} sequences with some constraint, usually on the number of +-- terminals or non-terminals appearing in the sequence. +-- +-- Constraints on sequences +-- +-- n==t terminal or non-terminal t must appear exactly n times +-- +-- n>=t terminal or non-terminal t must appear at least n times +-- +-- C1 && C1 conjunction of constraints +-- +-- C1 || C2 disjunction of constraints +-- +-- C1 |x| C2 exclusive disjunction of constraints +-- +-- +-- Comments: +-- +-- * Subtrees representing empty declarators of the form `CVarDeclr Nothing +-- at' have *no* valid attribute handle in `at' (only a `newAttrsOnlyPos +-- nopos'). +-- +-- * Builtin type names are imported from `CBuiltin'. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * GNUC __attribute__s should be enetered into the parse tree since they +-- contain useful api/abi information. +-- +-- * Some other extensions are currently recognised by the parser but not +-- entered into the parse tree. +-- + +{ +module CParser (parseC) where + +import Prelude hiding (reverse) +import qualified Data.List as List + +import Position (Position, Pos(..), nopos) +import UNames (names) +import Idents (Ident) +import Attributes (Attrs, newAttrs, newAttrsOnlyPos) + +import State (PreCST, raiseFatal, getNameSupply) +import CLexer (lexC, parseError) +import CAST (CHeader(..), CExtDecl(..), CFunDef(..), CStat(..), + CBlockItem(..), CDecl(..), CDeclSpec(..), CStorageSpec(..), + CTypeSpec(..), CTypeQual(..), CStructUnion(..), + CStructTag(..), CEnum(..), CDeclr(..), CInit(..), CInitList, + CDesignator(..), CExpr(..), CAssignOp(..), CBinaryOp(..), + CUnaryOp(..), CConst (..)) +import CBuiltin (builtinTypeNames) +import CTokens (CToken(..), GnuCTok(..)) +import CParserMonad (P, execParser, getNewName, addTypedef, shadowTypedef, + enterScope, leaveScope ) +} + +%name header header +%tokentype { CToken } + +%monad { P } { >>= } { return } +%lexer { lexC } { CTokEof } + +%expect 1 + +%token + +'(' { CTokLParen _ } +')' { CTokRParen _ } +'[' { CTokLBracket _ } +']' { CTokRBracket _ } +"->" { CTokArrow _ } +'.' { CTokDot _ } +'!' { CTokExclam _ } +'~' { CTokTilde _ } +"++" { CTokInc _ } +"--" { CTokDec _ } +'+' { CTokPlus _ } +'-' { CTokMinus _ } +'*' { CTokStar _ } +'/' { CTokSlash _ } +'%' { CTokPercent _ } +'&' { CTokAmper _ } +"<<" { CTokShiftL _ } +">>" { CTokShiftR _ } +'<' { CTokLess _ } +"<=" { CTokLessEq _ } +'>' { CTokHigh _ } +">=" { CTokHighEq _ } +"==" { CTokEqual _ } +"!=" { CTokUnequal _ } +'^' { CTokHat _ } +'|' { CTokBar _ } +"&&" { CTokAnd _ } +"||" { CTokOr _ } +'?' { CTokQuest _ } +':' { CTokColon _ } +'=' { CTokAssign _ } +"+=" { CTokPlusAss _ } +"-=" { CTokMinusAss _ } +"*=" { CTokStarAss _ } +"/=" { CTokSlashAss _ } +"%=" { CTokPercAss _ } +"&=" { CTokAmpAss _ } +"^=" { CTokHatAss _ } +"|=" { CTokBarAss _ } +"<<=" { CTokSLAss _ } +">>=" { CTokSRAss _ } +',' { CTokComma _ } +';' { CTokSemic _ } +'{' { CTokLBrace _ } +'}' { CTokRBrace _ } +"..." { CTokEllipsis _ } +alignof { CTokAlignof _ } +asm { CTokAsm _ } +auto { CTokAuto _ } +break { CTokBreak _ } +"_Bool" { CTokBool _ } +case { CTokCase _ } +char { CTokChar _ } +const { CTokConst _ } +continue { CTokContinue _ } +"_Complex" { CTokComplex _ } +default { CTokDefault _ } +do { CTokDo _ } +double { CTokDouble _ } +else { CTokElse _ } +enum { CTokEnum _ } +extern { CTokExtern _ } +float { CTokFloat _ } +for { CTokFor _ } +goto { CTokGoto _ } +if { CTokIf _ } +inline { CTokInline _ } +int { CTokInt _ } +long { CTokLong _ } +"__label__" { CTokLabel _ } +register { CTokRegister _ } +restrict { CTokRestrict _ } +return { CTokReturn _ } +short { CTokShort _ } +signed { CTokSigned _ } +sizeof { CTokSizeof _ } +static { CTokStatic _ } +struct { CTokStruct _ } +switch { CTokSwitch _ } +typedef { CTokTypedef _ } +typeof { CTokTypeof _ } +"__thread" { CTokThread _ } +union { CTokUnion _ } +unsigned { CTokUnsigned _ } +void { CTokVoid _ } +volatile { CTokVolatile _ } +while { CTokWhile _ } +cchar { CTokCLit _ _ } -- character constant +cint { CTokILit _ _ } -- integer constant +cfloat { CTokFLit _ _ } -- float constant +cstr { CTokSLit _ _ } -- string constant (no escapes) +ident { CTokIdent _ $$ } -- identifier +tyident { CTokTyIdent _ $$ } -- `typedef-name' identifier +"__attribute__" { CTokGnuC GnuCAttrTok _ } -- special GNU C tokens +"__extension__" { CTokGnuC GnuCExtTok _ } -- special GNU C tokens + +-- special GNU C builtin 'functions' that actually take types as parameters: +"__builtin_va_arg" { CTokGnuC GnuCVaArg _ } +"__builtin_offsetof" { CTokGnuC GnuCOffsetof _ } +"__builtin_types_compatible_p" { CTokGnuC GnuCTyCompat _ } + +%% + + +-- parse a complete C header file +-- +header :: { CHeader } +header + : translation_unit {% withAttrs $1 $ CHeader (reverse $1) } + + +-- parse a complete C translation unit (C99 6.9) +-- +-- * GNU extensions: +-- allow empty translation_unit +-- allow redundant ';' +-- +translation_unit :: { Reversed [CExtDecl] } +translation_unit + : {- empty -} { empty } + | translation_unit ';' { $1 } + | translation_unit external_declaration { $1 `snoc` $2 } + + +-- parse external C declaration (C99 6.9) +-- +-- * GNU extensions: +-- allow extension keyword before external declaration +-- asm definitions +-- +external_declaration :: { CExtDecl } +external_declaration + : attrs_opt function_definition { CFDefExt $2 } + | attrs_opt declaration { CDeclExt $2 } + | "__extension__" external_declaration { $2 } + | asm '(' string_literal ')' ';' {% withAttrs $2 CAsmExt } + + +-- parse C function definition (C99 6.9.1) +-- +function_definition :: { CFunDef } +function_definition + : function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef [] $1 [] $2) } + + | declaration_specifier function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) } + + | type_specifier function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) } + + | declaration_qualifier_list function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef (reverse $1) $2 [] $3) } + + | type_qualifier_list function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 [] $3) } + + | old_function_declarator declaration_list compound_statement + {% withAttrs $1 $ CFunDef [] $1 (reverse $2) $3 } + + | declaration_specifier old_function_declarator declaration_list compound_statement + {% withAttrs $1 $ CFunDef $1 $2 (reverse $3) $4 } + + | type_specifier old_function_declarator declaration_list compound_statement + {% withAttrs $1 $ CFunDef $1 $2 (reverse $3) $4 } + + | declaration_qualifier_list old_function_declarator declaration_list compound_statement + {% withAttrs $1 $ CFunDef (reverse $1) $2 (reverse $3) $4 } + + | type_qualifier_list old_function_declarator declaration_list compound_statement + {% withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 (reverse $3) $4 } + + +function_declarator :: { CDeclr } +function_declarator + : identifier_declarator + {% enterScope >> doFuncParamDeclIdent $1 >> return $1 } + + +declaration_list :: { Reversed [CDecl] } +declaration_list + : {- empty -} { empty } + | declaration_list declaration { $1 `snoc` $2 } + + +-- parse C statement (C99 6.8) +-- +-- * GNU extension: ' __asm__ (...); ' statements +-- +statement :: { CStat } +statement + : labeled_statement { $1 } + | compound_statement { $1 } + | expression_statement { $1 } + | selection_statement { $1 } + | iteration_statement { $1 } + | jump_statement { $1 } + | asm_statement { $1 } + + +-- parse C labeled statement (C99 6.8.1) +-- +-- * GNU extension: case ranges +-- +labeled_statement :: { CStat } +labeled_statement + : identifier ':' attrs_opt statement {% withAttrs $2 $ CLabel $1 $4} + | case constant_expression ':' statement {% withAttrs $1 $ CCase $2 $4 } + | default ':' statement {% withAttrs $1 $ CDefault $3 } + | case constant_expression "..." constant_expression ':' statement + {% withAttrs $1 $ CCases $2 $4 $6 } + + +-- parse C compound statement (C99 6.8.2) +-- +-- * GNU extension: '__label__ ident;' declarations +-- +compound_statement :: { CStat } +compound_statement + : '{' enter_scope block_item_list leave_scope '}' + {% withAttrs $1 $ CCompound (reverse $3) } + + | '{' enter_scope label_declarations block_item_list leave_scope '}' + {% withAttrs $1 $ CCompound (reverse $4) } + + +-- No syntax for these, just side effecting semantic actions. +-- +enter_scope :: { () } +enter_scope : {% enterScope } +leave_scope :: { () } +leave_scope : {% leaveScope } + + +block_item_list :: { Reversed [CBlockItem] } +block_item_list + : {- empty -} { empty } + | block_item_list block_item { $1 `snoc` $2 } + + +block_item :: { CBlockItem } +block_item + : statement { CBlockStmt $1 } + | nested_declaration { $1 } + + +nested_declaration :: { CBlockItem } +nested_declaration + : declaration { CBlockDecl $1 } + | attrs declaration { CBlockDecl $2 } + | nested_function_definition { CNestedFunDef $1 } + | attrs nested_function_definition { CNestedFunDef $2 } + | "__extension__" nested_declaration { $2 } + + +nested_function_definition :: { CFunDef } +nested_function_definition + : declaration_specifier function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) } + + | type_specifier function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) } + + | declaration_qualifier_list function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef (reverse $1) $2 [] $3) } + + | type_qualifier_list function_declarator compound_statement + {% leaveScope >> (withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 [] $3) } + + +label_declarations :: { () } +label_declarations + : "__label__" identifier_list ';' { () } + | label_declarations "__label__" identifier_list ';' { () } + + +-- parse C expression statement (C99 6.8.3) +-- +expression_statement :: { CStat } +expression_statement + : ';' {% withAttrs $1 $ CExpr Nothing } + | expression ';' {% withAttrs $1 $ CExpr (Just $1) } + + +-- parse C selection statement (C99 6.8.4) +-- +selection_statement :: { CStat } +selection_statement + : if '(' expression ')' statement + {% withAttrs $1 $ CIf $3 $5 Nothing } + + | if '(' expression ')' statement else statement + {% withAttrs $1 $ CIf $3 $5 (Just $7) } + + | switch '(' expression ')' statement + {% withAttrs $1 $ CSwitch $3 $5 } + + +-- parse C iteration statement (C99 6.8.5) +-- +iteration_statement :: { CStat } +iteration_statement + : while '(' expression ')' statement + {% withAttrs $1 $ CWhile $3 $5 False } + + | do statement while '(' expression ')' ';' + {% withAttrs $1 $ CWhile $5 $2 True } + + | for '(' expression_opt ';' expression_opt ';' expression_opt ')' statement + {% withAttrs $1 $ CFor (Left $3) $5 $7 $9 } + + | for '(' enter_scope declaration expression_opt ';' expression_opt ')' statement leave_scope + {% withAttrs $1 $ CFor (Right $4) $5 $7 $9 } + + +-- parse C jump statement (C99 6.8.6) +-- +-- * GNU extension: computed gotos +-- +jump_statement :: { CStat } +jump_statement + : goto identifier ';' {% withAttrs $1 $ CGoto $2 } + | goto '*' expression ';' {% withAttrs $1 $ CGotoPtr $3 } + | continue ';' {% withAttrs $1 $ CCont } + | break ';' {% withAttrs $1 $ CBreak } + | return expression_opt ';' {% withAttrs $1 $ CReturn $2 } + + +-- parse GNU C __asm__ (...) statement (recording only a place holder result) +-- +asm_statement :: { CStat } +asm_statement + : asm maybe_type_qualifier '(' expression ')' ';' + {% withAttrs $1 CAsm } + + | asm maybe_type_qualifier '(' expression ':' asm_operands ')' ';' + {% withAttrs $1 CAsm } + + | asm maybe_type_qualifier '(' expression ':' asm_operands + ':' asm_operands ')' ';' + {% withAttrs $1 CAsm } + | asm maybe_type_qualifier '(' expression ':' asm_operands ':' asm_operands + ':' asm_clobbers ')' ';' + {% withAttrs $1 CAsm } + + +maybe_type_qualifier :: { () } +maybe_type_qualifier + : {- empty -} { () } + | type_qualifier { () } + + +asm_operands :: { () } +asm_operands + : {- empty -} { () } + | nonnull_asm_operands { () } + + +nonnull_asm_operands :: { () } +nonnull_asm_operands + : asm_operand { () } + | nonnull_asm_operands ',' asm_operand { () } + + +asm_operand :: { () } +asm_operand + : string_literal '(' expression ')' { () } + | '[' ident ']' string_literal '(' expression ')' { () } + | '[' tyident ']' string_literal '(' expression ')' { () } + + +asm_clobbers :: { () } +asm_clobbers + : string_literal { () } + | asm_clobbers ',' string_literal { () } + + +-- parse C declaration (C99 6.7) +-- +declaration :: { CDecl } +declaration + : sue_declaration_specifier ';' + {% withAttrs $1 $ CDecl (reverse $1) [] } + + | sue_type_specifier ';' + {% withAttrs $1 $ CDecl (reverse $1) [] } + + | declaring_list ';' + { case $1 of + CDecl declspecs dies attr -> + CDecl declspecs (List.reverse dies) attr } + + | default_declaring_list ';' + { case $1 of + CDecl declspecs dies attr -> + CDecl declspecs (List.reverse dies) attr } + + +-- Note that if a typedef were redeclared, then a declaration +-- specifier must be supplied +-- +-- Can't redeclare typedef names +-- +default_declaring_list :: { CDecl } +default_declaring_list + : declaration_qualifier_list identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt + {% let declspecs = reverse $1 in + doDeclIdent declspecs $2 + >> (withAttrs $1 $ CDecl declspecs [(Just $2, $5, Nothing)]) } + + | type_qualifier_list identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt + {% let declspecs = liftTypeQuals $1 in + doDeclIdent declspecs $2 + >> (withAttrs $1 $ CDecl declspecs [(Just $2, $5, Nothing)]) } + + | default_declaring_list ',' identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt + {% case $1 of + CDecl declspecs dies attr -> do + doDeclIdent declspecs $3 + return (CDecl declspecs ((Just $3, $6, Nothing) : dies) attr) } + + +declaring_list :: { CDecl } +declaring_list + : declaration_specifier declarator asm_opt attrs_opt {-{}-} initializer_opt + {% doDeclIdent $1 $2 + >> (withAttrs $1 $ CDecl $1 [(Just $2, $5, Nothing)]) } + + | type_specifier declarator asm_opt attrs_opt {-{}-} initializer_opt + {% doDeclIdent $1 $2 + >> (withAttrs $1 $ CDecl $1 [(Just $2, $5, Nothing)]) } + + | declaring_list ',' declarator asm_opt attrs_opt {-{}-} initializer_opt + {% case $1 of + CDecl declspecs dies attr -> do + doDeclIdent declspecs $3 + return (CDecl declspecs ((Just $3, $6, Nothing) : dies) attr) } + + +-- parse C declaration specifiers (C99 6.7) +-- +-- * summary: +-- [ type_qualifier | storage_class +-- | basic_type_name | elaborated_type_name | tyident ]{ +-- ( 1 >= basic_type_name +-- |x| 1 == elaborated_type_name +-- |x| 1 == tyident +-- ) && 1 >= storage_class +-- } +-- +declaration_specifier :: { [CDeclSpec] } +declaration_specifier + : basic_declaration_specifier { reverse $1 } -- Arithmetic or void + | sue_declaration_specifier { reverse $1 } -- Struct/Union/Enum + | typedef_declaration_specifier { reverse $1 } -- Typedef + + +-- A mixture of type qualifiers and storage class specifiers in any order, but +-- containing at least one storage class specifier. +-- +-- * summary: +-- [type_qualifier | storage_class]{ 1 >= storage_class } +-- +-- * detail: +-- [type_qualifier] storage_class [type_qualifier | storage_class] +-- +declaration_qualifier_list :: { Reversed [CDeclSpec] } +declaration_qualifier_list + : storage_class + { singleton (CStorageSpec $1) } + + | type_qualifier_list storage_class + { rmap CTypeQual $1 `snoc` CStorageSpec $2 } + + | declaration_qualifier_list declaration_qualifier + { $1 `snoc` $2 } + + | declaration_qualifier_list attr + { $1 } + + +declaration_qualifier :: { CDeclSpec } +declaration_qualifier + : storage_class { CStorageSpec $1 } + | type_qualifier { CTypeQual $1 } -- const or volatile + + +-- parse C storage class specifier (C99 6.7.1) +-- +-- * GNU extensions: '__thread' thread local storage +-- +storage_class :: { CStorageSpec } +storage_class + : typedef {% withAttrs $1 $ CTypedef } + | extern {% withAttrs $1 $ CExtern } + | static {% withAttrs $1 $ CStatic } + | auto {% withAttrs $1 $ CAuto } + | register {% withAttrs $1 $ CRegister } + | "__thread" {% withAttrs $1 $ CThread } + + +-- parse C type specifier (C99 6.7.2) +-- +-- This recignises a whole list of type specifiers rather than just one +-- as in the C99 grammar. +-- +-- * summary: +-- [type_qualifier | basic_type_name | elaborated_type_name | tyident]{ +-- 1 >= basic_type_name +-- |x| 1 == elaborated_type_name +-- |x| 1 == tyident +-- } +-- +type_specifier :: { [CDeclSpec] } +type_specifier + : basic_type_specifier { reverse $1 } -- Arithmetic or void + | sue_type_specifier { reverse $1 } -- Struct/Union/Enum + | typedef_type_specifier { reverse $1 } -- Typedef + + +basic_type_name :: { CTypeSpec } +basic_type_name + : void {% withAttrs $1 $ CVoidType } + | char {% withAttrs $1 $ CCharType } + | short {% withAttrs $1 $ CShortType } + | int {% withAttrs $1 $ CIntType } + | long {% withAttrs $1 $ CLongType } + | float {% withAttrs $1 $ CFloatType } + | double {% withAttrs $1 $ CDoubleType } + | signed {% withAttrs $1 $ CSignedType } + | unsigned {% withAttrs $1 $ CUnsigType } + | "_Bool" {% withAttrs $1 $ CBoolType } + | "_Complex" {% withAttrs $1 $ CComplexType } + + +-- A mixture of type qualifiers, storage class and basic type names in any +-- order, but containing at least one basic type name and at least one storage +-- class specifier. +-- +-- * summary: +-- [type_qualifier | storage_class | basic_type_name]{ +-- 1 >= storage_class && 1 >= basic_type_name +-- } +-- +basic_declaration_specifier :: { Reversed [CDeclSpec] } +basic_declaration_specifier + : declaration_qualifier_list basic_type_name + { $1 `snoc` CTypeSpec $2 } + + | basic_type_specifier storage_class + { $1 `snoc` CStorageSpec $2 } + + | basic_declaration_specifier declaration_qualifier + { $1 `snoc` $2 } + + | basic_declaration_specifier basic_type_name + { $1 `snoc` CTypeSpec $2 } + + | basic_declaration_specifier attr + { $1 } + + +-- A mixture of type qualifiers and basic type names in any order, but +-- containing at least one basic type name. +-- +-- * summary: +-- [type_qualifier | basic_type_name]{ 1 >= basic_type_name } +-- +basic_type_specifier :: { Reversed [CDeclSpec] } +basic_type_specifier + -- Arithmetic or void + : basic_type_name + { singleton (CTypeSpec $1) } + + | type_qualifier_list basic_type_name + { rmap CTypeQual $1 `snoc` CTypeSpec $2 } + + | basic_type_specifier type_qualifier + { $1 `snoc` CTypeQual $2 } + + | basic_type_specifier basic_type_name + { $1 `snoc` CTypeSpec $2 } + + | basic_type_specifier attr + { $1 } + + +-- A named or anonymous struct, union or enum type along with at least one +-- storage class and any mix of type qualifiers. +-- +-- * summary: +-- [type_qualifier | storage_class | elaborated_type_name]{ +-- 1 == elaborated_type_name && 1 >= storage_class +-- } +-- +sue_declaration_specifier :: { Reversed [CDeclSpec] } +sue_declaration_specifier + : declaration_qualifier_list elaborated_type_name + { $1 `snoc` CTypeSpec $2 } + + | sue_type_specifier storage_class + { $1 `snoc` CStorageSpec $2 } + + | sue_declaration_specifier declaration_qualifier + { $1 `snoc` $2 } + + | sue_declaration_specifier attr + { $1 } + + +-- A struct, union or enum type (named or anonymous) with optional leading and +-- trailing type qualifiers. +-- +-- * summary: +-- [type_qualifier] elaborated_type_name [type_qualifier] +-- +sue_type_specifier :: { Reversed [CDeclSpec] } +sue_type_specifier + -- struct/union/enum + : elaborated_type_name + { singleton (CTypeSpec $1) } + + | type_qualifier_list elaborated_type_name + { rmap CTypeQual $1 `snoc` CTypeSpec $2 } + + | sue_type_specifier type_qualifier + { $1 `snoc` CTypeQual $2 } + + | sue_type_specifier attr + { $1 } + + +-- A typedef'ed type identifier with at least one storage qualifier and any +-- number of type qualifiers +-- +-- * Summary: +-- [type_qualifier | storage_class | tyident]{ +-- 1 == tyident && 1 >= storage_class +-- } +-- +-- * Note: +-- the tyident can also be a: typeof '(' ... ')' +-- +typedef_declaration_specifier :: { Reversed [CDeclSpec] } +typedef_declaration_specifier + : typedef_type_specifier storage_class + { $1 `snoc` CStorageSpec $2 } + + | declaration_qualifier_list tyident + {% withAttrs $1 $ \attr -> $1 `snoc` CTypeSpec (CTypeDef $2 attr) } + + | declaration_qualifier_list typeof '(' expression ')' + {% withAttrs $1 $ \attr -> $1 `snoc` CTypeSpec (CTypeOfExpr $4 attr) } + + | declaration_qualifier_list typeof '(' type_name ')' + {% withAttrs $1 $ \attr -> $1 `snoc` CTypeSpec (CTypeOfType $4 attr) } + + | typedef_declaration_specifier declaration_qualifier + { $1 `snoc` $2 } + + | typedef_declaration_specifier attr + { $1 } + + +-- typedef'ed type identifier with optional leading and trailing type qualifiers +-- +-- * Summary: +-- [type_qualifier] ( tyident | typeof '('...')' ) [type_qualifier] +-- +typedef_type_specifier :: { Reversed [CDeclSpec] } +typedef_type_specifier + : tyident + {% withAttrs $1 $ \attr -> singleton (CTypeSpec (CTypeDef $1 attr)) } + + | typeof '(' expression ')' + {% withAttrs $1 $ \attr -> singleton (CTypeSpec (CTypeOfExpr $3 attr)) } + + | typeof '(' type_name ')' + {% withAttrs $1 $ \attr -> singleton (CTypeSpec (CTypeOfType $3 attr)) } + + | type_qualifier_list tyident + {% withAttrs $2 $ \attr -> rmap CTypeQual $1 `snoc` CTypeSpec (CTypeDef $2 attr) } + + | type_qualifier_list typeof '(' expression ')' + {% withAttrs $2 $ \attr -> rmap CTypeQual $1 `snoc` CTypeSpec (CTypeOfExpr $4 attr) } + + | type_qualifier_list typeof '(' type_name ')' + {% withAttrs $2 $ \attr -> rmap CTypeQual $1 `snoc` CTypeSpec (CTypeOfType $4 attr) } + + | typedef_type_specifier type_qualifier + { $1 `snoc` CTypeQual $2 } + + | typedef_type_specifier attr + { $1 } + + +-- A named or anonymous struct, union or enum type. +-- +-- * summary: +-- (struct|union|enum) (identifier? '{' ... '}' | identifier) +-- +elaborated_type_name :: { CTypeSpec } +elaborated_type_name + : struct_or_union_specifier {% withAttrs $1 $ CSUType $1 } + | enum_specifier {% withAttrs $1 $ CEnumType $1 } + + +-- parse C structure or union declaration (C99 6.7.2.1) +-- +-- * summary: +-- (struct|union) (identifier? '{' ... '}' | identifier) +-- +struct_or_union_specifier :: { CStructUnion } +struct_or_union_specifier + : struct_or_union attrs_opt identifier '{' struct_declaration_list '}' + {% withAttrs $1 $ CStruct (unL $1) (Just $3) (reverse $5) } + + | struct_or_union attrs_opt '{' struct_declaration_list '}' + {% withAttrs $1 $ CStruct (unL $1) Nothing (reverse $4) } + + | struct_or_union attrs_opt identifier + {% withAttrs $1 $ CStruct (unL $1) (Just $3) [] } + + +struct_or_union :: { Located CStructTag } +struct_or_union + : struct { L CStructTag (posOf $1) } + | union { L CUnionTag (posOf $1) } + + +struct_declaration_list :: { Reversed [CDecl] } +struct_declaration_list + : {- empty -} { empty } + | struct_declaration_list ';' { $1 } + | struct_declaration_list struct_declaration { $1 `snoc` $2 } + + +-- parse C structure declaration (C99 6.7.2.1) +-- +struct_declaration :: { CDecl } +struct_declaration + : struct_declaring_list ';' + { case $1 of CDecl declspecs dies attr -> CDecl declspecs (List.reverse dies) attr } + + | struct_default_declaring_list ';' + { case $1 of CDecl declspecs dies attr -> CDecl declspecs (List.reverse dies) attr } + + | "__extension__" struct_declaration { $2 } + + +-- doesn't redeclare typedef +struct_default_declaring_list :: { CDecl } +struct_default_declaring_list + : attrs_opt type_qualifier_list struct_identifier_declarator attrs_opt + {% withAttrs $2 $ case $3 of (d,s) -> CDecl (liftTypeQuals $2) [(d,Nothing,s)] } + + | struct_default_declaring_list ',' attrs_opt struct_identifier_declarator attrs_opt + { case $1 of + CDecl declspecs dies attr -> + case $4 of + (d,s) -> CDecl declspecs ((d,Nothing,s) : dies) attr } + + +-- * GNU extensions: +-- allow anonymous nested structures and unions +-- +struct_declaring_list :: { CDecl } +struct_declaring_list + : attrs_opt type_specifier struct_declarator attrs_opt + {% withAttrs $2 $ case $3 of (d,s) -> CDecl $2 [(d,Nothing,s)] } + + | struct_declaring_list ',' attrs_opt struct_declarator attrs_opt + { case $1 of + CDecl declspecs dies attr -> + case $4 of + (d,s) -> CDecl declspecs ((d,Nothing,s) : dies) attr } + + -- We're being far too liberal in the parsing here, we realyl want to just + -- allow unnamed struct and union fields but we're actually allowing any + -- unnamed struct member. Making it allow only unnamed structs or unions in + -- the parser is far too tricky, it makes things ambiguous. So we'll have to + -- diagnose unnamed fields that are not structs/unions in a later stage. + | attrs_opt type_specifier + {% withAttrs $2 $ CDecl $2 [] } + + +-- parse C structure declarator (C99 6.7.2.1) +-- +struct_declarator :: { (Maybe CDeclr, Maybe CExpr) } +struct_declarator + : declarator { (Just $1, Nothing) } + | ':' constant_expression { (Nothing, Just $2) } + | declarator ':' constant_expression { (Just $1, Just $3) } + + +struct_identifier_declarator :: { (Maybe CDeclr, Maybe CExpr) } +struct_identifier_declarator + : identifier_declarator { (Just $1, Nothing) } + | ':' constant_expression { (Nothing, Just $2) } + | identifier_declarator ':' constant_expression { (Just $1, Just $3) } + + +-- parse C enumeration declaration (C99 6.7.2.2) +-- +-- * summary: +-- enum (identifier? '{' ... '}' | identifier) +-- +enum_specifier :: { CEnum } +enum_specifier + : enum attrs_opt '{' enumerator_list '}' + {% withAttrs $1 $ CEnum Nothing (reverse $4) } + + | enum attrs_opt '{' enumerator_list ',' '}' + {% withAttrs $1 $ CEnum Nothing (reverse $4) } + + | enum attrs_opt identifier '{' enumerator_list '}' + {% withAttrs $1 $ CEnum (Just $3) (reverse $5) } + + | enum attrs_opt identifier '{' enumerator_list ',' '}' + {% withAttrs $1 $ CEnum (Just $3) (reverse $5) } + + | enum attrs_opt identifier + {% withAttrs $1 $ CEnum (Just $3) [] } + + +enumerator_list :: { Reversed [(Ident, Maybe CExpr)] } +enumerator_list + : enumerator { singleton $1 } + | enumerator_list ',' enumerator { $1 `snoc` $3 } + + +enumerator :: { (Ident, Maybe CExpr) } +enumerator + : identifier { ($1, Nothing) } + | identifier '=' constant_expression { ($1, Just $3) } + + +-- parse C type qualifier (C99 6.7.3) +-- +type_qualifier :: { CTypeQual } +type_qualifier + : const {% withAttrs $1 $ CConstQual } + | volatile {% withAttrs $1 $ CVolatQual } + | restrict {% withAttrs $1 $ CRestrQual } + | inline {% withAttrs $1 $ CInlinQual } + + +-- parse C declarator (C99 6.7.5) +-- +declarator :: { CDeclr } +declarator + : identifier_declarator { $1 } + | typedef_declarator { $1 } + + +-- Parse GNU C's asm annotations +-- +asm_opt :: { () } +asm_opt + : {- empty -} { () } + | asm '(' string_literal_list ')' { () } + + +typedef_declarator :: { CDeclr } +typedef_declarator + -- would be ambiguous as parameter + : paren_typedef_declarator { $1 } + + -- not ambiguous as param + | parameter_typedef_declarator { $1 } + + +parameter_typedef_declarator :: { CDeclr } +parameter_typedef_declarator + : tyident + {% withAttrs $1 $ CVarDeclr (Just $1) } + + | tyident postfixing_abstract_declarator + {% withAttrs $1 $ \attrs -> $2 (CVarDeclr (Just $1) attrs) } + + | clean_typedef_declarator + { $1 } + + +-- The following have at least one '*'. +-- There is no (redundant) '(' between the '*' and the tyident. +clean_typedef_declarator :: { CDeclr } +clean_typedef_declarator + : clean_postfix_typedef_declarator + { $1 } + + | '*' parameter_typedef_declarator + {% withAttrs $1 $ CPtrDeclr [] $2 } + + | '*' type_qualifier_list parameter_typedef_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $2) $3 } + + | '*' attrs parameter_typedef_declarator + {% withAttrs $1 $ CPtrDeclr [] $3 } + + | '*' attrs type_qualifier_list parameter_typedef_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $3) $4 } + + +clean_postfix_typedef_declarator :: { CDeclr } +clean_postfix_typedef_declarator + : '(' clean_typedef_declarator ')' { $2 } + | '(' attrs clean_typedef_declarator ')' { $3 } + | '(' clean_typedef_declarator ')' postfixing_abstract_declarator { $4 $2 } + | '(' attrs clean_typedef_declarator ')' postfixing_abstract_declarator { $5 $3 } + + +-- The following have a redundant '(' placed +-- immediately to the left of the tyident +paren_typedef_declarator :: { CDeclr } +paren_typedef_declarator + : paren_postfix_typedef_declarator + { $1 } + + -- redundant paren + | '*' '(' simple_paren_typedef_declarator ')' + {% withAttrs $1 $ CPtrDeclr [] $3 } + + -- redundant paren + | '*' type_qualifier_list '(' simple_paren_typedef_declarator ')' + {% withAttrs $1 $ CPtrDeclr (reverse $2) $4 } + + | '*' paren_typedef_declarator + {% withAttrs $1 $ CPtrDeclr [] $2 } + + | '*' type_qualifier_list paren_typedef_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $2) $3 } + + | '*' attrs '(' simple_paren_typedef_declarator ')' + {% withAttrs $1 $ CPtrDeclr [] $4 } + + -- redundant paren + | '*' attrs type_qualifier_list '(' simple_paren_typedef_declarator ')' + {% withAttrs $1 $ CPtrDeclr (reverse $3) $5 } + + | '*' attrs paren_typedef_declarator + {% withAttrs $1 $ CPtrDeclr [] $3 } + + | '*' attrs type_qualifier_list paren_typedef_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $3) $4 } + + +-- redundant paren to left of tname +paren_postfix_typedef_declarator :: { CDeclr } +paren_postfix_typedef_declarator + : '(' paren_typedef_declarator ')' + { $2 } + + -- redundant paren + | '(' simple_paren_typedef_declarator postfixing_abstract_declarator ')' + { $3 $2 } + + | '(' paren_typedef_declarator ')' postfixing_abstract_declarator + { $4 $2 } + + +-- Just a type name in any number of nested brackets +-- +simple_paren_typedef_declarator :: { CDeclr } +simple_paren_typedef_declarator + : tyident + {% withAttrs $1 $ CVarDeclr (Just $1) } + + | '(' simple_paren_typedef_declarator ')' + { $2 } + + +identifier_declarator :: { CDeclr } +identifier_declarator + : unary_identifier_declarator { $1 } + | paren_identifier_declarator { $1 } + + +unary_identifier_declarator :: { CDeclr } +unary_identifier_declarator + : postfix_identifier_declarator + { $1 } + + | '*' identifier_declarator + {% withAttrs $1 $ CPtrDeclr [] $2 } + + | '*' type_qualifier_list identifier_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $2) $3 } + + | '*' attrs identifier_declarator + {% withAttrs $1 $ CPtrDeclr [] $3 } + + | '*' attrs type_qualifier_list identifier_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $3) $4 } + + +postfix_identifier_declarator :: { CDeclr } +postfix_identifier_declarator + : paren_identifier_declarator postfixing_abstract_declarator + { $2 $1 } + + | '(' unary_identifier_declarator ')' + { $2 } + + | '(' unary_identifier_declarator ')' postfixing_abstract_declarator + { $4 $2 } + + | '(' attrs unary_identifier_declarator ')' + { $3 } + + | '(' attrs unary_identifier_declarator ')' postfixing_abstract_declarator + { $5 $3 } + + +paren_identifier_declarator :: { CDeclr } +paren_identifier_declarator + : ident + {% withAttrs $1 $ CVarDeclr (Just $1) } + + | '(' paren_identifier_declarator ')' + { $2 } + + +old_function_declarator :: { CDeclr } +old_function_declarator + : postfix_old_function_declarator + { $1 } + + | '*' old_function_declarator + {% withAttrs $1 $ CPtrDeclr [] $2 } + + | '*' type_qualifier_list old_function_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $2) $3 } + + +postfix_old_function_declarator :: { CDeclr } +postfix_old_function_declarator + : paren_identifier_declarator '(' identifier_list ')' + {% withAttrs $2 $ CFunDeclr $1 [] False } + + | '(' old_function_declarator ')' + { $2 } + + | '(' old_function_declarator ')' postfixing_abstract_declarator + { $4 $2 } + + +type_qualifier_list :: { Reversed [CTypeQual] } +type_qualifier_list + : type_qualifier { singleton $1 } + | type_qualifier_list type_qualifier { $1 `snoc` $2 } + | type_qualifier_list attr { $1 } + + +-- parse C parameter type list (C99 6.7.5) +-- +parameter_type_list :: { ([CDecl], Bool) } +parameter_type_list + : {- empty -} { ([], False)} + | parameter_list { (reverse $1, False) } + | parameter_list ',' "..." { (reverse $1, True) } + + +parameter_list :: { Reversed [CDecl] } +parameter_list + : parameter_declaration { singleton $1 } + | attrs parameter_declaration { singleton $2 } + | parameter_list ',' attrs_opt parameter_declaration { $1 `snoc` $4 } + + +parameter_declaration :: { CDecl } +parameter_declaration + : declaration_specifier + {% withAttrs $1 $ CDecl $1 [] } + + | declaration_specifier abstract_declarator + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | declaration_specifier identifier_declarator attrs_opt + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | declaration_specifier parameter_typedef_declarator attrs_opt + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | declaration_qualifier_list + {% withAttrs $1 $ CDecl (reverse $1) [] } + + | declaration_qualifier_list abstract_declarator + {% withAttrs $1 $ CDecl (reverse $1) [(Just $2, Nothing, Nothing)] } + + | declaration_qualifier_list identifier_declarator attrs_opt + {% withAttrs $1 $ CDecl (reverse $1) [(Just $2, Nothing, Nothing)] } + + | type_specifier + {% withAttrs $1 $ CDecl $1 [] } + + | type_specifier abstract_declarator + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | type_specifier identifier_declarator attrs_opt + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | type_specifier parameter_typedef_declarator attrs_opt + {% withAttrs $1 $ CDecl $1 [(Just $2, Nothing, Nothing)] } + + | type_qualifier_list + {% withAttrs $1 $ CDecl (liftTypeQuals $1) [] } + + | type_qualifier_list abstract_declarator + {% withAttrs $1 $ CDecl (liftTypeQuals $1) [(Just $2, Nothing, Nothing)] } + + | type_qualifier_list identifier_declarator attrs_opt + {% withAttrs $1 $ CDecl (liftTypeQuals $1) [(Just $2, Nothing, Nothing)] } + + +identifier_list :: { Reversed [Ident] } +identifier_list + : ident { singleton $1 } + | identifier_list ',' ident { $1 `snoc` $3 } + + +-- parse C type name (C99 6.7.6) +-- +type_name :: { CDecl } +type_name + : attrs_opt type_specifier + {% withAttrs $2 $ CDecl $2 [] } + + | attrs_opt type_specifier abstract_declarator + {% withAttrs $2 $ CDecl $2 [(Just $3, Nothing, Nothing)] } + + | attrs_opt type_qualifier_list + {% withAttrs $2 $ CDecl (liftTypeQuals $2) [] } + + | attrs_opt type_qualifier_list abstract_declarator + {% withAttrs $2 $ CDecl (liftTypeQuals $2) [(Just $3, Nothing, Nothing)] } + + +-- parse C abstract declarator (C99 6.7.6) +-- +abstract_declarator :: { CDeclr } +abstract_declarator + : unary_abstract_declarator { $1 } + | postfix_abstract_declarator { $1 } + | postfixing_abstract_declarator attrs_opt { $1 emptyDeclr } + + +postfixing_abstract_declarator :: { CDeclr -> CDeclr } +postfixing_abstract_declarator + : array_abstract_declarator + { $1 } + + | '(' parameter_type_list ')' + {% withAttrs $1 $ \attrs declr -> case $2 of + (params, variadic) -> CFunDeclr declr params variadic attrs } + + +-- * Note that we recognise but ignore the C99 static keyword (see C99 6.7.5.3) +-- +-- * We do not distinguish in the AST between incomplete array types and +-- complete variable length arrays ([ '*' ] means the latter). (see C99 6.7.5.2) +-- +array_abstract_declarator :: { CDeclr -> CDeclr } +array_abstract_declarator + : postfix_array_abstract_declarator + { $1 } + + | array_abstract_declarator postfix_array_abstract_declarator + { \decl -> $2 ($1 decl) } + + +postfix_array_abstract_declarator :: { CDeclr -> CDeclr } +postfix_array_abstract_declarator + : '[' assignment_expression_opt ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr [] $2 attrs } + + | '[' type_qualifier_list assignment_expression_opt ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr (reverse $2) $3 attrs } + + | '[' static assignment_expression ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr [] (Just $3) attrs } + + | '[' static type_qualifier_list assignment_expression ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr (reverse $3) (Just $4) attrs } + + | '[' type_qualifier_list static assignment_expression ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr (reverse $2) (Just $4) attrs } + + | '[' '*' ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr [] Nothing attrs } + + | '[' type_qualifier_list '*' ']' + {% withAttrs $1 $ \attrs declr -> CArrDeclr declr (reverse $2) Nothing attrs } + + +unary_abstract_declarator :: { CDeclr } +unary_abstract_declarator + : '*' + {% withAttrs $1 $ CPtrDeclr [] emptyDeclr } + + | '*' type_qualifier_list + {% withAttrs $1 $ CPtrDeclr (reverse $2) emptyDeclr } + + | '*' abstract_declarator + {% withAttrs $1 $ CPtrDeclr [] $2 } + + | '*' type_qualifier_list abstract_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $2) $3 } + + | '*' attrs + {% withAttrs $1 $ CPtrDeclr [] emptyDeclr } + + | '*' attrs type_qualifier_list + {% withAttrs $1 $ CPtrDeclr (reverse $3) emptyDeclr } + + | '*' attrs abstract_declarator + {% withAttrs $1 $ CPtrDeclr [] $3 } + + | '*' attrs type_qualifier_list abstract_declarator + {% withAttrs $1 $ CPtrDeclr (reverse $3) $4 } + + +postfix_abstract_declarator :: { CDeclr } +postfix_abstract_declarator + : '(' unary_abstract_declarator ')' { $2 } + | '(' postfix_abstract_declarator ')' { $2 } + | '(' postfixing_abstract_declarator ')' { $2 emptyDeclr } + | '(' unary_abstract_declarator ')' postfixing_abstract_declarator { $4 $2 } + | '(' attrs unary_abstract_declarator ')' { $3 } + | '(' attrs postfix_abstract_declarator ')' { $3 } + | '(' attrs postfixing_abstract_declarator ')' { $3 emptyDeclr } + | '(' attrs unary_abstract_declarator ')' postfixing_abstract_declarator { $5 $3 } + | postfix_abstract_declarator attr { $1 } + + +-- parse C initializer (C99 6.7.8) +-- +initializer :: { CInit } +initializer + : assignment_expression {% withAttrs $1 $ CInitExpr $1 } + | '{' initializer_list '}' {% withAttrs $1 $ CInitList (reverse $2) } + | '{' initializer_list ',' '}' {% withAttrs $1 $ CInitList (reverse $2) } + + +initializer_opt :: { Maybe CInit } +initializer_opt + : {- empty -} { Nothing } + | '=' initializer { Just $2 } + + +initializer_list :: { Reversed CInitList } +initializer_list + : {- empty -} { empty } + | initializer { singleton ([],$1) } + | designation initializer { singleton ($1,$2) } + | initializer_list ',' initializer { $1 `snoc` ([],$3) } + | initializer_list ',' designation initializer { $1 `snoc` ($3,$4) } + + +-- designation +-- +-- * GNU extensions: +-- old style member designation: 'ident :' +-- array range designation +-- +designation :: { [CDesignator] } +designation + : designator_list '=' { reverse $1 } + | identifier ':' {% withAttrs $1 $ \at -> [CMemberDesig $1 at] } + | array_designator { [$1] } + + +designator_list :: { Reversed [CDesignator] } +designator_list + : designator { singleton $1 } + | designator_list designator { $1 `snoc` $2 } + + +designator :: { CDesignator } +designator + : '[' constant_expression ']' {% withAttrs $1 $ CArrDesig $2 } + | '.' identifier {% withAttrs $1 $ CMemberDesig $2 } + | array_designator { $1 } + + +array_designator :: { CDesignator } +array_designator + : '[' constant_expression "..." constant_expression ']' + {% withAttrs $1 $ CRangeDesig $2 $4 } + + +-- parse C primary expression (C99 6.5.1) +-- +-- We cannot use a typedef name as a variable +-- +-- * GNU extensions: +-- allow a compound statement as an expression +-- various __builtin_* forms that take type parameters +-- +primary_expression :: { CExpr } +primary_expression + : ident {% withAttrs $1 $ CVar $1 } + | constant {% withAttrs $1 $ CConst $1 } + | string_literal {% withAttrs $1 $ CConst $1 } + | '(' expression ')' { $2 } + | '(' compound_statement ')' + {% withAttrs $1 $ CStatExpr $2 } + + | "__builtin_va_arg" '(' assignment_expression ',' type_name ')' + {% withAttrs $1 CBuiltinExpr } + + | "__builtin_offsetof" '(' type_name ',' offsetof_member_designator ')' + {% withAttrs $1 CBuiltinExpr } + + | "__builtin_types_compatible_p" '(' type_name ',' type_name ')' + {% withAttrs $1 CBuiltinExpr } + + +offsetof_member_designator :: { () } +offsetof_member_designator + : ident { () } + | offsetof_member_designator '.' ident { () } + | offsetof_member_designator '[' expression ']' { () } + + +--parse C postfix expression (C99 6.5.2) +-- +postfix_expression :: { CExpr } +postfix_expression + : primary_expression + { $1 } + + | postfix_expression '[' expression ']' + {% withAttrs $2 $ CIndex $1 $3 } + + | postfix_expression '(' ')' + {% withAttrs $2 $ CCall $1 [] } + + | postfix_expression '(' argument_expression_list ')' + {% withAttrs $2 $ CCall $1 (reverse $3) } + + | postfix_expression '.' identifier + {% withAttrs $2 $ CMember $1 $3 False } + + | postfix_expression "->" identifier + {% withAttrs $2 $ CMember $1 $3 True } + + | postfix_expression "++" + {% withAttrs $2 $ CUnary CPostIncOp $1 } + + | postfix_expression "--" + {% withAttrs $2 $ CUnary CPostDecOp $1 } + + | '(' type_name ')' '{' initializer_list '}' + {% withAttrs $4 $ CCompoundLit $2 (reverse $5) } + + | '(' type_name ')' '{' initializer_list ',' '}' + {% withAttrs $4 $ CCompoundLit $2 (reverse $5) } + + +argument_expression_list :: { Reversed [CExpr] } +argument_expression_list + : assignment_expression { singleton $1 } + | argument_expression_list ',' assignment_expression { $1 `snoc` $3 } + + +-- parse C unary expression (C99 6.5.3) +-- +-- * GNU extensions: +-- 'alignof' expression or type +-- '__extension__' to suppress warnings about extensions +-- allow taking address of a label with: && label +-- +unary_expression :: { CExpr } +unary_expression + : postfix_expression { $1 } + | "++" unary_expression {% withAttrs $1 $ CUnary CPreIncOp $2 } + | "--" unary_expression {% withAttrs $1 $ CUnary CPreDecOp $2 } + | "__extension__" cast_expression { $2 } + | unary_operator cast_expression {% withAttrs $1 $ CUnary (unL $1) $2 } + | sizeof unary_expression {% withAttrs $1 $ CSizeofExpr $2 } + | sizeof '(' type_name ')' {% withAttrs $1 $ CSizeofType $3 } + | alignof unary_expression {% withAttrs $1 $ CAlignofExpr $2 } + | alignof '(' type_name ')' {% withAttrs $1 $ CAlignofType $3 } + | "&&" identifier {% withAttrs $1 $ CLabAddrExpr $2 } + + +unary_operator :: { Located CUnaryOp } +unary_operator + : '&' { L CAdrOp (posOf $1) } + | '*' { L CIndOp (posOf $1) } + | '+' { L CPlusOp (posOf $1) } + | '-' { L CMinOp (posOf $1) } + | '~' { L CCompOp (posOf $1) } + | '!' { L CNegOp (posOf $1) } + + +-- parse C cast expression (C99 6.5.4) +-- +cast_expression :: { CExpr } +cast_expression + : unary_expression { $1 } + | '(' type_name ')' cast_expression {% withAttrs $1 $ CCast $2 $4 } + + +-- parse C multiplicative expression (C99 6.5.5) +-- +multiplicative_expression :: { CExpr } +multiplicative_expression + : cast_expression + { $1 } + + | multiplicative_expression '*' cast_expression + {% withAttrs $2 $ CBinary CMulOp $1 $3 } + + | multiplicative_expression '/' cast_expression + {% withAttrs $2 $ CBinary CDivOp $1 $3 } + + | multiplicative_expression '%' cast_expression + {% withAttrs $2 $ CBinary CRmdOp $1 $3 } + + +-- parse C additive expression (C99 6.5.6) +-- +additive_expression :: { CExpr } +additive_expression + : multiplicative_expression + { $1 } + + | additive_expression '+' multiplicative_expression + {% withAttrs $2 $ CBinary CAddOp $1 $3 } + + | additive_expression '-' multiplicative_expression + {% withAttrs $2 $ CBinary CSubOp $1 $3 } + + +-- parse C shift expression (C99 6.5.7) +-- +shift_expression :: { CExpr } +shift_expression + : additive_expression + { $1 } + + | shift_expression "<<" additive_expression + {% withAttrs $2 $ CBinary CShlOp $1 $3 } + + | shift_expression ">>" additive_expression + {% withAttrs $2 $ CBinary CShrOp $1 $3 } + + +-- parse C relational expression (C99 6.5.8) +-- +relational_expression :: { CExpr } +relational_expression + : shift_expression + { $1 } + + | relational_expression '<' shift_expression + {% withAttrs $2 $ CBinary CLeOp $1 $3 } + + | relational_expression '>' shift_expression + {% withAttrs $2 $ CBinary CGrOp $1 $3 } + + | relational_expression "<=" shift_expression + {% withAttrs $2 $ CBinary CLeqOp $1 $3 } + + | relational_expression ">=" shift_expression + {% withAttrs $2 $ CBinary CGeqOp $1 $3 } + + +-- parse C equality expression (C99 6.5.9) +-- +equality_expression :: { CExpr } +equality_expression + : relational_expression + { $1 } + + | equality_expression "==" relational_expression + {% withAttrs $2 $ CBinary CEqOp $1 $3 } + + | equality_expression "!=" relational_expression + {% withAttrs $2 $ CBinary CNeqOp $1 $3 } + + +-- parse C bitwise and expression (C99 6.5.10) +-- +and_expression :: { CExpr } +and_expression + : equality_expression + { $1 } + + | and_expression '&' equality_expression + {% withAttrs $2 $ CBinary CAndOp $1 $3 } + + +-- parse C bitwise exclusive or expression (C99 6.5.11) +-- +exclusive_or_expression :: { CExpr } +exclusive_or_expression + : and_expression + { $1 } + + | exclusive_or_expression '^' and_expression + {% withAttrs $2 $ CBinary CXorOp $1 $3 } + + +-- parse C bitwise or expression (C99 6.5.12) +-- +inclusive_or_expression :: { CExpr } +inclusive_or_expression + : exclusive_or_expression + { $1 } + + | inclusive_or_expression '|' exclusive_or_expression + {% withAttrs $2 $ CBinary COrOp $1 $3 } + + +-- parse C logical and expression (C99 6.5.13) +-- +logical_and_expression :: { CExpr } +logical_and_expression + : inclusive_or_expression + { $1 } + + | logical_and_expression "&&" inclusive_or_expression + {% withAttrs $2 $ CBinary CLndOp $1 $3 } + + +-- parse C logical or expression (C99 6.5.14) +-- +logical_or_expression :: { CExpr } +logical_or_expression + : logical_and_expression + { $1 } + + | logical_or_expression "||" logical_and_expression + {% withAttrs $2 $ CBinary CLorOp $1 $3 } + + +-- parse C conditional expression (C99 6.5.15) +-- +-- * GNU extensions: +-- omitting the `then' part +-- +conditional_expression :: { CExpr } +conditional_expression + : logical_or_expression + { $1 } + + | logical_or_expression '?' expression ':' conditional_expression + {% withAttrs $2 $ CCond $1 (Just $3) $5 } + + | logical_or_expression '?' ':' conditional_expression + {% withAttrs $2 $ CCond $1 Nothing $4 } + + +-- parse C assignment expression (C99 6.5.16) +-- +assignment_expression :: { CExpr } +assignment_expression + : conditional_expression + { $1 } + + | unary_expression assignment_operator assignment_expression + {% withAttrs $2 $ CAssign (unL $2) $1 $3 } + + +assignment_operator :: { Located CAssignOp } +assignment_operator + : '=' { L CAssignOp (posOf $1) } + | "*=" { L CMulAssOp (posOf $1) } + | "/=" { L CDivAssOp (posOf $1) } + | "%=" { L CRmdAssOp (posOf $1) } + | "+=" { L CAddAssOp (posOf $1) } + | "-=" { L CSubAssOp (posOf $1) } + | "<<=" { L CShlAssOp (posOf $1) } + | ">>=" { L CShrAssOp (posOf $1) } + | "&=" { L CAndAssOp (posOf $1) } + | "^=" { L CXorAssOp (posOf $1) } + | "|=" { L COrAssOp (posOf $1) } + + +-- parse C expression (C99 6.5.17) +-- +expression :: { CExpr } +expression + : assignment_expression + { $1 } + + | assignment_expression ',' comma_expression + {% let es = reverse $3 in withAttrs es $ CComma ($1:es) } + + +comma_expression :: { Reversed [CExpr] } +comma_expression + : assignment_expression { singleton $1 } + | comma_expression ',' assignment_expression { $1 `snoc` $3 } + + +-- The following was used for clarity +expression_opt :: { Maybe CExpr } +expression_opt + : {- empty -} { Nothing } + | expression { Just $1 } + + +-- The following was used for clarity +assignment_expression_opt :: { Maybe CExpr } +assignment_expression_opt + : {- empty -} { Nothing } + | assignment_expression { Just $1 } + + +-- parse C constant expression (C99 6.6) +-- +constant_expression :: { CExpr } +constant_expression + : conditional_expression { $1 } + + +-- parse C constants +-- +constant :: { CConst } +constant + : cint {% withAttrs $1 $ case $1 of CTokILit _ i -> CIntConst i } + | cchar {% withAttrs $1 $ case $1 of CTokCLit _ c -> CCharConst c } + | cfloat {% withAttrs $1 $ case $1 of CTokFLit _ f -> CFloatConst f } + + +string_literal :: { CConst } +string_literal + : cstr + {% withAttrs $1 $ case $1 of CTokSLit _ s -> CStrConst s } + + | cstr string_literal_list + {% withAttrs $1 $ case $1 of CTokSLit _ s -> CStrConst (concat (s : reverse $2)) } + + +string_literal_list :: { Reversed [String] } +string_literal_list + : cstr { case $1 of CTokSLit _ s -> singleton s } + | string_literal_list cstr { case $2 of CTokSLit _ s -> $1 `snoc` s } + + +identifier :: { Ident } +identifier + : ident { $1 } + | tyident { $1 } + + + +-- parse GNU C attribute annotation (junking the result) +-- +attrs_opt :: { () } +attrs_opt + : {- empty -} { () } + | attrs_opt attr { () } + + +attrs :: { () } +attrs + : attr { () } + | attrs attr { () } + + +attr :: { () } +attr + : "__attribute__" '(' '(' attribute_list ')' ')' { () } + + +attribute_list :: { () } + : attribute { () } + | attribute_list ',' attribute { () } + + +attribute :: { () } +attribute + : {- empty -} { () } + | ident { () } + | const { () } + | ident '(' attribute_params ')' { () } + | ident '(' ')' { () } + + +attribute_params :: { () } +attribute_params + : constant_expression { () } + | attribute_params ',' constant_expression { () } + + +{ + +infixr 5 `snoc` + +-- Due to the way the grammar is constructed we very often have to build lists +-- in reverse. To make sure we do this consistently and correctly we have a +-- newtype to wrap the reversed style of list: +-- +newtype Reversed a = Reversed a + +empty :: Reversed [a] +empty = Reversed [] + +singleton :: a -> Reversed [a] +singleton x = Reversed [x] + +snoc :: Reversed [a] -> a -> Reversed [a] +snoc (Reversed xs) x = Reversed (x : xs) + +rmap :: (a -> b) -> Reversed [a] -> Reversed [b] +rmap f (Reversed xs) = Reversed (map f xs) + +reverse :: Reversed [a] -> [a] +reverse (Reversed xs) = List.reverse xs + +-- We occasionally need things to have a location when they don't naturally +-- have one built in as tokens and most AST elements do. +-- +data Located a = L !a !Position + +unL :: Located a -> a +unL (L a pos) = a + +instance Pos (Located a) where + posOf (L _ pos) = pos + +{-# INLINE withAttrs #-} +withAttrs :: Pos node => node -> (Attrs -> a) -> P a +withAttrs node mkAttributedNode = do + name <- getNewName + let attrs = newAttrs (posOf node) name + attrs `seq` return (mkAttributedNode attrs) + +-- this functions gets used repeatedly so take them out of line: +-- +liftTypeQuals :: Reversed [CTypeQual] -> [CDeclSpec] +liftTypeQuals (Reversed xs) = revmap [] xs + where revmap a [] = a + revmap a (x:xs) = revmap (CTypeQual x : a) xs + + +-- convenient instance, the position of a list of things is the position of +-- the first thing in the list +-- +instance Pos a => Pos [a] where + posOf (x:_) = posOf x + +instance Pos a => Pos (Reversed a) where + posOf (Reversed x) = posOf x + +emptyDeclr = CVarDeclr Nothing (newAttrsOnlyPos nopos) + +-- Take the identifiers and use them to update the typedef'ed identifier set +-- if the decl is defining a typedef then we add it to the set, +-- if it's a var decl then that shadows typedefed identifiers +-- +doDeclIdent :: [CDeclSpec] -> CDeclr -> P () +doDeclIdent declspecs declr = + case getCDeclrIdent declr of + Nothing -> return () + Just ident | any isTypeDef declspecs -> addTypedef ident + | otherwise -> shadowTypedef ident + + where isTypeDef (CStorageSpec (CTypedef _)) = True + isTypeDef _ = False + +doFuncParamDeclIdent :: CDeclr -> P () +doFuncParamDeclIdent (CFunDeclr _ params _ _) = + sequence_ + [ case getCDeclrIdent declr of + Nothing -> return () + Just ident -> shadowTypedef ident + | CDecl _ dle _ <- params + , (Just declr, _, _) <- dle ] +doFuncParamDeclIdent (CPtrDeclr _ declr _ ) = doFuncParamDeclIdent declr +doFuncParamDeclIdent _ = return () + +-- extract all identifiers +getCDeclrIdent :: CDeclr -> Maybe Ident +getCDeclrIdent (CVarDeclr optIde _) = optIde +getCDeclrIdent (CPtrDeclr _ declr _) = getCDeclrIdent declr +getCDeclrIdent (CArrDeclr declr _ _ _) = getCDeclrIdent declr +getCDeclrIdent (CFunDeclr declr _ _ _) = getCDeclrIdent declr + + +happyError :: P a +happyError = parseError + +parseC :: String -> Position -> PreCST s s' CHeader +parseC input initialPosition = do + nameSupply <- getNameSupply + let ns = names nameSupply + case execParser header input + initialPosition (map fst builtinTypeNames) ns of + Left header -> return header + Right (message, position) -> raiseFatal "Error in C header file." + position message +} diff --git a/c2hs/c/CParserMonad.hs b/c2hs/c/CParserMonad.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CParserMonad.hs @@ -0,0 +1,164 @@ +-- C -> Haskell Compiler: Lexer for C Header Files +-- +-- Author : Manuel M T Chakravarty, Duncan Coutts +-- Created: 12 Febuary 2007 +-- +-- Copyright (c) [1999..2004] Manuel M T Chakravarty +-- Copyright (c) 2005-2007 Duncan Coutts +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Monad for the C lexer and parser +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- This monad has to be usable with Alex and Happy. Some things in it are +-- dictated by that, eg having to be able to remember the last token. +-- +-- The monad also provides a unique name supply (via the Names module) +-- +-- For parsing C we have to maintain a set of identifiers that we know to be +-- typedef'ed type identifiers. We also must deal correctly with scope so we +-- keep a list of sets of identifiers so we can save the outer scope when we +-- enter an inner scope. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- + +module CParserMonad ( + P, + execParser, + failP, + getNewName, -- :: P Name + addTypedef, -- :: Ident -> P () + shadowTypedef, -- :: Ident -> P () + isTypeIdent, -- :: Ident -> P Bool + enterScope, -- :: P () + leaveScope, -- :: P () + setPos, -- :: Position -> P () + getPos, -- :: P Position + getInput, -- :: P String + setInput, -- :: String -> P () + getLastToken, -- :: P CToken + setLastToken, -- :: CToken -> P () + ) where + +import Position (Position(..)) +import Errors (interr) +import UNames (Name) +import Idents (Ident) + +import Data.Set (Set) +import qualified Data.Set as Set (fromList, insert, member, delete) + +import CTokens (CToken) + +data ParseResult a + = POk !PState a + | PFailed [String] Position -- The error message and position + +data PState = PState { + curPos :: !Position, -- position at current input location + curInput :: !String, -- the current input + prevToken :: CToken, -- the previous token + namesupply :: ![Name], -- the name unique supply + tyidents :: !(Set Ident), -- the set of typedef'ed identifiers + scopes :: ![Set Ident] -- the tyident sets for outer scopes + } + +newtype P a = P { unP :: PState -> ParseResult a } + +instance Monad P where + return = returnP + (>>=) = thenP + fail m = getPos >>= \pos -> failP pos [m] + +execParser :: P a -> String -> Position -> [Ident] -> [Name] + -> Either a ([String], Position) +execParser (P parser) input pos builtins names = + case parser initialState of + POk _ result -> Left result + PFailed message pos -> Right (message, pos) + where initialState = PState { + curPos = pos, + curInput = input, + prevToken = interr "CLexer.execParser: Touched undefined token!", + namesupply = names, + tyidents = Set.fromList builtins, + scopes = [] + } + +{-# INLINE returnP #-} +returnP :: a -> P a +returnP a = P $ \s -> POk s a + +{-# INLINE thenP #-} +thenP :: P a -> (a -> P b) -> P b +(P m) `thenP` k = P $ \s -> + case m s of + POk s' a -> (unP (k a)) s' + PFailed err pos -> PFailed err pos + +failP :: Position -> [String] -> P a +failP pos msg = P $ \_ -> PFailed msg pos + +getNewName :: P Name +getNewName = P $ \s@PState{namesupply=(n:ns)} -> POk s{namesupply=ns} n + +setPos :: Position -> P () +setPos pos = P $ \s -> POk s{curPos=pos} () + +getPos :: P Position +getPos = P $ \s@PState{curPos=pos} -> POk s pos + +addTypedef :: Ident -> P () +addTypedef ident = (P $ \s@PState{tyidents=tyidents} -> + POk s{tyidents = ident `Set.insert` tyidents} ()) + +shadowTypedef :: Ident -> P () +shadowTypedef ident = (P $ \s@PState{tyidents=tyidents} -> + -- optimisation: mostly the ident will not be in + -- the tyident set so do a member lookup to avoid + -- churn induced by calling delete + POk s{tyidents = if ident `Set.member` tyidents + then ident `Set.delete` tyidents + else tyidents } ()) + +isTypeIdent :: Ident -> P Bool +isTypeIdent ident = P $ \s@PState{tyidents=tyidents} -> + POk s $! Set.member ident tyidents + +enterScope :: P () +enterScope = P $ \s@PState{tyidents=tyidents,scopes=ss} -> + POk s{scopes=tyidents:ss} () + +leaveScope :: P () +leaveScope = P $ \s@PState{scopes=ss} -> + case ss of + [] -> interr "leaveScope: already in global scope" + (tyidents:ss') -> POk s{tyidents=tyidents, scopes=ss'} () + +getInput :: P String +getInput = P $ \s@PState{curInput=i} -> POk s i + +setInput :: String -> P () +setInput i = P $ \s -> POk s{curInput=i} () + +getLastToken :: P CToken +getLastToken = P $ \s@PState{prevToken=tok} -> POk s tok + +setLastToken :: CToken -> P () +setLastToken tok = P $ \s -> POk s{prevToken=tok} () diff --git a/c2hs/c/CPretty.hs b/c2hs/c/CPretty.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CPretty.hs @@ -0,0 +1,148 @@ +-- C->Haskell Compiler: pretty printing of C abstract syntax +-- +-- Author : Manuel M T Chakravarty +-- Created: 25 August 1 +-- +-- Copyright (c) [2001..2004] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Pretty printing support for abstract C trees. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * So far, only covers a small fraction of the abstract tree definition +-- + +module CPretty ( + -- we are just providing instances to the class `Pretty' +) where + +import Idents (Ident, identToLexeme) +import Text.PrettyPrint.HughesPJ + +import CAST + + +-- pretty printing of AST nodes +-- ---------------------------- + +instance Show CDecl where + showsPrec _ = showString . render . pretty + +-- overloaded pretty-printing function (EXPORTED) +-- +class Pretty a where + pretty :: a -> Doc + prettyPrec :: Int -> a -> Doc + + pretty = prettyPrec 0 + prettyPrec _ = pretty + + +-- actual structure tree traversals +-- -------------------------------- + +instance Pretty CDecl where + pretty (CDecl specs declrs _) = + hsep (map pretty specs) `hang` 2 $ + hsep (punctuate comma (map prettyDeclr declrs)) <> semi + +instance Pretty CDeclSpec where + pretty (CStorageSpec sspec) = pretty sspec + pretty (CTypeSpec tspec) = pretty tspec + pretty (CTypeQual qspec) = pretty qspec + +instance Pretty CStorageSpec where + pretty (CAuto _) = text "auto" + pretty (CRegister _) = text "register" + pretty (CStatic _) = text "static" + pretty (CExtern _) = text "extern" + pretty (CTypedef _) = text "typedef" + +instance Pretty CTypeSpec where + pretty (CVoidType _) = text "void" + pretty (CCharType _) = text "char" + pretty (CShortType _) = text "short" + pretty (CIntType _) = text "int" + pretty (CLongType _) = text "long" + pretty (CFloatType _) = text "float" + pretty (CDoubleType _) = text "double" + pretty (CSignedType _) = text "signed" + pretty (CUnsigType _) = text "unsigned" + pretty (CSUType struct _) = prettySU struct + pretty (CEnumType enum _) = prettyEnum enum + pretty (CTypeDef ide _) = ident ide + +instance Pretty CTypeQual where + pretty (CConstQual _) = text "const" + pretty (CVolatQual _) = text "volatile" + pretty (CRestrQual _) = text "restrict" + +prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc +prettyDeclr (odeclr, oinit, oexpr) = + maybe empty pretty odeclr + <+> maybe empty ((text "=" <+>) . pretty) oinit + <+> maybe empty ((text ":" <+>) . pretty) oexpr + +instance Pretty CDeclr where + pretty (CVarDeclr oide _) = maybe empty ident oide + pretty (CPtrDeclr inds declr _) = + let + oneLevel ind = parens . (hsep (map pretty ind) <+>) . (text "*" <>) + in + oneLevel inds (pretty declr) + pretty (CArrDeclr declr _ oexpr _) = + pretty declr <> brackets (maybe empty pretty oexpr) + pretty (CFunDeclr declr decls isVariadic _) = + let + varDoc = if isVariadic then text ", ..." else empty + in + pretty declr + <+> parens (hsep (punctuate comma (map pretty decls)) <> varDoc) + +instance Pretty CInit where + pretty _ = text "<>" + +instance Pretty CExpr where + pretty _ = text "<>" + + +-- auxilliary functions +-- -------------------- + +ident :: Ident -> Doc +ident = text . identToLexeme + +optName :: (Maybe Ident) -> String +optName = maybe "" $ (++" ").identToLexeme + +prettyEnum :: CEnum -> Doc +prettyEnum (CEnum name ms _) = header <> if ms == [] then empty else body ms + where header = text "enum " <+> maybe empty ident name + body :: [(Ident, Maybe CExpr)] -> Doc + body = braces.nest 1.sep.punctuate comma.(map p) + p :: (Ident, Maybe CExpr) -> Doc + p (ide, exp) = ident ide <+> maybe empty ((<+> text "=").pretty) exp + +prettySU :: CStructUnion -> Doc +prettySU (CStruct t name ms _) = header <> if ms == [] then empty else body ms + where header = text $ tag t ++ optName name + tag CStructTag = "struct " + tag CUnionTag = "union " + body :: [CDecl] -> Doc + body = braces.nest 1.sep.map pretty diff --git a/c2hs/c/CTokens.hs b/c2hs/c/CTokens.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CTokens.hs @@ -0,0 +1,346 @@ +-- C -> Haskell Compiler: Lexer for C Header Files +-- +-- Author : Manuel M T Chakravarty, Duncan Coutts +-- Created: 24 May 2005 +-- +-- Copyright (c) [1999..2004] Manuel M T Chakravarty +-- Copyright (c) 2005 Duncan Coutts +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- C Tokens for the C lexer. +-- + +module CTokens (CToken(..), GnuCTok(..)) where + +import Position (Position(..), Pos(posOf)) +import Idents (Ident, identToLexeme) + + +-- token definition +-- ---------------- + +-- possible tokens (EXPORTED) +-- +data CToken = CTokLParen !Position -- `(' + | CTokRParen !Position -- `)' + | CTokLBracket !Position -- `[' + | CTokRBracket !Position -- `]' + | CTokArrow !Position -- `->' + | CTokDot !Position -- `.' + | CTokExclam !Position -- `!' + | CTokTilde !Position -- `~' + | CTokInc !Position -- `++' + | CTokDec !Position -- `--' + | CTokPlus !Position -- `+' + | CTokMinus !Position -- `-' + | CTokStar !Position -- `*' + | CTokSlash !Position -- `/' + | CTokPercent !Position -- `%' + | CTokAmper !Position -- `&' + | CTokShiftL !Position -- `<<' + | CTokShiftR !Position -- `>>' + | CTokLess !Position -- `<' + | CTokLessEq !Position -- `<=' + | CTokHigh !Position -- `>' + | CTokHighEq !Position -- `>=' + | CTokEqual !Position -- `==' + | CTokUnequal !Position -- `!=' + | CTokHat !Position -- `^' + | CTokBar !Position -- `|' + | CTokAnd !Position -- `&&' + | CTokOr !Position -- `||' + | CTokQuest !Position -- `?' + | CTokColon !Position -- `:' + | CTokAssign !Position -- `=' + | CTokPlusAss !Position -- `+=' + | CTokMinusAss !Position -- `-=' + | CTokStarAss !Position -- `*=' + | CTokSlashAss !Position -- `/=' + | CTokPercAss !Position -- `%=' + | CTokAmpAss !Position -- `&=' + | CTokHatAss !Position -- `^=' + | CTokBarAss !Position -- `|=' + | CTokSLAss !Position -- `<<=' + | CTokSRAss !Position -- `>>=' + | CTokComma !Position -- `,' + | CTokSemic !Position -- `;' + | CTokLBrace !Position -- `{' + | CTokRBrace !Position -- + | CTokEllipsis !Position -- `...' + | CTokAlignof !Position -- `alignof' + -- (or `__alignof', + -- `__alignof__') + | CTokAsm !Position -- `asm' + -- (or `__asm', + -- `__asm__') + | CTokAuto !Position -- `auto' + | CTokBreak !Position -- `break' + | CTokBool !Position -- `_Bool' + | CTokCase !Position -- `case' + | CTokChar !Position -- `char' + | CTokConst !Position -- `const' + -- (or `__const', `__const__') + | CTokContinue !Position -- `continue' + | CTokComplex !Position -- `_Complex' + | CTokDefault !Position -- `default' + | CTokDo !Position -- `do' + | CTokDouble !Position -- `double' + | CTokElse !Position -- `else' + | CTokEnum !Position -- `enum' + | CTokExtern !Position -- `extern' + | CTokFloat !Position -- `float' + | CTokFor !Position -- `for' + | CTokGoto !Position -- `goto' + | CTokIf !Position -- `if' + | CTokInline !Position -- `inline' + -- (or `__inline', + -- `__inline__') + | CTokInt !Position -- `int' + | CTokLong !Position -- `long' + | CTokLabel !Position -- `__label__' + | CTokRegister !Position -- `register' + | CTokRestrict !Position -- `restrict' + -- (or `__restrict', + -- `__restrict__') + | CTokReturn !Position -- `return' + | CTokShort !Position -- `short' + | CTokSigned !Position -- `signed' + -- (or `__signed', + -- `__signed__') + | CTokSizeof !Position -- `sizeof' + | CTokStatic !Position -- `static' + | CTokStruct !Position -- `struct' + | CTokSwitch !Position -- `switch' + | CTokTypedef !Position -- `typedef' + | CTokTypeof !Position -- `typeof' + | CTokThread !Position -- `__thread' + | CTokUnion !Position -- `union' + | CTokUnsigned !Position -- `unsigned' + | CTokVoid !Position -- `void' + | CTokVolatile !Position -- `volatile' + -- (or `__volatile', + -- `__volatile__') + | CTokWhile !Position -- `while' + | CTokCLit !Position !Char -- character constant + | CTokILit !Position !Integer -- integer constant + | CTokFLit !Position String -- float constant + | CTokSLit !Position String -- string constant (no escapes) + | CTokIdent !Position !Ident -- identifier + + -- not generated here, but in `CParser.parseCHeader' + | CTokTyIdent !Position !Ident -- `typedef-name' identifier + | CTokGnuC !GnuCTok !Position -- special GNU C tokens + | CTokEof -- end of file + +-- special tokens used in GNU C extensions to ANSI C +-- +data GnuCTok = GnuCAttrTok -- `__attribute__' + | GnuCExtTok -- `__extension__' + | GnuCVaArg -- `__builtin_va_arg' + | GnuCOffsetof -- `__builtin_offsetof' + | GnuCTyCompat -- `__builtin_types_compatible_p' + +instance Pos CToken where + posOf (CTokLParen pos ) = pos + posOf (CTokRParen pos ) = pos + posOf (CTokLBracket pos ) = pos + posOf (CTokRBracket pos ) = pos + posOf (CTokArrow pos ) = pos + posOf (CTokDot pos ) = pos + posOf (CTokExclam pos ) = pos + posOf (CTokTilde pos ) = pos + posOf (CTokInc pos ) = pos + posOf (CTokDec pos ) = pos + posOf (CTokPlus pos ) = pos + posOf (CTokMinus pos ) = pos + posOf (CTokStar pos ) = pos + posOf (CTokSlash pos ) = pos + posOf (CTokPercent pos ) = pos + posOf (CTokAmper pos ) = pos + posOf (CTokShiftL pos ) = pos + posOf (CTokShiftR pos ) = pos + posOf (CTokLess pos ) = pos + posOf (CTokLessEq pos ) = pos + posOf (CTokHigh pos ) = pos + posOf (CTokHighEq pos ) = pos + posOf (CTokEqual pos ) = pos + posOf (CTokUnequal pos ) = pos + posOf (CTokHat pos ) = pos + posOf (CTokBar pos ) = pos + posOf (CTokAnd pos ) = pos + posOf (CTokOr pos ) = pos + posOf (CTokQuest pos ) = pos + posOf (CTokColon pos ) = pos + posOf (CTokAssign pos ) = pos + posOf (CTokPlusAss pos ) = pos + posOf (CTokMinusAss pos ) = pos + posOf (CTokStarAss pos ) = pos + posOf (CTokSlashAss pos ) = pos + posOf (CTokPercAss pos ) = pos + posOf (CTokAmpAss pos ) = pos + posOf (CTokHatAss pos ) = pos + posOf (CTokBarAss pos ) = pos + posOf (CTokSLAss pos ) = pos + posOf (CTokSRAss pos ) = pos + posOf (CTokComma pos ) = pos + posOf (CTokSemic pos ) = pos + posOf (CTokLBrace pos ) = pos + posOf (CTokRBrace pos ) = pos + posOf (CTokEllipsis pos ) = pos + posOf (CTokAlignof pos ) = pos + posOf (CTokAsm pos ) = pos + posOf (CTokAuto pos ) = pos + posOf (CTokBreak pos ) = pos + posOf (CTokBool pos ) = pos + posOf (CTokCase pos ) = pos + posOf (CTokChar pos ) = pos + posOf (CTokConst pos ) = pos + posOf (CTokContinue pos ) = pos + posOf (CTokComplex pos ) = pos + posOf (CTokDefault pos ) = pos + posOf (CTokDo pos ) = pos + posOf (CTokDouble pos ) = pos + posOf (CTokElse pos ) = pos + posOf (CTokEnum pos ) = pos + posOf (CTokExtern pos ) = pos + posOf (CTokFloat pos ) = pos + posOf (CTokFor pos ) = pos + posOf (CTokGoto pos ) = pos + posOf (CTokInt pos ) = pos + posOf (CTokInline pos ) = pos + posOf (CTokIf pos ) = pos + posOf (CTokLong pos ) = pos + posOf (CTokLabel pos ) = pos + posOf (CTokRegister pos ) = pos + posOf (CTokRestrict pos ) = pos + posOf (CTokReturn pos ) = pos + posOf (CTokShort pos ) = pos + posOf (CTokSigned pos ) = pos + posOf (CTokSizeof pos ) = pos + posOf (CTokStatic pos ) = pos + posOf (CTokStruct pos ) = pos + posOf (CTokSwitch pos ) = pos + posOf (CTokTypedef pos ) = pos + posOf (CTokTypeof pos ) = pos + posOf (CTokThread pos ) = pos + posOf (CTokUnion pos ) = pos + posOf (CTokUnsigned pos ) = pos + posOf (CTokVoid pos ) = pos + posOf (CTokVolatile pos ) = pos + posOf (CTokWhile pos ) = pos + posOf (CTokCLit pos _) = pos + posOf (CTokILit pos _) = pos + posOf (CTokFLit pos _) = pos + posOf (CTokSLit pos _) = pos + posOf (CTokIdent pos _) = pos + posOf (CTokTyIdent pos _) = pos + posOf (CTokGnuC _ pos ) = pos + +instance Show CToken where + showsPrec _ (CTokLParen _ ) = showString "(" + showsPrec _ (CTokRParen _ ) = showString ")" + showsPrec _ (CTokLBracket _ ) = showString "[" + showsPrec _ (CTokRBracket _ ) = showString "]" + showsPrec _ (CTokArrow _ ) = showString "->" + showsPrec _ (CTokDot _ ) = showString "." + showsPrec _ (CTokExclam _ ) = showString "!" + showsPrec _ (CTokTilde _ ) = showString "~" + showsPrec _ (CTokInc _ ) = showString "++" + showsPrec _ (CTokDec _ ) = showString "--" + showsPrec _ (CTokPlus _ ) = showString "+" + showsPrec _ (CTokMinus _ ) = showString "-" + showsPrec _ (CTokStar _ ) = showString "*" + showsPrec _ (CTokSlash _ ) = showString "/" + showsPrec _ (CTokPercent _ ) = showString "%" + showsPrec _ (CTokAmper _ ) = showString "&" + showsPrec _ (CTokShiftL _ ) = showString "<<" + showsPrec _ (CTokShiftR _ ) = showString ">>" + showsPrec _ (CTokLess _ ) = showString "<" + showsPrec _ (CTokLessEq _ ) = showString "<=" + showsPrec _ (CTokHigh _ ) = showString ">" + showsPrec _ (CTokHighEq _ ) = showString ">=" + showsPrec _ (CTokEqual _ ) = showString "==" + showsPrec _ (CTokUnequal _ ) = showString "!=" + showsPrec _ (CTokHat _ ) = showString "^" + showsPrec _ (CTokBar _ ) = showString "|" + showsPrec _ (CTokAnd _ ) = showString "&&" + showsPrec _ (CTokOr _ ) = showString "||" + showsPrec _ (CTokQuest _ ) = showString "?" + showsPrec _ (CTokColon _ ) = showString ":" + showsPrec _ (CTokAssign _ ) = showString "=" + showsPrec _ (CTokPlusAss _ ) = showString "+=" + showsPrec _ (CTokMinusAss _ ) = showString "-=" + showsPrec _ (CTokStarAss _ ) = showString "*=" + showsPrec _ (CTokSlashAss _ ) = showString "/=" + showsPrec _ (CTokPercAss _ ) = showString "%=" + showsPrec _ (CTokAmpAss _ ) = showString "&=" + showsPrec _ (CTokHatAss _ ) = showString "^=" + showsPrec _ (CTokBarAss _ ) = showString "|=" + showsPrec _ (CTokSLAss _ ) = showString "<<=" + showsPrec _ (CTokSRAss _ ) = showString ">>=" + showsPrec _ (CTokComma _ ) = showString "," + showsPrec _ (CTokSemic _ ) = showString ";" + showsPrec _ (CTokLBrace _ ) = showString "{" + showsPrec _ (CTokRBrace _ ) = showString "}" + showsPrec _ (CTokEllipsis _ ) = showString "..." + showsPrec _ (CTokAlignof _ ) = showString "alignof" + showsPrec _ (CTokAsm _ ) = showString "asm" + showsPrec _ (CTokAuto _ ) = showString "auto" + showsPrec _ (CTokBreak _ ) = showString "break" + showsPrec _ (CTokCase _ ) = showString "case" + showsPrec _ (CTokChar _ ) = showString "char" + showsPrec _ (CTokConst _ ) = showString "const" + showsPrec _ (CTokContinue _ ) = showString "continue" + showsPrec _ (CTokDefault _ ) = showString "default" + showsPrec _ (CTokDouble _ ) = showString "double" + showsPrec _ (CTokDo _ ) = showString "do" + showsPrec _ (CTokElse _ ) = showString "else" + showsPrec _ (CTokEnum _ ) = showString "enum" + showsPrec _ (CTokExtern _ ) = showString "extern" + showsPrec _ (CTokFloat _ ) = showString "float" + showsPrec _ (CTokFor _ ) = showString "for" + showsPrec _ (CTokGoto _ ) = showString "goto" + showsPrec _ (CTokIf _ ) = showString "if" + showsPrec _ (CTokInline _ ) = showString "inline" + showsPrec _ (CTokInt _ ) = showString "int" + showsPrec _ (CTokLong _ ) = showString "long" + showsPrec _ (CTokLabel _ ) = showString "__label__" + showsPrec _ (CTokRegister _ ) = showString "register" + showsPrec _ (CTokRestrict _ ) = showString "restrict" + showsPrec _ (CTokReturn _ ) = showString "return" + showsPrec _ (CTokShort _ ) = showString "short" + showsPrec _ (CTokSigned _ ) = showString "signed" + showsPrec _ (CTokSizeof _ ) = showString "sizeof" + showsPrec _ (CTokStatic _ ) = showString "static" + showsPrec _ (CTokStruct _ ) = showString "struct" + showsPrec _ (CTokSwitch _ ) = showString "switch" + showsPrec _ (CTokTypedef _ ) = showString "typedef" + showsPrec _ (CTokTypeof _ ) = showString "typeof" + showsPrec _ (CTokThread _ ) = showString "__thread" + showsPrec _ (CTokUnion _ ) = showString "union" + showsPrec _ (CTokUnsigned _ ) = showString "unsigned" + showsPrec _ (CTokVoid _ ) = showString "void" + showsPrec _ (CTokVolatile _ ) = showString "volatile" + showsPrec _ (CTokWhile _ ) = showString "while" + showsPrec _ (CTokCLit _ c) = showChar c + showsPrec _ (CTokILit _ i) = (showString . show) i + showsPrec _ (CTokFLit _ s) = showString s + showsPrec _ (CTokSLit _ s) = showString s + showsPrec _ (CTokIdent _ i) = (showString . identToLexeme) i + showsPrec _ (CTokTyIdent _ i) = (showString . identToLexeme) i + showsPrec _ (CTokGnuC GnuCAttrTok _) = showString "__attribute__" + showsPrec _ (CTokGnuC GnuCExtTok _) = showString "__extension__" + showsPrec _ (CTokGnuC GnuCVaArg _) = showString "__builtin_va_arg" + showsPrec _ (CTokGnuC GnuCOffsetof _) = showString "__builtin_offsetof" + showsPrec _ (CTokGnuC GnuCTyCompat _) = showString "__builtin_types_compatible_p" diff --git a/c2hs/c/CTrav.hs b/c2hs/c/CTrav.hs new file mode 100644 --- /dev/null +++ b/c2hs/c/CTrav.hs @@ -0,0 +1,910 @@ +-- C->Haskell Compiler: traversals of C structure tree +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 16 October 99 +-- +-- Copyright (c) [1999..2001] Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This modules provides for traversals of C structure trees. The C +-- traversal monad supports traversals that need convenient access to the +-- attributes of an attributed C structure tree. The monads state can still +-- be extended. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Handling of redefined tag values +-- -------------------------------- +-- +-- Structures allow both +-- +-- struct s {...} ...; +-- struct s ...; +-- +-- and +-- +-- struct s ...; /* this is called a forward reference */ +-- struct s {...} ...; +-- +-- In contrast enumerations only allow (in ANSI C) +-- +-- enum e {...} ...; +-- enum e ...; +-- +-- The function `defTag' handles both types and establishes an object +-- association from the tag identifier in the empty declaration (ie, the one +-- without `{...}') to the actually definition of the structure of +-- enumeration. This implies that when looking for the details of a +-- structure or enumeration, possibly a chain of references on tag +-- identifiers has to be chased. Note that the object association attribute +-- is _not_defined_ when the `{...}' part is present in a declaration. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * `extractStruct' doesn't account for forward declarations that have no +-- full declaration yet; if `extractStruct' is called on such a declaration, +-- we have a user error, but currently an internal error is raised +-- + +module CTrav (CT, readCT, transCT, runCT, throwCTExc, ifCTExc, + raiseErrorCTExc, + enter, enterObjs, leave, leaveObjs, defObj, findObj, + findObjShadow, defTag, findTag, findTagShadow, + applyPrefixToNameSpaces, getDefOf, refersToDef, refersToNewDef, + getDeclOf, findTypeObjMaybe, findTypeObj, findValueObj, + findFunObj, + -- + -- C structure tree query functions + -- + isTypedef, simplifyDecl, declrFromDecl, declrNamed, + declaredDeclr, declaredName, structMembers, expandDecl, + structName, enumName, tagName, isPtrDeclr, dropPtrDeclr, + isPtrDecl, isFunDeclr, structFromDecl, funResultAndArgs, + chaseDecl, findAndChaseDecl, checkForAlias, checkForOneCUName, + checkForOneAliasName, lookupEnum, lookupStructUnion, + lookupDeclOrTag) +where + +import Data.List (find) +import Control.Monad (liftM) +import Control.Exception (assert) + +import Position (Position, Pos(..), nopos) +import Errors (interr) +import Idents (Ident, identToLexeme) +import Attributes (Attr(..), newAttrsOnlyPos) + +import C2HSState (CST, readCST, transCST, runCST, raiseError, catchExc, + throwExc, Traces(..), putTraceStr) +import CAST +import CAttrs (AttrC, enterNewRangeC, enterNewObjRangeC, + leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC, + lookupDefObjCShadow, addDefTagC, lookupDefTagC, + lookupDefTagCShadow, applyPrefix, getDefOfIdentC, + setDefOfIdentC, updDefOfIdentC, CObj(..), CTag(..), + CDef(..)) + + +-- the C traversal monad +-- --------------------- + +-- C traversal monad (EXPORTED ABSTRACTLY) +-- +type CState s = (AttrC, s) +type CT s a = CST (CState s) a + +-- read attributed struture tree +-- +readAttrCCT :: (AttrC -> a) -> CT s a +readAttrCCT reader = readCST $ \(ac, _) -> reader ac + +-- transform attributed structure tree +-- +transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a +transAttrCCT trans = transCST $ \(ac, s) -> let + (ac', r) = trans ac + in + ((ac', s), r) + +-- access to the user-defined state +-- + +-- read user-defined state (EXPORTED) +-- +readCT :: (s -> a) -> CT s a +readCT reader = readCST $ \(_, s) -> reader s + +-- transform user-defined state (EXPORTED) +-- +transCT :: (s -> (s, a)) -> CT s a +transCT trans = transCST $ \(ac, s) -> let + (s', r) = trans s + in + ((ac, s'), r) + +-- usage of a traversal monad +-- + +-- execute a traversal monad (EXPORTED) +-- +-- * given a traversal monad, an attribute structure tree, and a user +-- state, the transformed structure tree and monads result are returned +-- +runCT :: CT s a -> AttrC -> s -> CST t (AttrC, a) +runCT m ac s = runCST m' (ac, s) + where + m' = do + r <- m + (ac, _) <- readCST id + return (ac, r) + + +-- exception handling +-- ------------------ + +-- exception identifier +-- +ctExc :: String +ctExc = "ctExc" + +-- throw an exception (EXPORTED) +-- +throwCTExc :: CT s a +throwCTExc = throwExc ctExc "Error during traversal of a C structure tree" + +-- catch a `ctExc' (EXPORTED) +-- +ifCTExc :: CT s a -> CT s a -> CT s a +ifCTExc m handler = m `catchExc` (ctExc, const handler) + +-- raise an error followed by throwing a CT exception (EXPORTED) +-- +raiseErrorCTExc :: Position -> [String] -> CT s a +raiseErrorCTExc pos errs = raiseError pos errs >> throwCTExc + + +-- attribute manipulation +-- ---------------------- + +-- name spaces +-- + +-- enter a new local range (EXPORTED) +-- +enter :: CT s () +enter = transAttrCCT $ \ac -> (enterNewRangeC ac, ()) + +-- enter a new local range, only for objects (EXPORTED) +-- +enterObjs :: CT s () +enterObjs = transAttrCCT $ \ac -> (enterNewObjRangeC ac, ()) + +-- leave the current local range (EXPORTED) +-- +leave :: CT s () +leave = transAttrCCT $ \ac -> (leaveRangeC ac, ()) + +-- leave the current local range, only for objects (EXPORTED) +-- +leaveObjs :: CT s () +leaveObjs = transAttrCCT $ \ac -> (leaveObjRangeC ac, ()) + +-- enter an object definition into the object name space (EXPORTED) +-- +-- * if a definition of the same name was already present, it is returned +-- +defObj :: Ident -> CObj -> CT s (Maybe CObj) +defObj ide obj = transAttrCCT $ \ac -> addDefObjC ac ide obj + +-- find a definition in the object name space (EXPORTED) +-- +findObj :: Ident -> CT s (Maybe CObj) +findObj ide = readAttrCCT $ \ac -> lookupDefObjC ac ide + +-- find a definition in the object name space; if nothing found, try +-- whether there is a shadow identifier that matches (EXPORTED) +-- +findObjShadow :: Ident -> CT s (Maybe (CObj, Ident)) +findObjShadow ide = readAttrCCT $ \ac -> lookupDefObjCShadow ac ide + +-- enter a tag definition into the tag name space (EXPORTED) +-- +-- * empty definitions of structures get overwritten with complete ones and a +-- forward reference is added to their tag identifier; furthermore, both +-- structures and enums may be referenced using an empty definition when +-- there was a full definition earlier and in this case there is also an +-- object association added; otherwise, if a definition of the same name was +-- already present, it is returned (see DOCU section) +-- +-- * it is checked that the first occurence of an enumeration tag is +-- accompanied by a full definition of the enumeration +-- +defTag :: Ident -> CTag -> CT s (Maybe CTag) +defTag ide tag = + do + otag <- transAttrCCT $ \ac -> addDefTagC ac ide tag + case otag of + Nothing -> do + assertIfEnumThenFull tag + return Nothing -- no collision + Just prevTag -> case isRefinedOrUse prevTag tag of + Nothing -> return otag + Just (fullTag, foreIde) -> do + transAttrCCT $ \ac -> addDefTagC ac ide fullTag + foreIde `refersToDef` TagCD fullTag + return Nothing -- transparent for env + where + -- compute whether we have the case of a non-conflicting redefined tag + -- definition, and if so, return the full definition and the foreward + -- definition's tag identifier + -- + -- * the first argument contains the _previous_ definition + -- + -- * in the case of a structure, a foreward definition after a full + -- definition is allowed, so we have to handle this case; enumerations + -- don't allow foreward definitions + -- + -- * there may also be multiple foreward definition; if we have two of + -- them here, one is arbitrarily selected to take the role of the full + -- definition + -- + isRefinedOrUse (StructUnionCT (CStruct _ (Just ide) [] _)) + tag@(StructUnionCT (CStruct _ (Just _ ) _ _)) = + Just (tag, ide) + isRefinedOrUse tag@(StructUnionCT (CStruct _ (Just _ ) _ _)) + (StructUnionCT (CStruct _ (Just ide) [] _)) = + Just (tag, ide) + isRefinedOrUse tag@(EnumCT (CEnum (Just _ ) _ _)) + (EnumCT (CEnum (Just ide) [] _)) = + Just (tag, ide) + isRefinedOrUse _ _ = Nothing + +-- find an definition in the tag name space (EXPORTED) +-- +findTag :: Ident -> CT s (Maybe CTag) +findTag ide = readAttrCCT $ \ac -> lookupDefTagC ac ide + +-- find an definition in the tag name space; if nothing found, try +-- whether there is a shadow identifier that matches (EXPORTED) +-- +findTagShadow :: Ident -> CT s (Maybe (CTag, Ident)) +findTagShadow ide = readAttrCCT $ \ac -> lookupDefTagCShadow ac ide + +-- enrich the object and tag name space with identifiers obtained by dropping +-- the given prefix from the identifiers already in the name space (EXPORTED) +-- +-- * if a new identifier would collides with an existing one, the new one is +-- discarded, ie, all associations that existed before the transformation +-- started are still in effect after the transformation +-- +applyPrefixToNameSpaces :: String -> CT s () +applyPrefixToNameSpaces prefix = + transAttrCCT $ \ac -> (applyPrefix ac prefix, ()) + +-- definition attribute +-- + +-- get the definition of an identifier (EXPORTED) +-- +-- * the attribute must be defined, ie, a definition must be associated with +-- the given identifier +-- +getDefOf :: Ident -> CT s CDef +getDefOf ide = do + def <- readAttrCCT $ \ac -> getDefOfIdentC ac ide + assert (not . isUndef $ def) $ + return def + +-- set the definition of an identifier (EXPORTED) +-- +refersToDef :: Ident -> CDef -> CT s () +refersToDef ide def = transAttrCCT $ \akl -> (setDefOfIdentC akl ide def, ()) + +-- update the definition of an identifier (EXPORTED) +-- +refersToNewDef :: Ident -> CDef -> CT s () +refersToNewDef ide def = + transAttrCCT $ \akl -> (updDefOfIdentC akl ide def, ()) + +-- get the declarator of an identifier (EXPORTED) +-- +getDeclOf :: Ident -> CT s CDecl +getDeclOf ide = + do + traceEnter + def <- getDefOf ide + case def of + UndefCD -> interr "CTrav.getDeclOf: Undefined!" + DontCareCD -> interr "CTrav.getDeclOf: Don't care!" + TagCD _ -> interr "CTrav.getDeclOf: Illegal tag!" + ObjCD obj -> case obj of + TypeCO decl -> traceTypeCO >> + return decl + ObjCO decl -> traceObjCO >> + return decl + EnumCO _ _ -> illegalEnum + BuiltinCO -> illegalBuiltin + where + illegalEnum = interr "CTrav.getDeclOf: Illegal enum!" + illegalBuiltin = interr "CTrav.getDeclOf: Attempted to get declarator of \ + \builtin entity!" + -- if the latter ever becomes necessary, we have to + -- change the representation of builtins and give them + -- some dummy declarator + traceEnter = traceCTrav $ + "Entering `getDeclOf' for `" ++ identToLexeme ide + ++ "'...\n" + traceTypeCO = traceCTrav $ + "...found a type object.\n" + traceObjCO = traceCTrav $ + "...found a vanilla object.\n" + + +-- convenience functions +-- + +-- find a type object in the object name space; returns `nothing' if the +-- identifier is not defined (EXPORTED) +-- +-- * if the second argument is `True', use `findObjShadow' +-- +findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident)) +findTypeObjMaybe ide useShadows = + do + oobj <- if useShadows + then findObjShadow ide + else liftM (fmap (\obj -> (obj, ide))) $ findObj ide + case oobj of + Just obj@(TypeCO _ , _) -> return $ Just obj + Just obj@(BuiltinCO, _) -> return $ Just obj + Just _ -> typedefExpectedErr ide + Nothing -> return $ Nothing + +-- find a type object in the object name space; raises an error and exception +-- if the identifier is not defined (EXPORTED) +-- +-- * if the second argument is `True', use `findObjShadow' +-- +findTypeObj :: Ident -> Bool -> CT s (CObj, Ident) +findTypeObj ide useShadows = do + oobj <- findTypeObjMaybe ide useShadows + case oobj of + Nothing -> unknownObjErr ide + Just obj -> return obj + +-- find an object, function, or enumerator in the object name space; raises an +-- error and exception if the identifier is not defined (EXPORTED) +-- +-- * if the second argument is `True', use `findObjShadow' +-- +findValueObj :: Ident -> Bool -> CT s (CObj, Ident) +findValueObj ide useShadows = + do + oobj <- if useShadows + then findObjShadow ide + else liftM (fmap (\obj -> (obj, ide))) $ findObj ide + case oobj of + Just obj@(ObjCO _ , _) -> return obj + Just obj@(EnumCO _ _, _) -> return obj + Just _ -> unexpectedTypedefErr (posOf ide) + Nothing -> unknownObjErr ide + +-- find a function in the object name space; raises an error and exception if +-- the identifier is not defined (EXPORTED) +-- +-- * if the second argument is `True', use `findObjShadow' +-- +findFunObj :: Ident -> Bool -> CT s (CObj, Ident) +findFunObj ide useShadows = + do + (obj, ide') <- findValueObj ide useShadows + case obj of + EnumCO _ _ -> funExpectedErr (posOf ide) + ObjCO decl -> do + let declr = ide' `declrFromDecl` decl + assertFunDeclr (posOf ide) declr + return (obj, ide') + + +-- C structure tree query routines +-- ------------------------------- + +-- test if this is a type definition specification (EXPORTED) +-- +isTypedef :: CDecl -> Bool +isTypedef (CDecl specs _ _) = + not . null $ [() | CStorageSpec (CTypedef _) <- specs] + +-- discard all declarators but the one declaring the given identifier +-- (EXPORTED) +-- +-- * the declaration must contain the identifier +-- +simplifyDecl :: Ident -> CDecl -> CDecl +ide `simplifyDecl` (CDecl specs declrs at) = + case find (`declrPlusNamed` ide) declrs of + Nothing -> err + Just declr -> CDecl specs [declr] at + where + (Just declr, _, _) `declrPlusNamed` ide = declr `declrNamed` ide + _ `declrPlusNamed` _ = False + -- + err = interr $ "CTrav.simplifyDecl: Wrong C object!\n\ + \ Looking for `" ++ identToLexeme ide ++ "' in decl \ + \at " ++ show (posOf at) + +-- extract the declarator that declares the given identifier (EXPORTED) +-- +-- * the declaration must contain the identifier +-- +declrFromDecl :: Ident -> CDecl -> CDeclr +ide `declrFromDecl` decl = + let CDecl _ [(Just declr, _, _)] _ = ide `simplifyDecl` decl + in + declr + +-- tests whether the given declarator has the given name (EXPORTED) +-- +declrNamed :: CDeclr -> Ident -> Bool +declr `declrNamed` ide = declrName declr == Just ide + +-- get the declarator of a declaration that has at most one declarator +-- (EXPORTED) +-- +declaredDeclr :: CDecl -> Maybe CDeclr +declaredDeclr (CDecl _ [] _) = Nothing +declaredDeclr (CDecl _ [(odeclr, _, _)] _) = odeclr +declaredDeclr decl = + interr $ "CTrav.declaredDeclr: Too many declarators!\n\ + \ Declaration at " ++ show (posOf decl) + +-- get the name declared by a declaration that has exactly one declarator +-- (EXPORTED) +-- +declaredName :: CDecl -> Maybe Ident +declaredName decl = declaredDeclr decl >>= declrName + +-- obtains the member definitions and the tag of a struct (EXPORTED) +-- +-- * member definitions are expanded +-- +structMembers :: CStructUnion -> ([CDecl], CStructTag) +structMembers (CStruct tag _ members _) = (concat . map expandDecl $ members, + tag) + +-- expand declarators declaring more than one identifier into multiple +-- declarators, eg, `int x, y;' becomes `int x; int y;' (EXPORTED) +-- +expandDecl :: CDecl -> [CDecl] +expandDecl (CDecl specs decls at) = + map (\decl -> CDecl specs [decl] at) decls + +-- get a struct's name (EXPORTED) +-- +structName :: CStructUnion -> Maybe Ident +structName (CStruct _ oide _ _) = oide + +-- get an enum's name (EXPORTED) +-- +enumName :: CEnum -> Maybe Ident +enumName (CEnum oide _ _) = oide + +-- get a tag's name (EXPORTED) +-- +-- * fail if the tag is anonymous +-- +tagName :: CTag -> Ident +tagName tag = + case tag of + StructUnionCT struct -> maybe err id $ structName struct + EnumCT enum -> maybe err id $ enumName enum + where + err = interr "CTrav.tagName: Anonymous tag definition" + +-- checks whether the given declarator defines an object that is a pointer to +-- some other type (EXPORTED) +-- +-- * as far as parameter passing is concerned, arrays are also pointer +-- +isPtrDeclr :: CDeclr -> Bool +isPtrDeclr (CPtrDeclr _ (CVarDeclr _ _) _) = True +isPtrDeclr (CPtrDeclr _ declr _) = isPtrDeclr declr +isPtrDeclr (CArrDeclr (CVarDeclr _ _) _ _ _) = True +isPtrDeclr (CArrDeclr declr _ _ _) = isPtrDeclr declr +isPtrDeclr (CFunDeclr declr _ _ _) = isPtrDeclr declr +isPtrDeclr _ = False + +-- drops the first pointer level from the given declarator (EXPORTED) +-- +-- * the declarator must declare a pointer object +-- +-- FIXME: this implementation isn't nice, because we retain the `CVarDeclr' +-- unchanged; as the declarator is changed, we should maybe make this +-- into an anonymous declarator and also change its attributes +-- +dropPtrDeclr :: CDeclr -> CDeclr +dropPtrDeclr (CPtrDeclr qs declr@(CVarDeclr _ _) ats) = declr +dropPtrDeclr (CPtrDeclr qs declr ats) = + let declr' = dropPtrDeclr declr + in + CPtrDeclr qs declr' ats +dropPtrDeclr (CArrDeclr declr@(CVarDeclr _ _) _ _ _) = declr +dropPtrDeclr (CArrDeclr declr tq e ats) = + let declr' = dropPtrDeclr declr + in + CArrDeclr declr' tq e ats +dropPtrDeclr (CFunDeclr declr args vari ats) = + let declr' = dropPtrDeclr declr + in + CFunDeclr declr' args vari ats +dropPtrDeclr _ = + interr "CTrav.dropPtrDeclr: No pointer!" + +-- checks whether the given declaration defines a pointer object (EXPORTED) +-- +-- * there may only be a single declarator in the declaration +-- +isPtrDecl :: CDecl -> Bool +isPtrDecl (CDecl _ [] _) = False +isPtrDecl (CDecl _ [(Just declr, _, _)] _) = isPtrDeclr declr +isPtrDecl _ = + interr "CTrav.isPtrDecl: There was more than one declarator!" + +-- checks whether the given declarator defines a function object (EXPORTED) +-- +isFunDeclr :: CDeclr -> Bool +isFunDeclr (CPtrDeclr _ declr _) = isFunDeclr declr +isFunDeclr (CArrDeclr declr _ _ _) = isFunDeclr declr +isFunDeclr (CFunDeclr (CVarDeclr _ _) _ _ _) = True +isFunDeclr (CFunDeclr declr _ _ _) = isFunDeclr declr +isFunDeclr _ = False + +-- extract the structure from the type specifiers of a declaration (EXPORTED) +-- +structFromDecl :: Position -> CDecl -> CT s CStructUnion +structFromDecl pos (CDecl specs _ _) = + case head [ts | CTypeSpec ts <- specs] of + CSUType su _ -> extractStruct pos (StructUnionCT su) + _ -> structExpectedErr pos + +-- extracts the arguments from a function declaration (must be a unique +-- declarator) and constructs a declaration for the result of the function +-- (EXPORTED) +-- +-- * the boolean result indicates whether the function is variadic +-- +funResultAndArgs :: CDecl -> ([CDecl], CDecl, Bool) +funResultAndArgs (CDecl specs [(Just declr, _, _)] _) = + let (args, declr', variadic) = funArgs declr + result = CDecl specs [(Just declr', Nothing, Nothing)] + (newAttrsOnlyPos nopos) + in + (args, result, variadic) + where + funArgs (CFunDeclr var@(CVarDeclr _ _) args variadic _) = + (args, var, variadic) + funArgs (CPtrDeclr qs declr at) = + let (args, declr', variadic) = funArgs declr + in + (args, CPtrDeclr qs declr' at, variadic) + funArgs (CArrDeclr declr tqs oe at) = + let (args, declr', variadic) = funArgs declr + in + (args, CArrDeclr declr' tqs oe at, variadic) + funArgs (CFunDeclr declr args var at) = + let (args, declr', variadic) = funArgs declr + in + (args, CFunDeclr declr' args var at, variadic) + funArgs _ = + interr "CTrav.funResultAndArgs: Illegal declarator!" + +-- name chasing +-- + +-- find the declarator identified by the given identifier; if the declarator +-- is itself only a `typedef'ed name, the operation recursively searches for +-- the declarator associated with that name (this is called ``typedef +-- chasing'') (EXPORTED) +-- +-- * if `ind = True', we have to hop over one indirection +-- +-- * remove all declarators except the one we just looked up +-- +chaseDecl :: Ident -> Bool -> CT s CDecl +-- +-- * cycles are no issue, as they cannot occur in a correct C header (we would +-- have spotted the problem during name analysis) +-- +chaseDecl ide ind = + do + traceEnter + cdecl <- getDeclOf ide + let sdecl = ide `simplifyDecl` cdecl + case extractAlias sdecl ind of + Just (ide', ind') -> chaseDecl ide' ind' + Nothing -> return sdecl + where + traceEnter = traceCTrav $ + "Entering `chaseDecl' for `" ++ identToLexeme ide + ++ "' " ++ (if ind then "" else "not ") + ++ "following indirections...\n" + +-- find type object in object name space and then chase it (EXPORTED) +-- +-- * see also `chaseDecl' +-- +-- * also create an object association from the given identifier to the object +-- that it _directly_ represents +-- +-- * if the third argument is `True', use `findObjShadow' +-- +findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl +findAndChaseDecl ide ind useShadows = + do + (obj, ide') <- findTypeObj ide useShadows -- is there an object def? + ide `refersToNewDef` ObjCD obj + ide' `refersToNewDef` ObjCD obj -- assoc needed for chasing + chaseDecl ide' ind + +-- given a declaration (which must have exactly one declarator), if the +-- declarator is an alias, chase it to the actual declaration (EXPORTED) +-- +checkForAlias :: CDecl -> CT s (Maybe CDecl) +checkForAlias decl = + case extractAlias decl False of + Nothing -> return Nothing + Just (ide', _) -> liftM Just $ chaseDecl ide' False + +-- given a declaration (which must have exactly one declarator), if the +-- declarator is an alias, yield the alias name; *no* chasing (EXPORTED) +-- +checkForOneAliasName :: CDecl -> Maybe Ident +checkForOneAliasName decl = fmap fst $ extractAlias decl False + +-- given a declaration, find the name of the struct/union type +checkForOneCUName :: CDecl -> Maybe Ident +checkForOneCUName decl@(CDecl specs _ _) = + case [ts | CTypeSpec ts <- specs] of + [CSUType (CStruct _ n _ _) _] -> + case declaredDeclr decl of + Nothing -> n + Just (CVarDeclr _ _ ) -> n + Just (CPtrDeclr _ (CVarDeclr _ _) _) -> Nothing + _ -> Nothing + +-- smart lookup +-- + +-- for the given identifier, either find an enumeration in the tag name space +-- or a type definition referring to an enumeration in the object name space; +-- raises an error and exception if the identifier is not defined (EXPORTED) +-- +-- * if the second argument is `True', use `findTagShadow' +-- +lookupEnum :: Ident -> Bool -> CT s CEnum +lookupEnum ide useShadows = + do + otag <- if useShadows + then liftM (fmap fst) $ findTagShadow ide + else findTag ide + case otag of + Just (StructUnionCT _ ) -> enumExpectedErr ide -- wrong tag definition + Just (EnumCT enum) -> return enum -- enum tag definition + Nothing -> do -- no tag definition + (CDecl specs _ _) <- findAndChaseDecl ide False useShadows + case head [ts | CTypeSpec ts <- specs] of + CEnumType enum _ -> return enum + _ -> enumExpectedErr ide + +-- for the given identifier, either find a struct/union in the tag name space +-- or a type definition referring to a struct/union in the object name space; +-- raises an error and exception if the identifier is not defined (EXPORTED) +-- +-- * if `ind = True', the identifier names a reference type to the searched +-- for struct/union +-- +-- * typedef chasing is used only if there is no tag of the same name or an +-- indirection (ie, `ind = True') is explicitly required +-- +-- * if the third argument is `True', use `findTagShadow' +-- +-- * when finding a forward definition of a tag, follow it to the real +-- definition +-- +lookupStructUnion :: Ident -> Bool -> Bool -> CT s CStructUnion +lookupStructUnion ide ind useShadows + | ind = chase + | otherwise = + do + otag <- if useShadows + then liftM (fmap fst) $ findTagShadow ide + else findTag ide + maybe chase (extractStruct (posOf ide)) otag -- `chase' if `Nothing' + where + chase = + do + decl <- findAndChaseDecl ide ind useShadows + structFromDecl (posOf ide) decl + +-- for the given identifier, check for the existance of both a type definition +-- or a struct, union, or enum definition (EXPORTED) +-- +-- * if a typedef and a tag exists, the typedef takes precedence +-- +-- * typedefs are chased +-- +-- * if the second argument is `True', look for shadows, too +-- +lookupDeclOrTag :: Ident -> Bool -> CT s (Either CDecl CTag) +lookupDeclOrTag ide useShadows = do + oobj <- findTypeObjMaybe ide useShadows + case oobj of + Just (_, ide) -> liftM Left $ findAndChaseDecl ide False False + -- already did check shadows + Nothing -> do + otag <- if useShadows + then liftM (fmap fst) $ findTagShadow ide + else findTag ide + case otag of + Nothing -> unknownObjErr ide + Just tag -> return $ Right tag + + +-- auxiliary routines (internal) +-- + +-- if the given declaration (which may have at most one declarator) is a +-- `typedef' alias, yield the referenced name +-- +-- * a `typedef' alias has one of the following forms +-- +-- at x, ...; +-- at *x, ...; +-- +-- where `at' is the alias type, which has been defined by a `typedef', and +-- are arbitrary specifiers and qualifiers. Note that `x' may be a +-- variable, a type name (if `typedef' is in ), or be entirely +-- omitted. +-- +-- * if `ind = True', the alias may be via an indirection +-- +-- * if `ind = True' and the alias is _not_ over an indirection, yield `True'; +-- otherwise `False' (ie, the ability to hop over an indirection is consumed) +-- +-- * this may be an anonymous declaration, ie, the name in `CVarDeclr' may be +-- omitted or there may be no declarator at all +-- +extractAlias :: CDecl -> Bool -> Maybe (Ident, Bool) +extractAlias decl@(CDecl specs _ _) ind = + case [ts | CTypeSpec ts <- specs] of + [CTypeDef ide' _] -> -- type spec is aliased ident + case declaredDeclr decl of + Nothing -> Just (ide', ind) + Just (CVarDeclr _ _ ) -> Just (ide', ind) + Just (CPtrDeclr _ (CVarDeclr _ _) _) + | ind -> Just (ide', False) + | otherwise -> Nothing + _ -> Nothing + _ -> Nothing + +-- if the given tag is a forward declaration of a structure, follow the +-- reference to the full declaration +-- +-- * the recursive call is not dangerous as there can't be any cycles +-- +extractStruct :: Position -> CTag -> CT s CStructUnion +extractStruct pos (EnumCT _ ) = structExpectedErr pos +extractStruct pos (StructUnionCT su) = + case su of + CStruct _ (Just ide') [] _ -> do -- found forward definition + def <- getDefOf ide' + case def of + TagCD tag -> extractStruct pos tag + _ -> err + _ -> return su + where + err = interr "CTrav.extractStruct: Illegal reference!" + +-- yield the name declared by a declarator if any +-- +declrName :: CDeclr -> Maybe Ident +declrName (CVarDeclr oide _) = oide +declrName (CPtrDeclr _ declr _) = declrName declr +declrName (CArrDeclr declr _ _ _) = declrName declr +declrName (CFunDeclr declr _ _ _) = declrName declr + +-- raise an error if the given declarator does not declare a C function or if +-- the function is supposed to return an array (the latter is illegal in C) +-- +assertFunDeclr :: Position -> CDeclr -> CT s () +assertFunDeclr pos (CArrDeclr (CFunDeclr (CVarDeclr _ _) _ _ _) _ _ _) = + illegalFunResultErr pos +assertFunDeclr pos (CFunDeclr (CVarDeclr _ _) _ _ _) = + return () -- everything is ok +assertFunDeclr pos (CFunDeclr declr _ _ _) = + assertFunDeclr pos declr +assertFunDeclr pos (CPtrDeclr _ declr _) = + assertFunDeclr pos declr +assertFunDeclr pos (CArrDeclr declr _ _ _) = + assertFunDeclr pos declr +assertFunDeclr pos _ = + funExpectedErr pos + +-- raise an error if the given tag defines an enumeration, but does not fully +-- define it +-- +assertIfEnumThenFull :: CTag -> CT s () +assertIfEnumThenFull (EnumCT (CEnum _ [] at)) = enumForwardErr (posOf at) +assertIfEnumThenFull _ = return () + +-- trace for this module +-- +traceCTrav :: String -> CT s () +traceCTrav = putTraceStr traceCTravSW + + +-- error messages +-- -------------- + +unknownObjErr :: Ident -> CT s a +unknownObjErr ide = + raiseErrorCTExc (posOf ide) + ["Unknown identifier!", + "Cannot find a definition for `" ++ identToLexeme ide ++ "' in the \ + \header file."] + +typedefExpectedErr :: Ident -> CT s a +typedefExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Expected type definition!", + "The identifier `" ++ identToLexeme ide ++ "' needs to be a C type name."] + +unexpectedTypedefErr :: Position -> CT s a +unexpectedTypedefErr pos = + raiseErrorCTExc pos + ["Unexpected type name!", + "An object, function, or enum constant is required here."] + +illegalFunResultErr :: Position -> CT s a +illegalFunResultErr pos = + raiseErrorCTExc pos ["Function cannot return an array!", + "ANSI C does not allow functions to return an array."] + +funExpectedErr :: Position -> CT s a +funExpectedErr pos = + raiseErrorCTExc pos + ["Function expected!", + "A function is needed here, but this declarator does not declare", + "a function."] + +enumExpectedErr :: Ident -> CT s a +enumExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Expected enum!", + "Expected `" ++ identToLexeme ide ++ "' to denote an enum; instead found", + "a struct, union, or object."] + +structExpectedErr :: Position -> CT s a +structExpectedErr pos = + raiseErrorCTExc pos + ["Expected a struct!", + "Expected a structure or union; instead found an enum or basic type."] + +enumForwardErr :: Position -> CT s a +enumForwardErr pos = + raiseErrorCTExc pos + ["Forward definition of enumeration!", + "ANSI C does not permit foreward definitions of enumerations!"] diff --git a/c2hs/chs/CHS.hs b/c2hs/chs/CHS.hs new file mode 100644 --- /dev/null +++ b/c2hs/chs/CHS.hs @@ -0,0 +1,1234 @@ +-- C->Haskell Compiler: CHS file abstraction +-- +-- Author : Manuel M T Chakravarty +-- Created: 16 August 99 +-- +-- Copyright (c) [1999..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Main file for reading CHS files. +-- +-- Import hooks & .chi files +-- ------------------------- +-- +-- Reading of `.chi' files is interleaved with parsing. More precisely, +-- whenever the parser comes across an import hook, it immediately reads the +-- `.chi' file and inserts its contents into the abstract representation of +-- the hook. The parser checks the version of the `.chi' file, but does not +-- otherwise attempt to interpret its contents. This is only done during +-- generation of the binding module. The first line of a .chi file has the +-- form +-- +-- C->Haskell Interface Version +-- +-- where is the three component version number `Version.version'. +-- C->Haskell will only accept files whose version number match its own in +-- the first two components (ie, major and minor version). In other words, +-- it must be guaranteed that the format of .chi files is not altered between +-- versions that differ only in their patchlevel. All remaining lines of the +-- file are version dependent and contain a dump of state information that +-- the binding file generator needs to rescue across modules. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- The following binding hooks are recognised: +-- +-- hook -> `{#' inner `#}' +-- inner -> `import' ['qualified'] ident +-- | `context' ctxt +-- | `type' ident +-- | `sizeof' ident +-- | `enum' idalias trans [`with' prefix] [deriving] +-- | `call' [`pure'] [`unsafe'] idalias +-- | `fun' [`pure'] [`unsafe'] idalias parms +-- | `get' apath +-- | `set' apath +-- | `pointer' ['*'] idalias ptrkind ['nocode'] +-- | `class' [ident `=>'] ident ident +-- ctxt -> [`lib' `=' string] [prefix] +-- idalias -> ident [`as' (ident | `^')] +-- prefix -> `prefix' `=' string +-- deriving -> `deriving' `(' ident_1 `,' ... `,' ident_n `)' +-- parms -> [verbhs `=>'] `{' parm_1 `,' ... `,' parm_n `}' `->' parm +-- parm -> [ident_1 [`*' | `-']] verbhs [`&'] [ident_2 [`*'] [`-']] +-- apath -> ident +-- | `*' apath +-- | apath `.' ident +-- | apath `->' ident +-- trans -> `{' alias_1 `,' ... `,' alias_n `}' +-- alias -> `underscoreToCase' | `upcaseFirstLetter' +-- | `downcaseFirstLetter' +-- | ident `as' ident +-- ptrkind -> [`foreign' | `stable'] ['newtype' | '->' ident] +-- +-- If `underscoreToCase', `upcaseFirstLetter', or `downcaseFirstLetter' +-- occurs in a translation table, it must be the first entry, or if two of +-- them occur the first two entries. +-- +-- Remark: Optional Haskell names are normalised during structure tree +-- construction, ie, associations that associated a name with itself +-- are removed. (They don't carry semantic content, and make some +-- tests more complicated.) +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CHS (CHSModule(..), CHSFrag(..), CHSHook(..), CHSTrans(..), + CHSChangeCase(..), CHSParm(..), CHSArg(..), CHSAccess(..), + CHSAPath(..), CHSPtrType(..), + loadCHS, dumpCHS, hssuffix, chssuffix, loadCHI, dumpCHI, chisuffix, + showCHSParm, apathToIdent) +where + +-- standard libraries +import Data.Char (isSpace, toUpper, toLower) +import Data.List (intersperse) +import Control.Monad (when) +import System.FilePath ((<.>), ()) + +-- Compiler Toolkit +import Position (Position(..), Pos(posOf), nopos, isBuiltinPos) +import Errors (interr) +import Idents (Ident, identToLexeme, onlyPosIdent) + +-- C->Haskell +import C2HSState (CST, doesFileExistCIO, readFileCIO, writeFileCIO, + getSwitch, chiPathSB, catchExc, throwExc, raiseError, + fatal, errorsPresent, showErrors, Traces(..), putTraceStr) +import Version (version) + +-- friends +import CHSLexer (CHSToken(..), lexCHS) + + +-- CHS abstract syntax +-- ------------------- + +-- representation of a CHS module (EXPORTED) +-- +data CHSModule = CHSModule [CHSFrag] + +-- a CHS code fragament (EXPORTED) +-- +-- * `CHSVerb' fragments are present throughout the compilation and finally +-- they are the only type of fragment (describing the generated Haskell +-- code) +-- +-- * `CHSHook' are binding hooks, which are being replaced by Haskell code by +-- `GenBind.expandHooks' +-- +-- * `CHSCPP' and `CHSC' are fragements of C code that are being removed when +-- generating the custom C header in `GenHeader.genHeader' +-- +-- * `CHSCond' are strutured conditionals that are being generated by +-- `GenHeader.genHeader' from conditional CPP directives (`CHSCPP') +-- +data CHSFrag = CHSVerb String -- Haskell code + Position + | CHSHook CHSHook -- binding hook + | CHSCPP String -- pre-processor directive + Position + | CHSLine Position -- line pragma + | CHSC String -- C code + Position + | CHSCond [(Ident, -- C variable repr. condition + [CHSFrag])] -- then/elif branches + (Maybe [CHSFrag]) -- else branch + +instance Pos CHSFrag where + posOf (CHSVerb _ pos ) = pos + posOf (CHSHook hook ) = posOf hook + posOf (CHSCPP _ pos ) = pos + posOf (CHSLine pos ) = pos + posOf (CHSC _ pos ) = pos + posOf (CHSCond alts _) = case alts of + (_, frag:_):_ -> posOf frag + _ -> nopos + +-- a CHS binding hook (EXPORTED) +-- +data CHSHook = CHSImport Bool -- qualified? + Ident -- module name + String -- content of .chi file + Position + | CHSContext (Maybe String) -- library name + (Maybe String) -- prefix + Position + | CHSType Ident -- C type + Position + | CHSSizeof Ident -- C type + Position + | CHSEnum Ident -- C enumeration type + (Maybe Ident) -- Haskell name + CHSTrans -- translation table + (Maybe String) -- local prefix + [Ident] -- instance requests from user + Position + | CHSCall Bool -- is a pure function? + Bool -- is unsafe? + CHSAPath -- C function + (Maybe Ident) -- Haskell name + Position + | CHSFun Bool -- is a pure function? + Bool -- is unsafe? + CHSAPath -- C function + (Maybe Ident) -- Haskell name + (Maybe String) -- type context + [CHSParm] -- argument marshalling + CHSParm -- result marshalling + Position + | CHSField CHSAccess -- access type + CHSAPath -- access path + Position + | CHSPointer Bool -- explicit '*' in hook + Ident -- C pointer name + (Maybe Ident) -- Haskell name + CHSPtrType -- Ptr, ForeignPtr or StablePtr + Bool -- create new type? + (Maybe Ident) -- Haskell type pointed to + Bool -- emit type decl? + Position + | CHSClass (Maybe Ident) -- superclass + Ident -- class name + Ident -- name of pointer type + Position + +instance Pos CHSHook where + posOf (CHSImport _ _ _ pos) = pos + posOf (CHSContext _ _ pos) = pos + posOf (CHSType _ pos) = pos + posOf (CHSSizeof _ pos) = pos + posOf (CHSEnum _ _ _ _ _ pos) = pos + posOf (CHSCall _ _ _ _ pos) = pos + posOf (CHSFun _ _ _ _ _ _ _ pos) = pos + posOf (CHSField _ _ pos) = pos + posOf (CHSPointer _ _ _ _ _ _ _ pos) = pos + posOf (CHSClass _ _ _ pos) = pos + +-- two hooks are equal if they have the same Haskell name and reference the +-- same C object +-- +instance Eq CHSHook where + (CHSImport qual1 ide1 _ _) == (CHSImport qual2 ide2 _ _) = + qual1 == qual2 && ide1 == ide2 + (CHSContext olib1 opref1 _ ) == (CHSContext olib2 opref2 _ ) = + olib1 == olib1 && opref1 == opref2 + (CHSType ide1 _) == (CHSType ide2 _) = + ide1 == ide2 + (CHSSizeof ide1 _) == (CHSSizeof ide2 _) = + ide1 == ide2 + (CHSEnum ide1 oalias1 _ _ _ _) == (CHSEnum ide2 oalias2 _ _ _ _) = + oalias1 == oalias2 && ide1 == ide2 + (CHSCall _ _ ide1 oalias1 _) == (CHSCall _ _ ide2 oalias2 _) = + oalias1 == oalias2 && ide1 == ide2 + (CHSFun _ _ ide1 oalias1 _ _ _ _) + == (CHSFun _ _ ide2 oalias2 _ _ _ _) = + oalias1 == oalias2 && ide1 == ide2 + (CHSField acc1 path1 _) == (CHSField acc2 path2 _) = + acc1 == acc2 && path1 == path2 + (CHSPointer _ ide1 oalias1 _ _ _ _ _) + == (CHSPointer _ ide2 oalias2 _ _ _ _ _) = + ide1 == ide2 && oalias1 == oalias2 + (CHSClass _ ide1 _ _) == (CHSClass _ ide2 _ _) = + ide1 == ide2 + _ == _ = False + +-- translation table (EXPORTED) +-- +data CHSTrans = CHSTrans Bool -- underscore to case? + CHSChangeCase -- upcase or downcase? + [(Ident, Ident)] -- alias list + +data CHSChangeCase = CHSSameCase + | CHSUpCase + | CHSDownCase + deriving Eq + +-- marshalling descriptor for function hooks (EXPORTED) +-- +-- * a marshaller consists of a function name and flag indicating whether it +-- has to be executed in the IO monad +-- +data CHSParm = CHSParm (Maybe (Ident, CHSArg)) -- "in" marshaller + String -- Haskell type + Bool -- C repr: two values? + (Maybe (Ident, CHSArg)) -- "out" marshaller + Position + +-- kinds of arguments in function hooks (EXPORTED) +-- +data CHSArg = CHSValArg -- plain value argument + | CHSIOArg -- reference argument + | CHSVoidArg -- no argument + | CHSIOVoidArg -- drops argument, but in monad + deriving (Eq) + +-- structure member access types (EXPORTED) +-- +data CHSAccess = CHSSet -- set structure field + | CHSGet -- get structure field + deriving (Eq) + +-- structure access path (EXPORTED) +-- +data CHSAPath = CHSRoot Ident -- root of access path + | CHSDeref CHSAPath Position -- dereferencing + | CHSRef CHSAPath Ident -- member referencing + deriving (Eq) + +instance Pos CHSAPath where + posOf (CHSRoot ide) = posOf ide + posOf (CHSDeref _ pos) = pos + posOf (CHSRef _ ide) = posOf ide + +-- pointer options (EXPORTED) +-- + +data CHSPtrType = CHSPtr -- standard Ptr from Haskell + | CHSForeignPtr -- a pointer with a finalizer + | CHSStablePtr -- a pointer into Haskell land + deriving (Eq) + +instance Show CHSPtrType where + show CHSPtr = "Ptr" + show CHSForeignPtr = "ForeignPtr" + show CHSStablePtr = "StablePtr" + +instance Read CHSPtrType where + readsPrec _ ( 'P':'t':'r':rest) = + [(CHSPtr, rest)] + readsPrec _ ('F':'o':'r':'e':'i':'g':'n':'P':'t':'r':rest) = + [(CHSForeignPtr, rest)] + readsPrec _ ('S':'t':'a':'b':'l':'e' :'P':'t':'r':rest) = + [(CHSStablePtr, rest)] + readsPrec p (c:cs) + | isSpace c = readsPrec p cs + readsPrec _ _ = [] + + +-- load and dump a CHS file +-- ------------------------ + +hssuffix, chssuffix :: String +hssuffix = "hs" +chssuffix = "chs" + +-- load a CHS module (EXPORTED) +-- +-- * the file suffix is automagically appended +-- +-- * in case of a syntactical or lexical error, a fatal error is raised; +-- warnings are returned together with the module +-- +loadCHS :: FilePath -> CST s (CHSModule, String) +loadCHS fname = do + let fullname = fname <.> chssuffix + + -- read file + -- + traceInfoRead fullname + contents <- readFileCIO fullname + + -- parse + -- + traceInfoParse + mod <- parseCHSModule (Position fullname 1 1) contents + + -- check for errors and finalize + -- + errs <- errorsPresent + if errs + then do + traceInfoErr + errmsgs <- showErrors + fatal ("CHS module contains \ + \errors:\n\n" ++ errmsgs) -- fatal error + else do + traceInfoOK + warnmsgs <- showErrors + return (mod, warnmsgs) + where + traceInfoRead fname = putTraceStr tracePhasesSW + ("Attempting to read file `" + ++ fname ++ "'...\n") + traceInfoParse = putTraceStr tracePhasesSW + ("...parsing `" + ++ fname ++ "'...\n") + traceInfoErr = putTraceStr tracePhasesSW + ("...error(s) detected in `" + ++ fname ++ "'.\n") + traceInfoOK = putTraceStr tracePhasesSW + ("...successfully loaded `" + ++ fname ++ "'.\n") + +-- given a file name (no suffix) and a CHS module, the module is printed +-- into that file (EXPORTED) +-- +-- * the module can be flagged as being pure Haskell +-- +-- * the correct suffix will automagically be appended +-- +dumpCHS :: String -> CHSModule -> Bool -> CST s () +dumpCHS fname mod pureHaskell = + do + let (suffix, kind) = if pureHaskell + then (hssuffix , "(Haskell)") + else (chssuffix, "(C->HS binding)") + writeFileCIO (fname <.> suffix) (contents version kind) + where + contents version kind = + "-- GENERATED by " ++ version ++ " " ++ kind ++ "\n\ + \-- Edit the ORIGNAL .chs file instead!\n\n" + ++ showCHSModule mod pureHaskell + +-- to keep track of the current state of the line emission automaton +-- +data LineState = Emit -- emit LINE pragma if next frag is Haskell + | Wait -- emit LINE pragma after the next '\n' + | NoLine -- no pragma needed + deriving (Eq) + +-- convert a CHS module into a string +-- +-- * if the second argument is `True', all fragments must contain Haskell code +-- +showCHSModule :: CHSModule -> Bool -> String +showCHSModule (CHSModule frags) pureHaskell = + showFrags pureHaskell Emit frags [] + where + -- the second argument indicates whether the next fragment (if it is + -- Haskell code) should be preceded by a LINE pragma; in particular + -- generated fragments and those following them need to be prefixed with a + -- LINE pragma + -- + showFrags :: Bool -> LineState -> [CHSFrag] -> ShowS + showFrags _ _ [] = id + showFrags pureHs state (CHSVerb s pos : frags) = + let + (Position fname line _) = pos + generated = isBuiltinPos pos + emitNow = state == Emit || + (state == Wait && not (null s) && head s == '\n') + nextState = if generated then Wait else NoLine + in + (if emitNow then + showString ("\n{-# LINE " ++ show (line `max` 0) ++ " " ++ + show fname ++ " #-}") + else id) + . showString s + . showFrags pureHs nextState frags + showFrags False _ (CHSHook hook : frags) = + showString "{#" + . showCHSHook hook + . showString "#}" + . showFrags False Wait frags + showFrags False _ (CHSCPP s _ : frags) = + showChar '#' + . showString s +-- . showChar '\n' + . showFrags False Emit frags + showFrags pureHs _ (CHSLine s : frags) = + showFrags pureHs Emit frags + showFrags False _ (CHSC s _ : frags) = + showString "\n#c" + . showString s + . showString "\n#endc" + . showFrags False Emit frags + showFrags False _ (CHSCond _ _ : frags) = + interr "showCHSFrag: Cannot print `CHSCond'!" + showFrags True _ _ = + interr "showCHSFrag: Illegal hook, cpp directive, or inline C code!" + +showCHSHook :: CHSHook -> ShowS +showCHSHook (CHSImport isQual ide _ _) = + showString "import " + . (if isQual then showString "qualified " else id) + . showCHSIdent ide +showCHSHook (CHSContext olib oprefix _) = + showString "context " + . (case olib of + Nothing -> showString "" + Just lib -> showString "lib = " . showString lib . showString " ") + . showPrefix oprefix False +showCHSHook (CHSType ide _) = + showString "type " + . showCHSIdent ide +showCHSHook (CHSSizeof ide _) = + showString "sizeof " + . showCHSIdent ide +showCHSHook (CHSEnum ide oalias trans oprefix derive _) = + showString "enum " + . showIdAlias ide oalias + . showCHSTrans trans + . showPrefix oprefix True + . if null derive then id else showString $ + "deriving (" + ++ concat (intersperse ", " (map identToLexeme derive)) + ++ ") " +showCHSHook (CHSCall isPure isUns ide oalias _) = + showString "call " + . (if isPure then showString "pure " else id) + . (if isUns then showString "unsafe " else id) + . showApAlias ide oalias +showCHSHook (CHSFun isPure isUns ide oalias octxt parms parm _) = + showString "fun " + . (if isPure then showString "pure " else id) + . (if isUns then showString "unsafe " else id) + . showApAlias ide oalias + . (case octxt of + Nothing -> showChar ' ' + Just ctxtStr -> showString ctxtStr . showString " => ") + . showString "{" + . foldr (.) id (intersperse (showString ", ") (map showCHSParm parms)) + . showString "} -> " + . showCHSParm parm +showCHSHook (CHSField acc path _) = + (case acc of + CHSGet -> showString "get " + CHSSet -> showString "set ") + . showCHSAPath path +showCHSHook (CHSPointer star ide oalias ptrType isNewtype oRefType emit _) = + showString "pointer " + . (if star then showString "*" else showString "") + . showIdAlias ide oalias + . (case ptrType of + CHSForeignPtr -> showString " foreign" + CHSStablePtr -> showString " stable" + _ -> showString "") + . (case (isNewtype, oRefType) of + (True , _ ) -> showString " newtype" + (False, Just ide) -> showString " -> " . showCHSIdent ide + (False, Nothing ) -> showString "") + . (case emit of + True -> showString "" + False -> showString " nocode") +showCHSHook (CHSClass oclassIde classIde typeIde _) = + showString "class " + . (case oclassIde of + Nothing -> showString "" + Just classIde -> showCHSIdent classIde . showString " => ") + . showCHSIdent classIde + . showString " " + . showCHSIdent typeIde + +showPrefix :: Maybe String -> Bool -> ShowS +showPrefix Nothing _ = showString "" +showPrefix (Just prefix) withWith = maybeWith + . showString "prefix = " + . showString prefix + . showString " " + where + maybeWith = if withWith then showString "with " else id + +showIdAlias :: Ident -> Maybe Ident -> ShowS +showIdAlias ide oalias = + showCHSIdent ide + . (case oalias of + Nothing -> id + Just ide -> showString " as " . showCHSIdent ide) + +showApAlias :: CHSAPath -> Maybe Ident -> ShowS +showApAlias apath oalias = + showCHSAPath apath + . (case oalias of + Nothing -> id + Just ide -> showString " as " . showCHSIdent ide) + +showCHSParm :: CHSParm -> ShowS +showCHSParm (CHSParm oimMarsh hsTyStr twoCVals oomMarsh _) = + showOMarsh oimMarsh + . showChar ' ' + . showHsVerb hsTyStr + . (if twoCVals then showChar '&' else id) + . showChar ' ' + . showOMarsh oomMarsh + where + showOMarsh Nothing = id + showOMarsh (Just (ide, argKind)) = showCHSIdent ide + . (case argKind of + CHSValArg -> id + CHSIOArg -> showString "*" + CHSVoidArg -> showString "-" + CHSIOVoidArg -> showString "*-") + -- + showHsVerb str = showChar '`' . showString str . showChar '\'' + +showCHSTrans :: CHSTrans -> ShowS +showCHSTrans (CHSTrans _2Case chgCase assocs) = + showString "{" + . (if _2Case then showString ("underscoreToCase" ++ maybeComma) else id) + . showCHSChangeCase chgCase + . foldr (.) id (intersperse (showString ", ") (map showAssoc assocs)) + . showString "}" + where + maybeComma = if null assocs then "" else ", " + -- + showAssoc (ide1, ide2) = + showCHSIdent ide1 + . showString " as " + . showCHSIdent ide2 + +showCHSChangeCase :: CHSChangeCase -> ShowS +showCHSChangeCase CHSSameCase = id +showCHSChangeCase CHSUpCase = showString "upcaseFirstLetter" +showCHSChangeCase CHSDownCase = showString "downcaseFirstLetter" + +showCHSAPath :: CHSAPath -> ShowS +showCHSAPath (CHSRoot ide) = + showCHSIdent ide +showCHSAPath (CHSDeref path _) = + showString "* " + . showCHSAPath path +showCHSAPath (CHSRef (CHSDeref path _) ide) = + showCHSAPath path + . showString "->" + . showCHSIdent ide +showCHSAPath (CHSRef path ide) = + showCHSAPath path + . showString "." + . showCHSIdent ide + +showCHSIdent :: Ident -> ShowS +showCHSIdent = showString . identToLexeme + + +-- load and dump a CHI file +-- ------------------------ + +chisuffix :: String +chisuffix = "chi" + +versionPrefix :: String +versionPrefix = "C->Haskell Interface Version " + +-- load a CHI file (EXPORTED) +-- +-- * the file suffix is automagically appended +-- +-- * any error raises a syntax exception (see below) +-- +-- * the version of the .chi file is checked against the version of the current +-- executable; they must match in the major and minor version +-- +loadCHI :: FilePath -> CST s String +loadCHI fname = do + -- search for .chi files + -- + paths <- getSwitch chiPathSB + let fullnames = [path fname <.> chisuffix | + path <- paths] + fullname <- findFirst fullnames + (fatal $ fname <.> chisuffix ++ " not found in:\n"++ + unlines paths) + -- read file + -- + traceInfoRead fullname + contents <- readFileCIO fullname + + -- parse + -- + traceInfoVersion + let ls = lines contents + when (null ls) $ + errorCHICorrupt fname + let versline:chi = ls + prefixLen = length versionPrefix + when (length versline < prefixLen + || take prefixLen versline /= versionPrefix) $ + errorCHICorrupt fname + let versline' = drop prefixLen versline + (major, minor) <- case majorMinor versline' of + Nothing -> errorCHICorrupt fname + Just majMin -> return majMin + + let Just (myMajor, myMinor) = majorMinor version + when (major /= myMajor || minor /= myMinor) $ + errorCHIVersion fname + (major ++ "." ++ minor) (myMajor ++ "." ++ myMinor) + + -- finalize + -- + traceInfoOK + return $ concat chi + where + traceInfoRead fname = putTraceStr tracePhasesSW + ("Attempting to read file `" + ++ fname ++ "'...\n") + traceInfoVersion = putTraceStr tracePhasesSW + ("...checking version `" + ++ fname ++ "'...\n") + traceInfoOK = putTraceStr tracePhasesSW + ("...successfully loaded `" + ++ fname ++ "'.\n") + findFirst [] err = err + findFirst (p:aths) err = do + e <- doesFileExistCIO p + if e then return p else findFirst aths err + + +-- given a file name (no suffix) and a CHI file, the information is printed +-- into that file (EXPORTED) +-- +-- * the correct suffix will automagically be appended +-- +dumpCHI :: String -> String -> CST s () +dumpCHI fname contents = + do + writeFileCIO (fname <.> chisuffix) $ + versionPrefix ++ version ++ "\n" ++ contents + +-- extract major and minor number from a version string +-- +majorMinor :: String -> Maybe (String, String) +majorMinor vers = let (major, rest) = break (== '.') vers + (minor, _ ) = break (== '.') . tail $ rest + in + if null rest then Nothing else Just (major, minor) + + +-- parsing a CHS token stream +-- -------------------------- + +syntaxExc :: String +syntaxExc = "syntax" + +-- alternative action in case of a syntax exception +-- +ifError :: CST s a -> CST s a -> CST s a +ifError action handler = action `catchExc` (syntaxExc, const handler) + +-- raise syntax error exception +-- +raiseSyntaxError :: CST s a +raiseSyntaxError = throwExc syntaxExc "syntax error" + +-- parse a complete module +-- +-- * errors are entered into the compiler state +-- +parseCHSModule :: Position -> String -> CST s CHSModule +parseCHSModule pos cs = do + toks <- lexCHS cs pos + frags <- parseFrags toks + return (CHSModule frags) + +-- parsing of code fragments +-- +-- * in case of an error, all tokens that are neither Haskell nor control +-- tokens are skipped; afterwards parsing continues +-- +-- * when encountering inline-C code we scan forward over all inline-C and +-- control tokens to avoid turning the control tokens within a sequence of +-- inline-C into Haskell fragments +-- +parseFrags :: [CHSToken] -> CST s [CHSFrag] +parseFrags toks = do + parseFrags0 toks + `ifError` contFrags toks + where + parseFrags0 :: [CHSToken] -> CST s [CHSFrag] + parseFrags0 [] = return [] + parseFrags0 (CHSTokHaskell pos s:toks) = do + frags <- parseFrags toks + return $ CHSVerb s pos : frags + parseFrags0 (CHSTokCtrl pos c:toks) = do + frags <- parseFrags toks + return $ CHSVerb [c] pos : frags + parseFrags0 (CHSTokCPP pos s:toks) = do + frags <- parseFrags toks + return $ CHSCPP s pos : frags + parseFrags0 (CHSTokLine pos :toks) = do + frags <- parseFrags toks + return $ CHSLine pos : frags + parseFrags0 (CHSTokC pos s:toks) = parseC pos s toks + parseFrags0 (CHSTokImport pos :toks) = parseImport pos toks + parseFrags0 (CHSTokContext pos :toks) = parseContext pos toks + parseFrags0 (CHSTokType pos :toks) = parseType pos toks + parseFrags0 (CHSTokSizeof pos :toks) = parseSizeof pos toks + parseFrags0 (CHSTokEnum pos :toks) = parseEnum pos toks + parseFrags0 (CHSTokCall pos :toks) = parseCall pos toks + parseFrags0 (CHSTokFun pos :toks) = parseFun pos toks + parseFrags0 (CHSTokGet pos :toks) = parseField pos CHSGet toks + parseFrags0 (CHSTokSet pos :toks) = parseField pos CHSSet toks + parseFrags0 (CHSTokClass pos :toks) = parseClass pos toks + parseFrags0 (CHSTokPointer pos :toks) = parsePointer pos toks + parseFrags0 toks = syntaxError toks + -- + -- skip to next Haskell or control token + -- + contFrags [] = return [] + contFrags toks@(CHSTokHaskell _ _:_ ) = parseFrags toks + contFrags toks@(CHSTokCtrl _ _:_ ) = parseFrags toks + contFrags (_ :toks) = contFrags toks + +parseC :: Position -> String -> [CHSToken] -> CST s [CHSFrag] +parseC pos s toks = + do + frags <- collectCtrlAndC toks + return $ CHSC s pos : frags + where + collectCtrlAndC (CHSTokCtrl pos c:toks) = do + frags <- collectCtrlAndC toks + return $ CHSC [c] pos : frags + collectCtrlAndC (CHSTokC pos s:toks) = do + frags <- collectCtrlAndC toks + return $ CHSC s pos : frags + collectCtrlAndC toks = parseFrags toks + +parseImport :: Position -> [CHSToken] -> CST s [CHSFrag] +parseImport pos toks = do + (qual, modid, toks') <- + case toks of + CHSTokIdent _ ide :toks -> + let (ide', toks') = rebuildModuleId ide toks + in return (False, ide', toks') + CHSTokQualif _: CHSTokIdent _ ide:toks -> + let (ide', toks') = rebuildModuleId ide toks + in return (True , ide', toks') + _ -> syntaxError toks + chi <- loadCHI . moduleNameToFileName . identToLexeme $ modid + toks'' <- parseEndHook toks' + frags <- parseFrags toks'' + return $ CHSHook (CHSImport qual modid chi pos) : frags + +-- Qualified module names do not get lexed as a single token so we need to +-- reconstruct it from a sequence of identifer and dot tokens. +-- +rebuildModuleId ide (CHSTokDot _ : CHSTokIdent _ ide' : toks) = + let catIdent ide ide' = onlyPosIdent (posOf ide) --FIXME: unpleasent hack + (identToLexeme ide ++ '.' : identToLexeme ide') + in rebuildModuleId (catIdent ide ide') toks +rebuildModuleId ide toks = (ide, toks) + +moduleNameToFileName :: String -> FilePath +moduleNameToFileName = map dotToSlash + where dotToSlash '.' = '/' + dotToSlash c = c + +parseContext :: Position -> [CHSToken] -> CST s [CHSFrag] +parseContext pos toks = do + (olib , toks'' ) <- parseOptLib toks + (opref , toks''') <- parseOptPrefix False toks'' + toks'''' <- parseEndHook toks''' + frags <- parseFrags toks'''' + let frag = CHSContext olib opref pos + return $ CHSHook frag : frags + +parseType :: Position -> [CHSToken] -> CST s [CHSFrag] +parseType pos (CHSTokIdent _ ide:toks) = + do + toks' <- parseEndHook toks + frags <- parseFrags toks' + return $ CHSHook (CHSType ide pos) : frags +parseType _ toks = syntaxError toks + +parseSizeof :: Position -> [CHSToken] -> CST s [CHSFrag] +parseSizeof pos (CHSTokIdent _ ide:toks) = + do + toks' <- parseEndHook toks + frags <- parseFrags toks' + return $ CHSHook (CHSSizeof ide pos) : frags +parseSizeof _ toks = syntaxError toks + +parseEnum :: Position -> [CHSToken] -> CST s [CHSFrag] +parseEnum pos (CHSTokIdent _ ide:toks) = + do + (oalias, toks' ) <- parseOptAs ide True toks + (trans , toks'') <- parseTrans toks' + (oprefix, toks''') <- parseOptPrefix True toks'' + (derive, toks'''') <- parseDerive toks''' + toks''''' <- parseEndHook toks'''' + frags <- parseFrags toks''''' + return $ CHSHook (CHSEnum ide (norm oalias) trans oprefix derive pos) : frags + where + norm Nothing = Nothing + norm (Just ide') | ide == ide' = Nothing + | otherwise = Just ide' +parseEnum _ toks = syntaxError toks + +parseCall :: Position -> [CHSToken] -> CST s [CHSFrag] +parseCall pos toks = + do + (isPure , toks' ) <- parseIsPure toks + (isUnsafe, toks'' ) <- parseIsUnsafe toks' + (apath , toks''' ) <- parsePath toks'' + (oalias , toks'''') <- parseOptAs (apathToIdent apath) False toks''' + toks''''' <- parseEndHook toks'''' + frags <- parseFrags toks''''' + return $ + CHSHook (CHSCall isPure isUnsafe apath (normAP apath oalias) pos) : frags + +parseFun :: Position -> [CHSToken] -> CST s [CHSFrag] +parseFun pos toks = + do + (isPure , toks' ) <- parseIsPure toks + (isUnsafe, toks'2) <- parseIsUnsafe toks' + (apath , toks'3) <- parsePath toks'2 + (oalias , toks'4) <- parseOptAs (apathToIdent apath) False toks'3 + (octxt , toks'5) <- parseOptContext toks'4 + (parms , toks'6) <- parseParms toks'5 + (parm , toks'7) <- parseParm toks'6 + toks'8 <- parseEndHook toks'7 + frags <- parseFrags toks'8 + return $ + CHSHook + (CHSFun isPure isUnsafe apath (normAP apath oalias) octxt parms parm pos) : + frags + where + parseOptContext (CHSTokHSVerb _ ctxt:CHSTokDArrow _:toks) = + return (Just ctxt, toks) + parseOptContext toks = + return (Nothing , toks) + -- + parseParms (CHSTokLBrace _:CHSTokRBrace _:CHSTokArrow _:toks) = + return ([], toks) + parseParms (CHSTokLBrace _ :toks) = + parseParms' (CHSTokComma nopos:toks) + parseParms toks = + syntaxError toks + -- + parseParms' (CHSTokRBrace _:CHSTokArrow _:toks) = return ([], toks) + parseParms' (CHSTokComma _ :toks) = do + (parm , toks' ) <- parseParm toks + (parms, toks'') <- parseParms' toks' + return (parm:parms, toks'') + parseParms' (CHSTokRBrace _ :toks) = syntaxError toks + -- gives better error messages + parseParms' toks = syntaxError toks + +parseIsPure :: [CHSToken] -> CST s (Bool, [CHSToken]) +parseIsPure (CHSTokPure _:toks) = return (True , toks) +parseIsPure (CHSTokFun _:toks) = return (True , toks) -- backwards compat. +parseIsPure toks = return (False, toks) +-- FIXME: eventually, remove `fun'; it's currently deprecated + +parseIsUnsafe :: [CHSToken] -> CST s (Bool, [CHSToken]) +parseIsUnsafe (CHSTokUnsafe _:toks) = return (True , toks) +parseIsUnsafe toks = return (False, toks) + +normAP :: CHSAPath -> Maybe Ident -> Maybe Ident +normAP ide Nothing = Nothing +normAP ide (Just ide') | apathToIdent ide == ide' = Nothing + | otherwise = Just ide' + + +apathToIdent :: CHSAPath -> Ident +apathToIdent (CHSRoot ide) = + let lowerFirst (c:cs) = toLower c : cs + in onlyPosIdent (posOf ide) (lowerFirst $ identToLexeme ide) +apathToIdent (CHSDeref apath _) = + let ide = apathToIdent apath + in onlyPosIdent (posOf ide) (identToLexeme ide ++ "_") +apathToIdent (CHSRef apath ide') = + let ide = apathToIdent apath + upperFirst (c:cs) = toLower c : cs + sel = upperFirst $ identToLexeme ide' + in onlyPosIdent (posOf ide) (identToLexeme ide ++ sel) + +norm :: Ident -> Maybe Ident -> Maybe Ident +norm ide Nothing = Nothing +norm ide (Just ide') | ide == ide' = Nothing + | otherwise = Just ide' + +parseParm :: [CHSToken] -> CST s (CHSParm, [CHSToken]) +parseParm toks = + do + (oimMarsh, toks' ) <- parseOptMarsh toks + (hsTyStr, twoCVals, pos, toks'2) <- + case toks' of + (CHSTokHSVerb pos hsTyStr:CHSTokAmp _:toks'2) -> + return (hsTyStr, True , pos, toks'2) + (CHSTokHSVerb pos hsTyStr :toks'2) -> + return (hsTyStr, False, pos, toks'2) + toks -> syntaxError toks + (oomMarsh, toks'3) <- parseOptMarsh toks'2 + return (CHSParm oimMarsh hsTyStr twoCVals oomMarsh pos, toks'3) + where + parseOptMarsh :: [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken]) + parseOptMarsh (CHSTokIdent _ ide:CHSTokStar _ :CHSTokMinus _:toks) = + return (Just (ide, CHSIOVoidArg) , toks) + parseOptMarsh (CHSTokIdent _ ide:CHSTokStar _ :toks) = + return (Just (ide, CHSIOArg) , toks) + parseOptMarsh (CHSTokIdent _ ide:CHSTokMinus _:toks) = + return (Just (ide, CHSVoidArg), toks) + parseOptMarsh (CHSTokIdent _ ide :toks) = + return (Just (ide, CHSValArg) , toks) + parseOptMarsh toks = + return (Nothing, toks) + +parseField :: Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag] +parseField pos access toks = + do + (path, toks') <- parsePath toks + toks'' <- parseEndHook toks' + frags <- parseFrags toks'' + return $ CHSHook (CHSField access path pos) : frags + +parsePointer :: Position -> [CHSToken] -> CST s [CHSFrag] +parsePointer pos toks = + do + (isStar, ide, toks') <- + case toks of + CHSTokStar _:CHSTokIdent _ ide:toks' -> return (True , ide, toks') + CHSTokIdent _ ide :toks' -> return (False, ide, toks') + _ -> syntaxError toks + (oalias , toks'2) <- parseOptAs ide True toks' + (ptrType, toks'3) <- parsePtrType toks'2 + let + (isNewtype, oRefType, toks'4) = + case toks'3 of + CHSTokNewtype _ :toks' -> (True , Nothing , toks' ) + CHSTokArrow _:CHSTokIdent _ ide:toks' -> (False, Just ide, toks' ) + _ -> (False, Nothing , toks'3) + let + (emit, toks'5) = + case toks'4 of + CHSTokNocode _ :toks' -> (False, toks' ) + _ -> (True , toks'4 ) + toks'6 <- parseEndHook toks'5 + frags <- parseFrags toks'6 + return $ + CHSHook + (CHSPointer + isStar ide (norm ide oalias) ptrType isNewtype oRefType emit pos) + : frags + where + parsePtrType :: [CHSToken] -> CST s (CHSPtrType, [CHSToken]) + parsePtrType (CHSTokForeign _:toks) = return (CHSForeignPtr, toks) + parsePtrType (CHSTokStable _ :toks) = return (CHSStablePtr, toks) + parsePtrType toks = return (CHSPtr, toks) + + norm ide Nothing = Nothing + norm ide (Just ide') | ide == ide' = Nothing + | otherwise = Just ide' + +parseClass :: Position -> [CHSToken] -> CST s [CHSFrag] +parseClass pos (CHSTokIdent _ sclassIde: + CHSTokDArrow _ : + CHSTokIdent _ classIde : + CHSTokIdent _ typeIde : + toks) = + do + toks' <- parseEndHook toks + frags <- parseFrags toks' + return $ CHSHook (CHSClass (Just sclassIde) classIde typeIde pos) : frags +parseClass pos (CHSTokIdent _ classIde : + CHSTokIdent _ typeIde : + toks) = + do + toks' <- parseEndHook toks + frags <- parseFrags toks' + return $ CHSHook (CHSClass Nothing classIde typeIde pos) : frags +parseClass _ toks = syntaxError toks + +parseOptLib :: [CHSToken] -> CST s (Maybe String, [CHSToken]) +parseOptLib (CHSTokLib _ : + CHSTokEqual _ : + CHSTokString _ str: + toks) = return (Just str, toks) +parseOptLib (CHSTokLib _:toks ) = syntaxError toks +parseOptLib toks = return (Nothing, toks) + +parseOptPrefix :: Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken]) +parseOptPrefix False (CHSTokPrefix _ : + CHSTokEqual _ : + CHSTokString _ str: + toks) = return (Just str, toks) +parseOptPrefix True (CHSTokWith _ : + CHSTokPrefix _ : + CHSTokEqual _ : + CHSTokString _ str: + toks) = return (Just str, toks) +parseOptPrefix _ (CHSTokWith _:toks) = syntaxError toks +parseOptPrefix _ (CHSTokPrefix _:toks) = syntaxError toks +parseOptPrefix _ toks = return (Nothing, toks) + +-- first argument is the identifier that is to be used when `^' is given and +-- the second indicates whether the first character has to be upper case +-- +parseOptAs :: Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken]) +parseOptAs _ _ (CHSTokAs _:CHSTokIdent _ ide:toks) = + return (Just ide, toks) +parseOptAs ide upper (CHSTokAs _:CHSTokHat pos :toks) = + return (Just $ underscoreToCase ide upper pos, toks) +parseOptAs _ _ (CHSTokAs _ :toks) = syntaxError toks +parseOptAs _ _ toks = + return (Nothing, toks) + +-- convert C style identifier to Haskell style identifier +-- +underscoreToCase :: Ident -> Bool -> Position -> Ident +underscoreToCase ide upper pos = + let lexeme = identToLexeme ide + ps = filter (not . null) . parts $ lexeme + in + onlyPosIdent pos . adjustHead . concat . map adjustCase $ ps + where + parts s = let (l, s') = break (== '_') s + in + l : case s' of + [] -> [] + (_:s'') -> parts s'' + -- + adjustCase (c:cs) = toUpper c : map toLower cs + -- + adjustHead "" = "" + adjustHead (c:cs) = if upper then toUpper c : cs else toLower c:cs + +-- this is disambiguated and left factored +-- +parsePath :: [CHSToken] -> CST s (CHSAPath, [CHSToken]) +parsePath (CHSTokStar pos:toks) = + do + (path, toks') <- parsePath toks + return (CHSDeref path pos, toks') +parsePath (CHSTokIdent _ ide:toks) = + do + (pathWithHole, toks') <- parsePath' toks + return (pathWithHole (CHSRoot ide), toks') +parsePath toks = syntaxError toks + +-- `s->m' is represented by `(*s).m' in the tree +-- +parsePath' :: [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken]) +parsePath' (CHSTokDot _:CHSTokIdent _ ide:toks) = + do + (pathWithHole, toks') <- parsePath' toks + return (pathWithHole . (\hole -> CHSRef hole ide), toks') +parsePath' (CHSTokDot _:toks) = + syntaxError toks +parsePath' (CHSTokArrow pos:CHSTokIdent _ ide:toks) = + do + (pathWithHole, toks') <- parsePath' toks + return (pathWithHole . (\hole -> CHSRef (CHSDeref hole pos) ide), toks') +parsePath' (CHSTokArrow _:toks) = + syntaxError toks +parsePath' toks = + return (id,toks) + +parseTrans :: [CHSToken] -> CST s (CHSTrans, [CHSToken]) +parseTrans (CHSTokLBrace _:toks) = + do + (_2Case, chgCase, toks' ) <- parse_2CaseAndChange toks + case toks' of + (CHSTokRBrace _:toks'') -> return (CHSTrans _2Case chgCase [], toks'') + _ -> + do + -- if there was no `underscoreToCase', we add a comma token to meet + -- the invariant of `parseTranss' + -- + (transs, toks'') <- if (_2Case || chgCase /= CHSSameCase) + then parseTranss toks' + else parseTranss (CHSTokComma nopos:toks') + return (CHSTrans _2Case chgCase transs, toks'') + where + parse_2CaseAndChange (CHSTok_2Case _:CHSTokComma _:CHSTokUpper _:toks) = + return (True, CHSUpCase, toks) + parse_2CaseAndChange (CHSTok_2Case _:CHSTokComma _:CHSTokDown _ :toks) = + return (True, CHSDownCase, toks) + parse_2CaseAndChange (CHSTok_2Case _ :toks) = + return (True, CHSSameCase, toks) + parse_2CaseAndChange (CHSTokUpper _:CHSTokComma _:CHSTok_2Case _:toks) = + return (True, CHSUpCase, toks) + parse_2CaseAndChange (CHSTokUpper _ :toks) = + return (False, CHSUpCase, toks) + parse_2CaseAndChange (CHSTokDown _:CHSTokComma _:CHSTok_2Case _:toks) = + return (True, CHSDownCase, toks) + parse_2CaseAndChange (CHSTokDown _ :toks) = + return (False, CHSDownCase, toks) + parse_2CaseAndChange toks = + return (False, CHSSameCase, toks) + -- + parseTranss (CHSTokRBrace _:toks) = return ([], toks) + parseTranss (CHSTokComma _:toks) = do + (assoc, toks' ) <- parseAssoc toks + (trans, toks'') <- parseTranss toks' + return (assoc:trans, toks'') + parseTranss toks = syntaxError toks + -- + parseAssoc (CHSTokIdent _ ide1:CHSTokAs _:CHSTokIdent _ ide2:toks) = + return ((ide1, ide2), toks) + parseAssoc (CHSTokIdent _ ide1:CHSTokAs _:toks ) = + syntaxError toks + parseAssoc (CHSTokIdent _ ide1:toks ) = + syntaxError toks + parseAssoc toks = + syntaxError toks +parseTrans toks = syntaxError toks + +parseDerive :: [CHSToken] -> CST s ([Ident], [CHSToken]) +parseDerive (CHSTokDerive _ :CHSTokLParen _:CHSTokRParen _:toks) = + return ([], toks) +parseDerive (CHSTokDerive _ :CHSTokLParen _:toks) = + parseCommaIdent (CHSTokComma nopos:toks) + where + parseCommaIdent :: [CHSToken] -> CST s ([Ident], [CHSToken]) + parseCommaIdent (CHSTokComma _:CHSTokIdent _ ide:toks) = + do + (ids, tok') <- parseCommaIdent toks + return (ide:ids, tok') + parseCommaIdent (CHSTokRParen _ :toks) = + return ([], toks) +parseDerive toks = return ([],toks) + +parseIdent :: [CHSToken] -> CST s (Ident, [CHSToken]) +parseIdent (CHSTokIdent _ ide:toks) = return (ide, toks) +parseIdent toks = syntaxError toks + +parseEndHook :: [CHSToken] -> CST s ([CHSToken]) +parseEndHook (CHSTokEndHook _:toks) = return toks +parseEndHook toks = syntaxError toks + +syntaxError :: [CHSToken] -> CST s a +syntaxError [] = errorEOF +syntaxError (tok:_) = errorIllegal tok + +errorIllegal :: CHSToken -> CST s a +errorIllegal tok = do + raiseError (posOf tok) + ["Syntax error!", + "The phrase `" ++ show tok ++ "' is not allowed \ + \here."] + raiseSyntaxError + +errorEOF :: CST s a +errorEOF = do + raiseError nopos + ["Premature end of file!", + "The .chs file ends in the middle of a binding hook."] + raiseSyntaxError + +errorCHINotFound :: String -> CST s a +errorCHINotFound ide = do + raiseError nopos + ["Unknown .chi file!", + "Cannot find the .chi file for `" ++ ide ++ "'."] + raiseSyntaxError + +errorCHICorrupt :: String -> CST s a +errorCHICorrupt ide = do + raiseError nopos + ["Corrupt .chi file!", + "The file `" ++ ide ++ ".chi' is corrupt."] + raiseSyntaxError + +errorCHIVersion :: String -> String -> String -> CST s a +errorCHIVersion ide chiVersion myVersion = do + raiseError nopos + ["Wrong version of .chi file!", + "The file `" ++ ide ++ ".chi' is version " + ++ chiVersion ++ ", but mine is " ++ myVersion ++ "."] + raiseSyntaxError diff --git a/c2hs/chs/CHSLexer.hs b/c2hs/chs/CHSLexer.hs new file mode 100644 --- /dev/null +++ b/c2hs/chs/CHSLexer.hs @@ -0,0 +1,779 @@ +-- C->Haskell Compiler: Lexer for CHS Files +-- +-- Author : Manuel M T Chakravarty +-- Created: 13 August 99 +-- +-- Copyright (c) [1999..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Lexer for CHS files; the tokens are only partially recognised. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- * CHS files are assumed to be Haskell 98 files that include C2HS binding +-- hooks. +-- +-- * Haskell code is not tokenised, but binding hooks (delimited by `{#'and +-- `#}') are analysed. Therefore the lexer operates in two states +-- (realised as two lexer coupled by meta actions) depending on whether +-- Haskell code or a binding hook is currently read. The lexer reading +-- Haskell code is called `base lexer'; the other one, `binding-hook +-- lexer'. In addition, there is a inline-c lexer, which, as the +-- binding-hook lexer, can be triggered from the base lexer. +-- +-- * Base lexer: +-- +-- haskell -> (inline \\ special)* +-- | special \\ `"' +-- | comment +-- | nested +-- | hstring +-- | '{#' +-- | cpp +-- special -> `(' | `{' | `-' | `"' +-- ctrl -> `\n' | `\f' | `\r' | `\t' | `\v' +-- +-- inline -> any \\ ctrl +-- any -> '\0'..'\255' +-- +-- Within the base lexer control codes appear as separate tokens in the +-- token list. +-- +-- NOTE: It is important that `{' is an extra lexeme and not added as an +-- optional component at the end of the first alternative for +-- `haskell'. Otherwise, the principle of the longest match will +-- divide `foo {#' into the tokens `foo {' and `#' instead of `foo ' +-- and `{#'. +-- +-- One line comments are handled by +-- +-- comment -> `--' (any \\ `\n')* `\n' +-- +-- and nested comments by +-- +-- nested -> `{-' any* `-}' +-- +-- where `any*' may contain _balanced_ occurrences of `{-' and `-}'. +-- +-- hstring -> `"' inhstr* `"' +-- inhstr -> ` '..`\127' \\ `"' +-- | `\"' +-- +-- Pre-precessor directives as well as the switch to inline-C code are +-- formed as follows: +-- +-- cpp -> `\n#' (inline | `\t')* `\n' +-- | `\n#c' (' ' | '\t')* `\n' +-- +-- We allow whitespace between the `#' and the actual directive, but in `#c' +-- and `#endc' the directive must immediately follow the `#'. This might +-- be regarded as a not entirely orthogonal design, but simplifies matters +-- especially for `#endc'. +-- +-- * On encountering the lexeme `{#', a meta action in the base lexer +-- transfers control to the following binding-hook lexer: +-- +-- ident -> letter (letter | digit | `\'')* +-- | `\'' letter (letter | digit)* `\'' +-- reservedid -> `as' | `call' | `class' | `context' | `deriving' +-- | `enum' | `foreign' | `fun' | `get' | `lib' +-- | `downcaseFirstLetter' +-- | `newtype' | `nocode' | `pointer' | `prefix' | `pure' +-- | `set' | `sizeof' | `stable' | `type' +-- | `underscoreToCase' | `upcaseFirstLetter' | `unsafe' | +-- | `with' +-- reservedsym -> `{#' | `#}' | `{' | `}' | `,' | `.' | `->' | `=' +-- | `=>' | '-' | `*' | `&' | `^' +-- string -> `"' instr* `"' +-- verbhs -> `\`' instr* `\'' +-- instr -> ` '..`\127' \\ `"' +-- comment -> `--' (any \\ `\n')* `\n' +-- +-- Control characters, white space, and comments are discarded in the +-- binding-hook lexer. Nested comments are not allowed in a binding hook. +-- Identifiers can be enclosed in single quotes to avoid collision with +-- C->Haskell keywords. +-- +-- * In the binding-hook lexer, the lexeme `#}' transfers control back to the +-- base lexer. An occurence of the lexeme `{#' inside the binding-hook +-- lexer triggers an error. The symbol `{#' is not explcitly represented +-- in the resulting token stream. However, the occurrence of a token +-- representing one of the reserved identifiers `call', `context', `enum', +-- and `field' marks the start of a binding hook. Strictly speaking, `#}' +-- need also not occur in the token stream, as the next `haskell' token +-- marks a hook's end. It is, however, useful for producing accurate error +-- messages (in case an hook is closed to early) to have a token +-- representing `#}'. +-- +-- * The rule `ident' describes Haskell identifiers, but without +-- distinguishing between variable and constructor identifers (ie, those +-- starting with a lowercase and those starting with an uppercase letter). +-- However, we use it also to scan C identifiers; although, strictly +-- speaking, it is too general for them. In the case of C identifiers, +-- this should not have any impact on the range of descriptions accepted by +-- the tool, as illegal identifier will never occur in a C header file that +-- is accepted by the C lexer. In the case of Haskell identifiers, a +-- confusion between variable and constructor identifiers will be noted by +-- the Haskell compiler translating the code generated by c2hs. Moreover, +-- identifiers can be enclosed in single quotes to avoid collision with +-- C->Haskell keywords, but those may not contain apostrophes. +-- +-- * Any line starting with the character `#' is regarded to be a C +-- preprocessor directive. With the exception of `#c' and `#endc', which +-- delimit a set of lines containing inline C code. Hence, in the base +-- lexer, the lexeme `#c' triggers a meta action transferring control to the +-- following inline-C lexer: +-- +-- c -> inline* \\ `\n#endc' +-- +-- We do neither treat C strings nor C comments specially. Hence, if the +-- string "\n#endc" occurs in a comment, we will mistakenly regard it as +-- the end of the inline C code. Note that the problem cannot happen with +-- strings, as C does not permit strings that extend over multiple lines. +-- At the moment, it just seems not to be worth the effort required to +-- treat this situation more accurately. +-- +-- The inline-C lexer also doesn't handle pre-processor directives +-- specially. Hence, structural pre-processor directives (namely, +-- conditionals) may occur within inline-C code only properly nested. +-- +-- Shortcomings +-- ~~~~~~~~~~~~ +-- Some lexemes that include single and double quote characters are not lexed +-- correctly. See the implementation comment at `haskell' for details. +-- +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * In `haskell', the case of a single `"' (without a matching second one) +-- is caught by an eplicit error raising rule. This shouldn't be +-- necessary, but for some strange reason, the lexer otherwise hangs when a +-- single `"' appears in the input. +-- +-- * Comments in the "gap" of a string are not yet supported. +-- + +module CHSLexer (CHSToken(..), lexCHS) +where + +import Data.List ((\\)) +import Data.Char (isDigit) +import Control.Monad (liftM) + +import Position (Position(..), Pos(posOf), incPos, retPos, tabPos) +import Errors (ErrorLvl(..), makeError) +import UNames (Name, names) +import Idents (Ident, lexemeToIdent, identToLexeme) +import Lexers (Regexp, Lexer, Action, epsilon, char, (+>), lexaction, + lexactionErr, lexmeta, (>|<), (>||<), ctrlLexer, star, plus, + alt, string, execLexer) + +import C2HSState (CST, raise, raiseError, getNameSupply) + + +-- token definition +-- ---------------- + +-- possible tokens (EXPORTED) +-- +data CHSToken = CHSTokArrow Position -- `->' + | CHSTokDArrow Position -- `=>' + | CHSTokDot Position -- `.' + | CHSTokComma Position -- `,' + | CHSTokEqual Position -- `=' + | CHSTokMinus Position -- `-' + | CHSTokStar Position -- `*' + | CHSTokAmp Position -- `&' + | CHSTokHat Position -- `^' + | CHSTokLBrace Position -- `{' + | CHSTokRBrace Position -- `}' + | CHSTokLParen Position -- `(' + | CHSTokRParen Position -- `)' + | CHSTokEndHook Position -- `#}' + | CHSTokAs Position -- `as' + | CHSTokCall Position -- `call' + | CHSTokClass Position -- `class' + | CHSTokContext Position -- `context' + | CHSTokDerive Position -- `deriving' + | CHSTokDown Position -- `downcaseFirstLetter' + | CHSTokEnum Position -- `enum' + | CHSTokForeign Position -- `foreign' + | CHSTokFun Position -- `fun' + | CHSTokGet Position -- `get' + | CHSTokImport Position -- `import' + | CHSTokLib Position -- `lib' + | CHSTokNewtype Position -- `newtype' + | CHSTokNocode Position -- `nocode' + | CHSTokPointer Position -- `pointer' + | CHSTokPrefix Position -- `prefix' + | CHSTokPure Position -- `pure' + | CHSTokQualif Position -- `qualified' + | CHSTokSet Position -- `set' + | CHSTokSizeof Position -- `sizeof' + | CHSTokStable Position -- `stable' + | CHSTokType Position -- `type' + | CHSTok_2Case Position -- `underscoreToCase' + | CHSTokUnsafe Position -- `unsafe' + | CHSTokUpper Position -- `upcaseFirstLetter' + | CHSTokWith Position -- `with' + | CHSTokString Position String -- string + | CHSTokHSVerb Position String -- verbatim Haskell (`...') + | CHSTokIdent Position Ident -- identifier + | CHSTokHaskell Position String -- verbatim Haskell code + | CHSTokCPP Position String -- pre-processor directive + | CHSTokLine Position -- line pragma + | CHSTokC Position String -- verbatim C code + | CHSTokCtrl Position Char -- control code + +instance Pos CHSToken where + posOf (CHSTokArrow pos ) = pos + posOf (CHSTokDArrow pos ) = pos + posOf (CHSTokDot pos ) = pos + posOf (CHSTokComma pos ) = pos + posOf (CHSTokEqual pos ) = pos + posOf (CHSTokMinus pos ) = pos + posOf (CHSTokStar pos ) = pos + posOf (CHSTokAmp pos ) = pos + posOf (CHSTokHat pos ) = pos + posOf (CHSTokLBrace pos ) = pos + posOf (CHSTokRBrace pos ) = pos + posOf (CHSTokLParen pos ) = pos + posOf (CHSTokRParen pos ) = pos + posOf (CHSTokEndHook pos ) = pos + posOf (CHSTokAs pos ) = pos + posOf (CHSTokCall pos ) = pos + posOf (CHSTokClass pos ) = pos + posOf (CHSTokContext pos ) = pos + posOf (CHSTokDerive pos ) = pos + posOf (CHSTokDown pos ) = pos + posOf (CHSTokEnum pos ) = pos + posOf (CHSTokForeign pos ) = pos + posOf (CHSTokFun pos ) = pos + posOf (CHSTokGet pos ) = pos + posOf (CHSTokImport pos ) = pos + posOf (CHSTokLib pos ) = pos + posOf (CHSTokNewtype pos ) = pos + posOf (CHSTokNocode pos ) = pos + posOf (CHSTokPointer pos ) = pos + posOf (CHSTokPrefix pos ) = pos + posOf (CHSTokPure pos ) = pos + posOf (CHSTokQualif pos ) = pos + posOf (CHSTokSet pos ) = pos + posOf (CHSTokSizeof pos ) = pos + posOf (CHSTokStable pos ) = pos + posOf (CHSTokType pos ) = pos + posOf (CHSTok_2Case pos ) = pos + posOf (CHSTokUnsafe pos ) = pos + posOf (CHSTokUpper pos ) = pos + posOf (CHSTokWith pos ) = pos + posOf (CHSTokString pos _) = pos + posOf (CHSTokHSVerb pos _) = pos + posOf (CHSTokIdent pos _) = pos + posOf (CHSTokHaskell pos _) = pos + posOf (CHSTokCPP pos _) = pos + posOf (CHSTokLine pos ) = pos + posOf (CHSTokC pos _) = pos + posOf (CHSTokCtrl pos _) = pos + +instance Eq CHSToken where + (CHSTokArrow _ ) == (CHSTokArrow _ ) = True + (CHSTokDArrow _ ) == (CHSTokDArrow _ ) = True + (CHSTokDot _ ) == (CHSTokDot _ ) = True + (CHSTokComma _ ) == (CHSTokComma _ ) = True + (CHSTokEqual _ ) == (CHSTokEqual _ ) = True + (CHSTokMinus _ ) == (CHSTokMinus _ ) = True + (CHSTokStar _ ) == (CHSTokStar _ ) = True + (CHSTokAmp _ ) == (CHSTokAmp _ ) = True + (CHSTokHat _ ) == (CHSTokHat _ ) = True + (CHSTokLBrace _ ) == (CHSTokLBrace _ ) = True + (CHSTokRBrace _ ) == (CHSTokRBrace _ ) = True + (CHSTokLParen _ ) == (CHSTokLParen _ ) = True + (CHSTokRParen _ ) == (CHSTokRParen _ ) = True + (CHSTokEndHook _ ) == (CHSTokEndHook _ ) = True + (CHSTokAs _ ) == (CHSTokAs _ ) = True + (CHSTokCall _ ) == (CHSTokCall _ ) = True + (CHSTokClass _ ) == (CHSTokClass _ ) = True + (CHSTokContext _ ) == (CHSTokContext _ ) = True + (CHSTokDerive _ ) == (CHSTokDerive _ ) = True + (CHSTokDown _ ) == (CHSTokDown _ ) = True + (CHSTokEnum _ ) == (CHSTokEnum _ ) = True + (CHSTokForeign _ ) == (CHSTokForeign _ ) = True + (CHSTokFun _ ) == (CHSTokFun _ ) = True + (CHSTokGet _ ) == (CHSTokGet _ ) = True + (CHSTokImport _ ) == (CHSTokImport _ ) = True + (CHSTokLib _ ) == (CHSTokLib _ ) = True + (CHSTokNewtype _ ) == (CHSTokNewtype _ ) = True + (CHSTokNocode _ ) == (CHSTokNocode _ ) = True + (CHSTokPointer _ ) == (CHSTokPointer _ ) = True + (CHSTokPrefix _ ) == (CHSTokPrefix _ ) = True + (CHSTokPure _ ) == (CHSTokPure _ ) = True + (CHSTokQualif _ ) == (CHSTokQualif _ ) = True + (CHSTokSet _ ) == (CHSTokSet _ ) = True + (CHSTokSizeof _ ) == (CHSTokSizeof _ ) = True + (CHSTokStable _ ) == (CHSTokStable _ ) = True + (CHSTokType _ ) == (CHSTokType _ ) = True + (CHSTok_2Case _ ) == (CHSTok_2Case _ ) = True + (CHSTokUnsafe _ ) == (CHSTokUnsafe _ ) = True + (CHSTokUpper _ ) == (CHSTokUpper _ ) = True + (CHSTokWith _ ) == (CHSTokWith _ ) = True + (CHSTokString _ _) == (CHSTokString _ _) = True + (CHSTokHSVerb _ _) == (CHSTokHSVerb _ _) = True + (CHSTokIdent _ _) == (CHSTokIdent _ _) = True + (CHSTokHaskell _ _) == (CHSTokHaskell _ _) = True + (CHSTokCPP _ _) == (CHSTokCPP _ _) = True + (CHSTokLine _ ) == (CHSTokLine _ ) = True + (CHSTokC _ _) == (CHSTokC _ _) = True + (CHSTokCtrl _ _) == (CHSTokCtrl _ _) = True + _ == _ = False + +instance Show CHSToken where + showsPrec _ (CHSTokArrow _ ) = showString "->" + showsPrec _ (CHSTokDArrow _ ) = showString "=>" + showsPrec _ (CHSTokDot _ ) = showString "." + showsPrec _ (CHSTokComma _ ) = showString "," + showsPrec _ (CHSTokEqual _ ) = showString "=" + showsPrec _ (CHSTokMinus _ ) = showString "-" + showsPrec _ (CHSTokStar _ ) = showString "*" + showsPrec _ (CHSTokAmp _ ) = showString "&" + showsPrec _ (CHSTokHat _ ) = showString "^" + showsPrec _ (CHSTokLBrace _ ) = showString "{" + showsPrec _ (CHSTokRBrace _ ) = showString "}" + showsPrec _ (CHSTokLParen _ ) = showString "(" + showsPrec _ (CHSTokRParen _ ) = showString ")" + showsPrec _ (CHSTokEndHook _ ) = showString "#}" + showsPrec _ (CHSTokAs _ ) = showString "as" + showsPrec _ (CHSTokCall _ ) = showString "call" + showsPrec _ (CHSTokClass _ ) = showString "class" + showsPrec _ (CHSTokContext _ ) = showString "context" + showsPrec _ (CHSTokDerive _ ) = showString "deriving" + showsPrec _ (CHSTokDown _ ) = showString "downcaseFirstLetter" + showsPrec _ (CHSTokEnum _ ) = showString "enum" + showsPrec _ (CHSTokForeign _ ) = showString "foreign" + showsPrec _ (CHSTokFun _ ) = showString "fun" + showsPrec _ (CHSTokGet _ ) = showString "get" + showsPrec _ (CHSTokImport _ ) = showString "import" + showsPrec _ (CHSTokLib _ ) = showString "lib" + showsPrec _ (CHSTokNewtype _ ) = showString "newtype" + showsPrec _ (CHSTokNocode _ ) = showString "nocode" + showsPrec _ (CHSTokPointer _ ) = showString "pointer" + showsPrec _ (CHSTokPrefix _ ) = showString "prefix" + showsPrec _ (CHSTokPure _ ) = showString "pure" + showsPrec _ (CHSTokQualif _ ) = showString "qualified" + showsPrec _ (CHSTokSet _ ) = showString "set" + showsPrec _ (CHSTokSizeof _ ) = showString "sizeof" + showsPrec _ (CHSTokStable _ ) = showString "stable" + showsPrec _ (CHSTokType _ ) = showString "type" + showsPrec _ (CHSTok_2Case _ ) = showString "underscoreToCase" + showsPrec _ (CHSTokUnsafe _ ) = showString "unsafe" + showsPrec _ (CHSTokUpper _ ) = showString "upcaseFirstLetter" + showsPrec _ (CHSTokWith _ ) = showString "with" + showsPrec _ (CHSTokString _ s) = showString ("\"" ++ s ++ "\"") + showsPrec _ (CHSTokHSVerb _ s) = showString ("`" ++ s ++ "'") + showsPrec _ (CHSTokIdent _ i) = (showString . identToLexeme) i + showsPrec _ (CHSTokHaskell _ s) = showString s + showsPrec _ (CHSTokCPP _ s) = showString s + showsPrec _ (CHSTokLine p ) = id --TODO show line num? + showsPrec _ (CHSTokC _ s) = showString s + showsPrec _ (CHSTokCtrl _ c) = showChar c + + +-- lexer state +-- ----------- + +-- state threaded through the lexer +-- +data CHSLexerState = CHSLS { + nestLvl :: Int, -- nesting depth of nested comments + inHook :: Bool, -- within a binding hook? + namesup :: [Name] -- supply of unique names + } + +-- initial state +-- +initialState :: CST s CHSLexerState +initialState = do + namesup <- liftM names getNameSupply + return $ CHSLS { + nestLvl = 0, + inHook = False, + namesup = namesup + } + +-- raise an error if the given state is not a final state +-- +assertFinalState :: Position -> CHSLexerState -> CST s () +assertFinalState pos CHSLS {nestLvl = nestLvl, inHook = inHook} + | nestLvl > 0 = raiseError pos ["Unexpected end of file!", + "Unclosed nested comment."] + | inHook = raiseError pos ["Unexpected end of file!", + "Unclosed binding hook."] + | otherwise = return () + +-- lexer and action type used throughout this specification +-- +type CHSLexer = Lexer CHSLexerState CHSToken +type CHSAction = Action CHSToken +type CHSRegexp = Regexp CHSLexerState CHSToken + +-- for actions that need a new unique name +-- +infixl 3 `lexactionName` +lexactionName :: CHSRegexp + -> (String -> Position -> Name -> CHSToken) + -> CHSLexer +re `lexactionName` action = re `lexmeta` action' + where + action' str pos state = let name:ns = namesup state + in + (Just $ Right (action str pos name), + incPos pos (length str), + state {namesup = ns}, + Nothing) + + +-- lexical specification +-- --------------------- + +-- the lexical definition of the tokens (the base lexer) +-- +-- +chslexer :: CHSLexer +chslexer = haskell -- Haskell code + >||< nested -- nested comments + >||< ctrl -- control code (that has to be preserved) + >||< hook -- start of a binding hook + >||< cpp -- a pre-processor directive (or `#c') + +-- stream of Haskell code (terminated by a control character or binding hook) +-- +haskell :: CHSLexer +-- +-- NB: We need to make sure that '"' is not regarded as the beginning of a +-- string; however, we cannot really lex character literals properly +-- without lexing identifiers (as the latter may containing single quotes +-- as part of their lexeme). Thus, we special case '"'. This is still a +-- kludge, as a program fragment, such as +-- +-- foo'"'strange string" +-- +-- will not be handled correctly. +-- +haskell = ( anyButSpecial`star` epsilon + >|< specialButQuotes + >|< char '"' +> inhstr`star` char '"' + >|< string "'\"'" -- special case of " + >|< string "--" +> anyButNL`star` epsilon -- comment + ) + `lexaction` copyVerbatim + >||< char '"' -- this is a bad kludge + `lexactionErr` + \_ pos -> (Left $ makeError ErrorErr pos + ["Lexical error!", + "Unclosed string."]) + where + anyButSpecial = alt (inlineSet \\ specialSet) + specialButQuotes = alt (specialSet \\ ['"']) + anyButNL = alt (anySet \\ ['\n']) + inhstr = instr >|< char '\\' >|< string "\\\"" >|< gap + gap = char '\\' +> alt (' ':ctrlSet)`plus` char '\\' + +-- action copying the input verbatim to `CHSTokHaskell' tokens +-- +copyVerbatim :: CHSAction +copyVerbatim cs pos = Just $ CHSTokHaskell pos cs + +-- nested comments +-- +nested :: CHSLexer +nested = + string "{-" {- for Haskell emacs mode :-( -} + `lexmeta` enterComment + >||< + string "-}" + `lexmeta` leaveComment + where + enterComment cs pos s = + (copyVerbatim' cs pos, -- collect the lexeme + incPos pos 2, -- advance current position + s {nestLvl = nestLvl s + 1}, -- increase nesting level + Just $ inNestedComment) -- continue in comment lexer + -- + leaveComment cs pos s = + case nestLvl s of + 0 -> (commentCloseErr pos, -- 0: -} outside comment => err + incPos pos 2, -- advance current position + s, + Nothing) + 1 -> (copyVerbatim' cs pos, -- collect the lexeme + incPos pos 2, -- advance current position + s {nestLvl = nestLvl s - 1}, -- decrease nesting level + Just chslexer) -- 1: continue with root lexer + _ -> (copyVerbatim' cs pos, -- collect the lexeme + incPos pos 2, -- advance current position + s {nestLvl = nestLvl s - 1}, -- decrease nesting level + Nothing) -- _: cont with comment lexer + -- + copyVerbatim' cs pos = Just $ Right (CHSTokHaskell pos cs) + -- + commentCloseErr pos = + Just $ Left (makeError ErrorErr pos + ["Lexical error!", + "`-}' not preceded by a matching `{-'."]) + {- for Haskell emacs mode :-( -} + + +-- lexer processing the inner of a comment +-- +inNestedComment :: CHSLexer +inNestedComment = commentInterior -- inside a comment + >||< nested -- nested comments + >||< ctrl -- control code (preserved) + +-- standard characters in a nested comment +-- +commentInterior :: CHSLexer +commentInterior = ( anyButSpecial`star` epsilon + >|< special + ) + `lexaction` copyVerbatim + where + anyButSpecial = alt (inlineSet \\ commentSpecialSet) + special = alt commentSpecialSet + +-- control code in the base lexer (is turned into a token) +-- +-- * this covers exactly the same set of characters as contained in `ctrlSet' +-- and `Lexers.ctrlLexer' and advances positions also like the `ctrlLexer' +-- +ctrl :: CHSLexer +ctrl = + char '\n' `lexmeta` newline + >||< char '\r' `lexmeta` newline + >||< char '\v' `lexmeta` newline + >||< char '\f' `lexmeta` formfeed + >||< char '\t' `lexmeta` tab + where + newline [c] pos = ctrlResult pos c (retPos pos) + formfeed [c] pos = ctrlResult pos c (incPos pos 1) + tab [c] pos = ctrlResult pos c (tabPos pos) + + ctrlResult pos c pos' s = + (Just $ Right (CHSTokCtrl pos c), pos', s, Nothing) + +-- start of a binding hook (ie, enter the binding hook lexer) +-- +hook :: CHSLexer +hook = string "{#" + `lexmeta` \_ pos s -> (Nothing, incPos pos 2, s, Just bhLexer) + +-- pre-processor directives and `#c' +-- +-- * we lex `#c' as a directive and special case it in the action +-- +-- * we lex C line number pragmas and special case it in the action +-- +cpp :: CHSLexer +cpp = directive + where + directive = + string "\n#" +> alt ('\t':inlineSet)`star` epsilon + `lexmeta` + \(_:_:dir) pos s -> -- strip off the "\n#" + case dir of + ['c'] -> -- #c + (Nothing, retPos pos, s, Just cLexer) + -- a #c may be followed by whitespace + 'c':sp:_ | sp `elem` " \t" -> -- #c + (Nothing, retPos pos, s, Just cLexer) + ' ':line@(n:_) | isDigit n -> -- C line pragma + let pos' = adjustPosByCLinePragma line pos + in (Just $ Right (CHSTokLine pos'), pos', s, Nothing) + _ -> -- CPP directive + (Just $ Right (CHSTokCPP pos dir), + retPos pos, s, Nothing) + +adjustPosByCLinePragma :: String -> Position -> Position +adjustPosByCLinePragma str (Position fname _ _) = + (Position fname' row' 0) + where + str' = dropWhite str + (rowStr, str'') = span isDigit str' + row' = read rowStr + str''' = dropWhite str'' + fnameStr = takeWhile (/= '"') . drop 1 $ str''' + fname' | null str''' || head str''' /= '"' = fname + -- try and get more sharing of file name strings + | fnameStr == fname = fname + | otherwise = fnameStr + -- + dropWhite = dropWhile (\c -> c == ' ' || c == '\t') + +-- the binding hook lexer +-- +bhLexer :: CHSLexer +bhLexer = identOrKW + >||< symbol + >||< strlit + >||< hsverb + >||< whitespace + >||< endOfHook + >||< string "--" +> anyButNL`star` char '\n' -- comment + `lexmeta` \_ pos s -> (Nothing, retPos pos, s, Nothing) + where + anyButNL = alt (anySet \\ ['\n']) + endOfHook = string "#}" + `lexmeta` + \_ pos s -> (Just $ Right (CHSTokEndHook pos), + incPos pos 2, s, Just chslexer) + +-- the inline-C lexer +-- +cLexer :: CHSLexer +cLexer = inlineC -- inline C code + >||< ctrl -- control code (preserved) + >||< string "\n#endc" -- end of inline C code... + `lexmeta` -- ...preserve '\n' as control token + \_ pos s -> (Just $ Right (CHSTokCtrl pos '\n'), retPos pos, s, + Just chslexer) + where + inlineC = alt inlineSet `lexaction` copyVerbatimC + -- + copyVerbatimC :: CHSAction + copyVerbatimC cs pos = Just $ CHSTokC pos cs + +-- whitespace +-- +-- * horizontal and vertical tabs, newlines, and form feeds are filter out by +-- `Lexers.ctrlLexer' +-- +whitespace :: CHSLexer +whitespace = (char ' ' `lexaction` \_ _ -> Nothing) + >||< ctrlLexer + +-- identifiers and keywords +-- +identOrKW :: CHSLexer +-- +-- the strictness annotations seem to help a bit +-- +identOrKW = + -- identifier or keyword + (letter +> (letter >|< digit >|< char '\'')`star` epsilon + `lexactionName` \cs pos name -> (idkwtok $!pos) cs name) + >||< -- identifier in single quotes + (char '\'' +> letter +> (letter >|< digit)`star` char '\'' + `lexactionName` \cs pos name -> (mkid $!pos) cs name) + -- NB: quotes are removed by lexemeToIdent + where + idkwtok pos "as" _ = CHSTokAs pos + idkwtok pos "call" _ = CHSTokCall pos + idkwtok pos "class" _ = CHSTokClass pos + idkwtok pos "context" _ = CHSTokContext pos + idkwtok pos "deriving" _ = CHSTokDerive pos + idkwtok pos "downcaseFirstLetter" _ = CHSTokDown pos + idkwtok pos "enum" _ = CHSTokEnum pos + idkwtok pos "foreign" _ = CHSTokForeign pos + idkwtok pos "fun" _ = CHSTokFun pos + idkwtok pos "get" _ = CHSTokGet pos + idkwtok pos "import" _ = CHSTokImport pos + idkwtok pos "lib" _ = CHSTokLib pos + idkwtok pos "newtype" _ = CHSTokNewtype pos + idkwtok pos "nocode" _ = CHSTokNocode pos + idkwtok pos "pointer" _ = CHSTokPointer pos + idkwtok pos "prefix" _ = CHSTokPrefix pos + idkwtok pos "pure" _ = CHSTokPure pos + idkwtok pos "qualified" _ = CHSTokQualif pos + idkwtok pos "set" _ = CHSTokSet pos + idkwtok pos "sizeof" _ = CHSTokSizeof pos + idkwtok pos "stable" _ = CHSTokStable pos + idkwtok pos "type" _ = CHSTokType pos + idkwtok pos "underscoreToCase" _ = CHSTok_2Case pos + idkwtok pos "unsafe" _ = CHSTokUnsafe pos + idkwtok pos "upcaseFirstLetter"_ = CHSTokUpper pos + idkwtok pos "with" _ = CHSTokWith pos + idkwtok pos cs name = mkid pos cs name + -- + mkid pos cs name = CHSTokIdent pos (lexemeToIdent pos cs name) + +-- reserved symbols +-- +symbol :: CHSLexer +symbol = sym "->" CHSTokArrow + >||< sym "=>" CHSTokDArrow + >||< sym "." CHSTokDot + >||< sym "," CHSTokComma + >||< sym "=" CHSTokEqual + >||< sym "-" CHSTokMinus + >||< sym "*" CHSTokStar + >||< sym "&" CHSTokAmp + >||< sym "^" CHSTokHat + >||< sym "{" CHSTokLBrace + >||< sym "}" CHSTokRBrace + >||< sym "(" CHSTokLParen + >||< sym ")" CHSTokRParen + where + sym cs con = string cs `lexaction` \_ pos -> Just (con pos) + +-- string +-- +strlit :: CHSLexer +strlit = char '"' +> (instr >|< char '\\')`star` char '"' + `lexaction` \cs pos -> Just (CHSTokString pos (init . tail $ cs)) + +-- verbatim code +-- +hsverb :: CHSLexer +hsverb = char '`' +> inhsverb`star` char '\'' + `lexaction` \cs pos -> Just (CHSTokHSVerb pos (init . tail $ cs)) + + +-- regular expressions +-- +letter, digit, instr, inhsverb :: Regexp s t +letter = alt ['a'..'z'] >|< alt ['A'..'Z'] >|< char '_' +digit = alt ['0'..'9'] +instr = alt ([' '..'\255'] \\ "\"\\") +inhsverb = alt ([' '..'\127'] \\ "\'") + +-- character sets +-- +anySet, inlineSet, specialSet, commentSpecialSet, ctrlSet :: [Char] +anySet = ['\0'..'\255'] +inlineSet = anySet \\ ctrlSet +specialSet = ['{', '-', '"', '\''] +commentSpecialSet = ['{', '-'] +ctrlSet = ['\n', '\f', '\r', '\t', '\v'] + + +-- main lexing routine +-- ------------------- + +-- generate a token sequence out of a string denoting a CHS file +-- (EXPORTED) +-- +-- * the given position is attributed to the first character in the string +-- +-- * errors are entered into the compiler state +-- +lexCHS :: String -> Position -> CST s [CHSToken] +lexCHS cs pos = + do + state <- initialState + let (ts, lstate, errs) = execLexer chslexer (cs, pos, state) + (_, pos', state') = lstate + mapM raise errs + assertFinalState pos' state' + return ts diff --git a/c2hs/gen/CInfo.hs b/c2hs/gen/CInfo.hs new file mode 100644 --- /dev/null +++ b/c2hs/gen/CInfo.hs @@ -0,0 +1,177 @@ +-- C->Haskell Compiler: information about the C implementation +-- +-- Author : Manuel M T Chakravarty +-- Created: 5 February 01 +-- +-- Copyright (c) [2001..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module provide some information about the specific implementation of +-- C that we are dealing with. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Bit fields +-- ~~~~~~~~~~ +-- Bit fields in C can be signed and unsigned. According to K&R A8.3, they +-- can only be formed from `int', `signed int', and `unsigned int', where for +-- `int' it is implementation dependent whether the field is signed or +-- unsigned. Moreover, the following parameters are implementation +-- dependent: +-- +-- * the direction of packing bits into storage units, +-- * the size of storage units, and +-- * whether when a field that doesn't fit a partially filled storage unit +-- is split across units or the partially filled unit is padded. +-- +-- Generally, unnamed fields (those without an identifier) with a width of 0 +-- are guaranteed to forces the above padding. Note that in `CPrimType' we +-- only represent 0 width fields *if* they imply padding. In other words, +-- whenever they are unnamed, they are represented by a `CPrimType', and if +-- they are named, they are represented by a `CPrimType' only if that +-- targeted C compiler chooses to let them introduce padding. If a field +-- does not have any effect, it is dropped during the conversion of a C type +-- into a `CPrimType'-based representation. +-- +-- In the code, we assume that the alignment of a bitfield (as determined by +-- `bitfieldAlignment') is independent of the size of the bitfield. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module CInfo ( + CPrimType(..), size, alignment, getPlatform +) where + +import Foreign (Ptr, FunPtr) +import qualified Foreign.Storable as Storable (Storable(sizeOf, alignment)) +import Foreign.C + +import C2HSConfig (PlatformSpec(..)) +import C2HSState (getSwitch) +import Switches (platformSB) +import GBMonad (GB) + + +-- calibration of C's primitive types +-- ---------------------------------- + +-- C's primitive types (EXPORTED) +-- +-- * `CFunPtrPT' doesn't occur in Haskell representations of C types, but we +-- need to know their size, which may be different from `CPtrPT' +-- +data CPrimType = CPtrPT -- void * + | CFunPtrPT -- void *() + | CCharPT -- char + | CUCharPT -- unsigned char + | CSCharPT -- signed char + | CIntPT -- int + | CShortPT -- short int + | CLongPT -- long int + | CLLongPT -- long long int + | CUIntPT -- unsigned int + | CUShortPT -- unsigned short int + | CULongPT -- unsigned long int + | CULLongPT -- unsigned long long int + | CFloatPT -- float + | CDoublePT -- double + | CLDoublePT -- long double + | CSFieldPT Int -- signed bit field + | CUFieldPT Int -- unsigned bit field + deriving (Eq) + +-- size of primitive type of C (EXPORTED) +-- +-- * negative size implies that it is a bit, not an octet size +-- +size :: CPrimType -> Int +size CPtrPT = Storable.sizeOf (undefined :: Ptr ()) +size CFunPtrPT = Storable.sizeOf (undefined :: FunPtr ()) +size CCharPT = 1 +size CUCharPT = 1 +size CSCharPT = 1 +size CIntPT = Storable.sizeOf (undefined :: CInt) +size CShortPT = Storable.sizeOf (undefined :: CShort) +size CLongPT = Storable.sizeOf (undefined :: CLong) +size CLLongPT = Storable.sizeOf (undefined :: CLLong) +size CUIntPT = Storable.sizeOf (undefined :: CUInt) +size CUShortPT = Storable.sizeOf (undefined :: CUShort) +size CULongPT = Storable.sizeOf (undefined :: CULong) +size CULLongPT = Storable.sizeOf (undefined :: CLLong) +size CFloatPT = Storable.sizeOf (undefined :: CFloat) +size CDoublePT = Storable.sizeOf (undefined :: CDouble) +size CLDoublePT = Storable.sizeOf (undefined :: CLDouble) +size (CSFieldPT bs) = -bs +size (CUFieldPT bs) = -bs + +-- alignment of C's primitive types (EXPORTED) +-- +-- * more precisely, the padding put before the type's member starts when the +-- preceding component is a char +-- +alignment :: CPrimType -> GB Int +alignment CPtrPT = return $ Storable.alignment (undefined :: Ptr ()) +alignment CFunPtrPT = return $ Storable.alignment (undefined :: FunPtr ()) +alignment CCharPT = return $ 1 +alignment CUCharPT = return $ 1 +alignment CSCharPT = return $ 1 +alignment CIntPT = return $ Storable.alignment (undefined :: CInt) +alignment CShortPT = return $ Storable.alignment (undefined :: CShort) +alignment CLongPT = return $ Storable.alignment (undefined :: CLong) +alignment CLLongPT = return $ Storable.alignment (undefined :: CLLong) +alignment CUIntPT = return $ Storable.alignment (undefined :: CUInt) +alignment CUShortPT = return $ Storable.alignment (undefined :: CUShort) +alignment CULongPT = return $ Storable.alignment (undefined :: CULong) +alignment CULLongPT = return $ Storable.alignment (undefined :: CULLong) +alignment CFloatPT = return $ Storable.alignment (undefined :: CFloat) +alignment CDoublePT = return $ Storable.alignment (undefined :: CDouble) +alignment CLDoublePT = return $ Storable.alignment (undefined :: CLDouble) +alignment (CSFieldPT bs) = fieldAlignment bs +alignment (CUFieldPT bs) = fieldAlignment bs + +-- alignment constraint for a C bitfield +-- +-- * gets the bitfield size (in bits) as an argument +-- +-- * alignments constraints smaller or equal to zero are reserved for bitfield +-- alignments +-- +-- * bitfields of size 0 always trigger padding; thus, they get the maximal +-- size +-- +-- * if bitfields whose size exceeds the space that is still available in a +-- partially filled storage unit trigger padding, the size of a storage unit +-- is provided as the alignment constraint; otherwise, it is 0 (meaning it +-- definitely starts at the current position) +-- +-- * here, alignment constraint /= 0 are somewhat subtle; they mean that is +-- the given number of bits doesn't fit in what's left in the current +-- storage unit, alignment to the start of the next storage unit has to be +-- triggered +-- +fieldAlignment :: Int -> GB Int +fieldAlignment 0 = return $ - (size CIntPT - 1) +fieldAlignment bs = + do + PlatformSpec {bitfieldPaddingPS = bitfieldPadding} <- getPlatform + return $ if bitfieldPadding then - bs else 0 + +-- obtain platform from switchboard +-- +getPlatform :: GB PlatformSpec +getPlatform = getSwitch platformSB + diff --git a/c2hs/gen/GBMonad.hs b/c2hs/gen/GBMonad.hs new file mode 100644 --- /dev/null +++ b/c2hs/gen/GBMonad.hs @@ -0,0 +1,436 @@ +-- C->Haskell Compiler: monad for the binding generator +-- +-- Author : Manuel M T Chakravarty +-- Derived: 18 February 2 (extracted from GenBind.hs) +-- +-- Copyright (c) [2002..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This modules defines the monad and related utility routines for the code +-- that implements the expansion of the binding hooks. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Translation table handling for enumerators: +-- ------------------------------------------- +-- +-- First a translation table lookup on the original identifier of the +-- enumerator is done. If that doesn't match and the prefix can be removed +-- from the identifier, a second lookup on the identifier without the prefix +-- is performed. If this also doesn't match, the identifier without prefix +-- (possible after underscoreToCase or similar translation is returned). If +-- there is a match, the translation (without any further stripping of +-- prefix) is returned. +-- +-- Pointer map +-- ----------- +-- +-- Pointer hooks allow the use to customise the Haskell types to which C +-- pointer types are mapped. The globally maintained map essentially maps C +-- pointer types to Haskell pointer types. The representation of the Haskell +-- types is defined by the `type' or `newtype' declaration emitted by the +-- corresponding pointer hook. However, the map stores a flag that tells +-- whether the C type is itself the pointer type in question or whether it is +-- pointers to this C type that should be mapped as specified. The pointer +-- map is dumped into and read from `.chi' files. +-- +-- Haskell object map +-- ------------------ +-- +-- Some features require information about Haskell objects defined by c2hs. +-- Therefore, the Haskell object map maintains the necessary information +-- about these Haskell objects. The Haskell object map is dumped into and +-- read from `.chi' files. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * Look up in translation tables is naive - this probably doesn't affect +-- costs much, but at some point a little profiling might be beneficial. +-- + +module GBMonad ( + TransFun, transTabToTransFun, + + HsObject(..), GB, initialGBState, setContext, getLibrary, getPrefix, + delayCode, getDelayedCode, ptrMapsTo, queryPtr, objIs, queryObj, queryClass, + queryPointer, mergeMaps, dumpMaps +) where + +-- standard libraries +import Data.Char (toUpper, toLower, isSpace) +import Data.List (find) +import Data.Maybe (fromMaybe) + +-- Compiler Toolkit +import Position (Position, Pos(posOf), nopos) +import Errors (interr) +import Idents (Ident, identToLexeme, onlyPosIdent) +import qualified Data.Map as Map (empty, insert, lookup, union, toList, fromList) +import Data.Map (Map) + +-- C -> Haskell +import C (CT, readCT, transCT, raiseErrorCTExc) + +-- friends +import CHS (CHSFrag(..), CHSHook(..), CHSTrans(..), + CHSChangeCase(..), CHSPtrType(..)) + + +-- translation tables +-- ------------------ + +-- takes an identifier to a lexeme including a potential mapping by a +-- translation table +-- +type TransFun = Ident -> String + +-- translation function for the `underscoreToCase' flag +-- +underscoreToCase :: String -> String +underscoreToCase lexeme = + let + ps = filter (not . null) . parts $ lexeme + in + concat . map adjustCase $ ps + where + parts s = let (l, s') = break (== '_') s + in + l : case s' of + [] -> [] + (_:s'') -> parts s'' + + adjustCase (c:cs) = toUpper c : map toLower cs + +-- translation function for the `upcaseFirstLetter' flag +-- +upcaseFirstLetter :: String -> String +upcaseFirstLetter "" = "" +upcaseFirstLetter (c:cs) = toUpper c : cs + +-- translation function for the `downcaseFirstLetter' flag +-- +downcaseFirstLetter :: String -> String +downcaseFirstLetter "" = "" +downcaseFirstLetter (c:cs) = toLower c : cs + +-- takes an identifier association table to a translation function +-- +-- * if first argument is `True', identifiers that are not found in the +-- translation table are subjected to `underscoreToCase' and friends +-- +-- * the details of handling the prefix are given in the DOCU section at the +-- beginning of this file +-- +transTabToTransFun :: String -> CHSTrans -> TransFun +transTabToTransFun prefix (CHSTrans _2Case chgCase table) = + \ide -> let + caseTrafo = (if _2Case then underscoreToCase else id) . + (case chgCase of + CHSSameCase -> id + CHSUpCase -> upcaseFirstLetter + CHSDownCase -> downcaseFirstLetter) + lexeme = identToLexeme ide + dft = caseTrafo lexeme -- default uses case trafo + in + case lookup ide table of -- lookup original ident + Just ide' -> identToLexeme ide' -- original ident matches + Nothing -> + case eat prefix lexeme of + Nothing -> dft -- no match & no prefix + Just eatenLexeme -> + let + eatenIde = onlyPosIdent (posOf ide) eatenLexeme + eatenDft = caseTrafo eatenLexeme + in + case lookup eatenIde table of -- lookup without prefix + Nothing -> eatenDft -- orig ide without prefix + Just ide' -> identToLexeme ide' -- without prefix matched + where + -- try to eat prefix and return `Just partialLexeme' if successful + -- + eat [] ('_':cs) = eat [] cs + eat [] cs = Just cs + eat (p:prefix) (c:cs) | toUpper p == toUpper c = eat prefix cs + | otherwise = Nothing + eat _ _ = Nothing + + +-- the local monad +-- --------------- + +-- map that for maps C pointer types to Haskell types for pointer that have +-- been registered using a pointer hook +-- +-- * the `Bool' indicates whether for a C type "ctype", we map "ctype" itself +-- or "*ctype" +-- +-- * in the co-domain, the first string is the type for function arguments and +-- the second string is for function results; this distinction is necessary +-- as `ForeignPtr's cannot be returned by a foreign function; the +-- restriction on function result types is only for the actual result, not +-- for type arguments to parametrised pointer types, ie, it holds for `res' +-- in `Int -> IO res', but not in `Int -> Ptr res' +-- +type PointerMap = Map (Bool, Ident) (String, String) + +-- map that maintains key information about some of the Haskell objects +-- generated by c2hs +-- +-- NB: using records here avoids to run into a bug with deriving `Read' in GHC +-- 5.04.1 +-- +data HsObject = Pointer { + ptrTypeHO :: CHSPtrType, -- kind of pointer + isNewtypeHO :: Bool -- newtype? + } + | Class { + superclassHO :: (Maybe Ident),-- superclass + ptrHO :: Ident -- pointer + } + deriving (Show, Read) +type HsObjectMap = Map Ident HsObject + +{- FIXME: What a mess... +instance Show HsObject where + show (Pointer ptrType isNewtype) = + "Pointer " ++ show ptrType ++ show isNewtype + show (Class osuper pointer ) = + "Class " ++ show ptrType ++ show isNewtype +-} +-- super kludgy (depends on Show instance of Ident) +instance Read Ident where + readsPrec _ ('`':lexeme) = let (ideChars, rest) = span (/= '\'') lexeme + in + if null ideChars + then [] + else [(onlyPosIdent nopos ideChars, tail rest)] + readsPrec p (c:cs) + | isSpace c = readsPrec p cs + readsPrec _ _ = [] + +-- the local state consists of +-- +-- (1) the dynamic library specified by the context hook, +-- (2) the prefix specified by the context hook, +-- (3) the set of delayed code fragaments, ie, pieces of Haskell code that, +-- finally, have to be appended at the CHS module together with the hook +-- that created them (the latter allows avoid duplication of foreign +-- export declarations), and +-- (4) a map associating C pointer types with their Haskell representation +-- +-- access to the attributes of the C structure tree is via the `CT' monad of +-- which we use an instance here +-- +data GBState = GBState { + lib :: String, -- dynamic library + prefix :: String, -- prefix + frags :: [(CHSHook, CHSFrag)], -- delayed code (with hooks) + ptrmap :: PointerMap, -- pointer representation + objmap :: HsObjectMap -- generated Haskell objects + } + +type GB a = CT GBState a + +initialGBState :: GBState +initialGBState = GBState { + lib = "", + prefix = "", + frags = [], + ptrmap = Map.empty, + objmap = Map.empty + } + +-- set the dynamic library and library prefix +-- +setContext :: (Maybe String) -> (Maybe String) -> GB () +setContext lib prefix = + transCT $ \state -> (state {lib = fromMaybe "" lib, + prefix = fromMaybe "" prefix}, + ()) + +-- get the dynamic library +-- +getLibrary :: GB String +getLibrary = readCT lib + +-- get the prefix string +-- +getPrefix :: GB String +getPrefix = readCT prefix + +-- add code to the delayed fragments (the code is made to start at a new line) +-- +-- * currently only code belonging to call hooks can be delayed +-- +-- * if code for the same call hook (ie, same C function) is delayed +-- repeatedly only the first entry is stored; it is checked that the hooks +-- specify the same flags (ie, produce the same delayed code) +-- +delayCode :: CHSHook -> String -> GB () +delayCode hook str = + do + frags <- readCT frags + frags' <- delay hook frags + transCT (\state -> (state {frags = frags'}, ())) + where + newEntry = (hook, (CHSVerb ("\n" ++ str) (posOf hook))) + -- + delay hook@(CHSCall isFun isUns ide oalias _) frags = + case find (\(hook', _) -> hook' == hook) frags of + Just (CHSCall isFun' isUns' ide' _ _, _) + | isFun == isFun' + && isUns == isUns' + && ide == ide' -> return frags + | otherwise -> err (posOf ide) (posOf ide') + Nothing -> return $ frags ++ [newEntry] + delay _ _ = + interr "GBMonad.delayCode: Illegal delay!" + -- + err = incompatibleCallHooksErr + +-- get the complete list of delayed fragments +-- +getDelayedCode :: GB [CHSFrag] +getDelayedCode = readCT (map snd . frags) + +-- add an entry to the pointer map +-- +ptrMapsTo :: (Bool, Ident) -> (String, String) -> GB () +(isStar, cName) `ptrMapsTo` hsRepr = + transCT (\state -> (state { + ptrmap = Map.insert (isStar, cName) hsRepr (ptrmap state) + }, ())) + +-- query the pointer map +-- +queryPtr :: (Bool, Ident) -> GB (Maybe (String, String)) +queryPtr pcName = do + fm <- readCT ptrmap + return $ Map.lookup pcName fm + +-- add an entry to the Haskell object map +-- +objIs :: Ident -> HsObject -> GB () +hsName `objIs` obj = + transCT (\state -> (state { + objmap = Map.insert hsName obj (objmap state) + }, ())) + +-- query the Haskell object map +-- +queryObj :: Ident -> GB (Maybe HsObject) +queryObj hsName = do + fm <- readCT objmap + return $ Map.lookup hsName fm + +-- query the Haskell object map for a class +-- +-- * raise an error if the class cannot be found +-- +queryClass :: Ident -> GB HsObject +queryClass hsName = do + let pos = posOf hsName + oobj <- queryObj hsName + case oobj of + Just obj@(Class _ _) -> return obj + Just _ -> classExpectedErr hsName + Nothing -> hsObjExpectedErr hsName + +-- query the Haskell object map for a pointer +-- +-- * raise an error if the pointer cannot be found +-- +queryPointer :: Ident -> GB HsObject +queryPointer hsName = do + let pos = posOf hsName + oobj <- queryObj hsName + case oobj of + Just obj@(Pointer _ _) -> return obj + Just _ -> pointerExpectedErr hsName + Nothing -> hsObjExpectedErr hsName + +-- merge the pointer and Haskell object maps +-- +-- * currently, the read map overrides any entires for shared keys in the map +-- that is already in the monad; this is so that, if multiple import hooks +-- add entries for shared keys, the textually latest prevails; any local +-- entries are entered after all import hooks anyway +-- +-- FIXME: This currently has several shortcomings: +-- * It just dies in case of a corrupted .chi file +-- * We should at least have the option to raise a warning if two +-- entries collide in the `objmap'. But it would be better to +-- implement qualified names. +-- * Do we want position information associated with the read idents? +-- +mergeMaps :: String -> GB () +mergeMaps str = + transCT (\state -> (state { + ptrmap = Map.union readPtrMap (ptrmap state), + objmap = Map.union readObjMap (objmap state) + }, ())) + where + (ptrAssoc, objAssoc) = read str + readPtrMap = Map.fromList [((isStar, onlyPosIdent nopos ide), repr) + | ((isStar, ide), repr) <- ptrAssoc] + readObjMap = Map.fromList [(onlyPosIdent nopos ide, obj) + | (ide, obj) <- objAssoc] + +-- convert the whole pointer and Haskell object maps into printable form +-- +dumpMaps :: GB String +dumpMaps = do + ptrFM <- readCT ptrmap + objFM <- readCT objmap + let dumpable = ([((isStar, identToLexeme ide), repr) + | ((isStar, ide), repr) <- Map.toList ptrFM], + [(identToLexeme ide, obj) + | (ide, obj) <- Map.toList objFM]) + return $ show dumpable + + +-- error messages +-- -------------- + +incompatibleCallHooksErr :: Position -> Position -> GB a +incompatibleCallHooksErr here there = + raiseErrorCTExc here + ["Incompatible call hooks!", + "There is a another call hook for the same C function at " ++ show there, + "The flags and C function name of the two hooks should be identical,", + "but they are not."] + +classExpectedErr :: Ident -> GB a +classExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Expected a class name!", + "Expected `" ++ identToLexeme ide ++ "' to refer to a class introduced", + "by a class hook."] + +pointerExpectedErr :: Ident -> GB a +pointerExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Expected a pointer name!", + "Expected `" ++ identToLexeme ide ++ "' to be a type name introduced by", + "a pointer hook."] + +hsObjExpectedErr :: Ident -> GB a +hsObjExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Unknown name!", + "`" ++ identToLexeme ide ++ "' is unknown; it has *not* been defined by", + "a previous hook."] + diff --git a/c2hs/gen/GenBind.hs b/c2hs/gen/GenBind.hs new file mode 100644 --- /dev/null +++ b/c2hs/gen/GenBind.hs @@ -0,0 +1,2212 @@ +-- C->Haskell Compiler: binding generator +-- vim:ts=8:noexpandtab +-- +-- Copyright (c) [1999..2003] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- Module implementing the expansion of the binding hooks. +-- +-- * If there is an error in one binding hook, it is skipped and the next one +-- is processed (to collect as many errors as possible). However, if at +-- least one error occured, the expansion of binding hooks ends in a fatal +-- exception. +-- +-- * `CST' exceptions are used to back off a binding hook as soon as an error +-- is encountered while it is processed. +-- +-- Mapping of C types to Haskell FFI types: +-- ---------------------------------------- +-- +-- The following defines the mapping for basic types. If the type specifer +-- is missing, it is taken to be `int'. In the following, elements enclosed +-- in square brackets are optional. +-- +-- void -> () +-- char -> CChar +-- unsigned char -> CUChar +-- signed char -> CShort +-- signed -> CInt +-- [signed] int -> CInt +-- [signed] short [int] -> CSInt +-- [signed] long [int] -> CLong +-- [signed] long long [int] -> CLLong +-- unsigned [int] -> CUInt +-- unsigned short [int] -> CUShort +-- unsigned long [int] -> CULong +-- unsigned long long [int] -> CULLong +-- float -> CFloat +-- double -> CDouble +-- long double -> CLDouble +-- enum ... -> CInt +-- struct ... -> ** error ** +-- union ... -> ** error ** +-- +-- Plain structures or unions (ie, if not the base type of a pointer type) +-- are not supported at the moment (the underlying FFI does not support them +-- directly). Named types (ie, in C type names defined using `typedef') are +-- traced back to their original definitions. Pointer types are mapped +-- to `Ptr a' or `FunPtr a' depending on whether they point to a functional. +-- Values obtained from bit fields are represented by `CInt' or `CUInt' +-- depending on whether they are signed. +-- +-- We obtain the size and alignment constraints for all primitive types of C +-- from `CInfo', which obtains it from the Haskell 98 FFI. In the alignment +-- computations involving bit fields, we assume that the alignment +-- constraints for bitfields (wrt to non-bitfield members) is always the same +-- as for `int' irrespective of the size of the bitfield. This seems to be +-- implicitly guaranteed by K&R A8.3, but it is not entirely clear. +-- +-- Identifier lookup: +-- ------------------ +-- +-- We allow to identify enumerations and structures by the names of `typedef' +-- types aliased to them. +-- +-- * enumerations: It is first checked whether there is a tag with the given +-- identifier; if such a tag does not exist, the definition of a typedef +-- with the same name is taken if it exists. +-- * structs/unions: like enumerations +-- +-- We generally use `shadow' lookups. When an identifier cannot be found, +-- we check whether - according to the prefix set by the context hook - +-- another identifier casts a shadow that matches. If so, that identifier is +-- taken instead of the original one. +-- +--- ToDo ---------------------------------------------------------------------- +-- +-- * A function prototype that uses a defined type on its left hand side may +-- declare a function, while that is not obvious from the declaration +-- itself (without also considering the `typedef'). Calls to such +-- functions are currently rejected, which is a BUG. +-- +-- * context hook must preceded all but the import hooks +-- +-- * The use of `++' in the recursive definition of the routines generating +-- `Enum' instances is not particularly efficient. +-- +-- * Some operands are missing in `applyBin' - unfortunately, Haskell does +-- not have standard bit operations. Some constructs are also missing +-- from `evalConstCExpr'. Haskell 98 FFI standardises `Bits'; use that. +-- + +module GenBind (expandHooks) +where + +-- standard libraries +import Data.Char (toLower) +import Data.List (deleteBy, intersperse, find) +import Data.Maybe (isNothing, fromJust, fromMaybe) +import Control.Monad (when, unless, liftM, mapAndUnzipM) + +-- Compiler Toolkit +import Position (Position, Pos(posOf), nopos, builtinPos) +import Errors (interr, todo) +import Idents (Ident, identToLexeme, onlyPosIdent) +import Attributes (newAttrsOnlyPos) + +-- C->Haskell +import C2HSConfig (PlatformSpec(..)) +import C2HSState (CST, errorsPresent, showErrors, fatal, + SwitchBoard(..), Traces(..), putTraceStr, getSwitch) +import C (AttrC, CObj(..), CTag(..), + CDecl(..), CDeclSpec(..), CTypeSpec(..), + CStructUnion(..), CStructTag(..), CEnum(..), CDeclr(..), + CExpr(..), CBinaryOp(..), CUnaryOp(..), CConst (..), + runCT, ifCTExc, + raiseErrorCTExc, findValueObj, findFunObj, findTag, + applyPrefixToNameSpaces, + simplifyDecl, declrNamed, structMembers, + structName, tagName, declaredName , structFromDecl, + funResultAndArgs, chaseDecl, findAndChaseDecl, + checkForAlias, checkForOneAliasName, checkForOneCUName, + lookupEnum, lookupStructUnion, lookupDeclOrTag, isPtrDeclr, + dropPtrDeclr, isPtrDecl, getDeclOf, isFunDeclr, + refersToNewDef, CDef(..)) + +-- friends +import CHS (CHSModule(..), CHSFrag(..), CHSHook(..), + CHSParm(..), CHSArg(..), CHSAccess(..), CHSAPath(..), + CHSPtrType(..), showCHSParm, apathToIdent) +import CInfo (CPrimType(..), size, alignment, getPlatform) +import GBMonad (TransFun, transTabToTransFun, HsObject(..), GB, + initialGBState, setContext, getPrefix, + delayCode, getDelayedCode, ptrMapsTo, queryPtr, objIs, + queryClass, queryPointer, mergeMaps, dumpMaps) + + +-- default marshallers +-- ------------------- + +-- FIXME: +-- - we might have a dynamically extended table in the monad if needed (we +-- could marshall enums this way and also save the `id' marshallers for +-- pointers defined via (newtype) pointer hooks) +-- - the checks for the Haskell types are quite kludgy + +-- determine the default "in" marshaller for the given Haskell and C types +-- +lookupDftMarshIn :: String -> [ExtType] -> GB (Maybe (Ident, CHSArg)) +lookupDftMarshIn "Bool" [PrimET pt] | isIntegralCPrimType pt = + return $ Just (cFromBoolIde, CHSValArg) +lookupDftMarshIn hsTy [PrimET pt] | isIntegralHsType hsTy + &&isIntegralCPrimType pt = + return $ Just (cIntConvIde, CHSValArg) +lookupDftMarshIn hsTy [PrimET pt] | isFloatHsType hsTy + &&isFloatCPrimType pt = + return $ Just (cFloatConvIde, CHSValArg) +lookupDftMarshIn "String" [PtrET (PrimET CCharPT)] = + return $ Just (withCStringIde, CHSIOArg) +lookupDftMarshIn "String" [PtrET (PrimET CCharPT), PrimET pt] + | isIntegralCPrimType pt = + return $ Just (withCStringLenIde, CHSIOArg) +lookupDftMarshIn hsTy [PtrET ty] | showExtType ty == hsTy = + return $ Just (withIde, CHSIOArg) +lookupDftMarshIn hsTy [PtrET (PrimET pt)] + | isIntegralHsType hsTy && isIntegralCPrimType pt = + return $ Just (withIntConvIde, CHSIOArg) +lookupDftMarshIn hsTy [PtrET (PrimET pt)] + | isFloatHsType hsTy && isFloatCPrimType pt = + return $ Just (withFloatConvIde, CHSIOArg) +lookupDftMarshIn "Bool" [PtrET (PrimET pt)] + | isIntegralCPrimType pt = + return $ Just (withFromBoolIde, CHSIOArg) +-- FIXME: handle array-list conversion +lookupDftMarshIn _ _ = + return Nothing + +-- determine the default "out" marshaller for the given Haskell and C types +-- +lookupDftMarshOut :: String -> [ExtType] -> GB (Maybe (Ident, CHSArg)) +lookupDftMarshOut "()" _ = + return $ Just (voidIde, CHSVoidArg) +lookupDftMarshOut "Bool" [PrimET pt] | isIntegralCPrimType pt = + return $ Just (cToBoolIde, CHSValArg) +lookupDftMarshOut hsTy [PrimET pt] | isIntegralHsType hsTy + &&isIntegralCPrimType pt = + return $ Just (cIntConvIde, CHSValArg) +lookupDftMarshOut hsTy [PrimET pt] | isFloatHsType hsTy + &&isFloatCPrimType pt = + return $ Just (cFloatConvIde, CHSValArg) +lookupDftMarshOut "String" [PtrET (PrimET CCharPT)] = + return $ Just (peekCStringIde, CHSIOArg) +lookupDftMarshOut "String" [PtrET (PrimET CCharPT), PrimET pt] + | isIntegralCPrimType pt = + return $ Just (peekCStringLenIde, CHSIOArg) +lookupDftMarshOut hsTy [PtrET ty] | showExtType ty == hsTy = + return $ Just (peekIde, CHSIOArg) +-- FIXME: add combination, such as "peek" plus "cIntConv" etc +-- FIXME: handle array-list conversion +lookupDftMarshOut _ _ = + return Nothing + + +-- check for integral Haskell types +-- +isIntegralHsType :: String -> Bool +isIntegralHsType "Int" = True +isIntegralHsType "Int8" = True +isIntegralHsType "Int16" = True +isIntegralHsType "Int32" = True +isIntegralHsType "Int64" = True +isIntegralHsType "Word8" = True +isIntegralHsType "Word16" = True +isIntegralHsType "Word32" = True +isIntegralHsType "Word64" = True +isIntegralHsType _ = False + +-- check for floating Haskell types +-- +isFloatHsType :: String -> Bool +isFloatHsType "Float" = True +isFloatHsType "Double" = True +isFloatHsType _ = False + +isVariadic :: ExtType -> Bool +isVariadic (FunET s t) = any isVariadic [s,t] +isVariadic (IOET t) = isVariadic t +isVariadic (PtrET t) = isVariadic t +isVariadic (VarFunET _) = True +isVariadic _ = False + +-- check for integral C types +-- +-- * For marshalling purposes C char's are integral types (see also types +-- classes for which the FFI guarantees instances for `CChar', `CSChar', and +-- `CUChar') +-- +isIntegralCPrimType :: CPrimType -> Bool +isIntegralCPrimType = (`elem` [CCharPT, CSCharPT, CIntPT, CShortPT, CLongPT, + CLLongPT, CUIntPT, CUCharPT, CUShortPT, + CULongPT, CULLongPT]) + +-- check for floating C types +-- +isFloatCPrimType :: CPrimType -> Bool +isFloatCPrimType = (`elem` [CFloatPT, CDoublePT, CLDoublePT]) + +-- standard conversions +-- +voidIde = noPosIdent "void" -- never appears in the output +cFromBoolIde = noPosIdent "cFromBool" +cToBoolIde = noPosIdent "cToBool" +cIntConvIde = noPosIdent "cIntConv" +cFloatConvIde = noPosIdent "cFloatConv" +withIde = noPosIdent "with" +withCStringIde = noPosIdent "withCString" +withCStringLenIde = noPosIdent "withCStringLenIntConv" +withIntConvIde = noPosIdent "withIntConv" +withFloatConvIde = noPosIdent "withFloatConv" +withFromBoolIde = noPosIdent "withFromBoolConv" +peekIde = noPosIdent "peek" +peekCStringIde = noPosIdent "peekCString" +peekCStringLenIde = noPosIdent "peekCStringLenIntConv" + + +-- expansion of binding hooks +-- -------------------------- + +-- given a C header file and a binding file, expand all hooks in the binding +-- file using the C header information (EXPORTED) +-- +-- * together with the module, returns the contents of the .chi file +-- +-- * if any error (not warnings) is encountered, a fatal error is raised. +-- +-- * also returns all warning messages encountered (last component of result) +-- +expandHooks :: AttrC -> CHSModule -> CST s (CHSModule, String, String) +expandHooks ac mod = do + (_, res) <- runCT (expandModule mod) ac initialGBState + return res + +expandModule :: CHSModule -> GB (CHSModule, String, String) +expandModule (CHSModule frags) = + do + -- expand hooks + -- + traceInfoExpand + frags' <- expandFrags frags + delayedFrags <- getDelayedCode + + -- get .chi dump + -- + chi <- dumpMaps + + -- check for errors and finalise + -- + errs <- errorsPresent + if errs + then do + traceInfoErr + errmsgs <- showErrors + fatal ("Errors during expansion of binding hooks:\n\n" -- fatal error + ++ errmsgs) + else do + traceInfoOK + warnmsgs <- showErrors + return (CHSModule (frags' ++ delayedFrags), chi, warnmsgs) + where + traceInfoExpand = putTraceStr tracePhasesSW + ("...expanding binding hooks...\n") + traceInfoErr = putTraceStr tracePhasesSW + ("...error(s) detected.\n") + traceInfoOK = putTraceStr tracePhasesSW + ("...successfully completed.\n") + +expandFrags :: [CHSFrag] -> GB [CHSFrag] +expandFrags = liftM concat . mapM expandFrag + +expandFrag :: CHSFrag -> GB [CHSFrag] +expandFrag verb@(CHSVerb _ _ ) = return [verb] +expandFrag line@(CHSLine _ ) = return [line] +expandFrag (CHSHook h ) = + do + code <- expandHook h + return [CHSVerb code builtinPos] + `ifCTExc` return [CHSVerb "** ERROR **" builtinPos] +expandFrag (CHSCPP s _ ) = + interr $ "GenBind.expandFrag: Left over CHSCPP!\n---\n" ++ s ++ "\n---" +expandFrag (CHSC s _ ) = + interr $ "GenBind.expandFrag: Left over CHSC!\n---\n" ++ s ++ "\n---" +expandFrag (CHSCond alts dft) = + do + traceInfoCond + select alts + where + select [] = do + traceInfoDft dft + expandFrags (maybe [] id dft) + select ((ide, frags):alts) = do + oobj <- findTag ide + traceInfoVal ide oobj + if isNothing oobj + then + select alts + else -- found right alternative + expandFrags frags + -- + traceInfoCond = traceGenBind "** CPP conditional:\n" + traceInfoVal ide oobj = traceGenBind $ identToLexeme ide ++ " is " ++ + (if isNothing oobj then "not " else "") ++ + "defined.\n" + traceInfoDft dft = if isNothing dft + then + return () + else + traceGenBind "Choosing else branch.\n" + +expandHook :: CHSHook -> GB String +expandHook (CHSImport qual ide chi _) = + do + mergeMaps chi + return $ + "import " ++ (if qual then "qualified " else "") ++ identToLexeme ide +expandHook (CHSContext olib oprefix _) = + do + setContext olib oprefix -- enter context information + mapMaybeM_ applyPrefixToNameSpaces oprefix -- use the prefix on name spaces + return "" +expandHook (CHSType ide pos) = + do + traceInfoType + decl <- findAndChaseDecl ide False True -- no indirection, but shadows + ty <- extractSimpleType False pos decl + traceInfoDump decl ty + when (isVariadic ty) (variadicErr pos (posOf decl)) + return $ "(" ++ showExtType ty ++ ")" + where + traceInfoType = traceGenBind "** Type hook:\n" + traceInfoDump decl ty = traceGenBind $ + "Declaration\n" ++ show decl ++ "\ntranslates to\n" + ++ showExtType ty ++ "\n" +expandHook (CHSSizeof ide pos) = + do + traceInfoSizeof + decl <- findAndChaseDecl ide False True -- no indirection, but shadows + (size, _) <- sizeAlignOf decl + traceInfoDump decl size + return $ show (fromIntegral . padBits $ size) + where + traceInfoSizeof = traceGenBind "** Sizeof hook:\n" + traceInfoDump decl size = traceGenBind $ + "Size of declaration\n" ++ show decl ++ "\nis " + ++ show (fromIntegral . padBits $ size) ++ "\n" +expandHook (CHSEnum cide oalias chsTrans oprefix derive _) = + do + -- get the corresponding C declaration + -- + enum <- lookupEnum cide True -- smart lookup incl error handling + -- + -- convert the translation table and generate data type definition code + -- + gprefix <- getPrefix + let prefix = case oprefix of + Nothing -> gprefix + Just pref -> pref + + let trans = transTabToTransFun prefix chsTrans + hide = identToLexeme . fromMaybe cide $ oalias + enumDef enum hide trans (map identToLexeme derive) +expandHook hook@(CHSCall isPure isUns (CHSRoot ide) oalias pos) = + do + traceEnter + -- get the corresponding C declaration; raises error if not found or not a + -- function; we use shadow identifiers, so the returned identifier is used + -- afterwards instead of the original one + -- + (ObjCO cdecl, ide) <- findFunObj ide True + let ideLexeme = identToLexeme ide -- orignal name might have been a shadow + hsLexeme = ideLexeme `maybe` identToLexeme $ oalias + cdecl' = ide `simplifyDecl` cdecl + callImport hook isPure isUns ideLexeme hsLexeme cdecl' pos + return hsLexeme + where + traceEnter = traceGenBind $ + "** Call hook for `" ++ identToLexeme ide ++ "':\n" +expandHook hook@(CHSCall isPure isUns apath oalias pos) = + do + traceEnter + + (decl, offsets) <- accessPath apath + ptrTy <- extractSimpleType False pos decl + ty <- case ptrTy of + PtrET f@(FunET _ _) -> return f + _ -> funPtrExpectedErr pos + + traceValueType ty + set_get <- setGet pos CHSGet offsets ptrTy + + -- get the corresponding C declaration; raises error if not found or not a + -- function; we use shadow identifiers, so the returned identifier is used + -- afterwards instead of the original one + -- + -- (ObjCO cdecl, ide) <- findFunObj ide True + let ideLexeme = identToLexeme $ apathToIdent apath + hsLexeme = ideLexeme `maybe` identToLexeme $ oalias + -- cdecl' = ide `simplifyDecl` cdecl + args = concat [ " x" ++ show n | n <- [1..numArgs ty] ] + + callImportDyn hook isPure isUns ideLexeme hsLexeme ty pos + return $ "(\\o" ++ args ++ " -> " ++ set_get ++ " o >>= \\f -> " + ++ hsLexeme ++ " f" ++ args ++ ")" + where + traceEnter = traceGenBind $ + "** Indirect call hook for `" ++ identToLexeme (apathToIdent apath) ++ "':\n" + traceValueType et = traceGenBind $ + "Type of accessed value: " ++ showExtType et ++ "\n" +expandHook hook@(CHSFun isPure isUns (CHSRoot ide) oalias ctxt parms parm pos) = + do + traceEnter + -- get the corresponding C declaration; raises error if not found or not a + -- function; we use shadow identifiers, so the returned identifier is used + -- afterwards instead of the original one + -- + (ObjCO cdecl, cide) <- findFunObj ide True + let ideLexeme = identToLexeme ide -- orignal name might have been a shadow + hsLexeme = ideLexeme `maybe` identToLexeme $ oalias + fiLexeme = hsLexeme ++ "'_" -- *Urgh* - probably unqiue... + fiIde = onlyPosIdent nopos fiLexeme + cdecl' = cide `simplifyDecl` cdecl + callHook = CHSCall isPure isUns (CHSRoot cide) (Just fiIde) pos + callImport callHook isPure isUns (identToLexeme cide) fiLexeme cdecl' pos + + extTy <- extractFunType pos cdecl' True + funDef isPure hsLexeme fiLexeme extTy ctxt parms parm Nothing pos + where + traceEnter = traceGenBind $ + "** Fun hook for `" ++ identToLexeme ide ++ "':\n" +expandHook hook@(CHSFun isPure isUns apath oalias ctxt parms parm pos) = + do + traceEnter + + (decl, offsets) <- accessPath apath + ptrTy <- extractSimpleType False pos decl + ty <- case ptrTy of + PtrET f@(FunET _ _) -> return f + _ -> funPtrExpectedErr pos + + traceValueType ty + + -- get the corresponding C declaration; raises error if not found or not a + -- function; we use shadow identifiers, so the returned identifier is used + -- afterwards instead of the original one + -- + -- (ObjCO cdecl, cide) <- findFunObj ide True + let ideLexeme = identToLexeme $ apathToIdent apath + hsLexeme = ideLexeme `maybe` identToLexeme $ oalias + fiLexeme = hsLexeme ++ "'_" -- *Urgh* - probably unqiue... + fiIde = onlyPosIdent nopos fiLexeme + -- cdecl' = cide `simplifyDecl` cdecl + args = concat [ " x" ++ show n | n <- [1..numArgs ty] ] + callHook = CHSCall isPure isUns apath (Just fiIde) pos + callImportDyn callHook isPure isUns ideLexeme fiLexeme ty pos + + set_get <- setGet pos CHSGet offsets ptrTy + funDef isPure hsLexeme fiLexeme (FunET ptrTy $ purify ty) + ctxt parms parm (Just set_get) pos + where + -- remove IO from the result type of a function ExtType. necessary + -- due to an unexpected interaction with the way funDef works + purify (FunET a b) = FunET a (purify b) + purify (IOET b) = b + purify a = a + + traceEnter = traceGenBind $ + "** Fun hook for `" ++ identToLexeme (apathToIdent apath) ++ "':\n" + traceValueType et = traceGenBind $ + "Type of accessed value: " ++ showExtType et ++ "\n" +expandHook (CHSField access path pos) = + do + traceInfoField + (decl, offsets) <- accessPath path + traceDepth offsets + ty <- extractSimpleType False pos decl + traceValueType ty + setGet pos access offsets ty + where + accessString = case access of + CHSGet -> "Get" + CHSSet -> "Set" + traceInfoField = traceGenBind $ "** " ++ accessString ++ " hook:\n" + traceDepth offsets = traceGenBind $ "Depth of access path: " + ++ show (length offsets) ++ "\n" + traceValueType et = traceGenBind $ + "Type of accessed value: " ++ showExtType et ++ "\n" +expandHook (CHSPointer isStar cName oalias ptrKind isNewtype oRefType emit + pos) = + do + traceInfoPointer + let hsIde = fromMaybe cName oalias + hsName = identToLexeme hsIde + hsIde `objIs` Pointer ptrKind isNewtype -- register Haskell object + -- + -- we check for a typedef declaration or tag (struct, union, or enum) + -- + declOrTag <- lookupDeclOrTag cName True + case declOrTag of + Left cdecl -> do -- found a typedef declaration + cNameFull <- case declaredName cdecl of + Just ide -> return ide + Nothing -> interr + "GenBind.expandHook: Where is the name?" + cNameFull `refersToNewDef` ObjCD (TypeCO cdecl) + -- assoc needed for chasing + traceInfoCName "declaration" cNameFull + unless (isStar || isPtrDecl cdecl) $ + ptrExpectedErr (posOf cName) + (hsType, isFun) <- + case oRefType of + Nothing -> do + cDecl <- chaseDecl cNameFull (not isStar) + et <- extractPtrType cDecl + traceInfoPtrType et + let et' = adjustPtr isStar et + when (isVariadic et') + (variadicErr pos (posOf cDecl)) + return (showExtType et', isFunExtType et') + Just hsType -> return (identToLexeme hsType, False) + -- FIXME: it is not possible to determine whether `hsType' + -- is a function; we would need to extend the syntax to + -- allow `... -> fun HSTYPE' to explicitly mark function + -- types if this ever becomes important + traceInfoHsType hsName hsType + pointerDef isStar cNameFull hsName ptrKind isNewtype hsType isFun emit + Right tag -> do -- found a tag definition + let cNameFull = tagName tag + traceInfoCName "tag definition" cNameFull + unless isStar $ -- tags need an explicit `*' + ptrExpectedErr (posOf cName) + let hsType = case oRefType of + Nothing -> "()" + Just hsType -> identToLexeme hsType + traceInfoHsType hsName hsType + pointerDef isStar cNameFull hsName ptrKind isNewtype hsType False emit + where + -- remove a pointer level if the first argument is `False' + -- + adjustPtr True et = et + adjustPtr False (PtrET et) = et + adjustPtr False et@(DefinedET _ _) = + interr "GenBind.adjustPtr: Can't adjust defined type" + adjustPtr _ _ = + interr "GenBind.adjustPtr: Where is the Ptr?" + -- + traceInfoPointer = traceGenBind "** Pointer hook:\n" + traceInfoPtrType et = traceGenBind $ + "extracted ptr type is `" ++ showExtType et ++ "'\n" + traceInfoHsType name ty = traceGenBind $ + "associated with Haskell entity `" ++ name ++ "'\nhaving type " ++ ty + ++ "\n" + traceInfoCName kind ide = traceGenBind $ + "found C " ++ kind ++ " for `" ++ identToLexeme ide ++ "'\n" +expandHook (CHSClass oclassIde classIde typeIde pos) = + do + traceInfoClass + classIde `objIs` Class oclassIde typeIde -- register Haskell object + superClasses <- collectClasses oclassIde + Pointer ptrType isNewtype <- queryPointer typeIde + when (ptrType == CHSStablePtr) $ + illegalStablePtrErr pos + classDef pos (identToLexeme classIde) (identToLexeme typeIde) + ptrType isNewtype superClasses + where + -- compile a list of all super classes (the direct super class first) + -- + collectClasses :: Maybe Ident -> GB [(String, String, HsObject)] + collectClasses Nothing = return [] + collectClasses (Just ide) = + do + Class oclassIde typeIde <- queryClass ide + ptr <- queryPointer typeIde + classes <- collectClasses oclassIde + return $ (identToLexeme ide, identToLexeme typeIde, ptr) : classes + -- + traceInfoClass = traceGenBind $ "** Class hook:\n" + +-- produce code for an enumeration +-- +-- * an extra instance declaration is required when any of the enumeration +-- constants is explicitly assigned a value in its definition +-- +-- * the translation function strips prefixes where possible (different +-- enumerators maye have different prefixes) +-- +enumDef :: CEnum -> String -> TransFun -> [String] -> GB String +enumDef cenum@(CEnum _ list _) hident trans userDerive = + do + (list', enumAuto) <- evalTagVals list + let enumVals = [(trans ide, cexpr) | (ide, cexpr) <- list'] -- translate + defHead = enumHead hident + defBody = enumBody (length defHead - 2) enumVals + inst = makeDerives + (if enumAuto then "Enum" : userDerive else userDerive) ++ + if enumAuto then "\n" else "\n" ++ enumInst hident enumVals + return $ defHead ++ defBody ++ inst + where + cpos = posOf cenum + -- + evalTagVals [] = return ([], True) + evalTagVals ((ide, Nothing ):list) = + do + (list', derived) <- evalTagVals list + return ((ide, Nothing):list', derived) + evalTagVals ((ide, Just exp):list) = + do + (list', derived) <- evalTagVals list + val <- evalConstCExpr exp + case val of + IntResult val' -> + return ((ide, Just $ CConst (CIntConst val' at1) at2):list', + False) + FloatResult _ -> + illegalConstExprErr (posOf exp) "a float result" + where + at1 = newAttrsOnlyPos nopos + at2 = newAttrsOnlyPos nopos + makeDerives [] = "" + makeDerives dList = "deriving (" ++ concat (intersperse "," dList) ++")" + +-- Haskell code for the head of an enumeration definition +-- +enumHead :: String -> String +enumHead ident = "data " ++ ident ++ " = " + +-- Haskell code for the body of an enumeration definition +-- +enumBody :: Int -> [(String, Maybe CExpr)] -> String +enumBody indent [] = "" +enumBody indent ((ide, _):list) = + ide ++ "\n" ++ replicate indent ' ' + ++ (if null list then "" else "| " ++ enumBody indent list) + +-- Haskell code for an instance declaration for `Enum' +-- +-- * the expression of all explicitly specified tag values already have to be +-- in normal form, ie, to be an int constant +-- +-- * enumerations start at 0 and whenever an explicit value is specified, +-- following tags are assigned values continuing from the explicitly +-- specified one +-- +enumInst :: String -> [(String, Maybe CExpr)] -> String +enumInst ident list = + "instance Enum " ++ ident ++ " where\n" + ++ fromDef list 0 ++ "\n" ++ toDef list 0 + where + fromDef [] _ = "" + fromDef ((ide, exp):list) n = + " fromEnum " ++ ide ++ " = " ++ show' val ++ "\n" + ++ fromDef list (val + 1) + where + val = case exp of + Nothing -> n + Just (CConst (CIntConst m _) _) -> m + Just _ -> + interr "GenBind.enumInst: Integer constant expected!" + -- + show' x = if x < 0 then "(" ++ show x ++ ")" else show x + -- + toDef [] _ = + " toEnum unmatched = error (\"" ++ ident + ++ ".toEnum: Cannot match \" ++ show unmatched)\n" + toDef ((ide, exp):list) n = + " toEnum " ++ show' val ++ " = " ++ ide ++ "\n" + ++ toDef list (val + 1) + where + val = case exp of + Nothing -> n + Just (CConst (CIntConst m _) _) -> m + Just _ -> + interr "GenBind.enumInst: Integer constant expected!" + -- + show' x = if x < 0 then "(" ++ show x ++ ")" else show x + +-- generate a foreign import declaration that is put into the delayed code +-- +-- * the C declaration is a simplified declaration of the function that we +-- want to import into Haskell land +-- +callImport :: CHSHook -> Bool -> Bool -> String -> String -> CDecl -> Position + -> GB () +callImport hook isPure isUns ideLexeme hsLexeme cdecl pos = + do + -- compute the external type from the declaration, and delay the foreign + -- export declaration + -- + extType <- extractFunType pos cdecl isPure + header <- getSwitch headerSB + when (isVariadic extType) (variadicErr pos (posOf cdecl)) + delayCode hook (foreignImport header ideLexeme hsLexeme isUns extType) + traceFunType extType + where + traceFunType et = traceGenBind $ + "Imported function type: " ++ showExtType et ++ "\n" + +callImportDyn :: CHSHook -> Bool -> Bool -> String -> String -> ExtType + -> Position -> GB () +callImportDyn hook isPure isUns ideLexeme hsLexeme ty pos = + do + -- compute the external type from the declaration, and delay the foreign + -- export declaration + -- + when (isVariadic ty) (variadicErr pos pos) -- FIXME? (posOf cdecl)) + delayCode hook (foreignImportDyn ideLexeme hsLexeme isUns ty) + traceFunType ty + where + traceFunType et = traceGenBind $ + "Imported function type: " ++ showExtType et ++ "\n" + +-- Haskell code for the foreign import declaration needed by a call hook +-- +foreignImport :: String -> String -> String -> Bool -> ExtType -> String +foreignImport header ident hsIdent isUnsafe ty = + "foreign import ccall " ++ safety ++ " " ++ show (header ++ " " ++ ident) ++ + "\n " ++ hsIdent ++ " :: " ++ showExtType ty ++ "\n" + where + safety = if isUnsafe then "unsafe" else "safe" + +-- Haskell code for the foreign import dynamic declaration needed by a call hook +-- +foreignImportDyn :: String -> String -> Bool -> ExtType -> String +foreignImportDyn ident hsIdent isUnsafe ty = + "foreign import ccall " ++ safety ++ " \"dynamic\"\n " ++ + hsIdent ++ " :: FunPtr( " ++ showExtType ty ++ " ) -> " ++ + showExtType ty ++ "\n" + where + safety = if isUnsafe then "unsafe" else "safe" + +-- produce a Haskell function definition for a fun hook +-- +-- * FIXME: There's an ugly special case in here: to support dynamic fun hooks +-- I had to add a special second marshaller for the first argument, +-- which, if present, is inserted just before the function call. This +-- is probably not the most elegant solution, it's just the only one I +-- can up with at the moment. If present, this special marshaller is +-- an io action (like 'peek' and unlike 'with'). -- US + +funDef :: Bool -- pure function? + -> String -- name of the new Haskell function + -> String -- Haskell name of the foreign imported C function + -> ExtType -- simplified declaration of the C function + -> Maybe String -- type context of the new Haskell function + -> [CHSParm] -- parameter marshalling description + -> CHSParm -- result marshalling description + -> Maybe String -- optional additional marshaller for first arg + -> Position -- source location of the hook + -> GB String -- Haskell code in text form +funDef isPure hsLexeme fiLexeme extTy octxt parms parm marsh2 pos = + do + (parms', parm', isImpure) <- addDftMarshaller pos parms parm extTy + + traceMarsh parms' parm' isImpure + let + sig = hsLexeme ++ " :: " ++ funTy parms' parm' ++ "\n" + marshs = [marshArg i parm | (i, parm) <- zip [1..] parms'] + funArgs = [funArg | (funArg, _, _, _, _) <- marshs, funArg /= ""] + marshIns = [marshIn | (_, marshIn, _, _, _) <- marshs] + callArgs = [callArg | (_, _, cs, _, _) <- marshs, callArg <- cs] + marshOuts = [marshOut | (_, _, _, marshOut, _) <- marshs, marshOut /= ""] + retArgs = [retArg | (_, _, _, _, retArg) <- marshs, retArg /= ""] + funHead = hsLexeme ++ join funArgs ++ " =\n" ++ + if isPure && isImpure then " unsafePerformIO $\n" else "" + call = if isPure + then " let {res = " ++ fiLexeme ++ joinCallArgs ++ "} in\n" + else " " ++ fiLexeme ++ joinCallArgs ++ " >>= \\res ->\n" + joinCallArgs = case marsh2 of + Nothing -> join callArgs + Just _ -> join ("b1'" : drop 1 callArgs) + mkMarsh2 = case marsh2 of + Nothing -> "" + Just m -> " " ++ m ++ " " ++ + join (take 1 callArgs) ++ + " >>= \\b1' ->\n" + marshRes = case parm' of + CHSParm _ _ twoCVal (Just (_ , CHSVoidArg)) _ -> "" + CHSParm _ _ twoCVal (Just (omIde, CHSIOVoidArg)) _ -> + " " ++ identToLexeme omIde ++ " res >> \n" + CHSParm _ _ twoCVal (Just (omIde, CHSIOArg )) _ -> + " " ++ identToLexeme omIde ++ " res >>= \\res' ->\n" + CHSParm _ _ twoCVal (Just (omIde, CHSValArg )) _ -> + " let {res' = " ++ identToLexeme omIde ++ " res} in\n" + CHSParm _ _ _ Nothing _ -> + interr "GenBind.funDef: marshRes: no default?" + retArgs' = case parm' of + CHSParm _ _ _ (Just (_, CHSVoidArg)) _ -> retArgs + CHSParm _ _ _ (Just (_, CHSIOVoidArg)) _ -> retArgs + _ -> "res'":retArgs + ret = "(" ++ concat (intersperse ", " retArgs') ++ ")" + funBody = joinLines marshIns ++ + mkMarsh2 ++ + call ++ + joinLines marshOuts ++ + marshRes ++ + " " ++ + (if isImpure || not isPure then "return " else "") ++ ret + return $ sig ++ funHead ++ funBody + where + join = concatMap (' ':) + joinLines = concatMap (\s -> " " ++ s ++ "\n") + -- + -- construct the function type + -- + -- * specified types appear in the argument and result only if their "in" + -- and "out" marshaller, respectively, is not the `void' marshaller + -- + funTy parms parm = + let + ctxt = case octxt of + Nothing -> "" + Just ctxtStr -> ctxtStr ++ " => " + argTys = [ty | CHSParm im ty _ _ _ <- parms , notVoid im] + resTys = [ty | CHSParm _ ty _ om _ <- parm:parms, notVoid om] + resTup = let + (lp, rp) = if isPure && length resTys == 1 + then ("", "") + else ("(", ")") + io = if isPure then "" else "IO " + in + io ++ lp ++ concat (intersperse ", " resTys) ++ rp + + in + ctxt ++ concat (intersperse " -> " (argTys ++ [resTup])) + where + notVoid Nothing = interr "GenBind.funDef: \ + \No default marshaller?" + notVoid (Just (_, kind)) = kind /= CHSVoidArg && kind /= CHSIOVoidArg + -- + -- for an argument marshaller, generate all "in" and "out" marshalling + -- code fragments + -- + marshArg i (CHSParm (Just (imIde, imArgKind)) _ twoCVal + (Just (omIde, omArgKind)) _ ) = + let + a = "a" ++ show i + imStr = identToLexeme imIde + imApp = imStr ++ " " ++ a + funArg = if imArgKind == CHSVoidArg then "" else a + inBndr = if twoCVal + then "(" ++ a ++ "'1, " ++ a ++ "'2)" + else a ++ "'" + marshIn = case imArgKind of + CHSVoidArg -> imStr ++ " $ \\" ++ inBndr ++ " -> " + CHSIOArg -> imApp ++ " $ \\" ++ inBndr ++ " -> " + CHSValArg -> "let {" ++ inBndr ++ " = " ++ + imApp ++ "} in " + callArgs = if twoCVal + then [a ++ "'1 ", a ++ "'2"] + else [a ++ "'"] + omApp = identToLexeme omIde ++ join callArgs + outBndr = a ++ "''" + marshOut = case omArgKind of + CHSVoidArg -> "" + CHSIOVoidArg -> omApp ++ ">>" + CHSIOArg -> omApp ++ ">>= \\" ++ outBndr ++ " -> " + CHSValArg -> "let {" ++ outBndr ++ " = " ++ + omApp ++ "} in " + retArg = if omArgKind == CHSVoidArg || omArgKind == CHSIOVoidArg then "" else outBndr + in + (funArg, marshIn, callArgs, marshOut, retArg) + marshArg _ _ = interr "GenBind.funDef: Missing default?" + -- + traceMarsh parms parm isImpure = traceGenBind $ + "Marshalling specification including defaults: \n" ++ + showParms (parms ++ [parm]) "" ++ + " The marshalling is " ++ if isImpure then "impure.\n" else "pure.\n" + where + showParms [] = id + showParms (parm:parms) = showString " " + . showCHSParm parm + . showChar '\n' + . showParms parms + +-- add default marshallers for "in" and "out" marshalling +-- +addDftMarshaller :: Position -> [CHSParm] -> CHSParm -> ExtType + -> GB ([CHSParm], CHSParm, Bool) +addDftMarshaller pos parms parm extTy = do + let (resTy, argTys) = splitFunTy extTy + (parm' , isImpure1) <- checkResMarsh parm resTy + (parms', isImpure2) <- addDft parms argTys + return (parms', parm', isImpure1 || isImpure2) + where + -- the result marshalling may not use an "in" marshaller and can only have + -- one C value + -- + -- * a default marshaller maybe used for "out" marshalling + -- + checkResMarsh (CHSParm (Just _) _ _ _ pos) _ = + resMarshIllegalInErr pos + checkResMarsh (CHSParm _ _ True _ pos) _ = + resMarshIllegalTwoCValErr pos + checkResMarsh (CHSParm _ ty _ omMarsh pos) cTy = do + (imMarsh', _ ) <- addDftVoid Nothing + (omMarsh', isImpure) <- addDftOut pos omMarsh ty [cTy] + return (CHSParm imMarsh' ty False omMarsh' pos, isImpure) + -- + splitFunTy (FunET UnitET ty ) = splitFunTy ty + splitFunTy (FunET ty1 ty2) = let + (resTy, argTys) = splitFunTy ty2 + in + (resTy, ty1:argTys) + splitFunTy resTy = (resTy, []) + -- + -- match Haskell with C arguments (and results) + -- + addDft ((CHSParm imMarsh hsTy False omMarsh p):parms) (cTy :cTys) = do + (imMarsh', isImpureIn ) <- addDftIn p imMarsh hsTy [cTy] + (omMarsh', isImpureOut) <- addDftVoid omMarsh + (parms' , isImpure ) <- addDft parms cTys + return (CHSParm imMarsh' hsTy False omMarsh' p : parms', + isImpure || isImpureIn || isImpureOut) + addDft ((CHSParm imMarsh hsTy True omMarsh p):parms) (cTy1:cTy2:cTys) = do + (imMarsh', isImpureIn ) <- addDftIn p imMarsh hsTy [cTy1, cTy2] + (omMarsh', isImpureOut) <- addDftVoid omMarsh + (parms' , isImpure ) <- addDft parms cTys + return (CHSParm imMarsh' hsTy True omMarsh' p : parms', + isImpure || isImpureIn || isImpureOut) + addDft [] [] = + return ([], False) + addDft ((CHSParm _ _ _ _ pos):parms) [] = + marshArgMismatchErr pos "This parameter is in excess of the C arguments." + addDft [] (_:_) = + marshArgMismatchErr pos "Parameter marshallers are missing." + -- + addDftIn _ imMarsh@(Just (_, kind)) _ _ = return (imMarsh, + kind == CHSIOArg) + addDftIn pos imMarsh@Nothing hsTy cTys = do + marsh <- lookupDftMarshIn hsTy cTys + when (isNothing marsh) $ + noDftMarshErr pos "\"in\"" hsTy cTys + return (marsh, case marsh of {Just (_, kind) -> kind == CHSIOArg}) + -- + addDftOut _ omMarsh@(Just (_, kind)) _ _ = return (omMarsh, + kind == CHSIOArg) + addDftOut pos omMarsh@Nothing hsTy cTys = do + marsh <- lookupDftMarshOut hsTy cTys + when (isNothing marsh) $ + noDftMarshErr pos "\"out\"" hsTy cTys + return (marsh, case marsh of {Just (_, kind) -> kind == CHSIOArg}) + -- + -- add void marshaller if no explict one is given + -- + addDftVoid marsh@(Just (_, kind)) = return (marsh, kind == CHSIOArg) + addDftVoid Nothing = do + return (Just (noPosIdent "void", CHSVoidArg), False) + +-- compute from an access path, the declarator finally accessed and the index +-- path required for the access +-- +-- * each element in the index path specifies dereferencing an address and the +-- offset to be added to the address before dereferencing +-- +-- * the returned declaration is already normalised (ie, alias have been +-- expanded) +-- +-- * it may appear as if `t.m' and `t->m' should have different access paths, +-- as the latter specifies one more dereferencing; this is certainly true in +-- C, but it doesn't apply here, as `t.m' is merely provided for the +-- convenience of the interface writer - it is strictly speaking an +-- impossible access paths, as in Haskell we always have a pointer to a +-- structure, we can never have the structure as a value itself +-- +accessPath :: CHSAPath -> GB (CDecl, [BitSize]) +accessPath (CHSRoot ide) = -- t + do + decl <- findAndChaseDecl ide False True + return (ide `simplifyDecl` decl, [BitSize 0 0]) +accessPath (CHSDeref (CHSRoot ide) _) = -- *t + do + decl <- findAndChaseDecl ide True True + return (ide `simplifyDecl` decl, [BitSize 0 0]) +accessPath (CHSRef root@(CHSRoot ide1) ide2) = -- t.m + do + su <- lookupStructUnion ide1 False True + (offset, decl') <- refStruct su ide2 + adecl <- replaceByAlias decl' + return (adecl, [offset]) +accessPath (CHSRef (CHSDeref (CHSRoot ide1) _) ide2) = -- t->m + do + su <- lookupStructUnion ide1 True True + (offset, decl') <- refStruct su ide2 + adecl <- replaceByAlias decl' + return (adecl, [offset]) +accessPath (CHSRef path ide) = -- a.m + do + (decl, offset:offsets) <- accessPath path + assertPrimDeclr ide decl + su <- structFromDecl (posOf ide) decl + (addOffset, decl') <- refStruct su ide + adecl <- replaceByAlias decl' + return (adecl, offset `addBitSize` addOffset : offsets) + where + assertPrimDeclr ide (CDecl _ [declr] _) = + case declr of + (Just (CVarDeclr _ _), _, _) -> return () + _ -> structExpectedErr ide +accessPath (CHSDeref path pos) = -- *a + do + (decl, offsets) <- accessPath path + decl' <- derefOrErr decl + adecl <- replaceByAlias decl' + return (adecl, BitSize 0 0 : offsets) + where + derefOrErr (CDecl specs [declr] at) = + case declr of + (Just (CPtrDeclr [_] declr at), oinit, oexpr) -> + return $ CDecl specs [(Just declr, oinit, oexpr)] at + (Just (CPtrDeclr (_:quals) declr at), oinit, oexpr) -> + return $ + CDecl specs [(Just (CPtrDeclr quals declr at), oinit, oexpr)] at + _ -> + ptrExpectedErr pos + +-- replaces a decleration by its alias if any +-- +-- * the alias inherits any field size specification that the original +-- declaration may have +-- +-- * declaration must have exactly one declarator +-- +replaceByAlias :: CDecl -> GB CDecl +replaceByAlias cdecl@(CDecl _ [(_, _, size)] at) = + do + ocdecl <- checkForAlias cdecl + case ocdecl of + Nothing -> return cdecl + Just (CDecl specs [(declr, init, _)] at) -> -- form of an alias + return $ CDecl specs [(declr, init, size)] at + +-- given a structure declaration and member name, compute the offset of the +-- member in the structure and the declaration of the referenced member +-- +refStruct :: CStructUnion -> Ident -> GB (BitSize, CDecl) +refStruct su ide = + do + -- get the list of fields and check for our selector + -- + let (fields, tag) = structMembers su + (pre, post) = span (not . flip declNamed ide) fields + when (null post) $ + unknownFieldErr (posOf su) ide + -- + -- get sizes of preceding fields and the result type (`pre' are all + -- declarators preceding `ide' and the first declarator in `post' defines + -- `ide') + -- + let decl = head post + offset <- case tag of + CStructTag -> offsetInStruct pre decl tag + CUnionTag -> return $ BitSize 0 0 + return (offset, decl) + +-- does the given declarator define the given name? +-- +declNamed :: CDecl -> Ident -> Bool +(CDecl _ [(Nothing , _, _)] _) `declNamed` ide = False +(CDecl _ [(Just declr, _, _)] _) `declNamed` ide = declr `declrNamed` ide +(CDecl _ [] _) `declNamed` _ = + interr "GenBind.declNamed: Abstract declarator in structure!" +_ `declNamed` _ = + interr "GenBind.declNamed: More than one declarator!" + +-- Haskell code for writing to or reading from a struct +-- +setGet :: Position -> CHSAccess -> [BitSize] -> ExtType -> GB String +setGet pos access offsets ty = + do + let pre = case access of + CHSSet -> "(\\ptr val -> do {" + CHSGet -> "(\\ptr -> do {" + body <- setGetBody (reverse offsets) + return $ pre ++ body ++ "})" + where + setGetBody [BitSize offset bitOffset] = + do + let tyTag = showExtType ty + bf <- checkType ty + case bf of + Nothing -> return $ case access of -- not a bitfield + CHSGet -> peekOp offset tyTag + CHSSet -> pokeOp offset tyTag "val" +--FIXME: must take `bitfieldDirection' into account + Just (_, bs) -> return $ case access of -- a bitfield + CHSGet -> "val <- " ++ peekOp offset tyTag + ++ extractBitfield + CHSSet -> "org <- " ++ peekOp offset tyTag + ++ insertBitfield + ++ pokeOp offset tyTag "val'" + where + -- we have to be careful here to ensure proper sign extension; + -- in particular, shifting right followed by anding a mask is + -- *not* sufficient; instead, we exploit in the following that + -- `shiftR' performs sign extension + -- + extractBitfield = "; return $ (val `shiftL` (" + ++ bitsPerField ++ " - " + ++ show (bs + bitOffset) ++ ")) `shiftR` (" + ++ bitsPerField ++ " - " ++ show bs + ++ ")" + bitsPerField = show $ size CIntPT * 8 + -- + insertBitfield = "; let {val' = (org .&. " ++ middleMask + ++ ") .|. (val `shiftL` " + ++ show bitOffset ++ ")}; " + middleMask = "fromIntegral (((maxBound::CUInt) `shiftL` " + ++ show bs ++ ") `rotateL` " + ++ show bitOffset ++ ")" + setGetBody (BitSize offset 0 : offsets) = + do + code <- setGetBody offsets + return $ "ptr <- peekByteOff ptr " ++ show offset ++ "; " ++ code + setGetBody (BitSize _ _ : _ ) = + derefBitfieldErr pos + -- + -- check that the type can be marshalled and compute extra operations for + -- bitfields + -- + checkType (VarFunET _ ) = variadicErr pos pos + checkType (IOET _ ) = interr "GenBind.setGet: Illegal \ + \type!" + checkType (UnitET ) = voidFieldErr pos + checkType (DefinedET _ _ ) = return Nothing-- can't check further + checkType (PrimET (CUFieldPT bs)) = return $ Just (False, bs) + checkType (PrimET (CSFieldPT bs)) = return $ Just (True , bs) + checkType _ = return Nothing + -- + peekOp off tyTag = "peekByteOff ptr " ++ show off ++ " ::IO " ++ tyTag + pokeOp off tyTag var = "pokeByteOff ptr " ++ show off ++ " (" ++ var + ++ "::" ++ tyTag ++ ")" + +-- generate the type definition for a pointer hook and enter the required type +-- mapping into the `ptrmap' +-- +pointerDef :: Bool -- explicit `*' in pointer hook + -> Ident -- full C name + -> String -- Haskell name + -> CHSPtrType -- kind of the pointer + -> Bool -- explicit newtype tag + -> String -- Haskell type expression of pointer argument + -> Bool -- do we have a pointer to a function? + -> Bool -- shall we emit code? + -> GB String +pointerDef isStar cNameFull hsName ptrKind isNewtype hsType isFun emit = + do + let ptrArg = if isNewtype + then hsName -- abstract type + else hsType -- concrete type + ptrCon = case ptrKind of + CHSPtr | isFun -> "FunPtr" + _ -> show ptrKind + ptrType = ptrCon ++ " (" ++ ptrArg ++ ")" + thePtr = (isStar, cNameFull) + case ptrKind of + CHSForeignPtr -> thePtr `ptrMapsTo` ("Ptr (" ++ ptrArg ++ ")", + "Ptr (" ++ ptrArg ++ ")") + _ -> thePtr `ptrMapsTo` (hsName, hsName) + return $ + case (emit, isNewtype) of + (False, _) -> "" -- suppress code generation + (True , True) -> + "newtype " ++ hsName ++ " = " ++ hsName ++ " (" ++ ptrType ++ ")" ++ + withForeignFun + (True , False) -> + "type " ++ hsName ++ " = " ++ ptrType + where + -- if we have a foreign pointer wrapped into a newtype, provide a + -- safe unwrapping function automatically + -- + withForeignFun + | ptrKind == CHSForeignPtr = + "\n" ++ + "with" ++ hsName ++ " (" ++ hsName ++ " fptr) = withForeignPtr fptr" + | otherwise = "" + +-- generate the class and instance definitions for a class hook +-- +-- * the pointer type must not be a stable pointer +-- +-- * the first super class (if present) must be the direct superclass +-- +-- * all Haskell objects in the superclass list must be pointer objects +-- +classDef :: Position -- for error messages + -> String -- class name + -> String -- pointer type name + -> CHSPtrType -- type of the pointer + -> Bool -- is a newtype? + -> [(String, String, HsObject)] -- superclasses + -> GB String +classDef pos className typeName ptrType isNewtype superClasses = + do + let + toMethodName = case typeName of + "" -> interr "GenBind.classDef: \ + \Illegal identifier!" + c:cs -> toLower c : cs + fromMethodName = "from" ++ typeName + classDefContext = case superClasses of + [] -> "" + (superName, _, _):_ -> superName ++ " p => " + classDef = + "class " ++ classDefContext ++ className ++ " p where\n" + ++ " " ++ toMethodName ++ " :: p -> " ++ typeName ++ "\n" + ++ " " ++ fromMethodName ++ " :: " ++ typeName ++ " -> p\n" + instDef = + "instance " ++ className ++ " " ++ typeName ++ " where\n" + ++ " " ++ toMethodName ++ " = id\n" + ++ " " ++ fromMethodName ++ " = id\n" + instDefs <- castInstDefs superClasses + return $ classDef ++ instDefs ++ instDef + where + castInstDefs [] = return "" + castInstDefs ((superName, ptrName, Pointer ptrType' isNewtype'):classes) = + do + unless (ptrType == ptrType') $ + pointerTypeMismatchErr pos className superName + let toMethodName = case ptrName of + "" -> interr "GenBind.classDef: \ + \Illegal identifier - 2!" + c:cs -> toLower c : cs + fromMethodName = "from" ++ ptrName + castFun = "cast" ++ show ptrType + typeConstr = if isNewtype then typeName ++ " " else "" + superConstr = if isNewtype' then ptrName ++ " " else "" + instDef = + "instance " ++ superName ++ " " ++ typeName ++ " where\n" + ++ " " ++ toMethodName ++ " (" ++ typeConstr ++ "p) = " + ++ superConstr ++ "(" ++ castFun ++ " p)\n" + ++ " " ++ fromMethodName ++ " (" ++ superConstr ++ "p) = " + ++ typeConstr ++ "(" ++ castFun ++ " p)\n" + instDefs <- castInstDefs classes + return $ instDef ++ instDefs + + +-- C code computations +-- ------------------- + +-- the result of a constant expression +-- +data ConstResult = IntResult Integer + | FloatResult Float + +-- types that may occur in foreign declarations, ie, Haskell land types +-- +-- * we reprsent C functions with no arguments (ie, the ANSI C `void' +-- argument) by `FunET UnitET res' rather than just `res' internally, +-- although the latter representation is finally emitted into the binding +-- file; this is because we need to know which types are functions (in +-- particular, to distinguish between `Ptr a' and `FunPtr a') +-- +-- * aliased types (`DefinedET') are represented by a string plus their C +-- declaration; the latter is for functions interpreting the following +-- structure; an aliased type is always a pointer type that is contained in +-- the pointer map (and got there either from a .chi or from a pointer hook +-- in the same module) +-- +-- * the representation for pointers does not distinguish between normal, +-- function, foreign, and stable pointers; function pointers are identified +-- by their argument and foreign and stable pointers are only used +-- indirectly, by referring to type names introduced by a `pointer' hook +-- +data ExtType = FunET ExtType ExtType -- function + | IOET ExtType -- operation with side effect + | PtrET ExtType -- typed pointer + | DefinedET CDecl String -- aliased type + | PrimET CPrimType -- basic C type + | UnitET -- void + | VarFunET ExtType -- variadic function + +instance Eq ExtType where + (FunET t1 t2) == (FunET t1' t2') = t1 == t1' && t2 == t2' + (IOET t ) == (IOET t' ) = t == t' + (PtrET t ) == (PtrET t' ) = t == t' + (DefinedET _ s ) == (DefinedET _ s' ) = s == s' + (PrimET t ) == (PrimET t' ) = t == t' + (VarFunET t ) == (VarFunET t' ) = t == t' + UnitET == UnitET = True + +-- composite C type +-- +data CompType = ExtType ExtType -- external type + | SUType CStructUnion -- structure or union + +-- check whether an external type denotes a function type +-- +isFunExtType :: ExtType -> Bool +isFunExtType (FunET _ _) = True +isFunExtType (VarFunET _ ) = True +isFunExtType (IOET _ ) = True +isFunExtType _ = False + +numArgs :: ExtType -> Int +numArgs (FunET _ f) = 1 + numArgs f +numArgs _ = 0 + +-- pretty print an external type +-- +-- * a previous version of this function attempted to not print unnecessary +-- brackets; this however doesn't work consistently due to `DefinedET'; so, +-- we give up on the idea (preferring simplicity) +-- +showExtType :: ExtType -> String +showExtType (FunET UnitET res) = showExtType res +showExtType (FunET arg res) = "(" ++ showExtType arg ++ " -> " + ++ showExtType res ++ ")" +showExtType (VarFunET res) = "( ... -> " ++ showExtType res ++ ")" +showExtType (IOET t) = "(IO " ++ showExtType t ++ ")" +showExtType (PtrET t) = let ptrCon = if isFunExtType t + then "FunPtr" else "Ptr" + in + "(" ++ ptrCon ++ " " ++ showExtType t + ++ ")" +showExtType (DefinedET _ str) = "(" ++ str ++ ")" +showExtType (PrimET CPtrPT) = "(Ptr ())" +showExtType (PrimET CFunPtrPT) = "(FunPtr ())" +showExtType (PrimET CCharPT) = "CChar" +showExtType (PrimET CUCharPT) = "CUChar" +showExtType (PrimET CSCharPT) = "CSChar" +showExtType (PrimET CIntPT) = "CInt" +showExtType (PrimET CShortPT) = "CShort" +showExtType (PrimET CLongPT) = "CLong" +showExtType (PrimET CLLongPT) = "CLLong" +showExtType (PrimET CUIntPT) = "CUInt" +showExtType (PrimET CUShortPT) = "CUShort" +showExtType (PrimET CULongPT) = "CULong" +showExtType (PrimET CULLongPT) = "CULLong" +showExtType (PrimET CFloatPT) = "CFloat" +showExtType (PrimET CDoublePT) = "CDouble" +showExtType (PrimET CLDoublePT) = "CLDouble" +showExtType (PrimET (CSFieldPT bs)) = "CInt{-:" ++ show bs ++ "-}" +showExtType (PrimET (CUFieldPT bs)) = "CUInt{-:" ++ show bs ++ "-}" +showExtType UnitET = "()" + +-- compute the type of the C function declared by the given C object +-- +-- * the identifier specifies in which of the declarators we are interested +-- +-- * if the third argument is `True', the function result should not be +-- wrapped into an `IO' type +-- +-- * the caller has to guarantee that the object does indeed refer to a +-- function +-- +extractFunType :: Position -> CDecl -> Bool -> GB ExtType +extractFunType pos cdecl isPure = + do + -- remove all declarators except that of the function we are processing; + -- then, extract the functions arguments and result type (also check that + -- the function is not variadic); finally, compute the external type for + -- the result + -- + let (args, resultDecl, variadic) = funResultAndArgs cdecl + preResultType <- extractSimpleType True pos resultDecl + -- + -- we can now add the `IO' monad if this is no pure function + -- + let protoResultType = if isPure + then preResultType + else IOET preResultType + let resultType = if variadic + then VarFunET protoResultType + else protoResultType + -- + -- compute function arguments and create a function type (a function + -- prototype with `void' as its single argument declares a nullary + -- function) + -- + argTypes <- mapM (extractSimpleType False pos) args + return $ foldr FunET resultType argTypes + +-- compute a non-struct/union type from the given declaration +-- +-- * the declaration may have at most one declarator +-- +-- * C functions are represented as `Ptr (FunEt ...)' or `Addr' if in +-- compatibility mode (ie, `--old-ffi=yes') +-- +extractSimpleType :: Bool -> Position -> CDecl -> GB ExtType +extractSimpleType isResult pos cdecl = + do + traceEnter + ct <- extractCompType isResult True cdecl + case ct of + ExtType et -> return et + SUType _ -> illegalStructUnionErr (posOf cdecl) pos + where + traceEnter = traceGenBind $ + "Entering `extractSimpleType' (" ++ (if isResult then "" else "not ") + ++ "for a result)...\n" + +-- compute a Haskell type for a type referenced in a C pointer type +-- +-- * the declaration may have at most one declarator +-- +-- * unknown struct/union types are mapped to `()' +-- +-- * do *not* take aliases into account +-- +-- * NB: this is by definition not a result type +-- +extractPtrType :: CDecl -> GB ExtType +extractPtrType cdecl = do + ct <- extractCompType False False cdecl + case ct of + ExtType et -> return et + SUType _ -> return UnitET + +-- compute a Haskell type from the given C declaration, where C functions are +-- represented by function pointers +-- +-- * the declaration may have at most one declarator +-- +-- * all C pointers (including functions) are represented as `Addr' if in +-- compatibility mode (--old-ffi) +-- +-- * typedef'ed types are chased +-- +-- * the first argument specifies whether the type specifies the result of a +-- function (this is only applicable to direct results and not to type +-- parameters for pointers that are a result) +-- +-- * takes the pointer map into account +-- +-- * IMPORTANT NOTE: `sizeAlignOf' relies on `DefinedET' only being produced +-- for pointer types; if this ever changes, we need to +-- handle `DefinedET's differently. The problem is that +-- entries in the pointer map currently prevent +-- `extractCompType' from looking further "into" the +-- definition of that pointer. +-- +extractCompType :: Bool -> Bool -> CDecl -> GB CompType +extractCompType isResult usePtrAliases cdecl@(CDecl specs declrs ats) = + if length declrs > 1 + then interr "GenBind.extractCompType: Too many declarators!" + else case declrs of + [(Just declr, _, size)] | isPtrDeclr declr -> ptrType declr + | isFunDeclr declr -> funType + | otherwise -> aliasOrSpecType size + [] -> aliasOrSpecType Nothing + where + -- handle explicit pointer types + -- + ptrType declr = do + tracePtrType + let declrs' = dropPtrDeclr declr -- remove indirection + cdecl' = CDecl specs [(Just declrs', Nothing, Nothing)] ats + oalias = checkForOneAliasName cdecl' -- is only an alias remaining? + osu = checkForOneCUName cdecl' + oname = if oalias == Nothing then osu else oalias + oHsRepr <- case oname of + Nothing -> return $ Nothing + Just ide -> queryPtr (True, ide) + case oHsRepr of + Just repr | usePtrAliases -> ptrAlias repr -- got an alias + _ -> do -- no alias => recurs + ct <- extractCompType False usePtrAliases cdecl' + returnX $ case ct of + ExtType et -> PtrET et + SUType _ -> PtrET UnitET + -- + -- handle explicit function types + -- + -- FIXME: we currently regard any functions as being impure (ie, being IO + -- functions); is this ever going to be a problem? + -- + funType = do + traceFunType + et <- extractFunType (posOf cdecl) cdecl False + returnX et + -- + -- handle all types, which are not obviously pointers or functions + -- + aliasOrSpecType :: Maybe CExpr -> GB CompType + aliasOrSpecType size = do + traceAliasOrSpecType size + case checkForOneAliasName cdecl of + Nothing -> specType (posOf cdecl) specs size + Just ide -> do -- this is a typedef alias + traceAlias ide + oHsRepr <- queryPtr (False, ide) -- check for pointer hook alias + case oHsRepr of + Just repr | usePtrAliases + -> ptrAlias repr -- found a pointer hook alias + _ -> do -- skip current alias (only one) + cdecl' <- getDeclOf ide + let CDecl specs [(declr, init, _)] at = + ide `simplifyDecl` cdecl' + sdecl = CDecl specs [(declr, init, size)] at + -- propagate `size' down (slightly kludgy) + extractCompType isResult usePtrAliases sdecl + -- + -- compute the result for a pointer alias + -- + ptrAlias (repr1, repr2) = + returnX $ DefinedET cdecl (if isResult then repr2 else repr1) + -- + -- wrap an `ExtType' into a `CompType' + -- + returnX retval = return $ ExtType retval + -- + tracePtrType = traceGenBind $ "extractCompType: explicit pointer type\n" + traceFunType = traceGenBind $ "extractCompType: explicit function type\n" + traceAliasOrSpecType Nothing = traceGenBind $ + "extractCompType: checking for alias\n" + traceAliasOrSpecType (Just _) = traceGenBind $ + "extractCompType: checking for alias of bitfield\n" + traceAlias ide = traceGenBind $ + "extractCompType: found an alias called `" ++ identToLexeme ide ++ "'\n" + +-- C to Haskell type mapping described in the DOCU section +-- +typeMap :: [([CTypeSpec], ExtType)] +typeMap = [([void] , UnitET ), + ([char] , PrimET CCharPT ), + ([unsigned, char] , PrimET CUCharPT ), + ([signed, char] , PrimET CSCharPT ), + ([signed] , PrimET CIntPT ), + ([int] , PrimET CIntPT ), + ([signed, int] , PrimET CIntPT ), + ([short] , PrimET CShortPT ), + ([short, int] , PrimET CShortPT ), + ([signed, short] , PrimET CShortPT ), + ([signed, short, int] , PrimET CShortPT ), + ([long] , PrimET CLongPT ), + ([long, int] , PrimET CLongPT ), + ([signed, long] , PrimET CLongPT ), + ([signed, long, int] , PrimET CLongPT ), + ([long, long] , PrimET CLLongPT ), + ([long, long, int] , PrimET CLLongPT ), + ([signed, long, long] , PrimET CLLongPT ), + ([signed, long, long, int] , PrimET CLLongPT ), + ([unsigned] , PrimET CUIntPT ), + ([unsigned, int] , PrimET CUIntPT ), + ([unsigned, short] , PrimET CUShortPT ), + ([unsigned, short, int] , PrimET CUShortPT ), + ([unsigned, long] , PrimET CULongPT ), + ([unsigned, long, int] , PrimET CULongPT ), + ([unsigned, long, long] , PrimET CULLongPT ), + ([unsigned, long, long, int] , PrimET CULLongPT ), + ([float] , PrimET CFloatPT ), + ([double] , PrimET CDoublePT ), + ([long, double] , PrimET CLDoublePT), + ([enum] , PrimET CIntPT )] + where + void = CVoidType undefined + char = CCharType undefined + short = CShortType undefined + int = CIntType undefined + long = CLongType undefined + float = CFloatType undefined + double = CDoubleType undefined + signed = CSignedType undefined + unsigned = CUnsigType undefined + enum = CEnumType undefined undefined + +-- compute the complex (external) type determined by a list of type specifiers +-- +-- * may not be called for a specifier that defines a typedef alias +-- +specType :: Position -> [CDeclSpec] -> Maybe CExpr -> GB CompType +specType cpos specs osize = + let tspecs = [ts | CTypeSpec ts <- specs] + in case lookupTSpec tspecs typeMap of + Just et | isUnsupportedType et -> unsupportedTypeSpecErr cpos + | isNothing osize -> return $ ExtType et -- not a bitfield + | otherwise -> bitfieldSpec tspecs et osize -- bitfield + Nothing -> + case tspecs of + [CSUType cu _] -> return $ SUType cu -- struct or union + [CEnumType _ _] -> return $ ExtType (PrimET CIntPT) -- enum + [CTypeDef _ _] -> interr "GenBind.specType: Illegal typedef alias!" + _ -> illegalTypeSpecErr cpos + where + lookupTSpec = lookupBy matches + -- + isUnsupportedType (PrimET et) = size et == 0 -- can't be a bitfield (yet) + isUnsupportedType _ = False + -- + -- check whether two type specifier lists denote the same type; handles + -- types like `long long' correctly, as `deleteBy' removes only the first + -- occurrence of the given element + -- + matches :: [CTypeSpec] -> [CTypeSpec] -> Bool + [] `matches` [] = True + [] `matches` (_:_) = False + (spec:specs) `matches` specs' + | any (eqSpec spec) specs' = specs `matches` deleteBy eqSpec spec specs' + | otherwise = False + -- + eqSpec (CVoidType _) (CVoidType _) = True + eqSpec (CCharType _) (CCharType _) = True + eqSpec (CShortType _) (CShortType _) = True + eqSpec (CIntType _) (CIntType _) = True + eqSpec (CLongType _) (CLongType _) = True + eqSpec (CFloatType _) (CFloatType _) = True + eqSpec (CDoubleType _) (CDoubleType _) = True + eqSpec (CSignedType _) (CSignedType _) = True + eqSpec (CUnsigType _) (CUnsigType _) = True + eqSpec (CSUType _ _) (CSUType _ _) = True + eqSpec (CEnumType _ _) (CEnumType _ _) = True + eqSpec (CTypeDef _ _) (CTypeDef _ _) = True + eqSpec _ _ = False + -- + bitfieldSpec :: [CTypeSpec] -> ExtType -> Maybe CExpr -> GB CompType + bitfieldSpec tspecs et (Just sizeExpr) = -- never called with `Nothing' + do + PlatformSpec {bitfieldIntSignedPS = bitfieldIntSigned} <- getPlatform + let pos = posOf sizeExpr + sizeResult <- evalConstCExpr sizeExpr + case sizeResult of + FloatResult _ -> illegalConstExprErr pos "a float result" + IntResult size' -> do + let size = fromInteger size' + case et of + PrimET CUIntPT -> returnCT $ CUFieldPT size + PrimET CIntPT + | [signed] `matches` tspecs + || [signed, int] `matches` tspecs -> returnCT $ CSFieldPT size + | [int] `matches` tspecs -> + returnCT $ if bitfieldIntSigned then CSFieldPT size + else CUFieldPT size + _ -> illegalFieldSizeErr pos + where + returnCT = return . ExtType . PrimET + -- + int = CIntType undefined + signed = CSignedType undefined + + +-- offset and size computations +-- ---------------------------- + +-- precise size representation +-- +-- * this is a pair of a number of octets and a number of bits +-- +-- * if the number of bits is nonzero, the octet component is aligned by the +-- alignment constraint for `CIntPT' (important for accessing bitfields with +-- more than 8 bits) +-- +data BitSize = BitSize Int Int + deriving (Eq, Show) + +-- ordering relation compares in terms of required storage units +-- +instance Ord BitSize where + bs1@(BitSize o1 b1) < bs2@(BitSize o2 b2) = + padBits bs1 < padBits bs2 || (o1 == o2 && b1 < b2) + bs1 <= bs2 = bs1 < bs2 || bs1 == bs2 + -- the <= instance is needed for Ord's compare functions, which is used in + -- the defaults for all other members + +-- add two bit size values +-- +addBitSize :: BitSize -> BitSize -> BitSize +addBitSize (BitSize o1 b1) (BitSize o2 b2) = BitSize (o1 + o2 + overflow) rest + where + bitsPerBitfield = size CIntPT * 8 + (overflow, rest) = (b1 + b2) `divMod` bitsPerBitfield + +-- multiply a bit size by a constant (gives size of an array) +-- +-- * not sure if this makes sense if the number of bits is non-zero. +-- +scaleBitSize :: Int -> BitSize -> BitSize +scaleBitSize n (BitSize o1 b1) = BitSize (n * o1 + overflow) rest + where + bitsPerBitfield = size CIntPT * 8 + (overflow, rest) = (n * b1) `divMod` bitsPerBitfield + +-- pad any storage unit that is partially used by a bitfield +-- +padBits :: BitSize -> Int +padBits (BitSize o 0) = o +padBits (BitSize o _) = o + size CIntPT + +-- compute the offset of the declarator in the second argument when it is +-- preceded by the declarators in the first argument +-- +offsetInStruct :: [CDecl] -> CDecl -> CStructTag -> GB BitSize +offsetInStruct [] _ _ = return $ BitSize 0 0 +offsetInStruct decls decl tag = + do + PlatformSpec {bitfieldAlignmentPS = bitfieldAlignment} <- getPlatform + (offset, _) <- sizeAlignOfStruct decls tag + (_, align) <- sizeAlignOf decl + return $ alignOffset offset align bitfieldAlignment + +-- compute the size and alignment (no padding at the end) of a set of +-- declarators from a struct +-- +sizeAlignOfStruct :: [CDecl] -> CStructTag -> GB (BitSize, Int) +sizeAlignOfStruct [] _ = return (BitSize 0 0, 1) +sizeAlignOfStruct decls CStructTag = + do + PlatformSpec {bitfieldAlignmentPS = bitfieldAlignment} <- getPlatform + (offset, preAlign) <- sizeAlignOfStruct (init decls) CStructTag + (size, align) <- sizeAlignOf (last decls) + let sizeOfStruct = alignOffset offset align bitfieldAlignment + `addBitSize` size + align' = if align > 0 then align else bitfieldAlignment + alignOfStruct = preAlign `max` align' + return (sizeOfStruct, alignOfStruct) +sizeAlignOfStruct decls CUnionTag = + do + PlatformSpec {bitfieldAlignmentPS = bitfieldAlignment} <- getPlatform + (sizes, aligns) <- mapAndUnzipM sizeAlignOf decls + let aligns' = [if align > 0 then align else bitfieldAlignment + | align <- aligns] + return (maximum sizes, maximum aligns') + +-- compute the size and alignment of the declarators forming a struct +-- including any end-of-struct padding that is needed to make the struct ``tile +-- in an array'' (K&R A7.4.8) +-- +sizeAlignOfStructPad :: [CDecl] -> CStructTag -> GB (BitSize, Int) +sizeAlignOfStructPad decls tag = + do + PlatformSpec {bitfieldAlignmentPS = bitfieldAlignment} <- getPlatform + (size, align) <- sizeAlignOfStruct decls tag + return (alignOffset size align bitfieldAlignment, align) + +-- compute the size and alignment constraint of a given C declaration +-- +sizeAlignOf :: CDecl -> GB (BitSize, Int) +sizeAlignOfSingle :: CDecl -> GB (BitSize, Int) +-- +-- * we make use of the assertion that `extractCompType' can only return a +-- `DefinedET' when the declaration is a pointer declaration +-- * for arrays, alignment is the same as for the base type and the size +-- is the size of the base type multiplied by the number of elements. +-- FIXME: I'm not sure whether anything of this is guaranteed by ISO C +-- and I have no idea what happens when an array-of-bitfield is +-- declared. At this time I don't care. -- U.S. 05/2006 +-- +sizeAlignOf (CDecl dclspec + [(Just (CArrDeclr declr _ (Just lexpr) _), init, expr)] + attr) = + do + (bitsize, align) <- sizeAlignOf (CDecl dclspec + [(Just declr, init, expr)] + attr) + IntResult length <- evalConstCExpr lexpr + return (fromIntegral length `scaleBitSize` bitsize, align) +sizeAlignOf (CDecl _ [(Just (CArrDeclr cdecl _ Nothing _), _, _)] _) = + interr "GenBind.sizeAlignOf: array of undeclared size." +sizeAlignOf cdecl = + sizeAlignOfSingle cdecl + + +sizeAlignOfSingle cdecl = + do + ct <- extractCompType False False cdecl + case ct of + ExtType (FunET _ _ ) -> do + align <- alignment CFunPtrPT + return (bitSize CFunPtrPT, align) + ExtType (VarFunET _ ) -> do + align <- alignment CFunPtrPT + return (bitSize CFunPtrPT, align) + ExtType (IOET _ ) -> interr "GenBind.sizeof: Illegal IO type!" + ExtType (PtrET t ) + | isFunExtType t -> do + align <- alignment CFunPtrPT + return (bitSize CFunPtrPT, align) + | otherwise -> do + align <- alignment CPtrPT + return (bitSize CPtrPT, align) + ExtType (DefinedET _ _ ) -> + interr "GenBind.sizeAlignOf: Should never get a defined type" +{- OLD: + do + align <- alignment CPtrPT + return (bitSize CPtrPT, align) + -- FIXME: The defined type could be a function pointer!!! + -} + ExtType (PrimET pt ) -> do + align <- alignment pt + return (bitSize pt, align) + ExtType UnitET -> voidFieldErr (posOf cdecl) + SUType su -> + do + let (fields, tag) = structMembers su + fields' <- let ide = structName su + in + if (not . null $ fields) || isNothing ide + then return fields + else do -- get the real... + tag <- findTag (fromJust ide) -- ...definition + case tag of + Just (StructUnionCT su) -> return + (fst . structMembers $ su) + _ -> return fields + sizeAlignOfStructPad fields' tag + where + bitSize et | sz < 0 = BitSize 0 (-sz) -- size is in bits + | otherwise = BitSize sz 0 + where + sz = size et + +-- apply the given alignment constraint at the given offset +-- +-- * if the alignment constraint is negative or zero, it is the alignment +-- constraint for a bitfield +-- +-- * the third argument gives the platform-specific bitfield alignment +-- +alignOffset :: BitSize -> Int -> Int -> BitSize +alignOffset offset@(BitSize octetOffset bitOffset) align bitfieldAlignment + | align > 0 && bitOffset /= 0 = -- close bitfield first + alignOffset (BitSize (octetOffset + (bitOffset + 7) `div` 8) 0) align + bitfieldAlignment + | align > 0 && bitOffset == 0 = -- no bitfields involved + BitSize (((octetOffset - 1) `div` align + 1) * align) 0 + | bitOffset == 0 -- start a bitfield + || overflowingBitfield = -- .. or overflowing bitfield + alignOffset offset bitfieldAlignment bitfieldAlignment + | otherwise = -- stays in current bitfield + offset + where + bitsPerBitfield = size CIntPT * 8 + overflowingBitfield = bitOffset - align >= bitsPerBitfield + -- note, `align' is negative + + +-- constant folding +-- ---------------- + +-- evaluate a constant expression +-- +-- FIXME: this is a bit too simplistic, as the range of expression allowed as +-- constant expression varies depending on the context in which the +-- constant expression occurs +-- +evalConstCExpr :: CExpr -> GB ConstResult +evalConstCExpr (CComma _ at) = + illegalConstExprErr (posOf at) "a comma expression" +evalConstCExpr (CAssign _ _ _ at) = + illegalConstExprErr (posOf at) "an assignment" +evalConstCExpr (CCond b (Just t) e _) = + do + bv <- evalConstCExpr b + case bv of + IntResult bvi -> if bvi /= 0 then evalConstCExpr t else evalConstCExpr e + FloatResult _ -> illegalConstExprErr (posOf b) "a float result" +evalConstCExpr (CBinary op lhs rhs at) = + do + lhsVal <- evalConstCExpr lhs + rhsVal <- evalConstCExpr rhs + let (lhsVal', rhsVal') = usualArithConv lhsVal rhsVal + applyBin (posOf at) op lhsVal' rhsVal' +evalConstCExpr (CCast _ _ _) = + todo "GenBind.evalConstCExpr: Casts are not implemented yet." +evalConstCExpr (CUnary op arg at) = + do + argVal <- evalConstCExpr arg + applyUnary (posOf at) op argVal +evalConstCExpr (CSizeofExpr _ _) = + todo "GenBind.evalConstCExpr: sizeof not implemented yet." +evalConstCExpr (CSizeofType decl _) = + do + (size, _) <- sizeAlignOf decl + return $ IntResult (fromIntegral . padBits $ size) +evalConstCExpr (CAlignofExpr _ _) = + todo "GenBind.evalConstCExpr: alignof (GNU C extension) not implemented yet." +evalConstCExpr (CAlignofType decl _) = + do + (_, align) <- sizeAlignOf decl + return $ IntResult (fromIntegral align) +evalConstCExpr (CIndex _ _ at) = + illegalConstExprErr (posOf at) "array indexing" +evalConstCExpr (CCall _ _ at) = + illegalConstExprErr (posOf at) "function call" +evalConstCExpr (CMember _ _ _ at) = + illegalConstExprErr (posOf at) "a . or -> operator" +evalConstCExpr (CVar ide at) = + do + (cobj, _) <- findValueObj ide False + case cobj of + EnumCO ide (CEnum _ enumrs _) -> liftM IntResult $ + enumTagValue ide enumrs 0 + _ -> + todo $ "GenBind.evalConstCExpr: variable names not implemented yet " ++ + show (posOf at) + where + -- FIXME: this is not very nice; instead, CTrav should have some support + -- for determining enum tag values (but then, constant folding needs + -- to be moved to CTrav, too) + -- + -- Compute the tag value for `ide' defined in the given enumerator list + -- + enumTagValue _ [] _ = + interr "GenBind.enumTagValue: enumerator not in declaration" + enumTagValue ide ((ide', oexpr):enumrs) val = + do + val' <- case oexpr of + Nothing -> return val + Just exp -> + do + val' <- evalConstCExpr exp + case val' of + IntResult val' -> return val' + FloatResult _ -> + illegalConstExprErr (posOf exp) "a float result" + if ide == ide' + then -- found the right enumerator + return val' + else -- continue down the enumerator list + enumTagValue ide enumrs (val' + 1) +evalConstCExpr (CConst c _) = + evalCConst c + +evalCConst :: CConst -> GB ConstResult +evalCConst (CIntConst i _ ) = return $ IntResult i +evalCConst (CCharConst c _ ) = return $ IntResult (toInteger (fromEnum c)) +evalCConst (CFloatConst s _ ) = + todo "GenBind.evalCConst: Float conversion from literal misses." +evalCConst (CStrConst s at) = + illegalConstExprErr (posOf at) "a string constant" + +usualArithConv :: ConstResult -> ConstResult -> (ConstResult, ConstResult) +usualArithConv lhs@(FloatResult _) rhs = (lhs, toFloat rhs) +usualArithConv lhs rhs@(FloatResult _) = (toFloat lhs, rhs) +usualArithConv lhs rhs = (lhs, rhs) + +toFloat :: ConstResult -> ConstResult +toFloat x@(FloatResult _) = x +toFloat (IntResult i) = FloatResult . fromIntegral $ i + +applyBin :: Position + -> CBinaryOp + -> ConstResult + -> ConstResult + -> GB ConstResult +applyBin cpos CMulOp (IntResult x) + (IntResult y) = return $ IntResult (x * y) +applyBin cpos CMulOp (FloatResult x) + (FloatResult y) = return $ FloatResult (x * y) +applyBin cpos CDivOp (IntResult x) + (IntResult y) = return $ IntResult (x `div` y) +applyBin cpos CDivOp (FloatResult x) + (FloatResult y) = return $ FloatResult (x / y) +applyBin cpos CRmdOp (IntResult x) + (IntResult y) = return$ IntResult (x `mod` y) +applyBin cpos CRmdOp (FloatResult x) + (FloatResult y) = + illegalConstExprErr cpos "a % operator applied to a float" +applyBin cpos CAddOp (IntResult x) + (IntResult y) = return $ IntResult (x + y) +applyBin cpos CAddOp (FloatResult x) + (FloatResult y) = return $ FloatResult (x + y) +applyBin cpos CSubOp (IntResult x) + (IntResult y) = return $ IntResult (x - y) +applyBin cpos CSubOp (FloatResult x) + (FloatResult y) = return $ FloatResult (x - y) +applyBin cpos CShlOp (IntResult x) + (IntResult y) = return $ IntResult (x * 2^y) +applyBin cpos CShlOp (FloatResult x) + (FloatResult y) = + illegalConstExprErr cpos "a << operator applied to a float" +applyBin cpos CShrOp (IntResult x) + (IntResult y) = return $ IntResult (x `div` 2^y) +applyBin cpos CShrOp (FloatResult x) + (FloatResult y) = + illegalConstExprErr cpos "a >> operator applied to a float" +applyBin cpos _ (IntResult x) + (IntResult y) = + todo "GenBind.applyBin: Not yet implemented operator in constant expression." +applyBin cpos _ (FloatResult x) + (FloatResult y) = + todo "GenBind.applyBin: Not yet implemented operator in constant expression." +applyBin _ _ _ _ = + interr "GenBind.applyBinOp: Illegal combination!" + +applyUnary :: Position -> CUnaryOp -> ConstResult -> GB ConstResult +applyUnary cpos CPreIncOp _ = + illegalConstExprErr cpos "a ++ operator" +applyUnary cpos CPreDecOp _ = + illegalConstExprErr cpos "a -- operator" +applyUnary cpos CPostIncOp _ = + illegalConstExprErr cpos "a ++ operator" +applyUnary cpos CPostDecOp _ = + illegalConstExprErr cpos "a -- operator" +applyUnary cpos CAdrOp _ = + illegalConstExprErr cpos "a & operator" +applyUnary cpos CIndOp _ = + illegalConstExprErr cpos "a * operator" +applyUnary cpos CPlusOp arg = return arg +applyUnary cpos CMinOp (IntResult x) = return (IntResult (-x)) +applyUnary cpos CMinOp (FloatResult x) = return (FloatResult (-x)) +applyUnary cpos CCompOp _ = + todo "GenBind.applyUnary: ~ not yet implemented." +applyUnary cpos CNegOp (IntResult x) = + let r = toInteger . fromEnum $ (x == 0) + in return (IntResult r) +applyUnary cpos CNegOp (FloatResult _) = + illegalConstExprErr cpos "! applied to a float" + + +-- auxilliary functions +-- -------------------- + +-- create an identifier without position information +-- +noPosIdent :: String -> Ident +noPosIdent = onlyPosIdent nopos + +-- print trace message +-- +traceGenBind :: String -> GB () +traceGenBind = putTraceStr traceGenBindSW + +-- generic lookup +-- +lookupBy :: (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b +lookupBy eq x = fmap snd . find (eq x . fst) + +-- maps some monad operation into a `Maybe', discarding the result +-- +mapMaybeM_ :: Monad m => (a -> m b) -> Maybe a -> m () +mapMaybeM_ m Nothing = return () +mapMaybeM_ m (Just a) = m a >> return () + + +-- error messages +-- -------------- + +unknownFieldErr :: Position -> Ident -> GB a +unknownFieldErr cpos ide = + raiseErrorCTExc (posOf ide) + ["Unknown member name!", + "The structure has no member called `" ++ identToLexeme ide + ++ "'. The structure is defined at", + show cpos ++ "."] + +illegalStructUnionErr :: Position -> Position -> GB a +illegalStructUnionErr cpos pos = + raiseErrorCTExc pos + ["Illegal structure or union type!", + "There is not automatic support for marshaling of structures and", + "unions; the offending type is declared at " + ++ show cpos ++ "."] + +illegalTypeSpecErr :: Position -> GB a +illegalTypeSpecErr cpos = + raiseErrorCTExc cpos + ["Illegal type!", + "The type specifiers of this declaration do not form a legal ANSI C(89) \ + \type." + ] + +unsupportedTypeSpecErr :: Position -> GB a +unsupportedTypeSpecErr cpos = + raiseErrorCTExc cpos + ["Unsupported type!", + "The type specifier of this declaration is not supported by your C \ + \compiler." + ] + +variadicErr :: Position -> Position -> GB a +variadicErr pos cpos = + raiseErrorCTExc pos + ["Variadic function!", + "Calling variadic functions is not supported by the FFI; the function", + "is defined at " ++ show cpos ++ "."] + +illegalConstExprErr :: Position -> String -> GB a +illegalConstExprErr cpos hint = + raiseErrorCTExc cpos ["Illegal constant expression!", + "Encountered " ++ hint ++ " in a constant expression,", + "which ANSI C89 does not permit."] + +voidFieldErr :: Position -> GB a +voidFieldErr cpos = + raiseErrorCTExc cpos ["Void field in struct!", + "Attempt to access a structure field of type void."] + +structExpectedErr :: Ident -> GB a +structExpectedErr ide = + raiseErrorCTExc (posOf ide) + ["Expected a structure or union!", + "Attempt to access member `" ++ identToLexeme ide ++ "' in something not", + "a structure or union."] + +ptrExpectedErr :: Position -> GB a +ptrExpectedErr pos = + raiseErrorCTExc pos + ["Expected a pointer object!", + "Attempt to dereference a non-pointer object or to use it in a `pointer' \ + \hook."] + +funPtrExpectedErr :: Position -> GB a +funPtrExpectedErr pos = + raiseErrorCTExc pos + ["Expected a pointer-to-function object!", + "Attempt to use a non-pointer object in a `call' or `fun' hook."] + +illegalStablePtrErr :: Position -> GB a +illegalStablePtrErr pos = + raiseErrorCTExc pos + ["Illegal use of a stable pointer!", + "Class hooks cannot be used for stable pointers."] + +pointerTypeMismatchErr :: Position -> String -> String -> GB a +pointerTypeMismatchErr pos className superName = + raiseErrorCTExc pos + ["Pointer type mismatch!", + "The pointer of the class hook for `" ++ className + ++ "' is of a different kind", + "than that of the class hook for `" ++ superName ++ "'; this is illegal", + "as the latter is defined to be an (indirect) superclass of the former."] + +illegalFieldSizeErr :: Position -> GB a +illegalFieldSizeErr cpos = + raiseErrorCTExc cpos + ["Illegal field size!", + "Only signed and unsigned `int' types may have a size annotation."] + +derefBitfieldErr :: Position -> GB a +derefBitfieldErr pos = + raiseErrorCTExc pos + ["Illegal dereferencing of a bit field!", + "Bit fields cannot be dereferenced."] + +resMarshIllegalInErr :: Position -> GB a +resMarshIllegalInErr pos = + raiseErrorCTExc pos + ["Malformed result marshalling!", + "There may not be an \"in\" marshaller for the result."] + +resMarshIllegalTwoCValErr :: Position -> GB a +resMarshIllegalTwoCValErr pos = + raiseErrorCTExc pos + ["Malformed result marshalling!", + "Two C values (i.e., the `&' symbol) are not allowed for the result."] + +marshArgMismatchErr :: Position -> String -> GB a +marshArgMismatchErr pos reason = + raiseErrorCTExc pos + ["Function arity mismatch!", + reason] + +noDftMarshErr :: Position -> String -> String -> [ExtType] -> GB a +noDftMarshErr pos inOut hsTy cTys = + raiseErrorCTExc pos + ["Missing " ++ inOut ++ " marshaller!", + "There is no default marshaller for this combination of Haskell and \ + \C type:", + "Haskell type: " ++ hsTy, + "C type : " ++ concat (intersperse " " (map showExtType cTys))] diff --git a/c2hs/gen/GenHeader.hs b/c2hs/gen/GenHeader.hs new file mode 100644 --- /dev/null +++ b/c2hs/gen/GenHeader.hs @@ -0,0 +1,295 @@ +-- C->Haskell Compiler: custom header generator +-- +-- Author : Manuel M T Chakravarty +-- Created: 5 February 2003 +-- +-- Copyright (c) 2004 Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module implements the generation of a custom header from a binding +-- module. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Computing CPP Conditionals +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We obtain information about which branches of CPP conditions are taken +-- during pre-processing of the custom header file by introducing new +-- struct declarations. Specifically, after each #if[[n]def] or #elif, +-- we place a declaration of the form +-- +-- struct C2HS_COND_SENTRY; +-- +-- We can, then, determine which branch of a conditional has been taken by +-- checking whether the struct corresponding to that conditional has been +-- declared. +-- +--- TODO ---------------------------------------------------------------------- +-- +-- * Ideally, `ghFrag[s]' should be tail recursive + +module GenHeader ( + genHeader +) where + +-- standard libraries +import Control.Monad (when) + +-- Compiler Toolkit +import Position (Position, Pos(..), nopos) +import DLists (DList, openDL, closeDL, zeroDL, unitDL, joinDL, snocDL) +import Errors (interr) +import Idents (onlyPosIdent) +import UNames (Name, names) + +-- C->Haskell +import C2HSState (CST, getNameSupply, runCST, transCST, raiseError, catchExc, + throwExc, errorsPresent, showErrors, fatal) + +-- friends +import CHS (CHSModule(..), CHSFrag(..)) + + +-- The header generation monad +-- +type GH a = CST [Name] a + +-- |Generate a custom C header from a CHS binding module. +-- +-- * All CPP directives and inline-C fragments are moved into the custom header +-- +-- * The CPP and inline-C fragments are removed from the .chs tree and +-- conditionals are replaced by structured conditionals +-- +genHeader :: CHSModule -> CST s ([String], CHSModule, String) +genHeader mod = + do + supply <- getNameSupply + (header, mod) <- runCST (ghModule mod) (names supply) + `ifGHExc` return ([], CHSModule []) + + -- check for errors and finalise + -- + errs <- errorsPresent + if errs + then do + errmsgs <- showErrors + fatal ("Errors during generation of C header:\n\n" -- fatal error + ++ errmsgs) + else do + warnmsgs <- showErrors + return (header, mod, warnmsgs) + +-- Obtain a new base name that may be used, in C, to encode the result of a +-- preprocessor conditionl. +-- +newName :: CST [Name] String +newName = transCST $ + \supply -> (tail supply, "C2HS_COND_SENTRY_" ++ show (head supply)) + +-- Various forms of processed fragments +-- +data FragElem = Frag CHSFrag + | Elif String Position + | Else Position + | Endif Position + | EOF + +instance Pos FragElem where + posOf (Frag frag ) = posOf frag + posOf (Elif _ pos) = pos + posOf (Else pos) = pos + posOf (Endif pos) = pos + posOf EOF = nopos + +-- check for end of file +-- +isEOF :: FragElem -> Bool +isEOF EOF = True +isEOF _ = False + +-- Generate the C header for an entire .chs module. +-- +-- * This works more or less like a recursive decent parser for a statement +-- sequence that may contain conditionals, where `ghFrag' implements most of +-- the state transition system of the associated automaton +-- +ghModule :: CHSModule -> GH ([String], CHSModule) +ghModule (CHSModule frags) = + do + (header, frags, last, rest) <- ghFrags frags + when (not . isEOF $ last) $ + notOpenCondErr (posOf last) + return (closeDL header, CHSModule frags) + +-- Collect header and fragments up to eof or a CPP directive that is part of a +-- conditional +-- +-- * We collect the header (ie, CPP directives and inline-C) using a +-- difference list to avoid worst case O(n^2) complexity due to +-- concatenation of lines that go into the header. +-- +ghFrags :: [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag]) +ghFrags [] = return (zeroDL, [], EOF, []) +ghFrags frags = + do + (header, frag, rest) <- ghFrag frags + case frag of + Frag aFrag -> do + (header2, frags', frag', rest) <- ghFrags rest + -- FIXME: Not tail rec + return (header `joinDL` header2, aFrag:frags', + frag', rest) + _ -> return (header, [], frag, rest) + +-- Process a single fragment *structure*; i.e., if the first fragment +-- introduces a conditional, process the whole conditional; otherwise, process +-- the first fragment +-- +ghFrag :: [CHSFrag] -> GH (DList String, -- partial header file + FragElem, -- processed fragment + [CHSFrag]) -- not yet processed fragments +ghFrag [] = + return (zeroDL, EOF, []) +ghFrag (frag@(CHSVerb _ _ ) : frags) = + return (zeroDL, Frag frag, frags) +ghFrag (frag@(CHSHook _ ) : frags) = + return (zeroDL, Frag frag, frags) +ghFrag (frag@(CHSLine _ ) : frags) = + return (zeroDL, Frag frag, frags) +ghFrag ( (CHSC s _ ) : frags) = + do + (header, frag, frags' ) <- ghFrag frags -- scan for next CHS fragment + return (unitDL s `joinDL` header, frag, frags') + -- FIXME: this is not tail recursive... +ghFrag ( (CHSCond _ _ ) : frags) = + interr "GenHeader.ghFrags: There can't be a structured conditional yet!" +ghFrag (frag@(CHSCPP s pos) : frags) = + let + (directive, _) = break (`elem` " \t") + . dropWhile (`elem` " \t") + $ s + in + case directive of + "if" -> openIf s pos frags + "ifdef" -> openIf s pos frags + "ifndef" -> openIf s pos frags + "else" -> return (zeroDL , Else pos , frags) + "elif" -> return (zeroDL , Elif s pos , frags) + "endif" -> return (zeroDL , Endif pos , frags) + _ -> return (openDL ['#':s, "\n"], Frag (CHSVerb "" nopos), frags) + where + -- enter a new conditional (may be an #if[[n]def] or #elif) + -- + -- * Arguments are the lexeme of the directive `s', the position of that + -- directive `pos', and the fragments following the directive `frags' + -- + openIf s pos frags = + do + (headerTh, fragsTh, last, rest) <- ghFrags frags + case last of + Else pos -> do + (headerEl, fragsEl, last, rest) <- ghFrags rest + case last of + Else pos -> notOpenCondErr pos + Elif _ pos -> notOpenCondErr pos + Endif pos -> closeIf + ((headerTh + `snocDL` "#else\n") + `joinDL` + (headerEl + `snocDL` "#endif\n")) + (s, fragsTh) + [] + (Just fragsEl) + rest + EOF -> notClosedCondErr pos + Elif s' pos -> do + (headerEl, condFrag, rest) <- openIf s' pos rest + case condFrag of + Frag (CHSCond alts dft) -> + closeIf (headerTh `joinDL` headerEl) + (s, fragsTh) + alts + dft + rest + _ -> + interr "GenHeader.ghFrag: Expected CHSCond!" + Endif pos -> closeIf (headerTh `snocDL` "#endif\n") + (s, fragsTh) + [] + (Just []) + rest + EOF -> notClosedCondErr pos + -- + -- turn a completed conditional into a `CHSCond' fragment + -- + -- * `(s, fragsTh)' is the CPP directive `s' containing the condition under + -- which `fragTh' should be executed; `alts' are alternative branches + -- (with conditions); and `oelse' is an optional else-branch + -- + closeIf headerTail (s, fragsTh) alts oelse rest = + do + sentryName <- newName + let sentry = onlyPosIdent nopos sentryName + -- don't use an internal ident, as we need to test for + -- equality with identifiers read from the .i file + -- during binding hook expansion + header = openDL ['#':s, "\n", + "struct ", sentryName, ";\n"] + `joinDL` headerTail + return (header, Frag (CHSCond ((sentry, fragsTh):alts) oelse), rest) + + +-- exception handling +-- ------------------ + +-- exception identifier +-- +ghExc :: String +ghExc = "ghExc" + +-- throw an exception +-- +throwGHExc :: GH a +throwGHExc = throwExc ghExc "Error during C header generation" + +-- catch a `ghExc' +-- +ifGHExc :: CST s a -> CST s a -> CST s a +ifGHExc m handler = m `catchExc` (ghExc, const handler) + +-- raise an error followed by throwing a GH exception +-- +raiseErrorGHExc :: Position -> [String] -> GH a +raiseErrorGHExc pos errs = raiseError pos errs >> throwGHExc + + +-- error messages +-- -------------- + +notClosedCondErr :: Position -> GH a +notClosedCondErr pos = + raiseErrorGHExc pos + ["Unexpected end of file!", + "File ended while the conditional block starting here was not closed \ + \properly."] + +notOpenCondErr :: Position -> GH a +notOpenCondErr pos = + raiseErrorGHExc pos + ["Missing #if[[n]def]!", + "There is a #else, #elif, or #endif without an #if, #ifdef, or #ifndef."] diff --git a/c2hs/state/C2HSState.hs b/c2hs/state/C2HSState.hs new file mode 100644 --- /dev/null +++ b/c2hs/state/C2HSState.hs @@ -0,0 +1,103 @@ +-- C -> Haskell Compiler: C2HS's state +-- +-- Author : Manuel M. T. Chakravarty +-- Created: 6 March 1999 +-- +-- Copyright (c) 1999 Manuel M. T. Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module instantiates the Compiler Toolkit's extra state with C2HS's +-- uncommon state information that should be stored in the Toolkit's base +-- state. +-- +-- This modules re-exports everything provided by `State', and thus, should be +-- used as the single reference to state related functionality within C2HS. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- State components: +-- +-- - compiler switches +-- +--- TODO ---------------------------------------------------------------------- +-- + +module C2HSState (-- re-exports all of `State' + -- + module State, + -- + -- instantiation of `PreCST' with C2HS's extra state + -- + CST, runC2HS, + -- + -- switches + -- + SwitchBoard(..), Traces(..), setTraces, traceSet, + putTraceStr, setSwitch, getSwitch) +where + +import Control.Monad (when) + +import State + +import Switches (SwitchBoard(..), Traces(..), + initialSwitchBoard) + + +-- instantiation of the extra state +-- -------------------------------- + +-- the extra state consists of the `SwitchBoard' (EXPORTED) +-- +type CST s a = PreCST SwitchBoard s a + +-- execution of c2hs starts with the initial `SwitchBoard' +-- +runC2HS :: CST () a -> IO a +runC2HS = run initialSwitchBoard + + +-- switch management +-- ----------------- + +-- set traces according to the given transformation function +-- +setTraces :: (Traces -> Traces) -> CST s () +setTraces t = updExtra (\es -> es {tracesSB = t (tracesSB es)}) + +-- inquire the status a trace using the given inquiry function +-- +traceSet :: (Traces -> Bool) -> CST s Bool +traceSet t = readExtra (t . tracesSB) + +-- output the given string to `stderr' when the trace determined by the inquiry +-- function is activated +-- +putTraceStr :: (Traces -> Bool) -> String -> CST s () +putTraceStr t msg = do + set <- traceSet t + when set $ + hPutStrCIO stderr msg + +-- set a switch value +-- +setSwitch :: (SwitchBoard -> SwitchBoard) -> CST s () +setSwitch = updExtra + +-- get a switch values +-- +getSwitch :: (SwitchBoard -> a) -> CST s a +getSwitch = readExtra diff --git a/c2hs/state/Switches.hs b/c2hs/state/Switches.hs new file mode 100644 --- /dev/null +++ b/c2hs/state/Switches.hs @@ -0,0 +1,118 @@ +-- C -> Haskell Compiler: management of switches +-- +-- Author : Manuel M T Chakravarty +-- Created: 6 March 99 +-- +-- Copyright (c) [1999..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- This module manages C2HS's compiler switches. It exports the data types +-- used to store the switches and operations on them. +-- +--- DOCU ---------------------------------------------------------------------- +-- +-- language: Haskell 98 +-- +-- Overview over the switches: +-- +-- * The cpp options specify the options passed to the C preprocessor. +-- +-- * The cpp filename gives the name of the executable of the C preprocessor. +-- +-- * The `keep' flag says whether the intermediate file produced by the C +-- pre-processor should be retained or not. +-- +-- * `platformSB' specifies the implementation-dependent parameters of the +-- targeted C compiler (as far as they are relevant to c2hs); this includes +-- especially the conventions for the memory layout of bitfields +-- +-- * Traces specify which trace information should be output by the compiler. +-- Currently the following trace information is supported: +-- +-- - information about phase activation and phase completion +-- +-- * After processing the compiler options, `outputSB' contains the base name +-- for the generated Haskell, C header, and .chi files. However, during +-- processing compiler options, `outputSB' contains arguments to the +-- `--output' option and `outDirSB' contains arguments to the +-- `--output-dir' option. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module Switches ( + SwitchBoard(..), Traces(..), initialSwitchBoard +) where + +import C2HSConfig (PlatformSpec, defaultPlatformSpec) + + +-- the switch board contains all toolkit switches +-- ---------------------------------------------- + +-- all switches of the toolkit (EXPORTED) +-- +data SwitchBoard = SwitchBoard { + cppOptsSB :: String, -- cpp options + cppSB :: FilePath, -- cpp executable + keepSB :: Bool, -- keep intermediate file + librarySB :: Bool, -- copy library in + tracesSB :: Traces, -- trace flags + outputSB :: FilePath, -- basename of generated files + outDirSB :: FilePath, -- dir where generated files go + platformSB:: PlatformSpec, -- target platform spec. + headerSB :: FilePath, -- generated header file + chiPathSB :: [FilePath] -- .chi file directories + } + +-- switch states on startup (EXPORTED) +-- +initialSwitchBoard :: SwitchBoard +initialSwitchBoard = SwitchBoard { + cppOptsSB = "", + cppSB = "cpp", + keepSB = False, + librarySB = False, + tracesSB = initialTraces, + outputSB = "", + outDirSB = "", + platformSB = defaultPlatformSpec, + headerSB = "", + chiPathSB = ["."] + } + + +-- traces +-- ------ + +-- different kinds of traces possible (EXPORTED) +-- +data Traces = Traces { + tracePhasesSW :: Bool, + traceGenBindSW :: Bool, + traceCTravSW :: Bool, + dumpCHSSW :: Bool + } + +-- trace setting on startup +-- +-- * all traces are initially off +-- +initialTraces :: Traces +initialTraces = Traces { + tracePhasesSW = False, + traceGenBindSW = False, + traceCTravSW = False, + dumpCHSSW = False + } diff --git a/c2hs/toplevel/C2HSConfig.hs b/c2hs/toplevel/C2HSConfig.hs new file mode 100644 --- /dev/null +++ b/c2hs/toplevel/C2HSConfig.hs @@ -0,0 +1,172 @@ +-- -*-haskell-*- +-- ** @configure_input@ ** +-- =========================================================================== +-- C -> Haskell Compiler: configuration +-- +-- Author : Manuel M T Chakravarty +-- Created: 27 September 99 +-- +-- Copyright (c) [1999..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- DESCRIPTION --------------------------------------------------------------- +-- +-- Configuration options; largely set by `configure'. +-- +--- TODO ---------------------------------------------------------------------- +-- + +module C2HSConfig ( + -- + -- programs and paths + -- + cpp, cppopts, libfname, hpaths, + -- + -- parameters of the targeted C compiler + -- + PlatformSpec(..), defaultPlatformSpec, platformSpecDB +) where + +import Foreign (toBool) +import Foreign.C (CInt) +import System.Info (arch, os) + +-- program settings +-- ---------------- + +-- |C preprocessor executable +-- +cpp :: FilePath +cpp = "cpp" + +-- |C preprocessor options +-- +-- * `-x c' forces CPP to regard the input as C code; this option seems to be +-- understood at least on Linux, FreeBSD, and Solaris and seems to make a +-- difference over the default language setting on FreeBSD +-- +-- * `-P' would suppress `#line' directives +-- +cppopts :: String +cppopts = case os of + "darwin" -> "-x=c" --why oh why must gcc on OSX be different!? + _ -> "-x c" + +-- |C2HS Library file name +-- +libfname :: FilePath +libfname = "C2HS.hs" + +-- |Standard system search paths for header files +-- +hpaths :: [FilePath] +hpaths = [".", "/usr/include", "/usr/local/include"] + +-- parameters of the targeted C compiler +-- ------------------------------------- + +-- Parameters that characterise implementation-dependent features of the +-- targeted C compiler +-- +data PlatformSpec = PlatformSpec { + identPS :: String, -- platform identifier + bitfieldDirectionPS :: Int, -- to fill bitfields + bitfieldPaddingPS :: Bool, -- padding or split? + bitfieldIntSignedPS :: Bool, -- `int' signed bitf.? + bitfieldAlignmentPS :: Int -- alignment constraint + } + +instance Show PlatformSpec where + show (PlatformSpec ident dir pad intSig align) = + show ident ++ " <" ++ show dir ++ ", " ++ show pad ++ ", " ++ + show intSig ++ ", " ++ show align ++ ">" + +-- Platform specification for the C compiler used to compile c2hs (which is +-- the default target). +-- +defaultPlatformSpec :: PlatformSpec +defaultPlatformSpec = PlatformSpec { + identPS = arch ++ "-" ++ os, + bitfieldDirectionPS = bitfieldDirection, + bitfieldPaddingPS = bitfieldPadding, + bitfieldIntSignedPS = bitfieldIntSigned, + bitfieldAlignmentPS = bitfieldAlignment + } + +-- The set of platform specification that may be choosen for cross compiling +-- bindings. +-- +platformSpecDB :: [PlatformSpec] +platformSpecDB = + [ + PlatformSpec { + identPS = "x86_64-linux", + bitfieldDirectionPS = 1, + bitfieldPaddingPS = True, + bitfieldIntSignedPS = True, + bitfieldAlignmentPS = 1 + }, + PlatformSpec { + identPS = "i686-linux", + bitfieldDirectionPS = 1, + bitfieldPaddingPS = True, + bitfieldIntSignedPS = True, + bitfieldAlignmentPS = 1 + }, + PlatformSpec { + identPS = "m68k-palmos", + bitfieldDirectionPS = -1, + bitfieldPaddingPS = True, + bitfieldIntSignedPS = True, + bitfieldAlignmentPS = 1 + } + ] + +-- indicates in which direction the C compiler fills bitfields (EXPORTED) +-- +-- * the value is 1 or -1, depending on whether the direction is growing +-- towards the MSB +-- +bitfieldDirection :: Int +bitfieldDirection = fromIntegral bitfield_direction + +foreign import ccall "c2hs_config.h" bitfield_direction :: CInt + +-- indicates whether a bitfield that does not fit into a partially filled +-- storage unit in its entirety introduce padding or split over two storage +-- units (EXPORTED) +-- +-- * `True' means that such a bitfield introduces padding (instead of being +-- split) +-- +bitfieldPadding :: Bool +bitfieldPadding = toBool bitfield_padding + +foreign import ccall "c2hs_config.h" bitfield_padding :: CInt + +-- indicates whether a bitfield of type `int' is signed in the targeted C +-- compiler (EXPORTED) +-- +bitfieldIntSigned :: Bool +bitfieldIntSigned = toBool bitfield_int_signed + +foreign import ccall "c2hs_config.h" bitfield_int_signed :: CInt + +-- the alignment constraint for a bitfield (EXPORTED) +-- +-- * this makes the assumption that the alignment of a bitfield is independent +-- of the bitfield's size +-- +bitfieldAlignment :: Int +bitfieldAlignment = fromIntegral bitfield_alignment + +foreign import ccall "c2hs_config.h" bitfield_alignment :: CInt diff --git a/c2hs/toplevel/Main.hs b/c2hs/toplevel/Main.hs new file mode 100644 --- /dev/null +++ b/c2hs/toplevel/Main.hs @@ -0,0 +1,629 @@ +-- C->Haskell Compiler: main module +-- +-- Copyright (c) [1999..2005] Manuel M T Chakravarty +-- +-- This file is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- This file is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- This is the main module of the compiler. It sets the version, processes +-- the command line arguments, and controls the compilation process. +-- +-- Usage: +-- ------ +-- +-- c2hs [ option... ] [header-file] binding-file +-- +-- The compiler is supposed to emit a Haskell program that expands all hooks +-- in the given binding file. +-- +-- File name suffix: +-- ----------------- +-- +-- Note: These also depend on suffixes defined in the compiler proper. +-- +-- .h C header file +-- .i pre-processeed C header file +-- .hs Haskell file +-- .chs Haskell file with C->Haskell hooks (binding file) +-- .chi C->Haskell interface file +-- +-- Options: +-- -------- +-- +-- -C CPPOPTS +-- --cppopts=CPPOPTS +-- Pass the additional options CPPOPTS to the C preprocessor. +-- +-- Repeated occurences accumulate. +-- +-- -c CPP +-- --cpp=CPP +-- Use the executable CPP to invoke CPP. +-- +-- In the case of repeated occurences, the last takes effect. +-- +-- -d TYPE +-- --dump=TYPE +-- Dump intermediate representation: +-- +-- + if TYPE is `trace', trace the compiler phases (to stderr) +-- + if TYPE is `genbind', trace binding generation (to stderr) +-- + if TYPE is `ctrav', trace C declaration traversal (to stderr) +-- + if TYPE is `chs', dump the binding file (insert `.dump' into the +-- file name to avoid overwriting the original file) +-- +-- -h, -? +-- --help +-- Dump brief usage information to stderr. +-- +-- -i DIRS +-- --include=DIRS +-- Search the colon separated list of directories DIRS when searching +-- for .chi files. +-- +-- -k +-- --keep +-- Keep the intermediate file that contains the pre-processed C header +-- (it carries the suffix `.i'). +-- +-- -l +-- --copy-library +-- Copies the library module `C2HS' into the same directory where the +-- generated code from the binding file is placed. +-- +-- -o FILE +-- --output=FILE +-- Place output in file FILE. +-- +-- If `-o' is not specified, the default is to put the output for +-- `source.chs' in `source.hs' in the same directory that contains the +-- binding file. If specified, the emitted C header file is put into +-- the same directory as the output file. The same holds for +-- C->Haskell interface file. All generated files also share the +-- basename. +-- +-- -p PLATFORM +-- --platform=PLATFORM +-- Generate output for the given PLATFORM. By default we generate +-- output for the platform that c2hs executes on. +-- +-- -t PATH +-- --output-dir=PATH +-- Place generated files in the directory PATH. +-- +-- If this option as well as the `-o' option is given, the basename of +-- the file specified with `-o' is put in the directory specified with +-- `-t'. +-- +-- -v, +-- --version +-- Print (on standard output) the version and copyright +-- information of the compiler (before doing anything else). +-- +--- TODO ---------------------------------------------------------------------- +-- + +module Main (main) +where + +-- standard libraries +import Data.List (isPrefixOf, intersperse, partition) +import Control.Monad (when, unless) +import Data.Version (showVersion) + +-- base libraries +import System.Console.GetOpt + (ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, getOpt) +import qualified System.FilePath as FilePath + (takeExtension, dropExtension, takeDirectory, takeBaseName) +import System.FilePath ((<.>), ()) +import StateBase (liftIO) + +-- c2hs modules +import C2HSState (CST, runC2HS, fatal, fatalsHandledBy, + ExitCode(..), stderr, putStrCIO, putStrLnCIO, + hPutStrCIO, printCIO, + hPutStrLnCIO, exitWithCIO, getArgsCIO, getProgNameCIO, + ioeGetErrorString, ioeGetFileName, removeFileCIO, + systemCIO, readFileCIO, writeFileCIO, + SwitchBoard(..), Traces(..), setTraces, + traceSet, setSwitch, getSwitch, putTraceStr) +import C (hsuffix, isuffix, loadAttrC) +import CHS (loadCHS, dumpCHS, hssuffix, chssuffix, dumpCHI) +import GenHeader (genHeader) +import GenBind (expandHooks) +import Version (versnum, version, copyright, disclaimer) +import C2HSConfig (cpp, cppopts, libfname, PlatformSpec(..), + defaultPlatformSpec, platformSpecDB) +import Paths_c2hs (getDataDir) + + +-- wrapper running the compiler +-- ============================ + +main :: IO () +main = runC2HS compile + + +-- option handling +-- =============== + +-- header is output in case of help, before the descriptions of the options; +-- errTrailer is output after an error message +-- +header :: String +header = + version ++ "\n" ++ copyright ++ "\n" ++ disclaimer + ++ "\n\nUsage: c2hs [ option... ] [header-file] binding-file\n" + +trailer, errTrailer :: String +trailer = "\n\ + \The header file must be a C header file matching the given \ + \binding file.\n\ + \The dump TYPE can be\n\ + \ trace -- trace compiler phases\n\ + \ genbind -- trace binding generation\n\ + \ ctrav -- trace C declaration traversal\n\ + \ chs -- dump the binding file (adds `.dump' to the name)\n" +errTrailer = "Try the option `--help' on its own for more information.\n" + +-- supported option types +-- +data Flag = CPPOpts String -- additional options for C preprocessor + | CPP String -- program name of C preprocessor + | Dump DumpType -- dump internal information + | Help -- print brief usage information + | Keep -- keep the .i file + | Library -- copy library module `C2HS' + | Include String -- list of directories to search .chi files + | Output String -- file where the generated file should go + | Platform String -- target platform to generate code for + | OutDir String -- directory where generates files should go + | Version -- print version information on stdout + | NumericVersion -- print numeric version on stdout + | Error String -- error occured during processing of options + deriving Eq + +data DumpType = Trace -- compiler trace + | GenBind -- trace `GenBind' + | CTrav -- trace `CTrav' + | CHS -- dump binding file + deriving Eq + +-- option description suitable for `GetOpt' +-- +options :: [OptDescr Flag] +options = [ + Option ['C'] + ["cppopts"] + (ReqArg CPPOpts "CPPOPTS") + "pass CPPOPTS to the C preprocessor", + Option ['c'] + ["cpp"] + (ReqArg CPP "CPP") + "use executable CPP to invoke C preprocessor", + Option ['d'] + ["dump"] + (ReqArg dumpArg "TYPE") + "dump internal information (for debugging)", + Option ['h', '?'] + ["help"] + (NoArg Help) + "brief help (the present message)", + Option ['i'] + ["include"] + (ReqArg Include "INCLUDE") + "include paths for .chi files", + Option ['k'] + ["keep"] + (NoArg Keep) + "keep pre-processed C header", + Option ['l'] + ["copy-library"] + (NoArg Library) + "copy `C2HS' library module in", + Option ['o'] + ["output"] + (ReqArg Output "FILE") + "output result to FILE (should end in .hs)", + Option ['p'] + ["platform"] + (ReqArg Platform "PLATFORM") + "platform to use for cross compilation", + Option ['t'] + ["output-dir"] + (ReqArg OutDir "PATH") + "place generated files in PATH", + Option ['v'] + ["version"] + (NoArg Version) + "show version information", + Option [] + ["numeric-version"] + (NoArg NumericVersion) + "show version number"] + +-- convert argument of `Dump' option +-- +dumpArg :: String -> Flag +dumpArg "trace" = Dump Trace +dumpArg "genbind" = Dump GenBind +dumpArg "ctrav" = Dump CTrav +dumpArg "chs" = Dump CHS +dumpArg _ = Error "Illegal dump type." + +-- main process (set up base configuration, analyse command line, and execute +-- compilation process) +-- +-- * Exceptions are caught and reported +-- +compile :: CST s () +compile = + do + setup + cmdLine <- getArgsCIO + case getOpt RequireOrder options cmdLine of + (opts, [] , []) + | noCompOpts opts -> doExecute opts Nothing + (opts, args, []) -> case parseArgs args of + args@(Just _) -> doExecute opts args + Nothing -> raiseErrs [wrongNoOfArgsErr] + (_ , _ , errs) -> raiseErrs errs + where + -- These options can be used without specifying a binding module. Then, + -- the corresponding action is executed without any compilation to take + -- place. (There can be --data and --output-dir (-t) options in addition + -- to the action.) + -- + aloneOptions = [Help, Version, NumericVersion, Library] + -- + noCompOpts opts = let nonDataOpts = filter nonDataOrDir opts + in + (not . null) nonDataOpts && + all (`elem` aloneOptions) nonDataOpts + where + nonDataOrDir (OutDir _) = False + nonDataOrDir _ = True + -- + parseArgs :: [FilePath] -> Maybe (FilePath, [FilePath]) + parseArgs = parseArgs' [] Nothing + where parseArgs' hs (Just chs) [] = Just (chs, reverse hs) + parseArgs' hs chs@Nothing (file:files) + | FilePath.takeExtension file == '.':chssuffix + = parseArgs' hs (Just file) files + parseArgs' hs chs (file:files) + | FilePath.takeExtension file == '.':hsuffix + = parseArgs' (file:hs) chs files + parseArgs' _ _ _ = Nothing + -- + doExecute opts args = do + execute opts args + `fatalsHandledBy` failureHandler + exitWithCIO ExitSuccess + -- + wrongNoOfArgsErr = + "There must be exactly one binding file (suffix .chs),\n\ + \and optionally one or more header files (suffix .h).\n" + -- + -- exception handler + -- + failureHandler err = + do + let msg = ioeGetErrorString err + fnMsg = case ioeGetFileName err of + Nothing -> "" + Just s -> " (file: `" ++ s ++ "')" + hPutStrLnCIO stderr (msg ++ fnMsg) + exitWithCIO $ ExitFailure 1 + +-- set up base configuration +-- +setup :: CST s () +setup = do + setCPP cpp + addCPPOpts cppopts + +-- output error message +-- +raiseErrs :: [String] -> CST s a +raiseErrs errs = do + hPutStrCIO stderr (concat errs) + hPutStrCIO stderr errTrailer + exitWithCIO $ ExitFailure 1 + +-- Process tasks +-- ------------- + +-- execute the compilation task +-- +-- * if `Help' is present, emit the help message and ignore the rest +-- * if `Version' is present, do it first (and only once) +-- * actual compilation is only invoked if we have one or two extra arguments +-- (otherwise, it is just skipped) +-- +execute :: [Flag] -> Maybe (FilePath, [FilePath]) -> CST s () +execute opts args | Help `elem` opts = help + | otherwise = + do + let (vs,opts') = partition (\opt -> opt == Version + || opt == NumericVersion) opts + mapM_ processOpt (atMostOne vs ++ opts') + case args of + Just (bndFile, headerFiles) -> do + let bndFileWithoutSuffix = FilePath.dropExtension bndFile + computeOutputName bndFileWithoutSuffix + process headerFiles bndFileWithoutSuffix + `fatalsHandledBy` die + Nothing -> + computeOutputName "." -- we need the output name for library copying + copyLibrary + `fatalsHandledBy` die + where + atMostOne = (foldl (\_ x -> [x]) []) + -- + die ioerr = + do + name <- getProgNameCIO + putStrCIO $ name ++ ": " ++ ioeGetErrorString ioerr ++ "\n" + exitWithCIO $ ExitFailure 1 + +-- emit help message +-- +help :: CST s () +help = + do + putStrCIO (usageInfo header options) + putStrCIO trailer + putStrCIO $ "PLATFORM can be " ++ hosts ++ "\n" + putStrCIO $ " (default is " ++ identPS defaultPlatformSpec ++ ")\n" + where + hosts = (concat . intersperse ", " . map identPS) platformSpecDB + +-- process an option +-- +-- * `Help' cannot occur +-- +processOpt :: Flag -> CST s () +processOpt (CPPOpts cppopts) = addCPPOpts cppopts +processOpt (CPP cpp ) = setCPP cpp +processOpt (Dump dt ) = setDump dt +processOpt (Keep ) = setKeep +processOpt (Library ) = setLibrary +processOpt (Include dirs ) = setInclude dirs +processOpt (Output fname ) = setOutput fname +processOpt (Platform fname ) = setPlatform fname +processOpt (OutDir fname ) = setOutDir fname +processOpt Version = do + putStrLnCIO version + platform <- getSwitch platformSB + putStrCIO " build platform is " + printCIO platform +processOpt NumericVersion = putStrLnCIO (showVersion versnum) +processOpt (Error msg ) = abort msg + +-- emit error message and raise an error +-- +abort :: String -> CST s () +abort msg = do + hPutStrLnCIO stderr msg + hPutStrCIO stderr errTrailer + fatal "Error in command line options" + +-- Compute the base name for all generated files (Haskell, C header, and .chi +-- file) +-- +-- * The result is available from the `outputSB' switch +-- +computeOutputName :: FilePath -> CST s () +computeOutputName bndFileNoSuffix = + setSwitch $ \sb@SwitchBoard{ outputSB = output } -> + sb { outputSB = if null output then bndFileNoSuffix else output } + +-- Copy the C2HS library if requested +-- +copyLibrary = + do + outdir <- getSwitch outDirSB + library <- getSwitch librarySB + datadir <- liftIO getDataDir + let libFullName = datadir libfname + libDestName = outdir libfname + when library $ + readFileCIO libFullName >>= writeFileCIO libDestName + + +-- set switches +-- ------------ + +-- set the options for the C proprocessor +-- +addCPPOpts :: String -> CST s () +addCPPOpts opts = + do + let iopts = [opt | opt <- words opts, "-I" `isPrefixOf` opt, "-I-" /= opt] + addOpts opts + where + addOpts opts = setSwitch $ + \sb -> sb {cppOptsSB = cppOptsSB sb ++ (' ':opts)} + +-- set the program name of the C proprocessor +-- +setCPP :: FilePath -> CST s () +setCPP fname = setSwitch $ \sb -> sb {cppSB = fname} + +-- set the given dump option +-- +setDump :: DumpType -> CST s () +setDump Trace = setTraces $ \ts -> ts {tracePhasesSW = True} +setDump GenBind = setTraces $ \ts -> ts {traceGenBindSW = True} +setDump CTrav = setTraces $ \ts -> ts {traceCTravSW = True} +setDump CHS = setTraces $ \ts -> ts {dumpCHSSW = True} + +-- set flag to keep the pre-processed header file +-- +setKeep :: CST s () +setKeep = setSwitch $ \sb -> sb {keepSB = True} + +-- set flag to copy library module in +-- +setLibrary :: CST s () +setLibrary = setSwitch $ \sb -> sb {librarySB = True} + +-- set the search directories for .chi files +-- +-- * Several -i flags are accumulated. Later paths have higher priority. +-- +-- * The current directory is always searched last because it is the +-- standard value in the compiler state. +-- +setInclude :: String -> CST s () +setInclude str = do + let fp = makePath str "" + setSwitch $ \sb -> sb {chiPathSB = fp ++ (chiPathSB sb)} + where + makePath ('\\':r:em) path = makePath em (path ++ ['\\',r]) + makePath (' ':rem) path = makePath rem path + makePath (':':rem) "" = makePath rem "" + makePath (':':rem) path = path : makePath rem "" + makePath ('/':':':rem) path = path : makePath rem "" + makePath (r:emain) path = makePath emain (path ++ [r]) + makePath "" "" = [] + makePath "" path = [path] + +-- set the output file name +-- +setOutput :: FilePath -> CST s () +setOutput fname = do + when (FilePath.takeExtension fname /= '.':hssuffix) $ + raiseErrs ["Output file should end in .hs!\n"] + setSwitch $ \sb -> sb {outputSB = FilePath.dropExtension fname} + +-- set platform +-- +setPlatform :: String -> CST s () +setPlatform platform = + case lookup platform platformAL of + Nothing -> raiseErrs ["Unknown platform `" ++ platform ++ "'\n"] + Just p -> setSwitch $ \sb -> sb {platformSB = p} + where + platformAL = [(identPS p, p) | p <- platformSpecDB] + +-- set the output directory +-- +setOutDir :: FilePath -> CST s () +setOutDir fname = setSwitch $ \sb -> sb {outDirSB = fname} + +-- set the name of the generated header file +-- +setHeader :: FilePath -> CST s () +setHeader fname = setSwitch $ \sb -> sb {headerSB = fname} + + +-- compilation process +-- ------------------- + +-- read the binding module, construct a header, run it through CPP, read it, +-- and finally generate the Haskell target +-- +-- * the header file name (first argument) may be empty; otherwise, it already +-- contains the right suffix +-- +-- * the binding file name has been stripped of the .chs suffix +-- +process :: [FilePath] -> FilePath -> CST s () +process headerFiles bndFile = + do + -- load the Haskell binding module + -- + (chsMod , warnmsgs) <- loadCHS bndFile + putStrCIO warnmsgs + traceCHSDump chsMod + -- + -- extract CPP and inline-C embedded in the .chs file (all CPP and + -- inline-C fragments are removed from the .chs tree and conditionals are + -- replaced by structured conditionals) + -- + (header, strippedCHSMod, warnmsgs) <- genHeader chsMod + putStrCIO warnmsgs + -- + -- create new header file, make it #include `headerFile', and emit + -- CPP and inline-C of .chs file into the new header + -- + outFName <- getSwitch outputSB + outDir <- getSwitch outDirSB + let newHeader = outFName <.> chssuffix <.> hsuffix + newHeaderFile = outDir newHeader + preprocFile = FilePath.takeBaseName outFName <.> isuffix + writeFileCIO newHeaderFile $ concat $ + [ "#include \"" ++ headerFile ++ "\"\n" + | headerFile <- headerFiles ] + ++ header + -- + -- Check if we can get away without having to keep a separate .chs.h file + -- + case headerFiles of + [headerFile] | null header + -> setHeader headerFile -- the generated .hs file will directly + -- refer to this header rather than going + -- through a one-line .chs.h file. + _ -> setHeader newHeader + -- + -- run C preprocessor over the header + -- + cpp <- getSwitch cppSB + cppOpts <- getSwitch cppOptsSB + let cmd = unwords [cpp, cppOpts, newHeaderFile, ">" ++ preprocFile] + tracePreproc cmd + exitCode <- systemCIO cmd + case exitCode of + ExitFailure _ -> fatal "Error during preprocessing custom header file" + _ -> return () + -- + -- load and analyse the C header file + -- + (cheader, warnmsgs) <- loadAttrC preprocFile + putStrCIO warnmsgs + -- + -- remove the pre-processed header and if we no longer need it, remove the + -- custom header file too. + -- + keep <- getSwitch keepSB + unless keep $ do + removeFileCIO preprocFile + case headerFiles of + [headerFile] | null header + -> removeFileCIO newHeaderFile + _ -> return () -- keep it since we'll need it to compile the .hs file + -- + -- expand binding hooks into plain Haskell + -- + (hsMod, chi, warnmsgs) <- expandHooks cheader strippedCHSMod + putStrCIO warnmsgs + -- + -- output the result + -- + dumpCHS (outDir outFName) hsMod True + dumpCHI (outDir outFName) chi -- different suffix will be appended + where + tracePreproc cmd = putTraceStr tracePhasesSW $ + "Invoking cpp as `" ++ cmd ++ "'...\n" + traceCHSDump mod = do + flag <- traceSet dumpCHSSW + when flag $ + (do + putStrCIO ("...dumping CHS to `" ++ chsName + ++ "'...\n") + dumpCHS chsName mod False) + + chsName = FilePath.takeBaseName bndFile <.> "dump" diff --git a/c2hs/toplevel/Version.hs b/c2hs/toplevel/Version.hs new file mode 100644 --- /dev/null +++ b/c2hs/toplevel/Version.hs @@ -0,0 +1,16 @@ +module Version (versnum, version, copyright, disclaimer) -- -*-haskell-*- +where + +import qualified Paths_c2hs (version) +import Data.Version (showVersion) + +name = "C->Haskell Compiler" +versnum = Paths_c2hs.version +versnick = "Rainy Days" +date = "31 Aug 2007" +version = name ++ ", version " ++ showVersion versnum ++ " " ++ versnick ++ ", " ++ date +copyright = "Copyright (c) [1999..2007] Manuel M T Chakravarty" +disclaimer = "This software is distributed under the \ + \terms of the GNU Public Licence.\n\ + \NO WARRANTY WHATSOEVER IS PROVIDED. \ + \See the details in the documentation." diff --git a/c2hs/toplevel/c2hs_config.c b/c2hs/toplevel/c2hs_config.c new file mode 100644 --- /dev/null +++ b/c2hs/toplevel/c2hs_config.c @@ -0,0 +1,125 @@ +/* C -> Haskell Compiler: configuration query routines + * + * Author : Manuel M T Chakravarty + * Created: 12 November 1 + * + * Copyright (c) [2001..2002] Manuel M T Chakravarty + * + * This file is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This file is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * DESCRIPTION --------------------------------------------------------------- + * + * Runtime configuration query functions + * + * TODO ---------------------------------------------------------------------- + */ + +#include "c2hs_config.h" + +/* compute the direction in which bitfields are growing + * ==================================================== + */ + +union bitfield_direction_union { + unsigned int allbits; + struct { + unsigned int first_bit : 1; + unsigned int second_bit : 1; + } twobits; +}; + +int bitfield_direction () +{ + union bitfield_direction_union v; + + /* if setting the second bit in a bitfield makes the storeage unit contain + * the value `2', the direction of bitfields must be increasing towards the + * MSB + */ + v.allbits = 0; + v.twobits.second_bit = 1; + + return (2 == v.allbits ? 1 : -1); +} + + +/* use padding for overspilling bitfields? + * ======================================= + */ + +union bitfield_padding_union { + struct { + unsigned int allbits1; + unsigned int allbits2; + } allbits; + struct { + unsigned int first_bit : 1; + int full_unit : sizeof (int) * 8; + } somebits; +}; + +int bitfield_padding () +{ + union bitfield_padding_union v; + + /* test whether more than one bit of `full_unit' spills over into `allbits2' + */ + v.allbits.allbits1 = 0; + v.allbits.allbits2 = 0; + v.somebits.full_unit = -1; + + return v.allbits.allbits2 == -1; +} + +/* is an `int' bitfield signed? + * ============================ + */ + +union bitfield_int_signed_union { + struct { + unsigned int first_bit : 1; + unsigned int second_bit : 1; + } two_single_bits; + struct { + int two_bits : 2; + } two_bits; +}; + +int bitfield_int_signed () +{ + union bitfield_int_signed_union v; + + /* check whether a two bit field with both bits set, gives us a negative + * number; then, `int' bitfields must be signed + */ + v.two_single_bits.first_bit = 1; + v.two_single_bits.second_bit = 1; + + return v.two_bits.two_bits == -1; +} + + +/* alignment constraint for bitfields + * ================================== + */ + +struct bitfield_alignment_struct { + char start; + unsigned int bit : 1; + char end; +}; + +int bitfield_alignment () +{ + struct bitfield_alignment_struct v; + + return ((int) (&v.end - &v.start)) - 1; +} diff --git a/c2hs/toplevel/c2hs_config.h b/c2hs/toplevel/c2hs_config.h new file mode 100644 --- /dev/null +++ b/c2hs/toplevel/c2hs_config.h @@ -0,0 +1,35 @@ +/* C -> Haskell Compiler: configuration query header + * + * Author : Manuel M T Chakravarty + * Created: 12 November 1 + * + * Copyright (c) 2001 Manuel M T Chakravarty + * + * This file is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This file is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * DESCRIPTION --------------------------------------------------------------- + * + * Interface to the runtime configuration query functions. + * + * TODO ---------------------------------------------------------------------- + */ + +#ifndef C2HS_CONFIG +#define C2HS_CONFIG + +/* routines querying C compiler properties + */ +int bitfield_direction (); /* direction in which bitfields are growing */ +int bitfield_padding (); /* use padding for overspilling bitfields? */ +int bitfield_int_signed (); /* is an `int' bitfield signed? */ +int bitfield_alignment (); /* alignment constraint for bitfields */ + +#endif /* C2HS_CONFIG*/