module ExecutionPlan2Hs where
import ExecutionPlan
import Pretty
import PPUtil
import Options
import Data.Monoid(mappend,mempty)
import Data.Maybe
import Debug.Trace
import System.IO
import System.Directory
import System.FilePath
import UU.Scanner.Position
import TokenDef
import HsToken
import ErrorMessages
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence(Seq)
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import CommonTypes
import ErrorMessages
import qualified Data.Set as Set
import Data.Set(Set)
import qualified Data.Map as Map
import Data.Map(Map)
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
import UU.Scanner.Position(Pos)
import HsToken
import CommonTypes
import UU.Scanner.Position(Pos)
classCtxsToDocs :: ClassContext -> [PP_Doc]
classCtxsToDocs = map toDoc where
toDoc (ident,args) = (ident >#< ppSpaced (map pp_parens args))
classConstrsToDocs :: [Type] -> [PP_Doc]
classConstrsToDocs = map ppTp
ppClasses :: [PP_Doc] -> PP_Doc
ppClasses [] = empty
ppClasses xs = pp_block "(" ")" "," xs >#< "=>"
ppQuants :: [Identifier] -> PP_Doc
ppQuants [] = empty
ppQuants ps = "forall" >#< ppSpaced ps >#< "."
ppConFields :: Bool -> [PP_Doc] -> PP_Doc
ppConFields True flds = ppListSep "{" "}" ", " flds
ppConFields False flds = ppSpaced flds
ppTp :: Type -> PP_Doc
ppTp (Haskell s) = text s
ppTp (NT nt args for) = prefix >|< nt >#< ppSpaced (map pp_parens args) where
prefix | for = text "T_"
| otherwise = empty
type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)
conNmTVisit nt vId = "T_" >|< nt >|< "_v" >|< vId
conNmTVisitIn nt vId = "T_" >|< nt >|< "_vIn" >|< vId
conNmTVisitOut nt vId = "T_" >|< nt >|< "_vOut" >|< vId
conNmTNextVisit nt stId = "T_" >|< nt >|< "_s" >|< stId
ppMonadType :: Options -> PP_Doc
ppMonadType opts
| parallelInvoke opts = text "IO"
| otherwise = text "Identity"
ppDefor :: Type -> PP_Doc
ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args)
ppDefor (Haskell s) = text s
mklet :: (PP a, PP b, PP c) => a -> b -> c -> PP_Doc
mklet prefix defs body =
prefix >#< "let"
>-< indent 3 defs
>-< indent 2 "in" >#< body
resultValName :: String
resultValName = "__result_"
nextStName :: String
nextStName = "__st_"
parResultName :: String
parResultName = "__outcome_"
fmtDecl :: PP a => Bool -> FormatMode -> a -> PP_Doc
fmtDecl declPure fmt decl = case fmt of
FormatLetDecl -> pp decl
FormatLetLine -> "let" >#< decl >#< "in"
FormatDo | declPure -> "let" >#< decl
| otherwise -> pp decl
stname :: Identifier -> Int -> String
stname child st = "_" ++ getName child ++ "X" ++ show st
compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool
compatibleAttach _ _ _ = True
unMon :: Options -> PP_Doc
unMon options
| parallelInvoke options = text "System.IO.Unsafe.unsafePerformIO"
| otherwise = text "Control.Monad.Identity.runIdentity"
dummyPat :: Options -> Bool -> PP_Doc
dummyPat opts noArgs
| not noArgs && tupleAsDummyToken opts = empty
| tupleAsDummyToken opts = if strictDummyToken opts
then text "()"
else text "(_ :: ())"
| otherwise = let match | strictDummyToken opts = "!_"
| otherwise = "_"
in pp_parens (match >#< "::" >#< dummyType opts noArgs)
where match | strictDummyToken opts = "(!_)"
| otherwise = "_"
dummyArg :: Options -> Bool -> PP_Doc
dummyArg opts noArgs
| not noArgs && tupleAsDummyToken opts = empty
| tupleAsDummyToken opts = text "()"
| otherwise = text "GHC.Prim.realWorld#"
dummyType :: Options -> Bool -> PP_Doc
dummyType opts noArgs
| not noArgs && tupleAsDummyToken opts = empty
| tupleAsDummyToken opts = text "()"
| otherwise = text "(GHC.Prim.State# GHC.Prim.RealWorld)"
ruleInlineThresholdSoft :: Int
ruleInlineThresholdSoft = 3
ruleInlineThresholdHard :: Int
ruleInlineThresholdHard = 5
reallyOftenUsedThreshold :: Int
reallyOftenUsedThreshold = 12
data NonLocalAttr
= AttrInh Identifier Identifier
| AttrSyn Identifier Identifier deriving Show
mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr
mkNonLocalAttr True = AttrInh
mkNonLocalAttr False = AttrSyn
lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc
lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs
lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns
lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc
lookupType child name attrMp childMp
| noParameters childTp = Just ppDoc
| otherwise = Nothing
where
attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs
childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp
nonterm = extractNonterminal childTp
childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp
ppDoc = ppTp attrTp
noParameters :: Type -> Bool
noParameters (Haskell _) = True
noParameters (NT _ args _) = null args
compatibleKind :: VisitKind -> VisitKind -> Bool
compatibleKind _ _ = True
compatibleRule :: VisitKind -> Bool -> Bool
compatibleRule (VisitPure _) False = False
compatibleRule _ _ = True
unionWithSum = Map.unionWith (+)
uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b)
uwSetUnion = Map.unionWith Set.union
uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c)
uwMapUnion = Map.unionWith Map.union
renderDocs :: [PP_Doc] -> String
renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) ""
writeModule :: FilePath -> [PP_Doc] -> IO ()
writeModule path docs
= do bExists <- doesFileExist path
if bExists
then do input <- readFile path
seq (length input) (return ())
if input /= output
then dumpIt
else return ()
else dumpIt
where
output = renderDocs docs
dumpIt = writeFile path output
ppNoInline :: PP a => a -> PP_Doc
ppNoInline = ppPragmaBinding "NOINLINE"
ppInline :: PP a => a -> PP_Doc
ppInline = ppPragmaBinding "INLINE"
ppInlinable :: PP a => a -> PP_Doc
ppInlinable = ppPragmaBinding "INLINABLE"
ppPragmaBinding :: (PP a, PP b) => a -> b -> PP_Doc
ppPragmaBinding pragma nm = "{-#" >#< pragma >#< nm >#< "#-}"
ppCostCentre :: PP a => a -> PP_Doc
ppCostCentre nm = "{-#" >#< "SCC" >#< "\"" >|< nm >|< "\"" >#< "#-}"
warrenFlagsPP :: Options -> PP_Doc
warrenFlagsPP options = vlist
[ pp "{-# LANGUAGE Rank2Types, GADTs #-}"
, if bangpats options
then pp "{-# LANGUAGE BangPatterns #-}"
else empty
, if noPerRuleTypeSigs options && noPerStateTypeSigs options
then empty
else pp "{-# LANGUAGE ScopedTypeVariables #-}"
, if tupleAsDummyToken options
then empty
else pp "{-# LANGUAGE ScopedTypeVariables, MagicHash #-}"
,
if unbox options && bangpats options
then pp $ "{-# OPTIONS_GHC -funbox-strict-fields -fstrictness #-}"
else empty
, if parallelInvoke options && not (noEagerBlackholing options)
then pp $ "{-# OPTIONS_GHC -feager-blackholing #-}"
else empty
]
sem_EChild :: EChild ->
T_EChild
sem_EChild (EChild _name _tp _kind _hasAround _merges _isMerged) =
(sem_EChild_EChild _name _tp _kind _hasAround _merges _isMerged)
sem_EChild (ETerm _name _tp) =
(sem_EChild_ETerm _name _tp)
newtype T_EChild = T_EChild ((Map NontermIdent Int) ->
ConstructorIdent ->
PP_Doc ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
NontermIdent ->
Options ->
String ->
PP_Doc ->
( ( PP_Doc ),( PP_Doc ),( PP_Doc ),(Map Identifier Type),(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),PP_Doc,(Set String)))
data Inh_EChild = Inh_EChild {allInitStates_Inh_EChild :: (Map NontermIdent Int),con_Inh_EChild :: ConstructorIdent,importBlocks_Inh_EChild :: PP_Doc,mainFile_Inh_EChild :: String,mainName_Inh_EChild :: String,moduleHeader_Inh_EChild :: (String -> String -> String -> Bool -> String),nt_Inh_EChild :: NontermIdent,options_Inh_EChild :: Options,pragmaBlocks_Inh_EChild :: String,textBlocks_Inh_EChild :: PP_Doc}
data Syn_EChild = Syn_EChild {argnamesw_Syn_EChild :: ( PP_Doc ),argpats_Syn_EChild :: ( PP_Doc ),argtps_Syn_EChild :: ( PP_Doc ),childTypes_Syn_EChild :: (Map Identifier Type),childintros_Syn_EChild :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),datatype_Syn_EChild :: PP_Doc,terminaldefs_Syn_EChild :: (Set String)}
wrap_EChild :: T_EChild ->
Inh_EChild ->
Syn_EChild
wrap_EChild (T_EChild sem) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) =
(let ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks
in (Syn_EChild _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs))
sem_EChild_EChild :: Identifier ->
Type ->
ChildKind ->
Bool ->
(Maybe [Identifier]) ->
Bool ->
T_EChild
sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ =
(T_EChild (\ _lhsIallInitStates
_lhsIcon
_lhsIimportBlocks
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsItextBlocks ->
(let _lhsOdatatype :: PP_Doc
_lhsOargnamesw :: ( PP_Doc )
_lhsOargtps :: ( PP_Doc )
_lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_lhsOchildTypes :: (Map Identifier Type)
_lhsOterminaldefs :: (Set String)
_lhsOargpats :: ( PP_Doc )
_tpDoc =
(
_addStrict $ pp_parens $ ppTp $ removeDeforested tp_
)
_strNm =
(
recordFieldname _lhsInt _lhsIcon name_
)
_field =
(
if dataRecords _lhsIoptions
then _strNm >#< "::" >#< _tpDoc
else _tpDoc
)
_addStrict =
(
\x -> if strictData _lhsIoptions then "!" >|< x else x
)
_lhsOdatatype =
(
case kind_ of
ChildAttr -> empty
_ -> _field
)
_lhsOargnamesw =
(
case kind_ of
ChildSyntax -> "(" >#< "sem_" >|< _nt >#< name_ >|< "_" >#< ")"
ChildAttr -> empty
ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< name_ >|< "_" >#< ")"
)
_lhsOargtps =
(
case kind_ of
ChildSyntax -> ppDefor tp_ >#< "->"
ChildReplace tp -> ppDefor tp >#< "->"
_ -> empty
)
_argpats =
(
case kind_ of
ChildSyntax -> name_ >|< "_"
ChildReplace _ -> name_ >|< "_"
_ -> empty
)
_lhsOchildintros =
(
Map.singleton name_ _introcode
)
_isDefor =
(
case tp_ of
NT _ _ defor -> defor
_ -> False
)
_valcode =
(
case kind_ of
ChildSyntax -> name_ >|< "_"
ChildAttr ->
let prefix | not _isDefor = if lateHigherOrderBinding _lhsIoptions
then lateSemNtLabel _nt >#< lhsname True idLateBindingAttr
else "sem_" >|< _nt
| otherwise = empty
in pp_parens (prefix >#< instname name_)
ChildReplace _ ->
pp_parens (instname name_ >#< name_ >|< "_")
)
_aroundcode =
(
if hasAround_
then locname name_ >|< "_around"
else empty
)
_introcode =
(
\kind fmtMode ->
let pat = text $ stname name_ _initSt
patStrict = _addbang pat
attach = "attach_T_" >|< _nt >#< pp_parens (_aroundcode >#< _valcode )
runAttach = unMon _lhsIoptions >#< pp_parens attach
decl = case kind of
VisitPure False -> pat >#< "=" >#< runAttach
VisitPure True -> patStrict >#< "=" >#< runAttach
VisitMonadic -> patStrict >#< "<-" >#< attach
in if compatibleAttach kind _nt _lhsIoptions
then Right ( fmtDecl False fmtMode decl
, Set.singleton (stname name_ _initSt )
, case kind_ of
ChildAttr -> Map.insert (instname name_) Nothing $
( if _isDefor || not (lateHigherOrderBinding _lhsIoptions)
then id
else Map.insert (lhsname True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr)
) $
( if hasAround_
then Map.insert (locname (name_) ++ "_around") Nothing
else id
) $ Map.empty
ChildReplace _ -> Map.singleton (instname name_) Nothing
ChildSyntax -> Map.empty
)
else Left $ IncompatibleAttachKind name_ kind
)
_nt =
(
extractNonterminal tp_
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_lhsOchildTypes =
(
Map.singleton name_ tp_
)
_initSt =
(
Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates
)
_lhsOterminaldefs =
(
Set.empty
)
_lhsOargpats =
(
_argpats
)
in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))))
sem_EChild_ETerm :: Identifier ->
Type ->
T_EChild
sem_EChild_ETerm name_ tp_ =
(T_EChild (\ _lhsIallInitStates
_lhsIcon
_lhsIimportBlocks
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsItextBlocks ->
(let _lhsOdatatype :: PP_Doc
_lhsOargnamesw :: ( PP_Doc )
_lhsOargtps :: ( PP_Doc )
_lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_lhsOterminaldefs :: (Set String)
_lhsOchildTypes :: (Map Identifier Type)
_lhsOargpats :: ( PP_Doc )
_tpDoc =
(
_addStrict $ pp_parens $ ppTp $ removeDeforested tp_
)
_strNm =
(
recordFieldname _lhsInt _lhsIcon name_
)
_field =
(
if dataRecords _lhsIoptions
then _strNm >#< "::" >#< _tpDoc
else _tpDoc
)
_addStrict =
(
\x -> if strictData _lhsIoptions then "!" >|< x else x
)
_lhsOdatatype =
(
_field
)
_lhsOargnamesw =
(
text $ fieldname name_
)
_lhsOargtps =
(
(pp_parens $ show tp_) >#< "->"
)
_argpats =
(
_addbang $ text $ fieldname name_
)
_lhsOchildintros =
(
Map.singleton name_ (\_ _ -> Right (empty, Set.empty, Map.empty))
)
_lhsOterminaldefs =
(
Set.singleton $ fieldname name_
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_lhsOchildTypes =
(
Map.singleton name_ tp_
)
_lhsOargpats =
(
_argpats
)
in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))))
sem_EChildren :: EChildren ->
T_EChildren
sem_EChildren list =
(Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list))
newtype T_EChildren = T_EChildren ((Map NontermIdent Int) ->
ConstructorIdent ->
PP_Doc ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
NontermIdent ->
Options ->
String ->
PP_Doc ->
( ([PP_Doc]),( [PP_Doc] ),( [PP_Doc] ),(Map Identifier Type),(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),([PP_Doc]),(Set String)))
data Inh_EChildren = Inh_EChildren {allInitStates_Inh_EChildren :: (Map NontermIdent Int),con_Inh_EChildren :: ConstructorIdent,importBlocks_Inh_EChildren :: PP_Doc,mainFile_Inh_EChildren :: String,mainName_Inh_EChildren :: String,moduleHeader_Inh_EChildren :: (String -> String -> String -> Bool -> String),nt_Inh_EChildren :: NontermIdent,options_Inh_EChildren :: Options,pragmaBlocks_Inh_EChildren :: String,textBlocks_Inh_EChildren :: PP_Doc}
data Syn_EChildren = Syn_EChildren {argnamesw_Syn_EChildren :: ([PP_Doc]),argpats_Syn_EChildren :: ( [PP_Doc] ),argtps_Syn_EChildren :: ( [PP_Doc] ),childTypes_Syn_EChildren :: (Map Identifier Type),childintros_Syn_EChildren :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),datatype_Syn_EChildren :: ([PP_Doc]),terminaldefs_Syn_EChildren :: (Set String)}
wrap_EChildren :: T_EChildren ->
Inh_EChildren ->
Syn_EChildren
wrap_EChildren (T_EChildren sem) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) =
(let ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks
in (Syn_EChildren _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs))
sem_EChildren_Cons :: T_EChild ->
T_EChildren ->
T_EChildren
sem_EChildren_Cons (T_EChild hd_) (T_EChildren tl_) =
(T_EChildren (\ _lhsIallInitStates
_lhsIcon
_lhsIimportBlocks
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsItextBlocks ->
(let _lhsOargnamesw :: ([PP_Doc])
_lhsOargpats :: ( [PP_Doc] )
_lhsOargtps :: ( [PP_Doc] )
_lhsOchildTypes :: (Map Identifier Type)
_lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_lhsOdatatype :: ([PP_Doc])
_lhsOterminaldefs :: (Set String)
_hdOallInitStates :: (Map NontermIdent Int)
_hdOcon :: ConstructorIdent
_hdOimportBlocks :: PP_Doc
_hdOmainFile :: String
_hdOmainName :: String
_hdOmoduleHeader :: (String -> String -> String -> Bool -> String)
_hdOnt :: NontermIdent
_hdOoptions :: Options
_hdOpragmaBlocks :: String
_hdOtextBlocks :: PP_Doc
_tlOallInitStates :: (Map NontermIdent Int)
_tlOcon :: ConstructorIdent
_tlOimportBlocks :: PP_Doc
_tlOmainFile :: String
_tlOmainName :: String
_tlOmoduleHeader :: (String -> String -> String -> Bool -> String)
_tlOnt :: NontermIdent
_tlOoptions :: Options
_tlOpragmaBlocks :: String
_tlOtextBlocks :: PP_Doc
_hdIargnamesw :: ( PP_Doc )
_hdIargpats :: ( PP_Doc )
_hdIargtps :: ( PP_Doc )
_hdIchildTypes :: (Map Identifier Type)
_hdIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_hdIdatatype :: PP_Doc
_hdIterminaldefs :: (Set String)
_tlIargnamesw :: ([PP_Doc])
_tlIargpats :: ( [PP_Doc] )
_tlIargtps :: ( [PP_Doc] )
_tlIchildTypes :: (Map Identifier Type)
_tlIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_tlIdatatype :: ([PP_Doc])
_tlIterminaldefs :: (Set String)
_lhsOargnamesw =
(
_hdIargnamesw : _tlIargnamesw
)
_lhsOargpats =
(
_hdIargpats : _tlIargpats
)
_lhsOargtps =
(
_hdIargtps : _tlIargtps
)
_lhsOchildTypes =
(
_hdIchildTypes `mappend` _tlIchildTypes
)
_lhsOchildintros =
(
_hdIchildintros `Map.union` _tlIchildintros
)
_lhsOdatatype =
(
_hdIdatatype : _tlIdatatype
)
_lhsOterminaldefs =
(
_hdIterminaldefs `Set.union` _tlIterminaldefs
)
_hdOallInitStates =
(
_lhsIallInitStates
)
_hdOcon =
(
_lhsIcon
)
_hdOimportBlocks =
(
_lhsIimportBlocks
)
_hdOmainFile =
(
_lhsImainFile
)
_hdOmainName =
(
_lhsImainName
)
_hdOmoduleHeader =
(
_lhsImoduleHeader
)
_hdOnt =
(
_lhsInt
)
_hdOoptions =
(
_lhsIoptions
)
_hdOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_hdOtextBlocks =
(
_lhsItextBlocks
)
_tlOallInitStates =
(
_lhsIallInitStates
)
_tlOcon =
(
_lhsIcon
)
_tlOimportBlocks =
(
_lhsIimportBlocks
)
_tlOmainFile =
(
_lhsImainFile
)
_tlOmainName =
(
_lhsImainName
)
_tlOmoduleHeader =
(
_lhsImoduleHeader
)
_tlOnt =
(
_lhsInt
)
_tlOoptions =
(
_lhsIoptions
)
_tlOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_tlOtextBlocks =
(
_lhsItextBlocks
)
( _hdIargnamesw,_hdIargpats,_hdIargtps,_hdIchildTypes,_hdIchildintros,_hdIdatatype,_hdIterminaldefs) =
hd_ _hdOallInitStates _hdOcon _hdOimportBlocks _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOtextBlocks
( _tlIargnamesw,_tlIargpats,_tlIargtps,_tlIchildTypes,_tlIchildintros,_tlIdatatype,_tlIterminaldefs) =
tl_ _tlOallInitStates _tlOcon _tlOimportBlocks _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOtextBlocks
in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))))
sem_EChildren_Nil :: T_EChildren
sem_EChildren_Nil =
(T_EChildren (\ _lhsIallInitStates
_lhsIcon
_lhsIimportBlocks
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsItextBlocks ->
(let _lhsOargnamesw :: ([PP_Doc])
_lhsOargpats :: ( [PP_Doc] )
_lhsOargtps :: ( [PP_Doc] )
_lhsOchildTypes :: (Map Identifier Type)
_lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_lhsOdatatype :: ([PP_Doc])
_lhsOterminaldefs :: (Set String)
_lhsOargnamesw =
(
[]
)
_lhsOargpats =
(
[]
)
_lhsOargtps =
(
[]
)
_lhsOchildTypes =
(
mempty
)
_lhsOchildintros =
(
Map.empty
)
_lhsOdatatype =
(
[]
)
_lhsOterminaldefs =
(
Set.empty
)
in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))))
sem_ENonterminal :: ENonterminal ->
T_ENonterminal
sem_ENonterminal (ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits _prods _recursive _hoInfo) =
(sem_ENonterminal_ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits (sem_EProductions _prods) _recursive _hoInfo)
newtype T_ENonterminal = T_ENonterminal ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Int) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
Derivings ->
PP_Doc ->
(Map NontermIdent Attributes) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
Options ->
String ->
(Map NontermIdent Attributes) ->
PP_Doc ->
TypeSyns ->
(Set NontermIdent) ->
( ( PP_Doc ),( PP_Doc ),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_ENonterminal = Inh_ENonterminal {allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminal :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),derivings_Inh_ENonterminal :: Derivings,importBlocks_Inh_ENonterminal :: PP_Doc,inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminal :: String,mainName_Inh_ENonterminal :: String,moduleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminal :: Options,pragmaBlocks_Inh_ENonterminal :: String,synmap_Inh_ENonterminal :: (Map NontermIdent Attributes),textBlocks_Inh_ENonterminal :: PP_Doc,typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set NontermIdent)}
data Syn_ENonterminal = Syn_ENonterminal {appendCommon_Syn_ENonterminal :: ( PP_Doc ),appendMain_Syn_ENonterminal :: ( PP_Doc ),childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_ENonterminal :: (Seq Error),fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_ENonterminal :: (IO ()),imports_Syn_ENonterminal :: ([PP_Doc]),initStates_Syn_ENonterminal :: (Map NontermIdent Int),output_Syn_ENonterminal :: PP_Doc,semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc),visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier))}
wrap_ENonterminal :: T_ENonterminal ->
Inh_ENonterminal ->
Syn_ENonterminal
wrap_ENonterminal (T_ENonterminal sem) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) =
(let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers
in (Syn_ENonterminal _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_ENonterminal_ENonterminal :: NontermIdent ->
([Identifier]) ->
ClassContext ->
StateIdentifier ->
(Maybe VisitIdentifier) ->
(Map StateIdentifier StateCtx) ->
(Map StateIdentifier StateCtx) ->
T_EProductions ->
Bool ->
HigherOrderInfo ->
T_ENonterminal
sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ (T_EProductions prods_) recursive_ hoInfo_ =
(T_ENonterminal (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIderivings
_lhsIimportBlocks
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsIoptions
_lhsIpragmaBlocks
_lhsIsynmap
_lhsItextBlocks
_lhsItypeSyns
_lhsIwrappers ->
(let _prodsOrename :: Bool
_prodsOnt :: NontermIdent
_prodsOparams :: ([Identifier])
_prodsOclassCtxs :: ClassContext
_lhsOoutput :: PP_Doc
_prodsOinhmap :: Attributes
_prodsOsynmap :: Attributes
_prodsOallInhmap :: (Map NontermIdent Attributes)
_prodsOallSynmap :: (Map NontermIdent Attributes)
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_prodsOinitial :: StateIdentifier
_prodsOallstates :: (Set StateIdentifier)
_lhsOappendMain :: ( PP_Doc )
_lhsOappendCommon :: ( PP_Doc )
_prodsOnextVisits :: (Map StateIdentifier StateCtx)
_prodsOprevVisits :: (Map StateIdentifier StateCtx)
_prodsOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type))
_lhsOinitStates :: (Map NontermIdent Int)
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOgenProdIO :: (IO ())
_lhsOimports :: ([PP_Doc])
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_prodsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_prodsOallInitStates :: (Map NontermIdent Int)
_prodsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_prodsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_prodsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_prodsOavisituses :: (Map VisitIdentifier (Set Identifier))
_prodsOimportBlocks :: PP_Doc
_prodsOmainFile :: String
_prodsOmainName :: String
_prodsOmoduleHeader :: (String -> String -> String -> Bool -> String)
_prodsOntType :: Type
_prodsOoptions :: Options
_prodsOpragmaBlocks :: String
_prodsOtextBlocks :: PP_Doc
_prodsIallvisits :: ([VisitStateState])
_prodsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_prodsIcount :: Int
_prodsIdatatype :: ([PP_Doc])
_prodsIerrors :: (Seq Error)
_prodsIfromToStates :: (Map VisitIdentifier (Int,Int))
_prodsIgenProdIO :: (IO ())
_prodsIimports :: ([PP_Doc])
_prodsIsemFunBndDefs :: (Seq PP_Doc)
_prodsIsemFunBndTps :: (Seq PP_Doc)
_prodsIsem_nt :: PP_Doc
_prodsIsem_prod :: PP_Doc
_prodsIt_visits :: PP_Doc
_prodsIvisitKinds :: (Map VisitIdentifier VisitKind)
_prodsIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_prodsIvisituses :: (Map VisitIdentifier (Set Identifier))
_prodsOrename =
(
rename _lhsIoptions
)
_prodsOnt =
(
nt_
)
_prodsOparams =
(
params_
)
_prodsOclassCtxs =
(
classCtxs_
)
_lhsOoutput =
(
("-- " ++ getName nt_ ++ " " ++ replicate (60 length (getName nt_)) '-')
>-< (if dataTypes _lhsIoptions
then "-- data"
>-< _datatype
>-< ""
else empty)
>-< (if _hasWrapper
then "-- wrapper"
>-< _wr_inh
>-< _wr_syn
>-< _wrapper
>-< ""
else empty)
>-< (if folds _lhsIoptions
then "-- cata"
>-< _sem_nt
>-< ""
else empty)
>-< (if semfuns _lhsIoptions
then "-- semantic domain"
>-< _t_init
>-< _t_states
>-< _k_states
>-< _prodsIt_visits
>-< _prodsIsem_prod
>-< ""
else empty)
)
_hasWrapper =
(
nt_ `Set.member` _lhsIwrappers
)
_classPP =
(
ppClasses $ classCtxsToDocs classCtxs_
)
_aliasPre =
(
"type" >#< _classPP >#< nt_ >#< _t_params >#< "="
)
_datatype =
(
case lookup nt_ _lhsItypeSyns of
Nothing -> "data" >#< _classPP >#< nt_ >#< _t_params
>-< ( if null _prodsIdatatype
then empty
else indent 2 $ vlist $ ( ("=" >#< head _prodsIdatatype)
: (map ("|" >#<) $ tail _prodsIdatatype))
)
>-< indent 2 _derivings
Just (List t) -> _aliasPre >#< "[" >#< show t >#< "]"
Just (Maybe t) -> _aliasPre >#< "Maybe" >#< show t
Just (Tuple ts) -> _aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts)
Just (Either l r) -> _aliasPre >#< "Either" >#< show l >#< show r
Just (Map k v) -> _aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< show v
Just (IntMap t) -> _aliasPre >#< "Data.IntMap.IntMap" >#< show t
Just (OrdSet t) -> _aliasPre >#< "Data.Set.Set" >#< show t
Just IntSet -> _aliasPre >#< "Data.IntSet.IntSet"
)
_derivings =
(
case Map.lookup nt_ _lhsIderivings of
Nothing -> empty
Just s -> if Set.null s
then empty
else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s)
)
_fsemname =
(
\x -> "sem_" ++ show x
)
_semname =
(
_fsemname nt_
)
_frecarg =
(
\t x -> case t of
NT nt _ _ -> pp_parens (_fsemname nt >#< x)
_ -> pp x
)
_sem_tp =
(
_quantPP >#< _classPP >#< nt_ >#< _t_params >#< "->" >#< _t_type >#< _t_params
)
_quantPP =
(
ppQuants params_
)
_sem_nt =
(
_semPragma
>-< _semname >#< "::" >#< _sem_tp
>-< case lookup nt_ _lhsItypeSyns of
Nothing -> _prodsIsem_nt
Just (List t) -> _semname >#< "list" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Cons"
>#< _semname >|< "_Nil"
>#< case t of
NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt >#< "list")
_ -> pp "list"
Just (Maybe t) -> _semname >#< "Prelude.Nothing" >#< "=" >#< _semname >|< "_Nothing"
>-< _semname >#< pp_parens ("Prelude.Just just") >#< "="
>#< _semname >|< "_Just" >#< _frecarg t "just"
Just (Tuple ts) -> _semname >#< pp_parens (ppCommas $ map fst ts) >#< "="
>#< _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (show $ fst t)) ts)
Just (Either l r) -> _semname >#< "(Prelude.Left left)" >#< "=" >#< _semname >|< "_Left" >#< _frecarg l "left"
>-< _semname >#< "(Prelude.Right right)" >#< "=" >#< _semname >|< "_Right" >#< _frecarg r "right"
Just (Map k v) -> _semname >#< "m" >#< "=" >#< "Data.Map.foldrWithKey"
>#< _semname >|< "_Entry" >#< _semname >|< "_Nil"
>#< case v of
NT nt _ _ -> pp_parens ("Data.Map.map" >#< _fsemname nt >#< "m")
_ -> pp "m"
Just (IntMap v) -> _semname >#< "m" >#< "=" >#< "Data.IntMap.foldWithKey"
>#< _semname >|< "_Entry" >#< _semname >|< "_Nil"
>#< case v of
NT nt _ _ -> pp_parens ("Data.IntMap.map" >#< _fsemname nt >#< "m")
_ -> pp "m"
Just (OrdSet t) -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry"
>#< _semname >|< "_Nil"
>#< pp_parens (
( case t of
NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt)
_ -> empty
) >#< pp_parens ("Data.IntSet.elems" >#< "s")
)
Just IntSet -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry"
>#< _semname >|< "_Nil"
>#< pp_parens ("Data.IntSet.elems" >#< "s")
)
_inlineNt =
(
not (lateHigherOrderBinding _lhsIoptions) && not recursive_ && (_prodsIcount == 1 || (aggressiveInlinePragmas _lhsIoptions && not _hasWrapper ))
)
_semPragma =
(
if noInlinePragmas _lhsIoptions
then empty
else if _inlineNt
then ppInline _semname
else if helpInlining _lhsIoptions && not (lateHigherOrderBinding _lhsIoptions)
then ppInlinable _semname
else ppNoInline _semname
)
(Just _prodsOinhmap) =
(
Map.lookup nt_ _lhsIinhmap
)
(Just _prodsOsynmap) =
(
Map.lookup nt_ _lhsIsynmap
)
_prodsOallInhmap =
(
_lhsIinhmap
)
_prodsOallSynmap =
(
_lhsIsynmap
)
_outedges =
(
Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits
)
_inedges =
(
Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits
)
_allstates =
(
Set.insert initial_ $ _inedges `Set.union` _outedges
)
_stvisits =
(
\st -> filter (\(v,f,t) -> f == st) _prodsIallvisits
)
_t_type =
(
"T_" >|< nt_
)
_t_params =
(
ppSpaced params_
)
_t_init =
(
"newtype" >#< _t_type >#< _t_params >#< "=" >#< _t_type >#<
pp_braces (
"attach_">|< _t_type >#< "::"
>#< ppMonadType _lhsIoptions >#< pp_parens (_t_type >|< "_s" >|< initial_ >#< _t_params ))
)
_t_states =
(
vlist $ map (\st ->
let nt_st = nt_ >|< "_s" >|< st
t_st = "T_" >|< nt_st
k_st = "K_" >|< nt_st
c_st = "C_" >|< nt_st
inv_st = "inv_" >|< nt_st
nextVisit = Map.findWithDefault ManyVis st nextVisits_
in case nextVisit of
NoneVis -> "data" >#< t_st >#< _t_params >#< "=" >#< c_st
OneVis vId -> "newtype" >#< t_st >#< _t_params >#< "=" >#< c_st
>#< (pp_braces $ inv_st >#< "::" >#< pp_parens (conNmTVisit nt_ vId >#< _t_params ))
ManyVis -> "data" >#< t_st >#< _t_params >#< "where" >#< c_st >#< "::"
>#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("forall t." >#< k_st >#< _t_params >#< "t" >#< "->" >#< "t"))
>#< "->" >#< t_st >#< _t_params
) $ Set.toList _allstates
)
_k_type =
(
"K_" ++ show nt_
)
_k_states =
(
vlist $ map (\st ->
let nt_st = nt_ >|< "_s" >|< st
k_st = "K_" >|< nt_st
outg = filter (\(v,f,t) -> f == st) _prodsIallvisits
visitlist = vlist $ map (\(v,f,t) ->
_k_type >|< "_v" >|< v >#< "::" >#< k_st >#< _t_params >#< pp_parens (_t_type >|< "_v" >|< v >#< _t_params )
) outg
nextVisit = Map.findWithDefault ManyVis st nextVisits_
decl = "data" >#< k_st >#< "k" >#< _t_params >#< "where" >-< indent 3 visitlist
in case nextVisit of
NoneVis -> empty
OneVis _ -> empty
ManyVis -> decl
) $ Set.toList _allstates
)
_wr_inh =
(
_genwrap "Inh" _wr_inhs
)
_wr_syn =
(
_genwrap "Syn" _wr_syns
)
_genwrap =
(
\nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< _t_params >#< "=" >#< nm >|< "_" >|< nt_ >#< "{"
>#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::"
>#< (_addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t)) attr) >#< "}"
)
_synAttrs =
(
fromJust $ Map.lookup nt_ _lhsIinhmap
)
_wr_inhs =
(
Map.toList $ _wr_filter $ _synAttrs
)
_wr_inhs1 =
(
Map.toList _synAttrs
)
_wr_filter =
(
if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions
then Map.delete idLateBindingAttr
else id
)
_wr_syns =
(
Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap
)
_inhlist =
(
map (lhsname True . fst) _wr_inhs
)
_inhlist1 =
(
map (lhsname True . fst) _wr_inhs1
)
_synlist =
(
map (lhsname False . fst) _wr_syns
)
_wrapname =
(
"wrap_" ++ show nt_
)
_inhname =
(
"Inh_" ++ show nt_
)
_synname =
(
"Syn_" ++ show nt_
)
_firstVisitInfo =
(
Map.findWithDefault ManyVis initial_ nextVisits_
)
_wrapper =
(
_wrapPragma
>-< (_wrapname >#< "::" >#< _quantPP >#< _classPP >#< _t_type >#< _t_params >#< "->"
>#< _inhname >#< _t_params >#< "->" >#< ( if monadicWrappers _lhsIoptions then ppMonadType _lhsIoptions else empty) >#< pp_parens (_synname >#< _t_params ))
>-< (_wrapname >#< (_addbang $ pp_parens (_t_type >#< pp "act"))
>#< (_addbang $ pp_parens (_inhname
>#< (ppSpaced $ map (_addbangWrap . pp) _inhlist )) >#< "="))
>-<
indent 3 (case initialv_ of
Nothing -> _synname >#< " { }"
Just initv ->
let inCon = conNmTVisitIn nt_ initv
outCon = conNmTVisitOut nt_ initv
pat = _addbang $ pp_parens $ pat0
pat0 = outCon >#< ppSpaced _synlist
arg = inCon >#< ppSpaced _inhlist1
ind = case _firstVisitInfo of
NoneVis -> error "wrapper: initial state should have a next visit but it has none"
OneVis _ -> empty
ManyVis -> _k_type >|< "_v" >|< initv
extra = if dummyTokenVisit _lhsIoptions
then pp $ dummyArg _lhsIoptions True
else empty
convert = case Map.lookup initv _lhsIallVisitKinds of
Just kind -> case kind of
VisitPure _ -> text "return"
VisitMonadic -> empty
unMonad | monadicWrappers _lhsIoptions = empty
| otherwise = unMon _lhsIoptions
in unMonad >#< "("
>-< indent 2 (
"do" >#< ( _addbang (pp "sem") >#< "<-" >#< "act"
>-< "let" >#< _addbangWrap (pp "arg") >#< "=" >#< arg
>-< pat >#< "<-" >#< convert >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< initial_ >#< "sem" >#< ind >#< "arg" >#< extra)
>-< "return" >#< pp_parens (_synname >#< ppSpaced _synlist )
)
)
>-< ")" )
>-< if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions
then indent 2 ("where" >#< lhsname True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName)
else empty
)
_wrapPragma =
(
if parallelInvoke _lhsIoptions && not (monadicWrappers _lhsIoptions)
then ppNoInline _wrapname
else if noInlinePragmas _lhsIoptions
then empty
else ppInlinable _wrapname
)
_lhsOsemFunBndDefs =
(
_semFunBndDef Seq.<| _prodsIsemFunBndDefs
)
_lhsOsemFunBndTps =
(
_semFunBndTp Seq.<| _prodsIsemFunBndTps
)
_semFunBndDef =
(
_semFunBndNm >#< "=" >#< _semname
)
_semFunBndTp =
(
_semFunBndNm >#< "::" >#< _sem_tp
)
_semFunBndNm =
(
lateSemNtLabel nt_
)
_prodsOinitial =
(
initial_
)
_prodsOallstates =
(
_allstates
)
_lhsOappendMain =
(
(if nt_ `Set.member` _lhsIwrappers
then _wr_inh
>-< _wr_syn
>-< _wrapper
else empty)
>-< _sem_nt
)
_lhsOappendCommon =
(
(if dataTypes _lhsIoptions then _datatype else empty)
>-< _t_init
>-< _t_states
>-< _k_states
>-< _prodsIt_visits
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbangWrap =
(
if strictWrap _lhsIoptions then _addbang else id
)
_prodsOnextVisits =
(
nextVisits_
)
_prodsOprevVisits =
(
prevVisits_
)
_prodsOlocalAttrTypes =
(
Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes
)
_lhsOinitStates =
(
Map.singleton nt_ initial_
)
_ntType =
(
NT nt_ (map show params_) False
)
_lhsOchildvisit =
(
_prodsIchildvisit
)
_lhsOerrors =
(
_prodsIerrors
)
_lhsOfromToStates =
(
_prodsIfromToStates
)
_lhsOgenProdIO =
(
_prodsIgenProdIO
)
_lhsOimports =
(
_prodsIimports
)
_lhsOvisitKinds =
(
_prodsIvisitKinds
)
_lhsOvisitdefs =
(
_prodsIvisitdefs
)
_lhsOvisituses =
(
_prodsIvisituses
)
_prodsOallFromToStates =
(
_lhsIallFromToStates
)
_prodsOallInitStates =
(
_lhsIallInitStates
)
_prodsOallVisitKinds =
(
_lhsIallVisitKinds
)
_prodsOallchildvisit =
(
_lhsIallchildvisit
)
_prodsOavisitdefs =
(
_lhsIavisitdefs
)
_prodsOavisituses =
(
_lhsIavisituses
)
_prodsOimportBlocks =
(
_lhsIimportBlocks
)
_prodsOmainFile =
(
_lhsImainFile
)
_prodsOmainName =
(
_lhsImainName
)
_prodsOmoduleHeader =
(
_lhsImoduleHeader
)
_prodsOntType =
(
_ntType
)
_prodsOoptions =
(
_lhsIoptions
)
_prodsOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_prodsOtextBlocks =
(
_lhsItextBlocks
)
( _prodsIallvisits,_prodsIchildvisit,_prodsIcount,_prodsIdatatype,_prodsIerrors,_prodsIfromToStates,_prodsIgenProdIO,_prodsIimports,_prodsIsemFunBndDefs,_prodsIsemFunBndTps,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitKinds,_prodsIvisitdefs,_prodsIvisituses) =
prods_ _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOclassCtxs _prodsOimportBlocks _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOmoduleHeader _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOpragmaBlocks _prodsOprevVisits _prodsOrename _prodsOsynmap _prodsOtextBlocks
in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_ENonterminals :: ENonterminals ->
T_ENonterminals
sem_ENonterminals list =
(Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list))
newtype T_ENonterminals = T_ENonterminals ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Int) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
Derivings ->
PP_Doc ->
(Map NontermIdent Attributes) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
Options ->
String ->
(Map NontermIdent Attributes) ->
PP_Doc ->
TypeSyns ->
(Set NontermIdent) ->
( ([PP_Doc]),([PP_Doc]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_ENonterminals = Inh_ENonterminals {allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminals :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),derivings_Inh_ENonterminals :: Derivings,importBlocks_Inh_ENonterminals :: PP_Doc,inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminals :: String,mainName_Inh_ENonterminals :: String,moduleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminals :: Options,pragmaBlocks_Inh_ENonterminals :: String,synmap_Inh_ENonterminals :: (Map NontermIdent Attributes),textBlocks_Inh_ENonterminals :: PP_Doc,typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set NontermIdent)}
data Syn_ENonterminals = Syn_ENonterminals {appendCommon_Syn_ENonterminals :: ([PP_Doc]),appendMain_Syn_ENonterminals :: ([PP_Doc]),childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_ENonterminals :: (Seq Error),fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_ENonterminals :: (IO ()),imports_Syn_ENonterminals :: ([PP_Doc]),initStates_Syn_ENonterminals :: (Map NontermIdent Int),output_Syn_ENonterminals :: PP_Doc,semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc),visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier))}
wrap_ENonterminals :: T_ENonterminals ->
Inh_ENonterminals ->
Syn_ENonterminals
wrap_ENonterminals (T_ENonterminals sem) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) =
(let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers
in (Syn_ENonterminals _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_ENonterminals_Cons :: T_ENonterminal ->
T_ENonterminals ->
T_ENonterminals
sem_ENonterminals_Cons (T_ENonterminal hd_) (T_ENonterminals tl_) =
(T_ENonterminals (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIderivings
_lhsIimportBlocks
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsIoptions
_lhsIpragmaBlocks
_lhsIsynmap
_lhsItextBlocks
_lhsItypeSyns
_lhsIwrappers ->
(let _lhsOappendCommon :: ([PP_Doc])
_lhsOappendMain :: ([PP_Doc])
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOgenProdIO :: (IO ())
_lhsOimports :: ([PP_Doc])
_lhsOinitStates :: (Map NontermIdent Int)
_lhsOoutput :: PP_Doc
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_hdOallFromToStates :: (Map VisitIdentifier (Int,Int))
_hdOallInitStates :: (Map NontermIdent Int)
_hdOallVisitKinds :: (Map VisitIdentifier VisitKind)
_hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdOavisituses :: (Map VisitIdentifier (Set Identifier))
_hdOderivings :: Derivings
_hdOimportBlocks :: PP_Doc
_hdOinhmap :: (Map NontermIdent Attributes)
_hdOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type)))
_hdOmainFile :: String
_hdOmainName :: String
_hdOmoduleHeader :: (String -> String -> String -> Bool -> String)
_hdOoptions :: Options
_hdOpragmaBlocks :: String
_hdOsynmap :: (Map NontermIdent Attributes)
_hdOtextBlocks :: PP_Doc
_hdOtypeSyns :: TypeSyns
_hdOwrappers :: (Set NontermIdent)
_tlOallFromToStates :: (Map VisitIdentifier (Int,Int))
_tlOallInitStates :: (Map NontermIdent Int)
_tlOallVisitKinds :: (Map VisitIdentifier VisitKind)
_tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlOavisituses :: (Map VisitIdentifier (Set Identifier))
_tlOderivings :: Derivings
_tlOimportBlocks :: PP_Doc
_tlOinhmap :: (Map NontermIdent Attributes)
_tlOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type)))
_tlOmainFile :: String
_tlOmainName :: String
_tlOmoduleHeader :: (String -> String -> String -> Bool -> String)
_tlOoptions :: Options
_tlOpragmaBlocks :: String
_tlOsynmap :: (Map NontermIdent Attributes)
_tlOtextBlocks :: PP_Doc
_tlOtypeSyns :: TypeSyns
_tlOwrappers :: (Set NontermIdent)
_hdIappendCommon :: ( PP_Doc )
_hdIappendMain :: ( PP_Doc )
_hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdIerrors :: (Seq Error)
_hdIfromToStates :: (Map VisitIdentifier (Int,Int))
_hdIgenProdIO :: (IO ())
_hdIimports :: ([PP_Doc])
_hdIinitStates :: (Map NontermIdent Int)
_hdIoutput :: PP_Doc
_hdIsemFunBndDefs :: (Seq PP_Doc)
_hdIsemFunBndTps :: (Seq PP_Doc)
_hdIvisitKinds :: (Map VisitIdentifier VisitKind)
_hdIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdIvisituses :: (Map VisitIdentifier (Set Identifier))
_tlIappendCommon :: ([PP_Doc])
_tlIappendMain :: ([PP_Doc])
_tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlIerrors :: (Seq Error)
_tlIfromToStates :: (Map VisitIdentifier (Int,Int))
_tlIgenProdIO :: (IO ())
_tlIimports :: ([PP_Doc])
_tlIinitStates :: (Map NontermIdent Int)
_tlIoutput :: PP_Doc
_tlIsemFunBndDefs :: (Seq PP_Doc)
_tlIsemFunBndTps :: (Seq PP_Doc)
_tlIvisitKinds :: (Map VisitIdentifier VisitKind)
_tlIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlIvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOappendCommon =
(
_hdIappendCommon : _tlIappendCommon
)
_lhsOappendMain =
(
_hdIappendMain : _tlIappendMain
)
_lhsOchildvisit =
(
_hdIchildvisit `Map.union` _tlIchildvisit
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOfromToStates =
(
_hdIfromToStates `mappend` _tlIfromToStates
)
_lhsOgenProdIO =
(
_hdIgenProdIO >> _tlIgenProdIO
)
_lhsOimports =
(
_hdIimports ++ _tlIimports
)
_lhsOinitStates =
(
_hdIinitStates `mappend` _tlIinitStates
)
_lhsOoutput =
(
_hdIoutput >-< _tlIoutput
)
_lhsOsemFunBndDefs =
(
_hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs
)
_lhsOsemFunBndTps =
(
_hdIsemFunBndTps Seq.>< _tlIsemFunBndTps
)
_lhsOvisitKinds =
(
_hdIvisitKinds `mappend` _tlIvisitKinds
)
_lhsOvisitdefs =
(
_hdIvisitdefs `uwSetUnion` _tlIvisitdefs
)
_lhsOvisituses =
(
_hdIvisituses `uwSetUnion` _tlIvisituses
)
_hdOallFromToStates =
(
_lhsIallFromToStates
)
_hdOallInitStates =
(
_lhsIallInitStates
)
_hdOallVisitKinds =
(
_lhsIallVisitKinds
)
_hdOallchildvisit =
(
_lhsIallchildvisit
)
_hdOavisitdefs =
(
_lhsIavisitdefs
)
_hdOavisituses =
(
_lhsIavisituses
)
_hdOderivings =
(
_lhsIderivings
)
_hdOimportBlocks =
(
_lhsIimportBlocks
)
_hdOinhmap =
(
_lhsIinhmap
)
_hdOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_hdOmainFile =
(
_lhsImainFile
)
_hdOmainName =
(
_lhsImainName
)
_hdOmoduleHeader =
(
_lhsImoduleHeader
)
_hdOoptions =
(
_lhsIoptions
)
_hdOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_hdOsynmap =
(
_lhsIsynmap
)
_hdOtextBlocks =
(
_lhsItextBlocks
)
_hdOtypeSyns =
(
_lhsItypeSyns
)
_hdOwrappers =
(
_lhsIwrappers
)
_tlOallFromToStates =
(
_lhsIallFromToStates
)
_tlOallInitStates =
(
_lhsIallInitStates
)
_tlOallVisitKinds =
(
_lhsIallVisitKinds
)
_tlOallchildvisit =
(
_lhsIallchildvisit
)
_tlOavisitdefs =
(
_lhsIavisitdefs
)
_tlOavisituses =
(
_lhsIavisituses
)
_tlOderivings =
(
_lhsIderivings
)
_tlOimportBlocks =
(
_lhsIimportBlocks
)
_tlOinhmap =
(
_lhsIinhmap
)
_tlOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_tlOmainFile =
(
_lhsImainFile
)
_tlOmainName =
(
_lhsImainName
)
_tlOmoduleHeader =
(
_lhsImoduleHeader
)
_tlOoptions =
(
_lhsIoptions
)
_tlOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_tlOsynmap =
(
_lhsIsynmap
)
_tlOtextBlocks =
(
_lhsItextBlocks
)
_tlOtypeSyns =
(
_lhsItypeSyns
)
_tlOwrappers =
(
_lhsIwrappers
)
( _hdIappendCommon,_hdIappendMain,_hdIchildvisit,_hdIerrors,_hdIfromToStates,_hdIgenProdIO,_hdIimports,_hdIinitStates,_hdIoutput,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) =
hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOderivings _hdOimportBlocks _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOoptions _hdOpragmaBlocks _hdOsynmap _hdOtextBlocks _hdOtypeSyns _hdOwrappers
( _tlIappendCommon,_tlIappendMain,_tlIchildvisit,_tlIerrors,_tlIfromToStates,_tlIgenProdIO,_tlIimports,_tlIinitStates,_tlIoutput,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) =
tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOderivings _tlOimportBlocks _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOoptions _tlOpragmaBlocks _tlOsynmap _tlOtextBlocks _tlOtypeSyns _tlOwrappers
in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_ENonterminals_Nil :: T_ENonterminals
sem_ENonterminals_Nil =
(T_ENonterminals (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIderivings
_lhsIimportBlocks
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsIoptions
_lhsIpragmaBlocks
_lhsIsynmap
_lhsItextBlocks
_lhsItypeSyns
_lhsIwrappers ->
(let _lhsOappendCommon :: ([PP_Doc])
_lhsOappendMain :: ([PP_Doc])
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOgenProdIO :: (IO ())
_lhsOimports :: ([PP_Doc])
_lhsOinitStates :: (Map NontermIdent Int)
_lhsOoutput :: PP_Doc
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOappendCommon =
(
[]
)
_lhsOappendMain =
(
[]
)
_lhsOchildvisit =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOfromToStates =
(
mempty
)
_lhsOgenProdIO =
(
return ()
)
_lhsOimports =
(
[]
)
_lhsOinitStates =
(
mempty
)
_lhsOoutput =
(
empty
)
_lhsOsemFunBndDefs =
(
Seq.empty
)
_lhsOsemFunBndTps =
(
Seq.empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOvisitdefs =
(
Map.empty
)
_lhsOvisituses =
(
Map.empty
)
in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_EProduction :: EProduction ->
T_EProduction
sem_EProduction (EProduction _con _params _constraints _rules _children _visits) =
(sem_EProduction_EProduction _con _params _constraints (sem_ERules _rules) (sem_EChildren _children) (sem_Visits _visits))
newtype T_EProduction = T_EProduction ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Attributes) ->
(Map NontermIdent Int) ->
(Map NontermIdent Attributes) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Set StateIdentifier) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
ClassContext ->
PP_Doc ->
Attributes ->
StateIdentifier ->
(Map ConstructorIdent (Map Identifier Type)) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
(Map StateIdentifier StateCtx) ->
NontermIdent ->
Type ->
Options ->
([Identifier]) ->
String ->
(Map StateIdentifier StateCtx) ->
Bool ->
Attributes ->
PP_Doc ->
( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),Int,PP_Doc,(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_EProduction = Inh_EProduction {allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProduction :: (Map NontermIdent Attributes),allInitStates_Inh_EProduction :: (Map NontermIdent Int),allSynmap_Inh_EProduction :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allstates_Inh_EProduction :: (Set StateIdentifier),avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),classCtxs_Inh_EProduction :: ClassContext,importBlocks_Inh_EProduction :: PP_Doc,inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProduction :: String,mainName_Inh_EProduction :: String,moduleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String),nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),nt_Inh_EProduction :: NontermIdent,ntType_Inh_EProduction :: Type,options_Inh_EProduction :: Options,params_Inh_EProduction :: ([Identifier]),pragmaBlocks_Inh_EProduction :: String,prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),rename_Inh_EProduction :: Bool,synmap_Inh_EProduction :: Attributes,textBlocks_Inh_EProduction :: PP_Doc}
data Syn_EProduction = Syn_EProduction {allvisits_Syn_EProduction :: ([VisitStateState]),childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),count_Syn_EProduction :: Int,datatype_Syn_EProduction :: PP_Doc,errors_Syn_EProduction :: (Seq Error),fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_EProduction :: (IO ()),imports_Syn_EProduction :: ([PP_Doc]),semFunBndDefs_Syn_EProduction :: (Seq PP_Doc),semFunBndTps_Syn_EProduction :: (Seq PP_Doc),sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier))}
wrap_EProduction :: T_EProduction ->
Inh_EProduction ->
Syn_EProduction
wrap_EProduction (T_EProduction sem) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) =
(let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks
in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_EProduction_EProduction :: ConstructorIdent ->
([Identifier]) ->
([Type]) ->
T_ERules ->
T_EChildren ->
T_Visits ->
T_EProduction
sem_EProduction_EProduction con_ params_ constraints_ (T_ERules rules_) (T_EChildren children_) (T_Visits visits_) =
(T_EProduction (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallstates
_lhsIavisitdefs
_lhsIavisituses
_lhsIclassCtxs
_lhsIimportBlocks
_lhsIinhmap
_lhsIinitial
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInextVisits
_lhsInt
_lhsIntType
_lhsIoptions
_lhsIparams
_lhsIpragmaBlocks
_lhsIprevVisits
_lhsIrename
_lhsIsynmap
_lhsItextBlocks ->
(let _childrenOcon :: ConstructorIdent
_rulesOcon :: ConstructorIdent
_visitsOcon :: ConstructorIdent
_lhsOdatatype :: PP_Doc
_lhsOcount :: Int
_lhsOsem_nt :: PP_Doc
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_visitsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_visitsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_rulesOusageInfo :: (Map Identifier Int)
_rulesOruleKinds :: (Map Identifier (Set VisitKind))
_visitsOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_visitsOterminaldefs :: (Set String)
_visitsOruledefs :: (Map Identifier (Set String))
_visitsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_lhsOimports :: ([PP_Doc])
_lhsOgenProdIO :: (IO ())
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOt_visits :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOallvisits :: ([VisitStateState])
_lhsOsem_prod :: PP_Doc
_rulesOallInhmap :: (Map NontermIdent Attributes)
_rulesOallSynmap :: (Map NontermIdent Attributes)
_rulesOchildTypes :: (Map Identifier Type)
_rulesOimportBlocks :: PP_Doc
_rulesOinhmap :: Attributes
_rulesOlazyIntras :: (Set String)
_rulesOlocalAttrTypes :: (Map Identifier Type)
_rulesOmainFile :: String
_rulesOmainName :: String
_rulesOmoduleHeader :: (String -> String -> String -> Bool -> String)
_rulesOnt :: NontermIdent
_rulesOoptions :: Options
_rulesOpragmaBlocks :: String
_rulesOsynmap :: Attributes
_rulesOtextBlocks :: PP_Doc
_childrenOallInitStates :: (Map NontermIdent Int)
_childrenOimportBlocks :: PP_Doc
_childrenOmainFile :: String
_childrenOmainName :: String
_childrenOmoduleHeader :: (String -> String -> String -> Bool -> String)
_childrenOnt :: NontermIdent
_childrenOoptions :: Options
_childrenOpragmaBlocks :: String
_childrenOtextBlocks :: PP_Doc
_visitsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_visitsOallInhmap :: (Map NontermIdent Attributes)
_visitsOallInitStates :: (Map NontermIdent Int)
_visitsOallSynmap :: (Map NontermIdent Attributes)
_visitsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_visitsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_visitsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_visitsOavisituses :: (Map VisitIdentifier (Set Identifier))
_visitsOchildTypes :: (Map Identifier Type)
_visitsOinhmap :: Attributes
_visitsOnextVisits :: (Map StateIdentifier StateCtx)
_visitsOnt :: NontermIdent
_visitsOoptions :: Options
_visitsOparams :: ([Identifier])
_visitsOprevVisits :: (Map StateIdentifier StateCtx)
_visitsOsynmap :: Attributes
_rulesIerrors :: (Seq Error)
_rulesImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_rulesIruledefs :: (Map Identifier (Set String))
_rulesIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_rulesIsem_rules :: PP_Doc
_childrenIargnamesw :: ([PP_Doc])
_childrenIargpats :: ( [PP_Doc] )
_childrenIargtps :: ( [PP_Doc] )
_childrenIchildTypes :: (Map Identifier Type)
_childrenIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_childrenIdatatype :: ([PP_Doc])
_childrenIterminaldefs :: (Set String)
_visitsIallvisits :: ([VisitStateState])
_visitsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_visitsIerrors :: (Seq Error)
_visitsIfromToStates :: (Map VisitIdentifier (Int,Int))
_visitsIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_visitsIlazyIntras :: (Set String)
_visitsIruleKinds :: (Map Identifier (Set VisitKind))
_visitsIruleUsage :: (Map Identifier Int)
_visitsIsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] )
_visitsIt_visits :: PP_Doc
_visitsIvisitKinds :: (Map VisitIdentifier VisitKind)
_visitsIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_visitsIvisituses :: (Map VisitIdentifier (Set Identifier))
_childrenOcon =
(
con_
)
_rulesOcon =
(
con_
)
_visitsOcon =
(
con_
)
_lhsOdatatype =
(
_quantPP1 >#< _classPP1
>#< conname _lhsIrename _lhsInt con_
>#< ppConFields (dataRecords _lhsIoptions) _childrenIdatatype
)
_classPP1 =
(
ppClasses (classConstrsToDocs constraints_)
)
_quantPP1 =
(
ppQuants params_
)
_lhsOcount =
(
1
)
_lhsOsem_nt =
(
"sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargpats >#< ")"
>#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw
)
_lhsOsemFunBndDefs =
(
Seq.singleton _semFunBndDef
)
_lhsOsemFunBndTps =
(
Seq.singleton _semFunBndTp
)
_semFunBndDef =
(
_semFunBndNm >#< "=" >#< _semname
)
_semFunBndTp =
(
_semFunBndNm >#< "::" >#< _sem_tp
)
_semFunBndNm =
(
lateSemConLabel _lhsInt con_
)
_t_type =
(
"T_" >|< _lhsInt
)
_t_params =
(
ppSpaced _lhsIparams
)
_args =
(
_childrenIargpats
)
_semname =
(
"sem_" ++ show _lhsInt ++ "_" ++ show con_
)
_sem_tp =
(
_quantPP2 >#< _classPP2 >#< ppSpaced _childrenIargtps >#< _t_type >#< _t_params
)
_classPP2 =
(
ppClasses (classCtxsToDocs _lhsIclassCtxs ++ classConstrsToDocs constraints_)
)
_quantPP2 =
(
ppQuants (_lhsIparams ++ params_)
)
_sem_prod =
(
_semInlinePragma
>-< _semname >#< "::" >#< _sem_tp
>-< _mkSemBody (_semname >#< ppSpaced _args >#< "=" >#< _scc >#< _t_type )
_mbInitializer _outerlet ("return" >#< "st" >|< _lhsIinitial)
)
_mkSemBody =
(
\prefix mbInit outerlet ret ->
case mbInit of
Nothing -> prefix >#< pp_parens ret >#< "where"
>-< indent 3 outerlet
Just m -> prefix >#< "(" >#< "do"
>-< indent 1 (
m
>-< "let"
>-< indent 2 outerlet
>-< ret )
>-< indent 1 ")"
)
_mbInitializer =
(
if parallelInvoke _lhsIoptions
then (Nothing :: Maybe PP_Doc)
else Nothing
)
_scc =
(
if genCostCentres _lhsIoptions
then ppCostCentre _semname
else empty
)
_semInlinePragma =
(
if noInlinePragmas _lhsIoptions
then empty
else ppNoInline _semname
)
_outerlet =
(
vlist _statefns >-< _rulesIsem_rules
)
_statefns =
(
map _genstfn $ Set.toList _lhsIallstates
)
_genstfn =
(
\st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits
prevVisitInfo = Map.findWithDefault ManyVis st _lhsIprevVisits
stNm = "st" >|< st
lhs = pragma >-< bang stNm >#< "=" >#<
(
if st == _lhsIinitial
then empty
else "\\" >#< _stargs st >#< "->"
)
pragma = if noInlinePragmas _lhsIoptions
then empty
else if helpInlining _lhsIoptions
then case prevVisitInfo of
ManyVis -> ppNoInline stNm
OneVis _ -> if aggressiveInlinePragmas _lhsIoptions
then ppInline stNm
else ppInlinable stNm
NoneVis -> if st /= _lhsIinitial
then error ("State " ++ show st ++ " is not reachable from the initial state.")
else if aggressiveInlinePragmas _lhsIoptions
then ppInline stNm
else ppInlinable stNm
else ppNoInline stNm
cCon = "C_" >|< _lhsInt >|< "_s" >|< st
bang | st == _lhsIinitial = _addbang
| otherwise = id
in case nextVisitInfo of
NoneVis ->
if st == _lhsIinitial
then lhs >#< cCon
else empty
OneVis vId -> mklet lhs (_stvs st False) (cCon >#< "v" >|< vId)
ManyVis -> mklet lhs (_stks st >-< _stvs st True) (cCon >#< "k" >|< st)
)
_stargs =
(
\st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap
in ppSpaced [ let match | str `Set.member` _lazyIntras = pp str
| otherwise = _addbang (pp str)
in case mbAttr of
Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) ->
case Map.lookup nm _localAttrTypes of
Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp)
Nothing -> match
Just attr | not (noPerStateTypeSigs _lhsIoptions) ->
case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of
Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc)
Nothing -> match
_ -> match
| (str,mbAttr) <- Map.assocs attrs
] >#< dummyPat _lhsIoptions (Map.null attrs)
)
_stks =
(
\st -> if null (_stvisits st)
then empty
else ( if not (noInlinePragmas _lhsIoptions) && helpInlining _lhsIoptions
then ppNoInline ("k" >|< st)
else empty
)
>-< "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< "t" >#< "->" >#< "t"
>-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "="
>#< "v" >|< v) $ _stvisits st)
)
_stvisits =
(
\st -> filter (\(v,f,t) -> f == st) _visitsIallvisits
)
_stvs =
(
\st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- _visitsIsem_visit, f == st]
)
_visitsOmrules =
(
_rulesImrules
)
_visitsOchildintros =
(
_childrenIchildintros
)
_rulesOusageInfo =
(
_visitsIruleUsage
)
_rulesOruleKinds =
(
_visitsIruleKinds
)
_visitsOallintramap =
(
_visitsIintramap
)
_visitsOterminaldefs =
(
_childrenIterminaldefs
)
_visitsOruledefs =
(
_rulesIruledefs
)
_visitsOruleuses =
(
_rulesIruleuses
)
_lazyIntras =
(
_visitsIlazyIntras
)
_lhsOimports =
(
[pp $ "import " ++ _moduleName ]
)
_moduleName =
(
_lhsImainName ++ _suffix
)
_suffix =
(
"_" ++ show _lhsInt ++ "_" ++ show con_
)
_outputfile =
(
replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ _suffix )
)
_ppMonadImports =
(
if parallelInvoke _lhsIoptions
then pp "import qualified System.IO.Unsafe(unsafePerformIO)"
>-< pp "import System.IO(IO)"
>-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"
else pp "import Control.Monad.Identity"
)
_lhsOgenProdIO =
(
writeModule _outputfile
[ warrenFlagsPP _lhsIoptions
, pp $ _lhsIpragmaBlocks
, pp $ _lhsImoduleHeader _lhsImainName _suffix _semname True
, _lhsIimportBlocks
, _ppMonadImports
, ( if tupleAsDummyToken _lhsIoptions
then empty
else pp "import GHC.Prim"
)
, pp $ "import " ++ _lhsImainName ++ "_common"
, _sem_prod
]
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_childTypes =
(
Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes
)
_localAttrTypes =
(
Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes
)
_lhsOchildvisit =
(
_visitsIchildvisit
)
_lhsOerrors =
(
_rulesIerrors Seq.>< _visitsIerrors
)
_lhsOfromToStates =
(
_visitsIfromToStates
)
_lhsOt_visits =
(
_visitsIt_visits
)
_lhsOvisitKinds =
(
_visitsIvisitKinds
)
_lhsOvisitdefs =
(
_visitsIvisitdefs
)
_lhsOvisituses =
(
_visitsIvisituses
)
_lhsOallvisits =
(
_visitsIallvisits
)
_lhsOsem_prod =
(
_sem_prod
)
_rulesOallInhmap =
(
_lhsIallInhmap
)
_rulesOallSynmap =
(
_lhsIallSynmap
)
_rulesOchildTypes =
(
_childTypes
)
_rulesOimportBlocks =
(
_lhsIimportBlocks
)
_rulesOinhmap =
(
_lhsIinhmap
)
_rulesOlazyIntras =
(
_lazyIntras
)
_rulesOlocalAttrTypes =
(
_localAttrTypes
)
_rulesOmainFile =
(
_lhsImainFile
)
_rulesOmainName =
(
_lhsImainName
)
_rulesOmoduleHeader =
(
_lhsImoduleHeader
)
_rulesOnt =
(
_lhsInt
)
_rulesOoptions =
(
_lhsIoptions
)
_rulesOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_rulesOsynmap =
(
_lhsIsynmap
)
_rulesOtextBlocks =
(
_lhsItextBlocks
)
_childrenOallInitStates =
(
_lhsIallInitStates
)
_childrenOimportBlocks =
(
_lhsIimportBlocks
)
_childrenOmainFile =
(
_lhsImainFile
)
_childrenOmainName =
(
_lhsImainName
)
_childrenOmoduleHeader =
(
_lhsImoduleHeader
)
_childrenOnt =
(
_lhsInt
)
_childrenOoptions =
(
_lhsIoptions
)
_childrenOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_childrenOtextBlocks =
(
_lhsItextBlocks
)
_visitsOallFromToStates =
(
_lhsIallFromToStates
)
_visitsOallInhmap =
(
_lhsIallInhmap
)
_visitsOallInitStates =
(
_lhsIallInitStates
)
_visitsOallSynmap =
(
_lhsIallSynmap
)
_visitsOallVisitKinds =
(
_lhsIallVisitKinds
)
_visitsOallchildvisit =
(
_lhsIallchildvisit
)
_visitsOavisitdefs =
(
_lhsIavisitdefs
)
_visitsOavisituses =
(
_lhsIavisituses
)
_visitsOchildTypes =
(
_childTypes
)
_visitsOinhmap =
(
_lhsIinhmap
)
_visitsOnextVisits =
(
_lhsInextVisits
)
_visitsOnt =
(
_lhsInt
)
_visitsOoptions =
(
_lhsIoptions
)
_visitsOparams =
(
_lhsIparams
)
_visitsOprevVisits =
(
_lhsIprevVisits
)
_visitsOsynmap =
(
_lhsIsynmap
)
( _rulesIerrors,_rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) =
rules_ _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOimportBlocks _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOmoduleHeader _rulesOnt _rulesOoptions _rulesOpragmaBlocks _rulesOruleKinds _rulesOsynmap _rulesOtextBlocks _rulesOusageInfo
( _childrenIargnamesw,_childrenIargpats,_childrenIargtps,_childrenIchildTypes,_childrenIchildintros,_childrenIdatatype,_childrenIterminaldefs) =
children_ _childrenOallInitStates _childrenOcon _childrenOimportBlocks _childrenOmainFile _childrenOmainName _childrenOmoduleHeader _childrenOnt _childrenOoptions _childrenOpragmaBlocks _childrenOtextBlocks
( _visitsIallvisits,_visitsIchildvisit,_visitsIerrors,_visitsIfromToStates,_visitsIintramap,_visitsIlazyIntras,_visitsIruleKinds,_visitsIruleUsage,_visitsIsem_visit,_visitsIt_visits,_visitsIvisitKinds,_visitsIvisitdefs,_visitsIvisituses) =
visits_ _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_EProductions :: EProductions ->
T_EProductions
sem_EProductions list =
(Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list))
newtype T_EProductions = T_EProductions ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Attributes) ->
(Map NontermIdent Int) ->
(Map NontermIdent Attributes) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Set StateIdentifier) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
ClassContext ->
PP_Doc ->
Attributes ->
StateIdentifier ->
(Map ConstructorIdent (Map Identifier Type)) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
(Map StateIdentifier StateCtx) ->
NontermIdent ->
Type ->
Options ->
([Identifier]) ->
String ->
(Map StateIdentifier StateCtx) ->
Bool ->
Attributes ->
PP_Doc ->
( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),Int,([PP_Doc]),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_EProductions = Inh_EProductions {allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProductions :: (Map NontermIdent Attributes),allInitStates_Inh_EProductions :: (Map NontermIdent Int),allSynmap_Inh_EProductions :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allstates_Inh_EProductions :: (Set StateIdentifier),avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),classCtxs_Inh_EProductions :: ClassContext,importBlocks_Inh_EProductions :: PP_Doc,inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProductions :: String,mainName_Inh_EProductions :: String,moduleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String),nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),nt_Inh_EProductions :: NontermIdent,ntType_Inh_EProductions :: Type,options_Inh_EProductions :: Options,params_Inh_EProductions :: ([Identifier]),pragmaBlocks_Inh_EProductions :: String,prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),rename_Inh_EProductions :: Bool,synmap_Inh_EProductions :: Attributes,textBlocks_Inh_EProductions :: PP_Doc}
data Syn_EProductions = Syn_EProductions {allvisits_Syn_EProductions :: ([VisitStateState]),childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),count_Syn_EProductions :: Int,datatype_Syn_EProductions :: ([PP_Doc]),errors_Syn_EProductions :: (Seq Error),fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_EProductions :: (IO ()),imports_Syn_EProductions :: ([PP_Doc]),semFunBndDefs_Syn_EProductions :: (Seq PP_Doc),semFunBndTps_Syn_EProductions :: (Seq PP_Doc),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier))}
wrap_EProductions :: T_EProductions ->
Inh_EProductions ->
Syn_EProductions
wrap_EProductions (T_EProductions sem) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) =
(let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks
in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_EProductions_Cons :: T_EProduction ->
T_EProductions ->
T_EProductions
sem_EProductions_Cons (T_EProduction hd_) (T_EProductions tl_) =
(T_EProductions (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallstates
_lhsIavisitdefs
_lhsIavisituses
_lhsIclassCtxs
_lhsIimportBlocks
_lhsIinhmap
_lhsIinitial
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInextVisits
_lhsInt
_lhsIntType
_lhsIoptions
_lhsIparams
_lhsIpragmaBlocks
_lhsIprevVisits
_lhsIrename
_lhsIsynmap
_lhsItextBlocks ->
(let _lhsOallvisits :: ([VisitStateState])
_lhsOt_visits :: PP_Doc
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOcount :: Int
_lhsOdatatype :: ([PP_Doc])
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOgenProdIO :: (IO ())
_lhsOimports :: ([PP_Doc])
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_lhsOsem_nt :: PP_Doc
_lhsOsem_prod :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_hdOallFromToStates :: (Map VisitIdentifier (Int,Int))
_hdOallInhmap :: (Map NontermIdent Attributes)
_hdOallInitStates :: (Map NontermIdent Int)
_hdOallSynmap :: (Map NontermIdent Attributes)
_hdOallVisitKinds :: (Map VisitIdentifier VisitKind)
_hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdOallstates :: (Set StateIdentifier)
_hdOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdOavisituses :: (Map VisitIdentifier (Set Identifier))
_hdOclassCtxs :: ClassContext
_hdOimportBlocks :: PP_Doc
_hdOinhmap :: Attributes
_hdOinitial :: StateIdentifier
_hdOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type))
_hdOmainFile :: String
_hdOmainName :: String
_hdOmoduleHeader :: (String -> String -> String -> Bool -> String)
_hdOnextVisits :: (Map StateIdentifier StateCtx)
_hdOnt :: NontermIdent
_hdOntType :: Type
_hdOoptions :: Options
_hdOparams :: ([Identifier])
_hdOpragmaBlocks :: String
_hdOprevVisits :: (Map StateIdentifier StateCtx)
_hdOrename :: Bool
_hdOsynmap :: Attributes
_hdOtextBlocks :: PP_Doc
_tlOallFromToStates :: (Map VisitIdentifier (Int,Int))
_tlOallInhmap :: (Map NontermIdent Attributes)
_tlOallInitStates :: (Map NontermIdent Int)
_tlOallSynmap :: (Map NontermIdent Attributes)
_tlOallVisitKinds :: (Map VisitIdentifier VisitKind)
_tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlOallstates :: (Set StateIdentifier)
_tlOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlOavisituses :: (Map VisitIdentifier (Set Identifier))
_tlOclassCtxs :: ClassContext
_tlOimportBlocks :: PP_Doc
_tlOinhmap :: Attributes
_tlOinitial :: StateIdentifier
_tlOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type))
_tlOmainFile :: String
_tlOmainName :: String
_tlOmoduleHeader :: (String -> String -> String -> Bool -> String)
_tlOnextVisits :: (Map StateIdentifier StateCtx)
_tlOnt :: NontermIdent
_tlOntType :: Type
_tlOoptions :: Options
_tlOparams :: ([Identifier])
_tlOpragmaBlocks :: String
_tlOprevVisits :: (Map StateIdentifier StateCtx)
_tlOrename :: Bool
_tlOsynmap :: Attributes
_tlOtextBlocks :: PP_Doc
_hdIallvisits :: ([VisitStateState])
_hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdIcount :: Int
_hdIdatatype :: PP_Doc
_hdIerrors :: (Seq Error)
_hdIfromToStates :: (Map VisitIdentifier (Int,Int))
_hdIgenProdIO :: (IO ())
_hdIimports :: ([PP_Doc])
_hdIsemFunBndDefs :: (Seq PP_Doc)
_hdIsemFunBndTps :: (Seq PP_Doc)
_hdIsem_nt :: PP_Doc
_hdIsem_prod :: PP_Doc
_hdIt_visits :: PP_Doc
_hdIvisitKinds :: (Map VisitIdentifier VisitKind)
_hdIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdIvisituses :: (Map VisitIdentifier (Set Identifier))
_tlIallvisits :: ([VisitStateState])
_tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlIcount :: Int
_tlIdatatype :: ([PP_Doc])
_tlIerrors :: (Seq Error)
_tlIfromToStates :: (Map VisitIdentifier (Int,Int))
_tlIgenProdIO :: (IO ())
_tlIimports :: ([PP_Doc])
_tlIsemFunBndDefs :: (Seq PP_Doc)
_tlIsemFunBndTps :: (Seq PP_Doc)
_tlIsem_nt :: PP_Doc
_tlIsem_prod :: PP_Doc
_tlIt_visits :: PP_Doc
_tlIvisitKinds :: (Map VisitIdentifier VisitKind)
_tlIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlIvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOallvisits =
(
_hdIallvisits
)
_lhsOt_visits =
(
_hdIt_visits
)
_lhsOchildvisit =
(
_hdIchildvisit `Map.union` _tlIchildvisit
)
_lhsOcount =
(
_hdIcount + _tlIcount
)
_lhsOdatatype =
(
_hdIdatatype : _tlIdatatype
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOfromToStates =
(
_hdIfromToStates `mappend` _tlIfromToStates
)
_lhsOgenProdIO =
(
_hdIgenProdIO >> _tlIgenProdIO
)
_lhsOimports =
(
_hdIimports ++ _tlIimports
)
_lhsOsemFunBndDefs =
(
_hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs
)
_lhsOsemFunBndTps =
(
_hdIsemFunBndTps Seq.>< _tlIsemFunBndTps
)
_lhsOsem_nt =
(
_hdIsem_nt >-< _tlIsem_nt
)
_lhsOsem_prod =
(
_hdIsem_prod >-< _tlIsem_prod
)
_lhsOvisitKinds =
(
_hdIvisitKinds `mappend` _tlIvisitKinds
)
_lhsOvisitdefs =
(
_hdIvisitdefs `uwSetUnion` _tlIvisitdefs
)
_lhsOvisituses =
(
_hdIvisituses `uwSetUnion` _tlIvisituses
)
_hdOallFromToStates =
(
_lhsIallFromToStates
)
_hdOallInhmap =
(
_lhsIallInhmap
)
_hdOallInitStates =
(
_lhsIallInitStates
)
_hdOallSynmap =
(
_lhsIallSynmap
)
_hdOallVisitKinds =
(
_lhsIallVisitKinds
)
_hdOallchildvisit =
(
_lhsIallchildvisit
)
_hdOallstates =
(
_lhsIallstates
)
_hdOavisitdefs =
(
_lhsIavisitdefs
)
_hdOavisituses =
(
_lhsIavisituses
)
_hdOclassCtxs =
(
_lhsIclassCtxs
)
_hdOimportBlocks =
(
_lhsIimportBlocks
)
_hdOinhmap =
(
_lhsIinhmap
)
_hdOinitial =
(
_lhsIinitial
)
_hdOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_hdOmainFile =
(
_lhsImainFile
)
_hdOmainName =
(
_lhsImainName
)
_hdOmoduleHeader =
(
_lhsImoduleHeader
)
_hdOnextVisits =
(
_lhsInextVisits
)
_hdOnt =
(
_lhsInt
)
_hdOntType =
(
_lhsIntType
)
_hdOoptions =
(
_lhsIoptions
)
_hdOparams =
(
_lhsIparams
)
_hdOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_hdOprevVisits =
(
_lhsIprevVisits
)
_hdOrename =
(
_lhsIrename
)
_hdOsynmap =
(
_lhsIsynmap
)
_hdOtextBlocks =
(
_lhsItextBlocks
)
_tlOallFromToStates =
(
_lhsIallFromToStates
)
_tlOallInhmap =
(
_lhsIallInhmap
)
_tlOallInitStates =
(
_lhsIallInitStates
)
_tlOallSynmap =
(
_lhsIallSynmap
)
_tlOallVisitKinds =
(
_lhsIallVisitKinds
)
_tlOallchildvisit =
(
_lhsIallchildvisit
)
_tlOallstates =
(
_lhsIallstates
)
_tlOavisitdefs =
(
_lhsIavisitdefs
)
_tlOavisituses =
(
_lhsIavisituses
)
_tlOclassCtxs =
(
_lhsIclassCtxs
)
_tlOimportBlocks =
(
_lhsIimportBlocks
)
_tlOinhmap =
(
_lhsIinhmap
)
_tlOinitial =
(
_lhsIinitial
)
_tlOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_tlOmainFile =
(
_lhsImainFile
)
_tlOmainName =
(
_lhsImainName
)
_tlOmoduleHeader =
(
_lhsImoduleHeader
)
_tlOnextVisits =
(
_lhsInextVisits
)
_tlOnt =
(
_lhsInt
)
_tlOntType =
(
_lhsIntType
)
_tlOoptions =
(
_lhsIoptions
)
_tlOparams =
(
_lhsIparams
)
_tlOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_tlOprevVisits =
(
_lhsIprevVisits
)
_tlOrename =
(
_lhsIrename
)
_tlOsynmap =
(
_lhsIsynmap
)
_tlOtextBlocks =
(
_lhsItextBlocks
)
( _hdIallvisits,_hdIchildvisit,_hdIcount,_hdIdatatype,_hdIerrors,_hdIfromToStates,_hdIgenProdIO,_hdIimports,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) =
hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOclassCtxs _hdOimportBlocks _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOpragmaBlocks _hdOprevVisits _hdOrename _hdOsynmap _hdOtextBlocks
( _tlIallvisits,_tlIchildvisit,_tlIcount,_tlIdatatype,_tlIerrors,_tlIfromToStates,_tlIgenProdIO,_tlIimports,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) =
tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOclassCtxs _tlOimportBlocks _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOpragmaBlocks _tlOprevVisits _tlOrename _tlOsynmap _tlOtextBlocks
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_EProductions_Nil :: T_EProductions
sem_EProductions_Nil =
(T_EProductions (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallstates
_lhsIavisitdefs
_lhsIavisituses
_lhsIclassCtxs
_lhsIimportBlocks
_lhsIinhmap
_lhsIinitial
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInextVisits
_lhsInt
_lhsIntType
_lhsIoptions
_lhsIparams
_lhsIpragmaBlocks
_lhsIprevVisits
_lhsIrename
_lhsIsynmap
_lhsItextBlocks ->
(let _lhsOallvisits :: ([VisitStateState])
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOcount :: Int
_lhsOdatatype :: ([PP_Doc])
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOgenProdIO :: (IO ())
_lhsOimports :: ([PP_Doc])
_lhsOsemFunBndDefs :: (Seq PP_Doc)
_lhsOsemFunBndTps :: (Seq PP_Doc)
_lhsOsem_nt :: PP_Doc
_lhsOsem_prod :: PP_Doc
_lhsOt_visits :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOallvisits =
(
error "Every nonterminal should have at least 1 production"
)
_lhsOchildvisit =
(
Map.empty
)
_lhsOcount =
(
0
)
_lhsOdatatype =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOfromToStates =
(
mempty
)
_lhsOgenProdIO =
(
return ()
)
_lhsOimports =
(
[]
)
_lhsOsemFunBndDefs =
(
Seq.empty
)
_lhsOsemFunBndTps =
(
Seq.empty
)
_lhsOsem_nt =
(
empty
)
_lhsOsem_prod =
(
empty
)
_lhsOt_visits =
(
empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOvisitdefs =
(
Map.empty
)
_lhsOvisituses =
(
Map.empty
)
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_ERule :: ERule ->
T_ERule
sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit _pure _mbError) =
(sem_ERule_ERule _name (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _mbError)
newtype T_ERule = T_ERule ((Map NontermIdent Attributes) ->
(Map NontermIdent Attributes) ->
(Map Identifier Type) ->
ConstructorIdent ->
PP_Doc ->
Attributes ->
(Set String) ->
(Map Identifier Type) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
NontermIdent ->
Options ->
String ->
(Map Identifier (Set VisitKind)) ->
Attributes ->
PP_Doc ->
(Map Identifier Int) ->
( (Seq Error),(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc))
data Inh_ERule = Inh_ERule {allInhmap_Inh_ERule :: (Map NontermIdent Attributes),allSynmap_Inh_ERule :: (Map NontermIdent Attributes),childTypes_Inh_ERule :: (Map Identifier Type),con_Inh_ERule :: ConstructorIdent,importBlocks_Inh_ERule :: PP_Doc,inhmap_Inh_ERule :: Attributes,lazyIntras_Inh_ERule :: (Set String),localAttrTypes_Inh_ERule :: (Map Identifier Type),mainFile_Inh_ERule :: String,mainName_Inh_ERule :: String,moduleHeader_Inh_ERule :: (String -> String -> String -> Bool -> String),nt_Inh_ERule :: NontermIdent,options_Inh_ERule :: Options,pragmaBlocks_Inh_ERule :: String,ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)),synmap_Inh_ERule :: Attributes,textBlocks_Inh_ERule :: PP_Doc,usageInfo_Inh_ERule :: (Map Identifier Int)}
data Syn_ERule = Syn_ERule {errors_Syn_ERule :: (Seq Error),mrules_Syn_ERule :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),ruledefs_Syn_ERule :: (Map Identifier (Set String)),ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERule :: PP_Doc}
wrap_ERule :: T_ERule ->
Inh_ERule ->
Syn_ERule
wrap_ERule (T_ERule sem) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) =
(let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo
in (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules))
sem_ERule_ERule :: Identifier ->
T_Pattern ->
T_Expression ->
Bool ->
String ->
Bool ->
Bool ->
(Maybe Error) ->
T_ERule
sem_ERule_ERule name_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ mbError_ =
(T_ERule (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIchildTypes
_lhsIcon
_lhsIimportBlocks
_lhsIinhmap
_lhsIlazyIntras
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsIruleKinds
_lhsIsynmap
_lhsItextBlocks
_lhsIusageInfo ->
(let _lhsOsem_rules :: PP_Doc
_lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_lhsOruledefs :: (Map Identifier (Set String))
_lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_lhsOerrors :: (Seq Error)
_patternOallInhmap :: (Map NontermIdent Attributes)
_patternOallSynmap :: (Map NontermIdent Attributes)
_patternOanyLazyKind :: Bool
_patternOinhmap :: Attributes
_patternOlocalAttrTypes :: (Map Identifier Type)
_patternOoptions :: Options
_patternOsynmap :: Attributes
_patternIattrTypes :: PP_Doc
_patternIattrs :: (Set String)
_patternIcopy :: Pattern
_patternIisUnderscore :: Bool
_patternIsem_lhs :: ( PP_Doc )
_rhsIattrs :: (Map String (Maybe NonLocalAttr))
_rhsIpos :: Pos
_rhsIsemfunc :: PP_Doc
_rhsItks :: ([HsToken])
_lhsOsem_rules =
(
if _used == 0
then empty
else _rulePragma >-< _rulecode
)
_rulecode =
(
( if _genpragma
then _pragma
else empty
)
>-< _lambda >#< _scc
>-< indent ((column _rhsIpos 2) `max` 2)
( if _genpragma
then _pragma >-< _rhsIsemfunc >-< _endpragma
else _rhsIsemfunc
)
)
_rulePragma =
(
( let reallyInlineStr = "INLINE"
reallyNoInlineStr = "NOINLINE"
in if noInlinePragmas _lhsIoptions
then empty
else if _used == 1
then ppPragmaBinding reallyInlineStr name_
else if helpInlining _lhsIoptions
then if not explicit_ && _used <= reallyOftenUsedThreshold
then ppPragmaBinding "INLINE[1]" name_
else if _used > ruleInlineThresholdSoft && explicit_
then if _used > ruleInlineThresholdHard
then ppPragmaBinding reallyNoInlineStr name_
else if aggressiveInlinePragmas _lhsIoptions
then ppPragmaBinding "NOINLINE[2]" name_
else ppNoInline name_
else if aggressiveInlinePragmas _lhsIoptions
then ppPragmaBinding "NOINLINE[1]" name_
else ppNoInline name_
else if not explicit_ || _used <= ruleInlineThresholdSoft
then ppPragmaBinding "NOINLINE[1]" name_
else ppNoInline name_
)
)
_scc =
(
if genCostCentres _lhsIoptions && explicit_ && pure_ && not (noPerRuleCostCentres _lhsIoptions)
then ppCostCentre (name_ >|< "_" >|< line _rhsIpos >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon)
else empty
)
_pragma =
(
"{-# LINE" >#< show (line _rhsIpos) >#< show (file _rhsIpos) >#< "#-}"
)
_endpragma =
(
ppWithLineNr (\ln -> "{-# LINE " ++ show (ln+1) ++ " " ++ show _lhsImainFile ++ "#-}")
)
_genpragma =
(
genLinePragmas _lhsIoptions && explicit_ && _haspos
)
_haspos =
(
line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos))
)
_lambda =
(
name_ >#< "=" >#< "\\" >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "->"
)
_argPats =
(
ppSpaced [ let match | str `Set.member` _lhsIlazyIntras = pp str
| otherwise = _addbang1 (pp str)
in case mbAttr of
Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) ->
case Map.lookup nm _lhsIlocalAttrTypes of
Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp)
Nothing -> match
Just attr | not (noPerRuleTypeSigs _lhsIoptions) ->
case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of
Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc)
Nothing -> match
_ -> match
| (str,mbAttr) <- Map.assocs _rhsIattrs
]
)
_argExprs =
(
ppSpaced $ Map.keys _rhsIattrs
)
_stepcode =
(
\kind fmtMode -> if kind `compatibleRule` pure_
then Right $ let oper | pure_ = "="
| otherwise = "<-"
decl = _patternIsem_lhs >#< oper >#< name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs)
tp = if pure_ && not (noPerRuleTypeSigs _lhsIoptions)
then _patternIattrTypes
else empty
in fmtDecl pure_ fmtMode (tp >-< decl)
else Left $ IncompatibleRuleKind name_ kind
)
_lhsOmrules =
(
Map.singleton name_ _stepcode
)
_used =
(
Map.findWithDefault 0 name_ _lhsIusageInfo
)
_kinds =
(
Map.findWithDefault Set.empty name_ _lhsIruleKinds
)
_anyLazyKind =
(
Set.fold (\k r -> isLazyKind k || r) False _kinds
)
_lhsOruledefs =
(
Map.singleton name_ _patternIattrs
)
_lhsOruleuses =
(
Map.singleton name_ _rhsIattrs
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbang1 =
(
if _anyLazyKind then id else _addbang
)
_lhsOerrors =
(
case mbError_ of
Just e | _used > 0 -> Seq.singleton e
_ -> Seq.empty
)
_patternOallInhmap =
(
_lhsIallInhmap
)
_patternOallSynmap =
(
_lhsIallSynmap
)
_patternOanyLazyKind =
(
_anyLazyKind
)
_patternOinhmap =
(
_lhsIinhmap
)
_patternOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_patternOoptions =
(
_lhsIoptions
)
_patternOsynmap =
(
_lhsIsynmap
)
( _patternIattrTypes,_patternIattrs,_patternIcopy,_patternIisUnderscore,_patternIsem_lhs) =
pattern_ _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap
( _rhsIattrs,_rhsIpos,_rhsIsemfunc,_rhsItks) =
rhs_
in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))))
sem_ERules :: ERules ->
T_ERules
sem_ERules list =
(Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list))
newtype T_ERules = T_ERules ((Map NontermIdent Attributes) ->
(Map NontermIdent Attributes) ->
(Map Identifier Type) ->
ConstructorIdent ->
PP_Doc ->
Attributes ->
(Set String) ->
(Map Identifier Type) ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
NontermIdent ->
Options ->
String ->
(Map Identifier (Set VisitKind)) ->
Attributes ->
PP_Doc ->
(Map Identifier Int) ->
( (Seq Error),(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc))
data Inh_ERules = Inh_ERules {allInhmap_Inh_ERules :: (Map NontermIdent Attributes),allSynmap_Inh_ERules :: (Map NontermIdent Attributes),childTypes_Inh_ERules :: (Map Identifier Type),con_Inh_ERules :: ConstructorIdent,importBlocks_Inh_ERules :: PP_Doc,inhmap_Inh_ERules :: Attributes,lazyIntras_Inh_ERules :: (Set String),localAttrTypes_Inh_ERules :: (Map Identifier Type),mainFile_Inh_ERules :: String,mainName_Inh_ERules :: String,moduleHeader_Inh_ERules :: (String -> String -> String -> Bool -> String),nt_Inh_ERules :: NontermIdent,options_Inh_ERules :: Options,pragmaBlocks_Inh_ERules :: String,ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)),synmap_Inh_ERules :: Attributes,textBlocks_Inh_ERules :: PP_Doc,usageInfo_Inh_ERules :: (Map Identifier Int)}
data Syn_ERules = Syn_ERules {errors_Syn_ERules :: (Seq Error),mrules_Syn_ERules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),ruledefs_Syn_ERules :: (Map Identifier (Set String)),ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERules :: PP_Doc}
wrap_ERules :: T_ERules ->
Inh_ERules ->
Syn_ERules
wrap_ERules (T_ERules sem) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) =
(let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo
in (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules))
sem_ERules_Cons :: T_ERule ->
T_ERules ->
T_ERules
sem_ERules_Cons (T_ERule hd_) (T_ERules tl_) =
(T_ERules (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIchildTypes
_lhsIcon
_lhsIimportBlocks
_lhsIinhmap
_lhsIlazyIntras
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsIruleKinds
_lhsIsynmap
_lhsItextBlocks
_lhsIusageInfo ->
(let _lhsOerrors :: (Seq Error)
_lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_lhsOruledefs :: (Map Identifier (Set String))
_lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_lhsOsem_rules :: PP_Doc
_hdOallInhmap :: (Map NontermIdent Attributes)
_hdOallSynmap :: (Map NontermIdent Attributes)
_hdOchildTypes :: (Map Identifier Type)
_hdOcon :: ConstructorIdent
_hdOimportBlocks :: PP_Doc
_hdOinhmap :: Attributes
_hdOlazyIntras :: (Set String)
_hdOlocalAttrTypes :: (Map Identifier Type)
_hdOmainFile :: String
_hdOmainName :: String
_hdOmoduleHeader :: (String -> String -> String -> Bool -> String)
_hdOnt :: NontermIdent
_hdOoptions :: Options
_hdOpragmaBlocks :: String
_hdOruleKinds :: (Map Identifier (Set VisitKind))
_hdOsynmap :: Attributes
_hdOtextBlocks :: PP_Doc
_hdOusageInfo :: (Map Identifier Int)
_tlOallInhmap :: (Map NontermIdent Attributes)
_tlOallSynmap :: (Map NontermIdent Attributes)
_tlOchildTypes :: (Map Identifier Type)
_tlOcon :: ConstructorIdent
_tlOimportBlocks :: PP_Doc
_tlOinhmap :: Attributes
_tlOlazyIntras :: (Set String)
_tlOlocalAttrTypes :: (Map Identifier Type)
_tlOmainFile :: String
_tlOmainName :: String
_tlOmoduleHeader :: (String -> String -> String -> Bool -> String)
_tlOnt :: NontermIdent
_tlOoptions :: Options
_tlOpragmaBlocks :: String
_tlOruleKinds :: (Map Identifier (Set VisitKind))
_tlOsynmap :: Attributes
_tlOtextBlocks :: PP_Doc
_tlOusageInfo :: (Map Identifier Int)
_hdIerrors :: (Seq Error)
_hdImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_hdIruledefs :: (Map Identifier (Set String))
_hdIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_hdIsem_rules :: PP_Doc
_tlIerrors :: (Seq Error)
_tlImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_tlIruledefs :: (Map Identifier (Set String))
_tlIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_tlIsem_rules :: PP_Doc
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOmrules =
(
_hdImrules `Map.union` _tlImrules
)
_lhsOruledefs =
(
_hdIruledefs `uwSetUnion` _tlIruledefs
)
_lhsOruleuses =
(
_hdIruleuses `uwMapUnion` _tlIruleuses
)
_lhsOsem_rules =
(
_hdIsem_rules >-< _tlIsem_rules
)
_hdOallInhmap =
(
_lhsIallInhmap
)
_hdOallSynmap =
(
_lhsIallSynmap
)
_hdOchildTypes =
(
_lhsIchildTypes
)
_hdOcon =
(
_lhsIcon
)
_hdOimportBlocks =
(
_lhsIimportBlocks
)
_hdOinhmap =
(
_lhsIinhmap
)
_hdOlazyIntras =
(
_lhsIlazyIntras
)
_hdOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_hdOmainFile =
(
_lhsImainFile
)
_hdOmainName =
(
_lhsImainName
)
_hdOmoduleHeader =
(
_lhsImoduleHeader
)
_hdOnt =
(
_lhsInt
)
_hdOoptions =
(
_lhsIoptions
)
_hdOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_hdOruleKinds =
(
_lhsIruleKinds
)
_hdOsynmap =
(
_lhsIsynmap
)
_hdOtextBlocks =
(
_lhsItextBlocks
)
_hdOusageInfo =
(
_lhsIusageInfo
)
_tlOallInhmap =
(
_lhsIallInhmap
)
_tlOallSynmap =
(
_lhsIallSynmap
)
_tlOchildTypes =
(
_lhsIchildTypes
)
_tlOcon =
(
_lhsIcon
)
_tlOimportBlocks =
(
_lhsIimportBlocks
)
_tlOinhmap =
(
_lhsIinhmap
)
_tlOlazyIntras =
(
_lhsIlazyIntras
)
_tlOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_tlOmainFile =
(
_lhsImainFile
)
_tlOmainName =
(
_lhsImainName
)
_tlOmoduleHeader =
(
_lhsImoduleHeader
)
_tlOnt =
(
_lhsInt
)
_tlOoptions =
(
_lhsIoptions
)
_tlOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_tlOruleKinds =
(
_lhsIruleKinds
)
_tlOsynmap =
(
_lhsIsynmap
)
_tlOtextBlocks =
(
_lhsItextBlocks
)
_tlOusageInfo =
(
_lhsIusageInfo
)
( _hdIerrors,_hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) =
hd_ _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOimportBlocks _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOruleKinds _hdOsynmap _hdOtextBlocks _hdOusageInfo
( _tlIerrors,_tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) =
tl_ _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOimportBlocks _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOruleKinds _tlOsynmap _tlOtextBlocks _tlOusageInfo
in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))))
sem_ERules_Nil :: T_ERules
sem_ERules_Nil =
(T_ERules (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIchildTypes
_lhsIcon
_lhsIimportBlocks
_lhsIinhmap
_lhsIlazyIntras
_lhsIlocalAttrTypes
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsInt
_lhsIoptions
_lhsIpragmaBlocks
_lhsIruleKinds
_lhsIsynmap
_lhsItextBlocks
_lhsIusageInfo ->
(let _lhsOerrors :: (Seq Error)
_lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_lhsOruledefs :: (Map Identifier (Set String))
_lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_lhsOsem_rules :: PP_Doc
_lhsOerrors =
(
Seq.empty
)
_lhsOmrules =
(
Map.empty
)
_lhsOruledefs =
(
Map.empty
)
_lhsOruleuses =
(
Map.empty
)
_lhsOsem_rules =
(
empty
)
in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))))
sem_ExecutionPlan :: ExecutionPlan ->
T_ExecutionPlan
sem_ExecutionPlan (ExecutionPlan _nonts _typeSyns _wrappers _derivings) =
(sem_ExecutionPlan_ExecutionPlan (sem_ENonterminals _nonts) _typeSyns _wrappers _derivings)
newtype T_ExecutionPlan = T_ExecutionPlan (PP_Doc ->
(Map NontermIdent Attributes) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) ->
PP_Doc ->
String ->
String ->
(String -> String -> String -> Bool -> String) ->
Options ->
String ->
(Map NontermIdent Attributes) ->
(Map BlockInfo PP_Doc) ->
PP_Doc ->
( (Seq Error),(IO ()),PP_Doc))
data Inh_ExecutionPlan = Inh_ExecutionPlan {importBlocks_Inh_ExecutionPlan :: PP_Doc,inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes),localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainBlocksDoc_Inh_ExecutionPlan :: PP_Doc,mainFile_Inh_ExecutionPlan :: String,mainName_Inh_ExecutionPlan :: String,moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String),options_Inh_ExecutionPlan :: Options,pragmaBlocks_Inh_ExecutionPlan :: String,synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes),textBlockMap_Inh_ExecutionPlan :: (Map BlockInfo PP_Doc),textBlocks_Inh_ExecutionPlan :: PP_Doc}
data Syn_ExecutionPlan = Syn_ExecutionPlan {errors_Syn_ExecutionPlan :: (Seq Error),genIO_Syn_ExecutionPlan :: (IO ()),output_Syn_ExecutionPlan :: PP_Doc}
wrap_ExecutionPlan :: T_ExecutionPlan ->
Inh_ExecutionPlan ->
Syn_ExecutionPlan
wrap_ExecutionPlan (T_ExecutionPlan sem) (Inh_ExecutionPlan _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) =
(let ( _lhsOerrors,_lhsOgenIO,_lhsOoutput) = sem _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks
in (Syn_ExecutionPlan _lhsOerrors _lhsOgenIO _lhsOoutput))
sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals ->
TypeSyns ->
(Set NontermIdent) ->
Derivings ->
T_ExecutionPlan
sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_) typeSyns_ wrappers_ derivings_ =
(T_ExecutionPlan (\ _lhsIimportBlocks
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsImainBlocksDoc
_lhsImainFile
_lhsImainName
_lhsImoduleHeader
_lhsIoptions
_lhsIpragmaBlocks
_lhsIsynmap
_lhsItextBlockMap
_lhsItextBlocks ->
(let _lhsOoutput :: PP_Doc
_nontsOwrappers :: (Set NontermIdent)
_nontsOtypeSyns :: TypeSyns
_nontsOderivings :: Derivings
_nontsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_nontsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_nontsOavisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOgenIO :: (IO ())
_nontsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_nontsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_nontsOallInitStates :: (Map NontermIdent Int)
_lhsOerrors :: (Seq Error)
_nontsOimportBlocks :: PP_Doc
_nontsOinhmap :: (Map NontermIdent Attributes)
_nontsOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type)))
_nontsOmainFile :: String
_nontsOmainName :: String
_nontsOmoduleHeader :: (String -> String -> String -> Bool -> String)
_nontsOoptions :: Options
_nontsOpragmaBlocks :: String
_nontsOsynmap :: (Map NontermIdent Attributes)
_nontsOtextBlocks :: PP_Doc
_nontsIappendCommon :: ([PP_Doc])
_nontsIappendMain :: ([PP_Doc])
_nontsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_nontsIerrors :: (Seq Error)
_nontsIfromToStates :: (Map VisitIdentifier (Int,Int))
_nontsIgenProdIO :: (IO ())
_nontsIimports :: ([PP_Doc])
_nontsIinitStates :: (Map NontermIdent Int)
_nontsIoutput :: PP_Doc
_nontsIsemFunBndDefs :: (Seq PP_Doc)
_nontsIsemFunBndTps :: (Seq PP_Doc)
_nontsIvisitKinds :: (Map VisitIdentifier VisitKind)
_nontsIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_nontsIvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOoutput =
(
_nontsIoutput >-< _commonExtra >-< _wrappersExtra
)
_nontsOwrappers =
(
wrappers_
)
_nontsOtypeSyns =
(
typeSyns_
)
_nontsOderivings =
(
derivings_
)
_wrappersExtra =
(
if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions
then _lateSemBndDef
else empty
)
_commonExtra =
(
if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions
then _lateSemBndTp
else empty
)
_lateSemBndTp =
(
"data" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName
>-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndTps)
)
_lateSemBndDef =
(
( if noInlinePragmas _lhsIoptions
then empty
else if helpInlining _lhsIoptions && Set.size wrappers_ == 1
then ppInline $ lateBindingFieldNm _lhsImainName
else ppNoInline $ lateBindingFieldNm _lhsImainName
)
>-< lateBindingFieldNm _lhsImainName >#< "::" >#< lateBindingTypeNm _lhsImainName
>-< lateBindingFieldNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName
>-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndDefs )
)
_nontsOallchildvisit =
(
_nontsIchildvisit
)
_nontsOavisitdefs =
(
_nontsIvisitdefs
)
_nontsOavisituses =
(
_nontsIvisituses
)
_lhsOgenIO =
(
do _genMainModule
_genCommonModule
_nontsIgenProdIO
)
_mainModuleFile =
(
_lhsImainFile
)
_ppMonadImports =
(
( if tupleAsDummyToken _lhsIoptions
then empty
else pp "import GHC.Prim"
)
>-< if parallelInvoke _lhsIoptions
then pp "import qualified System.IO.Unsafe(unsafePerformIO)"
>-< pp "import System.IO(IO)"
>-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"
else pp "import Control.Monad.Identity"
)
_genMainModule =
(
writeModule _mainModuleFile
( [ warrenFlagsPP _lhsIoptions
, pp $ _lhsIpragmaBlocks
, pp $ _lhsImoduleHeader _lhsImainName "" "" False
, _ppMonadImports
, pp $ "import " ++ _lhsImainName ++ "_common"
]
++ _nontsIimports
++ [_lhsImainBlocksDoc]
++ [_wrappersExtra ]
++ _nontsIappendMain
)
)
_commonFile =
(
replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common")
)
_genCommonModule =
(
writeModule _commonFile
( [ pp $ "{-# LANGUAGE Rank2Types, GADTs #-}"
, pp $ _lhsIpragmaBlocks
, pp $ _lhsImoduleHeader _lhsImainName "_common" "" True
, _ppMonadImports
, _lhsIimportBlocks
, _lhsItextBlocks
, _commonExtra
]
++ _nontsIappendCommon
)
)
_nontsOallFromToStates =
(
_nontsIfromToStates
)
_nontsOallVisitKinds =
(
_nontsIvisitKinds
)
_nontsOallInitStates =
(
_nontsIinitStates
)
_lhsOerrors =
(
_nontsIerrors
)
_nontsOimportBlocks =
(
_lhsIimportBlocks
)
_nontsOinhmap =
(
_lhsIinhmap
)
_nontsOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_nontsOmainFile =
(
_lhsImainFile
)
_nontsOmainName =
(
_lhsImainName
)
_nontsOmoduleHeader =
(
_lhsImoduleHeader
)
_nontsOoptions =
(
_lhsIoptions
)
_nontsOpragmaBlocks =
(
_lhsIpragmaBlocks
)
_nontsOsynmap =
(
_lhsIsynmap
)
_nontsOtextBlocks =
(
_lhsItextBlocks
)
( _nontsIappendCommon,_nontsIappendMain,_nontsIchildvisit,_nontsIerrors,_nontsIfromToStates,_nontsIgenProdIO,_nontsIimports,_nontsIinitStates,_nontsIoutput,_nontsIsemFunBndDefs,_nontsIsemFunBndTps,_nontsIvisitKinds,_nontsIvisitdefs,_nontsIvisituses) =
nonts_ _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOderivings _nontsOimportBlocks _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOmoduleHeader _nontsOoptions _nontsOpragmaBlocks _nontsOsynmap _nontsOtextBlocks _nontsOtypeSyns _nontsOwrappers
in ( _lhsOerrors,_lhsOgenIO,_lhsOoutput))))
sem_Expression :: Expression ->
T_Expression
sem_Expression (Expression _pos _tks) =
(sem_Expression_Expression _pos _tks)
newtype T_Expression = T_Expression (( (Map String (Maybe NonLocalAttr)),Pos,PP_Doc,([HsToken])))
data Inh_Expression = Inh_Expression {}
data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)),pos_Syn_Expression :: Pos,semfunc_Syn_Expression :: PP_Doc,tks_Syn_Expression :: ([HsToken])}
wrap_Expression :: T_Expression ->
Inh_Expression ->
Syn_Expression
wrap_Expression (T_Expression sem) (Inh_Expression) =
(let ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks) = sem
in (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks))
sem_Expression_Expression :: Pos ->
([HsToken]) ->
T_Expression
sem_Expression_Expression pos_ tks_ =
(T_Expression (let _lhsOtks :: ([HsToken])
_lhsOpos :: Pos
_lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOsemfunc :: PP_Doc
_lhsOtks =
(
tks_
)
_lhsOpos =
(
pos_
)
_lhsOattrs =
(
Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_
)
_lhsOsemfunc =
(
vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_
)
in ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks)))
sem_HsToken :: HsToken ->
T_HsToken
sem_HsToken (AGField _field _attr _pos _rdesc) =
(sem_HsToken_AGField _field _attr _pos _rdesc)
sem_HsToken (AGLocal _var _pos _rdesc) =
(sem_HsToken_AGLocal _var _pos _rdesc)
sem_HsToken (CharToken _value _pos) =
(sem_HsToken_CharToken _value _pos)
sem_HsToken (Err _mesg _pos) =
(sem_HsToken_Err _mesg _pos)
sem_HsToken (HsToken _value _pos) =
(sem_HsToken_HsToken _value _pos)
sem_HsToken (StrToken _value _pos) =
(sem_HsToken_StrToken _value _pos)
newtype T_HsToken = T_HsToken (( (Map String (Maybe NonLocalAttr)),((Pos,String))))
data Inh_HsToken = Inh_HsToken {}
data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)),tok_Syn_HsToken :: ((Pos,String))}
wrap_HsToken :: T_HsToken ->
Inh_HsToken ->
Syn_HsToken
wrap_HsToken (T_HsToken sem) (Inh_HsToken) =
(let ( _lhsOattrs,_lhsOtok) = sem
in (Syn_HsToken _lhsOattrs _lhsOtok))
sem_HsToken_AGField :: Identifier ->
Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGField field_ attr_ pos_ rdesc_ =
(T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok :: ((Pos,String))
_mbAttr =
(
if field_ == _INST || field_ == _FIELD || field_ == _INST'
then Nothing
else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_
)
_lhsOattrs =
(
Map.singleton (attrname True field_ attr_) _mbAttr
)
_addTrace =
(
case rdesc_ of
Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))"
Nothing -> id
)
_lhsOtok =
(
(pos_, _addTrace $ attrname True field_ attr_)
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsToken_AGLocal :: Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGLocal var_ pos_ rdesc_ =
(T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok :: ((Pos,String))
_lhsOattrs =
(
Map.singleton (fieldname var_) Nothing
)
_tok =
(
(pos_,fieldname var_)
)
_lhsOtok =
(
_tok
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsToken_CharToken :: String ->
Pos ->
T_HsToken
sem_HsToken_CharToken value_ pos_ =
(T_HsToken (let _lhsOtok :: ((Pos,String))
_lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok =
(
(pos_, if null value_
then ""
else showCharShort (head value_)
)
)
_lhsOattrs =
(
Map.empty
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsToken_Err :: String ->
Pos ->
T_HsToken
sem_HsToken_Err mesg_ pos_ =
(T_HsToken (let _lhsOtok :: ((Pos,String))
_lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok =
(
(pos_, "")
)
_lhsOattrs =
(
Map.empty
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsToken_HsToken :: String ->
Pos ->
T_HsToken
sem_HsToken_HsToken value_ pos_ =
(T_HsToken (let _lhsOtok :: ((Pos,String))
_lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok =
(
(pos_, value_)
)
_lhsOattrs =
(
Map.empty
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsToken_StrToken :: String ->
Pos ->
T_HsToken
sem_HsToken_StrToken value_ pos_ =
(T_HsToken (let _lhsOtok :: ((Pos,String))
_lhsOattrs :: (Map String (Maybe NonLocalAttr))
_lhsOtok =
(
(pos_, showStrShort value_)
)
_lhsOattrs =
(
Map.empty
)
in ( _lhsOattrs,_lhsOtok)))
sem_HsTokens :: HsTokens ->
T_HsTokens
sem_HsTokens list =
(Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list))
newtype T_HsTokens = T_HsTokens (( ([(Pos,String)])))
data Inh_HsTokens = Inh_HsTokens {}
data Syn_HsTokens = Syn_HsTokens {tks_Syn_HsTokens :: ([(Pos,String)])}
wrap_HsTokens :: T_HsTokens ->
Inh_HsTokens ->
Syn_HsTokens
wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens) =
(let ( _lhsOtks) = sem
in (Syn_HsTokens _lhsOtks))
sem_HsTokens_Cons :: T_HsToken ->
T_HsTokens ->
T_HsTokens
sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) =
(T_HsTokens (let _lhsOtks :: ([(Pos,String)])
_hdIattrs :: (Map String (Maybe NonLocalAttr))
_hdItok :: ((Pos,String))
_tlItks :: ([(Pos,String)])
_lhsOtks =
(
_hdItok : _tlItks
)
( _hdIattrs,_hdItok) =
hd_
( _tlItks) =
tl_
in ( _lhsOtks)))
sem_HsTokens_Nil :: T_HsTokens
sem_HsTokens_Nil =
(T_HsTokens (let _lhsOtks :: ([(Pos,String)])
_lhsOtks =
(
[]
)
in ( _lhsOtks)))
sem_HsTokensRoot :: HsTokensRoot ->
T_HsTokensRoot
sem_HsTokensRoot (HsTokensRoot _tokens) =
(sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens))
newtype T_HsTokensRoot = T_HsTokensRoot (( ))
data Inh_HsTokensRoot = Inh_HsTokensRoot {}
data Syn_HsTokensRoot = Syn_HsTokensRoot {}
wrap_HsTokensRoot :: T_HsTokensRoot ->
Inh_HsTokensRoot ->
Syn_HsTokensRoot
wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot) =
(let ( ) = sem
in (Syn_HsTokensRoot))
sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->
T_HsTokensRoot
sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) =
(T_HsTokensRoot (let _tokensItks :: ([(Pos,String)])
( _tokensItks) =
tokens_
in ( )))
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern (Alias _field _attr _pat) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat))
sem_Pattern (Constr _name _pats) =
(sem_Pattern_Constr _name (sem_Patterns _pats))
sem_Pattern (Irrefutable _pat) =
(sem_Pattern_Irrefutable (sem_Pattern _pat))
sem_Pattern (Product _pos _pats) =
(sem_Pattern_Product _pos (sem_Patterns _pats))
sem_Pattern (Underscore _pos) =
(sem_Pattern_Underscore _pos)
newtype T_Pattern = T_Pattern ((Map NontermIdent Attributes) ->
(Map NontermIdent Attributes) ->
Bool ->
Attributes ->
(Map Identifier Type) ->
Options ->
Attributes ->
( PP_Doc,(Set String),Pattern,Bool,( PP_Doc )))
data Inh_Pattern = Inh_Pattern {allInhmap_Inh_Pattern :: (Map NontermIdent Attributes),allSynmap_Inh_Pattern :: (Map NontermIdent Attributes),anyLazyKind_Inh_Pattern :: Bool,inhmap_Inh_Pattern :: Attributes,localAttrTypes_Inh_Pattern :: (Map Identifier Type),options_Inh_Pattern :: Options,synmap_Inh_Pattern :: Attributes}
data Syn_Pattern = Syn_Pattern {attrTypes_Syn_Pattern :: PP_Doc,attrs_Syn_Pattern :: (Set String),copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,sem_lhs_Syn_Pattern :: ( PP_Doc )}
wrap_Pattern :: T_Pattern ->
Inh_Pattern ->
Syn_Pattern
wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) =
(let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap
in (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_) =
(T_Pattern (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOsem_lhs :: ( PP_Doc )
_lhsOisUnderscore :: Bool
_lhsOattrs :: (Set String)
_lhsOattrTypes :: PP_Doc
_lhsOcopy :: Pattern
_patOallInhmap :: (Map NontermIdent Attributes)
_patOallSynmap :: (Map NontermIdent Attributes)
_patOanyLazyKind :: Bool
_patOinhmap :: Attributes
_patOlocalAttrTypes :: (Map Identifier Type)
_patOoptions :: Options
_patOsynmap :: Attributes
_patIattrTypes :: PP_Doc
_patIattrs :: (Set String)
_patIcopy :: Pattern
_patIisUnderscore :: Bool
_patIsem_lhs :: ( PP_Doc )
_varPat =
(
text $ attrname False field_ attr_
)
_patExpr =
(
if _patIisUnderscore
then _varPat
else _varPat >|< "@" >|< _patIsem_lhs
)
_lhsOsem_lhs =
(
_addbang1 _patExpr
)
_lhsOisUnderscore =
(
False
)
_lhsOattrs =
(
Set.insert (attrname False field_ attr_) _patIattrs
)
_mbTp =
(
if field_ == _LHS
then Map.lookup attr_ _lhsIsynmap
else if field_ == _LOC
then Map.lookup attr_ _lhsIlocalAttrTypes
else Nothing
)
_lhsOattrTypes =
(
maybe empty (\tp -> (attrname False field_ attr_) >#< "::" >#< ppTp tp) _mbTp
>-< _patIattrTypes
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbang1 =
(
if _lhsIanyLazyKind then id else _addbang
)
_copy =
(
Alias field_ attr_ _patIcopy
)
_lhsOcopy =
(
_copy
)
_patOallInhmap =
(
_lhsIallInhmap
)
_patOallSynmap =
(
_lhsIallSynmap
)
_patOanyLazyKind =
(
_lhsIanyLazyKind
)
_patOinhmap =
(
_lhsIinhmap
)
_patOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_patOoptions =
(
_lhsIoptions
)
_patOsynmap =
(
_lhsIsynmap
)
( _patIattrTypes,_patIattrs,_patIcopy,_patIisUnderscore,_patIsem_lhs) =
pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs))))
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr name_ (T_Patterns pats_) =
(T_Pattern (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOsem_lhs :: ( PP_Doc )
_lhsOisUnderscore :: Bool
_lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOcopy :: Pattern
_patsOallInhmap :: (Map NontermIdent Attributes)
_patsOallSynmap :: (Map NontermIdent Attributes)
_patsOanyLazyKind :: Bool
_patsOinhmap :: Attributes
_patsOlocalAttrTypes :: (Map Identifier Type)
_patsOoptions :: Options
_patsOsynmap :: Attributes
_patsIattrTypes :: PP_Doc
_patsIattrs :: (Set String)
_patsIcopy :: Patterns
_patsIsem_lhs :: ([PP_Doc])
_lhsOsem_lhs =
(
_addbang1 $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs
)
_lhsOisUnderscore =
(
False
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbang1 =
(
if _lhsIanyLazyKind then id else _addbang
)
_lhsOattrTypes =
(
_patsIattrTypes
)
_lhsOattrs =
(
_patsIattrs
)
_copy =
(
Constr name_ _patsIcopy
)
_lhsOcopy =
(
_copy
)
_patsOallInhmap =
(
_lhsIallInhmap
)
_patsOallSynmap =
(
_lhsIallSynmap
)
_patsOanyLazyKind =
(
_lhsIanyLazyKind
)
_patsOinhmap =
(
_lhsIinhmap
)
_patsOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_patsOoptions =
(
_lhsIoptions
)
_patsOsynmap =
(
_lhsIsynmap
)
( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIsem_lhs) =
pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs))))
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable (T_Pattern pat_) =
(T_Pattern (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOsem_lhs :: ( PP_Doc )
_lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOcopy :: Pattern
_lhsOisUnderscore :: Bool
_patOallInhmap :: (Map NontermIdent Attributes)
_patOallSynmap :: (Map NontermIdent Attributes)
_patOanyLazyKind :: Bool
_patOinhmap :: Attributes
_patOlocalAttrTypes :: (Map Identifier Type)
_patOoptions :: Options
_patOsynmap :: Attributes
_patIattrTypes :: PP_Doc
_patIattrs :: (Set String)
_patIcopy :: Pattern
_patIisUnderscore :: Bool
_patIsem_lhs :: ( PP_Doc )
_lhsOsem_lhs =
(
text "~" >|< pp_parens _patIsem_lhs
)
_lhsOattrTypes =
(
_patIattrTypes
)
_lhsOattrs =
(
_patIattrs
)
_copy =
(
Irrefutable _patIcopy
)
_lhsOcopy =
(
_copy
)
_lhsOisUnderscore =
(
_patIisUnderscore
)
_patOallInhmap =
(
_lhsIallInhmap
)
_patOallSynmap =
(
_lhsIallSynmap
)
_patOanyLazyKind =
(
_lhsIanyLazyKind
)
_patOinhmap =
(
_lhsIinhmap
)
_patOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_patOoptions =
(
_lhsIoptions
)
_patOsynmap =
(
_lhsIsynmap
)
( _patIattrTypes,_patIattrs,_patIcopy,_patIisUnderscore,_patIsem_lhs) =
pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs))))
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product pos_ (T_Patterns pats_) =
(T_Pattern (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOsem_lhs :: ( PP_Doc )
_lhsOisUnderscore :: Bool
_lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOcopy :: Pattern
_patsOallInhmap :: (Map NontermIdent Attributes)
_patsOallSynmap :: (Map NontermIdent Attributes)
_patsOanyLazyKind :: Bool
_patsOinhmap :: Attributes
_patsOlocalAttrTypes :: (Map Identifier Type)
_patsOoptions :: Options
_patsOsynmap :: Attributes
_patsIattrTypes :: PP_Doc
_patsIattrs :: (Set String)
_patsIcopy :: Patterns
_patsIsem_lhs :: ([PP_Doc])
_lhsOsem_lhs =
(
_addbang1 $ pp_block "(" ")" "," _patsIsem_lhs
)
_lhsOisUnderscore =
(
False
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbang1 =
(
if _lhsIanyLazyKind then id else _addbang
)
_lhsOattrTypes =
(
_patsIattrTypes
)
_lhsOattrs =
(
_patsIattrs
)
_copy =
(
Product pos_ _patsIcopy
)
_lhsOcopy =
(
_copy
)
_patsOallInhmap =
(
_lhsIallInhmap
)
_patsOallSynmap =
(
_lhsIallSynmap
)
_patsOanyLazyKind =
(
_lhsIanyLazyKind
)
_patsOinhmap =
(
_lhsIinhmap
)
_patsOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_patsOoptions =
(
_lhsIoptions
)
_patsOsynmap =
(
_lhsIsynmap
)
( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIsem_lhs) =
pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs))))
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore pos_ =
(T_Pattern (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOsem_lhs :: ( PP_Doc )
_lhsOisUnderscore :: Bool
_lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOcopy :: Pattern
_lhsOsem_lhs =
(
text "_"
)
_lhsOisUnderscore =
(
True
)
_lhsOattrTypes =
(
empty
)
_lhsOattrs =
(
Set.empty
)
_copy =
(
Underscore pos_
)
_lhsOcopy =
(
_copy
)
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs))))
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))
newtype T_Patterns = T_Patterns ((Map NontermIdent Attributes) ->
(Map NontermIdent Attributes) ->
Bool ->
Attributes ->
(Map Identifier Type) ->
Options ->
Attributes ->
( PP_Doc,(Set String),Patterns,([PP_Doc])))
data Inh_Patterns = Inh_Patterns {allInhmap_Inh_Patterns :: (Map NontermIdent Attributes),allSynmap_Inh_Patterns :: (Map NontermIdent Attributes),anyLazyKind_Inh_Patterns :: Bool,inhmap_Inh_Patterns :: Attributes,localAttrTypes_Inh_Patterns :: (Map Identifier Type),options_Inh_Patterns :: Options,synmap_Inh_Patterns :: Attributes}
data Syn_Patterns = Syn_Patterns {attrTypes_Syn_Patterns :: PP_Doc,attrs_Syn_Patterns :: (Set String),copy_Syn_Patterns :: Patterns,sem_lhs_Syn_Patterns :: ([PP_Doc])}
wrap_Patterns :: T_Patterns ->
Inh_Patterns ->
Syn_Patterns
wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) =
(let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap
in (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =
(T_Patterns (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOsem_lhs :: ([PP_Doc])
_lhsOcopy :: Patterns
_hdOallInhmap :: (Map NontermIdent Attributes)
_hdOallSynmap :: (Map NontermIdent Attributes)
_hdOanyLazyKind :: Bool
_hdOinhmap :: Attributes
_hdOlocalAttrTypes :: (Map Identifier Type)
_hdOoptions :: Options
_hdOsynmap :: Attributes
_tlOallInhmap :: (Map NontermIdent Attributes)
_tlOallSynmap :: (Map NontermIdent Attributes)
_tlOanyLazyKind :: Bool
_tlOinhmap :: Attributes
_tlOlocalAttrTypes :: (Map Identifier Type)
_tlOoptions :: Options
_tlOsynmap :: Attributes
_hdIattrTypes :: PP_Doc
_hdIattrs :: (Set String)
_hdIcopy :: Pattern
_hdIisUnderscore :: Bool
_hdIsem_lhs :: ( PP_Doc )
_tlIattrTypes :: PP_Doc
_tlIattrs :: (Set String)
_tlIcopy :: Patterns
_tlIsem_lhs :: ([PP_Doc])
_lhsOattrTypes =
(
_hdIattrTypes >-< _tlIattrTypes
)
_lhsOattrs =
(
_hdIattrs `Set.union` _tlIattrs
)
_lhsOsem_lhs =
(
_hdIsem_lhs : _tlIsem_lhs
)
_copy =
(
(:) _hdIcopy _tlIcopy
)
_lhsOcopy =
(
_copy
)
_hdOallInhmap =
(
_lhsIallInhmap
)
_hdOallSynmap =
(
_lhsIallSynmap
)
_hdOanyLazyKind =
(
_lhsIanyLazyKind
)
_hdOinhmap =
(
_lhsIinhmap
)
_hdOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_hdOoptions =
(
_lhsIoptions
)
_hdOsynmap =
(
_lhsIsynmap
)
_tlOallInhmap =
(
_lhsIallInhmap
)
_tlOallSynmap =
(
_lhsIallSynmap
)
_tlOanyLazyKind =
(
_lhsIanyLazyKind
)
_tlOinhmap =
(
_lhsIinhmap
)
_tlOlocalAttrTypes =
(
_lhsIlocalAttrTypes
)
_tlOoptions =
(
_lhsIoptions
)
_tlOsynmap =
(
_lhsIsynmap
)
( _hdIattrTypes,_hdIattrs,_hdIcopy,_hdIisUnderscore,_hdIsem_lhs) =
hd_ _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap
( _tlIattrTypes,_tlIattrs,_tlIcopy,_tlIsem_lhs) =
tl_ _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs))))
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (\ _lhsIallInhmap
_lhsIallSynmap
_lhsIanyLazyKind
_lhsIinhmap
_lhsIlocalAttrTypes
_lhsIoptions
_lhsIsynmap ->
(let _lhsOattrTypes :: PP_Doc
_lhsOattrs :: (Set String)
_lhsOsem_lhs :: ([PP_Doc])
_lhsOcopy :: Patterns
_lhsOattrTypes =
(
empty
)
_lhsOattrs =
(
Set.empty
)
_lhsOsem_lhs =
(
[]
)
_copy =
(
[]
)
_lhsOcopy =
(
_copy
)
in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs))))
sem_Visit :: Visit ->
T_Visit
sem_Visit (Visit _ident _from _to _inh _syn _steps _kind) =
(sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps) _kind)
newtype T_Visit = T_Visit ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Attributes) ->
(Map NontermIdent Int) ->
(Map NontermIdent Attributes) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map StateIdentifier (Map String (Maybe NonLocalAttr))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map Identifier Type) ->
(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ->
ConstructorIdent ->
Attributes ->
(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ->
(Map StateIdentifier StateCtx) ->
NontermIdent ->
Options ->
([Identifier]) ->
(Map StateIdentifier StateCtx) ->
(Map Identifier (Set String)) ->
(Map Identifier (Map String (Maybe NonLocalAttr))) ->
Attributes ->
(Set String) ->
( ( VisitStateState ),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( (StateIdentifier,Bool -> PP_Doc) ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_Visit = Inh_Visit {allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visit :: (Map NontermIdent Attributes),allInitStates_Inh_Visit :: (Map NontermIdent Int),allSynmap_Inh_Visit :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visit :: (Map Identifier Type),childintros_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visit :: ConstructorIdent,inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx),nt_Inh_Visit :: NontermIdent,options_Inh_Visit :: Options,params_Inh_Visit :: ([Identifier]),prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visit :: (Map Identifier (Set String)),ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set String)}
data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ( VisitStateState ),childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_Visit :: (Seq Error),fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visit :: (Set String),ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visit :: (Map Identifier Int),sem_visit_Syn_Visit :: ( (StateIdentifier,Bool -> PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier))}
wrap_Visit :: T_Visit ->
Inh_Visit ->
Syn_Visit
wrap_Visit (T_Visit sem) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) =
(let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs
in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_Visit_Visit :: VisitIdentifier ->
StateIdentifier ->
StateIdentifier ->
(Set Identifier) ->
(Set Identifier) ->
T_VisitSteps ->
VisitKind ->
T_Visit
sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_) kind_ =
(T_Visit (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallintramap
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIcon
_lhsIinhmap
_lhsImrules
_lhsInextVisits
_lhsInt
_lhsIoptions
_lhsIparams
_lhsIprevVisits
_lhsIruledefs
_lhsIruleuses
_lhsIsynmap
_lhsIterminaldefs ->
(let _lhsOallvisits :: ( VisitStateState )
_lhsOt_visits :: PP_Doc
_lhsOsem_visit :: ( (StateIdentifier,Bool -> PP_Doc) )
_stepsOkind :: VisitKind
_stepsOfmtMode :: FormatMode
_stepsOindex :: Int
_stepsOprevMaxSimRefs :: Int
_stepsOuseParallel :: Bool
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOlazyIntras :: (Set String)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOerrors :: (Seq Error)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_stepsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_stepsOallInitStates :: (Map NontermIdent Int)
_stepsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_stepsOavisituses :: (Map VisitIdentifier (Set Identifier))
_stepsOchildTypes :: (Map Identifier Type)
_stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_stepsOoptions :: Options
_stepsOruledefs :: (Map Identifier (Set String))
_stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_stepsIdefs :: (Set String)
_stepsIerrors :: (Seq Error)
_stepsIindex :: Int
_stepsIisLast :: Bool
_stepsIlazyIntras :: (Set String)
_stepsIprevMaxSimRefs :: Int
_stepsIruleKinds :: (Map Identifier (Set VisitKind))
_stepsIruleUsage :: (Map Identifier Int)
_stepsIsem_steps :: PP_Doc
_stepsIsize :: Int
_stepsIsync_steps :: PP_Doc
_stepsIuses :: (Map String (Maybe NonLocalAttr))
_stepsIvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOallvisits =
(
(ident_, from_, to_)
)
_nameT_visit =
(
conNmTVisit _lhsInt ident_
)
_nameTIn_visit =
(
conNmTVisitIn _lhsInt ident_
)
_nameTOut_visit =
(
conNmTVisitOut _lhsInt ident_
)
_nameTNext_visit =
(
conNmTNextVisit _lhsInt to_
)
_nextVisitInfo =
(
Map.findWithDefault ManyVis to_ _lhsInextVisits
)
_typecon =
(
case kind_ of
VisitPure _ -> empty
VisitMonadic -> ppMonadType _lhsIoptions
)
_t_params =
(
ppSpaced _lhsIparams
)
_lhsOt_visits =
(
"type" >#< _nameT_visit >#< _t_params >#< "=" >#<
pp_parens (_nameTIn_visit >#< _t_params )
>#< ( if dummyTokenVisit _lhsIoptions
then "->" >#< dummyType _lhsIoptions True
else empty
)
>#< "->" >#< _typecon >#< pp_parens (_nameTOut_visit >#< _t_params )
>-< "data" >#< _nameTIn_visit >#< _t_params >#< "=" >#< _nameTIn_visit >#<
_inhpart
>-< "data" >#< _nameTOut_visit >#< _t_params >#< "=" >#< _nameTOut_visit >#<
_synpart >#< case _nextVisitInfo of
NoneVis -> empty
_ -> _addbang1 $ pp_parens (_nameTNext_visit >#< _t_params )
)
_inhpart =
(
_ppTypeList inh_ _lhsIinhmap
)
_synpart =
(
_ppTypeList syn_ _lhsIsynmap
)
_ppTypeList =
(
\s m -> ppSpaced $ map (\i -> _addbang1 $ pp_parens $ case Map.lookup i m of
Just tp -> ppTp tp ) $ Set.toList s
)
_lhsOsem_visit =
(
( from_
, \addInlinePragma ->
( if noInlinePragmas _lhsIoptions
then empty
else if addInlinePragma && aggressiveInlinePragmas _lhsIoptions
then ppInline _vname
else if helpInlining _lhsIoptions
then ppNoInline _vname
else empty
)
>-< "v" >|< ident_ >#< "::" >#< _nameT_visit >#< _t_params
>-< "v" >|< ident_ >#< "=" >#< "\\" >#< (_addbang $ pp_parens (_nameTIn_visit >#< _inhpats ))
>#< ( if dummyTokenVisit _lhsIoptions
then pp $ dummyPat _lhsIoptions True
else empty
)
>#< "->"
>#< ( if genCostCentres _lhsIoptions
then ppCostCentre (_vname >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon)
else empty
) >#< "(" >#< _stepsInitial
>-< indent 3 (_stepsIsem_steps >-< _stepsClosing >#< ")")
)
)
_stepsInitial =
(
case kind_ of
VisitPure False -> text "let"
VisitPure True -> empty
VisitMonadic -> text "do"
)
_stepsClosing =
(
let decls = _nextStBuild
>-< _addbang (pp resultValName) >#< "=" >#< _resultval
in case kind_ of
VisitPure False -> decls
>-< "in" >#< resultValName
VisitPure True -> "let" >#< decls
>-< indent 1 ("in" >#< resultValName)
VisitMonadic -> "let" >#< decls
>-< "return" >#< resultValName
)
_vname =
(
"v" >|< ident_
)
_inhpats =
(
ppSpaced $ map (\arg -> _addbang $ pp $ attrname True _LHS arg) $ Set.toList inh_
)
_inhargs =
(
\chn -> ppSpaced $ map (attrname False chn) $ Set.toList inh_
)
_synargs =
(
ppSpaced $ map (\arg -> attrname False _LHS arg) $ Set.toList syn_
)
_nextargsMp =
(
maybe Map.empty id $ Map.lookup to_ _lhsIallintramap
)
_nextargs =
(
ppSpaced $ Map.keys $ _nextargsMp
)
_nextst =
(
"st" >|< to_ >#< _nextargs >#< dummyArg _lhsIoptions (Map.null _nextargsMp )
)
_resultval =
(
_nameTOut_visit >#< _synargs >#< _nextStRef
)
(_nextStBuild,_nextStRef) =
(
case _nextVisitInfo of
NoneVis -> (empty, empty)
_ -> (_addbang (pp nextStName) >#< "=" >#< _nextst , pp nextStName)
)
_stepsOkind =
(
kind_
)
_stepsOfmtMode =
(
case kind_ of
VisitPure False -> FormatLetDecl
VisitPure True -> FormatLetLine
VisitMonadic -> FormatDo
)
_stepsOindex =
(
0
)
_stepsOprevMaxSimRefs =
(
0
)
_stepsOuseParallel =
(
False
)
_prevVisitInfo =
(
Map.findWithDefault ManyVis from_ _lhsInextVisits
)
_lhsOchildvisit =
(
Map.singleton ident_ _invokecode
)
_invokecode =
(
\chn kind ->
if kind `compatibleKind` kind_
then Right $
let pat | isLazyKind kind_ = pat0
| otherwise = _addbang pat0
pat0 = pp_parens pat1
pat1 = _nameTOut_visit >#< (ppSpaced $ map (attrname True chn) $ Set.toList syn_)
>#< cont
cont = case _nextVisitInfo of
NoneVis -> empty
_ -> ch1
ch0 = text $ stname chn from_
ch1 = text $ stname chn to_
expr = case (kind, kind_) of
(VisitPure _, VisitPure _) -> expr0
(VisitPure _, VisitMonadic) -> unMon _lhsIoptions >#< expr0
(VisitMonadic, VisitPure _) -> "return" >#< expr0
(VisitMonadic, VisitMonadic) -> expr0
expr0 = case _prevVisitInfo of
NoneVis -> error "error: invocation of a visit from a state that has no next visits"
OneVis _ -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< args
ManyVis -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0
>#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< args
args = pp_parens args0 >#< args1
args0 = _nameTIn_visit >#< _inhargs chn
args1 | dummyTokenVisit _lhsIoptions = pp $ dummyArg _lhsIoptions True
| otherwise = empty
in (pat, expr)
else Left $ IncompatibleVisitKind chn ident_ kind kind_
)
_thisintra =
(
(_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap
)
_lhsOintramap =
(
Map.singleton from_ _thisintra
)
_nextintra =
(
maybe Map.empty id $ Map.lookup to_ _lhsIallintramap
)
_uses =
(
let mp1 = _stepsIuses
mp2 = Map.fromList [ (lhsname False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ]
in mp1 `Map.union` mp2
)
_inhVarNms =
(
Set.map (lhsname True) inh_
)
_defs =
(
_stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs
)
_defsAsMap =
(
Map.fromList [ (a, Nothing) | a <- Set.elems _defs ]
)
_lhsOvisitdefs =
(
Map.singleton ident_ syn_
)
_lhsOvisituses =
(
Map.singleton ident_ inh_
)
_lazyIntrasInh =
(
case kind_ of
VisitPure False -> _inhVarNms `Set.union` _stepsIdefs
_ -> Set.empty
)
_lhsOlazyIntras =
(
_lazyIntrasInh `Set.union` _stepsIlazyIntras
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
_addbang1 =
(
if isLazyKind kind_ then id else _addbang
)
_lhsOfromToStates =
(
Map.singleton ident_ (from_, to_)
)
_lhsOvisitKinds =
(
Map.singleton ident_ kind_
)
_lhsOerrors =
(
_stepsIerrors
)
_lhsOruleKinds =
(
_stepsIruleKinds
)
_lhsOruleUsage =
(
_stepsIruleUsage
)
_stepsOallFromToStates =
(
_lhsIallFromToStates
)
_stepsOallInitStates =
(
_lhsIallInitStates
)
_stepsOallVisitKinds =
(
_lhsIallVisitKinds
)
_stepsOallchildvisit =
(
_lhsIallchildvisit
)
_stepsOavisitdefs =
(
_lhsIavisitdefs
)
_stepsOavisituses =
(
_lhsIavisituses
)
_stepsOchildTypes =
(
_lhsIchildTypes
)
_stepsOchildintros =
(
_lhsIchildintros
)
_stepsOmrules =
(
_lhsImrules
)
_stepsOoptions =
(
_lhsIoptions
)
_stepsOruledefs =
(
_lhsIruledefs
)
_stepsOruleuses =
(
_lhsIruleuses
)
( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) =
steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_VisitStep :: VisitStep ->
T_VisitStep
sem_VisitStep (ChildIntro _child) =
(sem_VisitStep_ChildIntro _child)
sem_VisitStep (ChildVisit _child _nonterm _visit) =
(sem_VisitStep_ChildVisit _child _nonterm _visit)
sem_VisitStep (PureGroup _steps _ordered) =
(sem_VisitStep_PureGroup (sem_VisitSteps _steps) _ordered)
sem_VisitStep (Sem _name) =
(sem_VisitStep_Sem _name)
sem_VisitStep (Sim _steps) =
(sem_VisitStep_Sim (sem_VisitSteps _steps))
newtype T_VisitStep = T_VisitStep ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Int) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map Identifier Type) ->
(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ->
FormatMode ->
Int ->
Bool ->
VisitKind ->
(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ->
Options ->
Int ->
(Map Identifier (Set String)) ->
(Map Identifier (Map String (Maybe NonLocalAttr))) ->
Bool ->
( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,PP_Doc,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind)))
data Inh_VisitStep = Inh_VisitStep {allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitStep :: (Map NontermIdent Int),allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitStep :: (Map Identifier Type),childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),fmtMode_Inh_VisitStep :: FormatMode,index_Inh_VisitStep :: Int,isLast_Inh_VisitStep :: Bool,kind_Inh_VisitStep :: VisitKind,mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),options_Inh_VisitStep :: Options,prevMaxSimRefs_Inh_VisitStep :: Int,ruledefs_Inh_VisitStep :: (Map Identifier (Set String)),ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitStep :: Bool}
data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set String),errors_Syn_VisitStep :: (Seq Error),index_Syn_VisitStep :: Int,isLast_Syn_VisitStep :: Bool,lazyIntras_Syn_VisitStep :: (Set String),prevMaxSimRefs_Syn_VisitStep :: Int,ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitStep :: (Map Identifier Int),sem_steps_Syn_VisitStep :: PP_Doc,sync_steps_Syn_VisitStep :: PP_Doc,uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind)}
wrap_VisitStep :: T_VisitStep ->
Inh_VisitStep ->
Syn_VisitStep
wrap_VisitStep (T_VisitStep sem) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) =
(let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel
in (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOuses _lhsOvisitKinds))
sem_VisitStep_ChildIntro :: Identifier ->
T_VisitStep
sem_VisitStep_ChildIntro child_ =
(T_VisitStep (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIisLast
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOerrors :: (Seq Error)
_lhsOsem_steps :: PP_Doc
_lhsOdefs :: (Set String)
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsync_steps :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOindex :: Int
_lhsOisLast :: Bool
_lhsOprevMaxSimRefs :: Int
_attachItf =
(
Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros
)
(_lhsOerrors,_lhsOsem_steps,_lhsOdefs,_lhsOuses) =
(
case _attachItf _lhsIkind _lhsIfmtMode of
Left e -> (Seq.singleton e, empty, Set.empty, Map.empty)
Right (code, defs, uses) -> (Seq.empty, code, defs, uses)
)
_lhsOlazyIntras =
(
Set.empty
)
_lhsOruleKinds =
(
Map.empty
)
_lhsOruleUsage =
(
Map.empty
)
_lhsOsync_steps =
(
empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOindex =
(
_lhsIindex
)
_lhsOisLast =
(
_lhsIisLast
)
_lhsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitStep_ChildVisit :: Identifier ->
NontermIdent ->
VisitIdentifier ->
T_VisitStep
sem_VisitStep_ChildVisit child_ nonterm_ visit_ =
(T_VisitStep (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIisLast
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOerrors :: (Seq Error)
_lhsOsem_steps :: PP_Doc
_lhsOsync_steps :: PP_Doc
_lhsOdefs :: (Set String)
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOindex :: Int
_lhsOisLast :: Bool
_lhsOprevMaxSimRefs :: Int
_visitItf =
(
Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit
)
(_lhsOerrors,_patPP,_exprPP) =
(
case _visitItf child_ _lhsIkind of
Left e -> (Seq.singleton e, empty, empty)
Right (pat,expr) -> (Seq.empty, pat, expr)
)
_useParallel =
(
_lhsIuseParallel && not _lhsIisLast
)
_lhsOsem_steps =
(
if _useParallel
then _addbang ("sync_" >|< _lhsIindex) >#< "<- newEmptyMVar"
>-< "forkIO" >#< pp_parens (_convToMonad >#< pp_parens _exprPP >#< ">>= \\" >#< _addbang (pp parResultName) >#< " -> putMVar sync_" >|< _lhsIindex >#< parResultName)
else let decl = case _lhsIkind of
VisitPure _ -> _patPP >#< "=" >#< _exprPP
VisitMonadic -> _patPP >#< "<-" >#< _exprPP
in fmtDecl False _lhsIfmtMode decl
)
_convToMonad =
(
case _callKind of
VisitPure _ -> text "return"
VisitMonadic -> empty
)
_callKind =
(
Map.findWithDefault (error "visit kind should be in the map") visit_ _lhsIallVisitKinds
)
_lhsOsync_steps =
(
if _useParallel
then _patPP >#< "<-" >#< "takeMVar sync_" >|< _lhsIindex
else empty
)
_lhsOdefs =
(
Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs
)
_lhsOuses =
(
let convert attrs = Map.fromList [ (attrname False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ]
in Map.insert (stname child_ _from) Nothing $ convert $
maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses
)
_addbang =
(
\x -> if bangpats _lhsIoptions then "!" >|< x else x
)
(_from,_to) =
(
Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates
)
_lhsOlazyIntras =
(
Set.empty
)
_lhsOruleKinds =
(
Map.empty
)
_lhsOruleUsage =
(
Map.empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOindex =
(
_lhsIindex
)
_lhsOisLast =
(
_lhsIisLast
)
_lhsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitStep_PureGroup :: T_VisitSteps ->
Bool ->
T_VisitStep
sem_VisitStep_PureGroup (T_VisitSteps steps_) ordered_ =
(T_VisitStep (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIisLast
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _stepsOkind :: VisitKind
_lhsOsem_steps :: PP_Doc
_stepsOfmtMode :: FormatMode
_lhsOlazyIntras :: (Set String)
_lhsOdefs :: (Set String)
_lhsOerrors :: (Seq Error)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsync_steps :: PP_Doc
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOindex :: Int
_lhsOisLast :: Bool
_lhsOprevMaxSimRefs :: Int
_stepsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_stepsOallInitStates :: (Map NontermIdent Int)
_stepsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_stepsOavisituses :: (Map VisitIdentifier (Set Identifier))
_stepsOchildTypes :: (Map Identifier Type)
_stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_stepsOindex :: Int
_stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_stepsOoptions :: Options
_stepsOprevMaxSimRefs :: Int
_stepsOruledefs :: (Map Identifier (Set String))
_stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_stepsOuseParallel :: Bool
_stepsIdefs :: (Set String)
_stepsIerrors :: (Seq Error)
_stepsIindex :: Int
_stepsIisLast :: Bool
_stepsIlazyIntras :: (Set String)
_stepsIprevMaxSimRefs :: Int
_stepsIruleKinds :: (Map Identifier (Set VisitKind))
_stepsIruleUsage :: (Map Identifier Int)
_stepsIsem_steps :: PP_Doc
_stepsIsize :: Int
_stepsIsync_steps :: PP_Doc
_stepsIuses :: (Map String (Maybe NonLocalAttr))
_stepsIvisitKinds :: (Map VisitIdentifier VisitKind)
_stepsOkind =
(
VisitPure ordered_
)
_lhsOsem_steps =
(
case _lhsIfmtMode of
FormatDo -> "let" >#< _stepsIsem_steps
_ -> _stepsIsem_steps
)
_stepsOfmtMode =
(
case _lhsIfmtMode of
FormatDo -> FormatLetDecl
mode -> mode
)
_lhsOlazyIntras =
(
if ordered_
then _stepsIlazyIntras
else _stepsIdefs
)
_lhsOdefs =
(
_stepsIdefs
)
_lhsOerrors =
(
_stepsIerrors
)
_lhsOruleKinds =
(
_stepsIruleKinds
)
_lhsOruleUsage =
(
_stepsIruleUsage
)
_lhsOsync_steps =
(
_stepsIsync_steps
)
_lhsOuses =
(
_stepsIuses
)
_lhsOvisitKinds =
(
_stepsIvisitKinds
)
_lhsOindex =
(
_stepsIindex
)
_lhsOisLast =
(
_stepsIisLast
)
_lhsOprevMaxSimRefs =
(
_stepsIprevMaxSimRefs
)
_stepsOallFromToStates =
(
_lhsIallFromToStates
)
_stepsOallInitStates =
(
_lhsIallInitStates
)
_stepsOallVisitKinds =
(
_lhsIallVisitKinds
)
_stepsOallchildvisit =
(
_lhsIallchildvisit
)
_stepsOavisitdefs =
(
_lhsIavisitdefs
)
_stepsOavisituses =
(
_lhsIavisituses
)
_stepsOchildTypes =
(
_lhsIchildTypes
)
_stepsOchildintros =
(
_lhsIchildintros
)
_stepsOindex =
(
_lhsIindex
)
_stepsOmrules =
(
_lhsImrules
)
_stepsOoptions =
(
_lhsIoptions
)
_stepsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
_stepsOruledefs =
(
_lhsIruledefs
)
_stepsOruleuses =
(
_lhsIruleuses
)
_stepsOuseParallel =
(
_lhsIuseParallel
)
( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) =
steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitStep_Sem :: Identifier ->
T_VisitStep
sem_VisitStep_Sem name_ =
(T_VisitStep (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIisLast
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOerrors :: (Seq Error)
_lhsOruleUsage :: (Map Identifier Int)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOdefs :: (Set String)
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOlazyIntras :: (Set String)
_lhsOsem_steps :: PP_Doc
_lhsOsync_steps :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOindex :: Int
_lhsOisLast :: Bool
_lhsOprevMaxSimRefs :: Int
_ruleItf =
(
Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules
)
(_lhsOerrors,_sem_steps) =
(
case _ruleItf _lhsIkind _lhsIfmtMode of
Left e -> (Seq.singleton e, empty)
Right stmt -> (Seq.empty, stmt)
)
_lhsOruleUsage =
(
Map.singleton name_ 1
)
_lhsOruleKinds =
(
Map.singleton name_ (Set.singleton _lhsIkind)
)
_lhsOdefs =
(
maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs
)
_lhsOuses =
(
maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses
)
_lhsOlazyIntras =
(
Set.empty
)
_lhsOsem_steps =
(
_sem_steps
)
_lhsOsync_steps =
(
empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOindex =
(
_lhsIindex
)
_lhsOisLast =
(
_lhsIisLast
)
_lhsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitStep_Sim :: T_VisitSteps ->
T_VisitStep
sem_VisitStep_Sim (T_VisitSteps steps_) =
(T_VisitStep (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIisLast
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOsem_steps :: PP_Doc
_stepsOindex :: Int
_lhsOindex :: Int
_lhsOprevMaxSimRefs :: Int
_lhsOdefs :: (Set String)
_lhsOerrors :: (Seq Error)
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsync_steps :: PP_Doc
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOisLast :: Bool
_stepsOallFromToStates :: (Map VisitIdentifier (Int,Int))
_stepsOallInitStates :: (Map NontermIdent Int)
_stepsOallVisitKinds :: (Map VisitIdentifier VisitKind)
_stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_stepsOavisituses :: (Map VisitIdentifier (Set Identifier))
_stepsOchildTypes :: (Map Identifier Type)
_stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_stepsOfmtMode :: FormatMode
_stepsOkind :: VisitKind
_stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_stepsOoptions :: Options
_stepsOprevMaxSimRefs :: Int
_stepsOruledefs :: (Map Identifier (Set String))
_stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_stepsOuseParallel :: Bool
_stepsIdefs :: (Set String)
_stepsIerrors :: (Seq Error)
_stepsIindex :: Int
_stepsIisLast :: Bool
_stepsIlazyIntras :: (Set String)
_stepsIprevMaxSimRefs :: Int
_stepsIruleKinds :: (Map Identifier (Set VisitKind))
_stepsIruleUsage :: (Map Identifier Int)
_stepsIsem_steps :: PP_Doc
_stepsIsize :: Int
_stepsIsync_steps :: PP_Doc
_stepsIuses :: (Map String (Maybe NonLocalAttr))
_stepsIvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOsem_steps =
(
_stepsIsem_steps >-< _stepsIsync_steps
)
_stepsOindex =
(
0
)
_lhsOindex =
(
_lhsIindex
)
_lhsOprevMaxSimRefs =
(
if _useParallel
then _lhsIprevMaxSimRefs `max` (_stepsIindex 1)
else _lhsIprevMaxSimRefs
)
_useParallel =
(
parallelInvoke _lhsIoptions && _stepsIsize > 1 && _isMonadic
)
_isMonadic =
(
case _lhsIkind of
VisitMonadic -> True
_ -> False
)
_lhsOdefs =
(
_stepsIdefs
)
_lhsOerrors =
(
_stepsIerrors
)
_lhsOlazyIntras =
(
_stepsIlazyIntras
)
_lhsOruleKinds =
(
_stepsIruleKinds
)
_lhsOruleUsage =
(
_stepsIruleUsage
)
_lhsOsync_steps =
(
_stepsIsync_steps
)
_lhsOuses =
(
_stepsIuses
)
_lhsOvisitKinds =
(
_stepsIvisitKinds
)
_lhsOisLast =
(
_stepsIisLast
)
_stepsOallFromToStates =
(
_lhsIallFromToStates
)
_stepsOallInitStates =
(
_lhsIallInitStates
)
_stepsOallVisitKinds =
(
_lhsIallVisitKinds
)
_stepsOallchildvisit =
(
_lhsIallchildvisit
)
_stepsOavisitdefs =
(
_lhsIavisitdefs
)
_stepsOavisituses =
(
_lhsIavisituses
)
_stepsOchildTypes =
(
_lhsIchildTypes
)
_stepsOchildintros =
(
_lhsIchildintros
)
_stepsOfmtMode =
(
_lhsIfmtMode
)
_stepsOkind =
(
_lhsIkind
)
_stepsOmrules =
(
_lhsImrules
)
_stepsOoptions =
(
_lhsIoptions
)
_stepsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
_stepsOruledefs =
(
_lhsIruledefs
)
_stepsOruleuses =
(
_lhsIruleuses
)
_stepsOuseParallel =
(
_useParallel
)
( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) =
steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitSteps :: VisitSteps ->
T_VisitSteps
sem_VisitSteps list =
(Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list))
newtype T_VisitSteps = T_VisitSteps ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Int) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map Identifier Type) ->
(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ->
FormatMode ->
Int ->
VisitKind ->
(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ->
Options ->
Int ->
(Map Identifier (Set String)) ->
(Map Identifier (Map String (Maybe NonLocalAttr))) ->
Bool ->
( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,Int,PP_Doc,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind)))
data Inh_VisitSteps = Inh_VisitSteps {allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitSteps :: (Map NontermIdent Int),allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitSteps :: (Map Identifier Type),childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),fmtMode_Inh_VisitSteps :: FormatMode,index_Inh_VisitSteps :: Int,kind_Inh_VisitSteps :: VisitKind,mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),options_Inh_VisitSteps :: Options,prevMaxSimRefs_Inh_VisitSteps :: Int,ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)),ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitSteps :: Bool}
data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set String),errors_Syn_VisitSteps :: (Seq Error),index_Syn_VisitSteps :: Int,isLast_Syn_VisitSteps :: Bool,lazyIntras_Syn_VisitSteps :: (Set String),prevMaxSimRefs_Syn_VisitSteps :: Int,ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitSteps :: (Map Identifier Int),sem_steps_Syn_VisitSteps :: PP_Doc,size_Syn_VisitSteps :: Int,sync_steps_Syn_VisitSteps :: PP_Doc,uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind)}
wrap_VisitSteps :: T_VisitSteps ->
Inh_VisitSteps ->
Syn_VisitSteps
wrap_VisitSteps (T_VisitSteps sem) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) =
(let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel
in (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOuses _lhsOvisitKinds))
sem_VisitSteps_Cons :: T_VisitStep ->
T_VisitSteps ->
T_VisitSteps
sem_VisitSteps_Cons (T_VisitStep hd_) (T_VisitSteps tl_) =
(T_VisitSteps (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOsize :: Int
_hdOindex :: Int
_tlOindex :: Int
_lhsOindex :: Int
_lhsOisLast :: Bool
_hdOisLast :: Bool
_lhsOdefs :: (Set String)
_lhsOerrors :: (Seq Error)
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsem_steps :: PP_Doc
_lhsOsync_steps :: PP_Doc
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOprevMaxSimRefs :: Int
_hdOallFromToStates :: (Map VisitIdentifier (Int,Int))
_hdOallInitStates :: (Map NontermIdent Int)
_hdOallVisitKinds :: (Map VisitIdentifier VisitKind)
_hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdOavisituses :: (Map VisitIdentifier (Set Identifier))
_hdOchildTypes :: (Map Identifier Type)
_hdOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_hdOfmtMode :: FormatMode
_hdOkind :: VisitKind
_hdOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_hdOoptions :: Options
_hdOprevMaxSimRefs :: Int
_hdOruledefs :: (Map Identifier (Set String))
_hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_hdOuseParallel :: Bool
_tlOallFromToStates :: (Map VisitIdentifier (Int,Int))
_tlOallInitStates :: (Map NontermIdent Int)
_tlOallVisitKinds :: (Map VisitIdentifier VisitKind)
_tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlOavisituses :: (Map VisitIdentifier (Set Identifier))
_tlOchildTypes :: (Map Identifier Type)
_tlOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_tlOfmtMode :: FormatMode
_tlOkind :: VisitKind
_tlOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_tlOoptions :: Options
_tlOprevMaxSimRefs :: Int
_tlOruledefs :: (Map Identifier (Set String))
_tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_tlOuseParallel :: Bool
_hdIdefs :: (Set String)
_hdIerrors :: (Seq Error)
_hdIindex :: Int
_hdIisLast :: Bool
_hdIlazyIntras :: (Set String)
_hdIprevMaxSimRefs :: Int
_hdIruleKinds :: (Map Identifier (Set VisitKind))
_hdIruleUsage :: (Map Identifier Int)
_hdIsem_steps :: PP_Doc
_hdIsync_steps :: PP_Doc
_hdIuses :: (Map String (Maybe NonLocalAttr))
_hdIvisitKinds :: (Map VisitIdentifier VisitKind)
_tlIdefs :: (Set String)
_tlIerrors :: (Seq Error)
_tlIindex :: Int
_tlIisLast :: Bool
_tlIlazyIntras :: (Set String)
_tlIprevMaxSimRefs :: Int
_tlIruleKinds :: (Map Identifier (Set VisitKind))
_tlIruleUsage :: (Map Identifier Int)
_tlIsem_steps :: PP_Doc
_tlIsize :: Int
_tlIsync_steps :: PP_Doc
_tlIuses :: (Map String (Maybe NonLocalAttr))
_tlIvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOsize =
(
1 + _tlIsize
)
_hdOindex =
(
_lhsIindex
)
_tlOindex =
(
1 + _lhsIindex
)
_lhsOindex =
(
_tlIindex
)
_lhsOisLast =
(
False
)
_hdOisLast =
(
_tlIisLast
)
_lhsOdefs =
(
_hdIdefs `Set.union` _tlIdefs
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOlazyIntras =
(
_hdIlazyIntras `Set.union` _tlIlazyIntras
)
_lhsOruleKinds =
(
_hdIruleKinds `unionWithMappend` _tlIruleKinds
)
_lhsOruleUsage =
(
_hdIruleUsage `unionWithSum` _tlIruleUsage
)
_lhsOsem_steps =
(
_hdIsem_steps >-< _tlIsem_steps
)
_lhsOsync_steps =
(
_hdIsync_steps >-< _tlIsync_steps
)
_lhsOuses =
(
_hdIuses `Map.union` _tlIuses
)
_lhsOvisitKinds =
(
_hdIvisitKinds `mappend` _tlIvisitKinds
)
_lhsOprevMaxSimRefs =
(
_tlIprevMaxSimRefs
)
_hdOallFromToStates =
(
_lhsIallFromToStates
)
_hdOallInitStates =
(
_lhsIallInitStates
)
_hdOallVisitKinds =
(
_lhsIallVisitKinds
)
_hdOallchildvisit =
(
_lhsIallchildvisit
)
_hdOavisitdefs =
(
_lhsIavisitdefs
)
_hdOavisituses =
(
_lhsIavisituses
)
_hdOchildTypes =
(
_lhsIchildTypes
)
_hdOchildintros =
(
_lhsIchildintros
)
_hdOfmtMode =
(
_lhsIfmtMode
)
_hdOkind =
(
_lhsIkind
)
_hdOmrules =
(
_lhsImrules
)
_hdOoptions =
(
_lhsIoptions
)
_hdOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
_hdOruledefs =
(
_lhsIruledefs
)
_hdOruleuses =
(
_lhsIruleuses
)
_hdOuseParallel =
(
_lhsIuseParallel
)
_tlOallFromToStates =
(
_lhsIallFromToStates
)
_tlOallInitStates =
(
_lhsIallInitStates
)
_tlOallVisitKinds =
(
_lhsIallVisitKinds
)
_tlOallchildvisit =
(
_lhsIallchildvisit
)
_tlOavisitdefs =
(
_lhsIavisitdefs
)
_tlOavisituses =
(
_lhsIavisituses
)
_tlOchildTypes =
(
_lhsIchildTypes
)
_tlOchildintros =
(
_lhsIchildintros
)
_tlOfmtMode =
(
_lhsIfmtMode
)
_tlOkind =
(
_lhsIkind
)
_tlOmrules =
(
_lhsImrules
)
_tlOoptions =
(
_lhsIoptions
)
_tlOprevMaxSimRefs =
(
_hdIprevMaxSimRefs
)
_tlOruledefs =
(
_lhsIruledefs
)
_tlOruleuses =
(
_lhsIruleuses
)
_tlOuseParallel =
(
_lhsIuseParallel
)
( _hdIdefs,_hdIerrors,_hdIindex,_hdIisLast,_hdIlazyIntras,_hdIprevMaxSimRefs,_hdIruleKinds,_hdIruleUsage,_hdIsem_steps,_hdIsync_steps,_hdIuses,_hdIvisitKinds) =
hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfmtMode _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOprevMaxSimRefs _hdOruledefs _hdOruleuses _hdOuseParallel
( _tlIdefs,_tlIerrors,_tlIindex,_tlIisLast,_tlIlazyIntras,_tlIprevMaxSimRefs,_tlIruleKinds,_tlIruleUsage,_tlIsem_steps,_tlIsize,_tlIsync_steps,_tlIuses,_tlIvisitKinds) =
tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfmtMode _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOprevMaxSimRefs _tlOruledefs _tlOruleuses _tlOuseParallel
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_VisitSteps_Nil :: T_VisitSteps
sem_VisitSteps_Nil =
(T_VisitSteps (\ _lhsIallFromToStates
_lhsIallInitStates
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIfmtMode
_lhsIindex
_lhsIkind
_lhsImrules
_lhsIoptions
_lhsIprevMaxSimRefs
_lhsIruledefs
_lhsIruleuses
_lhsIuseParallel ->
(let _lhsOsize :: Int
_lhsOisLast :: Bool
_lhsOdefs :: (Set String)
_lhsOerrors :: (Seq Error)
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsem_steps :: PP_Doc
_lhsOsync_steps :: PP_Doc
_lhsOuses :: (Map String (Maybe NonLocalAttr))
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOindex :: Int
_lhsOprevMaxSimRefs :: Int
_lhsOsize =
(
0
)
_lhsOisLast =
(
True
)
_lhsOdefs =
(
Set.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOlazyIntras =
(
Set.empty
)
_lhsOruleKinds =
(
Map.empty
)
_lhsOruleUsage =
(
Map.empty
)
_lhsOsem_steps =
(
empty
)
_lhsOsync_steps =
(
empty
)
_lhsOuses =
(
Map.empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOindex =
(
_lhsIindex
)
_lhsOprevMaxSimRefs =
(
_lhsIprevMaxSimRefs
)
in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds))))
sem_Visits :: Visits ->
T_Visits
sem_Visits list =
(Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list))
newtype T_Visits = T_Visits ((Map VisitIdentifier (Int,Int)) ->
(Map NontermIdent Attributes) ->
(Map NontermIdent Int) ->
(Map NontermIdent Attributes) ->
(Map VisitIdentifier VisitKind) ->
(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ->
(Map StateIdentifier (Map String (Maybe NonLocalAttr))) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map VisitIdentifier (Set Identifier)) ->
(Map Identifier Type) ->
(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ->
ConstructorIdent ->
Attributes ->
(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ->
(Map StateIdentifier StateCtx) ->
NontermIdent ->
Options ->
([Identifier]) ->
(Map StateIdentifier StateCtx) ->
(Map Identifier (Set String)) ->
(Map Identifier (Map String (Maybe NonLocalAttr))) ->
Attributes ->
(Set String) ->
( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( [(StateIdentifier,Bool -> PP_Doc)] ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier))))
data Inh_Visits = Inh_Visits {allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visits :: (Map NontermIdent Attributes),allInitStates_Inh_Visits :: (Map NontermIdent Int),allSynmap_Inh_Visits :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visits :: (Map Identifier Type),childintros_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visits :: ConstructorIdent,inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx),nt_Inh_Visits :: NontermIdent,options_Inh_Visits :: Options,params_Inh_Visits :: ([Identifier]),prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visits :: (Map Identifier (Set String)),ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set String)}
data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([VisitStateState]),childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_Visits :: (Seq Error),fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visits :: (Set String),ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visits :: (Map Identifier Int),sem_visit_Syn_Visits :: ( [(StateIdentifier,Bool -> PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier))}
wrap_Visits :: T_Visits ->
Inh_Visits ->
Syn_Visits
wrap_Visits (T_Visits sem) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) =
(let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs
in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses))
sem_Visits_Cons :: T_Visit ->
T_Visits ->
T_Visits
sem_Visits_Cons (T_Visit hd_) (T_Visits tl_) =
(T_Visits (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallintramap
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIcon
_lhsIinhmap
_lhsImrules
_lhsInextVisits
_lhsInt
_lhsIoptions
_lhsIparams
_lhsIprevVisits
_lhsIruledefs
_lhsIruleuses
_lhsIsynmap
_lhsIterminaldefs ->
(let _lhsOallvisits :: ([VisitStateState])
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] )
_lhsOt_visits :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_hdOallFromToStates :: (Map VisitIdentifier (Int,Int))
_hdOallInhmap :: (Map NontermIdent Attributes)
_hdOallInitStates :: (Map NontermIdent Int)
_hdOallSynmap :: (Map NontermIdent Attributes)
_hdOallVisitKinds :: (Map VisitIdentifier VisitKind)
_hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_hdOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdOavisituses :: (Map VisitIdentifier (Set Identifier))
_hdOchildTypes :: (Map Identifier Type)
_hdOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_hdOcon :: ConstructorIdent
_hdOinhmap :: Attributes
_hdOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_hdOnextVisits :: (Map StateIdentifier StateCtx)
_hdOnt :: NontermIdent
_hdOoptions :: Options
_hdOparams :: ([Identifier])
_hdOprevVisits :: (Map StateIdentifier StateCtx)
_hdOruledefs :: (Map Identifier (Set String))
_hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_hdOsynmap :: Attributes
_hdOterminaldefs :: (Set String)
_tlOallFromToStates :: (Map VisitIdentifier (Int,Int))
_tlOallInhmap :: (Map NontermIdent Attributes)
_tlOallInitStates :: (Map NontermIdent Int)
_tlOallSynmap :: (Map NontermIdent Attributes)
_tlOallVisitKinds :: (Map VisitIdentifier VisitKind)
_tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_tlOavisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlOavisituses :: (Map VisitIdentifier (Set Identifier))
_tlOchildTypes :: (Map Identifier Type)
_tlOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))))
_tlOcon :: ConstructorIdent
_tlOinhmap :: Attributes
_tlOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc))
_tlOnextVisits :: (Map StateIdentifier StateCtx)
_tlOnt :: NontermIdent
_tlOoptions :: Options
_tlOparams :: ([Identifier])
_tlOprevVisits :: (Map StateIdentifier StateCtx)
_tlOruledefs :: (Map Identifier (Set String))
_tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr)))
_tlOsynmap :: Attributes
_tlOterminaldefs :: (Set String)
_hdIallvisits :: ( VisitStateState )
_hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_hdIerrors :: (Seq Error)
_hdIfromToStates :: (Map VisitIdentifier (Int,Int))
_hdIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_hdIlazyIntras :: (Set String)
_hdIruleKinds :: (Map Identifier (Set VisitKind))
_hdIruleUsage :: (Map Identifier Int)
_hdIsem_visit :: ( (StateIdentifier,Bool -> PP_Doc) )
_hdIt_visits :: PP_Doc
_hdIvisitKinds :: (Map VisitIdentifier VisitKind)
_hdIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_hdIvisituses :: (Map VisitIdentifier (Set Identifier))
_tlIallvisits :: ([VisitStateState])
_tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_tlIerrors :: (Seq Error)
_tlIfromToStates :: (Map VisitIdentifier (Int,Int))
_tlIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_tlIlazyIntras :: (Set String)
_tlIruleKinds :: (Map Identifier (Set VisitKind))
_tlIruleUsage :: (Map Identifier Int)
_tlIsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] )
_tlIt_visits :: PP_Doc
_tlIvisitKinds :: (Map VisitIdentifier VisitKind)
_tlIvisitdefs :: (Map VisitIdentifier (Set Identifier))
_tlIvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOallvisits =
(
_hdIallvisits : _tlIallvisits
)
_lhsOchildvisit =
(
_hdIchildvisit `Map.union` _tlIchildvisit
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOfromToStates =
(
_hdIfromToStates `mappend` _tlIfromToStates
)
_lhsOintramap =
(
_hdIintramap `uwMapUnion` _tlIintramap
)
_lhsOlazyIntras =
(
_hdIlazyIntras `Set.union` _tlIlazyIntras
)
_lhsOruleKinds =
(
_hdIruleKinds `unionWithMappend` _tlIruleKinds
)
_lhsOruleUsage =
(
_hdIruleUsage `unionWithSum` _tlIruleUsage
)
_lhsOsem_visit =
(
_hdIsem_visit : _tlIsem_visit
)
_lhsOt_visits =
(
_hdIt_visits >-< _tlIt_visits
)
_lhsOvisitKinds =
(
_hdIvisitKinds `mappend` _tlIvisitKinds
)
_lhsOvisitdefs =
(
_hdIvisitdefs `uwSetUnion` _tlIvisitdefs
)
_lhsOvisituses =
(
_hdIvisituses `uwSetUnion` _tlIvisituses
)
_hdOallFromToStates =
(
_lhsIallFromToStates
)
_hdOallInhmap =
(
_lhsIallInhmap
)
_hdOallInitStates =
(
_lhsIallInitStates
)
_hdOallSynmap =
(
_lhsIallSynmap
)
_hdOallVisitKinds =
(
_lhsIallVisitKinds
)
_hdOallchildvisit =
(
_lhsIallchildvisit
)
_hdOallintramap =
(
_lhsIallintramap
)
_hdOavisitdefs =
(
_lhsIavisitdefs
)
_hdOavisituses =
(
_lhsIavisituses
)
_hdOchildTypes =
(
_lhsIchildTypes
)
_hdOchildintros =
(
_lhsIchildintros
)
_hdOcon =
(
_lhsIcon
)
_hdOinhmap =
(
_lhsIinhmap
)
_hdOmrules =
(
_lhsImrules
)
_hdOnextVisits =
(
_lhsInextVisits
)
_hdOnt =
(
_lhsInt
)
_hdOoptions =
(
_lhsIoptions
)
_hdOparams =
(
_lhsIparams
)
_hdOprevVisits =
(
_lhsIprevVisits
)
_hdOruledefs =
(
_lhsIruledefs
)
_hdOruleuses =
(
_lhsIruleuses
)
_hdOsynmap =
(
_lhsIsynmap
)
_hdOterminaldefs =
(
_lhsIterminaldefs
)
_tlOallFromToStates =
(
_lhsIallFromToStates
)
_tlOallInhmap =
(
_lhsIallInhmap
)
_tlOallInitStates =
(
_lhsIallInitStates
)
_tlOallSynmap =
(
_lhsIallSynmap
)
_tlOallVisitKinds =
(
_lhsIallVisitKinds
)
_tlOallchildvisit =
(
_lhsIallchildvisit
)
_tlOallintramap =
(
_lhsIallintramap
)
_tlOavisitdefs =
(
_lhsIavisitdefs
)
_tlOavisituses =
(
_lhsIavisituses
)
_tlOchildTypes =
(
_lhsIchildTypes
)
_tlOchildintros =
(
_lhsIchildintros
)
_tlOcon =
(
_lhsIcon
)
_tlOinhmap =
(
_lhsIinhmap
)
_tlOmrules =
(
_lhsImrules
)
_tlOnextVisits =
(
_lhsInextVisits
)
_tlOnt =
(
_lhsInt
)
_tlOoptions =
(
_lhsIoptions
)
_tlOparams =
(
_lhsIparams
)
_tlOprevVisits =
(
_lhsIprevVisits
)
_tlOruledefs =
(
_lhsIruledefs
)
_tlOruleuses =
(
_lhsIruleuses
)
_tlOsynmap =
(
_lhsIsynmap
)
_tlOterminaldefs =
(
_lhsIterminaldefs
)
( _hdIallvisits,_hdIchildvisit,_hdIerrors,_hdIfromToStates,_hdIintramap,_hdIlazyIntras,_hdIruleKinds,_hdIruleUsage,_hdIsem_visit,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) =
hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs
( _tlIallvisits,_tlIchildvisit,_tlIerrors,_tlIfromToStates,_tlIintramap,_tlIlazyIntras,_tlIruleKinds,_tlIruleUsage,_tlIsem_visit,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) =
tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))
sem_Visits_Nil :: T_Visits
sem_Visits_Nil =
(T_Visits (\ _lhsIallFromToStates
_lhsIallInhmap
_lhsIallInitStates
_lhsIallSynmap
_lhsIallVisitKinds
_lhsIallchildvisit
_lhsIallintramap
_lhsIavisitdefs
_lhsIavisituses
_lhsIchildTypes
_lhsIchildintros
_lhsIcon
_lhsIinhmap
_lhsImrules
_lhsInextVisits
_lhsInt
_lhsIoptions
_lhsIparams
_lhsIprevVisits
_lhsIruledefs
_lhsIruleuses
_lhsIsynmap
_lhsIterminaldefs ->
(let _lhsOallvisits :: ([VisitStateState])
_lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)))
_lhsOerrors :: (Seq Error)
_lhsOfromToStates :: (Map VisitIdentifier (Int,Int))
_lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr)))
_lhsOlazyIntras :: (Set String)
_lhsOruleKinds :: (Map Identifier (Set VisitKind))
_lhsOruleUsage :: (Map Identifier Int)
_lhsOsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] )
_lhsOt_visits :: PP_Doc
_lhsOvisitKinds :: (Map VisitIdentifier VisitKind)
_lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier))
_lhsOvisituses :: (Map VisitIdentifier (Set Identifier))
_lhsOallvisits =
(
[]
)
_lhsOchildvisit =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOfromToStates =
(
mempty
)
_lhsOintramap =
(
Map.empty
)
_lhsOlazyIntras =
(
Set.empty
)
_lhsOruleKinds =
(
Map.empty
)
_lhsOruleUsage =
(
Map.empty
)
_lhsOsem_visit =
(
[]
)
_lhsOt_visits =
(
empty
)
_lhsOvisitKinds =
(
mempty
)
_lhsOvisitdefs =
(
Map.empty
)
_lhsOvisituses =
(
Map.empty
)
in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses))))