uuagc-0.9.5: src-derived/GenerateCode.hs
-- UUAGC 0.9.5 (GenerateCode.ag)
module GenerateCode where
import SequentialTypes
import Code hiding (Type)
import qualified Code
import Options
import CodeSyntax
import ErrorMessages
import GrammarInfo
import DeclBlocks
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Set as Set
import Data.Set(Set)
import qualified UU.DData.Seq as Seq
import UU.DData.Seq(Seq)
import UU.Scanner.Position
import Data.List(partition,intersperse,intersect,(\\))
import Maybe(fromJust,isJust)
import Patterns
import CommonTypes
import Data.Map(Map)
import Data.Set(Set)
-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (Constructor,Name)
import Code (Decl,Expr)
substSelf nt tp = if tp==NT _SELF
then Haskell (getName nt)
else tp
mkLambda [] e = e
mkLambda xs e = Lambda xs e
-- dead code - replaced by mkPartitionedFunction
{-
localCpsToExpr :: Bool -> [Decl] -> DeclBlocks -> Expr
localCpsToExpr o_case nextVisitDecl
= rec
where
rec cps
= case cps of
DeclTerminator decls expr
-> mkLet o_case (decls ++ nextVisitDecl) expr
DeclBlock decls (Decl lhs rhs _ _) remainder
-> let inDecls = [ PragmaDecl ("NOINLINE " ++ internalCpsName)
, Decl (Fun internalCpsName [SimpleExpr internalCpsVarName])
(mkLet o_case [Decl lhs (SimpleExpr internalCpsVarName) Set.empty Set.empty] (rec remainder))
Set.empty Set.empty
]
inBody = App "head" [App "(:)" [App internalCpsName [rhs], App "(:)" [App internalCpsName [rhs], SimpleExpr "[]"]]]
outerBody = Let inDecls inBody
block = mkLet o_case decls outerBody
in block
internalCpsName :: String
internalCpsName = "internalCps_"
internalCpsVarName :: String
internalCpsVarName = "internalCps_var_"
-}
mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr)
mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree
= let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix
, optCase_Inh_DeclBlocksRoot = optCase
, nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls
, lastExprVars_Inh_DeclBlocksRoot = lastExprVars
}
sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree)
syn = wrap_DeclBlocksRoot sem inh
in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn)
freevars :: [String] -> [Decl] -> [String]
freevars additional decls
= Set.toList (allused `Set.difference` alldefined)
where
allused = Set.unions (Set.fromList additional : map usedvars decls)
alldefined = Set.unions (map definedvars decls)
usedvars (Decl _ _ _ uses) = uses
usedvars _ = Set.empty
definedvars (Decl _ _ defs _) = defs
definedvars _ = Set.empty
mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl
mkBlockLambda optCase name args decls expr
= Decl lhs rhs Set.empty Set.empty
where
lhs = Fun name (map SimpleExpr args)
rhs = mkLet optCase decls expr
makeLocalComment :: Int -> String -> Name -> Maybe Type -> String
makeLocalComment width what name tp = let x = getName name
y = maybe "_" (\t -> case t of (NT nt) -> getName nt; Haskell t -> '{':t++"}") tp
in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y )
-- Lets or nested Cases?
mkLet :: Bool -> Decls -> Expr -> Expr
mkLet False decls body = Let decls body
mkLet True decls body = foldr oneCase body decls
oneCase :: Decl -> Expr -> Expr
oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp]
oneCase _ exp = exp
-- Gives the name of the visit function
funname field 0 = show field ++ "_"
funname field nr = show field ++ "_" ++ show nr
-- Gives the name of a semantic function
seqSemname :: String -> Nonterminal -> Constructor -> Int -> String
seqSemname pre nt con 0 = semname pre nt con
seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr
-- Gives the name of a type
typeName :: Nonterminal -> Int -> String
typeName nt 0 = "T_" ++ show nt
typeName nt n = "T_" ++ show nt ++ "_" ++ show n
-- Gives the name of a visit function
visitname :: String -> Nonterminal -> Int -> String
visitname pre nt n = pre ++ getName nt ++ "_" ++ show n
-- CAlternative ------------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
inh : Attributes
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
with_sig : Bool
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
cataAlt : Decl
comments : [String]
dataAlt : DataAlt
decls : Decls
semNames : [String]
alternatives:
alternative CAlternative:
child con : {Constructor}
child visits : CVisits
child children : {[(Name,Type,Bool)]}
child terminals : {[Name]}
visit 0:
local firstOrderChildren : _
-}
-- cata
sem_CAlternative :: CAlternative ->
T_CAlternative
sem_CAlternative (CAlternative _con _visits _children _terminals ) =
(sem_CAlternative_CAlternative _con (sem_CVisits _visits ) _children _terminals )
-- semantic domain
newtype T_CAlternative = T_CAlternative (PragmaMap ->
(Seq Error) ->
Attributes ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
Bool ->
( Bool,Decl,([String]),DataAlt,Decls,(Seq Error),([String])))
data Inh_CAlternative = Inh_CAlternative {allPragmas_Inh_CAlternative :: PragmaMap,errors_Inh_CAlternative :: Seq Error,inh_Inh_CAlternative :: Attributes,nt_Inh_CAlternative :: Nonterminal,o_case_Inh_CAlternative :: Bool,o_cata_Inh_CAlternative :: Bool,o_costcentre_Inh_CAlternative :: Bool,o_data_Inh_CAlternative :: Maybe Bool,o_linePragmas_Inh_CAlternative :: Bool,o_newtypes_Inh_CAlternative :: Bool,o_pretty_Inh_CAlternative :: Bool,o_rename_Inh_CAlternative :: Bool,o_sem_Inh_CAlternative :: Bool,o_sig_Inh_CAlternative :: Bool,o_splitsems_Inh_CAlternative :: Bool,o_strictwrap_Inh_CAlternative :: Bool,o_traces_Inh_CAlternative :: Bool,o_unbox_Inh_CAlternative :: Bool,prefix_Inh_CAlternative :: String,syn_Inh_CAlternative :: Attributes,with_sig_Inh_CAlternative :: Bool}
data Syn_CAlternative = Syn_CAlternative {allTpsFound_Syn_CAlternative :: Bool,cataAlt_Syn_CAlternative :: Decl,comments_Syn_CAlternative :: [String],dataAlt_Syn_CAlternative :: DataAlt,decls_Syn_CAlternative :: Decls,errors_Syn_CAlternative :: Seq Error,semNames_Syn_CAlternative :: [String]}
wrap_CAlternative (T_CAlternative sem ) (Inh_CAlternative _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig ) =
(let ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =
(sem _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig )
in (Syn_CAlternative _lhsOallTpsFound _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOerrors _lhsOsemNames ))
sem_CAlternative_CAlternative :: Constructor ->
T_CVisits ->
([(Name,Type,Bool)]) ->
([Name]) ->
T_CAlternative
sem_CAlternative_CAlternative con_ (T_CVisits visits_ ) children_ terminals_ =
(T_CAlternative (\ _lhsIallPragmas
_lhsIerrors
_lhsIinh
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIwith_sig ->
(let _visitsOcon :: Constructor
_visitsOterminals :: ([Name])
_visitsOnr :: Int
_visitsOchildren :: ([(Name,Type,Bool)])
_visitsOinstVisitNrs :: (Map Identifier Int)
_lhsOcomments :: ([String])
_lhsOdataAlt :: DataAlt
_lhsOcataAlt :: Decl
_lhsOallTpsFound :: Bool
_lhsOdecls :: Decls
_lhsOerrors :: (Seq Error)
_lhsOsemNames :: ([String])
_visitsOallPragmas :: PragmaMap
_visitsOerrors :: (Seq Error)
_visitsOinh :: Attributes
_visitsOnt :: Nonterminal
_visitsOo_case :: Bool
_visitsOo_cata :: Bool
_visitsOo_costcentre :: Bool
_visitsOo_data :: (Maybe Bool)
_visitsOo_linePragmas :: Bool
_visitsOo_newtypes :: Bool
_visitsOo_pretty :: Bool
_visitsOo_rename :: Bool
_visitsOo_sem :: Bool
_visitsOo_sig :: Bool
_visitsOo_splitsems :: Bool
_visitsOo_strictwrap :: Bool
_visitsOo_traces :: Bool
_visitsOo_unbox :: Bool
_visitsOprefix :: String
_visitsOsyn :: Attributes
_visitsOwith_sig :: Bool
_visitsIallTpsFound :: Bool
_visitsIcomments :: ([String])
_visitsIdecls :: Decls
_visitsIerrors :: (Seq Error)
_visitsIgatherInstVisitNrs :: (Map Identifier Int)
_visitsIintra :: Exprs
_visitsIintraVars :: (Set String)
_visitsIisNil :: Bool
_visitsIsemNames :: ([String])
-- "GenerateCode.ag"(line 78, column 20)
_visitsOcon =
con_
-- "GenerateCode.ag"(line 79, column 20)
_visitsOterminals =
terminals_
-- "GenerateCode.ag"(line 159, column 19)
_visitsOnr =
0
-- "GenerateCode.ag"(line 261, column 19)
_visitsOchildren =
children_
-- "GenerateCode.ag"(line 349, column 7)
_visitsOinstVisitNrs =
_visitsIgatherInstVisitNrs
-- "GenerateCode.ag"(line 594, column 18)
_firstOrderChildren =
filter (\(_,_,ho) -> not ho) children_
-- "GenerateCode.ag"(line 595, column 18)
_lhsOcomments =
("alternative " ++ getName con_ ++ ":")
: map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren
++ _visitsIcomments
)
-- "GenerateCode.ag"(line 704, column 19)
_lhsOdataAlt =
DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToString _lhsInt t) _firstOrderChildren )
-- "GenerateCode.ag"(line 759, column 18)
_lhsOcataAlt =
let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat]
lhs_pat = App (conname _lhsIo_rename _lhsInt con_)
(map (\(n,_,_) -> SimpleExpr $ locname $ n) _firstOrderChildren )
rhs = App (semname _lhsIprefix _lhsInt con_)
(map argument _firstOrderChildren )
argument (nm,NT tp,_) = App (cataname _lhsIprefix tp)
[SimpleExpr (locname nm)]
argument (nm, _,_) = SimpleExpr (locname nm)
in Decl lhs rhs Set.empty Set.empty
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
_visitsIallTpsFound
-- use rule "GenerateCode.ag"(line 626, column 46)
_lhsOdecls =
_visitsIdecls
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_visitsIerrors
-- use rule "GenerateCode.ag"(line 774, column 63)
_lhsOsemNames =
_visitsIsemNames
-- copy rule (down)
_visitsOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_visitsOerrors =
_lhsIerrors
-- copy rule (down)
_visitsOinh =
_lhsIinh
-- copy rule (down)
_visitsOnt =
_lhsInt
-- copy rule (down)
_visitsOo_case =
_lhsIo_case
-- copy rule (down)
_visitsOo_cata =
_lhsIo_cata
-- copy rule (down)
_visitsOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_visitsOo_data =
_lhsIo_data
-- copy rule (down)
_visitsOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_visitsOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_visitsOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_visitsOo_rename =
_lhsIo_rename
-- copy rule (down)
_visitsOo_sem =
_lhsIo_sem
-- copy rule (down)
_visitsOo_sig =
_lhsIo_sig
-- copy rule (down)
_visitsOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_visitsOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_visitsOo_traces =
_lhsIo_traces
-- copy rule (down)
_visitsOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_visitsOprefix =
_lhsIprefix
-- copy rule (down)
_visitsOsyn =
_lhsIsyn
-- copy rule (down)
_visitsOwith_sig =
_lhsIwith_sig
( _visitsIallTpsFound,_visitsIcomments,_visitsIdecls,_visitsIerrors,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames) =
(visits_ _visitsOallPragmas _visitsOchildren _visitsOcon _visitsOerrors _visitsOinh _visitsOinstVisitNrs _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOprefix _visitsOsyn _visitsOterminals _visitsOwith_sig )
in ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )
-- CAlternatives -----------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
inh : Attributes
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
with_sig : Bool
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
cataAlts : Decls
comments : [String]
dataAlts : DataAlts
decls : Decls
semNames : [String]
alternatives:
alternative Cons:
child hd : CAlternative
child tl : CAlternatives
alternative Nil:
-}
-- cata
sem_CAlternatives :: CAlternatives ->
T_CAlternatives
sem_CAlternatives list =
(Prelude.foldr sem_CAlternatives_Cons sem_CAlternatives_Nil (Prelude.map sem_CAlternative list) )
-- semantic domain
newtype T_CAlternatives = T_CAlternatives (PragmaMap ->
(Seq Error) ->
Attributes ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
Bool ->
( Bool,Decls,([String]),DataAlts,Decls,(Seq Error),([String])))
data Inh_CAlternatives = Inh_CAlternatives {allPragmas_Inh_CAlternatives :: PragmaMap,errors_Inh_CAlternatives :: Seq Error,inh_Inh_CAlternatives :: Attributes,nt_Inh_CAlternatives :: Nonterminal,o_case_Inh_CAlternatives :: Bool,o_cata_Inh_CAlternatives :: Bool,o_costcentre_Inh_CAlternatives :: Bool,o_data_Inh_CAlternatives :: Maybe Bool,o_linePragmas_Inh_CAlternatives :: Bool,o_newtypes_Inh_CAlternatives :: Bool,o_pretty_Inh_CAlternatives :: Bool,o_rename_Inh_CAlternatives :: Bool,o_sem_Inh_CAlternatives :: Bool,o_sig_Inh_CAlternatives :: Bool,o_splitsems_Inh_CAlternatives :: Bool,o_strictwrap_Inh_CAlternatives :: Bool,o_traces_Inh_CAlternatives :: Bool,o_unbox_Inh_CAlternatives :: Bool,prefix_Inh_CAlternatives :: String,syn_Inh_CAlternatives :: Attributes,with_sig_Inh_CAlternatives :: Bool}
data Syn_CAlternatives = Syn_CAlternatives {allTpsFound_Syn_CAlternatives :: Bool,cataAlts_Syn_CAlternatives :: Decls,comments_Syn_CAlternatives :: [String],dataAlts_Syn_CAlternatives :: DataAlts,decls_Syn_CAlternatives :: Decls,errors_Syn_CAlternatives :: Seq Error,semNames_Syn_CAlternatives :: [String]}
wrap_CAlternatives (T_CAlternatives sem ) (Inh_CAlternatives _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig ) =
(let ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =
(sem _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig )
in (Syn_CAlternatives _lhsOallTpsFound _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOerrors _lhsOsemNames ))
sem_CAlternatives_Cons :: T_CAlternative ->
T_CAlternatives ->
T_CAlternatives
sem_CAlternatives_Cons (T_CAlternative hd_ ) (T_CAlternatives tl_ ) =
(T_CAlternatives (\ _lhsIallPragmas
_lhsIerrors
_lhsIinh
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIwith_sig ->
(let _lhsOdataAlts :: DataAlts
_lhsOcataAlts :: Decls
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOerrors :: (Seq Error)
_lhsOsemNames :: ([String])
_hdOallPragmas :: PragmaMap
_hdOerrors :: (Seq Error)
_hdOinh :: Attributes
_hdOnt :: Nonterminal
_hdOo_case :: Bool
_hdOo_cata :: Bool
_hdOo_costcentre :: Bool
_hdOo_data :: (Maybe Bool)
_hdOo_linePragmas :: Bool
_hdOo_newtypes :: Bool
_hdOo_pretty :: Bool
_hdOo_rename :: Bool
_hdOo_sem :: Bool
_hdOo_sig :: Bool
_hdOo_splitsems :: Bool
_hdOo_strictwrap :: Bool
_hdOo_traces :: Bool
_hdOo_unbox :: Bool
_hdOprefix :: String
_hdOsyn :: Attributes
_hdOwith_sig :: Bool
_tlOallPragmas :: PragmaMap
_tlOerrors :: (Seq Error)
_tlOinh :: Attributes
_tlOnt :: Nonterminal
_tlOo_case :: Bool
_tlOo_cata :: Bool
_tlOo_costcentre :: Bool
_tlOo_data :: (Maybe Bool)
_tlOo_linePragmas :: Bool
_tlOo_newtypes :: Bool
_tlOo_pretty :: Bool
_tlOo_rename :: Bool
_tlOo_sem :: Bool
_tlOo_sig :: Bool
_tlOo_splitsems :: Bool
_tlOo_strictwrap :: Bool
_tlOo_traces :: Bool
_tlOo_unbox :: Bool
_tlOprefix :: String
_tlOsyn :: Attributes
_tlOwith_sig :: Bool
_hdIallTpsFound :: Bool
_hdIcataAlt :: Decl
_hdIcomments :: ([String])
_hdIdataAlt :: DataAlt
_hdIdecls :: Decls
_hdIerrors :: (Seq Error)
_hdIsemNames :: ([String])
_tlIallTpsFound :: Bool
_tlIcataAlts :: Decls
_tlIcomments :: ([String])
_tlIdataAlts :: DataAlts
_tlIdecls :: Decls
_tlIerrors :: (Seq Error)
_tlIsemNames :: ([String])
-- "GenerateCode.ag"(line 700, column 17)
_lhsOdataAlts =
_hdIdataAlt : _tlIdataAlts
-- "GenerateCode.ag"(line 755, column 10)
_lhsOcataAlts =
_hdIcataAlt : _tlIcataAlts
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
_hdIallTpsFound && _tlIallTpsFound
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
_hdIcomments ++ _tlIcomments
-- use rule "GenerateCode.ag"(line 626, column 46)
_lhsOdecls =
_hdIdecls ++ _tlIdecls
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- use rule "GenerateCode.ag"(line 774, column 63)
_lhsOsemNames =
_hdIsemNames ++ _tlIsemNames
-- copy rule (down)
_hdOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_hdOerrors =
_lhsIerrors
-- copy rule (down)
_hdOinh =
_lhsIinh
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOo_case =
_lhsIo_case
-- copy rule (down)
_hdOo_cata =
_lhsIo_cata
-- copy rule (down)
_hdOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_hdOo_data =
_lhsIo_data
-- copy rule (down)
_hdOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_hdOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_hdOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_hdOo_rename =
_lhsIo_rename
-- copy rule (down)
_hdOo_sem =
_lhsIo_sem
-- copy rule (down)
_hdOo_sig =
_lhsIo_sig
-- copy rule (down)
_hdOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_hdOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_hdOo_traces =
_lhsIo_traces
-- copy rule (down)
_hdOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_hdOprefix =
_lhsIprefix
-- copy rule (down)
_hdOsyn =
_lhsIsyn
-- copy rule (down)
_hdOwith_sig =
_lhsIwith_sig
-- copy rule (down)
_tlOallPragmas =
_lhsIallPragmas
-- copy rule (chain)
_tlOerrors =
_hdIerrors
-- copy rule (down)
_tlOinh =
_lhsIinh
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOo_case =
_lhsIo_case
-- copy rule (down)
_tlOo_cata =
_lhsIo_cata
-- copy rule (down)
_tlOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_tlOo_data =
_lhsIo_data
-- copy rule (down)
_tlOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_tlOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_tlOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_tlOo_rename =
_lhsIo_rename
-- copy rule (down)
_tlOo_sem =
_lhsIo_sem
-- copy rule (down)
_tlOo_sig =
_lhsIo_sig
-- copy rule (down)
_tlOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_tlOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_tlOo_traces =
_lhsIo_traces
-- copy rule (down)
_tlOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_tlOprefix =
_lhsIprefix
-- copy rule (down)
_tlOsyn =
_lhsIsyn
-- copy rule (down)
_tlOwith_sig =
_lhsIwith_sig
( _hdIallTpsFound,_hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIerrors,_hdIsemNames) =
(hd_ _hdOallPragmas _hdOerrors _hdOinh _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOwith_sig )
( _tlIallTpsFound,_tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIerrors,_tlIsemNames) =
(tl_ _tlOallPragmas _tlOerrors _tlOinh _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOwith_sig )
in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )
sem_CAlternatives_Nil :: T_CAlternatives
sem_CAlternatives_Nil =
(T_CAlternatives (\ _lhsIallPragmas
_lhsIerrors
_lhsIinh
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIwith_sig ->
(let _lhsOdataAlts :: DataAlts
_lhsOcataAlts :: Decls
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOerrors :: (Seq Error)
_lhsOsemNames :: ([String])
-- "GenerateCode.ag"(line 701, column 17)
_lhsOdataAlts =
[]
-- "GenerateCode.ag"(line 756, column 10)
_lhsOcataAlts =
[]
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
True
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
[]
-- use rule "GenerateCode.ag"(line 626, column 46)
_lhsOdecls =
[]
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
Seq.empty
-- use rule "GenerateCode.ag"(line 774, column 63)
_lhsOsemNames =
[]
in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )
-- CGrammar ----------------------------------------------------
{-
visit 0:
inherited attribute:
options : Options
synthesized attributes:
errors : Seq Error
output : Program
alternatives:
alternative CGrammar:
child typeSyns : {TypeSyns}
child derivings : {Derivings}
child wrappers : {Set Nonterminal}
child prods : CProductions
child pragmas : {PragmaMap}
-}
-- cata
sem_CGrammar :: CGrammar ->
T_CGrammar
sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _prods _pragmas ) =
(sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CProductions _prods ) _pragmas )
-- semantic domain
newtype T_CGrammar = T_CGrammar (Options ->
( (Seq Error),Program))
data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: Options}
data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: Seq Error,output_Syn_CGrammar :: Program}
wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar _lhsIoptions ) =
(let ( _lhsOerrors,_lhsOoutput) =
(sem _lhsIoptions )
in (Syn_CGrammar _lhsOerrors _lhsOoutput ))
sem_CGrammar_CGrammar :: TypeSyns ->
Derivings ->
(Set Nonterminal) ->
T_CProductions ->
PragmaMap ->
T_CGrammar
sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CProductions prods_ ) pragmas_ =
(T_CGrammar (\ _lhsIoptions ->
(let _prodsOo_sig :: Bool
_prodsOo_cata :: Bool
_prodsOo_sem :: Bool
_prodsOo_newtypes :: Bool
_prodsOo_unbox :: Bool
_prodsOo_case :: Bool
_prodsOo_pretty :: Bool
_prodsOo_rename :: Bool
_prodsOo_strictwrap :: Bool
_prodsOo_splitsems :: Bool
_prodsOo_data :: (Maybe Bool)
_prodsOprefix :: String
_prodsOo_traces :: Bool
_prodsOo_costcentre :: Bool
_prodsOo_linePragmas :: Bool
_prodsOallPragmas :: PragmaMap
_prodsOwith_sig :: Bool
_prodsOerrors :: (Seq Error)
_lhsOoutput :: Program
_prodsOtypeSyns :: TypeSyns
_prodsOderivings :: Derivings
_prodsOwrappers :: (Set Nonterminal)
_lhsOerrors :: (Seq Error)
_prodsIallTpsFound :: Bool
_prodsIchunks :: Chunks
_prodsIerrors :: (Seq Error)
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_sig =
typeSigs _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_cata =
folds _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_sem =
semfuns _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_newtypes =
newtypes _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_unbox =
unbox _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_case =
cases _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_pretty =
attrInfo _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_rename =
rename _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_strictwrap =
strictWrap _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_splitsems =
splitSems _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_data =
if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing
-- "GenerateCode.ag"(line 43, column 17)
_prodsOprefix =
prefix _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_traces =
genTraces _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_costcentre =
genCostCentres _lhsIoptions
-- "GenerateCode.ag"(line 43, column 17)
_prodsOo_linePragmas =
genLinePragmas _lhsIoptions
-- "GenerateCode.ag"(line 62, column 15)
_prodsOallPragmas =
pragmas_
-- "GenerateCode.ag"(line 559, column 14)
_prodsOwith_sig =
typeSigs _lhsIoptions && _prodsIallTpsFound
-- "GenerateCode.ag"(line 566, column 15)
_prodsOerrors =
Seq.empty
-- "GenerateCode.ag"(line 630, column 17)
_lhsOoutput =
Program _prodsIchunks
-- "GenerateCode.ag"(line 679, column 14)
_prodsOtypeSyns =
typeSyns_
-- "GenerateCode.ag"(line 679, column 14)
_prodsOderivings =
derivings_
-- "GenerateCode.ag"(line 679, column 14)
_prodsOwrappers =
wrappers_
-- copy rule (up)
_lhsOerrors =
_prodsIerrors
( _prodsIallTpsFound,_prodsIchunks,_prodsIerrors) =
(prods_ _prodsOallPragmas _prodsOderivings _prodsOerrors _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOprefix _prodsOtypeSyns _prodsOwith_sig _prodsOwrappers )
in ( _lhsOerrors,_lhsOoutput))) )
-- CInterface --------------------------------------------------
{-
visit 0:
inherited attributes:
inh : Attributes
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
synthesized attributes:
comments : [String]
semDom : [Decl]
wrapDecls : Decls
alternatives:
alternative CInterface:
child seg : CSegments
-}
-- cata
sem_CInterface :: CInterface ->
T_CInterface
sem_CInterface (CInterface _seg ) =
(sem_CInterface_CInterface (sem_CSegments _seg ) )
-- semantic domain
newtype T_CInterface = T_CInterface (Attributes ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
( ([String]),([Decl]),Decls))
data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: Attributes,nt_Inh_CInterface :: Nonterminal,o_case_Inh_CInterface :: Bool,o_cata_Inh_CInterface :: Bool,o_costcentre_Inh_CInterface :: Bool,o_data_Inh_CInterface :: Maybe Bool,o_linePragmas_Inh_CInterface :: Bool,o_newtypes_Inh_CInterface :: Bool,o_pretty_Inh_CInterface :: Bool,o_rename_Inh_CInterface :: Bool,o_sem_Inh_CInterface :: Bool,o_sig_Inh_CInterface :: Bool,o_splitsems_Inh_CInterface :: Bool,o_strictwrap_Inh_CInterface :: Bool,o_traces_Inh_CInterface :: Bool,o_unbox_Inh_CInterface :: Bool,prefix_Inh_CInterface :: String,syn_Inh_CInterface :: Attributes}
data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: [String],semDom_Syn_CInterface :: [Decl],wrapDecls_Syn_CInterface :: Decls}
wrap_CInterface (T_CInterface sem ) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =
(let ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls) =
(sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )
in (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOwrapDecls ))
sem_CInterface_CInterface :: T_CSegments ->
T_CInterface
sem_CInterface_CInterface (T_CSegments seg_ ) =
(T_CInterface (\ _lhsIinh
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn ->
(let _segOnr :: Int
_lhsOsemDom :: ([Decl])
_lhsOcomments :: ([String])
_lhsOwrapDecls :: Decls
_segOinh :: Attributes
_segOnt :: Nonterminal
_segOo_case :: Bool
_segOo_cata :: Bool
_segOo_costcentre :: Bool
_segOo_data :: (Maybe Bool)
_segOo_linePragmas :: Bool
_segOo_newtypes :: Bool
_segOo_pretty :: Bool
_segOo_rename :: Bool
_segOo_sem :: Bool
_segOo_sig :: Bool
_segOo_splitsems :: Bool
_segOo_strictwrap :: Bool
_segOo_traces :: Bool
_segOo_unbox :: Bool
_segOprefix :: String
_segOsyn :: Attributes
_segIcomments :: ([String])
_segIisNil :: Bool
_segIsemDom :: ([Decl])
_segIwrapDecls :: Decls
-- "GenerateCode.ag"(line 163, column 17)
_segOnr =
0
-- "GenerateCode.ag"(line 493, column 18)
_lhsOsemDom =
Comment "semantic domain" : _segIsemDom
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
_segIcomments
-- use rule "GenerateCode.ag"(line 532, column 52)
_lhsOwrapDecls =
_segIwrapDecls
-- copy rule (down)
_segOinh =
_lhsIinh
-- copy rule (down)
_segOnt =
_lhsInt
-- copy rule (down)
_segOo_case =
_lhsIo_case
-- copy rule (down)
_segOo_cata =
_lhsIo_cata
-- copy rule (down)
_segOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_segOo_data =
_lhsIo_data
-- copy rule (down)
_segOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_segOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_segOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_segOo_rename =
_lhsIo_rename
-- copy rule (down)
_segOo_sem =
_lhsIo_sem
-- copy rule (down)
_segOo_sig =
_lhsIo_sig
-- copy rule (down)
_segOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_segOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_segOo_traces =
_lhsIo_traces
-- copy rule (down)
_segOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_segOprefix =
_lhsIprefix
-- copy rule (down)
_segOsyn =
_lhsIsyn
( _segIcomments,_segIisNil,_segIsemDom,_segIwrapDecls) =
(seg_ _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOprefix _segOsyn )
in ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls))) )
-- CProduction -------------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
derivings : Derivings
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
typeSyns : TypeSyns
with_sig : Bool
wrappers : Set Nonterminal
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
chunks : Chunks
alternatives:
alternative CProduction:
child nt : {Nonterminal}
child inh : {Attributes}
child syn : {Attributes}
child alts : CAlternatives
child inter : CInterface
visit 0:
local _tup1 : {(Attributes,Attributes,Nonterminal)}
local _tup2 : {(Attributes,Attributes,Nonterminal)}
local semWrapper : _
local comment : _
local dataDef : _
local cataFun : _
-}
-- cata
sem_CProduction :: CProduction ->
T_CProduction
sem_CProduction (CProduction _nt _inh _syn _alts _inter ) =
(sem_CProduction_CProduction _nt _inh _syn (sem_CAlternatives _alts ) (sem_CInterface _inter ) )
-- semantic domain
newtype T_CProduction = T_CProduction (PragmaMap ->
Derivings ->
(Seq Error) ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
TypeSyns ->
Bool ->
(Set Nonterminal) ->
( Bool,Chunks,(Seq Error)))
data Inh_CProduction = Inh_CProduction {allPragmas_Inh_CProduction :: PragmaMap,derivings_Inh_CProduction :: Derivings,errors_Inh_CProduction :: Seq Error,o_case_Inh_CProduction :: Bool,o_cata_Inh_CProduction :: Bool,o_costcentre_Inh_CProduction :: Bool,o_data_Inh_CProduction :: Maybe Bool,o_linePragmas_Inh_CProduction :: Bool,o_newtypes_Inh_CProduction :: Bool,o_pretty_Inh_CProduction :: Bool,o_rename_Inh_CProduction :: Bool,o_sem_Inh_CProduction :: Bool,o_sig_Inh_CProduction :: Bool,o_splitsems_Inh_CProduction :: Bool,o_strictwrap_Inh_CProduction :: Bool,o_traces_Inh_CProduction :: Bool,o_unbox_Inh_CProduction :: Bool,prefix_Inh_CProduction :: String,typeSyns_Inh_CProduction :: TypeSyns,with_sig_Inh_CProduction :: Bool,wrappers_Inh_CProduction :: Set Nonterminal}
data Syn_CProduction = Syn_CProduction {allTpsFound_Syn_CProduction :: Bool,chunks_Syn_CProduction :: Chunks,errors_Syn_CProduction :: Seq Error}
wrap_CProduction (T_CProduction sem ) (Inh_CProduction _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers ) =
(let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors) =
(sem _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers )
in (Syn_CProduction _lhsOallTpsFound _lhsOchunks _lhsOerrors ))
sem_CProduction_CProduction :: Nonterminal ->
Attributes ->
Attributes ->
T_CAlternatives ->
T_CInterface ->
T_CProduction
sem_CProduction_CProduction nt_ inh_ syn_ (T_CAlternatives alts_ ) (T_CInterface inter_ ) =
(T_CProduction (\ _lhsIallPragmas
_lhsIderivings
_lhsIerrors
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsItypeSyns
_lhsIwith_sig
_lhsIwrappers ->
(let __tup1 :: ((Attributes,Attributes,Nonterminal))
_interOinh :: Attributes
_interOsyn :: Attributes
_interOnt :: Nonterminal
__tup2 :: ((Attributes,Attributes,Nonterminal))
_altsOinh :: Attributes
_altsOsyn :: Attributes
_altsOnt :: Nonterminal
_lhsOchunks :: Chunks
_lhsOallTpsFound :: Bool
_lhsOerrors :: (Seq Error)
_altsOallPragmas :: PragmaMap
_altsOerrors :: (Seq Error)
_altsOo_case :: Bool
_altsOo_cata :: Bool
_altsOo_costcentre :: Bool
_altsOo_data :: (Maybe Bool)
_altsOo_linePragmas :: Bool
_altsOo_newtypes :: Bool
_altsOo_pretty :: Bool
_altsOo_rename :: Bool
_altsOo_sem :: Bool
_altsOo_sig :: Bool
_altsOo_splitsems :: Bool
_altsOo_strictwrap :: Bool
_altsOo_traces :: Bool
_altsOo_unbox :: Bool
_altsOprefix :: String
_altsOwith_sig :: Bool
_interOo_case :: Bool
_interOo_cata :: Bool
_interOo_costcentre :: Bool
_interOo_data :: (Maybe Bool)
_interOo_linePragmas :: Bool
_interOo_newtypes :: Bool
_interOo_pretty :: Bool
_interOo_rename :: Bool
_interOo_sem :: Bool
_interOo_sig :: Bool
_interOo_splitsems :: Bool
_interOo_strictwrap :: Bool
_interOo_traces :: Bool
_interOo_unbox :: Bool
_interOprefix :: String
_altsIallTpsFound :: Bool
_altsIcataAlts :: Decls
_altsIcomments :: ([String])
_altsIdataAlts :: DataAlts
_altsIdecls :: Decls
_altsIerrors :: (Seq Error)
_altsIsemNames :: ([String])
_interIcomments :: ([String])
_interIsemDom :: ([Decl])
_interIwrapDecls :: Decls
-- "GenerateCode.ag"(line 72, column 25)
__tup1 =
(inh_,syn_,nt_)
-- "GenerateCode.ag"(line 72, column 25)
(_interOinh,_,_) =
__tup1
-- "GenerateCode.ag"(line 72, column 25)
(_,_interOsyn,_) =
__tup1
-- "GenerateCode.ag"(line 72, column 25)
(_,_,_interOnt) =
__tup1
-- "GenerateCode.ag"(line 73, column 24)
__tup2 =
(inh_,syn_,nt_)
-- "GenerateCode.ag"(line 73, column 24)
(_altsOinh,_,_) =
__tup2
-- "GenerateCode.ag"(line 73, column 24)
(_,_altsOsyn,_) =
__tup2
-- "GenerateCode.ag"(line 73, column 24)
(_,_,_altsOnt) =
__tup2
-- "GenerateCode.ag"(line 512, column 17)
_semWrapper =
let inhAttrs = Map.toList inh_
synAttrs = Map.toList syn_
inhVars = [ SimpleExpr (attrname True _LHS a) | (a,_) <- inhAttrs ]
synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ]
var = "sem"
wrapNT = "wrap" ++ "_" ++ getName nt_
inhNT = "Inh" ++ "_" ++ getName nt_
synNT = "Syn" ++ "_" ++ getName nt_
varPat = if _lhsIo_newtypes
then App (sdtype nt_) [SimpleExpr var]
else SimpleExpr var
typeSig = TSig wrapNT (SimpleType (sdtype nt_) `Arr` (SimpleType inhNT `Arr` SimpleType synNT))
mkstrict = if _lhsIo_strictwrap then (\x -> "!(" ++ x ++ ")") else id
mkdata n attrs = Data n [Record n [(getName f++"_"++n,mkstrict $ typeToString nt_ t) | (f,t) <- attrs]] False []
datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs]
in datas ++ [ Decl (Fun wrapNT [varPat, App inhNT inhVars])
(Let _interIwrapDecls (App synNT synVars))
Set.empty Set.empty
]
-- "GenerateCode.ag"(line 579, column 17)
_comment =
Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _altsIcomments) )
-- "GenerateCode.ag"(line 633, column 18)
_lhsOchunks =
[ Chunk (getName nt_)
(Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-'))
(if _lhsIo_pretty then [_comment ] else [])
(if isJust _lhsIo_data then [_dataDef ] else [])
(if _lhsIo_cata then _cataFun else [])
(if _lhsIo_sig then _interIsemDom else [])
(if nt_ `Set.member` _lhsIwrappers then _semWrapper else [])
(if _lhsIo_sem then _altsIdecls else [])
(if _lhsIo_sem then _altsIsemNames else [])
]
-- "GenerateCode.ag"(line 684, column 17)
_dataDef =
let typeSyn tp = let theType =
case tp of
CommonTypes.Maybe t -> SimpleType ("Maybe (" ++ typeToString nt_ t ++")")
CommonTypes.List t -> Code.List $ SimpleType (typeToString nt_ t)
CommonTypes.Tuple ts -> Code.TupleType [SimpleType (typeToString nt_ t)
| (_,t) <- ts
]
in Code.Type (getName nt_) theType
derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings)
dataDef = Data (getName nt_) _altsIdataAlts (maybe False id _lhsIo_data) derivings
in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns
-- "GenerateCode.ag"(line 711, column 17)
_cataFun =
let tSig = TSig (cataname _lhsIprefix nt_)
(SimpleType (getName nt_) `Arr` SimpleType (sdtype nt_))
special typ = case typ of
CommonTypes.List tp ->
let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons"))
nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" ))
arg = SimpleExpr "list"
rarg = case tp of
NT t -> SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t) ++ " list)")
_ -> arg
lhs = Fun (cataname _lhsIprefix nt_) [arg]
rhs = (App "Prelude.foldr" [cons,nil,rarg])
in [Decl lhs rhs Set.empty Set.empty]
CommonTypes.Maybe tp ->
let just = semname _lhsIprefix nt_ (identifier "Just")
nothing = semname _lhsIprefix nt_ (identifier "Nothing" )
arg = SimpleExpr "x"
rarg = case tp of
NT t -> App (cataname _lhsIprefix t) [arg]
_ -> arg
lhs a = Fun (cataname _lhsIprefix nt_) [a]
in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty
,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty
]
CommonTypes.Tuple tps ->
let con = semname _lhsIprefix nt_ (identifier "Tuple")
tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps]
rargs = map rarg tps'
rarg (n, tp) = case tp of
NT t -> App (cataname _lhsIprefix t) [n]
_ -> n
lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')]
rhs = App con rargs
in [Decl lhs rhs Set.empty Set.empty]
in Comment "cata" :
(if _lhsIo_sig then [tSig] else []) ++
maybe _altsIcataAlts special (lookup nt_ _lhsItypeSyns)
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
_altsIallTpsFound
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_altsIerrors
-- copy rule (down)
_altsOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_altsOerrors =
_lhsIerrors
-- copy rule (down)
_altsOo_case =
_lhsIo_case
-- copy rule (down)
_altsOo_cata =
_lhsIo_cata
-- copy rule (down)
_altsOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_altsOo_data =
_lhsIo_data
-- copy rule (down)
_altsOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_altsOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_altsOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_altsOo_rename =
_lhsIo_rename
-- copy rule (down)
_altsOo_sem =
_lhsIo_sem
-- copy rule (down)
_altsOo_sig =
_lhsIo_sig
-- copy rule (down)
_altsOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_altsOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_altsOo_traces =
_lhsIo_traces
-- copy rule (down)
_altsOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_altsOprefix =
_lhsIprefix
-- copy rule (down)
_altsOwith_sig =
_lhsIwith_sig
-- copy rule (down)
_interOo_case =
_lhsIo_case
-- copy rule (down)
_interOo_cata =
_lhsIo_cata
-- copy rule (down)
_interOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_interOo_data =
_lhsIo_data
-- copy rule (down)
_interOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_interOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_interOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_interOo_rename =
_lhsIo_rename
-- copy rule (down)
_interOo_sem =
_lhsIo_sem
-- copy rule (down)
_interOo_sig =
_lhsIo_sig
-- copy rule (down)
_interOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_interOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_interOo_traces =
_lhsIo_traces
-- copy rule (down)
_interOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_interOprefix =
_lhsIprefix
( _altsIallTpsFound,_altsIcataAlts,_altsIcomments,_altsIdataAlts,_altsIdecls,_altsIerrors,_altsIsemNames) =
(alts_ _altsOallPragmas _altsOerrors _altsOinh _altsOnt _altsOo_case _altsOo_cata _altsOo_costcentre _altsOo_data _altsOo_linePragmas _altsOo_newtypes _altsOo_pretty _altsOo_rename _altsOo_sem _altsOo_sig _altsOo_splitsems _altsOo_strictwrap _altsOo_traces _altsOo_unbox _altsOprefix _altsOsyn _altsOwith_sig )
( _interIcomments,_interIsemDom,_interIwrapDecls) =
(inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOprefix _interOsyn )
in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )
-- CProductions ------------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
derivings : Derivings
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
typeSyns : TypeSyns
with_sig : Bool
wrappers : Set Nonterminal
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
chunks : Chunks
alternatives:
alternative Cons:
child hd : CProduction
child tl : CProductions
alternative Nil:
-}
-- cata
sem_CProductions :: CProductions ->
T_CProductions
sem_CProductions list =
(Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) )
-- semantic domain
newtype T_CProductions = T_CProductions (PragmaMap ->
Derivings ->
(Seq Error) ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
TypeSyns ->
Bool ->
(Set Nonterminal) ->
( Bool,Chunks,(Seq Error)))
data Inh_CProductions = Inh_CProductions {allPragmas_Inh_CProductions :: PragmaMap,derivings_Inh_CProductions :: Derivings,errors_Inh_CProductions :: Seq Error,o_case_Inh_CProductions :: Bool,o_cata_Inh_CProductions :: Bool,o_costcentre_Inh_CProductions :: Bool,o_data_Inh_CProductions :: Maybe Bool,o_linePragmas_Inh_CProductions :: Bool,o_newtypes_Inh_CProductions :: Bool,o_pretty_Inh_CProductions :: Bool,o_rename_Inh_CProductions :: Bool,o_sem_Inh_CProductions :: Bool,o_sig_Inh_CProductions :: Bool,o_splitsems_Inh_CProductions :: Bool,o_strictwrap_Inh_CProductions :: Bool,o_traces_Inh_CProductions :: Bool,o_unbox_Inh_CProductions :: Bool,prefix_Inh_CProductions :: String,typeSyns_Inh_CProductions :: TypeSyns,with_sig_Inh_CProductions :: Bool,wrappers_Inh_CProductions :: Set Nonterminal}
data Syn_CProductions = Syn_CProductions {allTpsFound_Syn_CProductions :: Bool,chunks_Syn_CProductions :: Chunks,errors_Syn_CProductions :: Seq Error}
wrap_CProductions (T_CProductions sem ) (Inh_CProductions _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers ) =
(let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors) =
(sem _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers )
in (Syn_CProductions _lhsOallTpsFound _lhsOchunks _lhsOerrors ))
sem_CProductions_Cons :: T_CProduction ->
T_CProductions ->
T_CProductions
sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) =
(T_CProductions (\ _lhsIallPragmas
_lhsIderivings
_lhsIerrors
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsItypeSyns
_lhsIwith_sig
_lhsIwrappers ->
(let _lhsOallTpsFound :: Bool
_lhsOchunks :: Chunks
_lhsOerrors :: (Seq Error)
_hdOallPragmas :: PragmaMap
_hdOderivings :: Derivings
_hdOerrors :: (Seq Error)
_hdOo_case :: Bool
_hdOo_cata :: Bool
_hdOo_costcentre :: Bool
_hdOo_data :: (Maybe Bool)
_hdOo_linePragmas :: Bool
_hdOo_newtypes :: Bool
_hdOo_pretty :: Bool
_hdOo_rename :: Bool
_hdOo_sem :: Bool
_hdOo_sig :: Bool
_hdOo_splitsems :: Bool
_hdOo_strictwrap :: Bool
_hdOo_traces :: Bool
_hdOo_unbox :: Bool
_hdOprefix :: String
_hdOtypeSyns :: TypeSyns
_hdOwith_sig :: Bool
_hdOwrappers :: (Set Nonterminal)
_tlOallPragmas :: PragmaMap
_tlOderivings :: Derivings
_tlOerrors :: (Seq Error)
_tlOo_case :: Bool
_tlOo_cata :: Bool
_tlOo_costcentre :: Bool
_tlOo_data :: (Maybe Bool)
_tlOo_linePragmas :: Bool
_tlOo_newtypes :: Bool
_tlOo_pretty :: Bool
_tlOo_rename :: Bool
_tlOo_sem :: Bool
_tlOo_sig :: Bool
_tlOo_splitsems :: Bool
_tlOo_strictwrap :: Bool
_tlOo_traces :: Bool
_tlOo_unbox :: Bool
_tlOprefix :: String
_tlOtypeSyns :: TypeSyns
_tlOwith_sig :: Bool
_tlOwrappers :: (Set Nonterminal)
_hdIallTpsFound :: Bool
_hdIchunks :: Chunks
_hdIerrors :: (Seq Error)
_tlIallTpsFound :: Bool
_tlIchunks :: Chunks
_tlIerrors :: (Seq Error)
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
_hdIallTpsFound && _tlIallTpsFound
-- use rule "GenerateCode.ag"(line 625, column 47)
_lhsOchunks =
_hdIchunks ++ _tlIchunks
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- copy rule (down)
_hdOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_hdOderivings =
_lhsIderivings
-- copy rule (down)
_hdOerrors =
_lhsIerrors
-- copy rule (down)
_hdOo_case =
_lhsIo_case
-- copy rule (down)
_hdOo_cata =
_lhsIo_cata
-- copy rule (down)
_hdOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_hdOo_data =
_lhsIo_data
-- copy rule (down)
_hdOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_hdOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_hdOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_hdOo_rename =
_lhsIo_rename
-- copy rule (down)
_hdOo_sem =
_lhsIo_sem
-- copy rule (down)
_hdOo_sig =
_lhsIo_sig
-- copy rule (down)
_hdOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_hdOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_hdOo_traces =
_lhsIo_traces
-- copy rule (down)
_hdOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_hdOprefix =
_lhsIprefix
-- copy rule (down)
_hdOtypeSyns =
_lhsItypeSyns
-- copy rule (down)
_hdOwith_sig =
_lhsIwith_sig
-- copy rule (down)
_hdOwrappers =
_lhsIwrappers
-- copy rule (down)
_tlOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_tlOderivings =
_lhsIderivings
-- copy rule (chain)
_tlOerrors =
_hdIerrors
-- copy rule (down)
_tlOo_case =
_lhsIo_case
-- copy rule (down)
_tlOo_cata =
_lhsIo_cata
-- copy rule (down)
_tlOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_tlOo_data =
_lhsIo_data
-- copy rule (down)
_tlOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_tlOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_tlOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_tlOo_rename =
_lhsIo_rename
-- copy rule (down)
_tlOo_sem =
_lhsIo_sem
-- copy rule (down)
_tlOo_sig =
_lhsIo_sig
-- copy rule (down)
_tlOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_tlOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_tlOo_traces =
_lhsIo_traces
-- copy rule (down)
_tlOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_tlOprefix =
_lhsIprefix
-- copy rule (down)
_tlOtypeSyns =
_lhsItypeSyns
-- copy rule (down)
_tlOwith_sig =
_lhsIwith_sig
-- copy rule (down)
_tlOwrappers =
_lhsIwrappers
( _hdIallTpsFound,_hdIchunks,_hdIerrors) =
(hd_ _hdOallPragmas _hdOderivings _hdOerrors _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOtypeSyns _hdOwith_sig _hdOwrappers )
( _tlIallTpsFound,_tlIchunks,_tlIerrors) =
(tl_ _tlOallPragmas _tlOderivings _tlOerrors _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOtypeSyns _tlOwith_sig _tlOwrappers )
in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )
sem_CProductions_Nil :: T_CProductions
sem_CProductions_Nil =
(T_CProductions (\ _lhsIallPragmas
_lhsIderivings
_lhsIerrors
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsItypeSyns
_lhsIwith_sig
_lhsIwrappers ->
(let _lhsOallTpsFound :: Bool
_lhsOchunks :: Chunks
_lhsOerrors :: (Seq Error)
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
True
-- use rule "GenerateCode.ag"(line 625, column 47)
_lhsOchunks =
[]
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
Seq.empty
in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )
-- CRule -------------------------------------------------------
{-
visit 0:
inherited attributes:
children : [(Name,Type,Bool)]
con : Constructor
higherOrderChildren : [(Name,Type,Bool)]
inh : Attributes
instVisitNrs : Map Identifier Int
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
terminals : [Name]
what : String
chained attributes:
declsAbove : [Decl]
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
bldBlocksFun : DeclBlocks -> DeclBlocks
comments : [String]
decls : Decls
definedInsts : [Identifier]
exprs : Exprs
tSigs : [Decl]
tps : [Type]
usedVars : Set String
alternatives:
alternative CChildVisit:
child name : {Name}
child nt : {Nonterminal}
child nr : {Int}
child inh : {Attributes}
child syn : {Attributes}
child isLast : {Bool}
visit 0:
local costCentreDescr : _
local addCostCentre : _
local decls : _
local isSuperfluousHigherOrderIntra : _
local names : _
local mkTp : _
local definedTps : _
local nextTp : _
alternative CRule:
child name : {Name}
child isIn : {Bool}
child hasCode : {Bool}
child nt : {Nonterminal}
child con : {Constructor}
child field : {Name}
child childnt : {Maybe Nonterminal}
child tp : {Maybe Type}
child pattern : Pattern
child rhs : {[String]}
child defines : {Map Int (Name,Name,Maybe Type)}
child owrt : {Bool}
child origin : {String}
child uses : {Set (Name, Name)}
visit 0:
local instTypes : _
local originComment : _
local instDecls : _
local patDescr : _
local traceDescr : _
local addTrace : _
local costCentreDescr : _
local addCostCentre : _
local addLinePragma : _
local decls : _
local definedInsts : _
local name : _
local mkTp : _
local _tup3 : {([Type],Bool)}
-}
-- cata
sem_CRule :: CRule ->
T_CRule
sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) =
(sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast )
sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses ) =
(sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses )
-- semantic domain
newtype T_CRule = T_CRule (([(Name,Type,Bool)]) ->
Constructor ->
([Decl]) ->
(Seq Error) ->
([(Name,Type,Bool)]) ->
Attributes ->
(Map Identifier Int) ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
([Name]) ->
String ->
( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))
data Inh_CRule = Inh_CRule {children_Inh_CRule :: [(Name,Type,Bool)],con_Inh_CRule :: Constructor,declsAbove_Inh_CRule :: [Decl],errors_Inh_CRule :: Seq Error,higherOrderChildren_Inh_CRule :: [(Name,Type,Bool)],inh_Inh_CRule :: Attributes,instVisitNrs_Inh_CRule :: Map Identifier Int,nr_Inh_CRule :: Int,nt_Inh_CRule :: Nonterminal,o_case_Inh_CRule :: Bool,o_cata_Inh_CRule :: Bool,o_costcentre_Inh_CRule :: Bool,o_data_Inh_CRule :: Maybe Bool,o_linePragmas_Inh_CRule :: Bool,o_newtypes_Inh_CRule :: Bool,o_pretty_Inh_CRule :: Bool,o_rename_Inh_CRule :: Bool,o_sem_Inh_CRule :: Bool,o_sig_Inh_CRule :: Bool,o_splitsems_Inh_CRule :: Bool,o_strictwrap_Inh_CRule :: Bool,o_traces_Inh_CRule :: Bool,o_unbox_Inh_CRule :: Bool,prefix_Inh_CRule :: String,syn_Inh_CRule :: Attributes,terminals_Inh_CRule :: [Name],what_Inh_CRule :: String}
data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: Bool,bldBlocksFun_Syn_CRule :: DeclBlocks -> DeclBlocks,comments_Syn_CRule :: [String],decls_Syn_CRule :: Decls,declsAbove_Syn_CRule :: [Decl],definedInsts_Syn_CRule :: [Identifier],errors_Syn_CRule :: Seq Error,exprs_Syn_CRule :: Exprs,tSigs_Syn_CRule :: [Decl],tps_Syn_CRule :: [Type],usedVars_Syn_CRule :: Set String}
wrap_CRule (T_CRule sem ) (Inh_CRule _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat ) =
(let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =
(sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat )
in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars ))
sem_CRule_CChildVisit :: Name ->
Nonterminal ->
Int ->
Attributes ->
Attributes ->
Bool ->
T_CRule
sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ =
(T_CRule (\ _lhsIchildren
_lhsIcon
_lhsIdeclsAbove
_lhsIerrors
_lhsIhigherOrderChildren
_lhsIinh
_lhsIinstVisitNrs
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwhat ->
(let _lhsOexprs :: Exprs
_lhsOusedVars :: (Set String)
_lhsOtSigs :: ([Decl])
_lhsOtps :: ([Type])
_lhsOdeclsAbove :: ([Decl])
_lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
-- "GenerateCode.ag"(line 126, column 18)
_costCentreDescr =
show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_
-- "GenerateCode.ag"(line 127, column 18)
_addCostCentre =
\v -> if _lhsIo_costcentre
then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v
else v
-- "GenerateCode.ag"(line 130, column 18)
_decls =
let lhsVars = map (attrname True name_) (Map.keys syn_)
++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)]
rhsVars = map (attrname False name_) (Map.keys inh_)
unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else ""
tuple = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars
rhs = _addCostCentre $ App (funname name_ nr_) (map SimpleExpr rhsVars)
in [Decl tuple rhs (Set.fromList lhsVars) (Set.fromList (funname name_ nr_ : rhsVars))]
-- "GenerateCode.ag"(line 206, column 7)
_isSuperfluousHigherOrderIntra =
_lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs
-- "GenerateCode.ag"(line 220, column 8)
_names =
if _isSuperfluousHigherOrderIntra
then []
else [funname name_ (nr_+1)]
-- "GenerateCode.ag"(line 224, column 8)
_lhsOexprs =
let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id
in map (wrap . SimpleExpr) _names
-- "GenerateCode.ag"(line 232, column 7)
_lhsOusedVars =
Set.fromList _names
-- "GenerateCode.ag"(line 243, column 19)
_mkTp =
SimpleType . typeToString nt_
-- "GenerateCode.ag"(line 244, column 19)
_definedTps =
[ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]
-- "GenerateCode.ag"(line 245, column 19)
_nextTp =
typeName nt_ (nr_+1)
-- "GenerateCode.ag"(line 246, column 19)
_lhsOtSigs =
(if isLast_ then id else (TSig (funname name_ (nr_+1)) (SimpleType _nextTp) :)) _definedTps
-- "GenerateCode.ag"(line 268, column 19)
_lhsOtps =
if _isSuperfluousHigherOrderIntra
then []
else [Haskell _nextTp]
-- "GenerateCode.ag"(line 371, column 7)
_lhsOdeclsAbove =
[]
-- "GenerateCode.ag"(line 384, column 7)
_lhsObldBlocksFun =
DeclBlock _lhsIdeclsAbove (head _decls )
-- use rule "GenerateCode.ag"(line 265, column 39)
_lhsOallTpsFound =
True
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
[]
-- use rule "GenerateCode.ag"(line 87, column 34)
_lhsOdecls =
_decls
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
[]
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
Seq.empty
in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )
sem_CRule_CRule :: Name ->
Bool ->
Bool ->
Nonterminal ->
Constructor ->
Name ->
(Maybe Nonterminal) ->
(Maybe Type) ->
T_Pattern ->
([String]) ->
(Map Int (Name,Name,Maybe Type)) ->
Bool ->
String ->
(Set (Name, Name)) ->
T_CRule
sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ =
(T_CRule (\ _lhsIchildren
_lhsIcon
_lhsIdeclsAbove
_lhsIerrors
_lhsIhigherOrderChildren
_lhsIinh
_lhsIinstVisitNrs
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwhat ->
(let _lhsOexprs :: Exprs
_lhsOusedVars :: (Set String)
_lhsOtSigs :: ([Decl])
__tup3 :: (([Type],Bool))
_lhsOtps :: ([Type])
_lhsOallTpsFound :: Bool
_lhsOdeclsAbove :: ([Decl])
_lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)
_lhsOerrors :: (Seq Error)
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOdefinedInsts :: ([Identifier])
_patternIcopy :: Pattern
_patternIdefinedInsts :: ([Identifier])
_patternIpatternAttributes :: ([(Name, Name)])
-- "GenerateCode.ag"(line 89, column 12)
_instTypes =
map (\(n,NT t,_) -> (n,t)) _lhsIhigherOrderChildren
-- "GenerateCode.ag"(line 90, column 12)
_originComment =
if _lhsIo_pretty
then (Comment origin_:)
else id
-- "GenerateCode.ag"(line 93, column 12)
_instDecls =
[ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) []))
(App (cataname _lhsIprefix (fromJust $ inst `lookup` _instTypes ))
[SimpleExpr instLocFieldName])
(Set.singleton instSemFieldName)
(Set.singleton instLocFieldName)
| inst <- _definedInsts
, let instLocFieldName = attrname True _INST inst
, let instSemFieldName = attrname False _INST' inst ]
-- "GenerateCode.ag"(line 101, column 12)
_patDescr =
if isIn_
then "_"
else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes)
-- "GenerateCode.ag"(line 104, column 12)
_traceDescr =
show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr
-- "GenerateCode.ag"(line 106, column 12)
_addTrace =
\v -> if _lhsIo_traces
then Trace _traceDescr v
else v
-- "GenerateCode.ag"(line 109, column 12)
_costCentreDescr =
show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr
-- "GenerateCode.ag"(line 110, column 12)
_addCostCentre =
\v -> if _lhsIo_costcentre
then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v
else v
-- "GenerateCode.ag"(line 113, column 12)
_addLinePragma =
\v -> let p = getPos name_
hasPos = line p > 0 && column p >= 0 && not (null (file p))
in if _lhsIo_linePragmas && hasPos
then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p))
$ LineExpr
$ v
else v
-- "GenerateCode.ag"(line 120, column 12)
_decls =
if hasCode_
then _originComment ( Decl (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_))
(Set.fromList [attrname False fld nm | (fld,nm,_) <- Map.elems defines_])
(Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_])
: _instDecls )
else _instDecls
-- "GenerateCode.ag"(line 145, column 12)
_definedInsts =
if isIn_ then [] else _patternIdefinedInsts
-- "GenerateCode.ag"(line 215, column 12)
_name =
if field_ == _LOC && name_ `elem` _lhsIterminals
then funname name_ 0
else attrname isIn_ field_ name_
-- "GenerateCode.ag"(line 218, column 12)
_lhsOexprs =
[SimpleExpr _name ]
-- "GenerateCode.ag"(line 230, column 7)
_lhsOusedVars =
Set.singleton _name
-- "GenerateCode.ag"(line 240, column 19)
_mkTp =
SimpleType . typeToString _lhsInt
-- "GenerateCode.ag"(line 241, column 19)
_lhsOtSigs =
[ TSig (attrname False field attr) (_mkTp (fromJust tp))
| (field,attr,tp) <- Map.elems defines_, isJust tp ]
-- "GenerateCode.ag"(line 267, column 23)
__tup3 =
maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_
-- "GenerateCode.ag"(line 267, column 23)
(_lhsOtps,_) =
__tup3
-- "GenerateCode.ag"(line 267, column 23)
(_,_lhsOallTpsFound) =
__tup3
-- "GenerateCode.ag"(line 369, column 7)
_lhsOdeclsAbove =
_lhsIdeclsAbove ++ _decls
-- "GenerateCode.ag"(line 382, column 7)
_lhsObldBlocksFun =
id
-- "GenerateCode.ag"(line 570, column 12)
_lhsOerrors =
let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_)
nameOf _ = name_
in maybe (Seq.single (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_
-- "GenerateCode.ag"(line 610, column 18)
_lhsOcomments =
[ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ]
++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ]
-- use rule "GenerateCode.ag"(line 87, column 34)
_lhsOdecls =
_decls
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
_definedInsts
( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) =
(pattern_ )
in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )
-- CSegment ----------------------------------------------------
{-
visit 0:
inherited attributes:
inh : Attributes
isLast : Bool
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
synthesized attributes:
comments : [String]
semDom : [Decl]
wrapDecls : Decls
alternatives:
alternative CSegment:
child inh : {Attributes}
child syn : {Attributes}
-}
-- cata
sem_CSegment :: CSegment ->
T_CSegment
sem_CSegment (CSegment _inh _syn ) =
(sem_CSegment_CSegment _inh _syn )
-- semantic domain
newtype T_CSegment = T_CSegment (Attributes ->
Bool ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
( ([String]),([Decl]),Decls))
data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: Attributes,isLast_Inh_CSegment :: Bool,nr_Inh_CSegment :: Int,nt_Inh_CSegment :: Nonterminal,o_case_Inh_CSegment :: Bool,o_cata_Inh_CSegment :: Bool,o_costcentre_Inh_CSegment :: Bool,o_data_Inh_CSegment :: Maybe Bool,o_linePragmas_Inh_CSegment :: Bool,o_newtypes_Inh_CSegment :: Bool,o_pretty_Inh_CSegment :: Bool,o_rename_Inh_CSegment :: Bool,o_sem_Inh_CSegment :: Bool,o_sig_Inh_CSegment :: Bool,o_splitsems_Inh_CSegment :: Bool,o_strictwrap_Inh_CSegment :: Bool,o_traces_Inh_CSegment :: Bool,o_unbox_Inh_CSegment :: Bool,prefix_Inh_CSegment :: String,syn_Inh_CSegment :: Attributes}
data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: [String],semDom_Syn_CSegment :: [Decl],wrapDecls_Syn_CSegment :: Decls}
wrap_CSegment (T_CSegment sem ) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =
(let ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls) =
(sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )
in (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOwrapDecls ))
sem_CSegment_CSegment :: Attributes ->
Attributes ->
T_CSegment
sem_CSegment_CSegment inh_ syn_ =
(T_CSegment (\ _lhsIinh
_lhsIisLast
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn ->
(let _lhsOsemDom :: ([Decl])
_lhsOwrapDecls :: Decls
_lhsOcomments :: ([String])
-- "GenerateCode.ag"(line 496, column 15)
_lhsOsemDom =
let name = typeName _lhsInt _lhsInr
tp = foldr Arr synTps inhTps
inhTps = [SimpleType (typeToString _lhsInt tp) | tp <- Map.elems inh_]
synTps = mkTupleType _lhsIo_unbox (null inhTps) ([SimpleType (typeToString _lhsInt tp) | tp <- Map.elems syn_] ++ continuation)
continuation = if _lhsIisLast
then []
else [SimpleType (typeName _lhsInt (_lhsInr + 1))]
in if _lhsIo_newtypes
then [ Code.NewType name name tp ]
else [ Code.Type name tp ]
-- "GenerateCode.ag"(line 534, column 15)
_lhsOwrapDecls =
let lhsVars = map (lhsname False) (Map.keys syn_)
++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)]
rhsVars = map (lhsname True) (Map.keys inh_)
rhs = map SimpleExpr rhsVars
unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else ""
var = "sem"
sem 0 = var
sem n = var ++ "_" ++ show n
in [ Decl (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (App (sem _lhsInr) rhs) (Set.fromList lhsVars) (Set.fromList rhsVars) ]
-- "GenerateCode.ag"(line 588, column 18)
_lhsOcomments =
let body = map ind (showsSegment (CSegment inh_ syn_))
in if null body
then []
else ("visit " ++ show _lhsInr ++ ":") : body
in ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls))) )
-- CSegments ---------------------------------------------------
{-
visit 0:
inherited attributes:
inh : Attributes
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
synthesized attributes:
comments : [String]
isNil : Bool
semDom : [Decl]
wrapDecls : Decls
alternatives:
alternative Cons:
child hd : CSegment
child tl : CSegments
alternative Nil:
-}
-- cata
sem_CSegments :: CSegments ->
T_CSegments
sem_CSegments list =
(Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) )
-- semantic domain
newtype T_CSegments = T_CSegments (Attributes ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
( ([String]),Bool,([Decl]),Decls))
data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: Attributes,nr_Inh_CSegments :: Int,nt_Inh_CSegments :: Nonterminal,o_case_Inh_CSegments :: Bool,o_cata_Inh_CSegments :: Bool,o_costcentre_Inh_CSegments :: Bool,o_data_Inh_CSegments :: Maybe Bool,o_linePragmas_Inh_CSegments :: Bool,o_newtypes_Inh_CSegments :: Bool,o_pretty_Inh_CSegments :: Bool,o_rename_Inh_CSegments :: Bool,o_sem_Inh_CSegments :: Bool,o_sig_Inh_CSegments :: Bool,o_splitsems_Inh_CSegments :: Bool,o_strictwrap_Inh_CSegments :: Bool,o_traces_Inh_CSegments :: Bool,o_unbox_Inh_CSegments :: Bool,prefix_Inh_CSegments :: String,syn_Inh_CSegments :: Attributes}
data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: [String],isNil_Syn_CSegments :: Bool,semDom_Syn_CSegments :: [Decl],wrapDecls_Syn_CSegments :: Decls}
wrap_CSegments (T_CSegments sem ) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =
(let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls) =
(sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )
in (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOwrapDecls ))
sem_CSegments_Cons :: T_CSegment ->
T_CSegments ->
T_CSegments
sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) =
(T_CSegments (\ _lhsIinh
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn ->
(let _tlOnr :: Int
_lhsOisNil :: Bool
_hdOisLast :: Bool
_lhsOcomments :: ([String])
_lhsOsemDom :: ([Decl])
_lhsOwrapDecls :: Decls
_hdOinh :: Attributes
_hdOnr :: Int
_hdOnt :: Nonterminal
_hdOo_case :: Bool
_hdOo_cata :: Bool
_hdOo_costcentre :: Bool
_hdOo_data :: (Maybe Bool)
_hdOo_linePragmas :: Bool
_hdOo_newtypes :: Bool
_hdOo_pretty :: Bool
_hdOo_rename :: Bool
_hdOo_sem :: Bool
_hdOo_sig :: Bool
_hdOo_splitsems :: Bool
_hdOo_strictwrap :: Bool
_hdOo_traces :: Bool
_hdOo_unbox :: Bool
_hdOprefix :: String
_hdOsyn :: Attributes
_tlOinh :: Attributes
_tlOnt :: Nonterminal
_tlOo_case :: Bool
_tlOo_cata :: Bool
_tlOo_costcentre :: Bool
_tlOo_data :: (Maybe Bool)
_tlOo_linePragmas :: Bool
_tlOo_newtypes :: Bool
_tlOo_pretty :: Bool
_tlOo_rename :: Bool
_tlOo_sem :: Bool
_tlOo_sig :: Bool
_tlOo_splitsems :: Bool
_tlOo_strictwrap :: Bool
_tlOo_traces :: Bool
_tlOo_unbox :: Bool
_tlOprefix :: String
_tlOsyn :: Attributes
_hdIcomments :: ([String])
_hdIsemDom :: ([Decl])
_hdIwrapDecls :: Decls
_tlIcomments :: ([String])
_tlIisNil :: Bool
_tlIsemDom :: ([Decl])
_tlIwrapDecls :: Decls
-- "GenerateCode.ag"(line 165, column 11)
_tlOnr =
_lhsInr + 1
-- "GenerateCode.ag"(line 178, column 12)
_lhsOisNil =
False
-- "GenerateCode.ag"(line 179, column 12)
_hdOisLast =
_tlIisNil
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
_hdIcomments ++ _tlIcomments
-- use rule "GenerateCode.ag"(line 491, column 50)
_lhsOsemDom =
_hdIsemDom ++ _tlIsemDom
-- use rule "GenerateCode.ag"(line 532, column 52)
_lhsOwrapDecls =
_hdIwrapDecls ++ _tlIwrapDecls
-- copy rule (down)
_hdOinh =
_lhsIinh
-- copy rule (down)
_hdOnr =
_lhsInr
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOo_case =
_lhsIo_case
-- copy rule (down)
_hdOo_cata =
_lhsIo_cata
-- copy rule (down)
_hdOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_hdOo_data =
_lhsIo_data
-- copy rule (down)
_hdOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_hdOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_hdOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_hdOo_rename =
_lhsIo_rename
-- copy rule (down)
_hdOo_sem =
_lhsIo_sem
-- copy rule (down)
_hdOo_sig =
_lhsIo_sig
-- copy rule (down)
_hdOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_hdOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_hdOo_traces =
_lhsIo_traces
-- copy rule (down)
_hdOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_hdOprefix =
_lhsIprefix
-- copy rule (down)
_hdOsyn =
_lhsIsyn
-- copy rule (down)
_tlOinh =
_lhsIinh
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOo_case =
_lhsIo_case
-- copy rule (down)
_tlOo_cata =
_lhsIo_cata
-- copy rule (down)
_tlOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_tlOo_data =
_lhsIo_data
-- copy rule (down)
_tlOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_tlOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_tlOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_tlOo_rename =
_lhsIo_rename
-- copy rule (down)
_tlOo_sem =
_lhsIo_sem
-- copy rule (down)
_tlOo_sig =
_lhsIo_sig
-- copy rule (down)
_tlOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_tlOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_tlOo_traces =
_lhsIo_traces
-- copy rule (down)
_tlOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_tlOprefix =
_lhsIprefix
-- copy rule (down)
_tlOsyn =
_lhsIsyn
( _hdIcomments,_hdIsemDom,_hdIwrapDecls) =
(hd_ _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn )
( _tlIcomments,_tlIisNil,_tlIsemDom,_tlIwrapDecls) =
(tl_ _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn )
in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls))) )
sem_CSegments_Nil :: T_CSegments
sem_CSegments_Nil =
(T_CSegments (\ _lhsIinh
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn ->
(let _lhsOisNil :: Bool
_lhsOcomments :: ([String])
_lhsOsemDom :: ([Decl])
_lhsOwrapDecls :: Decls
-- "GenerateCode.ag"(line 180, column 10)
_lhsOisNil =
True
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
[]
-- use rule "GenerateCode.ag"(line 491, column 50)
_lhsOsemDom =
[]
-- use rule "GenerateCode.ag"(line 532, column 52)
_lhsOwrapDecls =
[]
in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls))) )
-- CVisit ------------------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
children : [(Name,Type,Bool)]
con : Constructor
inh : Attributes
instVisitNrs : Map Identifier Int
isLast : Bool
nextIntra : Exprs
nextIntraVars : Set String
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
terminals : [Name]
with_sig : Bool
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
comments : [String]
decls : Decls
gatherInstVisitNrs : Map Identifier Int
intra : Exprs
intraVars : Set String
semNames : [String]
alternatives:
alternative CVisit:
child inh : {Attributes}
child syn : {Attributes}
child vss : Sequence
child intra : Sequence
child ordered : {Bool}
visit 0:
local _tup4 : _
local higherOrderChildren : _
local firstOrderChildren : _
local funcname : _
local nextVisitName : _
local nextVisitDecl : _
local decls : _
local lastExprVars : _
local _tup5 : _
local blockFunDecls : _
local blockFirstFunCall : _
local costCentreDescr : _
local addCostCentre : _
local semFun : _
local tsig : _
local semType : _
local typeSigs : _
local o_case : _
local o_splitsems : _
-}
-- cata
sem_CVisit :: CVisit ->
T_CVisit
sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) =
(sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered )
-- semantic domain
newtype T_CVisit = T_CVisit (PragmaMap ->
([(Name,Type,Bool)]) ->
Constructor ->
(Seq Error) ->
Attributes ->
(Map Identifier Int) ->
Bool ->
Exprs ->
(Set String) ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
([Name]) ->
Bool ->
( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),([String])))
data Inh_CVisit = Inh_CVisit {allPragmas_Inh_CVisit :: PragmaMap,children_Inh_CVisit :: [(Name,Type,Bool)],con_Inh_CVisit :: Constructor,errors_Inh_CVisit :: Seq Error,inh_Inh_CVisit :: Attributes,instVisitNrs_Inh_CVisit :: Map Identifier Int,isLast_Inh_CVisit :: Bool,nextIntra_Inh_CVisit :: Exprs,nextIntraVars_Inh_CVisit :: Set String,nr_Inh_CVisit :: Int,nt_Inh_CVisit :: Nonterminal,o_case_Inh_CVisit :: Bool,o_cata_Inh_CVisit :: Bool,o_costcentre_Inh_CVisit :: Bool,o_data_Inh_CVisit :: Maybe Bool,o_linePragmas_Inh_CVisit :: Bool,o_newtypes_Inh_CVisit :: Bool,o_pretty_Inh_CVisit :: Bool,o_rename_Inh_CVisit :: Bool,o_sem_Inh_CVisit :: Bool,o_sig_Inh_CVisit :: Bool,o_splitsems_Inh_CVisit :: Bool,o_strictwrap_Inh_CVisit :: Bool,o_traces_Inh_CVisit :: Bool,o_unbox_Inh_CVisit :: Bool,prefix_Inh_CVisit :: String,syn_Inh_CVisit :: Attributes,terminals_Inh_CVisit :: [Name],with_sig_Inh_CVisit :: Bool}
data Syn_CVisit = Syn_CVisit {allTpsFound_Syn_CVisit :: Bool,comments_Syn_CVisit :: [String],decls_Syn_CVisit :: Decls,errors_Syn_CVisit :: Seq Error,gatherInstVisitNrs_Syn_CVisit :: Map Identifier Int,intra_Syn_CVisit :: Exprs,intraVars_Syn_CVisit :: Set String,semNames_Syn_CVisit :: [String]}
wrap_CVisit (T_CVisit sem ) (Inh_CVisit _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig ) =
(let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames) =
(sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig )
in (Syn_CVisit _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames ))
sem_CVisit_CVisit :: Attributes ->
Attributes ->
T_Sequence ->
T_Sequence ->
Bool ->
T_CVisit
sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ =
(T_CVisit (\ _lhsIallPragmas
_lhsIchildren
_lhsIcon
_lhsIerrors
_lhsIinh
_lhsIinstVisitNrs
_lhsIisLast
_lhsInextIntra
_lhsInextIntraVars
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwith_sig ->
(let _lhsOintra :: Exprs
_lhsOintraVars :: (Set String)
_vssOlastExpr :: Expr
_intraOlastExpr :: Expr
_lhsOdecls :: Decls
_lhsOgatherInstVisitNrs :: (Map Identifier Int)
_vssOdeclsAbove :: ([Decl])
_intraOdeclsAbove :: ([Decl])
_lhsOallTpsFound :: Bool
_lhsOerrors :: (Seq Error)
_lhsOcomments :: ([String])
_vssOwhat :: String
_intraOwhat :: String
_lhsOsemNames :: ([String])
_vssOchildren :: ([(Name,Type,Bool)])
_vssOcon :: Constructor
_vssOerrors :: (Seq Error)
_vssOhigherOrderChildren :: ([(Name,Type,Bool)])
_vssOinh :: Attributes
_vssOinstVisitNrs :: (Map Identifier Int)
_vssOnr :: Int
_vssOnt :: Nonterminal
_vssOo_case :: Bool
_vssOo_cata :: Bool
_vssOo_costcentre :: Bool
_vssOo_data :: (Maybe Bool)
_vssOo_linePragmas :: Bool
_vssOo_newtypes :: Bool
_vssOo_pretty :: Bool
_vssOo_rename :: Bool
_vssOo_sem :: Bool
_vssOo_sig :: Bool
_vssOo_splitsems :: Bool
_vssOo_strictwrap :: Bool
_vssOo_traces :: Bool
_vssOo_unbox :: Bool
_vssOprefix :: String
_vssOsyn :: Attributes
_vssOterminals :: ([Name])
_intraOchildren :: ([(Name,Type,Bool)])
_intraOcon :: Constructor
_intraOerrors :: (Seq Error)
_intraOhigherOrderChildren :: ([(Name,Type,Bool)])
_intraOinh :: Attributes
_intraOinstVisitNrs :: (Map Identifier Int)
_intraOnr :: Int
_intraOnt :: Nonterminal
_intraOo_case :: Bool
_intraOo_cata :: Bool
_intraOo_costcentre :: Bool
_intraOo_data :: (Maybe Bool)
_intraOo_linePragmas :: Bool
_intraOo_newtypes :: Bool
_intraOo_pretty :: Bool
_intraOo_rename :: Bool
_intraOo_sem :: Bool
_intraOo_sig :: Bool
_intraOo_splitsems :: Bool
_intraOo_strictwrap :: Bool
_intraOo_traces :: Bool
_intraOo_unbox :: Bool
_intraOprefix :: String
_intraOsyn :: Attributes
_intraOterminals :: ([Name])
_vssIallTpsFound :: Bool
_vssIblockDecls :: DeclBlocks
_vssIcomments :: ([String])
_vssIdecls :: Decls
_vssIdeclsAbove :: ([Decl])
_vssIdefinedInsts :: ([Identifier])
_vssIerrors :: (Seq Error)
_vssIexprs :: Exprs
_vssItSigs :: ([Decl])
_vssItps :: ([Type])
_vssIusedVars :: (Set String)
_intraIallTpsFound :: Bool
_intraIblockDecls :: DeclBlocks
_intraIcomments :: ([String])
_intraIdecls :: Decls
_intraIdeclsAbove :: ([Decl])
_intraIdefinedInsts :: ([Identifier])
_intraIerrors :: (Seq Error)
_intraIexprs :: Exprs
_intraItSigs :: ([Decl])
_intraItps :: ([Type])
_intraIusedVars :: (Set String)
-- "GenerateCode.ag"(line 189, column 13)
_lhsOintra =
_intraIexprs
-- "GenerateCode.ag"(line 190, column 13)
_lhsOintraVars =
_intraIusedVars
-- "GenerateCode.ag"(line 278, column 13)
__tup4 =
partition (\(_,_,ho) -> ho) _lhsIchildren
-- "GenerateCode.ag"(line 278, column 13)
(_higherOrderChildren,_) =
__tup4
-- "GenerateCode.ag"(line 278, column 13)
(_,_firstOrderChildren) =
__tup4
-- "GenerateCode.ag"(line 279, column 13)
_funcname =
seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr
-- "GenerateCode.ag"(line 280, column 13)
_nextVisitName =
if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]
-- "GenerateCode.ag"(line 281, column 13)
_nextVisitDecl =
let lhs = TupleLhs _nextVisitName
rhs = App fun _lhsInextIntra
fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1)
in if _lhsIisLast
then []
else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars]
-- "GenerateCode.ag"(line 287, column 13)
_decls =
_typeSigs ++ _vssIdecls ++ _nextVisitDecl
-- "GenerateCode.ag"(line 288, column 13)
_vssOlastExpr =
mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName
-- "GenerateCode.ag"(line 289, column 13)
_intraOlastExpr =
error "lastExpr: not used here"
-- "GenerateCode.ag"(line 290, column 13)
_lastExprVars =
map (lhsname False) (Map.keys syn_) ++ _nextVisitName
-- "GenerateCode.ag"(line 291, column 13)
__tup5 =
mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls
-- "GenerateCode.ag"(line 291, column 13)
(_blockFunDecls,_) =
__tup5
-- "GenerateCode.ag"(line 291, column 13)
(_,_blockFirstFunCall) =
__tup5
-- "GenerateCode.ag"(line 293, column 13)
_costCentreDescr =
"b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr
-- "GenerateCode.ag"(line 294, column 13)
_addCostCentre =
\v -> if _lhsIo_costcentre
then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v
else v
-- "GenerateCode.ag"(line 298, column 13)
_semFun =
let lhs = Fun _funcname lhs_args
lhs_args = if _lhsInr == 0 then map field _firstOrderChildren else _intraIexprs
field (name,NT tp,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x]
| otherwise = id
in unwrap (SimpleExpr (funname name 0))
field (name,_,_) = SimpleExpr (funname name 0)
rhs = wrap
. mkLambda (map (lhsname True) (Map.keys inh_))
$ _addCostCentre
$ if ordered_ && _o_splitsems
then _blockFirstFunCall
else mkLet _o_case _decls
. mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_)
$ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName
wrap = if _lhsIo_newtypes
then \x -> App (typeName _lhsInt _lhsInr) [x]
else id
in Decl lhs rhs Set.empty Set.empty
-- "GenerateCode.ag"(line 319, column 13)
_tsig =
TSig _funcname _semType
-- "GenerateCode.ag"(line 320, column 13)
_semType =
let argType (NT tp) rec | tp /= _SELF = SimpleType (sdtype tp) `Arr` rec
| tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps"
argType (Haskell tp) rec = SimpleType tp `Arr` rec
in if _lhsInr == 0
then foldr argType (SimpleType (sdtype _lhsInt )) (map (\(_,t,_) -> t) _firstOrderChildren )
else foldr argType (SimpleType (typeName _lhsInt _lhsInr)) _intraItps
-- "GenerateCode.ag"(line 326, column 13)
_lhsOdecls =
( if _lhsIwith_sig
then [_tsig, _semFun]
else [_semFun]
) ++
( if ordered_ && _o_splitsems
then _blockFunDecls
else []
)
-- "GenerateCode.ag"(line 334, column 13)
_typeSigs =
if _lhsIo_sig && not _o_case
then _vssItSigs
else []
-- "GenerateCode.ag"(line 337, column 13)
_o_case =
_lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)
-- "GenerateCode.ag"(line 338, column 13)
_o_splitsems =
ordered_ && _lhsIo_splitsems
-- "GenerateCode.ag"(line 353, column 7)
_lhsOgatherInstVisitNrs =
Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]
-- "GenerateCode.ag"(line 364, column 7)
_vssOdeclsAbove =
[]
-- "GenerateCode.ag"(line 365, column 7)
_intraOdeclsAbove =
error "declsAbove: not used here"
-- "GenerateCode.ag"(line 557, column 13)
_lhsOallTpsFound =
_intraIallTpsFound
-- "GenerateCode.ag"(line 568, column 13)
_lhsOerrors =
_intraIerrors
-- "GenerateCode.ag"(line 601, column 18)
_lhsOcomments =
let body = map ind (_vssIcomments ++ _intraIcomments)
in if null body
then []
else ("visit " ++ show _lhsInr ++ ":") : body
-- "GenerateCode.ag"(line 605, column 18)
_vssOwhat =
"local"
-- "GenerateCode.ag"(line 606, column 18)
_intraOwhat =
"intra"
-- "GenerateCode.ag"(line 784, column 7)
_lhsOsemNames =
[_funcname ]
-- copy rule (down)
_vssOchildren =
_lhsIchildren
-- copy rule (down)
_vssOcon =
_lhsIcon
-- copy rule (down)
_vssOerrors =
_lhsIerrors
-- copy rule (from local)
_vssOhigherOrderChildren =
_higherOrderChildren
-- copy rule (down)
_vssOinh =
_lhsIinh
-- copy rule (down)
_vssOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_vssOnr =
_lhsInr
-- copy rule (down)
_vssOnt =
_lhsInt
-- copy rule (from local)
_vssOo_case =
_o_case
-- copy rule (down)
_vssOo_cata =
_lhsIo_cata
-- copy rule (down)
_vssOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_vssOo_data =
_lhsIo_data
-- copy rule (down)
_vssOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_vssOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_vssOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_vssOo_rename =
_lhsIo_rename
-- copy rule (down)
_vssOo_sem =
_lhsIo_sem
-- copy rule (down)
_vssOo_sig =
_lhsIo_sig
-- copy rule (from local)
_vssOo_splitsems =
_o_splitsems
-- copy rule (down)
_vssOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_vssOo_traces =
_lhsIo_traces
-- copy rule (down)
_vssOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_vssOprefix =
_lhsIprefix
-- copy rule (down)
_vssOsyn =
_lhsIsyn
-- copy rule (down)
_vssOterminals =
_lhsIterminals
-- copy rule (down)
_intraOchildren =
_lhsIchildren
-- copy rule (down)
_intraOcon =
_lhsIcon
-- copy rule (chain)
_intraOerrors =
_vssIerrors
-- copy rule (from local)
_intraOhigherOrderChildren =
_higherOrderChildren
-- copy rule (down)
_intraOinh =
_lhsIinh
-- copy rule (down)
_intraOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_intraOnr =
_lhsInr
-- copy rule (down)
_intraOnt =
_lhsInt
-- copy rule (from local)
_intraOo_case =
_o_case
-- copy rule (down)
_intraOo_cata =
_lhsIo_cata
-- copy rule (down)
_intraOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_intraOo_data =
_lhsIo_data
-- copy rule (down)
_intraOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_intraOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_intraOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_intraOo_rename =
_lhsIo_rename
-- copy rule (down)
_intraOo_sem =
_lhsIo_sem
-- copy rule (down)
_intraOo_sig =
_lhsIo_sig
-- copy rule (from local)
_intraOo_splitsems =
_o_splitsems
-- copy rule (down)
_intraOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_intraOo_traces =
_lhsIo_traces
-- copy rule (down)
_intraOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_intraOprefix =
_lhsIprefix
-- copy rule (down)
_intraOsyn =
_lhsIsyn
-- copy rule (down)
_intraOterminals =
_lhsIterminals
( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) =
(vss_ _vssOchildren _vssOcon _vssOdeclsAbove _vssOerrors _vssOhigherOrderChildren _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOprefix _vssOsyn _vssOterminals _vssOwhat )
( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) =
(intra_ _intraOchildren _intraOcon _intraOdeclsAbove _intraOerrors _intraOhigherOrderChildren _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOprefix _intraOsyn _intraOterminals _intraOwhat )
in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames))) )
-- CVisits -----------------------------------------------------
{-
visit 0:
inherited attributes:
allPragmas : PragmaMap
children : [(Name,Type,Bool)]
con : Constructor
inh : Attributes
instVisitNrs : Map Identifier Int
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
terminals : [Name]
with_sig : Bool
chained attribute:
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
comments : [String]
decls : Decls
gatherInstVisitNrs : Map Identifier Int
intra : Exprs
intraVars : Set String
isNil : Bool
semNames : [String]
alternatives:
alternative Cons:
child hd : CVisit
child tl : CVisits
alternative Nil:
-}
-- cata
sem_CVisits :: CVisits ->
T_CVisits
sem_CVisits list =
(Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) )
-- semantic domain
newtype T_CVisits = T_CVisits (PragmaMap ->
([(Name,Type,Bool)]) ->
Constructor ->
(Seq Error) ->
Attributes ->
(Map Identifier Int) ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
([Name]) ->
Bool ->
( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),Bool,([String])))
data Inh_CVisits = Inh_CVisits {allPragmas_Inh_CVisits :: PragmaMap,children_Inh_CVisits :: [(Name,Type,Bool)],con_Inh_CVisits :: Constructor,errors_Inh_CVisits :: Seq Error,inh_Inh_CVisits :: Attributes,instVisitNrs_Inh_CVisits :: Map Identifier Int,nr_Inh_CVisits :: Int,nt_Inh_CVisits :: Nonterminal,o_case_Inh_CVisits :: Bool,o_cata_Inh_CVisits :: Bool,o_costcentre_Inh_CVisits :: Bool,o_data_Inh_CVisits :: Maybe Bool,o_linePragmas_Inh_CVisits :: Bool,o_newtypes_Inh_CVisits :: Bool,o_pretty_Inh_CVisits :: Bool,o_rename_Inh_CVisits :: Bool,o_sem_Inh_CVisits :: Bool,o_sig_Inh_CVisits :: Bool,o_splitsems_Inh_CVisits :: Bool,o_strictwrap_Inh_CVisits :: Bool,o_traces_Inh_CVisits :: Bool,o_unbox_Inh_CVisits :: Bool,prefix_Inh_CVisits :: String,syn_Inh_CVisits :: Attributes,terminals_Inh_CVisits :: [Name],with_sig_Inh_CVisits :: Bool}
data Syn_CVisits = Syn_CVisits {allTpsFound_Syn_CVisits :: Bool,comments_Syn_CVisits :: [String],decls_Syn_CVisits :: Decls,errors_Syn_CVisits :: Seq Error,gatherInstVisitNrs_Syn_CVisits :: Map Identifier Int,intra_Syn_CVisits :: Exprs,intraVars_Syn_CVisits :: Set String,isNil_Syn_CVisits :: Bool,semNames_Syn_CVisits :: [String]}
wrap_CVisits (T_CVisits sem ) (Inh_CVisits _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig ) =
(let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames) =
(sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig )
in (Syn_CVisits _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames ))
sem_CVisits_Cons :: T_CVisit ->
T_CVisits ->
T_CVisits
sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) =
(T_CVisits (\ _lhsIallPragmas
_lhsIchildren
_lhsIcon
_lhsIerrors
_lhsIinh
_lhsIinstVisitNrs
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwith_sig ->
(let _tlOnr :: Int
_lhsOisNil :: Bool
_hdOisLast :: Bool
_hdOnextIntra :: Exprs
_hdOnextIntraVars :: (Set String)
_lhsOintra :: Exprs
_lhsOintraVars :: (Set String)
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOerrors :: (Seq Error)
_lhsOgatherInstVisitNrs :: (Map Identifier Int)
_lhsOsemNames :: ([String])
_hdOallPragmas :: PragmaMap
_hdOchildren :: ([(Name,Type,Bool)])
_hdOcon :: Constructor
_hdOerrors :: (Seq Error)
_hdOinh :: Attributes
_hdOinstVisitNrs :: (Map Identifier Int)
_hdOnr :: Int
_hdOnt :: Nonterminal
_hdOo_case :: Bool
_hdOo_cata :: Bool
_hdOo_costcentre :: Bool
_hdOo_data :: (Maybe Bool)
_hdOo_linePragmas :: Bool
_hdOo_newtypes :: Bool
_hdOo_pretty :: Bool
_hdOo_rename :: Bool
_hdOo_sem :: Bool
_hdOo_sig :: Bool
_hdOo_splitsems :: Bool
_hdOo_strictwrap :: Bool
_hdOo_traces :: Bool
_hdOo_unbox :: Bool
_hdOprefix :: String
_hdOsyn :: Attributes
_hdOterminals :: ([Name])
_hdOwith_sig :: Bool
_tlOallPragmas :: PragmaMap
_tlOchildren :: ([(Name,Type,Bool)])
_tlOcon :: Constructor
_tlOerrors :: (Seq Error)
_tlOinh :: Attributes
_tlOinstVisitNrs :: (Map Identifier Int)
_tlOnt :: Nonterminal
_tlOo_case :: Bool
_tlOo_cata :: Bool
_tlOo_costcentre :: Bool
_tlOo_data :: (Maybe Bool)
_tlOo_linePragmas :: Bool
_tlOo_newtypes :: Bool
_tlOo_pretty :: Bool
_tlOo_rename :: Bool
_tlOo_sem :: Bool
_tlOo_sig :: Bool
_tlOo_splitsems :: Bool
_tlOo_strictwrap :: Bool
_tlOo_traces :: Bool
_tlOo_unbox :: Bool
_tlOprefix :: String
_tlOsyn :: Attributes
_tlOterminals :: ([Name])
_tlOwith_sig :: Bool
_hdIallTpsFound :: Bool
_hdIcomments :: ([String])
_hdIdecls :: Decls
_hdIerrors :: (Seq Error)
_hdIgatherInstVisitNrs :: (Map Identifier Int)
_hdIintra :: Exprs
_hdIintraVars :: (Set String)
_hdIsemNames :: ([String])
_tlIallTpsFound :: Bool
_tlIcomments :: ([String])
_tlIdecls :: Decls
_tlIerrors :: (Seq Error)
_tlIgatherInstVisitNrs :: (Map Identifier Int)
_tlIintra :: Exprs
_tlIintraVars :: (Set String)
_tlIisNil :: Bool
_tlIsemNames :: ([String])
-- "GenerateCode.ag"(line 161, column 11)
_tlOnr =
_lhsInr + 1
-- "GenerateCode.ag"(line 174, column 12)
_lhsOisNil =
False
-- "GenerateCode.ag"(line 175, column 12)
_hdOisLast =
_tlIisNil
-- "GenerateCode.ag"(line 192, column 12)
_hdOnextIntra =
_tlIintra
-- "GenerateCode.ag"(line 193, column 12)
_hdOnextIntraVars =
_tlIintraVars
-- "GenerateCode.ag"(line 194, column 12)
_lhsOintra =
_hdIintra
-- "GenerateCode.ag"(line 195, column 12)
_lhsOintraVars =
_hdIintraVars
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
_hdIallTpsFound && _tlIallTpsFound
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
_hdIcomments ++ _tlIcomments
-- use rule "GenerateCode.ag"(line 276, column 33)
_lhsOdecls =
_hdIdecls ++ _tlIdecls
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- use rule "GenerateCode.ag"(line 346, column 44)
_lhsOgatherInstVisitNrs =
_hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs
-- use rule "GenerateCode.ag"(line 774, column 63)
_lhsOsemNames =
_hdIsemNames ++ _tlIsemNames
-- copy rule (down)
_hdOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_hdOchildren =
_lhsIchildren
-- copy rule (down)
_hdOcon =
_lhsIcon
-- copy rule (down)
_hdOerrors =
_lhsIerrors
-- copy rule (down)
_hdOinh =
_lhsIinh
-- copy rule (down)
_hdOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_hdOnr =
_lhsInr
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOo_case =
_lhsIo_case
-- copy rule (down)
_hdOo_cata =
_lhsIo_cata
-- copy rule (down)
_hdOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_hdOo_data =
_lhsIo_data
-- copy rule (down)
_hdOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_hdOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_hdOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_hdOo_rename =
_lhsIo_rename
-- copy rule (down)
_hdOo_sem =
_lhsIo_sem
-- copy rule (down)
_hdOo_sig =
_lhsIo_sig
-- copy rule (down)
_hdOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_hdOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_hdOo_traces =
_lhsIo_traces
-- copy rule (down)
_hdOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_hdOprefix =
_lhsIprefix
-- copy rule (down)
_hdOsyn =
_lhsIsyn
-- copy rule (down)
_hdOterminals =
_lhsIterminals
-- copy rule (down)
_hdOwith_sig =
_lhsIwith_sig
-- copy rule (down)
_tlOallPragmas =
_lhsIallPragmas
-- copy rule (down)
_tlOchildren =
_lhsIchildren
-- copy rule (down)
_tlOcon =
_lhsIcon
-- copy rule (chain)
_tlOerrors =
_hdIerrors
-- copy rule (down)
_tlOinh =
_lhsIinh
-- copy rule (down)
_tlOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOo_case =
_lhsIo_case
-- copy rule (down)
_tlOo_cata =
_lhsIo_cata
-- copy rule (down)
_tlOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_tlOo_data =
_lhsIo_data
-- copy rule (down)
_tlOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_tlOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_tlOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_tlOo_rename =
_lhsIo_rename
-- copy rule (down)
_tlOo_sem =
_lhsIo_sem
-- copy rule (down)
_tlOo_sig =
_lhsIo_sig
-- copy rule (down)
_tlOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_tlOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_tlOo_traces =
_lhsIo_traces
-- copy rule (down)
_tlOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_tlOprefix =
_lhsIprefix
-- copy rule (down)
_tlOsyn =
_lhsIsyn
-- copy rule (down)
_tlOterminals =
_lhsIterminals
-- copy rule (down)
_tlOwith_sig =
_lhsIwith_sig
( _hdIallTpsFound,_hdIcomments,_hdIdecls,_hdIerrors,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames) =
(hd_ _hdOallPragmas _hdOchildren _hdOcon _hdOerrors _hdOinh _hdOinstVisitNrs _hdOisLast _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOterminals _hdOwith_sig )
( _tlIallTpsFound,_tlIcomments,_tlIdecls,_tlIerrors,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames) =
(tl_ _tlOallPragmas _tlOchildren _tlOcon _tlOerrors _tlOinh _tlOinstVisitNrs _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOterminals _tlOwith_sig )
in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))) )
sem_CVisits_Nil :: T_CVisits
sem_CVisits_Nil =
(T_CVisits (\ _lhsIallPragmas
_lhsIchildren
_lhsIcon
_lhsIerrors
_lhsIinh
_lhsIinstVisitNrs
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwith_sig ->
(let _lhsOisNil :: Bool
_lhsOintra :: Exprs
_lhsOintraVars :: (Set String)
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOerrors :: (Seq Error)
_lhsOgatherInstVisitNrs :: (Map Identifier Int)
_lhsOsemNames :: ([String])
-- "GenerateCode.ag"(line 176, column 10)
_lhsOisNil =
True
-- "GenerateCode.ag"(line 196, column 10)
_lhsOintra =
[]
-- "GenerateCode.ag"(line 197, column 10)
_lhsOintraVars =
Set.empty
-- use rule "GenerateCode.ag"(line 551, column 39)
_lhsOallTpsFound =
True
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
[]
-- use rule "GenerateCode.ag"(line 276, column 33)
_lhsOdecls =
[]
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
Seq.empty
-- use rule "GenerateCode.ag"(line 346, column 44)
_lhsOgatherInstVisitNrs =
Map.empty
-- use rule "GenerateCode.ag"(line 774, column 63)
_lhsOsemNames =
[]
in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))) )
-- DeclBlocks --------------------------------------------------
{-
visit 0:
inherited attributes:
blockNr : Int
lastExprVars : [String]
nextVisitDecls : [Decl]
optCase : Bool
prefix : String
synthesized attributes:
callExpr : Expr
decls : [Decl]
freeVars : [String]
alternatives:
alternative DeclBlock:
child defs : {[Decl]}
child visit : {Decl}
child next : DeclBlocks
visit 0:
local lambdaName : _
local pragmaDecl : _
local freeVars : _
local decl : _
alternative DeclTerminator:
child defs : {[Decl]}
child result : {Expr}
visit 0:
local lambdaName : _
local pragmaDecl : _
local freeVars : _
-}
-- cata
sem_DeclBlocks :: DeclBlocks ->
T_DeclBlocks
sem_DeclBlocks (DeclBlock _defs _visit _next ) =
(sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next ) )
sem_DeclBlocks (DeclTerminator _defs _result ) =
(sem_DeclBlocks_DeclTerminator _defs _result )
-- semantic domain
newtype T_DeclBlocks = T_DeclBlocks (Int ->
([String]) ->
([Decl]) ->
Bool ->
String ->
( Expr,([Decl]),([String])))
data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: Int,lastExprVars_Inh_DeclBlocks :: [String],nextVisitDecls_Inh_DeclBlocks :: [Decl],optCase_Inh_DeclBlocks :: Bool,prefix_Inh_DeclBlocks :: String}
data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: Expr,decls_Syn_DeclBlocks :: [Decl],freeVars_Syn_DeclBlocks :: [String]}
wrap_DeclBlocks (T_DeclBlocks sem ) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) =
(let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) =
(sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix )
in (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars ))
sem_DeclBlocks_DeclBlock :: ([Decl]) ->
Decl ->
T_DeclBlocks ->
T_DeclBlocks
sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_ ) =
(T_DeclBlocks (\ _lhsIblockNr
_lhsIlastExprVars
_lhsInextVisitDecls
_lhsIoptCase
_lhsIprefix ->
(let _nextOblockNr :: Int
_lhsOcallExpr :: Expr
_lhsOdecls :: ([Decl])
_lhsOfreeVars :: ([String])
_nextOlastExprVars :: ([String])
_nextOnextVisitDecls :: ([Decl])
_nextOoptCase :: Bool
_nextOprefix :: String
_nextIcallExpr :: Expr
_nextIdecls :: ([Decl])
_nextIfreeVars :: ([String])
-- "GenerateCode.ag"(line 443, column 7)
_nextOblockNr =
_lhsIblockNr + 1
-- "GenerateCode.ag"(line 448, column 7)
_lambdaName =
_lhsIprefix ++ "_block" ++ show _lhsIblockNr
-- "GenerateCode.ag"(line 449, column 7)
_pragmaDecl =
PragmaDecl ("NOINLINE " ++ _lambdaName )
-- "GenerateCode.ag"(line 450, column 7)
_lhsOcallExpr =
App _lambdaName (map SimpleExpr _freeVars )
-- "GenerateCode.ag"(line 454, column 7)
_freeVars =
freevars _nextIfreeVars (visit_ : defs_)
-- "GenerateCode.ag"(line 461, column 7)
_decl =
mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr
-- "GenerateCode.ag"(line 462, column 7)
_lhsOdecls =
(if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls
-- copy rule (from local)
_lhsOfreeVars =
_freeVars
-- copy rule (down)
_nextOlastExprVars =
_lhsIlastExprVars
-- copy rule (down)
_nextOnextVisitDecls =
_lhsInextVisitDecls
-- copy rule (down)
_nextOoptCase =
_lhsIoptCase
-- copy rule (down)
_nextOprefix =
_lhsIprefix
( _nextIcallExpr,_nextIdecls,_nextIfreeVars) =
(next_ _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix )
in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) )
sem_DeclBlocks_DeclTerminator :: ([Decl]) ->
Expr ->
T_DeclBlocks
sem_DeclBlocks_DeclTerminator defs_ result_ =
(T_DeclBlocks (\ _lhsIblockNr
_lhsIlastExprVars
_lhsInextVisitDecls
_lhsIoptCase
_lhsIprefix ->
(let _lhsOcallExpr :: Expr
_lhsOdecls :: ([Decl])
_lhsOfreeVars :: ([String])
-- "GenerateCode.ag"(line 448, column 7)
_lambdaName =
_lhsIprefix ++ "_block" ++ show _lhsIblockNr
-- "GenerateCode.ag"(line 449, column 7)
_pragmaDecl =
PragmaDecl ("NOINLINE " ++ _lambdaName )
-- "GenerateCode.ag"(line 450, column 7)
_lhsOcallExpr =
App _lambdaName (map SimpleExpr _freeVars )
-- "GenerateCode.ag"(line 452, column 7)
_freeVars =
freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)
-- "GenerateCode.ag"(line 459, column 7)
_lhsOdecls =
[ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ]
-- copy rule (from local)
_lhsOfreeVars =
_freeVars
in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) )
-- DeclBlocksRoot ----------------------------------------------
{-
visit 0:
inherited attributes:
lastExprVars : [String]
nextVisitDecls : [Decl]
optCase : Bool
prefix : String
synthesized attributes:
firstCall : Expr
lambdas : [Decl]
alternatives:
alternative DeclBlocksRoot:
child blocks : DeclBlocks
-}
-- cata
sem_DeclBlocksRoot :: DeclBlocksRoot ->
T_DeclBlocksRoot
sem_DeclBlocksRoot (DeclBlocksRoot _blocks ) =
(sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks ) )
-- semantic domain
newtype T_DeclBlocksRoot = T_DeclBlocksRoot (([String]) ->
([Decl]) ->
Bool ->
String ->
( Expr,([Decl])))
data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: [String],nextVisitDecls_Inh_DeclBlocksRoot :: [Decl],optCase_Inh_DeclBlocksRoot :: Bool,prefix_Inh_DeclBlocksRoot :: String}
data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: Expr,lambdas_Syn_DeclBlocksRoot :: [Decl]}
wrap_DeclBlocksRoot (T_DeclBlocksRoot sem ) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) =
(let ( _lhsOfirstCall,_lhsOlambdas) =
(sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix )
in (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas ))
sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks ->
T_DeclBlocksRoot
sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_ ) =
(T_DeclBlocksRoot (\ _lhsIlastExprVars
_lhsInextVisitDecls
_lhsIoptCase
_lhsIprefix ->
(let _lhsOlambdas :: ([Decl])
_lhsOfirstCall :: Expr
_blocksOblockNr :: Int
_blocksOlastExprVars :: ([String])
_blocksOnextVisitDecls :: ([Decl])
_blocksOoptCase :: Bool
_blocksOprefix :: String
_blocksIcallExpr :: Expr
_blocksIdecls :: ([Decl])
_blocksIfreeVars :: ([String])
-- "GenerateCode.ag"(line 434, column 7)
_lhsOlambdas =
_blocksIdecls
-- "GenerateCode.ag"(line 435, column 7)
_lhsOfirstCall =
_blocksIcallExpr
-- "GenerateCode.ag"(line 440, column 7)
_blocksOblockNr =
1
-- copy rule (down)
_blocksOlastExprVars =
_lhsIlastExprVars
-- copy rule (down)
_blocksOnextVisitDecls =
_lhsInextVisitDecls
-- copy rule (down)
_blocksOoptCase =
_lhsIoptCase
-- copy rule (down)
_blocksOprefix =
_lhsIprefix
( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) =
(blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix )
in ( _lhsOfirstCall,_lhsOlambdas))) )
-- Pattern -----------------------------------------------------
{-
visit 0:
synthesized attributes:
copy : SELF
definedInsts : [Identifier]
patternAttributes : [(Name, Name)]
alternatives:
alternative Alias:
child field : {Name}
child attr : {Name}
child pat : Pattern
child parts : Patterns
visit 0:
local copy : _
alternative Constr:
child name : {Constructor}
child pats : Patterns
visit 0:
local copy : _
alternative Product:
child pos : {Pos}
child pats : Patterns
visit 0:
local copy : _
alternative Underscore:
child pos : {Pos}
visit 0:
local copy : _
-}
-- cata
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern (Alias _field _attr _pat _parts ) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) )
sem_Pattern (Constr _name _pats ) =
(sem_Pattern_Constr _name (sem_Patterns _pats ) )
sem_Pattern (Product _pos _pats ) =
(sem_Pattern_Product _pos (sem_Patterns _pats ) )
sem_Pattern (Underscore _pos ) =
(sem_Pattern_Underscore _pos )
-- semantic domain
newtype T_Pattern = T_Pattern (( Pattern,([Identifier]),([(Name, Name)])))
data Inh_Pattern = Inh_Pattern {}
data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedInsts_Syn_Pattern :: [Identifier],patternAttributes_Syn_Pattern :: [(Name, Name)]}
wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =
(let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =
(sem )
in (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes ))
sem_Pattern_Alias :: Name ->
Name ->
T_Pattern ->
T_Patterns ->
T_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =
(T_Pattern (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Pattern
_patIcopy :: Pattern
_patIdefinedInsts :: ([Identifier])
_patIpatternAttributes :: ([(Name, Name)])
_partsIcopy :: Patterns
_partsIdefinedInsts :: ([Identifier])
_partsIpatternAttributes :: ([(Name, Name)])
-- "GenerateCode.ag"(line 142, column 11)
_lhsOdefinedInsts =
(if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts
-- "GenerateCode.ag"(line 150, column 7)
_lhsOpatternAttributes =
(field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes)
-- self rule
_copy =
Alias field_ attr_ _patIcopy _partsIcopy
-- self rule
_lhsOcopy =
_copy
( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) =
(pat_ )
( _partsIcopy,_partsIdefinedInsts,_partsIpatternAttributes) =
(parts_ )
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
sem_Pattern_Constr :: Constructor ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr name_ (T_Patterns pats_ ) =
(T_Pattern (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
_patsIdefinedInsts :: ([Identifier])
_patsIpatternAttributes :: ([(Name, Name)])
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
_patsIdefinedInsts
-- use rule "GenerateCode.ag"(line 147, column 47)
_lhsOpatternAttributes =
_patsIpatternAttributes
-- self rule
_copy =
Constr name_ _patsIcopy
-- self rule
_lhsOcopy =
_copy
( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =
(pats_ )
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product pos_ (T_Patterns pats_ ) =
(T_Pattern (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
_patsIdefinedInsts :: ([Identifier])
_patsIpatternAttributes :: ([(Name, Name)])
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
_patsIdefinedInsts
-- use rule "GenerateCode.ag"(line 147, column 47)
_lhsOpatternAttributes =
_patsIpatternAttributes
-- self rule
_copy =
Product pos_ _patsIcopy
-- self rule
_lhsOcopy =
_copy
( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =
(pats_ )
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore pos_ =
(T_Pattern (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Pattern
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
[]
-- use rule "GenerateCode.ag"(line 147, column 47)
_lhsOpatternAttributes =
[]
-- self rule
_copy =
Underscore pos_
-- self rule
_lhsOcopy =
_copy
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
-- Patterns ----------------------------------------------------
{-
visit 0:
synthesized attributes:
copy : SELF
definedInsts : [Identifier]
patternAttributes : [(Name, Name)]
alternatives:
alternative Cons:
child hd : Pattern
child tl : Patterns
visit 0:
local copy : _
alternative Nil:
visit 0:
local copy : _
-}
-- cata
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) )
-- semantic domain
newtype T_Patterns = T_Patterns (( Patterns,([Identifier]),([(Name, Name)])))
data Inh_Patterns = Inh_Patterns {}
data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedInsts_Syn_Patterns :: [Identifier],patternAttributes_Syn_Patterns :: [(Name, Name)]}
wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =
(let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =
(sem )
in (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes ))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =
(T_Patterns (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Patterns
_hdIcopy :: Pattern
_hdIdefinedInsts :: ([Identifier])
_hdIpatternAttributes :: ([(Name, Name)])
_tlIcopy :: Patterns
_tlIdefinedInsts :: ([Identifier])
_tlIpatternAttributes :: ([(Name, Name)])
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
_hdIdefinedInsts ++ _tlIdefinedInsts
-- use rule "GenerateCode.ag"(line 147, column 47)
_lhsOpatternAttributes =
_hdIpatternAttributes ++ _tlIpatternAttributes
-- self rule
_copy =
(:) _hdIcopy _tlIcopy
-- self rule
_lhsOcopy =
_copy
( _hdIcopy,_hdIdefinedInsts,_hdIpatternAttributes) =
(hd_ )
( _tlIcopy,_tlIdefinedInsts,_tlIpatternAttributes) =
(tl_ )
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (let _lhsOdefinedInsts :: ([Identifier])
_lhsOpatternAttributes :: ([(Name, Name)])
_lhsOcopy :: Patterns
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
[]
-- use rule "GenerateCode.ag"(line 147, column 47)
_lhsOpatternAttributes =
[]
-- self rule
_copy =
[]
-- self rule
_lhsOcopy =
_copy
in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )
-- Sequence ----------------------------------------------------
{-
visit 0:
inherited attributes:
children : [(Name,Type,Bool)]
con : Constructor
higherOrderChildren : [(Name,Type,Bool)]
inh : Attributes
instVisitNrs : Map Identifier Int
lastExpr : Expr
nr : Int
nt : Nonterminal
o_case : Bool
o_cata : Bool
o_costcentre : Bool
o_data : Maybe Bool
o_linePragmas : Bool
o_newtypes : Bool
o_pretty : Bool
o_rename : Bool
o_sem : Bool
o_sig : Bool
o_splitsems : Bool
o_strictwrap : Bool
o_traces : Bool
o_unbox : Bool
prefix : String
syn : Attributes
terminals : [Name]
what : String
chained attributes:
declsAbove : [Decl]
errors : Seq Error
synthesized attributes:
allTpsFound : Bool
blockDecls : DeclBlocks
comments : [String]
decls : Decls
definedInsts : [Identifier]
exprs : Exprs
tSigs : [Decl]
tps : [Type]
usedVars : Set String
alternatives:
alternative Cons:
child hd : CRule
child tl : Sequence
alternative Nil:
-}
-- cata
sem_Sequence :: Sequence ->
T_Sequence
sem_Sequence list =
(Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) )
-- semantic domain
newtype T_Sequence = T_Sequence (([(Name,Type,Bool)]) ->
Constructor ->
([Decl]) ->
(Seq Error) ->
([(Name,Type,Bool)]) ->
Attributes ->
(Map Identifier Int) ->
Expr ->
Int ->
Nonterminal ->
Bool ->
Bool ->
Bool ->
(Maybe Bool) ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
Bool ->
String ->
Attributes ->
([Name]) ->
String ->
( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))
data Inh_Sequence = Inh_Sequence {children_Inh_Sequence :: [(Name,Type,Bool)],con_Inh_Sequence :: Constructor,declsAbove_Inh_Sequence :: [Decl],errors_Inh_Sequence :: Seq Error,higherOrderChildren_Inh_Sequence :: [(Name,Type,Bool)],inh_Inh_Sequence :: Attributes,instVisitNrs_Inh_Sequence :: Map Identifier Int,lastExpr_Inh_Sequence :: Expr,nr_Inh_Sequence :: Int,nt_Inh_Sequence :: Nonterminal,o_case_Inh_Sequence :: Bool,o_cata_Inh_Sequence :: Bool,o_costcentre_Inh_Sequence :: Bool,o_data_Inh_Sequence :: Maybe Bool,o_linePragmas_Inh_Sequence :: Bool,o_newtypes_Inh_Sequence :: Bool,o_pretty_Inh_Sequence :: Bool,o_rename_Inh_Sequence :: Bool,o_sem_Inh_Sequence :: Bool,o_sig_Inh_Sequence :: Bool,o_splitsems_Inh_Sequence :: Bool,o_strictwrap_Inh_Sequence :: Bool,o_traces_Inh_Sequence :: Bool,o_unbox_Inh_Sequence :: Bool,prefix_Inh_Sequence :: String,syn_Inh_Sequence :: Attributes,terminals_Inh_Sequence :: [Name],what_Inh_Sequence :: String}
data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: Bool,blockDecls_Syn_Sequence :: DeclBlocks,comments_Syn_Sequence :: [String],decls_Syn_Sequence :: Decls,declsAbove_Syn_Sequence :: [Decl],definedInsts_Syn_Sequence :: [Identifier],errors_Syn_Sequence :: Seq Error,exprs_Syn_Sequence :: Exprs,tSigs_Syn_Sequence :: [Decl],tps_Syn_Sequence :: [Type],usedVars_Syn_Sequence :: Set String}
wrap_Sequence (T_Sequence sem ) (Inh_Sequence _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat ) =
(let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =
(sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat )
in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars ))
sem_Sequence_Cons :: T_CRule ->
T_Sequence ->
T_Sequence
sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) =
(T_Sequence (\ _lhsIchildren
_lhsIcon
_lhsIdeclsAbove
_lhsIerrors
_lhsIhigherOrderChildren
_lhsIinh
_lhsIinstVisitNrs
_lhsIlastExpr
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwhat ->
(let _lhsOblockDecls :: DeclBlocks
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOexprs :: Exprs
_lhsOtSigs :: ([Decl])
_lhsOtps :: ([Type])
_lhsOusedVars :: (Set String)
_lhsOdeclsAbove :: ([Decl])
_hdOchildren :: ([(Name,Type,Bool)])
_hdOcon :: Constructor
_hdOdeclsAbove :: ([Decl])
_hdOerrors :: (Seq Error)
_hdOhigherOrderChildren :: ([(Name,Type,Bool)])
_hdOinh :: Attributes
_hdOinstVisitNrs :: (Map Identifier Int)
_hdOnr :: Int
_hdOnt :: Nonterminal
_hdOo_case :: Bool
_hdOo_cata :: Bool
_hdOo_costcentre :: Bool
_hdOo_data :: (Maybe Bool)
_hdOo_linePragmas :: Bool
_hdOo_newtypes :: Bool
_hdOo_pretty :: Bool
_hdOo_rename :: Bool
_hdOo_sem :: Bool
_hdOo_sig :: Bool
_hdOo_splitsems :: Bool
_hdOo_strictwrap :: Bool
_hdOo_traces :: Bool
_hdOo_unbox :: Bool
_hdOprefix :: String
_hdOsyn :: Attributes
_hdOterminals :: ([Name])
_hdOwhat :: String
_tlOchildren :: ([(Name,Type,Bool)])
_tlOcon :: Constructor
_tlOdeclsAbove :: ([Decl])
_tlOerrors :: (Seq Error)
_tlOhigherOrderChildren :: ([(Name,Type,Bool)])
_tlOinh :: Attributes
_tlOinstVisitNrs :: (Map Identifier Int)
_tlOlastExpr :: Expr
_tlOnr :: Int
_tlOnt :: Nonterminal
_tlOo_case :: Bool
_tlOo_cata :: Bool
_tlOo_costcentre :: Bool
_tlOo_data :: (Maybe Bool)
_tlOo_linePragmas :: Bool
_tlOo_newtypes :: Bool
_tlOo_pretty :: Bool
_tlOo_rename :: Bool
_tlOo_sem :: Bool
_tlOo_sig :: Bool
_tlOo_splitsems :: Bool
_tlOo_strictwrap :: Bool
_tlOo_traces :: Bool
_tlOo_unbox :: Bool
_tlOprefix :: String
_tlOsyn :: Attributes
_tlOterminals :: ([Name])
_tlOwhat :: String
_hdIallTpsFound :: Bool
_hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks)
_hdIcomments :: ([String])
_hdIdecls :: Decls
_hdIdeclsAbove :: ([Decl])
_hdIdefinedInsts :: ([Identifier])
_hdIerrors :: (Seq Error)
_hdIexprs :: Exprs
_hdItSigs :: ([Decl])
_hdItps :: ([Type])
_hdIusedVars :: (Set String)
_tlIallTpsFound :: Bool
_tlIblockDecls :: DeclBlocks
_tlIcomments :: ([String])
_tlIdecls :: Decls
_tlIdeclsAbove :: ([Decl])
_tlIdefinedInsts :: ([Identifier])
_tlIerrors :: (Seq Error)
_tlIexprs :: Exprs
_tlItSigs :: ([Decl])
_tlItps :: ([Type])
_tlIusedVars :: (Set String)
-- "GenerateCode.ag"(line 375, column 7)
_lhsOblockDecls =
_hdIbldBlocksFun _tlIblockDecls
-- use rule "GenerateCode.ag"(line 265, column 39)
_lhsOallTpsFound =
_hdIallTpsFound && _tlIallTpsFound
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
_hdIcomments ++ _tlIcomments
-- use rule "GenerateCode.ag"(line 87, column 34)
_lhsOdecls =
_hdIdecls ++ _tlIdecls
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
_hdIdefinedInsts ++ _tlIdefinedInsts
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- use rule "GenerateCode.ag"(line 213, column 34)
_lhsOexprs =
_hdIexprs ++ _tlIexprs
-- use rule "GenerateCode.ag"(line 238, column 33)
_lhsOtSigs =
_hdItSigs ++ _tlItSigs
-- use rule "GenerateCode.ag"(line 264, column 31)
_lhsOtps =
_hdItps ++ _tlItps
-- use rule "GenerateCode.ag"(line 227, column 37)
_lhsOusedVars =
_hdIusedVars `Set.union` _tlIusedVars
-- copy rule (up)
_lhsOdeclsAbove =
_tlIdeclsAbove
-- copy rule (down)
_hdOchildren =
_lhsIchildren
-- copy rule (down)
_hdOcon =
_lhsIcon
-- copy rule (down)
_hdOdeclsAbove =
_lhsIdeclsAbove
-- copy rule (down)
_hdOerrors =
_lhsIerrors
-- copy rule (down)
_hdOhigherOrderChildren =
_lhsIhigherOrderChildren
-- copy rule (down)
_hdOinh =
_lhsIinh
-- copy rule (down)
_hdOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_hdOnr =
_lhsInr
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOo_case =
_lhsIo_case
-- copy rule (down)
_hdOo_cata =
_lhsIo_cata
-- copy rule (down)
_hdOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_hdOo_data =
_lhsIo_data
-- copy rule (down)
_hdOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_hdOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_hdOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_hdOo_rename =
_lhsIo_rename
-- copy rule (down)
_hdOo_sem =
_lhsIo_sem
-- copy rule (down)
_hdOo_sig =
_lhsIo_sig
-- copy rule (down)
_hdOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_hdOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_hdOo_traces =
_lhsIo_traces
-- copy rule (down)
_hdOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_hdOprefix =
_lhsIprefix
-- copy rule (down)
_hdOsyn =
_lhsIsyn
-- copy rule (down)
_hdOterminals =
_lhsIterminals
-- copy rule (down)
_hdOwhat =
_lhsIwhat
-- copy rule (down)
_tlOchildren =
_lhsIchildren
-- copy rule (down)
_tlOcon =
_lhsIcon
-- copy rule (chain)
_tlOdeclsAbove =
_hdIdeclsAbove
-- copy rule (chain)
_tlOerrors =
_hdIerrors
-- copy rule (down)
_tlOhigherOrderChildren =
_lhsIhigherOrderChildren
-- copy rule (down)
_tlOinh =
_lhsIinh
-- copy rule (down)
_tlOinstVisitNrs =
_lhsIinstVisitNrs
-- copy rule (down)
_tlOlastExpr =
_lhsIlastExpr
-- copy rule (down)
_tlOnr =
_lhsInr
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOo_case =
_lhsIo_case
-- copy rule (down)
_tlOo_cata =
_lhsIo_cata
-- copy rule (down)
_tlOo_costcentre =
_lhsIo_costcentre
-- copy rule (down)
_tlOo_data =
_lhsIo_data
-- copy rule (down)
_tlOo_linePragmas =
_lhsIo_linePragmas
-- copy rule (down)
_tlOo_newtypes =
_lhsIo_newtypes
-- copy rule (down)
_tlOo_pretty =
_lhsIo_pretty
-- copy rule (down)
_tlOo_rename =
_lhsIo_rename
-- copy rule (down)
_tlOo_sem =
_lhsIo_sem
-- copy rule (down)
_tlOo_sig =
_lhsIo_sig
-- copy rule (down)
_tlOo_splitsems =
_lhsIo_splitsems
-- copy rule (down)
_tlOo_strictwrap =
_lhsIo_strictwrap
-- copy rule (down)
_tlOo_traces =
_lhsIo_traces
-- copy rule (down)
_tlOo_unbox =
_lhsIo_unbox
-- copy rule (down)
_tlOprefix =
_lhsIprefix
-- copy rule (down)
_tlOsyn =
_lhsIsyn
-- copy rule (down)
_tlOterminals =
_lhsIterminals
-- copy rule (down)
_tlOwhat =
_lhsIwhat
( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) =
(hd_ _hdOchildren _hdOcon _hdOdeclsAbove _hdOerrors _hdOhigherOrderChildren _hdOinh _hdOinstVisitNrs _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOterminals _hdOwhat )
( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) =
(tl_ _tlOchildren _tlOcon _tlOdeclsAbove _tlOerrors _tlOhigherOrderChildren _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOterminals _tlOwhat )
in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )
sem_Sequence_Nil :: T_Sequence
sem_Sequence_Nil =
(T_Sequence (\ _lhsIchildren
_lhsIcon
_lhsIdeclsAbove
_lhsIerrors
_lhsIhigherOrderChildren
_lhsIinh
_lhsIinstVisitNrs
_lhsIlastExpr
_lhsInr
_lhsInt
_lhsIo_case
_lhsIo_cata
_lhsIo_costcentre
_lhsIo_data
_lhsIo_linePragmas
_lhsIo_newtypes
_lhsIo_pretty
_lhsIo_rename
_lhsIo_sem
_lhsIo_sig
_lhsIo_splitsems
_lhsIo_strictwrap
_lhsIo_traces
_lhsIo_unbox
_lhsIprefix
_lhsIsyn
_lhsIterminals
_lhsIwhat ->
(let _lhsOblockDecls :: DeclBlocks
_lhsOallTpsFound :: Bool
_lhsOcomments :: ([String])
_lhsOdecls :: Decls
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOexprs :: Exprs
_lhsOtSigs :: ([Decl])
_lhsOtps :: ([Type])
_lhsOusedVars :: (Set String)
_lhsOdeclsAbove :: ([Decl])
-- "GenerateCode.ag"(line 377, column 7)
_lhsOblockDecls =
DeclTerminator _lhsIdeclsAbove _lhsIlastExpr
-- use rule "GenerateCode.ag"(line 265, column 39)
_lhsOallTpsFound =
True
-- use rule "GenerateCode.ag"(line 583, column 52)
_lhsOcomments =
[]
-- use rule "GenerateCode.ag"(line 87, column 34)
_lhsOdecls =
[]
-- use rule "GenerateCode.ag"(line 140, column 55)
_lhsOdefinedInsts =
[]
-- use rule "GenerateCode.ag"(line 564, column 32)
_lhsOerrors =
Seq.empty
-- use rule "GenerateCode.ag"(line 213, column 34)
_lhsOexprs =
[]
-- use rule "GenerateCode.ag"(line 238, column 33)
_lhsOtSigs =
[]
-- use rule "GenerateCode.ag"(line 264, column 31)
_lhsOtps =
[]
-- use rule "GenerateCode.ag"(line 227, column 37)
_lhsOusedVars =
Set.empty
-- copy rule (chain)
_lhsOdeclsAbove =
_lhsIdeclsAbove
in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )