{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module T15164 () where

data Version = VHDL1993
data T
data NT a

class Rule f a where
  get :: Decorator f => f a

class Monad f => Decorator f where
  n :: [Version] -> f a -> f (NT a) -- n stands for both NT as well as Node (in grammar tree)
  chr :: Char -> [Version] -> f T
  txt :: String -> [Version] -> f T -- token OPTIONALLY followed by spaces

  -- combinators
  m :: f a -> f [a]
  c :: [f a] -> f a -- c stands for choose
  o :: f a -> f (Maybe a) -- o stands for optional
  trace :: String -> f a -> f a

  -- helper functions in the grammar
  n93 :: Rule f a => f (NT a)
  n93 = n [VHDL1993] get

  parenOpen :: f T
  parenOpen = chr '(' [VHDL1993]

  parenClose :: f T
  parenClose = chr ')' [VHDL1993]

  comma :: f T
  comma = chr ',' [VHDL1993]

  moreComma :: Rule f a => f [(T, NT a)]
  moreComma = m $ do
    cc <- comma
    cont <- n93
    return (cc, cont)

type P_MaybeActualParameterPart = (Maybe (T, (NT ActualParameterPart), T))
maybeActualParameterPart :: Decorator f => f (Maybe (T, NT ActualParameterPart, T))
maybeActualParameterPart = o $ do
  po <- parenOpen
  app <- (n93 :: Decorator f => f (NT ActualParameterPart))
  pc <- parenClose
  return (po, app, pc)
-- helper function used with FormalPart and ActualPart
-- dcon '(' actual_designator ')'
mkNameOrTypeMark :: (Decorator m, Rule m a1, Rule m a) => (NT a -> T -> NT a1 -> T -> b) -> m b
mkNameOrTypeMark dcon = do
  name_typemark <- n93 -- either Name OR TypeMark depending on dcon !!
  po <- parenOpen
  fd  <- n93
  pc <- parenClose
  return $ dcon name_typemark po fd pc

-- actual_designator
--          ::= expression
--            | name
--            | 'OPEN'
data ActualDesignator = AD1 (NT Expression) | AD2 (NT Name) | AD3 T
instance Rule f ActualDesignator where
  get = trace "ActualDesignator" $ {-# SCC "get_ActualDesignator" #-} c
    [ AD3 <$> (txt "open" [VHDL1993]) -- order matters here
    , AD2 <$> n93 -- try a simple name first
    , AD1 <$> n93
    -- [ AD3 <$> txt "open" [VHDL1993] -- order matters here
    -- , AD2 <$> (n93 :: f (NT Name)) -- try a simple name first
    -- , AD1 <$> (n93 :: f (NT Expression))
    ]

-- actual_parameter_part
--          ::= association_list
newtype ActualParameterPart = APP (NT AssociationList)
instance Rule f AssociationList => Rule f ActualParameterPart where
  get = APP <$> n93

-- actual_part
--          ::= actual_designator
--            | ( name | type_mark ) '(' actual_designator ')'
data ActualPart = AP1 (NT ActualDesignator) | APName (NT Name) T (NT ActualDesignator) T | APTypeMark (NT TypeMark) T (NT ActualDesignator) T
instance (Rule f ActualDesignator, Rule f Name, Rule f TypeMark) => Rule f ActualPart where
  get = trace "ActualPart" $ {-# SCC "get_ActualPart" #-} c
    [ AP1 <$> n93
    , mkNameOrTypeMark APName
    , mkNameOrTypeMark APTypeMark
    ]

-- aggregate
--          ::= '(' element_association ( ',' element_association )* ')'
data Aggregate = MkAggregate T (NT ElementAssociation) [(T, (NT ElementAssociation))] T
instance Rule f ElementAssociation => Rule f Aggregate where
  get = do
    po <- parenOpen
    ea <- n93
    rest <- moreComma
    pc <- parenClose
    return $ MkAggregate po ea rest pc

-- allocator
--          ::= 'NEW' ( subtype_indication | qualified_expression )
data Allocator = A1 T (NT SubtypeIndication) | A2 T (NT QualifiedExpression)
instance (Rule f SubtypeIndication, Rule f QualifiedExpression) => Rule f Allocator where
  get = c
    [ A1 <$> (txt "new" [VHDL1993]) <*> n93
    , A2 <$> (txt "new" [VHDL1993]) <*> n93
    ]

-- association_element
--          ::= ( formal_part '=>' )? actual_part
data AssociationElement = AE (Maybe (NT FormalPart, T)) (NT ActualPart)
instance (Rule f FormalPart, Rule f ActualPart) => Rule f AssociationElement where
  get = do
    fp <- o $ do
      f <- n93
      a <- txt "=>" [VHDL1993]
      return (f, a)
    ap <- n93
    return $ AE fp ap

-- association_list
--          ::= association_element ( ',' association_element )*
data AssociationList = AL (NT AssociationElement) [(T, NT AssociationElement)]
instance Rule f AssociationElement => Rule f AssociationList where
  get = do
    ae <- n93
    rest <- moreComma
    return $ AL ae rest

-- attribute_name
--          ::= prefix signature? "'" attribute_designator ( '(' expression ')' )?
data AttributeName = AN (NT Prefix) (Maybe (NT TypeMark)) T (Maybe (T, (NT Expression), T))
instance (Rule f Prefix, Rule f TypeMark, Rule f Expression) => Rule f AttributeName where
  get = do
    pp <- n93
    ss <- o n93
    cc <- chr '\'' [VHDL1993]
    -- ad <- n93
    ee <- o $ do
      po <- parenOpen
      e <- n93
      pc <- parenClose
      return (po, e, pc)
    return $ AN pp ss cc ee

-- choice   ::= simple_expression
--            | discrete_range
--            | simple_name
--            | 'OTHERS'
data Choice =
  CSmimpleExpression (NT SimpleExpression)
  | CDiscreteRange (NT DiscreteRange)
  -- | CSimpleName (NT SimpleName)
  | COthers T

instance (Rule f SimpleExpression, Rule f DiscreteRange) => Rule f Choice where
  get = c
    [ CSmimpleExpression <$> n93
    , CDiscreteRange     <$> n93
    -- , CSimpleName        <$> n93
    , COthers            <$> txt "others" [VHDL1993]
    ]

-- constraint
--          ::= range_constraint
--            | index_constraint
data Constraint = CRange (NT RangeConstraint) | CIndex (NT DiscreteRange)
instance (Rule f RangeConstraint, Rule f DiscreteRange) => Rule f Constraint where
  get = c
    [ CRange <$> n93
    , CIndex <$> n93
    ]

-- discrete_range
--          ::= subtype_indication
--            | range
data DiscreteRange = DRSubtypeIndication (NT SubtypeIndication) | DRRange (NT Range)
instance (Rule f SubtypeIndication, Rule f Range) => Rule f DiscreteRange where
  get = c
    [ DRSubtypeIndication <$> n93
    , DRRange <$> n93
    ]

-- element_association
--          ::= ( choices '=>' )? expression
data ElementAssociation = EA (Maybe (NT Choice, T)) (NT Expression)
instance (Rule f Choice, Rule f Expression) => Rule f ElementAssociation where
  get = do
    c <- o $ do
      c <- n93
      a <- txt "=>" [VHDL1993]
      return (c, a)
    e <- n93
    return $ EA c e

-- expression
--          ::= relation ( ( 'AND' relation )* | ( 'OR' relation )* | ( 'XOR' relation )* | ( 'NAND' | 'NOR' ) relation | ( 'XNOR' relation )* )
data Expression =
  And (NT SimpleExpression) [(T, (NT SimpleExpression))]
  | Or (NT SimpleExpression) [(T, (NT SimpleExpression))]
  | Xor (NT SimpleExpression) [(T, (NT SimpleExpression))]
  | Nand (NT SimpleExpression) (T, (NT SimpleExpression))
  | Nor (NT SimpleExpression) (T, (NT SimpleExpression))
  | Xnor (NT SimpleExpression) [(T, (NT SimpleExpression))]

instance Rule f SimpleExpression => Rule f Expression where
  get = {-# SCC "get_IndexedName" #-} c
    [ And  <$> n93 <*> emore "and"
    , Or   <$> n93 <*> emore "or"
    , Xor  <$> n93 <*> emore "xor"
    , Nand <$> n93 <*> etwo "nand"
    , Nor  <$> n93 <*> etwo "nor"
    , Xnor <$> n93 <*> emore "xnor"
    ]
    where etwo tok = do
            n1 <- txt tok [VHDL1993]
            n2 <- n93
            return (n1, n2)
          emore tok = do
            m $ do
              n2 <- txt tok [VHDL1993]
              n3 <- n93
              return (n2, n3)

-- factor   ::= ( primary '**' | 'ABS' | 'NOT' )? primary
data Factor = FPower (NT Primary) (Maybe (T, (NT Primary))) | FAbs T (NT Primary) | FNot T (NT Primary)
instance Rule f Primary => Rule f Factor where
  get = trace "Factor" $ {-# SCC "get_Factor" #-} c -- c
    [ do
      p <- n93
      rest <- o $ do
        p <- txt "**" [VHDL1993]
        p2 <- n93
        return (p, p2)
      return $ FPower p rest
    , FAbs <$> (txt "abs" [VHDL1993]) <*> n93
    , FNot <$> (txt "not" [VHDL1993]) <*> n93
    ]

-- formal_designator
--          ::= name
newtype FormalDesignator = MkFormalDesignator (NT Name)
instance Rule f Name => Rule f FormalDesignator where
  get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} MkFormalDesignator <$> n93

-- formal_part
--          ::= formal_designator
--            | ( name | type_mark ) '(' formal_designator ')'
data FormalPart = FP1 (NT FormalDesignator) | FPName (NT Name) T (NT FormalDesignator) T | FPTypeMark (NT TypeMark) T (NT FormalDesignator) T
instance (Rule f FormalDesignator, Rule f Name, Rule f TypeMark) => Rule f FormalPart where
  get = trace "FormalPart" $ {-# SCC "get_FormalPart" #-} c
    [ FP1 <$> n93
    , mkNameOrTypeMark FPName
    , mkNameOrTypeMark FPTypeMark
    ]

-- function_call
--          ::= name ( '(' actual_parameter_part ')' )?
data FunctionCall = FC (NT Name) P_MaybeActualParameterPart
-- redundant: Rule f ActualParameterPart
instance Rule f Name => Rule f FunctionCall where
  get = trace "FunctionCall" $ {-# SCC "get_FunctionCall" #-} do
    nn <- n93
    app <- maybeActualParameterPart
    return $ FC nn app

-- index_constraint
--          ::= '(' discrete_range ( ',' discrete_range )* ')'
data IndexConstraint = IC T (NT DiscreteRange) [(T, NT DiscreteRange)] T
instance Rule f DiscreteRange => Rule f IndexConstraint where
  get = do
    po <- parenOpen
    dr <- n93
    rest <- moreComma
    pc <- parenClose
    return $ IC po dr rest pc

-- indexed_name
--          ::= prefix '(' expression ( ',' expression )* ')'
data IndexedName = IN (NT Prefix) T (NT Expression) [(T, NT Expression)] T
instance (Rule f Prefix, Rule f Expression) => Rule f IndexedName where
  get = {-# SCC "get_IndexedName" #-} do
    pp <- n93
    po <- parenOpen
    ee <- n93
    ee2 <- moreComma
    pc <- parenClose
    return $ IN pp po ee ee2 pc

-- literal  ::= numeric_literal
--            | enumeration_literal
--            | string_literal
--            | bit_string_literal
--            | 'NULL'
data Literal =
  LNumericLiteral (NT Name)
  -- | LEnumerationLiteral (NT EnumerationLiteral)
  -- | LStringLiteral (NT StringLiteral)
  -- | LBitStringLiteral (NT BitStringLiteral)
  | LNull T

instance (Rule f Name) => Rule f Literal where
  get = c
    [ LNumericLiteral     <$> n93
    -- , LEnumerationLiteral <$> n93
    -- , LStringLiteral      <$> n93
    -- , LBitStringLiteral   <$> n93
    , LNull               <$> txt "null" [VHDL1993]
    ]

-- name     ::= simple_name
--            | operator_symbol
--            | selected_name
--            | indexed_name
--            | slice_name
--            | attribute_name
data Name = N3 (NT Prefix) | N4 (NT IndexedName) | N6 (NT AttributeName)
instance (Rule f Prefix, Rule f IndexedName, Rule f AttributeName) => Rule f Name where
  get = trace "Name" $ {-# SCC "get_Name" #-} c
    [ N3 <$> n93
    , N4 <$> n93
    -- , N5 <$> n93
    , N6 <$> n93
    ]

-- prefix   ::= name
--            | function_call
data Prefix = PrefixName (NT Name) | PrefixFunctionCall (NT FunctionCall)
instance (Rule f Name, Rule f FunctionCall) => Rule f Prefix where
  get = trace "Prefix" $ {-# SCC "get_Prefix" #-} c
    [ PrefixName <$> n93
    , PrefixFunctionCall <$> n93
    ]

-- primary  ::= name
--            | literal
--            | aggregate
--            | function_call
--            | qualified_expression
--            | type_conversion
--            | allocator
--            | '(' expression ')'
data Primary =
  PName (NT Name)
  -- | PLiteral (NT Literal)
  | PAggregate (NT Aggregate)
  | PFunctionCall (NT FunctionCall)
  | PQualifiedExpression (NT QualifiedExpression)
  | PTypeConversion (NT TypeConversion)
  | PAllocator (NT Allocator)
  | PExpression T (NT Expression) T

--get_levels: instance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression, Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where
instance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression
         , Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where
  get = trace "Primary" $ {-# SCC "get_Primary" #-} c
    [ PName                <$> n93
    -- , PLiteral             <$> n93
    , PAggregate           <$> n93
    , PFunctionCall        <$> n93
    , PQualifiedExpression <$> n93
    , PTypeConversion      <$> n93
    , PAllocator           <$> n93
    ,                          exp
    -- [ PName <$> (n93 :: f (NT Name))
    -- , PLiteral <$> (n93 :: f (NT Literal))
    -- , PAggregate <$> (n93 :: f (NT Aggregate))
    -- , PFunctionCall <$> (n93 :: f (NT FunctionCall))
    -- , PQualifiedExpression <$> (n93 :: f (NT QualifiedExpression))
    -- , PTypeConversion <$> (n93 :: f (NT TypeConversion))
    -- , PAllocator <$> (n93 :: f (NT Allocator))
    -- , PExpression <$> parenOpen <*> (n93 :: f (NT Expression)) <*> parenClose
    -- , exp
    ]
    where exp = do
            po <- parenOpen
            ee  <- n93
            pc <- parenClose
            return $ PExpression po ee pc

-- qualified_expression
--          ::= type_mark "'" ( '(' expression ')' | aggregate )
data QualifiedExpression = QEExpression (NT TypeMark) T T (NT Expression) T | EQAggregate (NT TypeMark) T
instance (Rule f TypeMark, Rule f Expression) => Rule f QualifiedExpression where
  get = c [qexp, qagg]
    where qexp = do
            tm <- n93
            q  <- chr '\'' [VHDL1993]
            po <- parenOpen
            ee  <- n93
            pc <- parenClose
            return $ QEExpression tm q po ee pc
          qagg = do
            tm <- n93
            q  <- chr '\'' [VHDL1993]
            -- a  <- n93
            return $ EQAggregate tm q

-- range    ::= attribute_name
--            | simple_expression direction simple_expression
data Range = R1 (NT AttributeName) | R2 (NT SimpleExpression) (NT SimpleExpression)
instance (Rule f AttributeName, Rule f SimpleExpression) => Rule f Range where
  get = c
    [ R1 <$> n93
    , R2 <$> n93<*> n93
    ]

-- range_constraint
--          ::= 'range' range
data RangeConstraint = RC T (NT Range)
instance Rule f Range => Rule f RangeConstraint where
  get = do
    r1 <- txt "range" [VHDL1993]
    r2 <- n93
    return $ RC r1 r2

-- relation
--          ::= shift_expression ( relational_operator shift_expression )?
data Relation = R (NT SimpleExpression) (Maybe ((NT SimpleExpression)))
instance (Rule f SimpleExpression) => Rule f Relation where
  get = do
    se <- n93
    rest <- o $ do
      -- ro <- n93
      se <- n93
      return se
    return $ R se rest

-- shift_expression
--          ::= simple_expression ( shift_operator simple_expression )?
data ShiftExpression = ShiftE (NT SimpleExpression) (Maybe ((NT SimpleExpression)))
instance (Rule f SimpleExpression) => Rule f ShiftExpression where
  get = do
    se <- n93
    rest <- o $ do
      -- so <- n93
      se <- n93
      return se
    return $ ShiftE se rest

-- simple_expression
--          ::= sign? term ( adding_operator term )*
data SimpleExpression = SimpleE (NT Primary) [(NT Primary)]
-- data SimpleExpression = SimpleE T
instance (Rule f Primary) => Rule f SimpleExpression where
  -- get = SimpleE <$> txt "bla" [VHDL1993]
  get = do
    -- ss <- o n93
    tt <- n93
    rest <- m $ do
      -- ao <- n93
      tt2 <- n93
      return tt2
    return $ SimpleE tt rest

-- slice_name
--          ::= prefix '(' discrete_range ')'
data SliceName = SliceNPrefix (NT DiscreteRange)
instance Rule f DiscreteRange => Rule f SliceName where
  get = SliceNPrefix <$> n93

-- subtype_indication
--          ::= name? type_mark constraint?
data SubtypeIndication = SI (Maybe (NT Name)) (NT TypeMark) (Maybe (NT Constraint))
instance (Rule f Name, Rule f TypeMark, Rule f Constraint) => Rule f SubtypeIndication where
  get = trace "SubtypeIndication" $ {-# SCC "get_SubtypeIndication" #-} do
    nn <- o n93
    tm <- n93
    cc <- o n93
    return $ SI nn tm cc

-- type_conversion
--          ::= type_mark '(' expression ')'
data TypeConversion = MkTypeConversion (NT TypeMark) T (NT Expression) T
instance (Rule f TypeMark, Rule f Expression) => Rule f TypeConversion where
  get = do
    tm <- n93
    po <- parenOpen
    e  <- n93
    pc <- parenClose
    return $ MkTypeConversion tm po e pc

-- type_mark
--          ::= type_name | subtype_name
data TypeMark = TM1 (NT Name) | TM2 (NT Name)
instance Rule f Name => Rule f TypeMark where
  get = trace "TypeMark" $ {-# SCC "get_TypeMark" #-} c
    [ TM1 <$> n93
    , TM2 <$> n93
    ]


{-# LANGUAGE TemplateHaskell #-}

module Main where

import T16190_Embed
import Foreign.Ptr
import Foreign.Storable
import Data.Word
import GHC.Ptr

ptr :: Ptr Word32
ptr = Ptr $(embedBytes (replicate (3 * 1000 * 1000) 0x37))

main :: IO ()
main = do
   w <- peek (ptr `plusPtr` 12)
   print (w == (0x37373737 :: Word32))


module T16190_Embed where

import Data.Word
import Language.Haskell.TH

embedBytes :: [Word8] -> Q Exp
embedBytes bs = return (LitE (StringPrimL bs))


module T1969 where

class C a where
    c :: a -> String
    d :: a -> String
    d x = c x
    e :: a -> String
    e x = c x

data A1 = A1
instance C A1 where
    c A1 = "A1"

data A2 = A2
instance C A2 where
    c A2 = "A2"

data A3 = A3
instance C A3 where
    c A3 = "A3"

data A4 = A4
instance C A4 where
    c A4 = "A4"

data A5 = A5
instance C A5 where
    c A5 = "A5"

data A6 = A6
instance C A6 where
    c A6 = "A6"

data A7 = A7
instance C A7 where
    c A7 = "A7"

data A8 = A8
instance C A8 where
    c A8 = "A8"

data A9 = A9
instance C A9 where
    c A9 = "A9"

data A10 = A10
instance C A10 where
    c A10 = "A10"

data A11 = A11
instance C A11 where
    c A11 = "A11"

data A12 = A12
instance C A12 where
    c A12 = "A12"

data A13 = A13
instance C A13 where
    c A13 = "A13"

data A14 = A14
instance C A14 where
    c A14 = "A14"

data A15 = A15
instance C A15 where
    c A15 = "A15"

data A16 = A16
instance C A16 where
    c A16 = "A16"

data A17 = A17
instance C A17 where
    c A17 = "A17"

data A18 = A18
instance C A18 where
    c A18 = "A18"

data A19 = A19
instance C A19 where
    c A19 = "A19"

data A20 = A20
instance C A20 where
    c A20 = "A20"

data A21 = A21
instance C A21 where
    c A21 = "A21"

data A22 = A22
instance C A22 where
    c A22 = "A22"

data A23 = A23
instance C A23 where
    c A23 = "A23"

data A24 = A24
instance C A24 where
    c A24 = "A24"

data A25 = A25
instance C A25 where
    c A25 = "A25"

data A26 = A26
instance C A26 where
    c A26 = "A26"

data A27 = A27
instance C A27 where
    c A27 = "A27"

data A28 = A28
instance C A28 where
    c A28 = "A28"

data A29 = A29
instance C A29 where
    c A29 = "A29"

data A30 = A30
instance C A30 where
    c A30 = "A30"

data A31 = A31
instance C A31 where
    c A31 = "A31"

data A32 = A32
instance C A32 where
    c A32 = "A32"

data A33 = A33
instance C A33 where
    c A33 = "A33"

data A34 = A34
instance C A34 where
    c A34 = "A34"

data A35 = A35
instance C A35 where
    c A35 = "A35"

data A36 = A36
instance C A36 where
    c A36 = "A36"

data A37 = A37
instance C A37 where
    c A37 = "A37"

data A38 = A38
instance C A38 where
    c A38 = "A38"

data A39 = A39
instance C A39 where
    c A39 = "A39"

data A40 = A40
instance C A40 where
    c A40 = "A40"

data A41 = A41
instance C A41 where
    c A41 = "A41"

data A42 = A42
instance C A42 where
    c A42 = "A42"

data A43 = A43
instance C A43 where
    c A43 = "A43"

data A44 = A44
instance C A44 where
    c A44 = "A44"

data A45 = A45
instance C A45 where
    c A45 = "A45"

data A46 = A46
instance C A46 where
    c A46 = "A46"

data A47 = A47
instance C A47 where
    c A47 = "A47"

data A48 = A48
instance C A48 where
    c A48 = "A48"

data A49 = A49
instance C A49 where
    c A49 = "A49"

data A50 = A50
instance C A50 where
    c A50 = "A50"

data A51 = A51
instance C A51 where
    c A51 = "A51"

data A52 = A52
instance C A52 where
    c A52 = "A52"

data A53 = A53
instance C A53 where
    c A53 = "A53"

data A54 = A54
instance C A54 where
    c A54 = "A54"

data A55 = A55
instance C A55 where
    c A55 = "A55"

data A56 = A56
instance C A56 where
    c A56 = "A56"

data A57 = A57
instance C A57 where
    c A57 = "A57"

data A58 = A58
instance C A58 where
    c A58 = "A58"

data A59 = A59
instance C A59 where
    c A59 = "A59"

data A60 = A60
instance C A60 where
    c A60 = "A60"

data A61 = A61
instance C A61 where
    c A61 = "A61"

data A62 = A62
instance C A62 where
    c A62 = "A62"

data A63 = A63
instance C A63 where
    c A63 = "A63"

data A64 = A64
instance C A64 where
    c A64 = "A64"

data A65 = A65
instance C A65 where
    c A65 = "A65"

data A66 = A66
instance C A66 where
    c A66 = "A66"

data A67 = A67
instance C A67 where
    c A67 = "A67"

data A68 = A68
instance C A68 where
    c A68 = "A68"

data A69 = A69
instance C A69 where
    c A69 = "A69"

data A70 = A70
instance C A70 where
    c A70 = "A70"

data A71 = A71
instance C A71 where
    c A71 = "A71"

data A72 = A72
instance C A72 where
    c A72 = "A72"

data A73 = A73
instance C A73 where
    c A73 = "A73"

data A74 = A74
instance C A74 where
    c A74 = "A74"

data A75 = A75
instance C A75 where
    c A75 = "A75"

data A76 = A76
instance C A76 where
    c A76 = "A76"

data A77 = A77
instance C A77 where
    c A77 = "A77"

data A78 = A78
instance C A78 where
    c A78 = "A78"

data A79 = A79
instance C A79 where
    c A79 = "A79"

data A80 = A80
instance C A80 where
    c A80 = "A80"

data A81 = A81
instance C A81 where
    c A81 = "A81"

data A82 = A82
instance C A82 where
    c A82 = "A82"

data A83 = A83
instance C A83 where
    c A83 = "A83"

data A84 = A84
instance C A84 where
    c A84 = "A84"

data A85 = A85
instance C A85 where
    c A85 = "A85"

data A86 = A86
instance C A86 where
    c A86 = "A86"

data A87 = A87
instance C A87 where
    c A87 = "A87"

data A88 = A88
instance C A88 where
    c A88 = "A88"

data A89 = A89
instance C A89 where
    c A89 = "A89"

data A90 = A90
instance C A90 where
    c A90 = "A90"

data A91 = A91
instance C A91 where
    c A91 = "A91"

data A92 = A92
instance C A92 where
    c A92 = "A92"

data A93 = A93
instance C A93 where
    c A93 = "A93"

data A94 = A94
instance C A94 where
    c A94 = "A94"

data A95 = A95
instance C A95 where
    c A95 = "A95"

data A96 = A96
instance C A96 where
    c A96 = "A96"

data A97 = A97
instance C A97 where
    c A97 = "A97"

data A98 = A98
instance C A98 where
    c A98 = "A98"

data A99 = A99
instance C A99 where
    c A99 = "A99"

data A100 = A100
instance C A100 where
    c A100 = "A100"

data A101 = A101
instance C A101 where
    c A101 = "A101"

data A102 = A102
instance C A102 where
    c A102 = "A102"

data A103 = A103
instance C A103 where
    c A103 = "A103"

data A104 = A104
instance C A104 where
    c A104 = "A104"

data A105 = A105
instance C A105 where
    c A105 = "A105"

data A106 = A106
instance C A106 where
    c A106 = "A106"

data A107 = A107
instance C A107 where
    c A107 = "A107"

data A108 = A108
instance C A108 where
    c A108 = "A108"

data A109 = A109
instance C A109 where
    c A109 = "A109"

data A110 = A110
instance C A110 where
    c A110 = "A110"

data A111 = A111
instance C A111 where
    c A111 = "A111"

data A112 = A112
instance C A112 where
    c A112 = "A112"

data A113 = A113
instance C A113 where
    c A113 = "A113"

data A114 = A114
instance C A114 where
    c A114 = "A114"

data A115 = A115
instance C A115 where
    c A115 = "A115"

data A116 = A116
instance C A116 where
    c A116 = "A116"

data A117 = A117
instance C A117 where
    c A117 = "A117"

data A118 = A118
instance C A118 where
    c A118 = "A118"

data A119 = A119
instance C A119 where
    c A119 = "A119"

data A120 = A120
instance C A120 where
    c A120 = "A120"

data A121 = A121
instance C A121 where
    c A121 = "A121"

data A122 = A122
instance C A122 where
    c A122 = "A122"

data A123 = A123
instance C A123 where
    c A123 = "A123"

data A124 = A124
instance C A124 where
    c A124 = "A124"

data A125 = A125
instance C A125 where
    c A125 = "A125"

data A126 = A126
instance C A126 where
    c A126 = "A126"

data A127 = A127
instance C A127 where
    c A127 = "A127"

data A128 = A128
instance C A128 where
    c A128 = "A128"

data A129 = A129
instance C A129 where
    c A129 = "A129"

data A130 = A130
instance C A130 where
    c A130 = "A130"

data A131 = A131
instance C A131 where
    c A131 = "A131"

data A132 = A132
instance C A132 where
    c A132 = "A132"

data A133 = A133
instance C A133 where
    c A133 = "A133"

data A134 = A134
instance C A134 where
    c A134 = "A134"

data A135 = A135
instance C A135 where
    c A135 = "A135"

data A136 = A136
instance C A136 where
    c A136 = "A136"

data A137 = A137
instance C A137 where
    c A137 = "A137"

data A138 = A138
instance C A138 where
    c A138 = "A138"

data A139 = A139
instance C A139 where
    c A139 = "A139"

data A140 = A140
instance C A140 where
    c A140 = "A140"

data A141 = A141
instance C A141 where
    c A141 = "A141"

data A142 = A142
instance C A142 where
    c A142 = "A142"

data A143 = A143
instance C A143 where
    c A143 = "A143"

data A144 = A144
instance C A144 where
    c A144 = "A144"

data A145 = A145
instance C A145 where
    c A145 = "A145"

data A146 = A146
instance C A146 where
    c A146 = "A146"

data A147 = A147
instance C A147 where
    c A147 = "A147"

data A148 = A148
instance C A148 where
    c A148 = "A148"

data A149 = A149
instance C A149 where
    c A149 = "A149"

data A150 = A150
instance C A150 where
    c A150 = "A150"

data A151 = A151
instance C A151 where
    c A151 = "A151"

data A152 = A152
instance C A152 where
    c A152 = "A152"

data A153 = A153
instance C A153 where
    c A153 = "A153"

data A154 = A154
instance C A154 where
    c A154 = "A154"

data A155 = A155
instance C A155 where
    c A155 = "A155"

data A156 = A156
instance C A156 where
    c A156 = "A156"

data A157 = A157
instance C A157 where
    c A157 = "A157"

data A158 = A158
instance C A158 where
    c A158 = "A158"

data A159 = A159
instance C A159 where
    c A159 = "A159"

data A160 = A160
instance C A160 where
    c A160 = "A160"

data A161 = A161
instance C A161 where
    c A161 = "A161"

data A162 = A162
instance C A162 where
    c A162 = "A162"

data A163 = A163
instance C A163 where
    c A163 = "A163"

data A164 = A164
instance C A164 where
    c A164 = "A164"

data A165 = A165
instance C A165 where
    c A165 = "A165"

data A166 = A166
instance C A166 where
    c A166 = "A166"

data A167 = A167
instance C A167 where
    c A167 = "A167"

data A168 = A168
instance C A168 where
    c A168 = "A168"

data A169 = A169
instance C A169 where
    c A169 = "A169"

data A170 = A170
instance C A170 where
    c A170 = "A170"

data A171 = A171
instance C A171 where
    c A171 = "A171"

data A172 = A172
instance C A172 where
    c A172 = "A172"

data A173 = A173
instance C A173 where
    c A173 = "A173"

data A174 = A174
instance C A174 where
    c A174 = "A174"

data A175 = A175
instance C A175 where
    c A175 = "A175"

data A176 = A176
instance C A176 where
    c A176 = "A176"

data A177 = A177
instance C A177 where
    c A177 = "A177"

data A178 = A178
instance C A178 where
    c A178 = "A178"

data A179 = A179
instance C A179 where
    c A179 = "A179"

data A180 = A180
instance C A180 where
    c A180 = "A180"

data A181 = A181
instance C A181 where
    c A181 = "A181"

data A182 = A182
instance C A182 where
    c A182 = "A182"

data A183 = A183
instance C A183 where
    c A183 = "A183"

data A184 = A184
instance C A184 where
    c A184 = "A184"

data A185 = A185
instance C A185 where
    c A185 = "A185"

data A186 = A186
instance C A186 where
    c A186 = "A186"

data A187 = A187
instance C A187 where
    c A187 = "A187"

data A188 = A188
instance C A188 where
    c A188 = "A188"

data A189 = A189
instance C A189 where
    c A189 = "A189"

data A190 = A190
instance C A190 where
    c A190 = "A190"

data A191 = A191
instance C A191 where
    c A191 = "A191"

data A192 = A192
instance C A192 where
    c A192 = "A192"

data A193 = A193
instance C A193 where
    c A193 = "A193"

data A194 = A194
instance C A194 where
    c A194 = "A194"

data A195 = A195
instance C A195 where
    c A195 = "A195"

data A196 = A196
instance C A196 where
    c A196 = "A196"

data A197 = A197
instance C A197 where
    c A197 = "A197"

data A198 = A198
instance C A198 where
    c A198 = "A198"

data A199 = A199
instance C A199 where
    c A199 = "A199"

data A200 = A200
instance C A200 where
    c A200 = "A200"

data A201 = A201
instance C A201 where
    c A201 = "A201"

data A202 = A202
instance C A202 where
    c A202 = "A202"

data A203 = A203
instance C A203 where
    c A203 = "A203"

data A204 = A204
instance C A204 where
    c A204 = "A204"

data A205 = A205
instance C A205 where
    c A205 = "A205"

data A206 = A206
instance C A206 where
    c A206 = "A206"

data A207 = A207
instance C A207 where
    c A207 = "A207"

data A208 = A208
instance C A208 where
    c A208 = "A208"

data A209 = A209
instance C A209 where
    c A209 = "A209"

data A210 = A210
instance C A210 where
    c A210 = "A210"

data A211 = A211
instance C A211 where
    c A211 = "A211"

data A212 = A212
instance C A212 where
    c A212 = "A212"

data A213 = A213
instance C A213 where
    c A213 = "A213"

data A214 = A214
instance C A214 where
    c A214 = "A214"

data A215 = A215
instance C A215 where
    c A215 = "A215"

data A216 = A216
instance C A216 where
    c A216 = "A216"

data A217 = A217
instance C A217 where
    c A217 = "A217"

data A218 = A218
instance C A218 where
    c A218 = "A218"

data A219 = A219
instance C A219 where
    c A219 = "A219"

data A220 = A220
instance C A220 where
    c A220 = "A220"

data A221 = A221
instance C A221 where
    c A221 = "A221"

data A222 = A222
instance C A222 where
    c A222 = "A222"

data A223 = A223
instance C A223 where
    c A223 = "A223"

data A224 = A224
instance C A224 where
    c A224 = "A224"

data A225 = A225
instance C A225 where
    c A225 = "A225"

data A226 = A226
instance C A226 where
    c A226 = "A226"

data A227 = A227
instance C A227 where
    c A227 = "A227"

data A228 = A228
instance C A228 where
    c A228 = "A228"

data A229 = A229
instance C A229 where
    c A229 = "A229"

data A230 = A230
instance C A230 where
    c A230 = "A230"

data A231 = A231
instance C A231 where
    c A231 = "A231"

data A232 = A232
instance C A232 where
    c A232 = "A232"

data A233 = A233
instance C A233 where
    c A233 = "A233"

data A234 = A234
instance C A234 where
    c A234 = "A234"

data A235 = A235
instance C A235 where
    c A235 = "A235"

data A236 = A236
instance C A236 where
    c A236 = "A236"

data A237 = A237
instance C A237 where
    c A237 = "A237"

data A238 = A238
instance C A238 where
    c A238 = "A238"

data A239 = A239
instance C A239 where
    c A239 = "A239"

data A240 = A240
instance C A240 where
    c A240 = "A240"

data A241 = A241
instance C A241 where
    c A241 = "A241"

data A242 = A242
instance C A242 where
    c A242 = "A242"

data A243 = A243
instance C A243 where
    c A243 = "A243"

data A244 = A244
instance C A244 where
    c A244 = "A244"

data A245 = A245
instance C A245 where
    c A245 = "A245"

data A246 = A246
instance C A246 where
    c A246 = "A246"

data A247 = A247
instance C A247 where
    c A247 = "A247"

data A248 = A248
instance C A248 where
    c A248 = "A248"

data A249 = A249
instance C A249 where
    c A249 = "A249"

data A250 = A250
instance C A250 where
    c A250 = "A250"

data A251 = A251
instance C A251 where
    c A251 = "A251"

data A252 = A252
instance C A252 where
    c A252 = "A252"

data A253 = A253
instance C A253 where
    c A253 = "A253"

data A254 = A254
instance C A254 where
    c A254 = "A254"

data A255 = A255
instance C A255 where
    c A255 = "A255"

data A256 = A256
instance C A256 where
    c A256 = "A256"

data A257 = A257
instance C A257 where
    c A257 = "A257"

data A258 = A258
instance C A258 where
    c A258 = "A258"

data A259 = A259
instance C A259 where
    c A259 = "A259"

data A260 = A260
instance C A260 where
    c A260 = "A260"

data A261 = A261
instance C A261 where
    c A261 = "A261"

data A262 = A262
instance C A262 where
    c A262 = "A262"

data A263 = A263
instance C A263 where
    c A263 = "A263"

data A264 = A264
instance C A264 where
    c A264 = "A264"

data A265 = A265
instance C A265 where
    c A265 = "A265"

data A266 = A266
instance C A266 where
    c A266 = "A266"

data A267 = A267
instance C A267 where
    c A267 = "A267"

data A268 = A268
instance C A268 where
    c A268 = "A268"

data A269 = A269
instance C A269 where
    c A269 = "A269"

data A270 = A270
instance C A270 where
    c A270 = "A270"

data A271 = A271
instance C A271 where
    c A271 = "A271"

data A272 = A272
instance C A272 where
    c A272 = "A272"

data A273 = A273
instance C A273 where
    c A273 = "A273"

data A274 = A274
instance C A274 where
    c A274 = "A274"

data A275 = A275
instance C A275 where
    c A275 = "A275"

data A276 = A276
instance C A276 where
    c A276 = "A276"

data A277 = A277
instance C A277 where
    c A277 = "A277"

data A278 = A278
instance C A278 where
    c A278 = "A278"

data A279 = A279
instance C A279 where
    c A279 = "A279"

data A280 = A280
instance C A280 where
    c A280 = "A280"

data A281 = A281
instance C A281 where
    c A281 = "A281"

data A282 = A282
instance C A282 where
    c A282 = "A282"

data A283 = A283
instance C A283 where
    c A283 = "A283"

data A284 = A284
instance C A284 where
    c A284 = "A284"

data A285 = A285
instance C A285 where
    c A285 = "A285"

data A286 = A286
instance C A286 where
    c A286 = "A286"

data A287 = A287
instance C A287 where
    c A287 = "A287"

data A288 = A288
instance C A288 where
    c A288 = "A288"

data A289 = A289
instance C A289 where
    c A289 = "A289"

data A290 = A290
instance C A290 where
    c A290 = "A290"

data A291 = A291
instance C A291 where
    c A291 = "A291"

data A292 = A292
instance C A292 where
    c A292 = "A292"

data A293 = A293
instance C A293 where
    c A293 = "A293"

data A294 = A294
instance C A294 where
    c A294 = "A294"

data A295 = A295
instance C A295 where
    c A295 = "A295"

data A296 = A296
instance C A296 where
    c A296 = "A296"

data A297 = A297
instance C A297 where
    c A297 = "A297"

data A298 = A298
instance C A298 where
    c A298 = "A298"

data A299 = A299
instance C A299 where
    c A299 = "A299"

data A300 = A300
instance C A300 where
    c A300 = "A300"


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE Rank2Types, TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}

module T3064 where
import Control.Applicative

newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }

instance Functor f => Functor (ReaderT r f) where
  fmap f m = ReaderT $ (fmap f) . runReaderT m

instance Applicative f => Applicative (ReaderT r f) where
  pure m   = ReaderT (const $ pure m)
  f <*> v = ReaderT $ \r -> runReaderT f r <*> runReaderT v r

instance (Monad m) => Monad (ReaderT r m) where
    return a = ReaderT $ \_ -> return a
    m >>= k  = ReaderT $ \r -> do
        a <- runReaderT m r
        runReaderT (k a) r
    fail msg = ReaderT $ \_ -> fail msg

newtype ResourceT r s m v = ResourceT { unResourceT :: ReaderT r m v }
  deriving (Functor, Applicative, Monad)

data Ctx = Ctx

data Ch = Ch

type CAT s c = ResourceT [Ch] (s,c)

type CtxM c = ResourceT Ctx c IO

newtype CA s c v = CA { unCA :: CAT s c (CtxM c) v }
  deriving (Functor, Applicative, Monad)

class (Monad m) => MonadCA m where
  type CtxLabel m

instance MonadCA (CA s c) where
  type CtxLabel (CA s c) = c

instance (Monad m, MonadCA m, c ~ CtxLabel m) => MonadCA  (CAT s c m) where
  type CtxLabel (CAT s c m) = c

runCAT :: (forall s. CAT s c m v) -> m v
runCAT action = runReaderT (unResourceT action) []

newRgn :: MonadCA m => (forall s. CAT s (CtxLabel m) m v) -> m v
newRgn = runCAT

runCA :: (forall s c. CA s c v) -> IO v
runCA action = runCtxM (runCAT (unCA action))

runCtxM :: (forall c. CtxM c v) -> IO v
runCtxM action = runReaderT (unResourceT action) Ctx

{-

test4 :: IO ()
test4 = runCA(newRgn(newRgn(newRgn(newRgn(return())))))

test11 :: IO ()
test11 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return()))))))))))

test12 :: IO ()
test12 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return())))))))))))

test13 :: IO ()
test13 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return()))))))))))))

test14 :: IO ()
test14 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return())))))))))))))

test28 :: IO ()
test28 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return())))))))))))))))))))))))))
-}

test56 :: IO ()
test56 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(
               newRgn(newRgn(newRgn(newRgn(return())))))))))))))))))))))))))))))))))))))))))))))))))


module Main where

data X = X
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  {-# UNPACK #-} !Double
  deriving (Show)

main = print $ X 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1


module T4007 where

f :: IO ()
f = sequence_ (replicate 10 (putStrLn "yes"))


{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

module SlowComp where

import Control.Monad
import Data.Kind

-------------------------------------------------------------------------------
-- Usual Peano integers.

class NatInt a where
    natInt :: a -> Int

data D0 n = D0 {d0Arg :: n}
data D1 n = D1 {d1Arg :: n}

data C0
data C1

class DPosInt n where posInt :: n -> (Int,Int)
instance DPosInt () where posInt _ = (0,1)
instance DPosInt n => DPosInt (D0 n) where
        posInt a = (dsum,w*2)
                where
                        (dsum,w) = posInt $ d0Arg a
instance DPosInt n => DPosInt (D1 n) where
        posInt a = (dsum+w,w*2)
                where
                        (dsum,w) = posInt $ d1Arg a

instance NatInt () where natInt _ = 0
instance DPosInt n => NatInt (D0 n) where natInt a = fst $ posInt a
instance DPosInt n => NatInt (D1 n) where natInt a = fst $ posInt a

type family DRev a
type instance DRev a = DRev' a ()

type family DRev' x acc
type instance DRev' () acc = acc
type instance DRev' (D0 a) acc = DRev' a (D0 acc)
type instance DRev' (D1 a) acc = DRev' a (D1 acc)

type family DAddC c a b
type instance DAddC C0 (D0 a) (D0 b) = D0 (DAddC C0 a b)
type instance DAddC C0 (D1 a) (D0 b) = D1 (DAddC C0 a b)
type instance DAddC C0 (D0 a) (D1 b) = D1 (DAddC C0 a b)
type instance DAddC C0 (D1 a) (D1 b) = D0 (DAddC C1 a b)
type instance DAddC C1 (D0 a) (D0 b) = D1 (DAddC C0 a b)
type instance DAddC C1 (D1 a) (D0 b) = D0 (DAddC C1 a b)
type instance DAddC C1 (D0 a) (D1 b) = D0 (DAddC C1 a b)
type instance DAddC C1 (D1 a) (D1 b) = D1 (DAddC C1 a b)
type instance DAddC C0 ()     ()     = ()
type instance DAddC C1 ()     ()     = D1 ()
type instance DAddC c  (D0 a) ()     = DAddC c (D0 a) (D0 ())
type instance DAddC c  (D1 a) ()     = DAddC c (D1 a) (D0 ())
type instance DAddC c  ()     (D0 b) = DAddC c (D0 b) (D0 ())
type instance DAddC c  ()     (D1 b) = DAddC c (D1 b) (D0 ())

type family DNorm a
type instance DNorm () = D0 ()
type instance DNorm (D0 ()) = D0 ()
type instance DNorm (D0 (D1 a)) = D1 a
type instance DNorm (D0 (D0 a)) = DNorm a
type instance DNorm (D1 a) = D1 a

type family DPlus a b
type instance DPlus a b = DNorm (DRev (DAddC C0 (DRev a) (DRev b)))

type family DDepth a
type instance DDepth () = D0 ()
type instance DDepth (D0 ()) = D0 ()
type instance DDepth (D1 ()) = D1 ()
type instance DDepth (D1 (D0 n)) = DPlus ONE (DDepth (D1 n))
type instance DDepth (D1 (D1 n)) = DPlus ONE (DDepth (D1 n))

type family DLog2 a
type instance DLog2 a = DDepth a

type ZERO = D0 ()

type ONE = D1 ()
type TWO = DPlus ONE ONE
type THREE = DPlus ONE TWO
type FOUR = DPlus TWO TWO
type FIVE = DPlus ONE FOUR
type SIX = DPlus TWO FOUR
type SEVEN = DPlus ONE SIX
type EIGHT = DPlus FOUR FOUR
type NINE = DPlus FOUR FIVE
type TEN = DPlus EIGHT TWO
type SIZE8  = EIGHT
type SIZE9  = NINE
type SIZE10 = TEN
type SIZE12 = DPlus SIX SIX
type SIZE15 = DPlus EIGHT SEVEN
type SIZE16 = DPlus EIGHT EIGHT
type SIZE17 = DPlus ONE SIZE16
type SIZE24 = DPlus SIZE8 SIZE16
type SIZE32 = DPlus SIZE8 SIZE24
type SIZE30 = DPlus SIZE24 SIX

-------------------------------------------------------------------------------
-- Description of CPU.

class CPU cpu where
        -- register address.
        type RegAddrSize cpu
        -- register width
        type RegDataSize cpu
        -- immediate width.
        type ImmSize cpu
        -- variables in CPU - register indices, command format variables, etc.
        type CPUVars cpu :: Type -> Type

data Const size = Const Integer

data Var cpu size where
        Temp :: Int -> Var cpu size
        Var :: CPUVars cpu size -> Var cpu size

-------------------------------------------------------------------------------
-- Command description monad.

data Command cpu where
        Command :: (Var cpu size) -> (Operation cpu size) -> Command cpu

type RegVar cpu = Var cpu (RegDataSize cpu)
type Immediate cpu = Const (ImmSize cpu)

data Operation cpu resultSize where
        Add :: RegVar cpu -> Either (Immediate cpu) (RegVar cpu) -> Operation cpu (RegDataSize cpu)
        Sub :: RegVar cpu -> Either (Immediate cpu) (RegVar cpu) -> Operation cpu (RegDataSize cpu)

type CDM cpu a = IO a

($=) :: Var cpu size -> Operation cpu size -> CDM cpu ()
var $= op = undefined

tempVar :: CDM cpu (Var cpu size)
tempVar = do
        cnt <- liftM fst undefined
        return $ Temp cnt

op :: Operation cpu size -> CDM cpu (Var cpu size)
op operation = do
        v <- tempVar
        v $= operation
        return v

-------------------------------------------------------------------------------
-- Dummy CPU.

data DummyCPU = DummyCPU

data DummyVar size where
        DummyFlag :: Flag -> DummyVar ONE
        DummyReg :: Int -> DummyVar SIZE16
        DummyZero :: DummyVar SIZE16

data Flag = C | Z | N | V

instance CPU DummyCPU where
        type RegAddrSize DummyCPU = FIVE
        type RegDataSize DummyCPU = SIZE16
        type ImmSize DummyCPU = SIZE12
        type CPUVars DummyCPU = DummyVar

-------------------------------------------------------------------------------
-- Long compiling program.

{-  cnst has very simple code, and should be fast to typecheck
    But if you insist on normalising (Immediate DummyCPU) you get

      Immediate DummyCPU =  Const (ImmSize DummyCPU)
                         -> Const SIZE12
                         =  Const (DPlus SIX SIX)
                         ...etc...

similarly for (RegVar DummyCPU).

So you get a lot of work and big coercions, for no gain.
-}

cnst :: Integer -> Either (Immediate DummyCPU) (RegVar DummyCPU)
cnst x = Left (Const x)

longCompilingProgram :: CDM DummyCPU ()
longCompilingProgram = do
-- the number of lines below greatly affects compilation time.
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        x10 <- op $ Add (Var DummyZero) (cnst 10)
        return ()


{-# OPTIONS_GHC -freduction-depth=1000 #-}
{-# LANGUAGE
     FlexibleContexts, FlexibleInstances, FunctionalDependencies,
     MultiParamTypeClasses, TypeSynonymInstances,
     TypeOperators, UndecidableInstances, TypeFamilies #-}
module T5321FD where

-------- USES FUNCTIONAL DEPENDENCIES -------------

-- Our running example, for simplicity's sake, is a type-level map of a
-- single function. For reference, here is the code for a simple
-- value-level map of a single function.

-- vfoo = id
-- mapfoo (x : xs) = vfoo x : mapfoo xs
-- mapfoo [] = []

-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.

-- We now lift map to the type level, to operate over HLists.

-- First, the basic HList types

infixr 3 :*
data x :* xs = x :* xs deriving Show
data HNil = HNil deriving Show

-- Next, a large boring HList

-- Adds ten cells
addData x = i :* i :* d :* d :* s :*
            i :* i :* d :* d :* s :*
            x
    where i = 1 :: Int
          d = 1 :: Double
          s = ""

-- Has 70 cells.
sampleData = addData $ addData $ addData $ addData $ addData $
             addData $ addData $
             HNil

-- Next, a simple polymorphic function to map

class Foo x y | x -> y
    where foo :: x -> y
          foo = undefined

instance Foo Int Double
instance Foo Double Int
instance Foo String String

------------------------
-- Now, our map

class HMapFoo1 as bs | as -> bs where
    hMapFoo1 :: as -> bs

instance (Foo a b, HMapFoo1 as bs) => HMapFoo1 (a :* as) (b :* bs) where
    hMapFoo1 (x :* xs) = foo x :* hMapFoo1 xs

instance HMapFoo1 HNil HNil where
    hMapFoo1 _ = HNil

-- If we enable the following line, compilation time is ~ 9 seconds.

testHMapFoo1 = hMapFoo1 sampleData

------------------------
class HMapFoo2 acc as bs | acc as -> bs where
    hMapFoo2 :: acc -> as -> bs

instance (Foo a b, HMapFoo2 (b :* bs) as res) => HMapFoo2 bs (a :* as) res where
    hMapFoo2 acc (x :* xs) = hMapFoo2 (foo x :* acc) xs

instance HMapFoo2 acc HNil acc where
    hMapFoo2 acc _ = acc

-- If we enable the following line, compilation time is a much more satisfying ~0.5s.

testHMapFoo2 = hMapFoo2 HNil sampleData

------------------------
-- But wait, there's trouble on the horizon! Consider the following version:

class HMapFoo3 acc as bs | acc as -> bs where
    hMapFoo3 :: acc -> as -> bs

instance (HMapFoo3 (b :* bs) as res, Foo a b) => HMapFoo3 bs (a :* as) res where
    hMapFoo3 acc (x :* xs) = hMapFoo3 (foo x :* acc) xs

instance HMapFoo3 acc HNil acc where
    hMapFoo3 acc _ = acc

-- The only difference between hMapFoo2 and hMapFoo3 is that the order of
-- constraints on the inductive case has been reversed, with the
-- recursive constraint first and the immediately checkable constraint
-- second. Now, if we enable the following line, compilation time rockets
-- to ~6s!

testHMapFoo3 = hMapFoo3 HNil sampleData


{-# OPTIONS_GHC -freduction-depth=1000 #-}
{-# LANGUAGE
     FlexibleContexts, FlexibleInstances, FunctionalDependencies,
     MultiParamTypeClasses, TypeSynonymInstances,
     TypeOperators, UndecidableInstances, TypeFamilies #-}
module T5321Fun where

-- As the below code demonstrates, the same issues demonstrated with
-- Functional Dependencies also appear with Type Families, although less
--horribly, as their code-path seems more optimized in the current
-- constraint solver:

-- Our running example, for simplicity's sake, is a type-level map of a
-- single function. For reference, here is the code for a simple
-- value-level map of a single function.

-- > vfoo = id
-- > mapfoo (x : xs) = vfoo x : mapfoo xs
-- > mapfoo [] = []

-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.

-- We now lift map to the type level, to operate over HLists.

-- First, the basic HList types

infixr 3 :*
data x :* xs = x :* xs deriving Show
data HNil = HNil deriving Show

-- Next, a large boring HList

-- Adds ten cells
addData x = i :* i :* d :* d :* s :*
            i :* i :* d :* d :* s :*
            x
    where i = 1 :: Int
          d = 1 :: Double
          s = ""

-- Has 70 cells.
sampleData = addData $ addData $ addData $ addData $ addData $
             addData $ addData $
             HNil

class TFoo x where
     type TFooFun x
     tfoo :: x -> TFooFun x
     tfoo = undefined

instance TFoo Int where
    type TFooFun Int = Double
instance TFoo Double where
    type TFooFun Double = Int
instance TFoo String where
    type TFooFun String = String

class THMapFoo1 as where
      type THMapFoo1Res as
      thMapFoo1 :: as -> THMapFoo1Res as

instance (TFoo a, THMapFoo1 as) => THMapFoo1 (a :* as) where
    type THMapFoo1Res (a :* as) = TFooFun a :* THMapFoo1Res as
    thMapFoo1 (x :* xs) = tfoo x :* thMapFoo1 xs

instance THMapFoo1 HNil where
    type THMapFoo1Res HNil = HNil
    thMapFoo1 _ = HNil

-- The following, when enabled, takes ~3.5s. This demonstrates that slowdown occurs with type families as well.

testTHMapFoo1 = thMapFoo1 sampleData

class THMapFoo2 acc as where
      type THMapFoo2Res acc as
      thMapFoo2 :: acc -> as -> THMapFoo2Res acc as

instance (TFoo a, THMapFoo2 (TFooFun a :* acc) as) => THMapFoo2 acc (a :* as) where
    type THMapFoo2Res acc (a :* as) = THMapFoo2Res (TFooFun a :* acc) as
    thMapFoo2 acc (x :* xs) = thMapFoo2 (tfoo x :* acc) xs

instance THMapFoo2 acc HNil where
    type THMapFoo2Res acc HNil = acc
    thMapFoo2 acc _ = acc

-- The following, when enabled, takes ~0.6s. This demonstrates that the
-- tail recursive transform fixes the slowdown with type families just as
-- with fundeps.

testTHMapFoo2 = thMapFoo2 HNil sampleData

class THMapFoo3 acc as where
      type THMapFoo3Res acc as
      thMapFoo3 :: acc -> as -> THMapFoo3Res acc as

instance (THMapFoo3 (TFooFun a :* acc) as, TFoo a) => THMapFoo3 acc (a :* as) where
    type THMapFoo3Res acc (a :* as) = THMapFoo3Res (TFooFun a :* acc) as
    thMapFoo3 acc (x :* xs) = thMapFoo3 (tfoo x :* acc) xs

instance THMapFoo3 acc HNil where
    type THMapFoo3Res acc HNil = acc
    thMapFoo3 acc _ = acc

-- The following, when enabled, also takes ~0.6s. This demonstrates that,
-- unlike the fundep case, the order of type class constraints does not,
-- in this instance, affect the performance of type families.

testTHMapFoo3 = thMapFoo3 HNil sampleData


{-# OPTIONS_GHC -w #-}
import Control.Monad(when)
import System.Exit

-- parser produced by Happy Version 1.18.6

data HappyAbsSyn t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61
	= HappyTerminal (Char)
	| HappyErrorToken Int
	| HappyAbsSyn14 t14
	| HappyAbsSyn15 t15
	| HappyAbsSyn16 t16
	| HappyAbsSyn17 t17
	| HappyAbsSyn18 t18
	| HappyAbsSyn19 t19
	| HappyAbsSyn20 t20
	| HappyAbsSyn21 t21
	| HappyAbsSyn22 t22
	| HappyAbsSyn23 t23
	| HappyAbsSyn24 t24
	| HappyAbsSyn25 t25
	| HappyAbsSyn26 t26
	| HappyAbsSyn27 t27
	| HappyAbsSyn28 t28
	| HappyAbsSyn29 t29
	| HappyAbsSyn30 t30
	| HappyAbsSyn31 t31
	| HappyAbsSyn32 t32
	| HappyAbsSyn33 t33
	| HappyAbsSyn34 t34
	| HappyAbsSyn35 t35
	| HappyAbsSyn36 t36
	| HappyAbsSyn37 t37
	| HappyAbsSyn38 t38
	| HappyAbsSyn39 t39
	| HappyAbsSyn40 t40
	| HappyAbsSyn41 t41
	| HappyAbsSyn42 t42
	| HappyAbsSyn43 t43
	| HappyAbsSyn44 t44
	| HappyAbsSyn45 t45
	| HappyAbsSyn46 t46
	| HappyAbsSyn47 t47
	| HappyAbsSyn48 t48
	| HappyAbsSyn49 t49
	| HappyAbsSyn50 t50
	| HappyAbsSyn51 t51
	| HappyAbsSyn52 t52
	| HappyAbsSyn53 t53
	| HappyAbsSyn54 t54
	| HappyAbsSyn55 t55
	| HappyAbsSyn56 t56
	| HappyAbsSyn57 t57
	| HappyAbsSyn58 t58
	| HappyAbsSyn59 t59
	| HappyAbsSyn60 t60
	| HappyAbsSyn61 t61

action_0 (62) = happyShift action_22
action_0 (14) = happyGoto action_66
action_0 (17) = happyGoto action_12
action_0 (18) = happyGoto action_13
action_0 (19) = happyGoto action_14
action_0 (31) = happyGoto action_15
action_0 (32) = happyGoto action_16
action_0 (33) = happyGoto action_17
action_0 (35) = happyGoto action_18
action_0 (43) = happyGoto action_19
action_0 (44) = happyGoto action_20
action_0 (45) = happyGoto action_21
action_0 _ = happyFail

action_1 (62) = happyShift action_22
action_1 (15) = happyGoto action_63
action_1 (34) = happyGoto action_64
action_1 (35) = happyGoto action_65
action_1 _ = happyReduce_32

action_2 (62) = happyShift action_62
action_2 (16) = happyGoto action_56
action_2 (25) = happyGoto action_57
action_2 (36) = happyGoto action_58
action_2 (46) = happyGoto action_59
action_2 (53) = happyGoto action_60
action_2 (60) = happyGoto action_61
action_2 _ = happyReduce_35

action_3 (62) = happyShift action_22
action_3 (17) = happyGoto action_55
action_3 (18) = happyGoto action_13
action_3 (19) = happyGoto action_14
action_3 (32) = happyGoto action_16
action_3 (33) = happyGoto action_17
action_3 (35) = happyGoto action_18
action_3 (44) = happyGoto action_20
action_3 (45) = happyGoto action_21
action_3 _ = happyFail

action_4 (62) = happyShift action_22
action_4 (18) = happyGoto action_54
action_4 (19) = happyGoto action_14
action_4 (33) = happyGoto action_17
action_4 (35) = happyGoto action_18
action_4 (45) = happyGoto action_21
action_4 _ = happyFail

action_5 (62) = happyShift action_22
action_5 (19) = happyGoto action_53
action_5 (35) = happyGoto action_18
action_5 _ = happyFail

action_6 (62) = happyShift action_52
action_6 (20) = happyGoto action_47
action_6 (26) = happyGoto action_48
action_6 (38) = happyGoto action_49
action_6 (47) = happyGoto action_50
action_6 (55) = happyGoto action_51
action_6 _ = happyFail

action_7 (62) = happyShift action_46
action_7 (21) = happyGoto action_41
action_7 (27) = happyGoto action_42
action_7 (39) = happyGoto action_43
action_7 (48) = happyGoto action_44
action_7 (56) = happyGoto action_45
action_7 _ = happyFail

action_8 (62) = happyShift action_40
action_8 (22) = happyGoto action_35
action_8 (28) = happyGoto action_36
action_8 (40) = happyGoto action_37
action_8 (49) = happyGoto action_38
action_8 (57) = happyGoto action_39
action_8 _ = happyFail

action_9 (62) = happyShift action_34
action_9 (23) = happyGoto action_29
action_9 (29) = happyGoto action_30
action_9 (41) = happyGoto action_31
action_9 (50) = happyGoto action_32
action_9 (58) = happyGoto action_33
action_9 _ = happyFail

action_10 (62) = happyShift action_28
action_10 (24) = happyGoto action_23
action_10 (30) = happyGoto action_24
action_10 (42) = happyGoto action_25
action_10 (51) = happyGoto action_26
action_10 (59) = happyGoto action_27
action_10 _ = happyFail

action_11 (62) = happyShift action_22
action_11 (17) = happyGoto action_12
action_11 (18) = happyGoto action_13
action_11 (19) = happyGoto action_14
action_11 (31) = happyGoto action_15
action_11 (32) = happyGoto action_16
action_11 (33) = happyGoto action_17
action_11 (35) = happyGoto action_18
action_11 (43) = happyGoto action_19
action_11 (44) = happyGoto action_20
action_11 (45) = happyGoto action_21
action_11 _ = happyFail

action_12 _ = happyReduce_43

action_13 _ = happyReduce_45

action_14 _ = happyReduce_47

action_15 _ = happyReduce_11

action_16 _ = happyReduce_14

action_17 _ = happyReduce_15

action_18 _ = happyReduce_16

action_19 (62) = happyShift action_22
action_19 (17) = happyGoto action_86
action_19 (18) = happyGoto action_13
action_19 (19) = happyGoto action_14
action_19 (32) = happyGoto action_16
action_19 (33) = happyGoto action_17
action_19 (35) = happyGoto action_18
action_19 (44) = happyGoto action_20
action_19 (45) = happyGoto action_21
action_19 _ = happyReduce_28

action_20 (62) = happyShift action_22
action_20 (18) = happyGoto action_85
action_20 (19) = happyGoto action_14
action_20 (33) = happyGoto action_17
action_20 (35) = happyGoto action_18
action_20 (45) = happyGoto action_21
action_20 _ = happyReduce_29

action_21 (62) = happyShift action_22
action_21 (19) = happyGoto action_84
action_21 (35) = happyGoto action_18
action_21 _ = happyReduce_30

action_22 (63) = happyShift action_83
action_22 (37) = happyGoto action_79
action_22 (52) = happyGoto action_80
action_22 (54) = happyGoto action_81
action_22 (61) = happyGoto action_82
action_22 _ = happyReduce_37

action_23 (64) = happyAccept
action_23 _ = happyFail

action_24 _ = happyReduce_21

action_25 _ = happyReduce_27

action_26 _ = happyReduce_66

action_27 (62) = happyShift action_28
action_27 (51) = happyGoto action_78
action_27 _ = happyReduce_42

action_28 (62) = happyShift action_22
action_28 (19) = happyGoto action_77
action_28 (35) = happyGoto action_18
action_28 _ = happyFail

action_29 (64) = happyAccept
action_29 _ = happyFail

action_30 _ = happyReduce_20

action_31 _ = happyReduce_26

action_32 _ = happyReduce_64

action_33 (62) = happyShift action_34
action_33 (50) = happyGoto action_76
action_33 _ = happyReduce_41

action_34 (62) = happyShift action_22
action_34 (18) = happyGoto action_75
action_34 (19) = happyGoto action_14
action_34 (33) = happyGoto action_17
action_34 (35) = happyGoto action_18
action_34 (45) = happyGoto action_21
action_34 _ = happyFail

action_35 (64) = happyAccept
action_35 _ = happyFail

action_36 _ = happyReduce_19

action_37 _ = happyReduce_25

action_38 _ = happyReduce_62

action_39 (62) = happyShift action_40
action_39 (49) = happyGoto action_74
action_39 _ = happyReduce_40

action_40 (62) = happyShift action_22
action_40 (17) = happyGoto action_73
action_40 (18) = happyGoto action_13
action_40 (19) = happyGoto action_14
action_40 (32) = happyGoto action_16
action_40 (33) = happyGoto action_17
action_40 (35) = happyGoto action_18
action_40 (44) = happyGoto action_20
action_40 (45) = happyGoto action_21
action_40 _ = happyFail

action_41 (64) = happyAccept
action_41 _ = happyFail

action_42 _ = happyReduce_18

action_43 _ = happyReduce_24

action_44 _ = happyReduce_60

action_45 (62) = happyShift action_46
action_45 (48) = happyGoto action_72
action_45 _ = happyReduce_39

action_46 (62) = happyShift action_62
action_46 (16) = happyGoto action_71
action_46 (25) = happyGoto action_57
action_46 (36) = happyGoto action_58
action_46 (46) = happyGoto action_59
action_46 (53) = happyGoto action_60
action_46 (60) = happyGoto action_61
action_46 _ = happyReduce_35

action_47 (64) = happyAccept
action_47 _ = happyFail

action_48 _ = happyReduce_17

action_49 _ = happyReduce_23

action_50 _ = happyReduce_58

action_51 (62) = happyShift action_52
action_51 (47) = happyGoto action_70
action_51 _ = happyReduce_38

action_52 (62) = happyShift action_22
action_52 (15) = happyGoto action_69
action_52 (34) = happyGoto action_64
action_52 (35) = happyGoto action_65
action_52 _ = happyReduce_32

action_53 (64) = happyAccept
action_53 _ = happyFail

action_54 (64) = happyAccept
action_54 _ = happyFail

action_55 (64) = happyAccept
action_55 _ = happyFail

action_56 (64) = happyAccept
action_56 _ = happyFail

action_57 _ = happyReduce_13

action_58 _ = happyReduce_22

action_59 _ = happyReduce_68

action_60 _ = happyReduce_34

action_61 (62) = happyShift action_62
action_61 (46) = happyGoto action_68
action_61 _ = happyReduce_56

action_62 (63) = happyShift action_67
action_62 _ = happyFail

action_63 (64) = happyAccept
action_63 _ = happyFail

action_64 _ = happyReduce_12

action_65 _ = happyReduce_31

action_66 (64) = happyAccept
action_66 _ = happyFail

action_67 _ = happyReduce_49

action_68 _ = happyReduce_69

action_69 _ = happyReduce_50

action_70 _ = happyReduce_59

action_71 _ = happyReduce_51

action_72 _ = happyReduce_61

action_73 _ = happyReduce_52

action_74 _ = happyReduce_63

action_75 _ = happyReduce_53

action_76 _ = happyReduce_65

action_77 _ = happyReduce_54

action_78 _ = happyReduce_67

action_79 _ = happyReduce_33

action_80 _ = happyReduce_70

action_81 _ = happyReduce_36

action_82 (63) = happyShift action_83
action_82 (52) = happyGoto action_88
action_82 _ = happyReduce_57

action_83 (62) = happyShift action_87
action_83 _ = happyFail

action_84 _ = happyReduce_48

action_85 _ = happyReduce_46

action_86 _ = happyReduce_44

action_87 _ = happyReduce_55

action_88 _ = happyReduce_71

happyReduce_11 = happySpecReduce_1  14 happyReduction_11
happyReduction_11 (HappyAbsSyn31  happy_var_1)
	 =  HappyAbsSyn14
		 (happy_var_1
	)
happyReduction_11 _  = notHappyAtAll

happyReduce_12 = happySpecReduce_1  15 happyReduction_12
happyReduction_12 (HappyAbsSyn34  happy_var_1)
	 =  HappyAbsSyn15
		 (happy_var_1
	)
happyReduction_12 _  = notHappyAtAll

happyReduce_13 = happySpecReduce_1  16 happyReduction_13
happyReduction_13 (HappyAbsSyn25  happy_var_1)
	 =  HappyAbsSyn16
		 (happy_var_1
	)
happyReduction_13 _  = notHappyAtAll

happyReduce_14 = happySpecReduce_1  17 happyReduction_14
happyReduction_14 (HappyAbsSyn32  happy_var_1)
	 =  HappyAbsSyn17
		 (happy_var_1
	)
happyReduction_14 _  = notHappyAtAll

happyReduce_15 = happySpecReduce_1  18 happyReduction_15
happyReduction_15 (HappyAbsSyn33  happy_var_1)
	 =  HappyAbsSyn18
		 (happy_var_1
	)
happyReduction_15 _  = notHappyAtAll

happyReduce_16 = happySpecReduce_1  19 happyReduction_16
happyReduction_16 (HappyAbsSyn35  happy_var_1)
	 =  HappyAbsSyn19
		 (happy_var_1
	)
happyReduction_16 _  = notHappyAtAll

happyReduce_17 = happySpecReduce_1  20 happyReduction_17
happyReduction_17 (HappyAbsSyn26  happy_var_1)
	 =  HappyAbsSyn20
		 (happy_var_1
	)
happyReduction_17 _  = notHappyAtAll

happyReduce_18 = happySpecReduce_1  21 happyReduction_18
happyReduction_18 (HappyAbsSyn27  happy_var_1)
	 =  HappyAbsSyn21
		 (happy_var_1
	)
happyReduction_18 _  = notHappyAtAll

happyReduce_19 = happySpecReduce_1  22 happyReduction_19
happyReduction_19 (HappyAbsSyn28  happy_var_1)
	 =  HappyAbsSyn22
		 (happy_var_1
	)
happyReduction_19 _  = notHappyAtAll

happyReduce_20 = happySpecReduce_1  23 happyReduction_20
happyReduction_20 (HappyAbsSyn29  happy_var_1)
	 =  HappyAbsSyn23
		 (happy_var_1
	)
happyReduction_20 _  = notHappyAtAll

happyReduce_21 = happySpecReduce_1  24 happyReduction_21
happyReduction_21 (HappyAbsSyn30  happy_var_1)
	 =  HappyAbsSyn24
		 (happy_var_1
	)
happyReduction_21 _  = notHappyAtAll

happyReduce_22 = happySpecReduce_1  25 happyReduction_22
happyReduction_22 (HappyAbsSyn36  happy_var_1)
	 =  HappyAbsSyn25
		 (happy_var_1
	)
happyReduction_22 _  = notHappyAtAll

happyReduce_23 = happySpecReduce_1  26 happyReduction_23
happyReduction_23 (HappyAbsSyn38  happy_var_1)
	 =  HappyAbsSyn26
		 (happy_var_1
	)
happyReduction_23 _  = notHappyAtAll

happyReduce_24 = happySpecReduce_1  27 happyReduction_24
happyReduction_24 (HappyAbsSyn39  happy_var_1)
	 =  HappyAbsSyn27
		 (happy_var_1
	)
happyReduction_24 _  = notHappyAtAll

happyReduce_25 = happySpecReduce_1  28 happyReduction_25
happyReduction_25 (HappyAbsSyn40  happy_var_1)
	 =  HappyAbsSyn28
		 (happy_var_1
	)
happyReduction_25 _  = notHappyAtAll

happyReduce_26 = happySpecReduce_1  29 happyReduction_26
happyReduction_26 (HappyAbsSyn41  happy_var_1)
	 =  HappyAbsSyn29
		 (happy_var_1
	)
happyReduction_26 _  = notHappyAtAll

happyReduce_27 = happySpecReduce_1  30 happyReduction_27
happyReduction_27 (HappyAbsSyn42  happy_var_1)
	 =  HappyAbsSyn30
		 (happy_var_1
	)
happyReduction_27 _  = notHappyAtAll

happyReduce_28 = happySpecReduce_1  31 happyReduction_28
happyReduction_28 (HappyAbsSyn43  happy_var_1)
	 =  HappyAbsSyn31
		 (reverse happy_var_1
	)
happyReduction_28 _  = notHappyAtAll

happyReduce_29 = happySpecReduce_1  32 happyReduction_29
happyReduction_29 (HappyAbsSyn44  happy_var_1)
	 =  HappyAbsSyn32
		 (reverse happy_var_1
	)
happyReduction_29 _  = notHappyAtAll

happyReduce_30 = happySpecReduce_1  33 happyReduction_30
happyReduction_30 (HappyAbsSyn45  happy_var_1)
	 =  HappyAbsSyn33
		 (reverse happy_var_1
	)
happyReduction_30 _  = notHappyAtAll

happyReduce_31 = happySpecReduce_1  34 happyReduction_31
happyReduction_31 (HappyAbsSyn35  happy_var_1)
	 =  HappyAbsSyn34
		 (happy_var_1
	)
happyReduction_31 _  = notHappyAtAll

happyReduce_32 = happySpecReduce_0  34 happyReduction_32
happyReduction_32  =  HappyAbsSyn34
		 ([]
	)

happyReduce_33 = happySpecReduce_2  35 happyReduction_33
happyReduction_33 (HappyAbsSyn37  happy_var_2)
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn35
		 (happy_var_1 : happy_var_2
	)
happyReduction_33 _ _  = notHappyAtAll

happyReduce_34 = happySpecReduce_1  36 happyReduction_34
happyReduction_34 (HappyAbsSyn53  happy_var_1)
	 =  HappyAbsSyn36
		 (happy_var_1
	)
happyReduction_34 _  = notHappyAtAll

happyReduce_35 = happySpecReduce_0  36 happyReduction_35
happyReduction_35  =  HappyAbsSyn36
		 ([]
	)

happyReduce_36 = happySpecReduce_1  37 happyReduction_36
happyReduction_36 (HappyAbsSyn54  happy_var_1)
	 =  HappyAbsSyn37
		 (happy_var_1
	)
happyReduction_36 _  = notHappyAtAll

happyReduce_37 = happySpecReduce_0  37 happyReduction_37
happyReduction_37  =  HappyAbsSyn37
		 ([]
	)

happyReduce_38 = happySpecReduce_1  38 happyReduction_38
happyReduction_38 (HappyAbsSyn55  happy_var_1)
	 =  HappyAbsSyn38
		 (reverse happy_var_1
	)
happyReduction_38 _  = notHappyAtAll

happyReduce_39 = happySpecReduce_1  39 happyReduction_39
happyReduction_39 (HappyAbsSyn56  happy_var_1)
	 =  HappyAbsSyn39
		 (reverse happy_var_1
	)
happyReduction_39 _  = notHappyAtAll

happyReduce_40 = happySpecReduce_1  40 happyReduction_40
happyReduction_40 (HappyAbsSyn57  happy_var_1)
	 =  HappyAbsSyn40
		 (reverse happy_var_1
	)
happyReduction_40 _  = notHappyAtAll

happyReduce_41 = happySpecReduce_1  41 happyReduction_41
happyReduction_41 (HappyAbsSyn58  happy_var_1)
	 =  HappyAbsSyn41
		 (reverse happy_var_1
	)
happyReduction_41 _  = notHappyAtAll

happyReduce_42 = happySpecReduce_1  42 happyReduction_42
happyReduction_42 (HappyAbsSyn59  happy_var_1)
	 =  HappyAbsSyn42
		 (reverse happy_var_1
	)
happyReduction_42 _  = notHappyAtAll

happyReduce_43 = happySpecReduce_1  43 happyReduction_43
happyReduction_43 (HappyAbsSyn17  happy_var_1)
	 =  HappyAbsSyn43
		 ([happy_var_1]
	)
happyReduction_43 _  = notHappyAtAll

happyReduce_44 = happySpecReduce_2  43 happyReduction_44
happyReduction_44 (HappyAbsSyn17  happy_var_2)
	(HappyAbsSyn43  happy_var_1)
	 =  HappyAbsSyn43
		 (happy_var_2 : happy_var_1
	)
happyReduction_44 _ _  = notHappyAtAll

happyReduce_45 = happySpecReduce_1  44 happyReduction_45
happyReduction_45 (HappyAbsSyn18  happy_var_1)
	 =  HappyAbsSyn44
		 ([happy_var_1]
	)
happyReduction_45 _  = notHappyAtAll

happyReduce_46 = happySpecReduce_2  44 happyReduction_46
happyReduction_46 (HappyAbsSyn18  happy_var_2)
	(HappyAbsSyn44  happy_var_1)
	 =  HappyAbsSyn44
		 (happy_var_2 : happy_var_1
	)
happyReduction_46 _ _  = notHappyAtAll

happyReduce_47 = happySpecReduce_1  45 happyReduction_47
happyReduction_47 (HappyAbsSyn19  happy_var_1)
	 =  HappyAbsSyn45
		 ([happy_var_1]
	)
happyReduction_47 _  = notHappyAtAll

happyReduce_48 = happySpecReduce_2  45 happyReduction_48
happyReduction_48 (HappyAbsSyn19  happy_var_2)
	(HappyAbsSyn45  happy_var_1)
	 =  HappyAbsSyn45
		 (happy_var_2 : happy_var_1
	)
happyReduction_48 _ _  = notHappyAtAll

happyReduce_49 = happySpecReduce_2  46 happyReduction_49
happyReduction_49 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn46
		 (happy_var_1
	)
happyReduction_49 _ _  = notHappyAtAll

happyReduce_50 = happySpecReduce_2  47 happyReduction_50
happyReduction_50 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn47
		 (happy_var_1
	)
happyReduction_50 _ _  = notHappyAtAll

happyReduce_51 = happySpecReduce_2  48 happyReduction_51
happyReduction_51 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn48
		 (happy_var_1
	)
happyReduction_51 _ _  = notHappyAtAll

happyReduce_52 = happySpecReduce_2  49 happyReduction_52
happyReduction_52 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn49
		 (happy_var_1
	)
happyReduction_52 _ _  = notHappyAtAll

happyReduce_53 = happySpecReduce_2  50 happyReduction_53
happyReduction_53 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn50
		 (happy_var_1
	)
happyReduction_53 _ _  = notHappyAtAll

happyReduce_54 = happySpecReduce_2  51 happyReduction_54
happyReduction_54 _
	(HappyTerminal happy_var_1)
	 =  HappyAbsSyn51
		 (happy_var_1
	)
happyReduction_54 _ _  = notHappyAtAll

happyReduce_55 = happySpecReduce_2  52 happyReduction_55
happyReduction_55 (HappyTerminal happy_var_2)
	_
	 =  HappyAbsSyn52
		 (happy_var_2
	)
happyReduction_55 _ _  = notHappyAtAll

happyReduce_56 = happySpecReduce_1  53 happyReduction_56
happyReduction_56 (HappyAbsSyn60  happy_var_1)
	 =  HappyAbsSyn53
		 (reverse happy_var_1
	)
happyReduction_56 _  = notHappyAtAll

happyReduce_57 = happySpecReduce_1  54 happyReduction_57
happyReduction_57 (HappyAbsSyn61  happy_var_1)
	 =  HappyAbsSyn54
		 (reverse happy_var_1
	)
happyReduction_57 _  = notHappyAtAll

happyReduce_58 = happySpecReduce_1  55 happyReduction_58
happyReduction_58 (HappyAbsSyn47  happy_var_1)
	 =  HappyAbsSyn55
		 ([happy_var_1]
	)
happyReduction_58 _  = notHappyAtAll

happyReduce_59 = happySpecReduce_2  55 happyReduction_59
happyReduction_59 (HappyAbsSyn47  happy_var_2)
	(HappyAbsSyn55  happy_var_1)
	 =  HappyAbsSyn55
		 (happy_var_2 : happy_var_1
	)
happyReduction_59 _ _  = notHappyAtAll

happyReduce_60 = happySpecReduce_1  56 happyReduction_60
happyReduction_60 (HappyAbsSyn48  happy_var_1)
	 =  HappyAbsSyn56
		 ([happy_var_1]
	)
happyReduction_60 _  = notHappyAtAll

happyReduce_61 = happySpecReduce_2  56 happyReduction_61
happyReduction_61 (HappyAbsSyn48  happy_var_2)
	(HappyAbsSyn56  happy_var_1)
	 =  HappyAbsSyn56
		 (happy_var_2 : happy_var_1
	)
happyReduction_61 _ _  = notHappyAtAll

happyReduce_62 = happySpecReduce_1  57 happyReduction_62
happyReduction_62 (HappyAbsSyn49  happy_var_1)
	 =  HappyAbsSyn57
		 ([happy_var_1]
	)
happyReduction_62 _  = notHappyAtAll

happyReduce_63 = happySpecReduce_2  57 happyReduction_63
happyReduction_63 (HappyAbsSyn49  happy_var_2)
	(HappyAbsSyn57  happy_var_1)
	 =  HappyAbsSyn57
		 (happy_var_2 : happy_var_1
	)
happyReduction_63 _ _  = notHappyAtAll

happyReduce_64 = happySpecReduce_1  58 happyReduction_64
happyReduction_64 (HappyAbsSyn50  happy_var_1)
	 =  HappyAbsSyn58
		 ([happy_var_1]
	)
happyReduction_64 _  = notHappyAtAll

happyReduce_65 = happySpecReduce_2  58 happyReduction_65
happyReduction_65 (HappyAbsSyn50  happy_var_2)
	(HappyAbsSyn58  happy_var_1)
	 =  HappyAbsSyn58
		 (happy_var_2 : happy_var_1
	)
happyReduction_65 _ _  = notHappyAtAll

happyReduce_66 = happySpecReduce_1  59 happyReduction_66
happyReduction_66 (HappyAbsSyn51  happy_var_1)
	 =  HappyAbsSyn59
		 ([happy_var_1]
	)
happyReduction_66 _  = notHappyAtAll

happyReduce_67 = happySpecReduce_2  59 happyReduction_67
happyReduction_67 (HappyAbsSyn51  happy_var_2)
	(HappyAbsSyn59  happy_var_1)
	 =  HappyAbsSyn59
		 (happy_var_2 : happy_var_1
	)
happyReduction_67 _ _  = notHappyAtAll

happyReduce_68 = happySpecReduce_1  60 happyReduction_68
happyReduction_68 (HappyAbsSyn46  happy_var_1)
	 =  HappyAbsSyn60
		 ([happy_var_1]
	)
happyReduction_68 _  = notHappyAtAll

happyReduce_69 = happySpecReduce_2  60 happyReduction_69
happyReduction_69 (HappyAbsSyn46  happy_var_2)
	(HappyAbsSyn60  happy_var_1)
	 =  HappyAbsSyn60
		 (happy_var_2 : happy_var_1
	)
happyReduction_69 _ _  = notHappyAtAll

happyReduce_70 = happySpecReduce_1  61 happyReduction_70
happyReduction_70 (HappyAbsSyn52  happy_var_1)
	 =  HappyAbsSyn61
		 ([happy_var_1]
	)
happyReduction_70 _  = notHappyAtAll

happyReduce_71 = happySpecReduce_2  61 happyReduction_71
happyReduction_71 (HappyAbsSyn52  happy_var_2)
	(HappyAbsSyn61  happy_var_1)
	 =  HappyAbsSyn61
		 (happy_var_2 : happy_var_1
	)
happyReduction_71 _ _  = notHappyAtAll

happyNewToken action sts stk [] =
	action 64 64 notHappyAtAll (HappyState action) sts stk []

happyNewToken action sts stk (tk:tks) =
	let cont i = action i i tk (HappyState action) sts stk tks in
	case tk of {
	'a' -> cont 62;
	'b' -> cont 63;
	_ -> happyError' (tk:tks)
	}

happyError_ tk tks = happyError' (tk:tks)

happyThen :: () => Maybe a -> (a -> Maybe b) -> Maybe b
happyThen = ((>>=))
happyReturn :: () => a -> Maybe a
happyReturn = (return)
happyThen1 m k tks = ((>>=)) m (\a -> k a tks)
happyReturn1 :: () => a -> b -> Maybe a
happyReturn1 = \a tks -> (return) a
happyError' :: () => [(Char)] -> Maybe a
happyError' = happyError

test0 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn14 z -> happyReturn z; _other -> notHappyAtAll })

test1 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn15 z -> happyReturn z; _other -> notHappyAtAll })

test2 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_2 tks) (\x -> case x of {HappyAbsSyn16 z -> happyReturn z; _other -> notHappyAtAll })

test3 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_3 tks) (\x -> case x of {HappyAbsSyn17 z -> happyReturn z; _other -> notHappyAtAll })

test4 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_4 tks) (\x -> case x of {HappyAbsSyn18 z -> happyReturn z; _other -> notHappyAtAll })

test5 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_5 tks) (\x -> case x of {HappyAbsSyn19 z -> happyReturn z; _other -> notHappyAtAll })

test6 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_6 tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll })

test7 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_7 tks) (\x -> case x of {HappyAbsSyn21 z -> happyReturn z; _other -> notHappyAtAll })

test8 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_8 tks) (\x -> case x of {HappyAbsSyn22 z -> happyReturn z; _other -> notHappyAtAll })

test9 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_9 tks) (\x -> case x of {HappyAbsSyn23 z -> happyReturn z; _other -> notHappyAtAll })

test10 tks = happySomeParser where
  happySomeParser = happyThen (happyParse action_10 tks) (\x -> case x of {HappyAbsSyn24 z -> happyReturn z; _other -> notHappyAtAll })

happySeq = happyDontSeq

happyError _  = Nothing

tests         = [ test1 ""      == Just ""
                , test1 "a"     == Just "a"
                , test1 "ab"    == Nothing
                , test1 "aba"   == Just "aa"
                , test1 "abab"  == Nothing

                , test2 ""      == Just ""
                , test2 "a"     == Nothing
                , test2 "ab"    == Just "a"
                , test2 "aba"   == Nothing
                , test2 "abab"  == Just "aa"
                ]

main        = do let failed = filter (not . snd) (zip [0..] tests)
                 when (not (null failed)) $
                   do putStrLn ("Failed tests: " ++ show (map fst failed))
                      exitFailure
                 putStrLn "Tests passed."
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 1 "<command-line>" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp

{-# LINE 30 "templates/GenericTemplate.hs" #-}

{-# LINE 51 "templates/GenericTemplate.hs" #-}

{-# LINE 61 "templates/GenericTemplate.hs" #-}

{-# LINE 70 "templates/GenericTemplate.hs" #-}

infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)

-----------------------------------------------------------------------------
-- starting the parse

happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll

-----------------------------------------------------------------------------
-- Accepting the parse

-- If the current token is (1), 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 (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =
	happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
	 (happyReturn1 ans)

-----------------------------------------------------------------------------
-- Arrays only: do the next action

{-# LINE 148 "templates/GenericTemplate.hs" #-}

-----------------------------------------------------------------------------
-- HappyState data type (not arrays)

newtype HappyState b c = HappyState
        (Int ->                    -- token number
         Int ->                    -- token number (yes, again)
         b ->                           -- token semantic value
         HappyState b c ->              -- current state
         [HappyState b c] ->            -- state stack
         c)

-----------------------------------------------------------------------------
-- Shifting a token

happyShift new_state (1) tk st sts stk@(x `HappyStk` _) =
     let (i) = (case x of { HappyErrorToken (i) -> i }) in
--     trace "shifting the error token" $
     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)

happyShift new_state i tk st sts stk =
     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)

-- happyReduce is specialised for the common cases.

happySpecReduce_0 i fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk
     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)

happySpecReduce_1 i fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')
     = let r = fn v1 in
       happySeq r (action nt j tk st sts (r `HappyStk` stk'))

happySpecReduce_2 i fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')
     = let r = fn v1 v2 in
       happySeq r (action nt j tk st sts (r `HappyStk` stk'))

happySpecReduce_3 i fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
     = let r = fn v1 v2 v3 in
       happySeq r (action nt j tk st sts (r `HappyStk` stk'))

happyReduce k i fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happyReduce k nt fn j tk st sts stk
     = case happyDrop (k - ((1) :: Int)) sts of
	 sts1@(((st1@(HappyState (action))):(_))) ->
        	let r = fn stk in  -- it doesn't hurt to always seq here...
       		happyDoSeq r (action nt j tk st1 sts1 r)

happyMonadReduce k nt fn (1) tk st sts stk
     = happyFail (1) tk st sts stk
happyMonadReduce k nt fn j tk st sts stk =
        happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))
       where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))
             drop_stk = happyDropStk k stk

happyMonad2Reduce k nt fn (1) tk st sts stk
     = happyFail (1) 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@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))
             drop_stk = happyDropStk k stk

             new_state = action

happyDrop (0) l = l
happyDrop n ((_):(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

{-# LINE 246 "templates/GenericTemplate.hs" #-}
happyGoto action j tk st = action j j tk (HappyState action)

-----------------------------------------------------------------------------
-- Error recovery ((1) is the error token)

-- parse error if we are in recovery and we fail again
happyFail  (1) 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  (1) tk old_st (((HappyState (action))):(sts))
						(saved_tok `HappyStk` _ `HappyStk` stk) =
--	trace ("discarding state, depth " ++ show (length stk))  $
	action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))
-}

-- Enter error recovery: generate an error token,
--                       save the old token and carry on.
happyFail  i tk (HappyState (action)) sts stk =
--      trace "entering error recovery" $
	action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)

-- Internal happy errors:

notHappyAtAll :: a
notHappyAtAll = error "Internal Happy error\n"

-----------------------------------------------------------------------------
-- Hack to get the typechecker to accept our action functions

-----------------------------------------------------------------------------
-- 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.

{-# LINE 311 "templates/GenericTemplate.hs" #-}
{-# 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.


{-# LANGUAGE AllowAmbiguousTypes, TypeFamilies #-}

module T5837 where

import Data.Kind

type family TF a :: Type
type instance TF (a,b) = (TF a, TF b)

t :: (a ~ TF (a,Int)) => Int
t = undefined

{-

         [G] a ~ TF (a,Int)               -- a = a_am1
-->
         [G] TF (a,Int) ~ fsk             -- fsk = fsk_am8

inert    [G] fsk ~ a

---> reduce
         [G] fsk ~ (TF a, TF Int)

inert    [G] fsk ~ a

---> substitute for fsk and flatten
         [G] TF a ~ fsk1
         [G] TF Int ~ fsk2

inert    [G] fsk ~ a
         [G] a ~ (fsk1, fsk2)

---> (substitute for a in first constraint)
         TF (fsk1, fsk2) ~ fsk1     (C1)
         TF Int ~ fsk2

inert    a ~ (fsk2, TF Int)
inert    fsk ~ (fsk2, TF Int)

------- At this point we are stuck because of
--      the recursion in the first constraint C1
--      Hooray

-- Before, we reduced C1, which led to a loop

---> (top-level reduction, re-orient)
         fsk2 ~ (TF fsk2, TF Int)
inert    a ~ (fsk2, TF Int)
inert    fsk ~ (fsk2, TF Int)

---> (attempt to flatten (TF fsk2) to get rid of fsk2
         TF fsk2 ~ fsk3
         fsk2 ~ (fsk3, TF Int)
inert    a   ~ (fsk2, TF Int)
inert    fsk ~ (fsk2, TF Int)

--->
         TF fsk2 ~ fsk3
inert    fsk2 ~ (fsk3, TF Int)
inert    a   ~ ((fsk3, TF Int), TF Int)
inert    fsk ~ ((fsk3, TF Int), TF Int)

-}


module T6048 where

import Control.Applicative

data X = X
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)
  (Maybe String)

mb :: (String -> Maybe a) -> String -> Maybe (Maybe a)
mb _ ""  = Just Nothing
mb _ "-" = Just Nothing
mb p xs  = Just <$> p xs

run :: [String] -> Maybe X
run
  [ x1
  , x2
  , x3
  , x4
  , x5
  , x6
  , x7
  , x8
  , x9
  ] = X
  <$> mb pure x1
  <*> mb pure x2
  <*> mb pure x3
  <*> mb pure x4
  <*> mb pure x5
  <*> mb pure x6
  <*> mb pure x7
  <*> mb pure x8
  <*> mb pure x9