summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeroenBransen <>2020-09-15 19:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-09-15 19:45:00 (GMT)
commit727f496b23f25b08f8c01b9c6a5dc32d1a5b409b (patch)
tree99b08f5d58875eca577dcc1a96733c8c04eeccd0
parentae2c2ebb517df6746955640e5e85a77ef85f4a1e (diff)
version 0.9.53HEAD0.9.53master
-rwxr-xr-x[-rw-r--r--]LICENSE46
-rwxr-xr-x[-rw-r--r--]README38
-rwxr-xr-x[-rw-r--r--]Setup.hs80
-rwxr-xr-x[-rw-r--r--]src-ag/DistChildAttr.ag48
-rwxr-xr-x[-rw-r--r--]src-ag/ExecutionPlanCommon.ag322
-rwxr-xr-x[-rw-r--r--]src-ag/ExecutionPlanPre.ag30
-rwxr-xr-x[-rw-r--r--]src-ag/LOAG/Prepare.ag632
-rwxr-xr-x[-rw-r--r--]src-generated/AG2AspectAG.hs5856
-rwxr-xr-x[-rw-r--r--]src-generated/AbstractSyntax.hs272
-rwxr-xr-x[-rw-r--r--]src-generated/AbstractSyntaxDump.hs2166
-rwxr-xr-x[-rw-r--r--]src-generated/Code.hs710
-rwxr-xr-x[-rw-r--r--]src-generated/CodeSyntax.hs300
-rwxr-xr-x[-rw-r--r--]src-generated/CodeSyntaxDump.hs2218
-rwxr-xr-x[-rw-r--r--]src-generated/ConcreteSyntax.hs520
-rwxr-xr-x[-rw-r--r--]src-generated/DeclBlocks.hs54
-rwxr-xr-x[-rw-r--r--]src-generated/DefaultRules.hs9452
-rwxr-xr-x[-rw-r--r--]src-generated/Desugar.hs8936
-rwxr-xr-x[-rw-r--r--]src-generated/ErrorMessages.hs396
-rwxr-xr-x[-rw-r--r--]src-generated/ExecutionPlan.hs346
-rwxr-xr-x[-rw-r--r--]src-generated/ExecutionPlan2Caml.hs12294
-rwxr-xr-x[-rw-r--r--]src-generated/ExecutionPlan2Clean.hs14002
-rwxr-xr-x[-rw-r--r--]src-generated/ExecutionPlan2Hs.hs14014
-rwxr-xr-x[-rw-r--r--]src-generated/Expression.hs32
-rwxr-xr-x[-rw-r--r--]src-generated/GenerateCode.hs10574
-rwxr-xr-x[-rw-r--r--]src-generated/HsToken.hs112
-rwxr-xr-x[-rw-r--r--]src-generated/Interfaces.hs100
-rwxr-xr-x[-rw-r--r--]src-generated/InterfacesRules.hs2426
-rwxr-xr-x[-rw-r--r--]src-generated/KWOrder.hs4610
-rwxr-xr-x[-rw-r--r--]src-generated/LOAG/Order.hs12476
-rwxr-xr-x[-rw-r--r--]src-generated/LOAG/Rep.hs212
-rwxr-xr-x[-rw-r--r--]src-generated/Macro.hs104
-rwxr-xr-x[-rw-r--r--]src-generated/Order.hs7692
-rwxr-xr-x[-rw-r--r--]src-generated/Patterns.hs124
-rwxr-xr-x[-rw-r--r--]src-generated/PrintCleanCode.hs8814
-rwxr-xr-x[-rw-r--r--]src-generated/PrintCode.hs8270
-rwxr-xr-x[-rw-r--r--]src-generated/PrintErrorMessages.hs3330
-rwxr-xr-x[-rw-r--r--]src-generated/PrintOcamlCode.hs5324
-rwxr-xr-x[-rw-r--r--]src-generated/PrintVisitCode.hs1932
-rwxr-xr-x[-rw-r--r--]src-generated/ResolveLocals.hs4010
-rwxr-xr-x[-rw-r--r--]src-generated/SemHsTokens.hs1378
-rwxr-xr-x[-rw-r--r--]src-generated/TfmToVisage.hs2648
-rwxr-xr-x[-rw-r--r--]src-generated/Transform.hs12516
-rwxr-xr-x[-rw-r--r--]src-generated/Visage.hs1804
-rwxr-xr-x[-rw-r--r--]src-generated/VisagePatterns.hs82
-rwxr-xr-x[-rw-r--r--]src-generated/VisageSyntax.hs192
-rwxr-xr-x[-rw-r--r--]src-main/Main.hs10
-rwxr-xr-x[-rw-r--r--]src-options/Options.hs1106
-rwxr-xr-x[-rw-r--r--]src-version/Version.hs0
-rwxr-xr-x[-rw-r--r--]src/ATermAbstractSyntax.hs46
-rwxr-xr-x[-rw-r--r--]src/ATermWrite.hs0
-rwxr-xr-x[-rw-r--r--]src/Ag.hs1116
-rwxr-xr-x[-rw-r--r--]src/CommonTypes.hs574
-rwxr-xr-x[-rw-r--r--]src/GrammarInfo.hs108
-rwxr-xr-x[-rw-r--r--]src/HsTokenScanner.hs388
-rwxr-xr-x[-rw-r--r--]src/KennedyWarren.hs1700
-rwxr-xr-x[-rw-r--r--]src/Knuth1.hs1064
-rwxr-xr-x[-rw-r--r--]src/LOAG/AOAG.hs564
-rwxr-xr-x[-rw-r--r--]src/LOAG/Chordal.hs530
-rwxr-xr-x[-rw-r--r--]src/LOAG/Common.hs596
-rwxr-xr-x[-rw-r--r--]src/LOAG/Graphs.hs310
-rwxr-xr-x[-rw-r--r--]src/LOAG/Optimise.hs600
-rwxr-xr-x[-rw-r--r--]src/LOAG/Solver/MiniSat.hs188
-rwxr-xr-x[-rw-r--r--]src/PPUtil.hs118
-rwxr-xr-x[-rw-r--r--]src/Parser.hs1226
-rwxr-xr-x[-rw-r--r--]src/Pretty.hs382
-rwxr-xr-x[-rw-r--r--]src/RhsCheck.hs130
-rwxr-xr-x[-rw-r--r--]src/Scanner.hs468
-rwxr-xr-x[-rw-r--r--]src/SequentialComputation.lhs782
-rwxr-xr-x[-rw-r--r--]src/SequentialTypes.hs328
-rwxr-xr-x[-rw-r--r--]src/TokenDef.hs172
-rwxr-xr-x[-rw-r--r--]src/UU/UUAGC.hs22
-rwxr-xr-x[-rw-r--r--]src/UU/UUAGC/Version.hs8
-rwxr-xr-x[-rw-r--r--]uuagc.cabal248
-rwxr-xr-x[-rw-r--r--]uuagc_options234
74 files changed, 87258 insertions, 87254 deletions
diff --git a/LICENSE b/LICENSE
index aaacbdb..fb556dd 100644..100755
--- a/LICENSE
+++ b/LICENSE
@@ -1,23 +1,23 @@
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
- * Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of the Universiteit Utrecht nor the
- names of its contributors may be used to endorse or promote products
- derived from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL UNIVERSITEIT UTRECHT BE LIABLE FOR ANY
-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of the Universiteit Utrecht nor the
+ names of its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL UNIVERSITEIT UTRECHT BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
index a133d13..6675904 100644..100755
--- a/README
+++ b/README
@@ -1,19 +1,19 @@
-To install UUAG, use cabal in combination with Setup.hs
-
-By default, "cabal install" will install UUAGC from the
-included Haskell sources. To build from the AG sources
-using an existing uuagc installation, use:
-
-cabal install --ghc-options="-DEXTERNAL_UUAGC"
-
-Note: to produce a source release, you'll need to use the
-Setup.hs because cabal-install at the time is not able to
-do this in combination with the cabal plugin:
-
---
-cabal clean # remove possible junk
-ghc --make Setup.hs -o setup
-./setup configure --user
-./setup build
-./setup sdist
---
+To install UUAG, use cabal in combination with Setup.hs
+
+By default, "cabal install" will install UUAGC from the
+included Haskell sources. To build from the AG sources
+using an existing uuagc installation, use:
+
+cabal install --ghc-options="-DEXTERNAL_UUAGC"
+
+Note: to produce a source release, you'll need to use the
+Setup.hs because cabal-install at the time is not able to
+do this in combination with the cabal plugin:
+
+--
+cabal clean # remove possible junk
+ghc --make Setup.hs -o setup
+./setup configure --user
+./setup build
+./setup sdist
+--
diff --git a/Setup.hs b/Setup.hs
index af08571..7810c89 100644..100755
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,40 +1,40 @@
--- Note: to bootstrap uuagc with a commandline uuagc,
--- pass the -DEXTERNAL_UUAGC to GHC
--- when building setup.hs. This can be accomplished using
--- cabal install with --ghc-options="-DEXTERNAL_UUAGC".
---
--- When this option is used, a cabal flag will be set so
--- that the Haskell sources will be regenerated from
--- the attribute grammar sources
---
--- Note: it would be nicer if this behavior could be enabled
--- with a configure flag. However, a compiled Setup.hs is
--- required in order to perform 'configure', so configure
--- flags are regarded too late in the process.
--- Also note that this Setup.hs has conditional package
--- requirements depending on what code is used.
-
-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-{-# LANGUAGE CPP #-}
-module Main where
-
-#ifdef EXTERNAL_UUAGC
-import System.Environment (getArgs)
-import Distribution.Simple (defaultMainWithHooksArgs)
-import Distribution.Simple.UUAGC (uuagcUserHook)
-
-main :: IO ()
-main = args >>= defaultMainWithHooksArgs uuagcUserHook
-
-args :: IO [String]
-args = do
- as <- getArgs
- let addFlags | "configure" `elem` as = ("--flags=bootstrap_external" :)
- | otherwise = id
- return (addFlags as)
-#else
-import Distribution.Simple (defaultMain, defaultMainWithHooksArgs)
-
-main :: IO ()
-main = defaultMain
-#endif
+-- Note: to bootstrap uuagc with a commandline uuagc,
+-- pass the -DEXTERNAL_UUAGC to GHC
+-- when building setup.hs. This can be accomplished using
+-- cabal install with --ghc-options="-DEXTERNAL_UUAGC".
+--
+-- When this option is used, a cabal flag will be set so
+-- that the Haskell sources will be regenerated from
+-- the attribute grammar sources
+--
+-- Note: it would be nicer if this behavior could be enabled
+-- with a configure flag. However, a compiled Setup.hs is
+-- required in order to perform 'configure', so configure
+-- flags are regarded too late in the process.
+-- Also note that this Setup.hs has conditional package
+-- requirements depending on what code is used.
+
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
+{-# LANGUAGE CPP #-}
+module Main where
+
+#ifdef EXTERNAL_UUAGC
+import System.Environment (getArgs)
+import Distribution.Simple (defaultMainWithHooksArgs)
+import Distribution.Simple.UUAGC (uuagcUserHook)
+
+main :: IO ()
+main = args >>= defaultMainWithHooksArgs uuagcUserHook
+
+args :: IO [String]
+args = do
+ as <- getArgs
+ let addFlags | "configure" `elem` as = ("--flags=bootstrap_external" :)
+ | otherwise = id
+ return (addFlags as)
+#else
+import Distribution.Simple (defaultMain, defaultMainWithHooksArgs)
+
+main :: IO ()
+main = defaultMain
+#endif
diff --git a/src-ag/DistChildAttr.ag b/src-ag/DistChildAttr.ag
index 2f6866a..3aa83bb 100644..100755
--- a/src-ag/DistChildAttr.ag
+++ b/src-ag/DistChildAttr.ag
@@ -1,24 +1,24 @@
--------------------------------------------------------------------------------
--- Map of all inherited and synthesized attributes per nonterminal
--------------------------------------------------------------------------------
-ATTR Nonterminals Nonterminal [ || inhMap', synMap' USE {`Map.union`} {Map.empty} : {Map Identifier Attributes} ]
-
-SEM Nonterminal
- | Nonterminal lhs.inhMap' = Map.singleton @nt @inh
- lhs.synMap' = Map.singleton @nt @syn
-
-ATTR Nonterminals Nonterminal
- Productions Production
- Children Child [ inhMap, synMap : {Map Identifier Attributes} | | ]
-
-SEM Grammar
- | Grammar nonts.inhMap = @nonts.inhMap'
- nonts.synMap = @nonts.synMap'
-
-SEM Child
- | Child loc.chnt = case @tp of
- NT nt _ _ -> nt
- Self -> error ("The type of child " ++ show @name ++ " should not be a Self type.")
- Haskell t -> identifier "" -- should be ignored because the child is a terminal
- loc.inh = Map.findWithDefault Map.empty @loc.chnt @lhs.inhMap
- loc.syn = Map.findWithDefault Map.empty @loc.chnt @lhs.synMap
+-------------------------------------------------------------------------------
+-- Map of all inherited and synthesized attributes per nonterminal
+-------------------------------------------------------------------------------
+ATTR Nonterminals Nonterminal [ || inhMap', synMap' USE {`Map.union`} {Map.empty} : {Map Identifier Attributes} ]
+
+SEM Nonterminal
+ | Nonterminal lhs.inhMap' = Map.singleton @nt @inh
+ lhs.synMap' = Map.singleton @nt @syn
+
+ATTR Nonterminals Nonterminal
+ Productions Production
+ Children Child [ inhMap, synMap : {Map Identifier Attributes} | | ]
+
+SEM Grammar
+ | Grammar nonts.inhMap = @nonts.inhMap'
+ nonts.synMap = @nonts.synMap'
+
+SEM Child
+ | Child loc.chnt = case @tp of
+ NT nt _ _ -> nt
+ Self -> error ("The type of child " ++ show @name ++ " should not be a Self type.")
+ Haskell t -> identifier "" -- should be ignored because the child is a terminal
+ loc.inh = Map.findWithDefault Map.empty @loc.chnt @lhs.inhMap
+ loc.syn = Map.findWithDefault Map.empty @loc.chnt @lhs.synMap
diff --git a/src-ag/ExecutionPlanCommon.ag b/src-ag/ExecutionPlanCommon.ag
index 55f7f02..15ebc32 100644..100755
--- a/src-ag/ExecutionPlanCommon.ag
+++ b/src-ag/ExecutionPlanCommon.ag
@@ -1,161 +1,161 @@
--------------------------------------------------------------------------------
--- Distributing options
--------------------------------------------------------------------------------
-ATTR Grammar Nonterminals Nonterminal Productions Production Children Child
- [ options : {Options} | | ]
-
--------------------------------------------------------------------------------
--- Find out which nonterminals are recursive
--------------------------------------------------------------------------------
-
-ATTR Nonterminals Nonterminal [ | | ntDeps, ntHoDeps USE {`mappend`} {mempty} : {Map NontermIdent (Set NontermIdent)} ]
-ATTR Nonterminals Nonterminal [ closedNtDeps, closedHoNtDeps, closedHoNtRevDeps : {Map NontermIdent (Set NontermIdent)} | | ]
-ATTR Productions Production Children Child [ | | refNts, refHoNts USE {`mappend`} {mempty} : {Set NontermIdent} ]
-
-SEM Nonterminal | Nonterminal
- lhs.ntDeps = Map.singleton @nt @prods.refNts
- lhs.ntHoDeps = Map.singleton @nt @prods.refHoNts
-
- loc.closedNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedNtDeps
- loc.closedHoNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtDeps
- loc.closedHoNtRevDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtRevDeps
-
- loc.recursive = @nt `Set.member` @loc.closedNtDeps
- loc.nontrivAcyc = @nt `Set.member` @loc.closedHoNtDeps
- loc.hoInfo = HigherOrderInfo { hoNtDeps = @loc.closedHoNtDeps
- , hoNtRevDeps = @loc.closedHoNtRevDeps
- , hoAcyclic = @loc.nontrivAcyc
- }
-
-SEM Child | Child
- loc.refNts = case @tp of
- NT nt _ _ -> Set.singleton nt
- _ -> mempty
- loc.refHoNts = if @loc.isHigherOrder then @loc.refNts else mempty
- loc.isHigherOrder = case @kind of
- ChildSyntax -> False
- _ -> True
-
-SEM Grammar | Grammar
- loc.closedNtDeps = closeMap @nonts.ntDeps
- loc.closedHoNtDeps = closeMap @nonts.ntHoDeps
- loc.closedHoNtRevDeps = revDeps @loc.closedHoNtDeps
-
--------------------------------------------------------------------------------
--- Distribute the ContextMap to nonterminals
--------------------------------------------------------------------------------
-
-ATTR Nonterminals Nonterminal [ classContexts : ContextMap | | ]
-
-SEM Grammar | Grammar
- nonts.classContexts = @contextMap
-
-SEM Nonterminal | Nonterminal
- loc.classContexts = Map.findWithDefault [] @nt @lhs.classContexts
-
--------------------------------------------------------------------------------
--- Gather all rules per production for the execution plan
--------------------------------------------------------------------------------
-ATTR Expression [ | | copy : SELF ]
-
-ATTR Rule [ | | erules : ERule ]
-ATTR Rules [ | | erules USE {:} {[]} : ERules ]
-
-SEM Rule
- | Rule lhs.erules = ERule @loc.rulename
- @pattern.copy
- @rhs.copy
- @owrt
- @origin
- @explicit
- @pure
- @mbError
-
--------------------------------------------------------------------------------
--- Determine which children have an around-rule
--------------------------------------------------------------------------------
-
--- Propagate the around-map downward
-ATTR Nonterminals Nonterminal
- [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ]
-
-ATTR Productions Production
- [ aroundMap : {Map ConstructorIdent (Map Identifier [Expression])} || ]
-
-ATTR Children Child
- [ aroundMap : {Map Identifier [Expression]} | | ]
-
-SEM Nonterminal | Nonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap
-SEM Production | Production loc.aroundMap = Map.findWithDefault Map.empty @con @lhs.aroundMap
-
-SEM Grammar | Grammar
- nonts.aroundMap = @aroundsMap
-
-SEM Child | Child
- loc.hasArounds = case Map.lookup @name @lhs.aroundMap of
- Nothing -> False
- Just as -> not (null as)
-
--------------------------------------------------------------------------------
--- Determine which children are used by merges
--------------------------------------------------------------------------------
-
--- Propagate the around-map downward
-ATTR Nonterminals Nonterminal
- [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} || ]
-
-ATTR Productions Production
- [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))} || ]
-
-ATTR Children Child
- [ mergeMap : {Map Identifier (Identifier, [Identifier], Expression)} mergedChildren : {Set Identifier} | | ]
-
-SEM Nonterminal | Nonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap
-SEM Production | Production loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap
-
-SEM Grammar | Grammar
- nonts.mergeMap = @mergeMap
-
-SEM Production | Production
- loc.mergedChildren = Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems @loc.mergeMap ]
-
-SEM Child | Child
- loc.merges = maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup @name @lhs.mergeMap
- loc.isMerged = @name `Set.member` @lhs.mergedChildren
-
-
--------------------------------------------------------------------------------
--- Gather all childs per production for the execution plan
--------------------------------------------------------------------------------
-
-ATTR Child [ | | echilds : EChild ]
-ATTR Children [ | | echilds USE {:} {[]} : EChildren ]
-
-SEM Child
- | Child lhs.echilds = case @tp of
- NT _ _ _ -> EChild @name @tp @kind @loc.hasArounds @loc.merges @loc.isMerged
- _ -> ETerm @name @tp
-
--------------------------------------------------------------------------------
--- Output nonterminal type mappings
--------------------------------------------------------------------------------
-ATTR Grammar
- Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes}
- synmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} ]
-
-ATTR Nonterminal [ | | inhmap : {Map.Map NontermIdent Attributes}
- synmap : {Map.Map NontermIdent Attributes} ]
-SEM Nonterminal
- | Nonterminal lhs.inhmap = Map.singleton @nt @inh
- lhs.synmap = Map.singleton @nt @syn
-
--------------------------------------------------------------------------------
--- Output nonterminal type mappings
--------------------------------------------------------------------------------
-ATTR Grammar Nonterminals Nonterminal [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))} ]
-ATTR Productions Production [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map ConstructorIdent (Map.Map Identifier Type)} ]
-ATTR TypeSigs TypeSig [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map Identifier Type} ]
-
-SEM Nonterminal | Nonterminal lhs.localSigMap = Map.singleton @nt @prods.localSigMap
-SEM Production | Production lhs.localSigMap = Map.singleton @con @typeSigs.localSigMap
-SEM TypeSig | TypeSig lhs.localSigMap = Map.singleton @name @tp
+-------------------------------------------------------------------------------
+-- Distributing options
+-------------------------------------------------------------------------------
+ATTR Grammar Nonterminals Nonterminal Productions Production Children Child
+ [ options : {Options} | | ]
+
+-------------------------------------------------------------------------------
+-- Find out which nonterminals are recursive
+-------------------------------------------------------------------------------
+
+ATTR Nonterminals Nonterminal [ | | ntDeps, ntHoDeps USE {`mappend`} {mempty} : {Map NontermIdent (Set NontermIdent)} ]
+ATTR Nonterminals Nonterminal [ closedNtDeps, closedHoNtDeps, closedHoNtRevDeps : {Map NontermIdent (Set NontermIdent)} | | ]
+ATTR Productions Production Children Child [ | | refNts, refHoNts USE {`mappend`} {mempty} : {Set NontermIdent} ]
+
+SEM Nonterminal | Nonterminal
+ lhs.ntDeps = Map.singleton @nt @prods.refNts
+ lhs.ntHoDeps = Map.singleton @nt @prods.refHoNts
+
+ loc.closedNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedNtDeps
+ loc.closedHoNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtDeps
+ loc.closedHoNtRevDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtRevDeps
+
+ loc.recursive = @nt `Set.member` @loc.closedNtDeps
+ loc.nontrivAcyc = @nt `Set.member` @loc.closedHoNtDeps
+ loc.hoInfo = HigherOrderInfo { hoNtDeps = @loc.closedHoNtDeps
+ , hoNtRevDeps = @loc.closedHoNtRevDeps
+ , hoAcyclic = @loc.nontrivAcyc
+ }
+
+SEM Child | Child
+ loc.refNts = case @tp of
+ NT nt _ _ -> Set.singleton nt
+ _ -> mempty
+ loc.refHoNts = if @loc.isHigherOrder then @loc.refNts else mempty
+ loc.isHigherOrder = case @kind of
+ ChildSyntax -> False
+ _ -> True
+
+SEM Grammar | Grammar
+ loc.closedNtDeps = closeMap @nonts.ntDeps
+ loc.closedHoNtDeps = closeMap @nonts.ntHoDeps
+ loc.closedHoNtRevDeps = revDeps @loc.closedHoNtDeps
+
+-------------------------------------------------------------------------------
+-- Distribute the ContextMap to nonterminals
+-------------------------------------------------------------------------------
+
+ATTR Nonterminals Nonterminal [ classContexts : ContextMap | | ]
+
+SEM Grammar | Grammar
+ nonts.classContexts = @contextMap
+
+SEM Nonterminal | Nonterminal
+ loc.classContexts = Map.findWithDefault [] @nt @lhs.classContexts
+
+-------------------------------------------------------------------------------
+-- Gather all rules per production for the execution plan
+-------------------------------------------------------------------------------
+ATTR Expression [ | | copy : SELF ]
+
+ATTR Rule [ | | erules : ERule ]
+ATTR Rules [ | | erules USE {:} {[]} : ERules ]
+
+SEM Rule
+ | Rule lhs.erules = ERule @loc.rulename
+ @pattern.copy
+ @rhs.copy
+ @owrt
+ @origin
+ @explicit
+ @pure
+ @mbError
+
+-------------------------------------------------------------------------------
+-- Determine which children have an around-rule
+-------------------------------------------------------------------------------
+
+-- Propagate the around-map downward
+ATTR Nonterminals Nonterminal
+ [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ]
+
+ATTR Productions Production
+ [ aroundMap : {Map ConstructorIdent (Map Identifier [Expression])} || ]
+
+ATTR Children Child
+ [ aroundMap : {Map Identifier [Expression]} | | ]
+
+SEM Nonterminal | Nonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap
+SEM Production | Production loc.aroundMap = Map.findWithDefault Map.empty @con @lhs.aroundMap
+
+SEM Grammar | Grammar
+ nonts.aroundMap = @aroundsMap
+
+SEM Child | Child
+ loc.hasArounds = case Map.lookup @name @lhs.aroundMap of
+ Nothing -> False
+ Just as -> not (null as)
+
+-------------------------------------------------------------------------------
+-- Determine which children are used by merges
+-------------------------------------------------------------------------------
+
+-- Propagate the around-map downward
+ATTR Nonterminals Nonterminal
+ [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} || ]
+
+ATTR Productions Production
+ [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))} || ]
+
+ATTR Children Child
+ [ mergeMap : {Map Identifier (Identifier, [Identifier], Expression)} mergedChildren : {Set Identifier} | | ]
+
+SEM Nonterminal | Nonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap
+SEM Production | Production loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap
+
+SEM Grammar | Grammar
+ nonts.mergeMap = @mergeMap
+
+SEM Production | Production
+ loc.mergedChildren = Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems @loc.mergeMap ]
+
+SEM Child | Child
+ loc.merges = maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup @name @lhs.mergeMap
+ loc.isMerged = @name `Set.member` @lhs.mergedChildren
+
+
+-------------------------------------------------------------------------------
+-- Gather all childs per production for the execution plan
+-------------------------------------------------------------------------------
+
+ATTR Child [ | | echilds : EChild ]
+ATTR Children [ | | echilds USE {:} {[]} : EChildren ]
+
+SEM Child
+ | Child lhs.echilds = case @tp of
+ NT _ _ _ -> EChild @name @tp @kind @loc.hasArounds @loc.merges @loc.isMerged
+ _ -> ETerm @name @tp
+
+-------------------------------------------------------------------------------
+-- Output nonterminal type mappings
+-------------------------------------------------------------------------------
+ATTR Grammar
+ Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes}
+ synmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} ]
+
+ATTR Nonterminal [ | | inhmap : {Map.Map NontermIdent Attributes}
+ synmap : {Map.Map NontermIdent Attributes} ]
+SEM Nonterminal
+ | Nonterminal lhs.inhmap = Map.singleton @nt @inh
+ lhs.synmap = Map.singleton @nt @syn
+
+-------------------------------------------------------------------------------
+-- Output nonterminal type mappings
+-------------------------------------------------------------------------------
+ATTR Grammar Nonterminals Nonterminal [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))} ]
+ATTR Productions Production [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map ConstructorIdent (Map.Map Identifier Type)} ]
+ATTR TypeSigs TypeSig [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map Identifier Type} ]
+
+SEM Nonterminal | Nonterminal lhs.localSigMap = Map.singleton @nt @prods.localSigMap
+SEM Production | Production lhs.localSigMap = Map.singleton @con @typeSigs.localSigMap
+SEM TypeSig | TypeSig lhs.localSigMap = Map.singleton @name @tp
diff --git a/src-ag/ExecutionPlanPre.ag b/src-ag/ExecutionPlanPre.ag
index 0fdf025..ba0103a 100644..100755
--- a/src-ag/ExecutionPlanPre.ag
+++ b/src-ag/ExecutionPlanPre.ag
@@ -1,15 +1,15 @@
--------------------------------------------------------------------------------
--- Give unique names to rules
--------------------------------------------------------------------------------
-ATTR Nonterminal Nonterminals
- Production Productions
- Rule Rules [ | rulenumber : Int | ]
-
-SEM Grammar
- | Grammar nonts.rulenumber = 0
-
-SEM Rule
- | Rule lhs.rulenumber = @lhs.rulenumber + 1
- loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName
-
-
+-------------------------------------------------------------------------------
+-- Give unique names to rules
+-------------------------------------------------------------------------------
+ATTR Nonterminal Nonterminals
+ Production Productions
+ Rule Rules [ | rulenumber : Int | ]
+
+SEM Grammar
+ | Grammar nonts.rulenumber = 0
+
+SEM Rule
+ | Rule lhs.rulenumber = @lhs.rulenumber + 1
+ loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName
+
+
diff --git a/src-ag/LOAG/Prepare.ag b/src-ag/LOAG/Prepare.ag
index 3952f84..7787bc7 100644..100755
--- a/src-ag/LOAG/Prepare.ag
+++ b/src-ag/LOAG/Prepare.ag
@@ -1,316 +1,316 @@
-INCLUDE "AbstractSyntax.ag"
-INCLUDE "Patterns.ag"
-INCLUDE "CodeSyntax.ag"
-INCLUDE "Expression.ag"
-INCLUDE "HsToken.ag"
-INCLUDE "LOAG/Rep"
-INCLUDE "ExecutionPlanPre"
-
-MODULE {LOAG.Prepare}
-{}
-{}
-
-{
--- | Translating UUAGC types to MyTypes
-drhs f | f == _LHS = Inh
- | f == _LOC = AnyDir
- | f == _INST = AnyDir
- | otherwise = Syn
-dlhs f | f == _LHS = Syn
- | f == _LOC = AnyDir
- | f == _INST = AnyDir
- | otherwise = Inh
-
-depToEdge :: PMP_R -> PLabel -> Dependency -> Edge
-depToEdge pmpr p e =
- (findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f1) (getName i1, drhs f1),
- findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f2) (getName i2, dlhs f2))
- where Dependency (OccAttr f1 i1) (OccAttr f2 i2) = e
-
-vertexToAttr :: NMP -> Vertex -> Attributes
-vertexToAttr nmp v = Map.singleton (identifier a) (fromMyTy ty)
- where (MyAttribute ty (a,_)) = findWithErr nmp "vertexToAttr" v
-
-}
-
-SEM Grammar | Grammar
- inst.smf : LOAGRep
- loc.initO= if Map.null @nonts.pmp then 1 else fst $ Map.findMin @nonts.pmp
- inst.smf =
- LOAGRep @nonts.ps @nonts.ap @loc.an
- @loc.ain @loc.asn @loc.sfp
- @nonts.pmp @nonts.pmpr @loc.nmp @loc.nmpr
- (A.array (@loc.initO, @loc.initO + Map.size @nonts.gen) $
- Map.toList $ @nonts.gen)
- (A.array (1,Map.size @nonts.inss) $
- Map.toList $ @nonts.inss)
- (A.array (@loc.initO, @loc.initO + length @nonts.ofld) $
- @nonts.ofld) @nonts.fty @nonts.fieldMap @nonts.fsInP
- loc.nmp = Map.fromList $ zip [1..] @loc.atts
- loc.nmpr = Map.fromList $ zip @loc.atts [1..]
- loc.an = Map.unionWith (++) @loc.ain @loc.asn
- loc.ain = @nonts.inhs
- loc.asn = @nonts.syns
- loc.atts = concat $ Map.elems @loc.an
- loc.occs = concat $ Map.elems @nonts.ap
- nonts.augM = @manualAttrOrderMap
-
--- Collecting the attributes
-ATTR Nonterminals Nonterminal [
- augM : {Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))} ||
- inhs USE {Map.union} {Map.empty} : AI_N
- syns USE {Map.union} {Map.empty} : AS_N ]
-
-SEM Nonterminal | Nonterminal
- lhs.inhs = let dty = TyData (getName @nt)
- in Map.singleton dty (toMyAttr Inh dty @inh)
- lhs.syns = let dty = TyData (getName @nt)
- in Map.singleton dty (toMyAttr Syn dty @syn)
- prods.augM = case Map.lookup @nt @lhs.augM of
- Nothing -> Map.empty
- Just a -> a
-
--- Adding all attribute sets to the AG type
--- and sending it all down the abstract tree
-ATTR Nonterminals Nonterminal Productions Production Children Child
- MySegments MySegment [
- ain : {MyType -> MyAttributes}
- asn : {MyType -> MyAttributes}
- pmpf : PMP
- pmprf : PMP_R
- lfpf : SF_P
- hoMapf: HOMap
- fty : FTY
- nmp : NMP || ]
-
-SEM Grammar | Grammar
- nonts.ain = map2F @loc.ain
- nonts.asn = map2F @loc.asn
- nonts.pmpf = @nonts.pmp
- nonts.pmprf = @nonts.pmpr
- nonts.lfpf = @nonts.lfp
- nonts.hoMapf= @nonts.hoMap
- nonts.ftyf = @nonts.fty
- nonts.fty = @nonts.fty
-
--- Make sure TDP AND LFPRF are passed around correctly to code-generation
-ATTR Nonterminals Nonterminal Productions Production [
- ftyf: FTY ||]
-
-
--- Calculate the set of production labels
-SEM Grammar | Grammar
- loc.ps = @nonts.ps
-ATTR Nonterminals Nonterminal Productions Production [ ||
- ads USE {(++)} {[]} : {[Edge]}
- fieldMap USE {(Map.union)} {Map.empty} : FMap
- hoMap USE {(Map.union)} {Map.empty} : HOMap
- fsInP USE {(Map.union)} {Map.empty} : FsInP]
-
-SEM Nonterminals Nonterminal [ ||
- ps USE {(++)} {([])} : {[PLabel]} ]
-SEM Productions [ ||
- ps USE {:} {([])} : {[PLabel]} ]
-SEM Production [ || ps : PLabel ] | Production
- loc.ps = (@lhs.dty,getName @con)
- lhs.ads =
- case Map.lookup @con @lhs.augM of
- Nothing -> []
- Just a -> Set.toList $ Set.map (depToEdge @children.pmpr @loc.pll) a
- children.dty = @lhs.dty
-
-ATTR Productions Production [
- augM : {Map.Map Identifier (Set.Set Dependency)} || ]
--- We didnt calculate A_P yet, inheriting A_N we can
-ATTR Productions Production Rules Rule [
- -- result type of this constructor
- dty : {MyType} || ]
-ATTR Rules Rule Children Child Expression HsTokensRoot HsTokens HsToken [
- pll : {PLabel} || ]
-SEM Nonterminal | Nonterminal
- loc.dty = TyData (getName @nt)
-
-ATTR Nonterminals Nonterminal Productions Production Children Child
- FieldAtts FieldAtt [
- an : {MyType -> MyAttributes}
- nmprf : NMP_R|
- olab : Int -- chained attribute for handing out labels to occurrences
- flab : Int |--chained attribute for handing out labels to fields
- ap USE {Map.unionWith (++)} {Map.empty} : A_P
- gen USE {Map.union} {Map.empty} : {Map Int Int}
- inss USE {Map.unionWith (++)} {Map.empty} : {Map Int [Int]}
- pmp USE {Map.union} {Map.empty} : PMP
- pmpr USE {Map.union} {Map.empty} : PMP_R
- -- maps for each occurrence to which field it belongs
- ofld USE {(++)} {[]} : {[(Int, Int)]}
- fty USE {Map.union} {Map.empty} : FTY
- ]
-
-SEM Grammar | Grammar
- nonts.an = map2F @loc.an
- nonts.nmprf= @loc.nmpr
- nonts.olab = if Map.null @loc.nmp then 0 else (fst $ Map.findMax @loc.nmp)
- nonts.flab = 0
-
-ATTR Children Child [||
- fieldMap USE {Map.union} {Map.empty} : FMap
- hoMap USE {Map.unionWith (Set.union)} {Map.empty} : HOMap
- ]
-SEM Children [ dty : {MyType} || ]
- | Nil
- loc.flab = @lhs.flab + 1
- loc.atp = fst @lhs.pll
- inst.fatts : FieldAtts
- inst.fatts = map ((FieldAtt @loc.atp @lhs.pll "lhs") . alab) $
- @lhs.an @loc.atp
- fatts.flab = @loc.flab
- loc.label = (@lhs.pll, "lhs")
- loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp
- loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp
- loc.fieldMap= Map.singleton @loc.label (@loc.foccsI, @loc.foccsS)
- lhs.fty = Map.singleton @loc.label @lhs.dty
-
-SEM Child | Child
- loc.flab = @lhs.flab + 1
- loc.atp = toMyTy @tp
- inst.fatts : FieldAtts
- inst.fatts = map ((FieldAtt @loc.atp @lhs.pll (getName @name)) . alab)
- $ @lhs.an @loc.atp
- fatts.flab = @loc.flab
- loc.ident = getName @name
- loc.label = (@lhs.pll, @loc.ident)
- loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp
- loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp
- loc.fieldMap= if Set.null @loc.foccsI && Set.null @loc.foccsS
- then Map.empty
- else Map.singleton @loc.label (@loc.foccsS,@loc.foccsI)
- loc.hoMap = case @kind of
- ChildAttr -> Map.singleton @lhs.pll (Set.singleton @loc.ident)
- _ -> Map.empty
- lhs.fty = Map.singleton (@lhs.pll, getName @name) @loc.atp
-
-SEM FieldAtt | FieldAtt
- loc.olab = @lhs.olab + 1
- loc.alab = findWithErr @lhs.nmprf "getting attr label" @loc.att
- loc.att = @t <.> @a
- loc.occ = (@p, @f) >.< @a
- loc.pmp = Map.singleton @loc.olab @loc.occ
- loc.pmpr = Map.singleton @loc.occ @loc.olab
- loc.inss = Map.singleton @loc.alab [@loc.olab]
- loc.gen = Map.singleton @loc.olab @loc.alab
- lhs.ap = Map.singleton @p [@loc.occ]
- lhs.ofld = [(@loc.olab, @lhs.flab)]
-
--- calculate representation of semantic function
--- definitions per non-terminal and from it, calculate E_P
-SEM Grammar | Grammar
- loc.sfp = repLocRefs @nonts.lfp $ addHigherOrders @nonts.lfp @nonts.sfp
-ATTR Nonterminals Nonterminal Productions Production Rules Rule [ ||
- sfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of non-locals
- ruleMap USE {Map.union} {Map.empty} : {Map.Map MyOccurrence Identifier}
- lfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of local attrs
- lfpr USE {Map.unionWith (Set.union)} {Map.empty} : SF_P ]-- reverse
-SEM Production | Production
- loc.pll = (@lhs.dty,getName @con)
- rules.pll = @pll
- rules.pts = @children.pts
- lhs.fsInP = Map.singleton @pll $ Map.keys @children.fieldMap
-
-ATTR Children Child [ ||
- pts USE {Set.union} {Set.empty} : {Set.Set FLabel} ]
-
-SEM Child | Child
- lhs.pts = Set.singleton $ getName @name
-
-ATTR Rules Rule [
- lfpf : SF_P ||
- usedLocals USE {(Set.union)} {Set.empty} : {Set.Set MyOccurrence}]
-
-SEM Rule | Rule
- loc.usedLocals = Set.filter (\(MyOccurrence (_,f) _) -> f == "loc") @rhs.used
- loc.usesLocals = not $ Set.null @loc.usedLocals
- (lhs.sfp,lhs.ruleMap,lhs.lfp,lhs.lfpr) =
- foldr (\(f, a, b) (m',rm', l', lr') ->
- let att = (@lhs.pll, f) >.< a
- rm = Map.insert att @rulename rm'
- l = if @loc.usesLocals && not b
- then Map.insert att @loc.usedLocals l'
- else l'
- lr = if @loc.usesLocals && not b
- then Set.fold (\k m -> Map.insertWith (Set.union) k
- (Set.singleton att) m) lr' @loc.usedLocals
- else lr'
- sfpins = Map.insert att (@rhs.used `Set.union` fromHO) m'
- fromHO = maybe Set.empty id (Map.lookup hOcc @lhs.lfpf)
- where hOcc = (@lhs.pll, "inst") >.< (f, AnyDir)
-
- in if b
- then (m',rm, Map.insert att @rhs.used l,
- Set.fold (\k m -> Map.insertWith (Set.union) k
- (Set.singleton att) m) lr @rhs.used)
- else (sfpins,rm,l,lr))
- (Map.empty,Map.empty,Map.empty,Map.empty) @pattern.afs
-
-ATTR Patterns Pattern [ ||
- -- the boolean represents whether this occurrence is
- -- an transparent occurrence (only there to pass on dependencies)
- afs USE {++} {[]} : {[(FLabel, ALabel, Bool)]} ]
-
-SEM Pattern | Alias
- lhs.afs = let isLocal = (@field == _LOC || @field == _INST)
- in [(getName @field, (getName @attr, dlhs @field),
- isLocal)] ++ @pat.afs
-
-ATTR Rules Rule Expression HsTokensRoot HsTokens HsToken [
- -- the terminals of current production
- pts : {Set.Set (FLabel)} || ]
-
-ATTR Rule Expression HsTokensRoot HsTokens HsToken [ ||
- used USE {Set.union} {Set.empty} : {Set.Set MyOccurrence} ]
-
-SEM Expression | Expression
- inst.tokens : HsTokensRoot
- inst.tokens = HsTokensRoot @tks
- tokens.pll = @lhs.pll
- tokens.pts = @lhs.pts
- lhs.used = @tokens.used
-
--- reference to terminals of which some are local attributes
-SEM HsToken | AGLocal
- lhs.used =
- case getName @var `Set.member` @lhs.pts of
- True -> Set.empty
- -- local found without flabel
- False -> Set.singleton $ (@lhs.pll, getName _LOC) >.<
- (getName @var, drhs _LOC)
--- includes both locals and attributes
--- locals will be replaced later by repLocRefs
-SEM HsToken | AGField
- lhs.used = Set.singleton $ (@lhs.pll, getName @field) >.<
- (getName @attr, drhs @field)
-
-{
--- | Replace the references to local attributes, by his attrs dependencies,
--- | rendering the local attributes 'transparent'.
-repLocRefs :: SF_P -> SF_P -> SF_P
-repLocRefs lfp sfp =
- Map.map (setConcatMap $ rep Set.empty) sfp
- where rep :: Set.Set MyOccurrence -> MyOccurrence -> Set.Set MyOccurrence
- rep done occ | occ `Set.member` done = Set.empty
- | isLoc occ = setConcatMap (rep $ Set.insert occ done) $
- findWithErr lfp "repping locals" occ
- | otherwise = Set.singleton occ
-
--- | Add dependencies from a higher order child to all its attributes
-addHigherOrders :: SF_P -> SF_P -> SF_P
-addHigherOrders lfp sfp =
- Map.mapWithKey f $ Map.map (setConcatMap (\mo -> f mo (Set.singleton mo))) sfp
- where f :: MyOccurrence -> Set.Set MyOccurrence -> Set.Set MyOccurrence
- f mo@(MyOccurrence (p,f) _) deps =
- let ho = ((p,"inst") >.< (f,AnyDir))
- in if ho `Map.member` lfp
- then ho `Set.insert` deps
- else deps
-}
-
-
+INCLUDE "AbstractSyntax.ag"
+INCLUDE "Patterns.ag"
+INCLUDE "CodeSyntax.ag"
+INCLUDE "Expression.ag"
+INCLUDE "HsToken.ag"
+INCLUDE "LOAG/Rep"
+INCLUDE "ExecutionPlanPre"
+
+MODULE {LOAG.Prepare}
+{}
+{}
+
+{
+-- | Translating UUAGC types to MyTypes
+drhs f | f == _LHS = Inh
+ | f == _LOC = AnyDir
+ | f == _INST = AnyDir
+ | otherwise = Syn
+dlhs f | f == _LHS = Syn
+ | f == _LOC = AnyDir
+ | f == _INST = AnyDir
+ | otherwise = Inh
+
+depToEdge :: PMP_R -> PLabel -> Dependency -> Edge
+depToEdge pmpr p e =
+ (findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f1) (getName i1, drhs f1),
+ findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f2) (getName i2, dlhs f2))
+ where Dependency (OccAttr f1 i1) (OccAttr f2 i2) = e
+
+vertexToAttr :: NMP -> Vertex -> Attributes
+vertexToAttr nmp v = Map.singleton (identifier a) (fromMyTy ty)
+ where (MyAttribute ty (a,_)) = findWithErr nmp "vertexToAttr" v
+
+}
+
+SEM Grammar | Grammar
+ inst.smf : LOAGRep
+ loc.initO= if Map.null @nonts.pmp then 1 else fst $ Map.findMin @nonts.pmp
+ inst.smf =
+ LOAGRep @nonts.ps @nonts.ap @loc.an
+ @loc.ain @loc.asn @loc.sfp
+ @nonts.pmp @nonts.pmpr @loc.nmp @loc.nmpr
+ (A.array (@loc.initO, @loc.initO + Map.size @nonts.gen) $
+ Map.toList $ @nonts.gen)
+ (A.array (1,Map.size @nonts.inss) $
+ Map.toList $ @nonts.inss)
+ (A.array (@loc.initO, @loc.initO + length @nonts.ofld) $
+ @nonts.ofld) @nonts.fty @nonts.fieldMap @nonts.fsInP
+ loc.nmp = Map.fromList $ zip [1..] @loc.atts
+ loc.nmpr = Map.fromList $ zip @loc.atts [1..]
+ loc.an = Map.unionWith (++) @loc.ain @loc.asn
+ loc.ain = @nonts.inhs
+ loc.asn = @nonts.syns
+ loc.atts = concat $ Map.elems @loc.an
+ loc.occs = concat $ Map.elems @nonts.ap
+ nonts.augM = @manualAttrOrderMap
+
+-- Collecting the attributes
+ATTR Nonterminals Nonterminal [
+ augM : {Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))} ||
+ inhs USE {Map.union} {Map.empty} : AI_N
+ syns USE {Map.union} {Map.empty} : AS_N ]
+
+SEM Nonterminal | Nonterminal
+ lhs.inhs = let dty = TyData (getName @nt)
+ in Map.singleton dty (toMyAttr Inh dty @inh)
+ lhs.syns = let dty = TyData (getName @nt)
+ in Map.singleton dty (toMyAttr Syn dty @syn)
+ prods.augM = case Map.lookup @nt @lhs.augM of
+ Nothing -> Map.empty
+ Just a -> a
+
+-- Adding all attribute sets to the AG type
+-- and sending it all down the abstract tree
+ATTR Nonterminals Nonterminal Productions Production Children Child
+ MySegments MySegment [
+ ain : {MyType -> MyAttributes}
+ asn : {MyType -> MyAttributes}
+ pmpf : PMP
+ pmprf : PMP_R
+ lfpf : SF_P
+ hoMapf: HOMap
+ fty : FTY
+ nmp : NMP || ]
+
+SEM Grammar | Grammar
+ nonts.ain = map2F @loc.ain
+ nonts.asn = map2F @loc.asn
+ nonts.pmpf = @nonts.pmp
+ nonts.pmprf = @nonts.pmpr
+ nonts.lfpf = @nonts.lfp
+ nonts.hoMapf= @nonts.hoMap
+ nonts.ftyf = @nonts.fty
+ nonts.fty = @nonts.fty
+
+-- Make sure TDP AND LFPRF are passed around correctly to code-generation
+ATTR Nonterminals Nonterminal Productions Production [
+ ftyf: FTY ||]
+
+
+-- Calculate the set of production labels
+SEM Grammar | Grammar
+ loc.ps = @nonts.ps
+ATTR Nonterminals Nonterminal Productions Production [ ||
+ ads USE {(++)} {[]} : {[Edge]}
+ fieldMap USE {(Map.union)} {Map.empty} : FMap
+ hoMap USE {(Map.union)} {Map.empty} : HOMap
+ fsInP USE {(Map.union)} {Map.empty} : FsInP]
+
+SEM Nonterminals Nonterminal [ ||
+ ps USE {(++)} {([])} : {[PLabel]} ]
+SEM Productions [ ||
+ ps USE {:} {([])} : {[PLabel]} ]
+SEM Production [ || ps : PLabel ] | Production
+ loc.ps = (@lhs.dty,getName @con)
+ lhs.ads =
+ case Map.lookup @con @lhs.augM of
+ Nothing -> []
+ Just a -> Set.toList $ Set.map (depToEdge @children.pmpr @loc.pll) a
+ children.dty = @lhs.dty
+
+ATTR Productions Production [
+ augM : {Map.Map Identifier (Set.Set Dependency)} || ]
+-- We didnt calculate A_P yet, inheriting A_N we can
+ATTR Productions Production Rules Rule [
+ -- result type of this constructor
+ dty : {MyType} || ]
+ATTR Rules Rule Children Child Expression HsTokensRoot HsTokens HsToken [
+ pll : {PLabel} || ]
+SEM Nonterminal | Nonterminal
+ loc.dty = TyData (getName @nt)
+
+ATTR Nonterminals Nonterminal Productions Production Children Child
+ FieldAtts FieldAtt [
+ an : {MyType -> MyAttributes}
+ nmprf : NMP_R|
+ olab : Int -- chained attribute for handing out labels to occurrences
+ flab : Int |--chained attribute for handing out labels to fields
+ ap USE {Map.unionWith (++)} {Map.empty} : A_P
+ gen USE {Map.union} {Map.empty} : {Map Int Int}
+ inss USE {Map.unionWith (++)} {Map.empty} : {Map Int [Int]}
+ pmp USE {Map.union} {Map.empty} : PMP
+ pmpr USE {Map.union} {Map.empty} : PMP_R
+ -- maps for each occurrence to which field it belongs
+ ofld USE {(++)} {[]} : {[(Int, Int)]}
+ fty USE {Map.union} {Map.empty} : FTY
+ ]
+
+SEM Grammar | Grammar
+ nonts.an = map2F @loc.an
+ nonts.nmprf= @loc.nmpr
+ nonts.olab = if Map.null @loc.nmp then 0 else (fst $ Map.findMax @loc.nmp)
+ nonts.flab = 0
+
+ATTR Children Child [||
+ fieldMap USE {Map.union} {Map.empty} : FMap
+ hoMap USE {Map.unionWith (Set.union)} {Map.empty} : HOMap
+ ]
+SEM Children [ dty : {MyType} || ]
+ | Nil
+ loc.flab = @lhs.flab + 1
+ loc.atp = fst @lhs.pll
+ inst.fatts : FieldAtts
+ inst.fatts = map ((FieldAtt @loc.atp @lhs.pll "lhs") . alab) $
+ @lhs.an @loc.atp
+ fatts.flab = @loc.flab
+ loc.label = (@lhs.pll, "lhs")
+ loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp
+ loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp
+ loc.fieldMap= Map.singleton @loc.label (@loc.foccsI, @loc.foccsS)
+ lhs.fty = Map.singleton @loc.label @lhs.dty
+
+SEM Child | Child
+ loc.flab = @lhs.flab + 1
+ loc.atp = toMyTy @tp
+ inst.fatts : FieldAtts
+ inst.fatts = map ((FieldAtt @loc.atp @lhs.pll (getName @name)) . alab)
+ $ @lhs.an @loc.atp
+ fatts.flab = @loc.flab
+ loc.ident = getName @name
+ loc.label = (@lhs.pll, @loc.ident)
+ loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp
+ loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp
+ loc.fieldMap= if Set.null @loc.foccsI && Set.null @loc.foccsS
+ then Map.empty
+ else Map.singleton @loc.label (@loc.foccsS,@loc.foccsI)
+ loc.hoMap = case @kind of
+ ChildAttr -> Map.singleton @lhs.pll (Set.singleton @loc.ident)
+ _ -> Map.empty
+ lhs.fty = Map.singleton (@lhs.pll, getName @name) @loc.atp
+
+SEM FieldAtt | FieldAtt
+ loc.olab = @lhs.olab + 1
+ loc.alab = findWithErr @lhs.nmprf "getting attr label" @loc.att
+ loc.att = @t <.> @a
+ loc.occ = (@p, @f) >.< @a
+ loc.pmp = Map.singleton @loc.olab @loc.occ
+ loc.pmpr = Map.singleton @loc.occ @loc.olab
+ loc.inss = Map.singleton @loc.alab [@loc.olab]
+ loc.gen = Map.singleton @loc.olab @loc.alab
+ lhs.ap = Map.singleton @p [@loc.occ]
+ lhs.ofld = [(@loc.olab, @lhs.flab)]
+
+-- calculate representation of semantic function
+-- definitions per non-terminal and from it, calculate E_P
+SEM Grammar | Grammar
+ loc.sfp = repLocRefs @nonts.lfp $ addHigherOrders @nonts.lfp @nonts.sfp
+ATTR Nonterminals Nonterminal Productions Production Rules Rule [ ||
+ sfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of non-locals
+ ruleMap USE {Map.union} {Map.empty} : {Map.Map MyOccurrence Identifier}
+ lfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of local attrs
+ lfpr USE {Map.unionWith (Set.union)} {Map.empty} : SF_P ]-- reverse
+SEM Production | Production
+ loc.pll = (@lhs.dty,getName @con)
+ rules.pll = @pll
+ rules.pts = @children.pts
+ lhs.fsInP = Map.singleton @pll $ Map.keys @children.fieldMap
+
+ATTR Children Child [ ||
+ pts USE {Set.union} {Set.empty} : {Set.Set FLabel} ]
+
+SEM Child | Child
+ lhs.pts = Set.singleton $ getName @name
+
+ATTR Rules Rule [
+ lfpf : SF_P ||
+ usedLocals USE {(Set.union)} {Set.empty} : {Set.Set MyOccurrence}]
+
+SEM Rule | Rule
+ loc.usedLocals = Set.filter (\(MyOccurrence (_,f) _) -> f == "loc") @rhs.used
+ loc.usesLocals = not $ Set.null @loc.usedLocals
+ (lhs.sfp,lhs.ruleMap,lhs.lfp,lhs.lfpr) =
+ foldr (\(f, a, b) (m',rm', l', lr') ->
+ let att = (@lhs.pll, f) >.< a
+ rm = Map.insert att @rulename rm'
+ l = if @loc.usesLocals && not b
+ then Map.insert att @loc.usedLocals l'
+ else l'
+ lr = if @loc.usesLocals && not b
+ then Set.fold (\k m -> Map.insertWith (Set.union) k
+ (Set.singleton att) m) lr' @loc.usedLocals
+ else lr'
+ sfpins = Map.insert att (@rhs.used `Set.union` fromHO) m'
+ fromHO = maybe Set.empty id (Map.lookup hOcc @lhs.lfpf)
+ where hOcc = (@lhs.pll, "inst") >.< (f, AnyDir)
+
+ in if b
+ then (m',rm, Map.insert att @rhs.used l,
+ Set.fold (\k m -> Map.insertWith (Set.union) k
+ (Set.singleton att) m) lr @rhs.used)
+ else (sfpins,rm,l,lr))
+ (Map.empty,Map.empty,Map.empty,Map.empty) @pattern.afs
+
+ATTR Patterns Pattern [ ||
+ -- the boolean represents whether this occurrence is
+ -- an transparent occurrence (only there to pass on dependencies)
+ afs USE {++} {[]} : {[(FLabel, ALabel, Bool)]} ]
+
+SEM Pattern | Alias
+ lhs.afs = let isLocal = (@field == _LOC || @field == _INST)
+ in [(getName @field, (getName @attr, dlhs @field),
+ isLocal)] ++ @pat.afs
+
+ATTR Rules Rule Expression HsTokensRoot HsTokens HsToken [
+ -- the terminals of current production
+ pts : {Set.Set (FLabel)} || ]
+
+ATTR Rule Expression HsTokensRoot HsTokens HsToken [ ||
+ used USE {Set.union} {Set.empty} : {Set.Set MyOccurrence} ]
+
+SEM Expression | Expression
+ inst.tokens : HsTokensRoot
+ inst.tokens = HsTokensRoot @tks
+ tokens.pll = @lhs.pll
+ tokens.pts = @lhs.pts
+ lhs.used = @tokens.used
+
+-- reference to terminals of which some are local attributes
+SEM HsToken | AGLocal
+ lhs.used =
+ case getName @var `Set.member` @lhs.pts of
+ True -> Set.empty
+ -- local found without flabel
+ False -> Set.singleton $ (@lhs.pll, getName _LOC) >.<
+ (getName @var, drhs _LOC)
+-- includes both locals and attributes
+-- locals will be replaced later by repLocRefs
+SEM HsToken | AGField
+ lhs.used = Set.singleton $ (@lhs.pll, getName @field) >.<
+ (getName @attr, drhs @field)
+
+{
+-- | Replace the references to local attributes, by his attrs dependencies,
+-- | rendering the local attributes 'transparent'.
+repLocRefs :: SF_P -> SF_P -> SF_P
+repLocRefs lfp sfp =
+ Map.map (setConcatMap $ rep Set.empty) sfp
+ where rep :: Set.Set MyOccurrence -> MyOccurrence -> Set.Set MyOccurrence
+ rep done occ | occ `Set.member` done = Set.empty
+ | isLoc occ = setConcatMap (rep $ Set.insert occ done) $
+ findWithErr lfp "repping locals" occ
+ | otherwise = Set.singleton occ
+
+-- | Add dependencies from a higher order child to all its attributes
+addHigherOrders :: SF_P -> SF_P -> SF_P
+addHigherOrders lfp sfp =
+ Map.mapWithKey f $ Map.map (setConcatMap (\mo -> f mo (Set.singleton mo))) sfp
+ where f :: MyOccurrence -> Set.Set MyOccurrence -> Set.Set MyOccurrence
+ f mo@(MyOccurrence (p,f) _) deps =
+ let ho = ((p,"inst") >.< (f,AnyDir))
+ in if ho `Map.member` lfp
+ then ho `Set.insert` deps
+ else deps
+}
+
+
diff --git a/src-generated/AG2AspectAG.hs b/src-generated/AG2AspectAG.hs
index f4702db..8d01afc 100644..100755
--- a/src-generated/AG2AspectAG.hs
+++ b/src-generated/AG2AspectAG.hs
@@ -1,2928 +1,2928 @@
-{-# LANGUAGE Rank2Types, GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module AG2AspectAG where
-{-# LINE 2 "src-ag/HsToken.ag" #-}
-
-import CommonTypes
-import UU.Scanner.Position(Pos)
-{-# LINE 10 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 2 "src-ag/Expression.ag" #-}
-
-import UU.Scanner.Position(Pos)
-import HsToken
-{-# LINE 16 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 2 "src-ag/Patterns.ag" #-}
-
--- Patterns.ag imports
-import UU.Scanner.Position(Pos)
-import CommonTypes (ConstructorIdent,Identifier)
-{-# LINE 23 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
-
--- AbstractSyntax.ag imports
-import Data.Set(Set)
-import Data.Map(Map)
-import Patterns (Pattern(..),Patterns)
-import Expression (Expression(..))
-import Macro --marcos
-import CommonTypes
-import ErrorMessages
-{-# LINE 35 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 8 "src-ag/AG2AspectAG.ag" #-}
-
-import Options
-
-import Data.Char
-import Data.List
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Data.Maybe
-
-import Pretty
-import PPUtil
-import UU.Scanner.Position
-
-import AbstractSyntax
-import TokenDef
-import CommonTypes
-
--- import Debug.Trace
-{-# LINE 56 "dist/build/AG2AspectAG.hs" #-}
-import Control.Monad.Identity (Identity)
-import qualified Control.Monad.Identity
-{-# LINE 28 "src-ag/AG2AspectAG.ag" #-}
-
-pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}"
-
-{-# LINE 63 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 33 "src-ag/AG2AspectAG.ag" #-}
-
-ppName l = ppListSep "" "" "_" l
-{-# LINE 68 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 70 "src-ag/AG2AspectAG.ag" #-}
-
-type FieldMap = [(Identifier, Type)]
-type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap)
-{-# LINE 74 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 342 "src-ag/AG2AspectAG.ag" #-}
-
-filterAtts newAtts = filter (\att -> Map.member (identifier att) newAtts)
-filterNotAtts newAtts = filter (\att -> not (Map.member (identifier att) newAtts))
-
-defAtt att = "data " >|< attTName att >|< "; " >|< attName att >|< " = proxy :: Proxy " >|< attTName att
-attName att = pp $ "att_" ++ att
-attTName att = pp $ "Att_" ++ att
-
-
-defAttRec recPref ppNt atts noGroup =
- let recName = ppName [recPref, ppNt]
- fields = ppCommas (map (\(a,t) -> ppName [pp a, recName ] >|< " ::" >|< ppShow t) (groupAtts atts noGroup))
- in
- "data " >|< recName >|< " = " >|< recName >|< " { " >|< fields >|< " }"
-
-groupAtts atts noGroup = (Map.toAscList . Map.difference atts) noGroup
-
--- it defines selectors with the form:
--- l1_nt_prod(x, _, .., _) = x
--- ln_nt_prod(_, .., _, x) = x
-defLocalAtts prodName total actual (l:ls) = ppName [pp l, prodName] >|<
- ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|<
- pp " = x" >-<
- defLocalAtts prodName total (actual+1) ls
-defLocalAtts _ _ _ [] = empty
-
-{-# LINE 103 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 397 "src-ag/AG2AspectAG.ag" #-}
-
-ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"])
-
-filterNts att = filter ( Map.member (identifier att) . snd )
-{-# LINE 110 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 455 "src-ag/AG2AspectAG.ag" #-}
-
-data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc)
-
-ppRule (field,attr) owrt def = PPRule field attr owrt def
-ruleField (PPRule field _ _ _ ) = field
-ruleAttr (PPRule _ attr _ _ ) = attr
-ruleOwrt (PPRule _ _ owrt _ ) = owrt
-ruleDef (PPRule _ _ _ def) = def
-
-{-# LINE 122 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 494 "src-ag/AG2AspectAG.ag" #-}
-
-
-defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals =
- let ppAtt = ppName [pp "inh", prodName]
- ppR = ppAtt >|< pp " = inhdefM att_inh nts_group $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 (foldr (>-<) (pp "emptyRecord") (map (chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals) chids))
- in if (newNT || (not newNT && newProd))
- then (ppR, [ ppAtt ])
- else (empty, [])
-
-chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals (idCh,tp) =
- let chName = ppName [pp "ch", pp idCh, prodName]
- ppTp = ppShow tp
- chRules = ppCommas $ mapGRuleDefs (== idCh) rules inhNoGroup synNoGroup chids locals
- in if (isNonterminal tp)
- then chName >|< ".=." >-<
- indent 1 "InhG_" >|< ppShow tp >|< pp " {" >-<
- indent 2 chRules >-<
- indent 1 "} .*. "
- else empty
-
-
-defSynGRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
- let ppAtt = ppName [pp "syn", ppNt, pp prod]
- ppTAtt = "SynG_" >|< ppNt
- ppR = ppAtt >|< pp " = syndefM att_syn $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 ppTAtt >|< pp " {" >-<
- indent 7 (ppCommas $ mapGRuleDefs ((== "lhs") . show) rules inhNoGroup synNoGroup chids locals) >-<
- indent 6 "}"
- in if (newNT || (not newNT && newProd))
- then (ppR, [ ppAtt ])
- else (empty, [])
-
-defLocRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
- let ppAtt = ppName [pp "loc", ppNt, pp prod]
- ppTAtt = ppName [pp "Loc", ppNt, pp prod]
- ppR = ppAtt >|< pp " = locdefM att_loc $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 (ppListSep "(" ")" "," $ mapLRuleDefs rules inhNoGroup synNoGroup chids locals)
- in (ppR, [ ppAtt ])
-
-defInstRules ppNt prod newNT newProd ch rules chids locals
- = let ppAsp = ppName [pp "inst", ppNt, pp prod]
- instRules = filter ((=="inst") . show . ruleField) rules
- ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod]
- in ( ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . ruleAttr) instRules) >-<
- (vlist $ map (defInstRule ppNt prod ch chids locals) instRules)
- , [ ppAsp ])
-
-
-defInstRule ppNt prod ch chids locals rule =
- let ppAtt = ppName [pp "ch", pp (ruleAttr rule), ppNt, pp prod]
- in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 ((ruleDef rule) chids locals)
-
-
-defSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
- = let synRules = filter ( (=="lhs") . show . ruleField) rules
- ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
- (ppR, ppRA) = unzip $ map (defSynRule True ppNt prod newNT newProd newAtts ch chids locals) ngRules
- in (vlist ppR, concat ppRA )
-
-modSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
- = let synRules = filter ( (=="lhs") . show . ruleField) rules
- ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
- (ppR, ppRA) = unzip $ map (defSynRule False ppNt prod newNT newProd newAtts ch chids locals) ngRules
- in (vlist ppR, concat ppRA )
-
-defSynRule new ppNt prod newNT newProd newAtts ch chids locals rule =
- let att = ruleAttr rule
- newAtt = Map.member att newAtts
- owrt = ruleOwrt rule
- ppAtt = ppName [pp att, pp (if new then "syn" else "synM"), ppNt, pp prod]
- ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName (show att) >|< pp " $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 ((ruleDef rule) chids locals)
- in
- if new
- then if (not owrt && (newNT || (not newNT && newProd) || newAtt))
- then (ppR "syndefM", [ ppAtt ])
- else (empty, [])
- else if owrt
- then (ppR "synmodM", [ ppAtt ])
- else (empty, [])
-
-
-
-defInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
- = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
- (ppR, ppRA) = unzip $ map (defInhRule True ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
- in (vlist ppR, concat ppRA)
-
-modInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
- = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
- (ppR, ppRA) = unzip $ map (defInhRule False ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
- in (vlist ppR, concat ppRA)
-
-
-defInhRule new ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals att =
- let ppAtt = ppName [pp att, pp (if new then "inh" else "inhM"),prodName]
- newAtt = Map.member (identifier att) newAtts
- chRMaybe = map (chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals) chids
- chR = [ x | (Just x) <- chRMaybe ]
- ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName att >|< " nts_" >|< att >|< " $" >-<
- indent 4 "do " >-<
- indent 5 "loc <- at loc" >-<
- indent 5 "lhs <- at lhs" >-<
- indent 5 ch >-<
- indent 5 "return $" >-<
- indent 6 (foldr (>-<) (pp "emptyRecord") chR)
- in
- if new
- then if (newNT || (not newNT && newProd) || newAtt)
- then (ppR "inhdefM", [ ppAtt ])
- else (empty, [])
- else if (not . null) chR
- then (ppR "inhmodM", [ ppAtt ])
- else (empty, [])
-
-
-chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals (idCh,tp) =
- let chName = ppName [pp "ch", pp idCh, prodName]
- ppTp = ppShow tp
- chRule = inhRuleDef new (== idCh) (== att) rules inhNoGroup synNoGroup chids locals -- it's supposed to be only one
- in if (isNonterminal tp && (not . null) chRule)
- then Just $ chName >|< ".=. (" >|< chRule >|< ") .*. "
- else Nothing
-
-
-mapLRuleDefs rules inhNoGroup synNoGroup chids locals
- = map appSnd $ sortBy cmpField $ filter ((== "loc") . show . ruleField) rules
- where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
- appSnd rule = (ruleDef rule) chids locals
-
-
-mapGRuleDefs filt rules inhNoGroup synNoGroup chids locals
- = map appSnd $ sortBy cmpField $ filter (not . (flip elem inhNoGroup) . getName . ruleAttr)
- $ filter (not . (flip elem synNoGroup) . getName . ruleAttr)
- $ filter ( filt . ruleField) rules
- where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
- appSnd rule = (ruleDef rule) chids locals
-
-inhRuleDef new filt1 filt2 rules inhNoGroup synNoGroup chids locals
- = map appSnd $ sortBy cmpField $ filter ( (== not new) . ruleOwrt)
- $ filter ((flip elem inhNoGroup) . getName . ruleAttr)
- $ filter ( filt2 . getName . ruleAttr)
- $ filter ( filt1 . ruleField) rules
- where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
- appSnd rule = (ruleDef rule) chids locals
-
-defRule ppNt (field,att) noGroup rhs = \chids locals ->
- let ppAtt = if (elem (getName att) noGroup)
- then empty
- else case (show field) of
- "lhs" -> att >|< "_" >|< pp "SynG" >|< pp "_" >|< ppNt >|< " = "
- "loc" -> empty
- "inst" -> empty
- otherwise -> att >|< "_" >|< pp "InhG" >|< pp "_" >|<
- (maybe (error $ "lhs field " ++ show field ++" is not a child")
- ppShow (lookup field chids))
- >|< " = "
- in ppAtt >|< (rhs noGroup field chids locals)
-
-
-rhsRule ppNt ppProd tks noGroup field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals noGroup )) $ tks
-
-
-lines2PP [] = []
-lines2PP xs = map line2PP . shiftLeft . getLines $ xs
-
-
-token2PP ppNt ppProd field chids locals noGroup tk
- = case tk of
- AGLocal var pos _ -> (pos, if (elem var locals)
- then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) "
- else pp var)
- AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids)
- ppAtt = case (show field) of
- "lhs" -> attName "inh"
- "loc" -> attName "loc"
- otherwise -> attName "syn"
- ppSubAtt = case (show field) of
- "lhs" -> ppName [pp (getName attr), pp "InhG", ppNt]
- "loc" -> ppName [pp (getName attr), ppNt, ppProd]
- otherwise -> ppName [pp (getName attr), pp "SynG", ppChT]
- in (pos, if ((elem (getName attr) noGroup) && ((show field) /= "loc"))
- then pp "(" >|< pp (getName field) >|< " # " >|< attName (getName attr) >|< pp ")"
- else pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ")
- HsToken value pos -> (pos, pp value)
- CharToken value pos -> (pos, pp (show value))
- StrToken value pos -> (pos, pp (show value))
- Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ")
-
-line2PP ts = let f (p,t) r = let ct = column p
- in \c -> pp (spaces (ct-c)) >|< t >|< r (length (show t) +ct)
- spaces x | x < 0 = ""
- | otherwise = replicate x ' '
- in foldr f (pp . const "") ts 1
-
-{-# LINE 347 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 721 "src-ag/AG2AspectAG.ag" #-}
-
-ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")"
- where ppChildren = map ppChild children
- ppChild (RuleChild ch n) = chName ch >|< " ==> " >|< ppMacro n
- ppChild (ChildChild ch n) = chName ch >|< " --> " >|< n
- ppChild (ValueChild ch n) = chName ch >|< " ~~> " >|< n
- chName ch = ppName [pp "ch", pp ch, pp con]
-{-# LINE 357 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 754 "src-ag/AG2AspectAG.ag" #-}
-
-ppNoGroupAtts syn noGroup = let synatts = Map.keys $ Map.filterWithKey (\att _ -> elem (getName att) noGroup) syn
- in map (flip (>|<) "_inh") noGroup ++ map (flip (>|<) "_syn") synatts
-
-ruleName att prodName = ppName [att,prodName]
-
-elemNT a b = False
-{-# LINE 367 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 797 "src-ag/AG2AspectAG.ag" #-}
-
-attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts
-{-# LINE 372 "dist/build/AG2AspectAG.hs" #-}
-
-{-# LINE 851 "src-ag/AG2AspectAG.ag" #-}
-
-attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts
-attFields atts noGroup ppNt =
- let ng = map (\(a,_) -> attName (getName a) >|< " .=. _" >|< a >|< " .*. ") $ Map.toAscList noGroup
- g = ppCommas $ map (\(a,_) -> ppName [pp a, pp "InhG",ppNt] >|< "= _" >|< a) $ Map.toAscList $ Map.difference atts noGroup
- in "(" >|< ng >|< "att_inh .=. " >|< ppName [pp "InhG", ppNt] >|< " { " >|< g >|< " } .*. emptyRecord)"
-{-# LINE 381 "dist/build/AG2AspectAG.hs" #-}
--- Child -------------------------------------------------------
--- wrapper
-data Inh_Child = Inh_Child { ext_Inh_Child :: (Maybe String), inhMap_Inh_Child :: (Map Identifier Attributes), inhNoGroup_Inh_Child :: ([String]), newAtts_Inh_Child :: ( Attributes ), o_noGroup_Inh_Child :: ([String]), o_rename_Inh_Child :: (Bool), ppNt_Inh_Child :: (PP_Doc), ppProd_Inh_Child :: (PP_Doc), synMap_Inh_Child :: (Map Identifier Attributes), synNoGroup_Inh_Child :: ([String]) }
-data Syn_Child = Syn_Child { idCL_Syn_Child :: ([(Identifier,Type)]), ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Child :: ([PP_Doc]), ppL_Syn_Child :: (PP_Doc), ppLI_Syn_Child :: ([PP_Doc]), ppR_Syn_Child :: (PP_Doc), prdInh_Syn_Child :: (Attributes) }
-{-# INLINABLE wrap_Child #-}
-wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
-wrap_Child (T_Child act) (Inh_Child _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg1 = T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
- (T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Child_s2 sem arg1)
- return (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
- )
-
--- cata
-{-# INLINE sem_Child #-}
-sem_Child :: Child -> T_Child
-sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
-
--- semantic domain
-newtype T_Child = T_Child {
- attach_T_Child :: Identity (T_Child_s2 )
- }
-newtype T_Child_s2 = C_Child_s2 {
- inv_Child_s2 :: (T_Child_v1 )
- }
-data T_Child_s3 = C_Child_s3
-type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
-data T_Child_vIn1 = T_Child_vIn1 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
-data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
-{-# NOINLINE sem_Child_Child #-}
-sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
-sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where
- {-# NOINLINE st2 #-}
- st2 = let
- v1 :: T_Child_v1
- v1 = \ (T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _chnt = rule0 arg_name_ arg_tp_
- _inh = rule1 _chnt _lhsIinhMap
- _syn = rule2 _chnt _lhsIsynMap
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule3 _inh
- _ppCh = rule4 arg_name_
- _ppTCh = rule5 arg_tp_
- _chName = rule6 _lhsIppNt _lhsIppProd _ppCh
- _lhsOppDL :: [PP_Doc]
- _lhsOppDL = rule7 _chName _ppTCh arg_kind_
- _chLabel = rule8 _chName
- _chTLabel = rule9 _chName
- _lhsOppL :: PP_Doc
- _lhsOppL = rule10 _chLabel _chTLabel _ppTCh arg_kind_
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule11 _chLabel _chTLabel
- _lhsOppR :: PP_Doc
- _lhsOppR = rule12 _lhsIppNt _lhsIppProd arg_name_
- _lhsOidCL :: [(Identifier,Type)]
- _lhsOidCL = rule13 arg_name_ arg_tp_
- _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
- _lhsOppCSF = rule14 _chLabel arg_kind_ arg_name_ arg_tp_
- __result_ = T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
- in __result_ )
- in C_Child_s2 v1
- {-# INLINE rule0 #-}
- {-# LINE 19 "src-ag/DistChildAttr.ag" #-}
- rule0 = \ name_ tp_ ->
- {-# LINE 19 "src-ag/DistChildAttr.ag" #-}
- case tp_ of
- NT nt _ _ -> nt
- Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
- Haskell t -> identifier ""
- {-# LINE 452 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule1 #-}
- {-# LINE 23 "src-ag/DistChildAttr.ag" #-}
- rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) ->
- {-# LINE 23 "src-ag/DistChildAttr.ag" #-}
- Map.findWithDefault Map.empty _chnt _lhsIinhMap
- {-# LINE 458 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule2 #-}
- {-# LINE 24 "src-ag/DistChildAttr.ag" #-}
- rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) ->
- {-# LINE 24 "src-ag/DistChildAttr.ag" #-}
- Map.findWithDefault Map.empty _chnt _lhsIsynMap
- {-# LINE 464 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule3 #-}
- {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}
- rule3 = \ _inh ->
- {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}
- _inh
- {-# LINE 470 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule4 #-}
- {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}
- rule4 = \ name_ ->
- {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}
- pp name_
- {-# LINE 476 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule5 #-}
- {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}
- rule5 = \ tp_ ->
- {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}
- ppShow tp_
- {-# LINE 482 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule6 #-}
- {-# LINE 184 "src-ag/AG2AspectAG.ag" #-}
- rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh ->
- {-# LINE 184 "src-ag/AG2AspectAG.ag" #-}
- ppName [_ppCh , _lhsIppNt, _lhsIppProd]
- {-# LINE 488 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule7 #-}
- {-# LINE 242 "src-ag/AG2AspectAG.ag" #-}
- rule7 = \ _chName _ppTCh kind_ ->
- {-# LINE 242 "src-ag/AG2AspectAG.ag" #-}
- case kind_ of
- ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ]
- _ -> []
- {-# LINE 496 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule8 #-}
- {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}
- rule8 = \ _chName ->
- {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}
- "ch_" >|< _chName
- {-# LINE 502 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule9 #-}
- {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}
- rule9 = \ _chName ->
- {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}
- "Ch_" >|< _chName
- {-# LINE 508 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule10 #-}
- {-# LINE 287 "src-ag/AG2AspectAG.ag" #-}
- rule10 = \ _chLabel _chTLabel _ppTCh kind_ ->
- {-# LINE 287 "src-ag/AG2AspectAG.ag" #-}
- "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|<
- case kind_ of
- ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")"
- _ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|<
- "(" >|< _chTLabel >|< ", nt)"
- {-# LINE 518 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule11 #-}
- {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}
- rule11 = \ _chLabel _chTLabel ->
- {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}
- [ _chLabel , _chTLabel ]
- {-# LINE 524 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule12 #-}
- {-# LINE 451 "src-ag/AG2AspectAG.ag" #-}
- rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ ->
- {-# LINE 451 "src-ag/AG2AspectAG.ag" #-}
- let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
- in pp name_ >|< " <- at ch_" >|< chName
- {-# LINE 531 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule13 #-}
- {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}
- rule13 = \ name_ tp_ ->
- {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}
- [ (name_, removeDeforested tp_ ) ]
- {-# LINE 537 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule14 #-}
- {-# LINE 827 "src-ag/AG2AspectAG.ag" #-}
- rule14 = \ _chLabel kind_ name_ tp_ ->
- {-# LINE 827 "src-ag/AG2AspectAG.ag" #-}
- let
- semC = if (isNonterminal tp_)
- then "sem_" >|< ppShow tp_ >|< " _" >|< name_
- else "sem_Lit _" >|< name_
- in case kind_ of
- ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. "
- , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))]
- _ -> []
- {-# LINE 550 "dist/build/AG2AspectAG.hs"#-}
-
--- Children ----------------------------------------------------
--- wrapper
-data Inh_Children = Inh_Children { ext_Inh_Children :: (Maybe String), inhMap_Inh_Children :: (Map Identifier Attributes), inhNoGroup_Inh_Children :: ([String]), newAtts_Inh_Children :: ( Attributes ), o_noGroup_Inh_Children :: ([String]), o_rename_Inh_Children :: (Bool), ppNt_Inh_Children :: (PP_Doc), ppProd_Inh_Children :: (PP_Doc), synMap_Inh_Children :: (Map Identifier Attributes), synNoGroup_Inh_Children :: ([String]) }
-data Syn_Children = Syn_Children { idCL_Syn_Children :: ([(Identifier,Type)]), ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Children :: ([PP_Doc]), ppL_Syn_Children :: (PP_Doc), ppLI_Syn_Children :: ([PP_Doc]), ppR_Syn_Children :: (PP_Doc), prdInh_Syn_Children :: (Attributes) }
-{-# INLINABLE wrap_Children #-}
-wrap_Children :: T_Children -> Inh_Children -> (Syn_Children )
-wrap_Children (T_Children act) (Inh_Children _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg4 = T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
- (T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Children_s5 sem arg4)
- return (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
- )
-
--- cata
-{-# NOINLINE sem_Children #-}
-sem_Children :: Children -> T_Children
-sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
-
--- semantic domain
-newtype T_Children = T_Children {
- attach_T_Children :: Identity (T_Children_s5 )
- }
-newtype T_Children_s5 = C_Children_s5 {
- inv_Children_s5 :: (T_Children_v4 )
- }
-data T_Children_s6 = C_Children_s6
-type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
-data T_Children_vIn4 = T_Children_vIn4 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
-data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
-{-# NOINLINE sem_Children_Cons #-}
-sem_Children_Cons :: T_Child -> T_Children -> T_Children
-sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
- {-# NOINLINE st5 #-}
- st5 = let
- v4 :: T_Children_v4
- v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
- _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
- (T_Child_vOut1 _hdIidCL _hdIppCSF _hdIppDL _hdIppL _hdIppLI _hdIppR _hdIprdInh) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOext _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOo_noGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynMap _hdOsynNoGroup)
- (T_Children_vOut4 _tlIidCL _tlIppCSF _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIprdInh) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOext _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOo_noGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynMap _tlOsynNoGroup)
- _lhsOppDL :: [PP_Doc]
- _lhsOppDL = rule15 _hdIppDL _tlIppDL
- _lhsOidCL :: [(Identifier,Type)]
- _lhsOidCL = rule16 _hdIidCL _tlIidCL
- _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
- _lhsOppCSF = rule17 _hdIppCSF _tlIppCSF
- _lhsOppL :: PP_Doc
- _lhsOppL = rule18 _hdIppL _tlIppL
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule19 _hdIppLI _tlIppLI
- _lhsOppR :: PP_Doc
- _lhsOppR = rule20 _hdIppR _tlIppR
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule21 _hdIprdInh _tlIprdInh
- _hdOext = rule22 _lhsIext
- _hdOinhMap = rule23 _lhsIinhMap
- _hdOinhNoGroup = rule24 _lhsIinhNoGroup
- _hdOnewAtts = rule25 _lhsInewAtts
- _hdOo_noGroup = rule26 _lhsIo_noGroup
- _hdOo_rename = rule27 _lhsIo_rename
- _hdOppNt = rule28 _lhsIppNt
- _hdOppProd = rule29 _lhsIppProd
- _hdOsynMap = rule30 _lhsIsynMap
- _hdOsynNoGroup = rule31 _lhsIsynNoGroup
- _tlOext = rule32 _lhsIext
- _tlOinhMap = rule33 _lhsIinhMap
- _tlOinhNoGroup = rule34 _lhsIinhNoGroup
- _tlOnewAtts = rule35 _lhsInewAtts
- _tlOo_noGroup = rule36 _lhsIo_noGroup
- _tlOo_rename = rule37 _lhsIo_rename
- _tlOppNt = rule38 _lhsIppNt
- _tlOppProd = rule39 _lhsIppProd
- _tlOsynMap = rule40 _lhsIsynMap
- _tlOsynNoGroup = rule41 _lhsIsynNoGroup
- __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
- in __result_ )
- in C_Children_s5 v4
- {-# INLINE rule15 #-}
- {-# LINE 238 "src-ag/AG2AspectAG.ag" #-}
- rule15 = \ ((_hdIppDL) :: [PP_Doc]) ((_tlIppDL) :: [PP_Doc]) ->
- {-# LINE 238 "src-ag/AG2AspectAG.ag" #-}
- _hdIppDL ++ _tlIppDL
- {-# LINE 635 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule16 #-}
- rule16 = \ ((_hdIidCL) :: [(Identifier,Type)]) ((_tlIidCL) :: [(Identifier,Type)]) ->
- _hdIidCL ++ _tlIidCL
- {-# INLINE rule17 #-}
- rule17 = \ ((_hdIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_tlIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ->
- _hdIppCSF ++ _tlIppCSF
- {-# INLINE rule18 #-}
- rule18 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
- _hdIppL >-< _tlIppL
- {-# INLINE rule19 #-}
- rule19 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
- _hdIppLI ++ _tlIppLI
- {-# INLINE rule20 #-}
- rule20 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
- _hdIppR >-< _tlIppR
- {-# INLINE rule21 #-}
- rule21 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
- _hdIprdInh `Map.union` _tlIprdInh
- {-# INLINE rule22 #-}
- rule22 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule23 #-}
- rule23 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule24 #-}
- rule24 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule25 #-}
- rule25 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule26 #-}
- rule26 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule27 #-}
- rule27 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule28 #-}
- rule28 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule29 #-}
- rule29 = \ ((_lhsIppProd) :: PP_Doc) ->
- _lhsIppProd
- {-# INLINE rule30 #-}
- rule30 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule31 #-}
- rule31 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
- {-# INLINE rule32 #-}
- rule32 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule33 #-}
- rule33 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule34 #-}
- rule34 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule35 #-}
- rule35 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule36 #-}
- rule36 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule37 #-}
- rule37 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule38 #-}
- rule38 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule39 #-}
- rule39 = \ ((_lhsIppProd) :: PP_Doc) ->
- _lhsIppProd
- {-# INLINE rule40 #-}
- rule40 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule41 #-}
- rule41 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
-{-# NOINLINE sem_Children_Nil #-}
-sem_Children_Nil :: T_Children
-sem_Children_Nil = T_Children (return st5) where
- {-# NOINLINE st5 #-}
- st5 = let
- v4 :: T_Children_v4
- v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _lhsOppDL :: [PP_Doc]
- _lhsOppDL = rule42 ()
- _lhsOidCL :: [(Identifier,Type)]
- _lhsOidCL = rule43 ()
- _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
- _lhsOppCSF = rule44 ()
- _lhsOppL :: PP_Doc
- _lhsOppL = rule45 ()
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule46 ()
- _lhsOppR :: PP_Doc
- _lhsOppR = rule47 ()
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule48 ()
- __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
- in __result_ )
- in C_Children_s5 v4
- {-# INLINE rule42 #-}
- {-# LINE 239 "src-ag/AG2AspectAG.ag" #-}
- rule42 = \ (_ :: ()) ->
- {-# LINE 239 "src-ag/AG2AspectAG.ag" #-}
- []
- {-# LINE 743 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule43 #-}
- rule43 = \ (_ :: ()) ->
- []
- {-# INLINE rule44 #-}
- rule44 = \ (_ :: ()) ->
- []
- {-# INLINE rule45 #-}
- rule45 = \ (_ :: ()) ->
- empty
- {-# INLINE rule46 #-}
- rule46 = \ (_ :: ()) ->
- []
- {-# INLINE rule47 #-}
- rule47 = \ (_ :: ()) ->
- empty
- {-# INLINE rule48 #-}
- rule48 = \ (_ :: ()) ->
- Map.empty
-
--- Expression --------------------------------------------------
--- wrapper
-data Inh_Expression = Inh_Expression { ppNt_Inh_Expression :: (PP_Doc), ppProd_Inh_Expression :: (PP_Doc) }
-data Syn_Expression = Syn_Expression { ppRE_Syn_Expression :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) }
-{-# INLINABLE wrap_Expression #-}
-wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression )
-wrap_Expression (T_Expression act) (Inh_Expression _lhsIppNt _lhsIppProd) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg7 = T_Expression_vIn7 _lhsIppNt _lhsIppProd
- (T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg7)
- return (Syn_Expression _lhsOppRE)
- )
-
--- cata
-{-# INLINE sem_Expression #-}
-sem_Expression :: Expression -> T_Expression
-sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
-
--- semantic domain
-newtype T_Expression = T_Expression {
- attach_T_Expression :: Identity (T_Expression_s8 )
- }
-newtype T_Expression_s8 = C_Expression_s8 {
- inv_Expression_s8 :: (T_Expression_v7 )
- }
-data T_Expression_s9 = C_Expression_s9
-type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
-data T_Expression_vIn7 = T_Expression_vIn7 (PP_Doc) (PP_Doc)
-data T_Expression_vOut7 = T_Expression_vOut7 ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)
-{-# NOINLINE sem_Expression_Expression #-}
-sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
-sem_Expression_Expression _ arg_tks_ = T_Expression (return st8) where
- {-# NOINLINE st8 #-}
- st8 = let
- v7 :: T_Expression_v7
- v7 = \ (T_Expression_vIn7 _lhsIppNt _lhsIppProd) -> ( let
- _lhsOppRE :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc
- _lhsOppRE = rule49 _lhsIppNt _lhsIppProd arg_tks_
- __result_ = T_Expression_vOut7 _lhsOppRE
- in __result_ )
- in C_Expression_s8 v7
- {-# INLINE rule49 #-}
- {-# LINE 484 "src-ag/AG2AspectAG.ag" #-}
- rule49 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) tks_ ->
- {-# LINE 484 "src-ag/AG2AspectAG.ag" #-}
- rhsRule _lhsIppNt _lhsIppProd tks_
- {-# LINE 810 "dist/build/AG2AspectAG.hs"#-}
-
--- Grammar -----------------------------------------------------
--- wrapper
-data Inh_Grammar = Inh_Grammar { agi_Inh_Grammar :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))), ext_Inh_Grammar :: (Maybe String), options_Inh_Grammar :: (Options) }
-data Syn_Grammar = Syn_Grammar { imp_Syn_Grammar :: (PP_Doc), pp_Syn_Grammar :: (PP_Doc) }
-{-# INLINABLE wrap_Grammar #-}
-wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar )
-wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg10 = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions
- (T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg10)
- return (Syn_Grammar _lhsOimp _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Grammar #-}
-sem_Grammar :: Grammar -> T_Grammar
-sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
-
--- semantic domain
-newtype T_Grammar = T_Grammar {
- attach_T_Grammar :: Identity (T_Grammar_s11 )
- }
-newtype T_Grammar_s11 = C_Grammar_s11 {
- inv_Grammar_s11 :: (T_Grammar_v10 )
- }
-data T_Grammar_s12 = C_Grammar_s12
-type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
-data T_Grammar_vIn10 = T_Grammar_vIn10 ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) (Maybe String) (Options)
-data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) (PP_Doc)
-{-# NOINLINE sem_Grammar_Grammar #-}
-sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar
-sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
- {-# NOINLINE st11 #-}
- st11 = let
- v10 :: T_Grammar_v10
- v10 = \ (T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions) -> ( let
- _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
- (T_Nonterminals_vOut25 _nontsIextendedNTs _nontsIinhMap' _nontsIppA _nontsIppAI _nontsIppCata _nontsIppD _nontsIppDI _nontsIppL _nontsIppLI _nontsIppNtL _nontsIppR _nontsIppSF _nontsIppW _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns)
- _nontsOinhMap = rule50 _nontsIinhMap'
- _nontsOsynMap = rule51 _nontsIsynMap'
- _nontsOo_rename = rule52 _lhsIoptions
- _o_noGroup = rule53 _lhsIoptions
- _nontsOo_noGroup = rule54 _o_noGroup
- _newAtts = rule55 _lhsIagi
- _nontsOnewAtts = rule56 _newAtts
- _newProds = rule57 _lhsIagi
- _nontsOnewProds = rule58 _newProds
- _nontsOnewNTs = rule59 _lhsIagi _nontsIextendedNTs
- _lhsOimp :: PP_Doc
- _lhsOimp = rule60 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT
- _lhsOpp :: PP_Doc
- _lhsOpp = rule61 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR
- _nontsOderivs = rule62 arg_derivings_
- _nontsOtSyns = rule63 arg_typeSyns_
- _ppA = rule64 _lhsIext _newAtts _nontsIppA _o_noGroup
- _ppAI = rule65 _lhsIext _newAtts _nontsIppAI _o_noGroup
- _ppANT = rule66 _newAtts _o_noGroup
- _ppNtL = rule67 _nontsIppNtL
- _ppR = rule68 _newAtts _nontsIppR _o_noGroup _ppNtL
- _nontsOext = rule69 _lhsIext
- __result_ = T_Grammar_vOut10 _lhsOimp _lhsOpp
- in __result_ )
- in C_Grammar_s11 v10
- {-# INLINE rule50 #-}
- {-# LINE 15 "src-ag/DistChildAttr.ag" #-}
- rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) ->
- {-# LINE 15 "src-ag/DistChildAttr.ag" #-}
- _nontsIinhMap'
- {-# LINE 881 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule51 #-}
- {-# LINE 16 "src-ag/DistChildAttr.ag" #-}
- rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->
- {-# LINE 16 "src-ag/DistChildAttr.ag" #-}
- _nontsIsynMap'
- {-# LINE 887 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule52 #-}
- {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}
- rule52 = \ ((_lhsIoptions) :: Options) ->
- {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}
- rename _lhsIoptions
- {-# LINE 893 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule53 #-}
- {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}
- rule53 = \ ((_lhsIoptions) :: Options) ->
- {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}
- sort $ noGroup _lhsIoptions
- {-# LINE 899 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule54 #-}
- {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}
- rule54 = \ _o_noGroup ->
- {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}
- _o_noGroup
- {-# LINE 905 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule55 #-}
- {-# LINE 80 "src-ag/AG2AspectAG.ag" #-}
- rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
- {-# LINE 80 "src-ag/AG2AspectAG.ag" #-}
- case _lhsIagi of
- (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts
- {-# LINE 912 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule56 #-}
- {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}
- rule56 = \ _newAtts ->
- {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}
- _newAtts
- {-# LINE 918 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule57 #-}
- {-# LINE 88 "src-ag/AG2AspectAG.ag" #-}
- rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
- {-# LINE 88 "src-ag/AG2AspectAG.ag" #-}
- case _lhsIagi of
- (_,prods,_) -> prods
- {-# LINE 925 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule58 #-}
- {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}
- rule58 = \ _newProds ->
- {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}
- _newProds
- {-# LINE 931 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule59 #-}
- {-# LINE 112 "src-ag/AG2AspectAG.ag" #-}
- rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) ->
- {-# LINE 112 "src-ag/AG2AspectAG.ag" #-}
- case _lhsIagi of
- (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs
- {-# LINE 938 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule60 #-}
- {-# LINE 127 "src-ag/AG2AspectAG.ag" #-}
- rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT ->
- {-# LINE 127 "src-ag/AG2AspectAG.ag" #-}
- "import Language.Grammars.AspectAG" >-<
- "import Language.Grammars.AspectAG.Derive" >-<
- "import Data.HList.Label4" >-<
- "import Data.HList.TypeEqGeneric1" >-<
- "import Data.HList.TypeCastGeneric1" >-<
- maybe empty ("import qualified" >#<) _lhsIext >-<
- maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext
- {-# LINE 950 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule61 #-}
- {-# LINE 140 "src-ag/AG2AspectAG.ag" #-}
- rule61 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR ->
- {-# LINE 140 "src-ag/AG2AspectAG.ag" #-}
- (if dataTypes _lhsIoptions
- then "-- datatypes" >-< _nontsIppD >-<
- "-- labels" >-< _nontsIppL
- else empty)
- >-<
- (if folds _lhsIoptions
- then "-- attributes" >-< _ppA >-<
- "-- rules" >-< _ppR >-<
- "-- catas" >-< _nontsIppCata
- else empty)
- >-<
- (if semfuns _lhsIoptions
- then "-- semantic functions" >-< _nontsIppSF
- else empty)
- >-<
- (if wrappers _lhsIoptions
- then "-- wrappers" >-< _nontsIppW
- else empty)
- {-# LINE 973 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule62 #-}
- {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}
- rule62 = \ derivings_ ->
- {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}
- derivings_
- {-# LINE 979 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule63 #-}
- {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}
- rule63 = \ typeSyns_ ->
- {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}
- typeSyns_
- {-# LINE 985 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule64 #-}
- {-# LINE 300 "src-ag/AG2AspectAG.ag" #-}
- rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup ->
- {-# LINE 300 "src-ag/AG2AspectAG.ag" #-}
- vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-<
- defAtt "loc" >-<
- (case _lhsIext of
- Nothing -> defAtt "inh" >-< defAtt "syn"
- otherwise -> empty) >-<
- _nontsIppA
- {-# LINE 996 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule65 #-}
- {-# LINE 308 "src-ag/AG2AspectAG.ag" #-}
- rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup ->
- {-# LINE 308 "src-ag/AG2AspectAG.ag" #-}
- let atts = filterNotAtts _newAtts _o_noGroup
- in (foldr (\a as -> attName a : as) [] atts) ++
- (foldr (\a as -> attTName a : as) [] atts) ++
- (case _lhsIext of
- Nothing -> []
- otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++
- _nontsIppAI
- {-# LINE 1008 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule66 #-}
- {-# LINE 318 "src-ag/AG2AspectAG.ag" #-}
- rule66 = \ _newAtts _o_noGroup ->
- {-# LINE 318 "src-ag/AG2AspectAG.ag" #-}
- let atts = filterNotAtts _newAtts _o_noGroup
- in (foldr (\a as -> ("nts_" >|< a) : as) [] atts)
- {-# LINE 1015 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule67 #-}
- {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}
- rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) ->
- {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}
- _nontsIppNtL
- {-# LINE 1021 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule68 #-}
- {-# LINE 393 "src-ag/AG2AspectAG.ag" #-}
- rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL ->
- {-# LINE 393 "src-ag/AG2AspectAG.ag" #-}
- ntsList "group" _ppNtL >-<
- vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-<
- _nontsIppR
- {-# LINE 1029 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule69 #-}
- rule69 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
-
--- HsToken -----------------------------------------------------
--- wrapper
-data Inh_HsToken = Inh_HsToken { }
-data Syn_HsToken = Syn_HsToken { }
-{-# INLINABLE wrap_HsToken #-}
-wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken )
-wrap_HsToken (T_HsToken act) (Inh_HsToken ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg13 = T_HsToken_vIn13
- (T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg13)
- return (Syn_HsToken )
- )
-
--- cata
-{-# NOINLINE sem_HsToken #-}
-sem_HsToken :: HsToken -> T_HsToken
-sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_
-sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_
-sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_
-sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_
-sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_
-sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_
-
--- semantic domain
-newtype T_HsToken = T_HsToken {
- attach_T_HsToken :: Identity (T_HsToken_s14 )
- }
-newtype T_HsToken_s14 = C_HsToken_s14 {
- inv_HsToken_s14 :: (T_HsToken_v13 )
- }
-data T_HsToken_s15 = C_HsToken_s15
-type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 )
-data T_HsToken_vIn13 = T_HsToken_vIn13
-data T_HsToken_vOut13 = T_HsToken_vOut13
-{-# NOINLINE sem_HsToken_AGLocal #-}
-sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
-sem_HsToken_AGLocal _ _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-{-# NOINLINE sem_HsToken_AGField #-}
-sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
-sem_HsToken_AGField _ _ _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-{-# NOINLINE sem_HsToken_HsToken #-}
-sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken
-sem_HsToken_HsToken _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-{-# NOINLINE sem_HsToken_CharToken #-}
-sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken
-sem_HsToken_CharToken _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-{-# NOINLINE sem_HsToken_StrToken #-}
-sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken
-sem_HsToken_StrToken _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-{-# NOINLINE sem_HsToken_Err #-}
-sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken
-sem_HsToken_Err _ _ = T_HsToken (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_HsToken_v13
- v13 = \ (T_HsToken_vIn13 ) -> ( let
- __result_ = T_HsToken_vOut13
- in __result_ )
- in C_HsToken_s14 v13
-
--- HsTokens ----------------------------------------------------
--- wrapper
-data Inh_HsTokens = Inh_HsTokens { }
-data Syn_HsTokens = Syn_HsTokens { }
-{-# INLINABLE wrap_HsTokens #-}
-wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens )
-wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg16 = T_HsTokens_vIn16
- (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16)
- return (Syn_HsTokens )
- )
-
--- cata
-{-# NOINLINE sem_HsTokens #-}
-sem_HsTokens :: HsTokens -> T_HsTokens
-sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)
-
--- semantic domain
-newtype T_HsTokens = T_HsTokens {
- attach_T_HsTokens :: Identity (T_HsTokens_s17 )
- }
-newtype T_HsTokens_s17 = C_HsTokens_s17 {
- inv_HsTokens_s17 :: (T_HsTokens_v16 )
- }
-data T_HsTokens_s18 = C_HsTokens_s18
-type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 )
-data T_HsTokens_vIn16 = T_HsTokens_vIn16
-data T_HsTokens_vOut16 = T_HsTokens_vOut16
-{-# NOINLINE sem_HsTokens_Cons #-}
-sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens
-sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_HsTokens_v16
- v16 = \ (T_HsTokens_vIn16 ) -> ( let
- _hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_))
- _tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_))
- (T_HsToken_vOut13 ) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 )
- (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 )
- __result_ = T_HsTokens_vOut16
- in __result_ )
- in C_HsTokens_s17 v16
-{-# NOINLINE sem_HsTokens_Nil #-}
-sem_HsTokens_Nil :: T_HsTokens
-sem_HsTokens_Nil = T_HsTokens (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_HsTokens_v16
- v16 = \ (T_HsTokens_vIn16 ) -> ( let
- __result_ = T_HsTokens_vOut16
- in __result_ )
- in C_HsTokens_s17 v16
-
--- HsTokensRoot ------------------------------------------------
--- wrapper
-data Inh_HsTokensRoot = Inh_HsTokensRoot { }
-data Syn_HsTokensRoot = Syn_HsTokensRoot { }
-{-# INLINABLE wrap_HsTokensRoot #-}
-wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot )
-wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg19 = T_HsTokensRoot_vIn19
- (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19)
- return (Syn_HsTokensRoot )
- )
-
--- cata
-{-# INLINE sem_HsTokensRoot #-}
-sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot
-sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ )
-
--- semantic domain
-newtype T_HsTokensRoot = T_HsTokensRoot {
- attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 )
- }
-newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 {
- inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 )
- }
-data T_HsTokensRoot_s21 = C_HsTokensRoot_s21
-type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 )
-data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19
-data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19
-{-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-}
-sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot
-sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_HsTokensRoot_v19
- v19 = \ (T_HsTokensRoot_vIn19 ) -> ( let
- _tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_))
- (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 )
- __result_ = T_HsTokensRoot_vOut19
- in __result_ )
- in C_HsTokensRoot_s20 v19
-
--- Nonterminal -------------------------------------------------
--- wrapper
-data Inh_Nonterminal = Inh_Nonterminal { derivs_Inh_Nonterminal :: (Derivings), ext_Inh_Nonterminal :: (Maybe String), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), newAtts_Inh_Nonterminal :: ( Attributes ), newNTs_Inh_Nonterminal :: (Set NontermIdent), newProds_Inh_Nonterminal :: ( DataTypes ), o_noGroup_Inh_Nonterminal :: ([String]), o_rename_Inh_Nonterminal :: (Bool), synMap_Inh_Nonterminal :: (Map Identifier Attributes), tSyns_Inh_Nonterminal :: (TypeSyns) }
-data Syn_Nonterminal = Syn_Nonterminal { extendedNTs_Syn_Nonterminal :: (Set NontermIdent), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), ppA_Syn_Nonterminal :: (PP_Doc), ppAI_Syn_Nonterminal :: ([PP_Doc]), ppCata_Syn_Nonterminal :: (PP_Doc), ppD_Syn_Nonterminal :: (PP_Doc), ppDI_Syn_Nonterminal :: ([PP_Doc]), ppL_Syn_Nonterminal :: (PP_Doc), ppLI_Syn_Nonterminal :: ([PP_Doc]), ppNtL_Syn_Nonterminal :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminal :: (PP_Doc), ppSF_Syn_Nonterminal :: (PP_Doc), ppW_Syn_Nonterminal :: (PP_Doc), synMap'_Syn_Nonterminal :: (Map Identifier Attributes) }
-{-# INLINABLE wrap_Nonterminal #-}
-wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal )
-wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg22 = T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
- (T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminal_s23 sem arg22)
- return (Syn_Nonterminal _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
- )
-
--- cata
-{-# INLINE sem_Nonterminal #-}
-sem_Nonterminal :: Nonterminal -> T_Nonterminal
-sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
-
--- semantic domain
-newtype T_Nonterminal = T_Nonterminal {
- attach_T_Nonterminal :: Identity (T_Nonterminal_s23 )
- }
-newtype T_Nonterminal_s23 = C_Nonterminal_s23 {
- inv_Nonterminal_s23 :: (T_Nonterminal_v22 )
- }
-data T_Nonterminal_s24 = C_Nonterminal_s24
-type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 )
-data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
-data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
-{-# NOINLINE sem_Nonterminal_Nonterminal #-}
-sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
-sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st23) where
- {-# NOINLINE st23 #-}
- st23 = let
- v22 :: T_Nonterminal_v22
- v22 = \ (T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
- _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
- (T_Productions_vOut37 _prodsIhasMoreProds _prodsIppA _prodsIppCata _prodsIppDL _prodsIppL _prodsIppLI _prodsIppR _prodsIppRA _prodsIppSF _prodsIppSPF _prodsIprdInh) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup)
- _lhsOinhMap' :: Map Identifier Attributes
- _lhsOinhMap' = rule70 arg_inh_ arg_nt_
- _lhsOsynMap' :: Map Identifier Attributes
- _lhsOsynMap' = rule71 arg_nt_ arg_syn_
- _inhNoGroup = rule72 _lhsIo_noGroup _prodsIprdInh
- _synNoGroup = rule73 _lhsIo_noGroup arg_syn_
- _prodsOinhNoGroup = rule74 _inhNoGroup
- _prodsOsynNoGroup = rule75 _synNoGroup
- _prodsOnewProds = rule76 _lhsInewProds arg_nt_
- _lhsOextendedNTs :: Set NontermIdent
- _lhsOextendedNTs = rule77 _prodsIhasMoreProds arg_nt_
- _ppNt = rule78 arg_nt_
- _prodsOppNt = rule79 _ppNt
- _lhsOppD :: PP_Doc
- _lhsOppD = rule80 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_
- _lhsOppDI :: [PP_Doc]
- _lhsOppDI = rule81 _lhsInewNTs _ppNt arg_nt_
- _ntLabel = rule82 _ppNt
- _lhsOppL :: PP_Doc
- _lhsOppL = rule83 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule84 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_
- _lhsOppA :: PP_Doc
- _lhsOppA = rule85 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_
- _lhsOppAI :: [PP_Doc]
- _lhsOppAI = rule86 _lhsInewNTs _ppNt arg_nt_
- _lhsOppNtL :: [(PP_Doc, Attributes)]
- _lhsOppNtL = rule87 arg_inh_ arg_nt_ arg_syn_
- _prodsOnewNT = rule88 _lhsInewNTs arg_nt_
- _lhsOppR :: PP_Doc
- _lhsOppR = rule89 _prodsIppR arg_nt_
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule90 _ppNt _prodsIppCata
- _prodsOsyn = rule91 arg_syn_
- _prodsOinh = rule92 arg_inh_
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule93 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup
- _lhsOppW :: PP_Doc
- _lhsOppW = rule94 _inhNoGroup _ppNt arg_inh_
- _prodsOext = rule95 _lhsIext
- _prodsOinhMap = rule96 _lhsIinhMap
- _prodsOnewAtts = rule97 _lhsInewAtts
- _prodsOo_noGroup = rule98 _lhsIo_noGroup
- _prodsOo_rename = rule99 _lhsIo_rename
- _prodsOsynMap = rule100 _lhsIsynMap
- __result_ = T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
- in __result_ )
- in C_Nonterminal_s23 v22
- {-# INLINE rule70 #-}
- {-# LINE 7 "src-ag/DistChildAttr.ag" #-}
- rule70 = \ inh_ nt_ ->
- {-# LINE 7 "src-ag/DistChildAttr.ag" #-}
- Map.singleton nt_ inh_
- {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule71 #-}
- {-# LINE 8 "src-ag/DistChildAttr.ag" #-}
- rule71 = \ nt_ syn_ ->
- {-# LINE 8 "src-ag/DistChildAttr.ag" #-}
- Map.singleton nt_ syn_
- {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule72 #-}
- {-# LINE 51 "src-ag/AG2AspectAG.ag" #-}
- rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) ->
- {-# LINE 51 "src-ag/AG2AspectAG.ag" #-}
- Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh
- {-# LINE 1332 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule73 #-}
- {-# LINE 52 "src-ag/AG2AspectAG.ag" #-}
- rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ ->
- {-# LINE 52 "src-ag/AG2AspectAG.ag" #-}
- Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_
- {-# LINE 1338 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule74 #-}
- {-# LINE 57 "src-ag/AG2AspectAG.ag" #-}
- rule74 = \ _inhNoGroup ->
- {-# LINE 57 "src-ag/AG2AspectAG.ag" #-}
- map show $ Map.keys _inhNoGroup
- {-# LINE 1344 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule75 #-}
- {-# LINE 58 "src-ag/AG2AspectAG.ag" #-}
- rule75 = \ _synNoGroup ->
- {-# LINE 58 "src-ag/AG2AspectAG.ag" #-}
- map show $ Map.keys _synNoGroup
- {-# LINE 1350 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule76 #-}
- {-# LINE 94 "src-ag/AG2AspectAG.ag" #-}
- rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ ->
- {-# LINE 94 "src-ag/AG2AspectAG.ag" #-}
- case Map.lookup nt_ _lhsInewProds of
- Just prds -> prds
- Nothing -> Map.empty
- {-# LINE 1358 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule77 #-}
- {-# LINE 107 "src-ag/AG2AspectAG.ag" #-}
- rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ ->
- {-# LINE 107 "src-ag/AG2AspectAG.ag" #-}
- if _prodsIhasMoreProds
- then Set.singleton nt_
- else Set.empty
- {-# LINE 1366 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule78 #-}
- {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}
- rule78 = \ nt_ ->
- {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}
- pp nt_
- {-# LINE 1372 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule79 #-}
- {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}
- rule79 = \ _ppNt ->
- {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}
- _ppNt
- {-# LINE 1378 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule80 #-}
- {-# LINE 209 "src-ag/AG2AspectAG.ag" #-}
- rule80 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ ->
- {-# LINE 209 "src-ag/AG2AspectAG.ag" #-}
- if (Set.member nt_ _lhsInewNTs)
- then case (lookup nt_ _lhsItSyns) of
- Nothing -> "data " >|< _ppNt
- >|< " = " >|< vlist_sep " | " _prodsIppDL >-<
- case (Map.lookup nt_ _lhsIderivs) of
- Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds)
- Nothing -> empty
- Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp
- else empty
- {-# LINE 1392 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule81 #-}
- {-# LINE 222 "src-ag/AG2AspectAG.ag" #-}
- rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
- {-# LINE 222 "src-ag/AG2AspectAG.ag" #-}
- if (not $ Set.member nt_ _lhsInewNTs)
- then [ _ppNt ]
- else [ ]
- {-# LINE 1400 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule82 #-}
- {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}
- rule82 = \ _ppNt ->
- {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}
- "nt_" >|< _ppNt
- {-# LINE 1406 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule83 #-}
- {-# LINE 264 "src-ag/AG2AspectAG.ag" #-}
- rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ ->
- {-# LINE 264 "src-ag/AG2AspectAG.ag" #-}
- ( if (Set.member nt_ _lhsInewNTs)
- then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt
- else empty) >-<
- _prodsIppL
- {-# LINE 1415 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule84 #-}
- {-# LINE 269 "src-ag/AG2AspectAG.ag" #-}
- rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ ->
- {-# LINE 269 "src-ag/AG2AspectAG.ag" #-}
- ( if (not $ Set.member nt_ _lhsInewNTs)
- then [ _ntLabel ]
- else [ ]) ++
- _prodsIppLI
- {-# LINE 1424 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule85 #-}
- {-# LINE 324 "src-ag/AG2AspectAG.ag" #-}
- rule85 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ ->
- {-# LINE 324 "src-ag/AG2AspectAG.ag" #-}
- ( if (Set.member nt_ _lhsInewNTs)
- then
- defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-<
- defAttRec (pp "SynG") _ppNt syn_ _synNoGroup
- else empty) >-<
- _prodsIppA
- {-# LINE 1435 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule86 #-}
- {-# LINE 338 "src-ag/AG2AspectAG.ag" #-}
- rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
- {-# LINE 338 "src-ag/AG2AspectAG.ag" #-}
- if (not $ Set.member nt_ _lhsInewNTs)
- then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ]
- else [ ]
- {-# LINE 1443 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule87 #-}
- {-# LINE 406 "src-ag/AG2AspectAG.ag" #-}
- rule87 = \ inh_ nt_ syn_ ->
- {-# LINE 406 "src-ag/AG2AspectAG.ag" #-}
- [ ("nt_" >|< nt_, Map.union inh_ syn_) ]
- {-# LINE 1449 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule88 #-}
- {-# LINE 415 "src-ag/AG2AspectAG.ag" #-}
- rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ ->
- {-# LINE 415 "src-ag/AG2AspectAG.ag" #-}
- Set.member nt_ _lhsInewNTs
- {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule89 #-}
- {-# LINE 425 "src-ag/AG2AspectAG.ag" #-}
- rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ ->
- {-# LINE 425 "src-ag/AG2AspectAG.ag" #-}
- pp "----" >|< pp nt_ >-< _prodsIppR
- {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule90 #-}
- {-# LINE 735 "src-ag/AG2AspectAG.ag" #-}
- rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) ->
- {-# LINE 735 "src-ag/AG2AspectAG.ag" #-}
- "----" >|< _ppNt >-< _prodsIppCata
- {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule91 #-}
- {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}
- rule91 = \ syn_ ->
- {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}
- syn_
- {-# LINE 1473 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule92 #-}
- {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}
- rule92 = \ inh_ ->
- {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}
- inh_
- {-# LINE 1479 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule93 #-}
- {-# LINE 779 "src-ag/AG2AspectAG.ag" #-}
- rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup ->
- {-# LINE 779 "src-ag/AG2AspectAG.ag" #-}
- let inhAtts = attTypes _inhNoGroup
- synAtts = attTypes _synNoGroup
- in
- "----" >|< _ppNt >-<
- "type T_" >|< _ppNt >|< " = " >|<
- "(Record " >|<
- inhAtts >|<
- "(HCons (LVPair (Proxy Att_inh) InhG_" >|< _ppNt >|< ") HNil))" >|<
- replicate (length inhAtts) ")" >|< " -> " >|<
- "(Record " >|<
- synAtts >|<
- "(HCons (LVPair (Proxy Att_syn) SynG_" >|< _ppNt >|< ") HNil))" >|<
- replicate (length synAtts) ")" >-<
- "-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-<
- "-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-<
- _prodsIppSPF
- {-# LINE 1500 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule94 #-}
- {-# LINE 847 "src-ag/AG2AspectAG.ag" #-}
- rule94 = \ _inhNoGroup _ppNt inh_ ->
- {-# LINE 847 "src-ag/AG2AspectAG.ag" #-}
- ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-<
- " sem " >|< attFields inh_ _inhNoGroup _ppNt
- {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule95 #-}
- rule95 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule96 #-}
- rule96 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule97 #-}
- rule97 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule98 #-}
- rule98 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule99 #-}
- rule99 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule100 #-}
- rule100 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
-
--- Nonterminals ------------------------------------------------
--- wrapper
-data Inh_Nonterminals = Inh_Nonterminals { derivs_Inh_Nonterminals :: (Derivings), ext_Inh_Nonterminals :: (Maybe String), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), newAtts_Inh_Nonterminals :: ( Attributes ), newNTs_Inh_Nonterminals :: (Set NontermIdent), newProds_Inh_Nonterminals :: ( DataTypes ), o_noGroup_Inh_Nonterminals :: ([String]), o_rename_Inh_Nonterminals :: (Bool), synMap_Inh_Nonterminals :: (Map Identifier Attributes), tSyns_Inh_Nonterminals :: (TypeSyns) }
-data Syn_Nonterminals = Syn_Nonterminals { extendedNTs_Syn_Nonterminals :: (Set NontermIdent), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), ppA_Syn_Nonterminals :: (PP_Doc), ppAI_Syn_Nonterminals :: ([PP_Doc]), ppCata_Syn_Nonterminals :: (PP_Doc), ppD_Syn_Nonterminals :: (PP_Doc), ppDI_Syn_Nonterminals :: ([PP_Doc]), ppL_Syn_Nonterminals :: (PP_Doc), ppLI_Syn_Nonterminals :: ([PP_Doc]), ppNtL_Syn_Nonterminals :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminals :: (PP_Doc), ppSF_Syn_Nonterminals :: (PP_Doc), ppW_Syn_Nonterminals :: (PP_Doc), synMap'_Syn_Nonterminals :: (Map Identifier Attributes) }
-{-# INLINABLE wrap_Nonterminals #-}
-wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals )
-wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg25 = T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
- (T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminals_s26 sem arg25)
- return (Syn_Nonterminals _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
- )
-
--- cata
-{-# NOINLINE sem_Nonterminals #-}
-sem_Nonterminals :: Nonterminals -> T_Nonterminals
-sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
-
--- semantic domain
-newtype T_Nonterminals = T_Nonterminals {
- attach_T_Nonterminals :: Identity (T_Nonterminals_s26 )
- }
-newtype T_Nonterminals_s26 = C_Nonterminals_s26 {
- inv_Nonterminals_s26 :: (T_Nonterminals_v25 )
- }
-data T_Nonterminals_s27 = C_Nonterminals_s27
-type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 )
-data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
-data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
-{-# NOINLINE sem_Nonterminals_Cons #-}
-sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
-sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where
- {-# NOINLINE st26 #-}
- st26 = let
- v25 :: T_Nonterminals_v25
- v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
- _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
- _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
- (T_Nonterminal_vOut22 _hdIextendedNTs _hdIinhMap' _hdIppA _hdIppAI _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppNtL _hdIppR _hdIppSF _hdIppW _hdIsynMap') = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOderivs _hdOext _hdOinhMap _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOsynMap _hdOtSyns)
- (T_Nonterminals_vOut25 _tlIextendedNTs _tlIinhMap' _tlIppA _tlIppAI _tlIppCata _tlIppD _tlIppDI _tlIppL _tlIppLI _tlIppNtL _tlIppR _tlIppSF _tlIppW _tlIsynMap') = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOderivs _tlOext _tlOinhMap _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOsynMap _tlOtSyns)
- _lhsOextendedNTs :: Set NontermIdent
- _lhsOextendedNTs = rule101 _hdIextendedNTs _tlIextendedNTs
- _lhsOinhMap' :: Map Identifier Attributes
- _lhsOinhMap' = rule102 _hdIinhMap' _tlIinhMap'
- _lhsOppA :: PP_Doc
- _lhsOppA = rule103 _hdIppA _tlIppA
- _lhsOppAI :: [PP_Doc]
- _lhsOppAI = rule104 _hdIppAI _tlIppAI
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule105 _hdIppCata _tlIppCata
- _lhsOppD :: PP_Doc
- _lhsOppD = rule106 _hdIppD _tlIppD
- _lhsOppDI :: [PP_Doc]
- _lhsOppDI = rule107 _hdIppDI _tlIppDI
- _lhsOppL :: PP_Doc
- _lhsOppL = rule108 _hdIppL _tlIppL
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule109 _hdIppLI _tlIppLI
- _lhsOppNtL :: [(PP_Doc, Attributes)]
- _lhsOppNtL = rule110 _hdIppNtL _tlIppNtL
- _lhsOppR :: PP_Doc
- _lhsOppR = rule111 _hdIppR _tlIppR
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule112 _hdIppSF _tlIppSF
- _lhsOppW :: PP_Doc
- _lhsOppW = rule113 _hdIppW _tlIppW
- _lhsOsynMap' :: Map Identifier Attributes
- _lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap'
- _hdOderivs = rule115 _lhsIderivs
- _hdOext = rule116 _lhsIext
- _hdOinhMap = rule117 _lhsIinhMap
- _hdOnewAtts = rule118 _lhsInewAtts
- _hdOnewNTs = rule119 _lhsInewNTs
- _hdOnewProds = rule120 _lhsInewProds
- _hdOo_noGroup = rule121 _lhsIo_noGroup
- _hdOo_rename = rule122 _lhsIo_rename
- _hdOsynMap = rule123 _lhsIsynMap
- _hdOtSyns = rule124 _lhsItSyns
- _tlOderivs = rule125 _lhsIderivs
- _tlOext = rule126 _lhsIext
- _tlOinhMap = rule127 _lhsIinhMap
- _tlOnewAtts = rule128 _lhsInewAtts
- _tlOnewNTs = rule129 _lhsInewNTs
- _tlOnewProds = rule130 _lhsInewProds
- _tlOo_noGroup = rule131 _lhsIo_noGroup
- _tlOo_rename = rule132 _lhsIo_rename
- _tlOsynMap = rule133 _lhsIsynMap
- _tlOtSyns = rule134 _lhsItSyns
- __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
- in __result_ )
- in C_Nonterminals_s26 v25
- {-# INLINE rule101 #-}
- rule101 = \ ((_hdIextendedNTs) :: Set NontermIdent) ((_tlIextendedNTs) :: Set NontermIdent) ->
- _hdIextendedNTs `Set.union` _tlIextendedNTs
- {-# INLINE rule102 #-}
- rule102 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) ->
- _hdIinhMap' `Map.union` _tlIinhMap'
- {-# INLINE rule103 #-}
- rule103 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
- _hdIppA >-< _tlIppA
- {-# INLINE rule104 #-}
- rule104 = \ ((_hdIppAI) :: [PP_Doc]) ((_tlIppAI) :: [PP_Doc]) ->
- _hdIppAI ++ _tlIppAI
- {-# INLINE rule105 #-}
- rule105 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
- _hdIppCata >-< _tlIppCata
- {-# INLINE rule106 #-}
- rule106 = \ ((_hdIppD) :: PP_Doc) ((_tlIppD) :: PP_Doc) ->
- _hdIppD >-< _tlIppD
- {-# INLINE rule107 #-}
- rule107 = \ ((_hdIppDI) :: [PP_Doc]) ((_tlIppDI) :: [PP_Doc]) ->
- _hdIppDI ++ _tlIppDI
- {-# INLINE rule108 #-}
- rule108 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
- _hdIppL >-< _tlIppL
- {-# INLINE rule109 #-}
- rule109 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
- _hdIppLI ++ _tlIppLI
- {-# INLINE rule110 #-}
- rule110 = \ ((_hdIppNtL) :: [(PP_Doc, Attributes)]) ((_tlIppNtL) :: [(PP_Doc, Attributes)]) ->
- _hdIppNtL ++ _tlIppNtL
- {-# INLINE rule111 #-}
- rule111 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
- _hdIppR >-< _tlIppR
- {-# INLINE rule112 #-}
- rule112 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
- _hdIppSF >-< _tlIppSF
- {-# INLINE rule113 #-}
- rule113 = \ ((_hdIppW) :: PP_Doc) ((_tlIppW) :: PP_Doc) ->
- _hdIppW >-< _tlIppW
- {-# INLINE rule114 #-}
- rule114 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) ->
- _hdIsynMap' `Map.union` _tlIsynMap'
- {-# INLINE rule115 #-}
- rule115 = \ ((_lhsIderivs) :: Derivings) ->
- _lhsIderivs
- {-# INLINE rule116 #-}
- rule116 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule117 #-}
- rule117 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule118 #-}
- rule118 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule119 #-}
- rule119 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
- _lhsInewNTs
- {-# INLINE rule120 #-}
- rule120 = \ ((_lhsInewProds) :: DataTypes ) ->
- _lhsInewProds
- {-# INLINE rule121 #-}
- rule121 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule122 #-}
- rule122 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule123 #-}
- rule123 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule124 #-}
- rule124 = \ ((_lhsItSyns) :: TypeSyns) ->
- _lhsItSyns
- {-# INLINE rule125 #-}
- rule125 = \ ((_lhsIderivs) :: Derivings) ->
- _lhsIderivs
- {-# INLINE rule126 #-}
- rule126 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule127 #-}
- rule127 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule128 #-}
- rule128 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule129 #-}
- rule129 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
- _lhsInewNTs
- {-# INLINE rule130 #-}
- rule130 = \ ((_lhsInewProds) :: DataTypes ) ->
- _lhsInewProds
- {-# INLINE rule131 #-}
- rule131 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule132 #-}
- rule132 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule133 #-}
- rule133 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule134 #-}
- rule134 = \ ((_lhsItSyns) :: TypeSyns) ->
- _lhsItSyns
-{-# NOINLINE sem_Nonterminals_Nil #-}
-sem_Nonterminals_Nil :: T_Nonterminals
-sem_Nonterminals_Nil = T_Nonterminals (return st26) where
- {-# NOINLINE st26 #-}
- st26 = let
- v25 :: T_Nonterminals_v25
- v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
- _lhsOextendedNTs :: Set NontermIdent
- _lhsOextendedNTs = rule135 ()
- _lhsOinhMap' :: Map Identifier Attributes
- _lhsOinhMap' = rule136 ()
- _lhsOppA :: PP_Doc
- _lhsOppA = rule137 ()
- _lhsOppAI :: [PP_Doc]
- _lhsOppAI = rule138 ()
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule139 ()
- _lhsOppD :: PP_Doc
- _lhsOppD = rule140 ()
- _lhsOppDI :: [PP_Doc]
- _lhsOppDI = rule141 ()
- _lhsOppL :: PP_Doc
- _lhsOppL = rule142 ()
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule143 ()
- _lhsOppNtL :: [(PP_Doc, Attributes)]
- _lhsOppNtL = rule144 ()
- _lhsOppR :: PP_Doc
- _lhsOppR = rule145 ()
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule146 ()
- _lhsOppW :: PP_Doc
- _lhsOppW = rule147 ()
- _lhsOsynMap' :: Map Identifier Attributes
- _lhsOsynMap' = rule148 ()
- __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
- in __result_ )
- in C_Nonterminals_s26 v25
- {-# INLINE rule135 #-}
- rule135 = \ (_ :: ()) ->
- Set.empty
- {-# INLINE rule136 #-}
- rule136 = \ (_ :: ()) ->
- Map.empty
- {-# INLINE rule137 #-}
- rule137 = \ (_ :: ()) ->
- empty
- {-# INLINE rule138 #-}
- rule138 = \ (_ :: ()) ->
- []
- {-# INLINE rule139 #-}
- rule139 = \ (_ :: ()) ->
- empty
- {-# INLINE rule140 #-}
- rule140 = \ (_ :: ()) ->
- empty
- {-# INLINE rule141 #-}
- rule141 = \ (_ :: ()) ->
- []
- {-# INLINE rule142 #-}
- rule142 = \ (_ :: ()) ->
- empty
- {-# INLINE rule143 #-}
- rule143 = \ (_ :: ()) ->
- []
- {-# INLINE rule144 #-}
- rule144 = \ (_ :: ()) ->
- []
- {-# INLINE rule145 #-}
- rule145 = \ (_ :: ()) ->
- empty
- {-# INLINE rule146 #-}
- rule146 = \ (_ :: ()) ->
- empty
- {-# INLINE rule147 #-}
- rule147 = \ (_ :: ()) ->
- empty
- {-# INLINE rule148 #-}
- rule148 = \ (_ :: ()) ->
- Map.empty
-
--- Pattern -----------------------------------------------------
--- wrapper
-data Inh_Pattern = Inh_Pattern { }
-data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), info_Syn_Pattern :: ((Identifier, Identifier)) }
-{-# INLINABLE wrap_Pattern #-}
-wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
-wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg28 = T_Pattern_vIn28
- (T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg28)
- return (Syn_Pattern _lhsOcopy _lhsOinfo)
- )
-
--- cata
-{-# NOINLINE sem_Pattern #-}
-sem_Pattern :: Pattern -> T_Pattern
-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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
-sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
-sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
-
--- semantic domain
-newtype T_Pattern = T_Pattern {
- attach_T_Pattern :: Identity (T_Pattern_s29 )
- }
-newtype T_Pattern_s29 = C_Pattern_s29 {
- inv_Pattern_s29 :: (T_Pattern_v28 )
- }
-data T_Pattern_s30 = C_Pattern_s30
-type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 )
-data T_Pattern_vIn28 = T_Pattern_vIn28
-data T_Pattern_vOut28 = T_Pattern_vOut28 (Pattern) ((Identifier, Identifier))
-{-# NOINLINE sem_Pattern_Constr #-}
-sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
-sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Pattern_v28
- v28 = \ (T_Pattern_vIn28 ) -> ( let
- _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
- _lhsOinfo :: (Identifier, Identifier)
- _lhsOinfo = rule149 ()
- _copy = rule150 _patsIcopy arg_name_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule151 _copy
- __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
- in __result_ )
- in C_Pattern_s29 v28
- {-# INLINE rule149 #-}
- {-# LINE 383 "src-ag/AG2AspectAG.ag" #-}
- rule149 = \ (_ :: ()) ->
- {-# LINE 383 "src-ag/AG2AspectAG.ag" #-}
- error "Pattern Constr undefined!!"
- {-# LINE 1858 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule150 #-}
- rule150 = \ ((_patsIcopy) :: Patterns) name_ ->
- Constr name_ _patsIcopy
- {-# INLINE rule151 #-}
- rule151 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Product #-}
-sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
-sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Pattern_v28
- v28 = \ (T_Pattern_vIn28 ) -> ( let
- _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
- _lhsOinfo :: (Identifier, Identifier)
- _lhsOinfo = rule152 ()
- _copy = rule153 _patsIcopy arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule154 _copy
- __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
- in __result_ )
- in C_Pattern_s29 v28
- {-# INLINE rule152 #-}
- {-# LINE 384 "src-ag/AG2AspectAG.ag" #-}
- rule152 = \ (_ :: ()) ->
- {-# LINE 384 "src-ag/AG2AspectAG.ag" #-}
- error "Pattern Product undefined!!"
- {-# LINE 1887 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule153 #-}
- rule153 = \ ((_patsIcopy) :: Patterns) pos_ ->
- Product pos_ _patsIcopy
- {-# INLINE rule154 #-}
- rule154 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Alias #-}
-sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
-sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Pattern_v28
- v28 = \ (T_Pattern_vIn28 ) -> ( let
- _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
- _lhsOinfo :: (Identifier, Identifier)
- _lhsOinfo = rule155 arg_attr_ arg_field_
- _copy = rule156 _patIcopy arg_attr_ arg_field_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule157 _copy
- __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
- in __result_ )
- in C_Pattern_s29 v28
- {-# INLINE rule155 #-}
- {-# LINE 382 "src-ag/AG2AspectAG.ag" #-}
- rule155 = \ attr_ field_ ->
- {-# LINE 382 "src-ag/AG2AspectAG.ag" #-}
- (field_, attr_)
- {-# LINE 1916 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule156 #-}
- rule156 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
- Alias field_ attr_ _patIcopy
- {-# INLINE rule157 #-}
- rule157 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Irrefutable #-}
-sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
-sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Pattern_v28
- v28 = \ (T_Pattern_vIn28 ) -> ( let
- _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
- _copy = rule158 _patIcopy
- _lhsOcopy :: Pattern
- _lhsOcopy = rule159 _copy
- _lhsOinfo :: (Identifier, Identifier)
- _lhsOinfo = rule160 _patIinfo
- __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
- in __result_ )
- in C_Pattern_s29 v28
- {-# INLINE rule158 #-}
- rule158 = \ ((_patIcopy) :: Pattern) ->
- Irrefutable _patIcopy
- {-# INLINE rule159 #-}
- rule159 = \ _copy ->
- _copy
- {-# INLINE rule160 #-}
- rule160 = \ ((_patIinfo) :: (Identifier, Identifier)) ->
- _patIinfo
-{-# NOINLINE sem_Pattern_Underscore #-}
-sem_Pattern_Underscore :: (Pos) -> T_Pattern
-sem_Pattern_Underscore arg_pos_ = T_Pattern (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Pattern_v28
- v28 = \ (T_Pattern_vIn28 ) -> ( let
- _lhsOinfo :: (Identifier, Identifier)
- _lhsOinfo = rule161 ()
- _copy = rule162 arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule163 _copy
- __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
- in __result_ )
- in C_Pattern_s29 v28
- {-# INLINE rule161 #-}
- {-# LINE 385 "src-ag/AG2AspectAG.ag" #-}
- rule161 = \ (_ :: ()) ->
- {-# LINE 385 "src-ag/AG2AspectAG.ag" #-}
- error "Pattern Underscore undefined!!"
- {-# LINE 1969 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule162 #-}
- rule162 = \ pos_ ->
- Underscore pos_
- {-# INLINE rule163 #-}
- rule163 = \ _copy ->
- _copy
-
--- Patterns ----------------------------------------------------
--- wrapper
-data Inh_Patterns = Inh_Patterns { }
-data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns) }
-{-# INLINABLE wrap_Patterns #-}
-wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
-wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg31 = T_Patterns_vIn31
- (T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg31)
- return (Syn_Patterns _lhsOcopy)
- )
-
--- cata
-{-# NOINLINE sem_Patterns #-}
-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 {
- attach_T_Patterns :: Identity (T_Patterns_s32 )
- }
-newtype T_Patterns_s32 = C_Patterns_s32 {
- inv_Patterns_s32 :: (T_Patterns_v31 )
- }
-data T_Patterns_s33 = C_Patterns_s33
-type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 )
-data T_Patterns_vIn31 = T_Patterns_vIn31
-data T_Patterns_vOut31 = T_Patterns_vOut31 (Patterns)
-{-# NOINLINE sem_Patterns_Cons #-}
-sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
-sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where
- {-# NOINLINE st32 #-}
- st32 = let
- v31 :: T_Patterns_v31
- v31 = \ (T_Patterns_vIn31 ) -> ( let
- _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
- _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
- (T_Pattern_vOut28 _hdIcopy _hdIinfo) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 )
- (T_Patterns_vOut31 _tlIcopy) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 )
- _copy = rule164 _hdIcopy _tlIcopy
- _lhsOcopy :: Patterns
- _lhsOcopy = rule165 _copy
- __result_ = T_Patterns_vOut31 _lhsOcopy
- in __result_ )
- in C_Patterns_s32 v31
- {-# INLINE rule164 #-}
- rule164 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
- (:) _hdIcopy _tlIcopy
- {-# INLINE rule165 #-}
- rule165 = \ _copy ->
- _copy
-{-# NOINLINE sem_Patterns_Nil #-}
-sem_Patterns_Nil :: T_Patterns
-sem_Patterns_Nil = T_Patterns (return st32) where
- {-# NOINLINE st32 #-}
- st32 = let
- v31 :: T_Patterns_v31
- v31 = \ (T_Patterns_vIn31 ) -> ( let
- _copy = rule166 ()
- _lhsOcopy :: Patterns
- _lhsOcopy = rule167 _copy
- __result_ = T_Patterns_vOut31 _lhsOcopy
- in __result_ )
- in C_Patterns_s32 v31
- {-# INLINE rule166 #-}
- rule166 = \ (_ :: ()) ->
- []
- {-# INLINE rule167 #-}
- rule167 = \ _copy ->
- _copy
-
--- Production --------------------------------------------------
--- wrapper
-data Inh_Production = Inh_Production { ext_Inh_Production :: (Maybe String), inh_Inh_Production :: ( Attributes ), inhMap_Inh_Production :: (Map Identifier Attributes), inhNoGroup_Inh_Production :: ([String]), newAtts_Inh_Production :: ( Attributes ), newNT_Inh_Production :: (Bool), newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Production :: ([String]), o_rename_Inh_Production :: (Bool), ppNt_Inh_Production :: (PP_Doc), syn_Inh_Production :: ( Attributes ), synMap_Inh_Production :: (Map Identifier Attributes), synNoGroup_Inh_Production :: ([String]) }
-data Syn_Production = Syn_Production { hasMoreProds_Syn_Production :: ( Bool ), ppA_Syn_Production :: (PP_Doc), ppCata_Syn_Production :: (PP_Doc), ppD_Syn_Production :: (PP_Doc), ppDI_Syn_Production :: ([PP_Doc]), ppL_Syn_Production :: (PP_Doc), ppLI_Syn_Production :: ([PP_Doc]), ppR_Syn_Production :: (PP_Doc), ppRA_Syn_Production :: ([PP_Doc]), ppSF_Syn_Production :: (PP_Doc), ppSPF_Syn_Production :: (PP_Doc), prdInh_Syn_Production :: (Attributes) }
-{-# INLINABLE wrap_Production #-}
-wrap_Production :: T_Production -> Inh_Production -> (Syn_Production )
-wrap_Production (T_Production act) (Inh_Production _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg34 = T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
- (T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Production_s35 sem arg34)
- return (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
- )
-
--- cata
-{-# INLINE sem_Production #-}
-sem_Production :: Production -> T_Production
-sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_
-
--- semantic domain
-newtype T_Production = T_Production {
- attach_T_Production :: Identity (T_Production_s35 )
- }
-newtype T_Production_s35 = C_Production_s35 {
- inv_Production_s35 :: (T_Production_v34 )
- }
-data T_Production_s36 = C_Production_s36
-type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 )
-data T_Production_vIn34 = T_Production_vIn34 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
-data T_Production_vOut34 = T_Production_vOut34 ( Bool ) (PP_Doc) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
-{-# NOINLINE sem_Production_Production #-}
-sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
-sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Production_v34
- v34 = \ (T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
- _rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
- _typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
- (T_Children_vOut4 _childrenIidCL _childrenIppCSF _childrenIppDL _childrenIppL _childrenIppLI _childrenIppR _childrenIprdInh) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOext _childrenOinhMap _childrenOinhNoGroup _childrenOnewAtts _childrenOo_noGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynMap _childrenOsynNoGroup)
- (T_Rules_vOut43 _rulesIlocals _rulesIppRL) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOext _rulesOinhNoGroup _rulesOnewAtts _rulesOnewProd _rulesOo_noGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup)
- (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 )
- _lhsOhasMoreProds :: Bool
- _lhsOhasMoreProds = rule168 _lhsInewProds arg_con_
- _ppProd = rule169 arg_con_
- _prodName = rule170 _lhsIppNt _ppProd
- _conName = rule171 _lhsIo_rename _ppProd _prodName
- _childrenOppProd = rule172 _ppProd
- _rulesOppProd = rule173 _ppProd
- _lhsOppD :: PP_Doc
- _lhsOppD = rule174 _childrenIppDL _conName
- _lhsOppL :: PP_Doc
- _lhsOppL = rule175 _childrenIppL _lhsInewProds arg_con_
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule176 _childrenIppLI _lhsInewProds arg_con_
- _lhsOppA :: PP_Doc
- _lhsOppA = rule177 _prodName _rulesIlocals
- _newProd = rule178 _lhsInewProds arg_con_
- (_ppR,_ppRA) = rule179 _childrenIidCL _childrenIppR _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsIppNt _lhsIsynNoGroup _newProd _prodName _rulesIlocals _rulesIppRL arg_con_
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule180 _lhsIext _lhsInewNT _newProd _ppRA _prodName arg_macro_
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule181 _childrenIppCSF _conName _lhsIppNt _prodName arg_con_
- _lhsOppSPF :: PP_Doc
- _lhsOppSPF = rule182 _childrenIppCSF _lhsIppNt _prodName arg_con_
- _lhsOppDI :: [PP_Doc]
- _lhsOppDI = rule183 ()
- _lhsOppR :: PP_Doc
- _lhsOppR = rule184 _ppR
- _lhsOppRA :: [PP_Doc]
- _lhsOppRA = rule185 _ppRA
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule186 _childrenIprdInh
- _childrenOext = rule187 _lhsIext
- _childrenOinhMap = rule188 _lhsIinhMap
- _childrenOinhNoGroup = rule189 _lhsIinhNoGroup
- _childrenOnewAtts = rule190 _lhsInewAtts
- _childrenOo_noGroup = rule191 _lhsIo_noGroup
- _childrenOo_rename = rule192 _lhsIo_rename
- _childrenOppNt = rule193 _lhsIppNt
- _childrenOsynMap = rule194 _lhsIsynMap
- _childrenOsynNoGroup = rule195 _lhsIsynNoGroup
- _rulesOext = rule196 _lhsIext
- _rulesOinhNoGroup = rule197 _lhsIinhNoGroup
- _rulesOnewAtts = rule198 _lhsInewAtts
- _rulesOnewProd = rule199 _newProd
- _rulesOo_noGroup = rule200 _lhsIo_noGroup
- _rulesOppNt = rule201 _lhsIppNt
- _rulesOsynNoGroup = rule202 _lhsIsynNoGroup
- __result_ = T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
- in __result_ )
- in C_Production_s35 v34
- {-# INLINE rule168 #-}
- {-# LINE 103 "src-ag/AG2AspectAG.ag" #-}
- rule168 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
- {-# LINE 103 "src-ag/AG2AspectAG.ag" #-}
- not $ Map.member con_ _lhsInewProds
- {-# LINE 2148 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule169 #-}
- {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}
- rule169 = \ con_ ->
- {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}
- pp con_
- {-# LINE 2154 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule170 #-}
- {-# LINE 177 "src-ag/AG2AspectAG.ag" #-}
- rule170 = \ ((_lhsIppNt) :: PP_Doc) _ppProd ->
- {-# LINE 177 "src-ag/AG2AspectAG.ag" #-}
- ppName [_lhsIppNt, _ppProd ]
- {-# LINE 2160 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule171 #-}
- {-# LINE 178 "src-ag/AG2AspectAG.ag" #-}
- rule171 = \ ((_lhsIo_rename) :: Bool) _ppProd _prodName ->
- {-# LINE 178 "src-ag/AG2AspectAG.ag" #-}
- if _lhsIo_rename
- then _prodName
- else _ppProd
- {-# LINE 2168 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule172 #-}
- {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}
- rule172 = \ _ppProd ->
- {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}
- _ppProd
- {-# LINE 2174 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule173 #-}
- {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}
- rule173 = \ _ppProd ->
- {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}
- _ppProd
- {-# LINE 2180 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule174 #-}
- {-# LINE 228 "src-ag/AG2AspectAG.ag" #-}
- rule174 = \ ((_childrenIppDL) :: [PP_Doc]) _conName ->
- {-# LINE 228 "src-ag/AG2AspectAG.ag" #-}
- _conName >|< ppListSep " {" "}" ", " _childrenIppDL
- {-# LINE 2186 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule175 #-}
- {-# LINE 275 "src-ag/AG2AspectAG.ag" #-}
- rule175 = \ ((_childrenIppL) :: PP_Doc) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
- {-# LINE 275 "src-ag/AG2AspectAG.ag" #-}
- if (Map.member con_ _lhsInewProds)
- then _childrenIppL
- else empty
- {-# LINE 2194 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule176 #-}
- {-# LINE 279 "src-ag/AG2AspectAG.ag" #-}
- rule176 = \ ((_childrenIppLI) :: [PP_Doc]) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
- {-# LINE 279 "src-ag/AG2AspectAG.ag" #-}
- if (not $ Map.member con_ _lhsInewProds)
- then _childrenIppLI
- else []
- {-# LINE 2202 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule177 #-}
- {-# LINE 332 "src-ag/AG2AspectAG.ag" #-}
- rule177 = \ _prodName ((_rulesIlocals) :: [Identifier]) ->
- {-# LINE 332 "src-ag/AG2AspectAG.ag" #-}
- defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals
- {-# LINE 2208 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule178 #-}
- {-# LINE 428 "src-ag/AG2AspectAG.ag" #-}
- rule178 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
- {-# LINE 428 "src-ag/AG2AspectAG.ag" #-}
- Map.member con_ _lhsInewProds
- {-# LINE 2214 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule179 #-}
- {-# LINE 430 "src-ag/AG2AspectAG.ag" #-}
- rule179 = \ ((_childrenIidCL) :: [(Identifier,Type)]) ((_childrenIppR) :: PP_Doc) ((_lhsIinhNoGroup) :: [String]) ((_lhsInewAtts) :: Attributes ) ((_lhsInewNT) :: Bool) ((_lhsIppNt) :: PP_Doc) ((_lhsIsynNoGroup) :: [String]) _newProd _prodName ((_rulesIlocals) :: [Identifier]) ((_rulesIppRL) :: [ PPRule ]) con_ ->
- {-# LINE 430 "src-ag/AG2AspectAG.ag" #-}
- let (instR, instRA) = defInstRules _lhsIppNt con_ _lhsInewNT _newProd
- _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals
- (locR, locRA) = defLocRule _lhsIppNt con_ _lhsInewNT _newProd
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (inhGR, inhGRA) = defInhGRule _lhsIppNt _prodName _lhsInewNT _newProd
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (synGR, synGRA) = defSynGRule _lhsIppNt con_ _lhsInewNT _newProd
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (inhR, inhRA) = defInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (synR, synRA) = defSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (inhMR, inhMRA) = modInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- (synMR, synMRA) = modSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
- _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
- in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR]
- , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA)
- {-# LINE 2237 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule180 #-}
- {-# LINE 740 "src-ag/AG2AspectAG.ag" #-}
- rule180 = \ ((_lhsIext) :: Maybe String) ((_lhsInewNT) :: Bool) _newProd _ppRA _prodName macro_ ->
- {-# LINE 740 "src-ag/AG2AspectAG.ag" #-}
- let extend = maybe []
- ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd ))
- then []
- else [ ext >|< ".atts_" >|< _prodName ])
- _lhsIext
- macro = case macro_ of
- Nothing -> []
- Just macro -> [ "agMacro " >|< ppMacro macro ]
- atts = sortBy (\a b -> compare (show a) (show b)) _ppRA
- in "atts_" >|< _prodName >|< " = " >|<
- ppListSep "" "" " `ext` "
- (atts ++ macro ++ extend ) >-<
- "semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName
- {-# LINE 2255 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule181 #-}
- {-# LINE 804 "src-ag/AG2AspectAG.ag" #-}
- rule181 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) _conName ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
- {-# LINE 804 "src-ag/AG2AspectAG.ag" #-}
- let chi = _childrenIppCSF
- ppPattern = case (show con_) of
- "Cons" -> ppParams (ppListSep "" "" " : ")
- "Nil" -> pp "[]"
- otherwise -> _conName >|< " " >|< (ppParams ppSpaced)
- ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
- in "sem_" >|< _lhsIppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< _prodName >|<
- " (" >|< map (fst . snd) chi >|< "emptyRecord)"
- {-# LINE 2268 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule182 #-}
- {-# LINE 816 "src-ag/AG2AspectAG.ag" #-}
- rule182 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
- {-# LINE 816 "src-ag/AG2AspectAG.ag" #-}
- let chi = _childrenIppCSF
- ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
- in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|<
- " (" >|< map (snd . snd) chi >|< "emptyRecord)"
- {-# LINE 2277 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule183 #-}
- rule183 = \ (_ :: ()) ->
- []
- {-# INLINE rule184 #-}
- rule184 = \ _ppR ->
- _ppR
- {-# INLINE rule185 #-}
- rule185 = \ _ppRA ->
- _ppRA
- {-# INLINE rule186 #-}
- rule186 = \ ((_childrenIprdInh) :: Attributes) ->
- _childrenIprdInh
- {-# INLINE rule187 #-}
- rule187 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule188 #-}
- rule188 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule189 #-}
- rule189 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule190 #-}
- rule190 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule191 #-}
- rule191 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule192 #-}
- rule192 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule193 #-}
- rule193 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule194 #-}
- rule194 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule195 #-}
- rule195 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
- {-# INLINE rule196 #-}
- rule196 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule197 #-}
- rule197 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule198 #-}
- rule198 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule199 #-}
- rule199 = \ _newProd ->
- _newProd
- {-# INLINE rule200 #-}
- rule200 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule201 #-}
- rule201 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule202 #-}
- rule202 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
-
--- Productions -------------------------------------------------
--- wrapper
-data Inh_Productions = Inh_Productions { ext_Inh_Productions :: (Maybe String), inh_Inh_Productions :: ( Attributes ), inhMap_Inh_Productions :: (Map Identifier Attributes), inhNoGroup_Inh_Productions :: ([String]), newAtts_Inh_Productions :: ( Attributes ), newNT_Inh_Productions :: (Bool), newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Productions :: ([String]), o_rename_Inh_Productions :: (Bool), ppNt_Inh_Productions :: (PP_Doc), syn_Inh_Productions :: ( Attributes ), synMap_Inh_Productions :: (Map Identifier Attributes), synNoGroup_Inh_Productions :: ([String]) }
-data Syn_Productions = Syn_Productions { hasMoreProds_Syn_Productions :: ( Bool ), ppA_Syn_Productions :: (PP_Doc), ppCata_Syn_Productions :: (PP_Doc), ppDL_Syn_Productions :: ([PP_Doc]), ppL_Syn_Productions :: (PP_Doc), ppLI_Syn_Productions :: ([PP_Doc]), ppR_Syn_Productions :: (PP_Doc), ppRA_Syn_Productions :: ([PP_Doc]), ppSF_Syn_Productions :: (PP_Doc), ppSPF_Syn_Productions :: (PP_Doc), prdInh_Syn_Productions :: (Attributes) }
-{-# INLINABLE wrap_Productions #-}
-wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions )
-wrap_Productions (T_Productions act) (Inh_Productions _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg37 = T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
- (T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Productions_s38 sem arg37)
- return (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
- )
-
--- cata
-{-# NOINLINE sem_Productions #-}
-sem_Productions :: Productions -> T_Productions
-sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
-
--- semantic domain
-newtype T_Productions = T_Productions {
- attach_T_Productions :: Identity (T_Productions_s38 )
- }
-newtype T_Productions_s38 = C_Productions_s38 {
- inv_Productions_s38 :: (T_Productions_v37 )
- }
-data T_Productions_s39 = C_Productions_s39
-type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 )
-data T_Productions_vIn37 = T_Productions_vIn37 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
-data T_Productions_vOut37 = T_Productions_vOut37 ( Bool ) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
-{-# NOINLINE sem_Productions_Cons #-}
-sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
-sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where
- {-# NOINLINE st38 #-}
- st38 = let
- v37 :: T_Productions_v37
- v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
- _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
- (T_Production_vOut34 _hdIhasMoreProds _hdIppA _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppR _hdIppRA _hdIppSF _hdIppSPF _hdIprdInh) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOext _hdOinh _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOppNt _hdOsyn _hdOsynMap _hdOsynNoGroup)
- (T_Productions_vOut37 _tlIhasMoreProds _tlIppA _tlIppCata _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIppRA _tlIppSF _tlIppSPF _tlIprdInh) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOext _tlOinh _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOppNt _tlOsyn _tlOsynMap _tlOsynNoGroup)
- _hdOinhNoGroup = rule203 _hdIprdInh _lhsIinhNoGroup
- _lhsOppDL :: [PP_Doc]
- _lhsOppDL = rule204 _hdIppD _tlIppDL
- _lhsOhasMoreProds :: Bool
- _lhsOhasMoreProds = rule205 _hdIhasMoreProds _tlIhasMoreProds
- _lhsOppA :: PP_Doc
- _lhsOppA = rule206 _hdIppA _tlIppA
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule207 _hdIppCata _tlIppCata
- _lhsOppL :: PP_Doc
- _lhsOppL = rule208 _hdIppL _tlIppL
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule209 _hdIppLI _tlIppLI
- _lhsOppR :: PP_Doc
- _lhsOppR = rule210 _hdIppR _tlIppR
- _lhsOppRA :: [PP_Doc]
- _lhsOppRA = rule211 _hdIppRA _tlIppRA
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule212 _hdIppSF _tlIppSF
- _lhsOppSPF :: PP_Doc
- _lhsOppSPF = rule213 _hdIppSPF _tlIppSPF
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule214 _hdIprdInh _tlIprdInh
- _hdOext = rule215 _lhsIext
- _hdOinh = rule216 _lhsIinh
- _hdOinhMap = rule217 _lhsIinhMap
- _hdOnewAtts = rule218 _lhsInewAtts
- _hdOnewNT = rule219 _lhsInewNT
- _hdOnewProds = rule220 _lhsInewProds
- _hdOo_noGroup = rule221 _lhsIo_noGroup
- _hdOo_rename = rule222 _lhsIo_rename
- _hdOppNt = rule223 _lhsIppNt
- _hdOsyn = rule224 _lhsIsyn
- _hdOsynMap = rule225 _lhsIsynMap
- _hdOsynNoGroup = rule226 _lhsIsynNoGroup
- _tlOext = rule227 _lhsIext
- _tlOinh = rule228 _lhsIinh
- _tlOinhMap = rule229 _lhsIinhMap
- _tlOinhNoGroup = rule230 _lhsIinhNoGroup
- _tlOnewAtts = rule231 _lhsInewAtts
- _tlOnewNT = rule232 _lhsInewNT
- _tlOnewProds = rule233 _lhsInewProds
- _tlOo_noGroup = rule234 _lhsIo_noGroup
- _tlOo_rename = rule235 _lhsIo_rename
- _tlOppNt = rule236 _lhsIppNt
- _tlOsyn = rule237 _lhsIsyn
- _tlOsynMap = rule238 _lhsIsynMap
- _tlOsynNoGroup = rule239 _lhsIsynNoGroup
- __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
- in __result_ )
- in C_Productions_s38 v37
- {-# INLINE rule203 #-}
- {-# LINE 62 "src-ag/AG2AspectAG.ag" #-}
- rule203 = \ ((_hdIprdInh) :: Attributes) ((_lhsIinhNoGroup) :: [String]) ->
- {-# LINE 62 "src-ag/AG2AspectAG.ag" #-}
- filter (flip Map.member _hdIprdInh . identifier) _lhsIinhNoGroup
- {-# LINE 2436 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule204 #-}
- {-# LINE 234 "src-ag/AG2AspectAG.ag" #-}
- rule204 = \ ((_hdIppD) :: PP_Doc) ((_tlIppDL) :: [PP_Doc]) ->
- {-# LINE 234 "src-ag/AG2AspectAG.ag" #-}
- _hdIppD : _tlIppDL
- {-# LINE 2442 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule205 #-}
- rule205 = \ ((_hdIhasMoreProds) :: Bool ) ((_tlIhasMoreProds) :: Bool ) ->
- _hdIhasMoreProds || _tlIhasMoreProds
- {-# INLINE rule206 #-}
- rule206 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
- _hdIppA >-< _tlIppA
- {-# INLINE rule207 #-}
- rule207 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
- _hdIppCata >-< _tlIppCata
- {-# INLINE rule208 #-}
- rule208 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
- _hdIppL >-< _tlIppL
- {-# INLINE rule209 #-}
- rule209 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
- _hdIppLI ++ _tlIppLI
- {-# INLINE rule210 #-}
- rule210 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
- _hdIppR >-< _tlIppR
- {-# INLINE rule211 #-}
- rule211 = \ ((_hdIppRA) :: [PP_Doc]) ((_tlIppRA) :: [PP_Doc]) ->
- _hdIppRA ++ _tlIppRA
- {-# INLINE rule212 #-}
- rule212 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
- _hdIppSF >-< _tlIppSF
- {-# INLINE rule213 #-}
- rule213 = \ ((_hdIppSPF) :: PP_Doc) ((_tlIppSPF) :: PP_Doc) ->
- _hdIppSPF >-< _tlIppSPF
- {-# INLINE rule214 #-}
- rule214 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
- _hdIprdInh `Map.union` _tlIprdInh
- {-# INLINE rule215 #-}
- rule215 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule216 #-}
- rule216 = \ ((_lhsIinh) :: Attributes ) ->
- _lhsIinh
- {-# INLINE rule217 #-}
- rule217 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule218 #-}
- rule218 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule219 #-}
- rule219 = \ ((_lhsInewNT) :: Bool) ->
- _lhsInewNT
- {-# INLINE rule220 #-}
- rule220 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
- _lhsInewProds
- {-# INLINE rule221 #-}
- rule221 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule222 #-}
- rule222 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule223 #-}
- rule223 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule224 #-}
- rule224 = \ ((_lhsIsyn) :: Attributes ) ->
- _lhsIsyn
- {-# INLINE rule225 #-}
- rule225 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule226 #-}
- rule226 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
- {-# INLINE rule227 #-}
- rule227 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule228 #-}
- rule228 = \ ((_lhsIinh) :: Attributes ) ->
- _lhsIinh
- {-# INLINE rule229 #-}
- rule229 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
- _lhsIinhMap
- {-# INLINE rule230 #-}
- rule230 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule231 #-}
- rule231 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule232 #-}
- rule232 = \ ((_lhsInewNT) :: Bool) ->
- _lhsInewNT
- {-# INLINE rule233 #-}
- rule233 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
- _lhsInewProds
- {-# INLINE rule234 #-}
- rule234 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule235 #-}
- rule235 = \ ((_lhsIo_rename) :: Bool) ->
- _lhsIo_rename
- {-# INLINE rule236 #-}
- rule236 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule237 #-}
- rule237 = \ ((_lhsIsyn) :: Attributes ) ->
- _lhsIsyn
- {-# INLINE rule238 #-}
- rule238 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
- _lhsIsynMap
- {-# INLINE rule239 #-}
- rule239 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
-{-# NOINLINE sem_Productions_Nil #-}
-sem_Productions_Nil :: T_Productions
-sem_Productions_Nil = T_Productions (return st38) where
- {-# NOINLINE st38 #-}
- st38 = let
- v37 :: T_Productions_v37
- v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
- _lhsOppDL :: [PP_Doc]
- _lhsOppDL = rule240 ()
- _lhsOhasMoreProds :: Bool
- _lhsOhasMoreProds = rule241 ()
- _lhsOppA :: PP_Doc
- _lhsOppA = rule242 ()
- _lhsOppCata :: PP_Doc
- _lhsOppCata = rule243 ()
- _lhsOppL :: PP_Doc
- _lhsOppL = rule244 ()
- _lhsOppLI :: [PP_Doc]
- _lhsOppLI = rule245 ()
- _lhsOppR :: PP_Doc
- _lhsOppR = rule246 ()
- _lhsOppRA :: [PP_Doc]
- _lhsOppRA = rule247 ()
- _lhsOppSF :: PP_Doc
- _lhsOppSF = rule248 ()
- _lhsOppSPF :: PP_Doc
- _lhsOppSPF = rule249 ()
- _lhsOprdInh :: Attributes
- _lhsOprdInh = rule250 ()
- __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
- in __result_ )
- in C_Productions_s38 v37
- {-# INLINE rule240 #-}
- {-# LINE 235 "src-ag/AG2AspectAG.ag" #-}
- rule240 = \ (_ :: ()) ->
- {-# LINE 235 "src-ag/AG2AspectAG.ag" #-}
- []
- {-# LINE 2585 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule241 #-}
- rule241 = \ (_ :: ()) ->
- False
- {-# INLINE rule242 #-}
- rule242 = \ (_ :: ()) ->
- empty
- {-# INLINE rule243 #-}
- rule243 = \ (_ :: ()) ->
- empty
- {-# INLINE rule244 #-}
- rule244 = \ (_ :: ()) ->
- empty
- {-# INLINE rule245 #-}
- rule245 = \ (_ :: ()) ->
- []
- {-# INLINE rule246 #-}
- rule246 = \ (_ :: ()) ->
- empty
- {-# INLINE rule247 #-}
- rule247 = \ (_ :: ()) ->
- []
- {-# INLINE rule248 #-}
- rule248 = \ (_ :: ()) ->
- empty
- {-# INLINE rule249 #-}
- rule249 = \ (_ :: ()) ->
- empty
- {-# INLINE rule250 #-}
- rule250 = \ (_ :: ()) ->
- Map.empty
-
--- Rule --------------------------------------------------------
--- wrapper
-data Inh_Rule = Inh_Rule { ext_Inh_Rule :: (Maybe String), inhNoGroup_Inh_Rule :: ([String]), newAtts_Inh_Rule :: ( Attributes ), newProd_Inh_Rule :: (Bool), o_noGroup_Inh_Rule :: ([String]), ppNt_Inh_Rule :: (PP_Doc), ppProd_Inh_Rule :: (PP_Doc), synNoGroup_Inh_Rule :: ([String]) }
-data Syn_Rule = Syn_Rule { locals_Syn_Rule :: ([Identifier]), ppRL_Syn_Rule :: ([ PPRule ]) }
-{-# INLINABLE wrap_Rule #-}
-wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule )
-wrap_Rule (T_Rule act) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg40 = T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
- (T_Rule_vOut40 _lhsOlocals _lhsOppRL) <- return (inv_Rule_s41 sem arg40)
- return (Syn_Rule _lhsOlocals _lhsOppRL)
- )
-
--- cata
-{-# INLINE sem_Rule #-}
-sem_Rule :: Rule -> T_Rule
-sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
-
--- semantic domain
-newtype T_Rule = T_Rule {
- attach_T_Rule :: Identity (T_Rule_s41 )
- }
-newtype T_Rule_s41 = C_Rule_s41 {
- inv_Rule_s41 :: (T_Rule_v40 )
- }
-data T_Rule_s42 = C_Rule_s42
-type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 )
-data T_Rule_vIn40 = T_Rule_vIn40 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
-data T_Rule_vOut40 = T_Rule_vOut40 ([Identifier]) ([ PPRule ])
-{-# NOINLINE sem_Rule_Rule #-}
-sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
-sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ arg_explicit_ _ _ _ _ = T_Rule (return st41) where
- {-# NOINLINE st41 #-}
- st41 = let
- v40 :: T_Rule_v40
- v40 = \ (T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
- _patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
- _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
- (T_Pattern_vOut28 _patternIcopy _patternIinfo) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 )
- (T_Expression_vOut7 _rhsIppRE) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOppNt _rhsOppProd)
- _lhsOlocals :: [Identifier]
- _lhsOlocals = rule251 _patternIinfo
- _lhsOppRL :: [ PPRule ]
- _lhsOppRL = rule252 _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _patternIinfo _rhsIppRE arg_explicit_ arg_owrt_
- _rhsOppNt = rule253 _lhsIppNt
- _rhsOppProd = rule254 _lhsIppProd
- __result_ = T_Rule_vOut40 _lhsOlocals _lhsOppRL
- in __result_ )
- in C_Rule_s41 v40
- {-# INLINE rule251 #-}
- {-# LINE 375 "src-ag/AG2AspectAG.ag" #-}
- rule251 = \ ((_patternIinfo) :: (Identifier, Identifier)) ->
- {-# LINE 375 "src-ag/AG2AspectAG.ag" #-}
- if (show (fst _patternIinfo) == "loc")
- then [ snd _patternIinfo ]
- else [ ]
- {-# LINE 2674 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule252 #-}
- {-# LINE 472 "src-ag/AG2AspectAG.ag" #-}
- rule252 = \ ((_lhsInewAtts) :: Attributes ) ((_lhsInewProd) :: Bool) ((_lhsIo_noGroup) :: [String]) ((_lhsIppNt) :: PP_Doc) ((_patternIinfo) :: (Identifier, Identifier)) ((_rhsIppRE) :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) explicit_ owrt_ ->
- {-# LINE 472 "src-ag/AG2AspectAG.ag" #-}
- if (not explicit_ && not _lhsInewProd && not (Map.member (snd _patternIinfo) _lhsInewAtts) )
- then []
- else [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIo_noGroup _rhsIppRE) ]
- {-# LINE 2682 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule253 #-}
- rule253 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule254 #-}
- rule254 = \ ((_lhsIppProd) :: PP_Doc) ->
- _lhsIppProd
-
--- Rules -------------------------------------------------------
--- wrapper
-data Inh_Rules = Inh_Rules { ext_Inh_Rules :: (Maybe String), inhNoGroup_Inh_Rules :: ([String]), newAtts_Inh_Rules :: ( Attributes ), newProd_Inh_Rules :: (Bool), o_noGroup_Inh_Rules :: ([String]), ppNt_Inh_Rules :: (PP_Doc), ppProd_Inh_Rules :: (PP_Doc), synNoGroup_Inh_Rules :: ([String]) }
-data Syn_Rules = Syn_Rules { locals_Syn_Rules :: ([Identifier]), ppRL_Syn_Rules :: ([ PPRule ]) }
-{-# INLINABLE wrap_Rules #-}
-wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules )
-wrap_Rules (T_Rules act) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg43 = T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
- (T_Rules_vOut43 _lhsOlocals _lhsOppRL) <- return (inv_Rules_s44 sem arg43)
- return (Syn_Rules _lhsOlocals _lhsOppRL)
- )
-
--- cata
-{-# NOINLINE sem_Rules #-}
-sem_Rules :: Rules -> T_Rules
-sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
-
--- semantic domain
-newtype T_Rules = T_Rules {
- attach_T_Rules :: Identity (T_Rules_s44 )
- }
-newtype T_Rules_s44 = C_Rules_s44 {
- inv_Rules_s44 :: (T_Rules_v43 )
- }
-data T_Rules_s45 = C_Rules_s45
-type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 )
-data T_Rules_vIn43 = T_Rules_vIn43 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
-data T_Rules_vOut43 = T_Rules_vOut43 ([Identifier]) ([ PPRule ])
-{-# NOINLINE sem_Rules_Cons #-}
-sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
-sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where
- {-# NOINLINE st44 #-}
- st44 = let
- v43 :: T_Rules_v43
- v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
- _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
- _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
- (T_Rule_vOut40 _hdIlocals _hdIppRL) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOext _hdOinhNoGroup _hdOnewAtts _hdOnewProd _hdOo_noGroup _hdOppNt _hdOppProd _hdOsynNoGroup)
- (T_Rules_vOut43 _tlIlocals _tlIppRL) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOext _tlOinhNoGroup _tlOnewAtts _tlOnewProd _tlOo_noGroup _tlOppNt _tlOppProd _tlOsynNoGroup)
- _lhsOppRL :: [ PPRule ]
- _lhsOppRL = rule255 _hdIppRL _tlIppRL
- _lhsOlocals :: [Identifier]
- _lhsOlocals = rule256 _hdIlocals _tlIlocals
- _hdOext = rule257 _lhsIext
- _hdOinhNoGroup = rule258 _lhsIinhNoGroup
- _hdOnewAtts = rule259 _lhsInewAtts
- _hdOnewProd = rule260 _lhsInewProd
- _hdOo_noGroup = rule261 _lhsIo_noGroup
- _hdOppNt = rule262 _lhsIppNt
- _hdOppProd = rule263 _lhsIppProd
- _hdOsynNoGroup = rule264 _lhsIsynNoGroup
- _tlOext = rule265 _lhsIext
- _tlOinhNoGroup = rule266 _lhsIinhNoGroup
- _tlOnewAtts = rule267 _lhsInewAtts
- _tlOnewProd = rule268 _lhsInewProd
- _tlOo_noGroup = rule269 _lhsIo_noGroup
- _tlOppNt = rule270 _lhsIppNt
- _tlOppProd = rule271 _lhsIppProd
- _tlOsynNoGroup = rule272 _lhsIsynNoGroup
- __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
- in __result_ )
- in C_Rules_s44 v43
- {-# INLINE rule255 #-}
- {-# LINE 468 "src-ag/AG2AspectAG.ag" #-}
- rule255 = \ ((_hdIppRL) :: [ PPRule ]) ((_tlIppRL) :: [ PPRule ]) ->
- {-# LINE 468 "src-ag/AG2AspectAG.ag" #-}
- _hdIppRL ++ _tlIppRL
- {-# LINE 2759 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule256 #-}
- rule256 = \ ((_hdIlocals) :: [Identifier]) ((_tlIlocals) :: [Identifier]) ->
- _hdIlocals ++ _tlIlocals
- {-# INLINE rule257 #-}
- rule257 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule258 #-}
- rule258 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule259 #-}
- rule259 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule260 #-}
- rule260 = \ ((_lhsInewProd) :: Bool) ->
- _lhsInewProd
- {-# INLINE rule261 #-}
- rule261 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule262 #-}
- rule262 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule263 #-}
- rule263 = \ ((_lhsIppProd) :: PP_Doc) ->
- _lhsIppProd
- {-# INLINE rule264 #-}
- rule264 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
- {-# INLINE rule265 #-}
- rule265 = \ ((_lhsIext) :: Maybe String) ->
- _lhsIext
- {-# INLINE rule266 #-}
- rule266 = \ ((_lhsIinhNoGroup) :: [String]) ->
- _lhsIinhNoGroup
- {-# INLINE rule267 #-}
- rule267 = \ ((_lhsInewAtts) :: Attributes ) ->
- _lhsInewAtts
- {-# INLINE rule268 #-}
- rule268 = \ ((_lhsInewProd) :: Bool) ->
- _lhsInewProd
- {-# INLINE rule269 #-}
- rule269 = \ ((_lhsIo_noGroup) :: [String]) ->
- _lhsIo_noGroup
- {-# INLINE rule270 #-}
- rule270 = \ ((_lhsIppNt) :: PP_Doc) ->
- _lhsIppNt
- {-# INLINE rule271 #-}
- rule271 = \ ((_lhsIppProd) :: PP_Doc) ->
- _lhsIppProd
- {-# INLINE rule272 #-}
- rule272 = \ ((_lhsIsynNoGroup) :: [String]) ->
- _lhsIsynNoGroup
-{-# NOINLINE sem_Rules_Nil #-}
-sem_Rules_Nil :: T_Rules
-sem_Rules_Nil = T_Rules (return st44) where
- {-# NOINLINE st44 #-}
- st44 = let
- v43 :: T_Rules_v43
- v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
- _lhsOppRL :: [ PPRule ]
- _lhsOppRL = rule273 ()
- _lhsOlocals :: [Identifier]
- _lhsOlocals = rule274 ()
- __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
- in __result_ )
- in C_Rules_s44 v43
- {-# INLINE rule273 #-}
- {-# LINE 469 "src-ag/AG2AspectAG.ag" #-}
- rule273 = \ (_ :: ()) ->
- {-# LINE 469 "src-ag/AG2AspectAG.ag" #-}
- []
- {-# LINE 2830 "dist/build/AG2AspectAG.hs"#-}
- {-# INLINE rule274 #-}
- rule274 = \ (_ :: ()) ->
- []
-
--- TypeSig -----------------------------------------------------
--- wrapper
-data Inh_TypeSig = Inh_TypeSig { }
-data Syn_TypeSig = Syn_TypeSig { }
-{-# INLINABLE wrap_TypeSig #-}
-wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
-wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg46 = T_TypeSig_vIn46
- (T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg46)
- return (Syn_TypeSig )
- )
-
--- cata
-{-# INLINE sem_TypeSig #-}
-sem_TypeSig :: TypeSig -> T_TypeSig
-sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
-
--- semantic domain
-newtype T_TypeSig = T_TypeSig {
- attach_T_TypeSig :: Identity (T_TypeSig_s47 )
- }
-newtype T_TypeSig_s47 = C_TypeSig_s47 {
- inv_TypeSig_s47 :: (T_TypeSig_v46 )
- }
-data T_TypeSig_s48 = C_TypeSig_s48
-type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 )
-data T_TypeSig_vIn46 = T_TypeSig_vIn46
-data T_TypeSig_vOut46 = T_TypeSig_vOut46
-{-# NOINLINE sem_TypeSig_TypeSig #-}
-sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
-sem_TypeSig_TypeSig _ _ = T_TypeSig (return st47) where
- {-# NOINLINE st47 #-}
- st47 = let
- v46 :: T_TypeSig_v46
- v46 = \ (T_TypeSig_vIn46 ) -> ( let
- __result_ = T_TypeSig_vOut46
- in __result_ )
- in C_TypeSig_s47 v46
-
--- TypeSigs ----------------------------------------------------
--- wrapper
-data Inh_TypeSigs = Inh_TypeSigs { }
-data Syn_TypeSigs = Syn_TypeSigs { }
-{-# INLINABLE wrap_TypeSigs #-}
-wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
-wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg49 = T_TypeSigs_vIn49
- (T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg49)
- return (Syn_TypeSigs )
- )
-
--- cata
-{-# NOINLINE sem_TypeSigs #-}
-sem_TypeSigs :: TypeSigs -> T_TypeSigs
-sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
-
--- semantic domain
-newtype T_TypeSigs = T_TypeSigs {
- attach_T_TypeSigs :: Identity (T_TypeSigs_s50 )
- }
-newtype T_TypeSigs_s50 = C_TypeSigs_s50 {
- inv_TypeSigs_s50 :: (T_TypeSigs_v49 )
- }
-data T_TypeSigs_s51 = C_TypeSigs_s51
-type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 )
-data T_TypeSigs_vIn49 = T_TypeSigs_vIn49
-data T_TypeSigs_vOut49 = T_TypeSigs_vOut49
-{-# NOINLINE sem_TypeSigs_Cons #-}
-sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
-sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where
- {-# NOINLINE st50 #-}
- st50 = let
- v49 :: T_TypeSigs_v49
- v49 = \ (T_TypeSigs_vIn49 ) -> ( let
- _hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
- _tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
- (T_TypeSig_vOut46 ) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 )
- (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 )
- __result_ = T_TypeSigs_vOut49
- in __result_ )
- in C_TypeSigs_s50 v49
-{-# NOINLINE sem_TypeSigs_Nil #-}
-sem_TypeSigs_Nil :: T_TypeSigs
-sem_TypeSigs_Nil = T_TypeSigs (return st50) where
- {-# NOINLINE st50 #-}
- st50 = let
- v49 :: T_TypeSigs_v49
- v49 = \ (T_TypeSigs_vIn49 ) -> ( let
- __result_ = T_TypeSigs_vOut49
- in __result_ )
- in C_TypeSigs_s50 v49
+{-# LANGUAGE Rank2Types, GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module AG2AspectAG where
+{-# LINE 2 "src-ag/HsToken.ag" #-}
+
+import CommonTypes
+import UU.Scanner.Position(Pos)
+{-# LINE 10 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 2 "src-ag/Expression.ag" #-}
+
+import UU.Scanner.Position(Pos)
+import HsToken
+{-# LINE 16 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 2 "src-ag/Patterns.ag" #-}
+
+-- Patterns.ag imports
+import UU.Scanner.Position(Pos)
+import CommonTypes (ConstructorIdent,Identifier)
+{-# LINE 23 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
+
+-- AbstractSyntax.ag imports
+import Data.Set(Set)
+import Data.Map(Map)
+import Patterns (Pattern(..),Patterns)
+import Expression (Expression(..))
+import Macro --marcos
+import CommonTypes
+import ErrorMessages
+{-# LINE 35 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 8 "src-ag/AG2AspectAG.ag" #-}
+
+import Options
+
+import Data.Char
+import Data.List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+
+import Pretty
+import PPUtil
+import UU.Scanner.Position
+
+import AbstractSyntax
+import TokenDef
+import CommonTypes
+
+-- import Debug.Trace
+{-# LINE 56 "dist/build/AG2AspectAG.hs" #-}
+import Control.Monad.Identity (Identity)
+import qualified Control.Monad.Identity
+{-# LINE 28 "src-ag/AG2AspectAG.ag" #-}
+
+pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}"
+
+{-# LINE 63 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 33 "src-ag/AG2AspectAG.ag" #-}
+
+ppName l = ppListSep "" "" "_" l
+{-# LINE 68 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 70 "src-ag/AG2AspectAG.ag" #-}
+
+type FieldMap = [(Identifier, Type)]
+type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap)
+{-# LINE 74 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 342 "src-ag/AG2AspectAG.ag" #-}
+
+filterAtts newAtts = filter (\att -> Map.member (identifier att) newAtts)
+filterNotAtts newAtts = filter (\att -> not (Map.member (identifier att) newAtts))
+
+defAtt att = "data " >|< attTName att >|< "; " >|< attName att >|< " = proxy :: Proxy " >|< attTName att
+attName att = pp $ "att_" ++ att
+attTName att = pp $ "Att_" ++ att
+
+
+defAttRec recPref ppNt atts noGroup =
+ let recName = ppName [recPref, ppNt]
+ fields = ppCommas (map (\(a,t) -> ppName [pp a, recName ] >|< " ::" >|< ppShow t) (groupAtts atts noGroup))
+ in
+ "data " >|< recName >|< " = " >|< recName >|< " { " >|< fields >|< " }"
+
+groupAtts atts noGroup = (Map.toAscList . Map.difference atts) noGroup
+
+-- it defines selectors with the form:
+-- l1_nt_prod(x, _, .., _) = x
+-- ln_nt_prod(_, .., _, x) = x
+defLocalAtts prodName total actual (l:ls) = ppName [pp l, prodName] >|<
+ ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|<
+ pp " = x" >-<
+ defLocalAtts prodName total (actual+1) ls
+defLocalAtts _ _ _ [] = empty
+
+{-# LINE 103 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 397 "src-ag/AG2AspectAG.ag" #-}
+
+ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"])
+
+filterNts att = filter ( Map.member (identifier att) . snd )
+{-# LINE 110 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 455 "src-ag/AG2AspectAG.ag" #-}
+
+data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc)
+
+ppRule (field,attr) owrt def = PPRule field attr owrt def
+ruleField (PPRule field _ _ _ ) = field
+ruleAttr (PPRule _ attr _ _ ) = attr
+ruleOwrt (PPRule _ _ owrt _ ) = owrt
+ruleDef (PPRule _ _ _ def) = def
+
+{-# LINE 122 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 494 "src-ag/AG2AspectAG.ag" #-}
+
+
+defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals =
+ let ppAtt = ppName [pp "inh", prodName]
+ ppR = ppAtt >|< pp " = inhdefM att_inh nts_group $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 (foldr (>-<) (pp "emptyRecord") (map (chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals) chids))
+ in if (newNT || (not newNT && newProd))
+ then (ppR, [ ppAtt ])
+ else (empty, [])
+
+chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals (idCh,tp) =
+ let chName = ppName [pp "ch", pp idCh, prodName]
+ ppTp = ppShow tp
+ chRules = ppCommas $ mapGRuleDefs (== idCh) rules inhNoGroup synNoGroup chids locals
+ in if (isNonterminal tp)
+ then chName >|< ".=." >-<
+ indent 1 "InhG_" >|< ppShow tp >|< pp " {" >-<
+ indent 2 chRules >-<
+ indent 1 "} .*. "
+ else empty
+
+
+defSynGRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
+ let ppAtt = ppName [pp "syn", ppNt, pp prod]
+ ppTAtt = "SynG_" >|< ppNt
+ ppR = ppAtt >|< pp " = syndefM att_syn $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 ppTAtt >|< pp " {" >-<
+ indent 7 (ppCommas $ mapGRuleDefs ((== "lhs") . show) rules inhNoGroup synNoGroup chids locals) >-<
+ indent 6 "}"
+ in if (newNT || (not newNT && newProd))
+ then (ppR, [ ppAtt ])
+ else (empty, [])
+
+defLocRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
+ let ppAtt = ppName [pp "loc", ppNt, pp prod]
+ ppTAtt = ppName [pp "Loc", ppNt, pp prod]
+ ppR = ppAtt >|< pp " = locdefM att_loc $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 (ppListSep "(" ")" "," $ mapLRuleDefs rules inhNoGroup synNoGroup chids locals)
+ in (ppR, [ ppAtt ])
+
+defInstRules ppNt prod newNT newProd ch rules chids locals
+ = let ppAsp = ppName [pp "inst", ppNt, pp prod]
+ instRules = filter ((=="inst") . show . ruleField) rules
+ ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod]
+ in ( ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . ruleAttr) instRules) >-<
+ (vlist $ map (defInstRule ppNt prod ch chids locals) instRules)
+ , [ ppAsp ])
+
+
+defInstRule ppNt prod ch chids locals rule =
+ let ppAtt = ppName [pp "ch", pp (ruleAttr rule), ppNt, pp prod]
+ in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 ((ruleDef rule) chids locals)
+
+
+defSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
+ = let synRules = filter ( (=="lhs") . show . ruleField) rules
+ ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
+ (ppR, ppRA) = unzip $ map (defSynRule True ppNt prod newNT newProd newAtts ch chids locals) ngRules
+ in (vlist ppR, concat ppRA )
+
+modSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
+ = let synRules = filter ( (=="lhs") . show . ruleField) rules
+ ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
+ (ppR, ppRA) = unzip $ map (defSynRule False ppNt prod newNT newProd newAtts ch chids locals) ngRules
+ in (vlist ppR, concat ppRA )
+
+defSynRule new ppNt prod newNT newProd newAtts ch chids locals rule =
+ let att = ruleAttr rule
+ newAtt = Map.member att newAtts
+ owrt = ruleOwrt rule
+ ppAtt = ppName [pp att, pp (if new then "syn" else "synM"), ppNt, pp prod]
+ ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName (show att) >|< pp " $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 ((ruleDef rule) chids locals)
+ in
+ if new
+ then if (not owrt && (newNT || (not newNT && newProd) || newAtt))
+ then (ppR "syndefM", [ ppAtt ])
+ else (empty, [])
+ else if owrt
+ then (ppR "synmodM", [ ppAtt ])
+ else (empty, [])
+
+
+
+defInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
+ = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
+ (ppR, ppRA) = unzip $ map (defInhRule True ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
+ in (vlist ppR, concat ppRA)
+
+modInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
+ = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
+ (ppR, ppRA) = unzip $ map (defInhRule False ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
+ in (vlist ppR, concat ppRA)
+
+
+defInhRule new ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals att =
+ let ppAtt = ppName [pp att, pp (if new then "inh" else "inhM"),prodName]
+ newAtt = Map.member (identifier att) newAtts
+ chRMaybe = map (chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals) chids
+ chR = [ x | (Just x) <- chRMaybe ]
+ ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName att >|< " nts_" >|< att >|< " $" >-<
+ indent 4 "do " >-<
+ indent 5 "loc <- at loc" >-<
+ indent 5 "lhs <- at lhs" >-<
+ indent 5 ch >-<
+ indent 5 "return $" >-<
+ indent 6 (foldr (>-<) (pp "emptyRecord") chR)
+ in
+ if new
+ then if (newNT || (not newNT && newProd) || newAtt)
+ then (ppR "inhdefM", [ ppAtt ])
+ else (empty, [])
+ else if (not . null) chR
+ then (ppR "inhmodM", [ ppAtt ])
+ else (empty, [])
+
+
+chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals (idCh,tp) =
+ let chName = ppName [pp "ch", pp idCh, prodName]
+ ppTp = ppShow tp
+ chRule = inhRuleDef new (== idCh) (== att) rules inhNoGroup synNoGroup chids locals -- it's supposed to be only one
+ in if (isNonterminal tp && (not . null) chRule)
+ then Just $ chName >|< ".=. (" >|< chRule >|< ") .*. "
+ else Nothing
+
+
+mapLRuleDefs rules inhNoGroup synNoGroup chids locals
+ = map appSnd $ sortBy cmpField $ filter ((== "loc") . show . ruleField) rules
+ where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
+ appSnd rule = (ruleDef rule) chids locals
+
+
+mapGRuleDefs filt rules inhNoGroup synNoGroup chids locals
+ = map appSnd $ sortBy cmpField $ filter (not . (flip elem inhNoGroup) . getName . ruleAttr)
+ $ filter (not . (flip elem synNoGroup) . getName . ruleAttr)
+ $ filter ( filt . ruleField) rules
+ where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
+ appSnd rule = (ruleDef rule) chids locals
+
+inhRuleDef new filt1 filt2 rules inhNoGroup synNoGroup chids locals
+ = map appSnd $ sortBy cmpField $ filter ( (== not new) . ruleOwrt)
+ $ filter ((flip elem inhNoGroup) . getName . ruleAttr)
+ $ filter ( filt2 . getName . ruleAttr)
+ $ filter ( filt1 . ruleField) rules
+ where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
+ appSnd rule = (ruleDef rule) chids locals
+
+defRule ppNt (field,att) noGroup rhs = \chids locals ->
+ let ppAtt = if (elem (getName att) noGroup)
+ then empty
+ else case (show field) of
+ "lhs" -> att >|< "_" >|< pp "SynG" >|< pp "_" >|< ppNt >|< " = "
+ "loc" -> empty
+ "inst" -> empty
+ otherwise -> att >|< "_" >|< pp "InhG" >|< pp "_" >|<
+ (maybe (error $ "lhs field " ++ show field ++" is not a child")
+ ppShow (lookup field chids))
+ >|< " = "
+ in ppAtt >|< (rhs noGroup field chids locals)
+
+
+rhsRule ppNt ppProd tks noGroup field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals noGroup )) $ tks
+
+
+lines2PP [] = []
+lines2PP xs = map line2PP . shiftLeft . getLines $ xs
+
+
+token2PP ppNt ppProd field chids locals noGroup tk
+ = case tk of
+ AGLocal var pos _ -> (pos, if (elem var locals)
+ then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) "
+ else pp var)
+ AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids)
+ ppAtt = case (show field) of
+ "lhs" -> attName "inh"
+ "loc" -> attName "loc"
+ otherwise -> attName "syn"
+ ppSubAtt = case (show field) of
+ "lhs" -> ppName [pp (getName attr), pp "InhG", ppNt]
+ "loc" -> ppName [pp (getName attr), ppNt, ppProd]
+ otherwise -> ppName [pp (getName attr), pp "SynG", ppChT]
+ in (pos, if ((elem (getName attr) noGroup) && ((show field) /= "loc"))
+ then pp "(" >|< pp (getName field) >|< " # " >|< attName (getName attr) >|< pp ")"
+ else pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ")
+ HsToken value pos -> (pos, pp value)
+ CharToken value pos -> (pos, pp (show value))
+ StrToken value pos -> (pos, pp (show value))
+ Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ")
+
+line2PP ts = let f (p,t) r = let ct = column p
+ in \c -> pp (spaces (ct-c)) >|< t >|< r (length (show t) +ct)
+ spaces x | x < 0 = ""
+ | otherwise = replicate x ' '
+ in foldr f (pp . const "") ts 1
+
+{-# LINE 347 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 721 "src-ag/AG2AspectAG.ag" #-}
+
+ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")"
+ where ppChildren = map ppChild children
+ ppChild (RuleChild ch n) = chName ch >|< " ==> " >|< ppMacro n
+ ppChild (ChildChild ch n) = chName ch >|< " --> " >|< n
+ ppChild (ValueChild ch n) = chName ch >|< " ~~> " >|< n
+ chName ch = ppName [pp "ch", pp ch, pp con]
+{-# LINE 357 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 754 "src-ag/AG2AspectAG.ag" #-}
+
+ppNoGroupAtts syn noGroup = let synatts = Map.keys $ Map.filterWithKey (\att _ -> elem (getName att) noGroup) syn
+ in map (flip (>|<) "_inh") noGroup ++ map (flip (>|<) "_syn") synatts
+
+ruleName att prodName = ppName [att,prodName]
+
+elemNT a b = False
+{-# LINE 367 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 797 "src-ag/AG2AspectAG.ag" #-}
+
+attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts
+{-# LINE 372 "dist/build/AG2AspectAG.hs" #-}
+
+{-# LINE 851 "src-ag/AG2AspectAG.ag" #-}
+
+attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts
+attFields atts noGroup ppNt =
+ let ng = map (\(a,_) -> attName (getName a) >|< " .=. _" >|< a >|< " .*. ") $ Map.toAscList noGroup
+ g = ppCommas $ map (\(a,_) -> ppName [pp a, pp "InhG",ppNt] >|< "= _" >|< a) $ Map.toAscList $ Map.difference atts noGroup
+ in "(" >|< ng >|< "att_inh .=. " >|< ppName [pp "InhG", ppNt] >|< " { " >|< g >|< " } .*. emptyRecord)"
+{-# LINE 381 "dist/build/AG2AspectAG.hs" #-}
+-- Child -------------------------------------------------------
+-- wrapper
+data Inh_Child = Inh_Child { ext_Inh_Child :: (Maybe String), inhMap_Inh_Child :: (Map Identifier Attributes), inhNoGroup_Inh_Child :: ([String]), newAtts_Inh_Child :: ( Attributes ), o_noGroup_Inh_Child :: ([String]), o_rename_Inh_Child :: (Bool), ppNt_Inh_Child :: (PP_Doc), ppProd_Inh_Child :: (PP_Doc), synMap_Inh_Child :: (Map Identifier Attributes), synNoGroup_Inh_Child :: ([String]) }
+data Syn_Child = Syn_Child { idCL_Syn_Child :: ([(Identifier,Type)]), ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Child :: ([PP_Doc]), ppL_Syn_Child :: (PP_Doc), ppLI_Syn_Child :: ([PP_Doc]), ppR_Syn_Child :: (PP_Doc), prdInh_Syn_Child :: (Attributes) }
+{-# INLINABLE wrap_Child #-}
+wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
+wrap_Child (T_Child act) (Inh_Child _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg1 = T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
+ (T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Child_s2 sem arg1)
+ return (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
+ )
+
+-- cata
+{-# INLINE sem_Child #-}
+sem_Child :: Child -> T_Child
+sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
+
+-- semantic domain
+newtype T_Child = T_Child {
+ attach_T_Child :: Identity (T_Child_s2 )
+ }
+newtype T_Child_s2 = C_Child_s2 {
+ inv_Child_s2 :: (T_Child_v1 )
+ }
+data T_Child_s3 = C_Child_s3
+type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
+data T_Child_vIn1 = T_Child_vIn1 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
+data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
+{-# NOINLINE sem_Child_Child #-}
+sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
+sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where
+ {-# NOINLINE st2 #-}
+ st2 = let
+ v1 :: T_Child_v1
+ v1 = \ (T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _chnt = rule0 arg_name_ arg_tp_
+ _inh = rule1 _chnt _lhsIinhMap
+ _syn = rule2 _chnt _lhsIsynMap
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule3 _inh
+ _ppCh = rule4 arg_name_
+ _ppTCh = rule5 arg_tp_
+ _chName = rule6 _lhsIppNt _lhsIppProd _ppCh
+ _lhsOppDL :: [PP_Doc]
+ _lhsOppDL = rule7 _chName _ppTCh arg_kind_
+ _chLabel = rule8 _chName
+ _chTLabel = rule9 _chName
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule10 _chLabel _chTLabel _ppTCh arg_kind_
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule11 _chLabel _chTLabel
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule12 _lhsIppNt _lhsIppProd arg_name_
+ _lhsOidCL :: [(Identifier,Type)]
+ _lhsOidCL = rule13 arg_name_ arg_tp_
+ _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
+ _lhsOppCSF = rule14 _chLabel arg_kind_ arg_name_ arg_tp_
+ __result_ = T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
+ in __result_ )
+ in C_Child_s2 v1
+ {-# INLINE rule0 #-}
+ {-# LINE 19 "src-ag/DistChildAttr.ag" #-}
+ rule0 = \ name_ tp_ ->
+ {-# LINE 19 "src-ag/DistChildAttr.ag" #-}
+ case tp_ of
+ NT nt _ _ -> nt
+ Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
+ Haskell t -> identifier ""
+ {-# LINE 452 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule1 #-}
+ {-# LINE 23 "src-ag/DistChildAttr.ag" #-}
+ rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ {-# LINE 23 "src-ag/DistChildAttr.ag" #-}
+ Map.findWithDefault Map.empty _chnt _lhsIinhMap
+ {-# LINE 458 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule2 #-}
+ {-# LINE 24 "src-ag/DistChildAttr.ag" #-}
+ rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ {-# LINE 24 "src-ag/DistChildAttr.ag" #-}
+ Map.findWithDefault Map.empty _chnt _lhsIsynMap
+ {-# LINE 464 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule3 #-}
+ {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}
+ rule3 = \ _inh ->
+ {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}
+ _inh
+ {-# LINE 470 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule4 #-}
+ {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}
+ rule4 = \ name_ ->
+ {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}
+ pp name_
+ {-# LINE 476 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule5 #-}
+ {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}
+ rule5 = \ tp_ ->
+ {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}
+ ppShow tp_
+ {-# LINE 482 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule6 #-}
+ {-# LINE 184 "src-ag/AG2AspectAG.ag" #-}
+ rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh ->
+ {-# LINE 184 "src-ag/AG2AspectAG.ag" #-}
+ ppName [_ppCh , _lhsIppNt, _lhsIppProd]
+ {-# LINE 488 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule7 #-}
+ {-# LINE 242 "src-ag/AG2AspectAG.ag" #-}
+ rule7 = \ _chName _ppTCh kind_ ->
+ {-# LINE 242 "src-ag/AG2AspectAG.ag" #-}
+ case kind_ of
+ ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ]
+ _ -> []
+ {-# LINE 496 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule8 #-}
+ {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}
+ rule8 = \ _chName ->
+ {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}
+ "ch_" >|< _chName
+ {-# LINE 502 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule9 #-}
+ {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}
+ rule9 = \ _chName ->
+ {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}
+ "Ch_" >|< _chName
+ {-# LINE 508 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule10 #-}
+ {-# LINE 287 "src-ag/AG2AspectAG.ag" #-}
+ rule10 = \ _chLabel _chTLabel _ppTCh kind_ ->
+ {-# LINE 287 "src-ag/AG2AspectAG.ag" #-}
+ "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|<
+ case kind_ of
+ ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")"
+ _ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|<
+ "(" >|< _chTLabel >|< ", nt)"
+ {-# LINE 518 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule11 #-}
+ {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}
+ rule11 = \ _chLabel _chTLabel ->
+ {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}
+ [ _chLabel , _chTLabel ]
+ {-# LINE 524 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule12 #-}
+ {-# LINE 451 "src-ag/AG2AspectAG.ag" #-}
+ rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ ->
+ {-# LINE 451 "src-ag/AG2AspectAG.ag" #-}
+ let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
+ in pp name_ >|< " <- at ch_" >|< chName
+ {-# LINE 531 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule13 #-}
+ {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}
+ rule13 = \ name_ tp_ ->
+ {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}
+ [ (name_, removeDeforested tp_ ) ]
+ {-# LINE 537 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule14 #-}
+ {-# LINE 827 "src-ag/AG2AspectAG.ag" #-}
+ rule14 = \ _chLabel kind_ name_ tp_ ->
+ {-# LINE 827 "src-ag/AG2AspectAG.ag" #-}
+ let
+ semC = if (isNonterminal tp_)
+ then "sem_" >|< ppShow tp_ >|< " _" >|< name_
+ else "sem_Lit _" >|< name_
+ in case kind_ of
+ ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. "
+ , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))]
+ _ -> []
+ {-# LINE 550 "dist/build/AG2AspectAG.hs"#-}
+
+-- Children ----------------------------------------------------
+-- wrapper
+data Inh_Children = Inh_Children { ext_Inh_Children :: (Maybe String), inhMap_Inh_Children :: (Map Identifier Attributes), inhNoGroup_Inh_Children :: ([String]), newAtts_Inh_Children :: ( Attributes ), o_noGroup_Inh_Children :: ([String]), o_rename_Inh_Children :: (Bool), ppNt_Inh_Children :: (PP_Doc), ppProd_Inh_Children :: (PP_Doc), synMap_Inh_Children :: (Map Identifier Attributes), synNoGroup_Inh_Children :: ([String]) }
+data Syn_Children = Syn_Children { idCL_Syn_Children :: ([(Identifier,Type)]), ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Children :: ([PP_Doc]), ppL_Syn_Children :: (PP_Doc), ppLI_Syn_Children :: ([PP_Doc]), ppR_Syn_Children :: (PP_Doc), prdInh_Syn_Children :: (Attributes) }
+{-# INLINABLE wrap_Children #-}
+wrap_Children :: T_Children -> Inh_Children -> (Syn_Children )
+wrap_Children (T_Children act) (Inh_Children _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg4 = T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
+ (T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Children_s5 sem arg4)
+ return (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
+ )
+
+-- cata
+{-# NOINLINE sem_Children #-}
+sem_Children :: Children -> T_Children
+sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
+
+-- semantic domain
+newtype T_Children = T_Children {
+ attach_T_Children :: Identity (T_Children_s5 )
+ }
+newtype T_Children_s5 = C_Children_s5 {
+ inv_Children_s5 :: (T_Children_v4 )
+ }
+data T_Children_s6 = C_Children_s6
+type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
+data T_Children_vIn4 = T_Children_vIn4 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
+data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
+{-# NOINLINE sem_Children_Cons #-}
+sem_Children_Cons :: T_Child -> T_Children -> T_Children
+sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
+ {-# NOINLINE st5 #-}
+ st5 = let
+ v4 :: T_Children_v4
+ v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
+ _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
+ (T_Child_vOut1 _hdIidCL _hdIppCSF _hdIppDL _hdIppL _hdIppLI _hdIppR _hdIprdInh) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOext _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOo_noGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynMap _hdOsynNoGroup)
+ (T_Children_vOut4 _tlIidCL _tlIppCSF _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIprdInh) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOext _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOo_noGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynMap _tlOsynNoGroup)
+ _lhsOppDL :: [PP_Doc]
+ _lhsOppDL = rule15 _hdIppDL _tlIppDL
+ _lhsOidCL :: [(Identifier,Type)]
+ _lhsOidCL = rule16 _hdIidCL _tlIidCL
+ _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
+ _lhsOppCSF = rule17 _hdIppCSF _tlIppCSF
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule18 _hdIppL _tlIppL
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule19 _hdIppLI _tlIppLI
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule20 _hdIppR _tlIppR
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule21 _hdIprdInh _tlIprdInh
+ _hdOext = rule22 _lhsIext
+ _hdOinhMap = rule23 _lhsIinhMap
+ _hdOinhNoGroup = rule24 _lhsIinhNoGroup
+ _hdOnewAtts = rule25 _lhsInewAtts
+ _hdOo_noGroup = rule26 _lhsIo_noGroup
+ _hdOo_rename = rule27 _lhsIo_rename
+ _hdOppNt = rule28 _lhsIppNt
+ _hdOppProd = rule29 _lhsIppProd
+ _hdOsynMap = rule30 _lhsIsynMap
+ _hdOsynNoGroup = rule31 _lhsIsynNoGroup
+ _tlOext = rule32 _lhsIext
+ _tlOinhMap = rule33 _lhsIinhMap
+ _tlOinhNoGroup = rule34 _lhsIinhNoGroup
+ _tlOnewAtts = rule35 _lhsInewAtts
+ _tlOo_noGroup = rule36 _lhsIo_noGroup
+ _tlOo_rename = rule37 _lhsIo_rename
+ _tlOppNt = rule38 _lhsIppNt
+ _tlOppProd = rule39 _lhsIppProd
+ _tlOsynMap = rule40 _lhsIsynMap
+ _tlOsynNoGroup = rule41 _lhsIsynNoGroup
+ __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
+ in __result_ )
+ in C_Children_s5 v4
+ {-# INLINE rule15 #-}
+ {-# LINE 238 "src-ag/AG2AspectAG.ag" #-}
+ rule15 = \ ((_hdIppDL) :: [PP_Doc]) ((_tlIppDL) :: [PP_Doc]) ->
+ {-# LINE 238 "src-ag/AG2AspectAG.ag" #-}
+ _hdIppDL ++ _tlIppDL
+ {-# LINE 635 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule16 #-}
+ rule16 = \ ((_hdIidCL) :: [(Identifier,Type)]) ((_tlIidCL) :: [(Identifier,Type)]) ->
+ _hdIidCL ++ _tlIidCL
+ {-# INLINE rule17 #-}
+ rule17 = \ ((_hdIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_tlIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ->
+ _hdIppCSF ++ _tlIppCSF
+ {-# INLINE rule18 #-}
+ rule18 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
+ _hdIppL >-< _tlIppL
+ {-# INLINE rule19 #-}
+ rule19 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
+ _hdIppLI ++ _tlIppLI
+ {-# INLINE rule20 #-}
+ rule20 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
+ _hdIppR >-< _tlIppR
+ {-# INLINE rule21 #-}
+ rule21 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
+ _hdIprdInh `Map.union` _tlIprdInh
+ {-# INLINE rule22 #-}
+ rule22 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule23 #-}
+ rule23 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule24 #-}
+ rule24 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule25 #-}
+ rule25 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule26 #-}
+ rule26 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule27 #-}
+ rule27 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule28 #-}
+ rule28 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule29 #-}
+ rule29 = \ ((_lhsIppProd) :: PP_Doc) ->
+ _lhsIppProd
+ {-# INLINE rule30 #-}
+ rule30 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule31 #-}
+ rule31 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+ {-# INLINE rule32 #-}
+ rule32 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule33 #-}
+ rule33 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule34 #-}
+ rule34 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule35 #-}
+ rule35 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule36 #-}
+ rule36 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule37 #-}
+ rule37 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule38 #-}
+ rule38 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule39 #-}
+ rule39 = \ ((_lhsIppProd) :: PP_Doc) ->
+ _lhsIppProd
+ {-# INLINE rule40 #-}
+ rule40 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule41 #-}
+ rule41 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+{-# NOINLINE sem_Children_Nil #-}
+sem_Children_Nil :: T_Children
+sem_Children_Nil = T_Children (return st5) where
+ {-# NOINLINE st5 #-}
+ st5 = let
+ v4 :: T_Children_v4
+ v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _lhsOppDL :: [PP_Doc]
+ _lhsOppDL = rule42 ()
+ _lhsOidCL :: [(Identifier,Type)]
+ _lhsOidCL = rule43 ()
+ _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
+ _lhsOppCSF = rule44 ()
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule45 ()
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule46 ()
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule47 ()
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule48 ()
+ __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
+ in __result_ )
+ in C_Children_s5 v4
+ {-# INLINE rule42 #-}
+ {-# LINE 239 "src-ag/AG2AspectAG.ag" #-}
+ rule42 = \ (_ :: ()) ->
+ {-# LINE 239 "src-ag/AG2AspectAG.ag" #-}
+ []
+ {-# LINE 743 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule43 #-}
+ rule43 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule44 #-}
+ rule44 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule45 #-}
+ rule45 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule46 #-}
+ rule46 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule47 #-}
+ rule47 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule48 #-}
+ rule48 = \ (_ :: ()) ->
+ Map.empty
+
+-- Expression --------------------------------------------------
+-- wrapper
+data Inh_Expression = Inh_Expression { ppNt_Inh_Expression :: (PP_Doc), ppProd_Inh_Expression :: (PP_Doc) }
+data Syn_Expression = Syn_Expression { ppRE_Syn_Expression :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) }
+{-# INLINABLE wrap_Expression #-}
+wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression )
+wrap_Expression (T_Expression act) (Inh_Expression _lhsIppNt _lhsIppProd) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg7 = T_Expression_vIn7 _lhsIppNt _lhsIppProd
+ (T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg7)
+ return (Syn_Expression _lhsOppRE)
+ )
+
+-- cata
+{-# INLINE sem_Expression #-}
+sem_Expression :: Expression -> T_Expression
+sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
+
+-- semantic domain
+newtype T_Expression = T_Expression {
+ attach_T_Expression :: Identity (T_Expression_s8 )
+ }
+newtype T_Expression_s8 = C_Expression_s8 {
+ inv_Expression_s8 :: (T_Expression_v7 )
+ }
+data T_Expression_s9 = C_Expression_s9
+type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
+data T_Expression_vIn7 = T_Expression_vIn7 (PP_Doc) (PP_Doc)
+data T_Expression_vOut7 = T_Expression_vOut7 ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)
+{-# NOINLINE sem_Expression_Expression #-}
+sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
+sem_Expression_Expression _ arg_tks_ = T_Expression (return st8) where
+ {-# NOINLINE st8 #-}
+ st8 = let
+ v7 :: T_Expression_v7
+ v7 = \ (T_Expression_vIn7 _lhsIppNt _lhsIppProd) -> ( let
+ _lhsOppRE :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc
+ _lhsOppRE = rule49 _lhsIppNt _lhsIppProd arg_tks_
+ __result_ = T_Expression_vOut7 _lhsOppRE
+ in __result_ )
+ in C_Expression_s8 v7
+ {-# INLINE rule49 #-}
+ {-# LINE 484 "src-ag/AG2AspectAG.ag" #-}
+ rule49 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) tks_ ->
+ {-# LINE 484 "src-ag/AG2AspectAG.ag" #-}
+ rhsRule _lhsIppNt _lhsIppProd tks_
+ {-# LINE 810 "dist/build/AG2AspectAG.hs"#-}
+
+-- Grammar -----------------------------------------------------
+-- wrapper
+data Inh_Grammar = Inh_Grammar { agi_Inh_Grammar :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))), ext_Inh_Grammar :: (Maybe String), options_Inh_Grammar :: (Options) }
+data Syn_Grammar = Syn_Grammar { imp_Syn_Grammar :: (PP_Doc), pp_Syn_Grammar :: (PP_Doc) }
+{-# INLINABLE wrap_Grammar #-}
+wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar )
+wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg10 = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions
+ (T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg10)
+ return (Syn_Grammar _lhsOimp _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Grammar #-}
+sem_Grammar :: Grammar -> T_Grammar
+sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
+
+-- semantic domain
+newtype T_Grammar = T_Grammar {
+ attach_T_Grammar :: Identity (T_Grammar_s11 )
+ }
+newtype T_Grammar_s11 = C_Grammar_s11 {
+ inv_Grammar_s11 :: (T_Grammar_v10 )
+ }
+data T_Grammar_s12 = C_Grammar_s12
+type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
+data T_Grammar_vIn10 = T_Grammar_vIn10 ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) (Maybe String) (Options)
+data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) (PP_Doc)
+{-# NOINLINE sem_Grammar_Grammar #-}
+sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar
+sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
+ {-# NOINLINE st11 #-}
+ st11 = let
+ v10 :: T_Grammar_v10
+ v10 = \ (T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions) -> ( let
+ _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
+ (T_Nonterminals_vOut25 _nontsIextendedNTs _nontsIinhMap' _nontsIppA _nontsIppAI _nontsIppCata _nontsIppD _nontsIppDI _nontsIppL _nontsIppLI _nontsIppNtL _nontsIppR _nontsIppSF _nontsIppW _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns)
+ _nontsOinhMap = rule50 _nontsIinhMap'
+ _nontsOsynMap = rule51 _nontsIsynMap'
+ _nontsOo_rename = rule52 _lhsIoptions
+ _o_noGroup = rule53 _lhsIoptions
+ _nontsOo_noGroup = rule54 _o_noGroup
+ _newAtts = rule55 _lhsIagi
+ _nontsOnewAtts = rule56 _newAtts
+ _newProds = rule57 _lhsIagi
+ _nontsOnewProds = rule58 _newProds
+ _nontsOnewNTs = rule59 _lhsIagi _nontsIextendedNTs
+ _lhsOimp :: PP_Doc
+ _lhsOimp = rule60 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule61 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR
+ _nontsOderivs = rule62 arg_derivings_
+ _nontsOtSyns = rule63 arg_typeSyns_
+ _ppA = rule64 _lhsIext _newAtts _nontsIppA _o_noGroup
+ _ppAI = rule65 _lhsIext _newAtts _nontsIppAI _o_noGroup
+ _ppANT = rule66 _newAtts _o_noGroup
+ _ppNtL = rule67 _nontsIppNtL
+ _ppR = rule68 _newAtts _nontsIppR _o_noGroup _ppNtL
+ _nontsOext = rule69 _lhsIext
+ __result_ = T_Grammar_vOut10 _lhsOimp _lhsOpp
+ in __result_ )
+ in C_Grammar_s11 v10
+ {-# INLINE rule50 #-}
+ {-# LINE 15 "src-ag/DistChildAttr.ag" #-}
+ rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) ->
+ {-# LINE 15 "src-ag/DistChildAttr.ag" #-}
+ _nontsIinhMap'
+ {-# LINE 881 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule51 #-}
+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}
+ rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->
+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}
+ _nontsIsynMap'
+ {-# LINE 887 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule52 #-}
+ {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}
+ rule52 = \ ((_lhsIoptions) :: Options) ->
+ {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}
+ rename _lhsIoptions
+ {-# LINE 893 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule53 #-}
+ {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}
+ rule53 = \ ((_lhsIoptions) :: Options) ->
+ {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}
+ sort $ noGroup _lhsIoptions
+ {-# LINE 899 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule54 #-}
+ {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}
+ rule54 = \ _o_noGroup ->
+ {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}
+ _o_noGroup
+ {-# LINE 905 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule55 #-}
+ {-# LINE 80 "src-ag/AG2AspectAG.ag" #-}
+ rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
+ {-# LINE 80 "src-ag/AG2AspectAG.ag" #-}
+ case _lhsIagi of
+ (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts
+ {-# LINE 912 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule56 #-}
+ {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}
+ rule56 = \ _newAtts ->
+ {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}
+ _newAtts
+ {-# LINE 918 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule57 #-}
+ {-# LINE 88 "src-ag/AG2AspectAG.ag" #-}
+ rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
+ {-# LINE 88 "src-ag/AG2AspectAG.ag" #-}
+ case _lhsIagi of
+ (_,prods,_) -> prods
+ {-# LINE 925 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule58 #-}
+ {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}
+ rule58 = \ _newProds ->
+ {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}
+ _newProds
+ {-# LINE 931 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule59 #-}
+ {-# LINE 112 "src-ag/AG2AspectAG.ag" #-}
+ rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) ->
+ {-# LINE 112 "src-ag/AG2AspectAG.ag" #-}
+ case _lhsIagi of
+ (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs
+ {-# LINE 938 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule60 #-}
+ {-# LINE 127 "src-ag/AG2AspectAG.ag" #-}
+ rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT ->
+ {-# LINE 127 "src-ag/AG2AspectAG.ag" #-}
+ "import Language.Grammars.AspectAG" >-<
+ "import Language.Grammars.AspectAG.Derive" >-<
+ "import Data.HList.Label4" >-<
+ "import Data.HList.TypeEqGeneric1" >-<
+ "import Data.HList.TypeCastGeneric1" >-<
+ maybe empty ("import qualified" >#<) _lhsIext >-<
+ maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext
+ {-# LINE 950 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule61 #-}
+ {-# LINE 140 "src-ag/AG2AspectAG.ag" #-}
+ rule61 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR ->
+ {-# LINE 140 "src-ag/AG2AspectAG.ag" #-}
+ (if dataTypes _lhsIoptions
+ then "-- datatypes" >-< _nontsIppD >-<
+ "-- labels" >-< _nontsIppL
+ else empty)
+ >-<
+ (if folds _lhsIoptions
+ then "-- attributes" >-< _ppA >-<
+ "-- rules" >-< _ppR >-<
+ "-- catas" >-< _nontsIppCata
+ else empty)
+ >-<
+ (if semfuns _lhsIoptions
+ then "-- semantic functions" >-< _nontsIppSF
+ else empty)
+ >-<
+ (if wrappers _lhsIoptions
+ then "-- wrappers" >-< _nontsIppW
+ else empty)
+ {-# LINE 973 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule62 #-}
+ {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}
+ rule62 = \ derivings_ ->
+ {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}
+ derivings_
+ {-# LINE 979 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule63 #-}
+ {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}
+ rule63 = \ typeSyns_ ->
+ {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}
+ typeSyns_
+ {-# LINE 985 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule64 #-}
+ {-# LINE 300 "src-ag/AG2AspectAG.ag" #-}
+ rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup ->
+ {-# LINE 300 "src-ag/AG2AspectAG.ag" #-}
+ vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-<
+ defAtt "loc" >-<
+ (case _lhsIext of
+ Nothing -> defAtt "inh" >-< defAtt "syn"
+ otherwise -> empty) >-<
+ _nontsIppA
+ {-# LINE 996 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule65 #-}
+ {-# LINE 308 "src-ag/AG2AspectAG.ag" #-}
+ rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup ->
+ {-# LINE 308 "src-ag/AG2AspectAG.ag" #-}
+ let atts = filterNotAtts _newAtts _o_noGroup
+ in (foldr (\a as -> attName a : as) [] atts) ++
+ (foldr (\a as -> attTName a : as) [] atts) ++
+ (case _lhsIext of
+ Nothing -> []
+ otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++
+ _nontsIppAI
+ {-# LINE 1008 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule66 #-}
+ {-# LINE 318 "src-ag/AG2AspectAG.ag" #-}
+ rule66 = \ _newAtts _o_noGroup ->
+ {-# LINE 318 "src-ag/AG2AspectAG.ag" #-}
+ let atts = filterNotAtts _newAtts _o_noGroup
+ in (foldr (\a as -> ("nts_" >|< a) : as) [] atts)
+ {-# LINE 1015 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule67 #-}
+ {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}
+ rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) ->
+ {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}
+ _nontsIppNtL
+ {-# LINE 1021 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule68 #-}
+ {-# LINE 393 "src-ag/AG2AspectAG.ag" #-}
+ rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL ->
+ {-# LINE 393 "src-ag/AG2AspectAG.ag" #-}
+ ntsList "group" _ppNtL >-<
+ vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-<
+ _nontsIppR
+ {-# LINE 1029 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule69 #-}
+ rule69 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+
+-- HsToken -----------------------------------------------------
+-- wrapper
+data Inh_HsToken = Inh_HsToken { }
+data Syn_HsToken = Syn_HsToken { }
+{-# INLINABLE wrap_HsToken #-}
+wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken )
+wrap_HsToken (T_HsToken act) (Inh_HsToken ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg13 = T_HsToken_vIn13
+ (T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg13)
+ return (Syn_HsToken )
+ )
+
+-- cata
+{-# NOINLINE sem_HsToken #-}
+sem_HsToken :: HsToken -> T_HsToken
+sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_
+sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_
+sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_
+sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_
+sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_
+sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_
+
+-- semantic domain
+newtype T_HsToken = T_HsToken {
+ attach_T_HsToken :: Identity (T_HsToken_s14 )
+ }
+newtype T_HsToken_s14 = C_HsToken_s14 {
+ inv_HsToken_s14 :: (T_HsToken_v13 )
+ }
+data T_HsToken_s15 = C_HsToken_s15
+type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 )
+data T_HsToken_vIn13 = T_HsToken_vIn13
+data T_HsToken_vOut13 = T_HsToken_vOut13
+{-# NOINLINE sem_HsToken_AGLocal #-}
+sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
+sem_HsToken_AGLocal _ _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+{-# NOINLINE sem_HsToken_AGField #-}
+sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
+sem_HsToken_AGField _ _ _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+{-# NOINLINE sem_HsToken_HsToken #-}
+sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken
+sem_HsToken_HsToken _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+{-# NOINLINE sem_HsToken_CharToken #-}
+sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken
+sem_HsToken_CharToken _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+{-# NOINLINE sem_HsToken_StrToken #-}
+sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken
+sem_HsToken_StrToken _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+{-# NOINLINE sem_HsToken_Err #-}
+sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken
+sem_HsToken_Err _ _ = T_HsToken (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_HsToken_v13
+ v13 = \ (T_HsToken_vIn13 ) -> ( let
+ __result_ = T_HsToken_vOut13
+ in __result_ )
+ in C_HsToken_s14 v13
+
+-- HsTokens ----------------------------------------------------
+-- wrapper
+data Inh_HsTokens = Inh_HsTokens { }
+data Syn_HsTokens = Syn_HsTokens { }
+{-# INLINABLE wrap_HsTokens #-}
+wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens )
+wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg16 = T_HsTokens_vIn16
+ (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16)
+ return (Syn_HsTokens )
+ )
+
+-- cata
+{-# NOINLINE sem_HsTokens #-}
+sem_HsTokens :: HsTokens -> T_HsTokens
+sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)
+
+-- semantic domain
+newtype T_HsTokens = T_HsTokens {
+ attach_T_HsTokens :: Identity (T_HsTokens_s17 )
+ }
+newtype T_HsTokens_s17 = C_HsTokens_s17 {
+ inv_HsTokens_s17 :: (T_HsTokens_v16 )
+ }
+data T_HsTokens_s18 = C_HsTokens_s18
+type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 )
+data T_HsTokens_vIn16 = T_HsTokens_vIn16
+data T_HsTokens_vOut16 = T_HsTokens_vOut16
+{-# NOINLINE sem_HsTokens_Cons #-}
+sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens
+sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_HsTokens_v16
+ v16 = \ (T_HsTokens_vIn16 ) -> ( let
+ _hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_))
+ _tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_))
+ (T_HsToken_vOut13 ) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 )
+ (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 )
+ __result_ = T_HsTokens_vOut16
+ in __result_ )
+ in C_HsTokens_s17 v16
+{-# NOINLINE sem_HsTokens_Nil #-}
+sem_HsTokens_Nil :: T_HsTokens
+sem_HsTokens_Nil = T_HsTokens (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_HsTokens_v16
+ v16 = \ (T_HsTokens_vIn16 ) -> ( let
+ __result_ = T_HsTokens_vOut16
+ in __result_ )
+ in C_HsTokens_s17 v16
+
+-- HsTokensRoot ------------------------------------------------
+-- wrapper
+data Inh_HsTokensRoot = Inh_HsTokensRoot { }
+data Syn_HsTokensRoot = Syn_HsTokensRoot { }
+{-# INLINABLE wrap_HsTokensRoot #-}
+wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot )
+wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg19 = T_HsTokensRoot_vIn19
+ (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19)
+ return (Syn_HsTokensRoot )
+ )
+
+-- cata
+{-# INLINE sem_HsTokensRoot #-}
+sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot
+sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ )
+
+-- semantic domain
+newtype T_HsTokensRoot = T_HsTokensRoot {
+ attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 )
+ }
+newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 {
+ inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 )
+ }
+data T_HsTokensRoot_s21 = C_HsTokensRoot_s21
+type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 )
+data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19
+data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19
+{-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-}
+sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot
+sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_HsTokensRoot_v19
+ v19 = \ (T_HsTokensRoot_vIn19 ) -> ( let
+ _tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_))
+ (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 )
+ __result_ = T_HsTokensRoot_vOut19
+ in __result_ )
+ in C_HsTokensRoot_s20 v19
+
+-- Nonterminal -------------------------------------------------
+-- wrapper
+data Inh_Nonterminal = Inh_Nonterminal { derivs_Inh_Nonterminal :: (Derivings), ext_Inh_Nonterminal :: (Maybe String), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), newAtts_Inh_Nonterminal :: ( Attributes ), newNTs_Inh_Nonterminal :: (Set NontermIdent), newProds_Inh_Nonterminal :: ( DataTypes ), o_noGroup_Inh_Nonterminal :: ([String]), o_rename_Inh_Nonterminal :: (Bool), synMap_Inh_Nonterminal :: (Map Identifier Attributes), tSyns_Inh_Nonterminal :: (TypeSyns) }
+data Syn_Nonterminal = Syn_Nonterminal { extendedNTs_Syn_Nonterminal :: (Set NontermIdent), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), ppA_Syn_Nonterminal :: (PP_Doc), ppAI_Syn_Nonterminal :: ([PP_Doc]), ppCata_Syn_Nonterminal :: (PP_Doc), ppD_Syn_Nonterminal :: (PP_Doc), ppDI_Syn_Nonterminal :: ([PP_Doc]), ppL_Syn_Nonterminal :: (PP_Doc), ppLI_Syn_Nonterminal :: ([PP_Doc]), ppNtL_Syn_Nonterminal :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminal :: (PP_Doc), ppSF_Syn_Nonterminal :: (PP_Doc), ppW_Syn_Nonterminal :: (PP_Doc), synMap'_Syn_Nonterminal :: (Map Identifier Attributes) }
+{-# INLINABLE wrap_Nonterminal #-}
+wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal )
+wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg22 = T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
+ (T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminal_s23 sem arg22)
+ return (Syn_Nonterminal _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
+ )
+
+-- cata
+{-# INLINE sem_Nonterminal #-}
+sem_Nonterminal :: Nonterminal -> T_Nonterminal
+sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
+
+-- semantic domain
+newtype T_Nonterminal = T_Nonterminal {
+ attach_T_Nonterminal :: Identity (T_Nonterminal_s23 )
+ }
+newtype T_Nonterminal_s23 = C_Nonterminal_s23 {
+ inv_Nonterminal_s23 :: (T_Nonterminal_v22 )
+ }
+data T_Nonterminal_s24 = C_Nonterminal_s24
+type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 )
+data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
+data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
+{-# NOINLINE sem_Nonterminal_Nonterminal #-}
+sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
+sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st23) where
+ {-# NOINLINE st23 #-}
+ st23 = let
+ v22 :: T_Nonterminal_v22
+ v22 = \ (T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
+ _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
+ (T_Productions_vOut37 _prodsIhasMoreProds _prodsIppA _prodsIppCata _prodsIppDL _prodsIppL _prodsIppLI _prodsIppR _prodsIppRA _prodsIppSF _prodsIppSPF _prodsIprdInh) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup)
+ _lhsOinhMap' :: Map Identifier Attributes
+ _lhsOinhMap' = rule70 arg_inh_ arg_nt_
+ _lhsOsynMap' :: Map Identifier Attributes
+ _lhsOsynMap' = rule71 arg_nt_ arg_syn_
+ _inhNoGroup = rule72 _lhsIo_noGroup _prodsIprdInh
+ _synNoGroup = rule73 _lhsIo_noGroup arg_syn_
+ _prodsOinhNoGroup = rule74 _inhNoGroup
+ _prodsOsynNoGroup = rule75 _synNoGroup
+ _prodsOnewProds = rule76 _lhsInewProds arg_nt_
+ _lhsOextendedNTs :: Set NontermIdent
+ _lhsOextendedNTs = rule77 _prodsIhasMoreProds arg_nt_
+ _ppNt = rule78 arg_nt_
+ _prodsOppNt = rule79 _ppNt
+ _lhsOppD :: PP_Doc
+ _lhsOppD = rule80 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_
+ _lhsOppDI :: [PP_Doc]
+ _lhsOppDI = rule81 _lhsInewNTs _ppNt arg_nt_
+ _ntLabel = rule82 _ppNt
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule83 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule84 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule85 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_
+ _lhsOppAI :: [PP_Doc]
+ _lhsOppAI = rule86 _lhsInewNTs _ppNt arg_nt_
+ _lhsOppNtL :: [(PP_Doc, Attributes)]
+ _lhsOppNtL = rule87 arg_inh_ arg_nt_ arg_syn_
+ _prodsOnewNT = rule88 _lhsInewNTs arg_nt_
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule89 _prodsIppR arg_nt_
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule90 _ppNt _prodsIppCata
+ _prodsOsyn = rule91 arg_syn_
+ _prodsOinh = rule92 arg_inh_
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule93 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup
+ _lhsOppW :: PP_Doc
+ _lhsOppW = rule94 _inhNoGroup _ppNt arg_inh_
+ _prodsOext = rule95 _lhsIext
+ _prodsOinhMap = rule96 _lhsIinhMap
+ _prodsOnewAtts = rule97 _lhsInewAtts
+ _prodsOo_noGroup = rule98 _lhsIo_noGroup
+ _prodsOo_rename = rule99 _lhsIo_rename
+ _prodsOsynMap = rule100 _lhsIsynMap
+ __result_ = T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
+ in __result_ )
+ in C_Nonterminal_s23 v22
+ {-# INLINE rule70 #-}
+ {-# LINE 7 "src-ag/DistChildAttr.ag" #-}
+ rule70 = \ inh_ nt_ ->
+ {-# LINE 7 "src-ag/DistChildAttr.ag" #-}
+ Map.singleton nt_ inh_
+ {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule71 #-}
+ {-# LINE 8 "src-ag/DistChildAttr.ag" #-}
+ rule71 = \ nt_ syn_ ->
+ {-# LINE 8 "src-ag/DistChildAttr.ag" #-}
+ Map.singleton nt_ syn_
+ {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule72 #-}
+ {-# LINE 51 "src-ag/AG2AspectAG.ag" #-}
+ rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) ->
+ {-# LINE 51 "src-ag/AG2AspectAG.ag" #-}
+ Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh
+ {-# LINE 1332 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule73 #-}
+ {-# LINE 52 "src-ag/AG2AspectAG.ag" #-}
+ rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ ->
+ {-# LINE 52 "src-ag/AG2AspectAG.ag" #-}
+ Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_
+ {-# LINE 1338 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule74 #-}
+ {-# LINE 57 "src-ag/AG2AspectAG.ag" #-}
+ rule74 = \ _inhNoGroup ->
+ {-# LINE 57 "src-ag/AG2AspectAG.ag" #-}
+ map show $ Map.keys _inhNoGroup
+ {-# LINE 1344 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule75 #-}
+ {-# LINE 58 "src-ag/AG2AspectAG.ag" #-}
+ rule75 = \ _synNoGroup ->
+ {-# LINE 58 "src-ag/AG2AspectAG.ag" #-}
+ map show $ Map.keys _synNoGroup
+ {-# LINE 1350 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule76 #-}
+ {-# LINE 94 "src-ag/AG2AspectAG.ag" #-}
+ rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ ->
+ {-# LINE 94 "src-ag/AG2AspectAG.ag" #-}
+ case Map.lookup nt_ _lhsInewProds of
+ Just prds -> prds
+ Nothing -> Map.empty
+ {-# LINE 1358 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule77 #-}
+ {-# LINE 107 "src-ag/AG2AspectAG.ag" #-}
+ rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ ->
+ {-# LINE 107 "src-ag/AG2AspectAG.ag" #-}
+ if _prodsIhasMoreProds
+ then Set.singleton nt_
+ else Set.empty
+ {-# LINE 1366 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule78 #-}
+ {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}
+ rule78 = \ nt_ ->
+ {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}
+ pp nt_
+ {-# LINE 1372 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule79 #-}
+ {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}
+ rule79 = \ _ppNt ->
+ {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}
+ _ppNt
+ {-# LINE 1378 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule80 #-}
+ {-# LINE 209 "src-ag/AG2AspectAG.ag" #-}
+ rule80 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ ->
+ {-# LINE 209 "src-ag/AG2AspectAG.ag" #-}
+ if (Set.member nt_ _lhsInewNTs)
+ then case (lookup nt_ _lhsItSyns) of
+ Nothing -> "data " >|< _ppNt
+ >|< " = " >|< vlist_sep " | " _prodsIppDL >-<
+ case (Map.lookup nt_ _lhsIderivs) of
+ Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds)
+ Nothing -> empty
+ Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp
+ else empty
+ {-# LINE 1392 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule81 #-}
+ {-# LINE 222 "src-ag/AG2AspectAG.ag" #-}
+ rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
+ {-# LINE 222 "src-ag/AG2AspectAG.ag" #-}
+ if (not $ Set.member nt_ _lhsInewNTs)
+ then [ _ppNt ]
+ else [ ]
+ {-# LINE 1400 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule82 #-}
+ {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}
+ rule82 = \ _ppNt ->
+ {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}
+ "nt_" >|< _ppNt
+ {-# LINE 1406 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule83 #-}
+ {-# LINE 264 "src-ag/AG2AspectAG.ag" #-}
+ rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ ->
+ {-# LINE 264 "src-ag/AG2AspectAG.ag" #-}
+ ( if (Set.member nt_ _lhsInewNTs)
+ then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt
+ else empty) >-<
+ _prodsIppL
+ {-# LINE 1415 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule84 #-}
+ {-# LINE 269 "src-ag/AG2AspectAG.ag" #-}
+ rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ ->
+ {-# LINE 269 "src-ag/AG2AspectAG.ag" #-}
+ ( if (not $ Set.member nt_ _lhsInewNTs)
+ then [ _ntLabel ]
+ else [ ]) ++
+ _prodsIppLI
+ {-# LINE 1424 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule85 #-}
+ {-# LINE 324 "src-ag/AG2AspectAG.ag" #-}
+ rule85 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ ->
+ {-# LINE 324 "src-ag/AG2AspectAG.ag" #-}
+ ( if (Set.member nt_ _lhsInewNTs)
+ then
+ defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-<
+ defAttRec (pp "SynG") _ppNt syn_ _synNoGroup
+ else empty) >-<
+ _prodsIppA
+ {-# LINE 1435 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule86 #-}
+ {-# LINE 338 "src-ag/AG2AspectAG.ag" #-}
+ rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
+ {-# LINE 338 "src-ag/AG2AspectAG.ag" #-}
+ if (not $ Set.member nt_ _lhsInewNTs)
+ then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ]
+ else [ ]
+ {-# LINE 1443 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule87 #-}
+ {-# LINE 406 "src-ag/AG2AspectAG.ag" #-}
+ rule87 = \ inh_ nt_ syn_ ->
+ {-# LINE 406 "src-ag/AG2AspectAG.ag" #-}
+ [ ("nt_" >|< nt_, Map.union inh_ syn_) ]
+ {-# LINE 1449 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule88 #-}
+ {-# LINE 415 "src-ag/AG2AspectAG.ag" #-}
+ rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ ->
+ {-# LINE 415 "src-ag/AG2AspectAG.ag" #-}
+ Set.member nt_ _lhsInewNTs
+ {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule89 #-}
+ {-# LINE 425 "src-ag/AG2AspectAG.ag" #-}
+ rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ ->
+ {-# LINE 425 "src-ag/AG2AspectAG.ag" #-}
+ pp "----" >|< pp nt_ >-< _prodsIppR
+ {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule90 #-}
+ {-# LINE 735 "src-ag/AG2AspectAG.ag" #-}
+ rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) ->
+ {-# LINE 735 "src-ag/AG2AspectAG.ag" #-}
+ "----" >|< _ppNt >-< _prodsIppCata
+ {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule91 #-}
+ {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}
+ rule91 = \ syn_ ->
+ {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}
+ syn_
+ {-# LINE 1473 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule92 #-}
+ {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}
+ rule92 = \ inh_ ->
+ {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}
+ inh_
+ {-# LINE 1479 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule93 #-}
+ {-# LINE 779 "src-ag/AG2AspectAG.ag" #-}
+ rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup ->
+ {-# LINE 779 "src-ag/AG2AspectAG.ag" #-}
+ let inhAtts = attTypes _inhNoGroup
+ synAtts = attTypes _synNoGroup
+ in
+ "----" >|< _ppNt >-<
+ "type T_" >|< _ppNt >|< " = " >|<
+ "(Record " >|<
+ inhAtts >|<
+ "(HCons (LVPair (Proxy Att_inh) InhG_" >|< _ppNt >|< ") HNil))" >|<
+ replicate (length inhAtts) ")" >|< " -> " >|<
+ "(Record " >|<
+ synAtts >|<
+ "(HCons (LVPair (Proxy Att_syn) SynG_" >|< _ppNt >|< ") HNil))" >|<
+ replicate (length synAtts) ")" >-<
+ "-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-<
+ "-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-<
+ _prodsIppSPF
+ {-# LINE 1500 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule94 #-}
+ {-# LINE 847 "src-ag/AG2AspectAG.ag" #-}
+ rule94 = \ _inhNoGroup _ppNt inh_ ->
+ {-# LINE 847 "src-ag/AG2AspectAG.ag" #-}
+ ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-<
+ " sem " >|< attFields inh_ _inhNoGroup _ppNt
+ {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule95 #-}
+ rule95 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule96 #-}
+ rule96 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule97 #-}
+ rule97 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule98 #-}
+ rule98 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule99 #-}
+ rule99 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule100 #-}
+ rule100 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+
+-- Nonterminals ------------------------------------------------
+-- wrapper
+data Inh_Nonterminals = Inh_Nonterminals { derivs_Inh_Nonterminals :: (Derivings), ext_Inh_Nonterminals :: (Maybe String), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), newAtts_Inh_Nonterminals :: ( Attributes ), newNTs_Inh_Nonterminals :: (Set NontermIdent), newProds_Inh_Nonterminals :: ( DataTypes ), o_noGroup_Inh_Nonterminals :: ([String]), o_rename_Inh_Nonterminals :: (Bool), synMap_Inh_Nonterminals :: (Map Identifier Attributes), tSyns_Inh_Nonterminals :: (TypeSyns) }
+data Syn_Nonterminals = Syn_Nonterminals { extendedNTs_Syn_Nonterminals :: (Set NontermIdent), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), ppA_Syn_Nonterminals :: (PP_Doc), ppAI_Syn_Nonterminals :: ([PP_Doc]), ppCata_Syn_Nonterminals :: (PP_Doc), ppD_Syn_Nonterminals :: (PP_Doc), ppDI_Syn_Nonterminals :: ([PP_Doc]), ppL_Syn_Nonterminals :: (PP_Doc), ppLI_Syn_Nonterminals :: ([PP_Doc]), ppNtL_Syn_Nonterminals :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminals :: (PP_Doc), ppSF_Syn_Nonterminals :: (PP_Doc), ppW_Syn_Nonterminals :: (PP_Doc), synMap'_Syn_Nonterminals :: (Map Identifier Attributes) }
+{-# INLINABLE wrap_Nonterminals #-}
+wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals )
+wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg25 = T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
+ (T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminals_s26 sem arg25)
+ return (Syn_Nonterminals _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
+ )
+
+-- cata
+{-# NOINLINE sem_Nonterminals #-}
+sem_Nonterminals :: Nonterminals -> T_Nonterminals
+sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
+
+-- semantic domain
+newtype T_Nonterminals = T_Nonterminals {
+ attach_T_Nonterminals :: Identity (T_Nonterminals_s26 )
+ }
+newtype T_Nonterminals_s26 = C_Nonterminals_s26 {
+ inv_Nonterminals_s26 :: (T_Nonterminals_v25 )
+ }
+data T_Nonterminals_s27 = C_Nonterminals_s27
+type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 )
+data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
+data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
+{-# NOINLINE sem_Nonterminals_Cons #-}
+sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
+sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where
+ {-# NOINLINE st26 #-}
+ st26 = let
+ v25 :: T_Nonterminals_v25
+ v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
+ _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
+ _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
+ (T_Nonterminal_vOut22 _hdIextendedNTs _hdIinhMap' _hdIppA _hdIppAI _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppNtL _hdIppR _hdIppSF _hdIppW _hdIsynMap') = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOderivs _hdOext _hdOinhMap _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOsynMap _hdOtSyns)
+ (T_Nonterminals_vOut25 _tlIextendedNTs _tlIinhMap' _tlIppA _tlIppAI _tlIppCata _tlIppD _tlIppDI _tlIppL _tlIppLI _tlIppNtL _tlIppR _tlIppSF _tlIppW _tlIsynMap') = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOderivs _tlOext _tlOinhMap _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOsynMap _tlOtSyns)
+ _lhsOextendedNTs :: Set NontermIdent
+ _lhsOextendedNTs = rule101 _hdIextendedNTs _tlIextendedNTs
+ _lhsOinhMap' :: Map Identifier Attributes
+ _lhsOinhMap' = rule102 _hdIinhMap' _tlIinhMap'
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule103 _hdIppA _tlIppA
+ _lhsOppAI :: [PP_Doc]
+ _lhsOppAI = rule104 _hdIppAI _tlIppAI
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule105 _hdIppCata _tlIppCata
+ _lhsOppD :: PP_Doc
+ _lhsOppD = rule106 _hdIppD _tlIppD
+ _lhsOppDI :: [PP_Doc]
+ _lhsOppDI = rule107 _hdIppDI _tlIppDI
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule108 _hdIppL _tlIppL
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule109 _hdIppLI _tlIppLI
+ _lhsOppNtL :: [(PP_Doc, Attributes)]
+ _lhsOppNtL = rule110 _hdIppNtL _tlIppNtL
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule111 _hdIppR _tlIppR
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule112 _hdIppSF _tlIppSF
+ _lhsOppW :: PP_Doc
+ _lhsOppW = rule113 _hdIppW _tlIppW
+ _lhsOsynMap' :: Map Identifier Attributes
+ _lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap'
+ _hdOderivs = rule115 _lhsIderivs
+ _hdOext = rule116 _lhsIext
+ _hdOinhMap = rule117 _lhsIinhMap
+ _hdOnewAtts = rule118 _lhsInewAtts
+ _hdOnewNTs = rule119 _lhsInewNTs
+ _hdOnewProds = rule120 _lhsInewProds
+ _hdOo_noGroup = rule121 _lhsIo_noGroup
+ _hdOo_rename = rule122 _lhsIo_rename
+ _hdOsynMap = rule123 _lhsIsynMap
+ _hdOtSyns = rule124 _lhsItSyns
+ _tlOderivs = rule125 _lhsIderivs
+ _tlOext = rule126 _lhsIext
+ _tlOinhMap = rule127 _lhsIinhMap
+ _tlOnewAtts = rule128 _lhsInewAtts
+ _tlOnewNTs = rule129 _lhsInewNTs
+ _tlOnewProds = rule130 _lhsInewProds
+ _tlOo_noGroup = rule131 _lhsIo_noGroup
+ _tlOo_rename = rule132 _lhsIo_rename
+ _tlOsynMap = rule133 _lhsIsynMap
+ _tlOtSyns = rule134 _lhsItSyns
+ __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
+ in __result_ )
+ in C_Nonterminals_s26 v25
+ {-# INLINE rule101 #-}
+ rule101 = \ ((_hdIextendedNTs) :: Set NontermIdent) ((_tlIextendedNTs) :: Set NontermIdent) ->
+ _hdIextendedNTs `Set.union` _tlIextendedNTs
+ {-# INLINE rule102 #-}
+ rule102 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) ->
+ _hdIinhMap' `Map.union` _tlIinhMap'
+ {-# INLINE rule103 #-}
+ rule103 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
+ _hdIppA >-< _tlIppA
+ {-# INLINE rule104 #-}
+ rule104 = \ ((_hdIppAI) :: [PP_Doc]) ((_tlIppAI) :: [PP_Doc]) ->
+ _hdIppAI ++ _tlIppAI
+ {-# INLINE rule105 #-}
+ rule105 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
+ _hdIppCata >-< _tlIppCata
+ {-# INLINE rule106 #-}
+ rule106 = \ ((_hdIppD) :: PP_Doc) ((_tlIppD) :: PP_Doc) ->
+ _hdIppD >-< _tlIppD
+ {-# INLINE rule107 #-}
+ rule107 = \ ((_hdIppDI) :: [PP_Doc]) ((_tlIppDI) :: [PP_Doc]) ->
+ _hdIppDI ++ _tlIppDI
+ {-# INLINE rule108 #-}
+ rule108 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
+ _hdIppL >-< _tlIppL
+ {-# INLINE rule109 #-}
+ rule109 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
+ _hdIppLI ++ _tlIppLI
+ {-# INLINE rule110 #-}
+ rule110 = \ ((_hdIppNtL) :: [(PP_Doc, Attributes)]) ((_tlIppNtL) :: [(PP_Doc, Attributes)]) ->
+ _hdIppNtL ++ _tlIppNtL
+ {-# INLINE rule111 #-}
+ rule111 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
+ _hdIppR >-< _tlIppR
+ {-# INLINE rule112 #-}
+ rule112 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
+ _hdIppSF >-< _tlIppSF
+ {-# INLINE rule113 #-}
+ rule113 = \ ((_hdIppW) :: PP_Doc) ((_tlIppW) :: PP_Doc) ->
+ _hdIppW >-< _tlIppW
+ {-# INLINE rule114 #-}
+ rule114 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) ->
+ _hdIsynMap' `Map.union` _tlIsynMap'
+ {-# INLINE rule115 #-}
+ rule115 = \ ((_lhsIderivs) :: Derivings) ->
+ _lhsIderivs
+ {-# INLINE rule116 #-}
+ rule116 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule117 #-}
+ rule117 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule118 #-}
+ rule118 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule119 #-}
+ rule119 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
+ _lhsInewNTs
+ {-# INLINE rule120 #-}
+ rule120 = \ ((_lhsInewProds) :: DataTypes ) ->
+ _lhsInewProds
+ {-# INLINE rule121 #-}
+ rule121 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule122 #-}
+ rule122 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule123 #-}
+ rule123 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule124 #-}
+ rule124 = \ ((_lhsItSyns) :: TypeSyns) ->
+ _lhsItSyns
+ {-# INLINE rule125 #-}
+ rule125 = \ ((_lhsIderivs) :: Derivings) ->
+ _lhsIderivs
+ {-# INLINE rule126 #-}
+ rule126 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule127 #-}
+ rule127 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule128 #-}
+ rule128 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule129 #-}
+ rule129 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
+ _lhsInewNTs
+ {-# INLINE rule130 #-}
+ rule130 = \ ((_lhsInewProds) :: DataTypes ) ->
+ _lhsInewProds
+ {-# INLINE rule131 #-}
+ rule131 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule132 #-}
+ rule132 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule133 #-}
+ rule133 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule134 #-}
+ rule134 = \ ((_lhsItSyns) :: TypeSyns) ->
+ _lhsItSyns
+{-# NOINLINE sem_Nonterminals_Nil #-}
+sem_Nonterminals_Nil :: T_Nonterminals
+sem_Nonterminals_Nil = T_Nonterminals (return st26) where
+ {-# NOINLINE st26 #-}
+ st26 = let
+ v25 :: T_Nonterminals_v25
+ v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
+ _lhsOextendedNTs :: Set NontermIdent
+ _lhsOextendedNTs = rule135 ()
+ _lhsOinhMap' :: Map Identifier Attributes
+ _lhsOinhMap' = rule136 ()
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule137 ()
+ _lhsOppAI :: [PP_Doc]
+ _lhsOppAI = rule138 ()
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule139 ()
+ _lhsOppD :: PP_Doc
+ _lhsOppD = rule140 ()
+ _lhsOppDI :: [PP_Doc]
+ _lhsOppDI = rule141 ()
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule142 ()
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule143 ()
+ _lhsOppNtL :: [(PP_Doc, Attributes)]
+ _lhsOppNtL = rule144 ()
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule145 ()
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule146 ()
+ _lhsOppW :: PP_Doc
+ _lhsOppW = rule147 ()
+ _lhsOsynMap' :: Map Identifier Attributes
+ _lhsOsynMap' = rule148 ()
+ __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
+ in __result_ )
+ in C_Nonterminals_s26 v25
+ {-# INLINE rule135 #-}
+ rule135 = \ (_ :: ()) ->
+ Set.empty
+ {-# INLINE rule136 #-}
+ rule136 = \ (_ :: ()) ->
+ Map.empty
+ {-# INLINE rule137 #-}
+ rule137 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule138 #-}
+ rule138 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule139 #-}
+ rule139 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule140 #-}
+ rule140 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule141 #-}
+ rule141 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule142 #-}
+ rule142 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule143 #-}
+ rule143 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule144 #-}
+ rule144 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule145 #-}
+ rule145 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule146 #-}
+ rule146 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule147 #-}
+ rule147 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule148 #-}
+ rule148 = \ (_ :: ()) ->
+ Map.empty
+
+-- Pattern -----------------------------------------------------
+-- wrapper
+data Inh_Pattern = Inh_Pattern { }
+data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), info_Syn_Pattern :: ((Identifier, Identifier)) }
+{-# INLINABLE wrap_Pattern #-}
+wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
+wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg28 = T_Pattern_vIn28
+ (T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg28)
+ return (Syn_Pattern _lhsOcopy _lhsOinfo)
+ )
+
+-- cata
+{-# NOINLINE sem_Pattern #-}
+sem_Pattern :: Pattern -> T_Pattern
+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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
+sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
+sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
+
+-- semantic domain
+newtype T_Pattern = T_Pattern {
+ attach_T_Pattern :: Identity (T_Pattern_s29 )
+ }
+newtype T_Pattern_s29 = C_Pattern_s29 {
+ inv_Pattern_s29 :: (T_Pattern_v28 )
+ }
+data T_Pattern_s30 = C_Pattern_s30
+type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 )
+data T_Pattern_vIn28 = T_Pattern_vIn28
+data T_Pattern_vOut28 = T_Pattern_vOut28 (Pattern) ((Identifier, Identifier))
+{-# NOINLINE sem_Pattern_Constr #-}
+sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
+sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Pattern_v28
+ v28 = \ (T_Pattern_vIn28 ) -> ( let
+ _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
+ _lhsOinfo :: (Identifier, Identifier)
+ _lhsOinfo = rule149 ()
+ _copy = rule150 _patsIcopy arg_name_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule151 _copy
+ __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
+ in __result_ )
+ in C_Pattern_s29 v28
+ {-# INLINE rule149 #-}
+ {-# LINE 383 "src-ag/AG2AspectAG.ag" #-}
+ rule149 = \ (_ :: ()) ->
+ {-# LINE 383 "src-ag/AG2AspectAG.ag" #-}
+ error "Pattern Constr undefined!!"
+ {-# LINE 1858 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule150 #-}
+ rule150 = \ ((_patsIcopy) :: Patterns) name_ ->
+ Constr name_ _patsIcopy
+ {-# INLINE rule151 #-}
+ rule151 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Product #-}
+sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
+sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Pattern_v28
+ v28 = \ (T_Pattern_vIn28 ) -> ( let
+ _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
+ _lhsOinfo :: (Identifier, Identifier)
+ _lhsOinfo = rule152 ()
+ _copy = rule153 _patsIcopy arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule154 _copy
+ __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
+ in __result_ )
+ in C_Pattern_s29 v28
+ {-# INLINE rule152 #-}
+ {-# LINE 384 "src-ag/AG2AspectAG.ag" #-}
+ rule152 = \ (_ :: ()) ->
+ {-# LINE 384 "src-ag/AG2AspectAG.ag" #-}
+ error "Pattern Product undefined!!"
+ {-# LINE 1887 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule153 #-}
+ rule153 = \ ((_patsIcopy) :: Patterns) pos_ ->
+ Product pos_ _patsIcopy
+ {-# INLINE rule154 #-}
+ rule154 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Alias #-}
+sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
+sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Pattern_v28
+ v28 = \ (T_Pattern_vIn28 ) -> ( let
+ _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
+ _lhsOinfo :: (Identifier, Identifier)
+ _lhsOinfo = rule155 arg_attr_ arg_field_
+ _copy = rule156 _patIcopy arg_attr_ arg_field_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule157 _copy
+ __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
+ in __result_ )
+ in C_Pattern_s29 v28
+ {-# INLINE rule155 #-}
+ {-# LINE 382 "src-ag/AG2AspectAG.ag" #-}
+ rule155 = \ attr_ field_ ->
+ {-# LINE 382 "src-ag/AG2AspectAG.ag" #-}
+ (field_, attr_)
+ {-# LINE 1916 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule156 #-}
+ rule156 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
+ Alias field_ attr_ _patIcopy
+ {-# INLINE rule157 #-}
+ rule157 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Irrefutable #-}
+sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
+sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Pattern_v28
+ v28 = \ (T_Pattern_vIn28 ) -> ( let
+ _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
+ _copy = rule158 _patIcopy
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule159 _copy
+ _lhsOinfo :: (Identifier, Identifier)
+ _lhsOinfo = rule160 _patIinfo
+ __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
+ in __result_ )
+ in C_Pattern_s29 v28
+ {-# INLINE rule158 #-}
+ rule158 = \ ((_patIcopy) :: Pattern) ->
+ Irrefutable _patIcopy
+ {-# INLINE rule159 #-}
+ rule159 = \ _copy ->
+ _copy
+ {-# INLINE rule160 #-}
+ rule160 = \ ((_patIinfo) :: (Identifier, Identifier)) ->
+ _patIinfo
+{-# NOINLINE sem_Pattern_Underscore #-}
+sem_Pattern_Underscore :: (Pos) -> T_Pattern
+sem_Pattern_Underscore arg_pos_ = T_Pattern (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Pattern_v28
+ v28 = \ (T_Pattern_vIn28 ) -> ( let
+ _lhsOinfo :: (Identifier, Identifier)
+ _lhsOinfo = rule161 ()
+ _copy = rule162 arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule163 _copy
+ __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
+ in __result_ )
+ in C_Pattern_s29 v28
+ {-# INLINE rule161 #-}
+ {-# LINE 385 "src-ag/AG2AspectAG.ag" #-}
+ rule161 = \ (_ :: ()) ->
+ {-# LINE 385 "src-ag/AG2AspectAG.ag" #-}
+ error "Pattern Underscore undefined!!"
+ {-# LINE 1969 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule162 #-}
+ rule162 = \ pos_ ->
+ Underscore pos_
+ {-# INLINE rule163 #-}
+ rule163 = \ _copy ->
+ _copy
+
+-- Patterns ----------------------------------------------------
+-- wrapper
+data Inh_Patterns = Inh_Patterns { }
+data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns) }
+{-# INLINABLE wrap_Patterns #-}
+wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
+wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg31 = T_Patterns_vIn31
+ (T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg31)
+ return (Syn_Patterns _lhsOcopy)
+ )
+
+-- cata
+{-# NOINLINE sem_Patterns #-}
+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 {
+ attach_T_Patterns :: Identity (T_Patterns_s32 )
+ }
+newtype T_Patterns_s32 = C_Patterns_s32 {
+ inv_Patterns_s32 :: (T_Patterns_v31 )
+ }
+data T_Patterns_s33 = C_Patterns_s33
+type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 )
+data T_Patterns_vIn31 = T_Patterns_vIn31
+data T_Patterns_vOut31 = T_Patterns_vOut31 (Patterns)
+{-# NOINLINE sem_Patterns_Cons #-}
+sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
+sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where
+ {-# NOINLINE st32 #-}
+ st32 = let
+ v31 :: T_Patterns_v31
+ v31 = \ (T_Patterns_vIn31 ) -> ( let
+ _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
+ _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
+ (T_Pattern_vOut28 _hdIcopy _hdIinfo) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 )
+ (T_Patterns_vOut31 _tlIcopy) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 )
+ _copy = rule164 _hdIcopy _tlIcopy
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule165 _copy
+ __result_ = T_Patterns_vOut31 _lhsOcopy
+ in __result_ )
+ in C_Patterns_s32 v31
+ {-# INLINE rule164 #-}
+ rule164 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
+ (:) _hdIcopy _tlIcopy
+ {-# INLINE rule165 #-}
+ rule165 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Patterns_Nil #-}
+sem_Patterns_Nil :: T_Patterns
+sem_Patterns_Nil = T_Patterns (return st32) where
+ {-# NOINLINE st32 #-}
+ st32 = let
+ v31 :: T_Patterns_v31
+ v31 = \ (T_Patterns_vIn31 ) -> ( let
+ _copy = rule166 ()
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule167 _copy
+ __result_ = T_Patterns_vOut31 _lhsOcopy
+ in __result_ )
+ in C_Patterns_s32 v31
+ {-# INLINE rule166 #-}
+ rule166 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule167 #-}
+ rule167 = \ _copy ->
+ _copy
+
+-- Production --------------------------------------------------
+-- wrapper
+data Inh_Production = Inh_Production { ext_Inh_Production :: (Maybe String), inh_Inh_Production :: ( Attributes ), inhMap_Inh_Production :: (Map Identifier Attributes), inhNoGroup_Inh_Production :: ([String]), newAtts_Inh_Production :: ( Attributes ), newNT_Inh_Production :: (Bool), newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Production :: ([String]), o_rename_Inh_Production :: (Bool), ppNt_Inh_Production :: (PP_Doc), syn_Inh_Production :: ( Attributes ), synMap_Inh_Production :: (Map Identifier Attributes), synNoGroup_Inh_Production :: ([String]) }
+data Syn_Production = Syn_Production { hasMoreProds_Syn_Production :: ( Bool ), ppA_Syn_Production :: (PP_Doc), ppCata_Syn_Production :: (PP_Doc), ppD_Syn_Production :: (PP_Doc), ppDI_Syn_Production :: ([PP_Doc]), ppL_Syn_Production :: (PP_Doc), ppLI_Syn_Production :: ([PP_Doc]), ppR_Syn_Production :: (PP_Doc), ppRA_Syn_Production :: ([PP_Doc]), ppSF_Syn_Production :: (PP_Doc), ppSPF_Syn_Production :: (PP_Doc), prdInh_Syn_Production :: (Attributes) }
+{-# INLINABLE wrap_Production #-}
+wrap_Production :: T_Production -> Inh_Production -> (Syn_Production )
+wrap_Production (T_Production act) (Inh_Production _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg34 = T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
+ (T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Production_s35 sem arg34)
+ return (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
+ )
+
+-- cata
+{-# INLINE sem_Production #-}
+sem_Production :: Production -> T_Production
+sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_
+
+-- semantic domain
+newtype T_Production = T_Production {
+ attach_T_Production :: Identity (T_Production_s35 )
+ }
+newtype T_Production_s35 = C_Production_s35 {
+ inv_Production_s35 :: (T_Production_v34 )
+ }
+data T_Production_s36 = C_Production_s36
+type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 )
+data T_Production_vIn34 = T_Production_vIn34 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
+data T_Production_vOut34 = T_Production_vOut34 ( Bool ) (PP_Doc) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
+{-# NOINLINE sem_Production_Production #-}
+sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
+sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Production_v34
+ v34 = \ (T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
+ _rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
+ _typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
+ (T_Children_vOut4 _childrenIidCL _childrenIppCSF _childrenIppDL _childrenIppL _childrenIppLI _childrenIppR _childrenIprdInh) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOext _childrenOinhMap _childrenOinhNoGroup _childrenOnewAtts _childrenOo_noGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynMap _childrenOsynNoGroup)
+ (T_Rules_vOut43 _rulesIlocals _rulesIppRL) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOext _rulesOinhNoGroup _rulesOnewAtts _rulesOnewProd _rulesOo_noGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup)
+ (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 )
+ _lhsOhasMoreProds :: Bool
+ _lhsOhasMoreProds = rule168 _lhsInewProds arg_con_
+ _ppProd = rule169 arg_con_
+ _prodName = rule170 _lhsIppNt _ppProd
+ _conName = rule171 _lhsIo_rename _ppProd _prodName
+ _childrenOppProd = rule172 _ppProd
+ _rulesOppProd = rule173 _ppProd
+ _lhsOppD :: PP_Doc
+ _lhsOppD = rule174 _childrenIppDL _conName
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule175 _childrenIppL _lhsInewProds arg_con_
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule176 _childrenIppLI _lhsInewProds arg_con_
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule177 _prodName _rulesIlocals
+ _newProd = rule178 _lhsInewProds arg_con_
+ (_ppR,_ppRA) = rule179 _childrenIidCL _childrenIppR _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsIppNt _lhsIsynNoGroup _newProd _prodName _rulesIlocals _rulesIppRL arg_con_
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule180 _lhsIext _lhsInewNT _newProd _ppRA _prodName arg_macro_
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule181 _childrenIppCSF _conName _lhsIppNt _prodName arg_con_
+ _lhsOppSPF :: PP_Doc
+ _lhsOppSPF = rule182 _childrenIppCSF _lhsIppNt _prodName arg_con_
+ _lhsOppDI :: [PP_Doc]
+ _lhsOppDI = rule183 ()
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule184 _ppR
+ _lhsOppRA :: [PP_Doc]
+ _lhsOppRA = rule185 _ppRA
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule186 _childrenIprdInh
+ _childrenOext = rule187 _lhsIext
+ _childrenOinhMap = rule188 _lhsIinhMap
+ _childrenOinhNoGroup = rule189 _lhsIinhNoGroup
+ _childrenOnewAtts = rule190 _lhsInewAtts
+ _childrenOo_noGroup = rule191 _lhsIo_noGroup
+ _childrenOo_rename = rule192 _lhsIo_rename
+ _childrenOppNt = rule193 _lhsIppNt
+ _childrenOsynMap = rule194 _lhsIsynMap
+ _childrenOsynNoGroup = rule195 _lhsIsynNoGroup
+ _rulesOext = rule196 _lhsIext
+ _rulesOinhNoGroup = rule197 _lhsIinhNoGroup
+ _rulesOnewAtts = rule198 _lhsInewAtts
+ _rulesOnewProd = rule199 _newProd
+ _rulesOo_noGroup = rule200 _lhsIo_noGroup
+ _rulesOppNt = rule201 _lhsIppNt
+ _rulesOsynNoGroup = rule202 _lhsIsynNoGroup
+ __result_ = T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
+ in __result_ )
+ in C_Production_s35 v34
+ {-# INLINE rule168 #-}
+ {-# LINE 103 "src-ag/AG2AspectAG.ag" #-}
+ rule168 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
+ {-# LINE 103 "src-ag/AG2AspectAG.ag" #-}
+ not $ Map.member con_ _lhsInewProds
+ {-# LINE 2148 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule169 #-}
+ {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}
+ rule169 = \ con_ ->
+ {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}
+ pp con_
+ {-# LINE 2154 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule170 #-}
+ {-# LINE 177 "src-ag/AG2AspectAG.ag" #-}
+ rule170 = \ ((_lhsIppNt) :: PP_Doc) _ppProd ->
+ {-# LINE 177 "src-ag/AG2AspectAG.ag" #-}
+ ppName [_lhsIppNt, _ppProd ]
+ {-# LINE 2160 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule171 #-}
+ {-# LINE 178 "src-ag/AG2AspectAG.ag" #-}
+ rule171 = \ ((_lhsIo_rename) :: Bool) _ppProd _prodName ->
+ {-# LINE 178 "src-ag/AG2AspectAG.ag" #-}
+ if _lhsIo_rename
+ then _prodName
+ else _ppProd
+ {-# LINE 2168 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule172 #-}
+ {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}
+ rule172 = \ _ppProd ->
+ {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}
+ _ppProd
+ {-# LINE 2174 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule173 #-}
+ {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}
+ rule173 = \ _ppProd ->
+ {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}
+ _ppProd
+ {-# LINE 2180 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule174 #-}
+ {-# LINE 228 "src-ag/AG2AspectAG.ag" #-}
+ rule174 = \ ((_childrenIppDL) :: [PP_Doc]) _conName ->
+ {-# LINE 228 "src-ag/AG2AspectAG.ag" #-}
+ _conName >|< ppListSep " {" "}" ", " _childrenIppDL
+ {-# LINE 2186 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule175 #-}
+ {-# LINE 275 "src-ag/AG2AspectAG.ag" #-}
+ rule175 = \ ((_childrenIppL) :: PP_Doc) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
+ {-# LINE 275 "src-ag/AG2AspectAG.ag" #-}
+ if (Map.member con_ _lhsInewProds)
+ then _childrenIppL
+ else empty
+ {-# LINE 2194 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule176 #-}
+ {-# LINE 279 "src-ag/AG2AspectAG.ag" #-}
+ rule176 = \ ((_childrenIppLI) :: [PP_Doc]) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
+ {-# LINE 279 "src-ag/AG2AspectAG.ag" #-}
+ if (not $ Map.member con_ _lhsInewProds)
+ then _childrenIppLI
+ else []
+ {-# LINE 2202 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule177 #-}
+ {-# LINE 332 "src-ag/AG2AspectAG.ag" #-}
+ rule177 = \ _prodName ((_rulesIlocals) :: [Identifier]) ->
+ {-# LINE 332 "src-ag/AG2AspectAG.ag" #-}
+ defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals
+ {-# LINE 2208 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule178 #-}
+ {-# LINE 428 "src-ag/AG2AspectAG.ag" #-}
+ rule178 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
+ {-# LINE 428 "src-ag/AG2AspectAG.ag" #-}
+ Map.member con_ _lhsInewProds
+ {-# LINE 2214 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule179 #-}
+ {-# LINE 430 "src-ag/AG2AspectAG.ag" #-}
+ rule179 = \ ((_childrenIidCL) :: [(Identifier,Type)]) ((_childrenIppR) :: PP_Doc) ((_lhsIinhNoGroup) :: [String]) ((_lhsInewAtts) :: Attributes ) ((_lhsInewNT) :: Bool) ((_lhsIppNt) :: PP_Doc) ((_lhsIsynNoGroup) :: [String]) _newProd _prodName ((_rulesIlocals) :: [Identifier]) ((_rulesIppRL) :: [ PPRule ]) con_ ->
+ {-# LINE 430 "src-ag/AG2AspectAG.ag" #-}
+ let (instR, instRA) = defInstRules _lhsIppNt con_ _lhsInewNT _newProd
+ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals
+ (locR, locRA) = defLocRule _lhsIppNt con_ _lhsInewNT _newProd
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (inhGR, inhGRA) = defInhGRule _lhsIppNt _prodName _lhsInewNT _newProd
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (synGR, synGRA) = defSynGRule _lhsIppNt con_ _lhsInewNT _newProd
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (inhR, inhRA) = defInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (synR, synRA) = defSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (inhMR, inhMRA) = modInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ (synMR, synMRA) = modSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
+ _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
+ in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR]
+ , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA)
+ {-# LINE 2237 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule180 #-}
+ {-# LINE 740 "src-ag/AG2AspectAG.ag" #-}
+ rule180 = \ ((_lhsIext) :: Maybe String) ((_lhsInewNT) :: Bool) _newProd _ppRA _prodName macro_ ->
+ {-# LINE 740 "src-ag/AG2AspectAG.ag" #-}
+ let extend = maybe []
+ ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd ))
+ then []
+ else [ ext >|< ".atts_" >|< _prodName ])
+ _lhsIext
+ macro = case macro_ of
+ Nothing -> []
+ Just macro -> [ "agMacro " >|< ppMacro macro ]
+ atts = sortBy (\a b -> compare (show a) (show b)) _ppRA
+ in "atts_" >|< _prodName >|< " = " >|<
+ ppListSep "" "" " `ext` "
+ (atts ++ macro ++ extend ) >-<
+ "semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName
+ {-# LINE 2255 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule181 #-}
+ {-# LINE 804 "src-ag/AG2AspectAG.ag" #-}
+ rule181 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) _conName ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
+ {-# LINE 804 "src-ag/AG2AspectAG.ag" #-}
+ let chi = _childrenIppCSF
+ ppPattern = case (show con_) of
+ "Cons" -> ppParams (ppListSep "" "" " : ")
+ "Nil" -> pp "[]"
+ otherwise -> _conName >|< " " >|< (ppParams ppSpaced)
+ ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
+ in "sem_" >|< _lhsIppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< _prodName >|<
+ " (" >|< map (fst . snd) chi >|< "emptyRecord)"
+ {-# LINE 2268 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule182 #-}
+ {-# LINE 816 "src-ag/AG2AspectAG.ag" #-}
+ rule182 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
+ {-# LINE 816 "src-ag/AG2AspectAG.ag" #-}
+ let chi = _childrenIppCSF
+ ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
+ in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|<
+ " (" >|< map (snd . snd) chi >|< "emptyRecord)"
+ {-# LINE 2277 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule183 #-}
+ rule183 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule184 #-}
+ rule184 = \ _ppR ->
+ _ppR
+ {-# INLINE rule185 #-}
+ rule185 = \ _ppRA ->
+ _ppRA
+ {-# INLINE rule186 #-}
+ rule186 = \ ((_childrenIprdInh) :: Attributes) ->
+ _childrenIprdInh
+ {-# INLINE rule187 #-}
+ rule187 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule188 #-}
+ rule188 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule189 #-}
+ rule189 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule190 #-}
+ rule190 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule191 #-}
+ rule191 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule192 #-}
+ rule192 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule193 #-}
+ rule193 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule194 #-}
+ rule194 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule195 #-}
+ rule195 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+ {-# INLINE rule196 #-}
+ rule196 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule197 #-}
+ rule197 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule198 #-}
+ rule198 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule199 #-}
+ rule199 = \ _newProd ->
+ _newProd
+ {-# INLINE rule200 #-}
+ rule200 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule201 #-}
+ rule201 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule202 #-}
+ rule202 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+
+-- Productions -------------------------------------------------
+-- wrapper
+data Inh_Productions = Inh_Productions { ext_Inh_Productions :: (Maybe String), inh_Inh_Productions :: ( Attributes ), inhMap_Inh_Productions :: (Map Identifier Attributes), inhNoGroup_Inh_Productions :: ([String]), newAtts_Inh_Productions :: ( Attributes ), newNT_Inh_Productions :: (Bool), newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Productions :: ([String]), o_rename_Inh_Productions :: (Bool), ppNt_Inh_Productions :: (PP_Doc), syn_Inh_Productions :: ( Attributes ), synMap_Inh_Productions :: (Map Identifier Attributes), synNoGroup_Inh_Productions :: ([String]) }
+data Syn_Productions = Syn_Productions { hasMoreProds_Syn_Productions :: ( Bool ), ppA_Syn_Productions :: (PP_Doc), ppCata_Syn_Productions :: (PP_Doc), ppDL_Syn_Productions :: ([PP_Doc]), ppL_Syn_Productions :: (PP_Doc), ppLI_Syn_Productions :: ([PP_Doc]), ppR_Syn_Productions :: (PP_Doc), ppRA_Syn_Productions :: ([PP_Doc]), ppSF_Syn_Productions :: (PP_Doc), ppSPF_Syn_Productions :: (PP_Doc), prdInh_Syn_Productions :: (Attributes) }
+{-# INLINABLE wrap_Productions #-}
+wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions )
+wrap_Productions (T_Productions act) (Inh_Productions _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg37 = T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
+ (T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Productions_s38 sem arg37)
+ return (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
+ )
+
+-- cata
+{-# NOINLINE sem_Productions #-}
+sem_Productions :: Productions -> T_Productions
+sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
+
+-- semantic domain
+newtype T_Productions = T_Productions {
+ attach_T_Productions :: Identity (T_Productions_s38 )
+ }
+newtype T_Productions_s38 = C_Productions_s38 {
+ inv_Productions_s38 :: (T_Productions_v37 )
+ }
+data T_Productions_s39 = C_Productions_s39
+type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 )
+data T_Productions_vIn37 = T_Productions_vIn37 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
+data T_Productions_vOut37 = T_Productions_vOut37 ( Bool ) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
+{-# NOINLINE sem_Productions_Cons #-}
+sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
+sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where
+ {-# NOINLINE st38 #-}
+ st38 = let
+ v37 :: T_Productions_v37
+ v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
+ _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
+ (T_Production_vOut34 _hdIhasMoreProds _hdIppA _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppR _hdIppRA _hdIppSF _hdIppSPF _hdIprdInh) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOext _hdOinh _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOppNt _hdOsyn _hdOsynMap _hdOsynNoGroup)
+ (T_Productions_vOut37 _tlIhasMoreProds _tlIppA _tlIppCata _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIppRA _tlIppSF _tlIppSPF _tlIprdInh) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOext _tlOinh _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOppNt _tlOsyn _tlOsynMap _tlOsynNoGroup)
+ _hdOinhNoGroup = rule203 _hdIprdInh _lhsIinhNoGroup
+ _lhsOppDL :: [PP_Doc]
+ _lhsOppDL = rule204 _hdIppD _tlIppDL
+ _lhsOhasMoreProds :: Bool
+ _lhsOhasMoreProds = rule205 _hdIhasMoreProds _tlIhasMoreProds
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule206 _hdIppA _tlIppA
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule207 _hdIppCata _tlIppCata
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule208 _hdIppL _tlIppL
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule209 _hdIppLI _tlIppLI
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule210 _hdIppR _tlIppR
+ _lhsOppRA :: [PP_Doc]
+ _lhsOppRA = rule211 _hdIppRA _tlIppRA
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule212 _hdIppSF _tlIppSF
+ _lhsOppSPF :: PP_Doc
+ _lhsOppSPF = rule213 _hdIppSPF _tlIppSPF
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule214 _hdIprdInh _tlIprdInh
+ _hdOext = rule215 _lhsIext
+ _hdOinh = rule216 _lhsIinh
+ _hdOinhMap = rule217 _lhsIinhMap
+ _hdOnewAtts = rule218 _lhsInewAtts
+ _hdOnewNT = rule219 _lhsInewNT
+ _hdOnewProds = rule220 _lhsInewProds
+ _hdOo_noGroup = rule221 _lhsIo_noGroup
+ _hdOo_rename = rule222 _lhsIo_rename
+ _hdOppNt = rule223 _lhsIppNt
+ _hdOsyn = rule224 _lhsIsyn
+ _hdOsynMap = rule225 _lhsIsynMap
+ _hdOsynNoGroup = rule226 _lhsIsynNoGroup
+ _tlOext = rule227 _lhsIext
+ _tlOinh = rule228 _lhsIinh
+ _tlOinhMap = rule229 _lhsIinhMap
+ _tlOinhNoGroup = rule230 _lhsIinhNoGroup
+ _tlOnewAtts = rule231 _lhsInewAtts
+ _tlOnewNT = rule232 _lhsInewNT
+ _tlOnewProds = rule233 _lhsInewProds
+ _tlOo_noGroup = rule234 _lhsIo_noGroup
+ _tlOo_rename = rule235 _lhsIo_rename
+ _tlOppNt = rule236 _lhsIppNt
+ _tlOsyn = rule237 _lhsIsyn
+ _tlOsynMap = rule238 _lhsIsynMap
+ _tlOsynNoGroup = rule239 _lhsIsynNoGroup
+ __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
+ in __result_ )
+ in C_Productions_s38 v37
+ {-# INLINE rule203 #-}
+ {-# LINE 62 "src-ag/AG2AspectAG.ag" #-}
+ rule203 = \ ((_hdIprdInh) :: Attributes) ((_lhsIinhNoGroup) :: [String]) ->
+ {-# LINE 62 "src-ag/AG2AspectAG.ag" #-}
+ filter (flip Map.member _hdIprdInh . identifier) _lhsIinhNoGroup
+ {-# LINE 2436 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule204 #-}
+ {-# LINE 234 "src-ag/AG2AspectAG.ag" #-}
+ rule204 = \ ((_hdIppD) :: PP_Doc) ((_tlIppDL) :: [PP_Doc]) ->
+ {-# LINE 234 "src-ag/AG2AspectAG.ag" #-}
+ _hdIppD : _tlIppDL
+ {-# LINE 2442 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule205 #-}
+ rule205 = \ ((_hdIhasMoreProds) :: Bool ) ((_tlIhasMoreProds) :: Bool ) ->
+ _hdIhasMoreProds || _tlIhasMoreProds
+ {-# INLINE rule206 #-}
+ rule206 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
+ _hdIppA >-< _tlIppA
+ {-# INLINE rule207 #-}
+ rule207 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
+ _hdIppCata >-< _tlIppCata
+ {-# INLINE rule208 #-}
+ rule208 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
+ _hdIppL >-< _tlIppL
+ {-# INLINE rule209 #-}
+ rule209 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
+ _hdIppLI ++ _tlIppLI
+ {-# INLINE rule210 #-}
+ rule210 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
+ _hdIppR >-< _tlIppR
+ {-# INLINE rule211 #-}
+ rule211 = \ ((_hdIppRA) :: [PP_Doc]) ((_tlIppRA) :: [PP_Doc]) ->
+ _hdIppRA ++ _tlIppRA
+ {-# INLINE rule212 #-}
+ rule212 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
+ _hdIppSF >-< _tlIppSF
+ {-# INLINE rule213 #-}
+ rule213 = \ ((_hdIppSPF) :: PP_Doc) ((_tlIppSPF) :: PP_Doc) ->
+ _hdIppSPF >-< _tlIppSPF
+ {-# INLINE rule214 #-}
+ rule214 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
+ _hdIprdInh `Map.union` _tlIprdInh
+ {-# INLINE rule215 #-}
+ rule215 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule216 #-}
+ rule216 = \ ((_lhsIinh) :: Attributes ) ->
+ _lhsIinh
+ {-# INLINE rule217 #-}
+ rule217 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule218 #-}
+ rule218 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule219 #-}
+ rule219 = \ ((_lhsInewNT) :: Bool) ->
+ _lhsInewNT
+ {-# INLINE rule220 #-}
+ rule220 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
+ _lhsInewProds
+ {-# INLINE rule221 #-}
+ rule221 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule222 #-}
+ rule222 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule223 #-}
+ rule223 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule224 #-}
+ rule224 = \ ((_lhsIsyn) :: Attributes ) ->
+ _lhsIsyn
+ {-# INLINE rule225 #-}
+ rule225 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule226 #-}
+ rule226 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+ {-# INLINE rule227 #-}
+ rule227 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule228 #-}
+ rule228 = \ ((_lhsIinh) :: Attributes ) ->
+ _lhsIinh
+ {-# INLINE rule229 #-}
+ rule229 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
+ _lhsIinhMap
+ {-# INLINE rule230 #-}
+ rule230 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule231 #-}
+ rule231 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule232 #-}
+ rule232 = \ ((_lhsInewNT) :: Bool) ->
+ _lhsInewNT
+ {-# INLINE rule233 #-}
+ rule233 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
+ _lhsInewProds
+ {-# INLINE rule234 #-}
+ rule234 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule235 #-}
+ rule235 = \ ((_lhsIo_rename) :: Bool) ->
+ _lhsIo_rename
+ {-# INLINE rule236 #-}
+ rule236 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule237 #-}
+ rule237 = \ ((_lhsIsyn) :: Attributes ) ->
+ _lhsIsyn
+ {-# INLINE rule238 #-}
+ rule238 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
+ _lhsIsynMap
+ {-# INLINE rule239 #-}
+ rule239 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+{-# NOINLINE sem_Productions_Nil #-}
+sem_Productions_Nil :: T_Productions
+sem_Productions_Nil = T_Productions (return st38) where
+ {-# NOINLINE st38 #-}
+ st38 = let
+ v37 :: T_Productions_v37
+ v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
+ _lhsOppDL :: [PP_Doc]
+ _lhsOppDL = rule240 ()
+ _lhsOhasMoreProds :: Bool
+ _lhsOhasMoreProds = rule241 ()
+ _lhsOppA :: PP_Doc
+ _lhsOppA = rule242 ()
+ _lhsOppCata :: PP_Doc
+ _lhsOppCata = rule243 ()
+ _lhsOppL :: PP_Doc
+ _lhsOppL = rule244 ()
+ _lhsOppLI :: [PP_Doc]
+ _lhsOppLI = rule245 ()
+ _lhsOppR :: PP_Doc
+ _lhsOppR = rule246 ()
+ _lhsOppRA :: [PP_Doc]
+ _lhsOppRA = rule247 ()
+ _lhsOppSF :: PP_Doc
+ _lhsOppSF = rule248 ()
+ _lhsOppSPF :: PP_Doc
+ _lhsOppSPF = rule249 ()
+ _lhsOprdInh :: Attributes
+ _lhsOprdInh = rule250 ()
+ __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
+ in __result_ )
+ in C_Productions_s38 v37
+ {-# INLINE rule240 #-}
+ {-# LINE 235 "src-ag/AG2AspectAG.ag" #-}
+ rule240 = \ (_ :: ()) ->
+ {-# LINE 235 "src-ag/AG2AspectAG.ag" #-}
+ []
+ {-# LINE 2585 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule241 #-}
+ rule241 = \ (_ :: ()) ->
+ False
+ {-# INLINE rule242 #-}
+ rule242 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule243 #-}
+ rule243 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule244 #-}
+ rule244 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule245 #-}
+ rule245 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule246 #-}
+ rule246 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule247 #-}
+ rule247 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule248 #-}
+ rule248 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule249 #-}
+ rule249 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule250 #-}
+ rule250 = \ (_ :: ()) ->
+ Map.empty
+
+-- Rule --------------------------------------------------------
+-- wrapper
+data Inh_Rule = Inh_Rule { ext_Inh_Rule :: (Maybe String), inhNoGroup_Inh_Rule :: ([String]), newAtts_Inh_Rule :: ( Attributes ), newProd_Inh_Rule :: (Bool), o_noGroup_Inh_Rule :: ([String]), ppNt_Inh_Rule :: (PP_Doc), ppProd_Inh_Rule :: (PP_Doc), synNoGroup_Inh_Rule :: ([String]) }
+data Syn_Rule = Syn_Rule { locals_Syn_Rule :: ([Identifier]), ppRL_Syn_Rule :: ([ PPRule ]) }
+{-# INLINABLE wrap_Rule #-}
+wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule )
+wrap_Rule (T_Rule act) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg40 = T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
+ (T_Rule_vOut40 _lhsOlocals _lhsOppRL) <- return (inv_Rule_s41 sem arg40)
+ return (Syn_Rule _lhsOlocals _lhsOppRL)
+ )
+
+-- cata
+{-# INLINE sem_Rule #-}
+sem_Rule :: Rule -> T_Rule
+sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
+
+-- semantic domain
+newtype T_Rule = T_Rule {
+ attach_T_Rule :: Identity (T_Rule_s41 )
+ }
+newtype T_Rule_s41 = C_Rule_s41 {
+ inv_Rule_s41 :: (T_Rule_v40 )
+ }
+data T_Rule_s42 = C_Rule_s42
+type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 )
+data T_Rule_vIn40 = T_Rule_vIn40 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
+data T_Rule_vOut40 = T_Rule_vOut40 ([Identifier]) ([ PPRule ])
+{-# NOINLINE sem_Rule_Rule #-}
+sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
+sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ arg_explicit_ _ _ _ _ = T_Rule (return st41) where
+ {-# NOINLINE st41 #-}
+ st41 = let
+ v40 :: T_Rule_v40
+ v40 = \ (T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
+ _patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
+ _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
+ (T_Pattern_vOut28 _patternIcopy _patternIinfo) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 )
+ (T_Expression_vOut7 _rhsIppRE) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOppNt _rhsOppProd)
+ _lhsOlocals :: [Identifier]
+ _lhsOlocals = rule251 _patternIinfo
+ _lhsOppRL :: [ PPRule ]
+ _lhsOppRL = rule252 _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _patternIinfo _rhsIppRE arg_explicit_ arg_owrt_
+ _rhsOppNt = rule253 _lhsIppNt
+ _rhsOppProd = rule254 _lhsIppProd
+ __result_ = T_Rule_vOut40 _lhsOlocals _lhsOppRL
+ in __result_ )
+ in C_Rule_s41 v40
+ {-# INLINE rule251 #-}
+ {-# LINE 375 "src-ag/AG2AspectAG.ag" #-}
+ rule251 = \ ((_patternIinfo) :: (Identifier, Identifier)) ->
+ {-# LINE 375 "src-ag/AG2AspectAG.ag" #-}
+ if (show (fst _patternIinfo) == "loc")
+ then [ snd _patternIinfo ]
+ else [ ]
+ {-# LINE 2674 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule252 #-}
+ {-# LINE 472 "src-ag/AG2AspectAG.ag" #-}
+ rule252 = \ ((_lhsInewAtts) :: Attributes ) ((_lhsInewProd) :: Bool) ((_lhsIo_noGroup) :: [String]) ((_lhsIppNt) :: PP_Doc) ((_patternIinfo) :: (Identifier, Identifier)) ((_rhsIppRE) :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) explicit_ owrt_ ->
+ {-# LINE 472 "src-ag/AG2AspectAG.ag" #-}
+ if (not explicit_ && not _lhsInewProd && not (Map.member (snd _patternIinfo) _lhsInewAtts) )
+ then []
+ else [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIo_noGroup _rhsIppRE) ]
+ {-# LINE 2682 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule253 #-}
+ rule253 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule254 #-}
+ rule254 = \ ((_lhsIppProd) :: PP_Doc) ->
+ _lhsIppProd
+
+-- Rules -------------------------------------------------------
+-- wrapper
+data Inh_Rules = Inh_Rules { ext_Inh_Rules :: (Maybe String), inhNoGroup_Inh_Rules :: ([String]), newAtts_Inh_Rules :: ( Attributes ), newProd_Inh_Rules :: (Bool), o_noGroup_Inh_Rules :: ([String]), ppNt_Inh_Rules :: (PP_Doc), ppProd_Inh_Rules :: (PP_Doc), synNoGroup_Inh_Rules :: ([String]) }
+data Syn_Rules = Syn_Rules { locals_Syn_Rules :: ([Identifier]), ppRL_Syn_Rules :: ([ PPRule ]) }
+{-# INLINABLE wrap_Rules #-}
+wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules )
+wrap_Rules (T_Rules act) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg43 = T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
+ (T_Rules_vOut43 _lhsOlocals _lhsOppRL) <- return (inv_Rules_s44 sem arg43)
+ return (Syn_Rules _lhsOlocals _lhsOppRL)
+ )
+
+-- cata
+{-# NOINLINE sem_Rules #-}
+sem_Rules :: Rules -> T_Rules
+sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
+
+-- semantic domain
+newtype T_Rules = T_Rules {
+ attach_T_Rules :: Identity (T_Rules_s44 )
+ }
+newtype T_Rules_s44 = C_Rules_s44 {
+ inv_Rules_s44 :: (T_Rules_v43 )
+ }
+data T_Rules_s45 = C_Rules_s45
+type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 )
+data T_Rules_vIn43 = T_Rules_vIn43 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
+data T_Rules_vOut43 = T_Rules_vOut43 ([Identifier]) ([ PPRule ])
+{-# NOINLINE sem_Rules_Cons #-}
+sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
+sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where
+ {-# NOINLINE st44 #-}
+ st44 = let
+ v43 :: T_Rules_v43
+ v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
+ _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
+ _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
+ (T_Rule_vOut40 _hdIlocals _hdIppRL) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOext _hdOinhNoGroup _hdOnewAtts _hdOnewProd _hdOo_noGroup _hdOppNt _hdOppProd _hdOsynNoGroup)
+ (T_Rules_vOut43 _tlIlocals _tlIppRL) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOext _tlOinhNoGroup _tlOnewAtts _tlOnewProd _tlOo_noGroup _tlOppNt _tlOppProd _tlOsynNoGroup)
+ _lhsOppRL :: [ PPRule ]
+ _lhsOppRL = rule255 _hdIppRL _tlIppRL
+ _lhsOlocals :: [Identifier]
+ _lhsOlocals = rule256 _hdIlocals _tlIlocals
+ _hdOext = rule257 _lhsIext
+ _hdOinhNoGroup = rule258 _lhsIinhNoGroup
+ _hdOnewAtts = rule259 _lhsInewAtts
+ _hdOnewProd = rule260 _lhsInewProd
+ _hdOo_noGroup = rule261 _lhsIo_noGroup
+ _hdOppNt = rule262 _lhsIppNt
+ _hdOppProd = rule263 _lhsIppProd
+ _hdOsynNoGroup = rule264 _lhsIsynNoGroup
+ _tlOext = rule265 _lhsIext
+ _tlOinhNoGroup = rule266 _lhsIinhNoGroup
+ _tlOnewAtts = rule267 _lhsInewAtts
+ _tlOnewProd = rule268 _lhsInewProd
+ _tlOo_noGroup = rule269 _lhsIo_noGroup
+ _tlOppNt = rule270 _lhsIppNt
+ _tlOppProd = rule271 _lhsIppProd
+ _tlOsynNoGroup = rule272 _lhsIsynNoGroup
+ __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
+ in __result_ )
+ in C_Rules_s44 v43
+ {-# INLINE rule255 #-}
+ {-# LINE 468 "src-ag/AG2AspectAG.ag" #-}
+ rule255 = \ ((_hdIppRL) :: [ PPRule ]) ((_tlIppRL) :: [ PPRule ]) ->
+ {-# LINE 468 "src-ag/AG2AspectAG.ag" #-}
+ _hdIppRL ++ _tlIppRL
+ {-# LINE 2759 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule256 #-}
+ rule256 = \ ((_hdIlocals) :: [Identifier]) ((_tlIlocals) :: [Identifier]) ->
+ _hdIlocals ++ _tlIlocals
+ {-# INLINE rule257 #-}
+ rule257 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule258 #-}
+ rule258 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule259 #-}
+ rule259 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule260 #-}
+ rule260 = \ ((_lhsInewProd) :: Bool) ->
+ _lhsInewProd
+ {-# INLINE rule261 #-}
+ rule261 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule262 #-}
+ rule262 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule263 #-}
+ rule263 = \ ((_lhsIppProd) :: PP_Doc) ->
+ _lhsIppProd
+ {-# INLINE rule264 #-}
+ rule264 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+ {-# INLINE rule265 #-}
+ rule265 = \ ((_lhsIext) :: Maybe String) ->
+ _lhsIext
+ {-# INLINE rule266 #-}
+ rule266 = \ ((_lhsIinhNoGroup) :: [String]) ->
+ _lhsIinhNoGroup
+ {-# INLINE rule267 #-}
+ rule267 = \ ((_lhsInewAtts) :: Attributes ) ->
+ _lhsInewAtts
+ {-# INLINE rule268 #-}
+ rule268 = \ ((_lhsInewProd) :: Bool) ->
+ _lhsInewProd
+ {-# INLINE rule269 #-}
+ rule269 = \ ((_lhsIo_noGroup) :: [String]) ->
+ _lhsIo_noGroup
+ {-# INLINE rule270 #-}
+ rule270 = \ ((_lhsIppNt) :: PP_Doc) ->
+ _lhsIppNt
+ {-# INLINE rule271 #-}
+ rule271 = \ ((_lhsIppProd) :: PP_Doc) ->
+ _lhsIppProd
+ {-# INLINE rule272 #-}
+ rule272 = \ ((_lhsIsynNoGroup) :: [String]) ->
+ _lhsIsynNoGroup
+{-# NOINLINE sem_Rules_Nil #-}
+sem_Rules_Nil :: T_Rules
+sem_Rules_Nil = T_Rules (return st44) where
+ {-# NOINLINE st44 #-}
+ st44 = let
+ v43 :: T_Rules_v43
+ v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
+ _lhsOppRL :: [ PPRule ]
+ _lhsOppRL = rule273 ()
+ _lhsOlocals :: [Identifier]
+ _lhsOlocals = rule274 ()
+ __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
+ in __result_ )
+ in C_Rules_s44 v43
+ {-# INLINE rule273 #-}
+ {-# LINE 469 "src-ag/AG2AspectAG.ag" #-}
+ rule273 = \ (_ :: ()) ->
+ {-# LINE 469 "src-ag/AG2AspectAG.ag" #-}
+ []
+ {-# LINE 2830 "dist/build/AG2AspectAG.hs"#-}
+ {-# INLINE rule274 #-}
+ rule274 = \ (_ :: ()) ->
+ []
+
+-- TypeSig -----------------------------------------------------
+-- wrapper
+data Inh_TypeSig = Inh_TypeSig { }
+data Syn_TypeSig = Syn_TypeSig { }
+{-# INLINABLE wrap_TypeSig #-}
+wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
+wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg46 = T_TypeSig_vIn46
+ (T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg46)
+ return (Syn_TypeSig )
+ )
+
+-- cata
+{-# INLINE sem_TypeSig #-}
+sem_TypeSig :: TypeSig -> T_TypeSig
+sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
+
+-- semantic domain
+newtype T_TypeSig = T_TypeSig {
+ attach_T_TypeSig :: Identity (T_TypeSig_s47 )
+ }
+newtype T_TypeSig_s47 = C_TypeSig_s47 {
+ inv_TypeSig_s47 :: (T_TypeSig_v46 )
+ }
+data T_TypeSig_s48 = C_TypeSig_s48
+type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 )
+data T_TypeSig_vIn46 = T_TypeSig_vIn46
+data T_TypeSig_vOut46 = T_TypeSig_vOut46
+{-# NOINLINE sem_TypeSig_TypeSig #-}
+sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
+sem_TypeSig_TypeSig _ _ = T_TypeSig (return st47) where
+ {-# NOINLINE st47 #-}
+ st47 = let
+ v46 :: T_TypeSig_v46
+ v46 = \ (T_TypeSig_vIn46 ) -> ( let
+ __result_ = T_TypeSig_vOut46
+ in __result_ )
+ in C_TypeSig_s47 v46
+
+-- TypeSigs ----------------------------------------------------
+-- wrapper
+data Inh_TypeSigs = Inh_TypeSigs { }
+data Syn_TypeSigs = Syn_TypeSigs { }
+{-# INLINABLE wrap_TypeSigs #-}
+wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
+wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg49 = T_TypeSigs_vIn49
+ (T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg49)
+ return (Syn_TypeSigs )
+ )
+
+-- cata
+{-# NOINLINE sem_TypeSigs #-}
+sem_TypeSigs :: TypeSigs -> T_TypeSigs
+sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
+
+-- semantic domain
+newtype T_TypeSigs = T_TypeSigs {
+ attach_T_TypeSigs :: Identity (T_TypeSigs_s50 )
+ }
+newtype T_TypeSigs_s50 = C_TypeSigs_s50 {
+ inv_TypeSigs_s50 :: (T_TypeSigs_v49 )
+ }
+data T_TypeSigs_s51 = C_TypeSigs_s51
+type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 )
+data T_TypeSigs_vIn49 = T_TypeSigs_vIn49
+data T_TypeSigs_vOut49 = T_TypeSigs_vOut49
+{-# NOINLINE sem_TypeSigs_Cons #-}
+sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
+sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where
+ {-# NOINLINE st50 #-}
+ st50 = let
+ v49 :: T_TypeSigs_v49
+ v49 = \ (T_TypeSigs_vIn49 ) -> ( let
+ _hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
+ _tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
+ (T_TypeSig_vOut46 ) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 )
+ (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 )
+ __result_ = T_TypeSigs_vOut49
+ in __result_ )
+ in C_TypeSigs_s50 v49
+{-# NOINLINE sem_TypeSigs_Nil #-}
+sem_TypeSigs_Nil :: T_TypeSigs
+sem_TypeSigs_Nil = T_TypeSigs (return st50) where
+ {-# NOINLINE st50 #-}
+ st50 = let
+ v49 :: T_TypeSigs_v49
+ v49 = \ (T_TypeSigs_vIn49 ) -> ( let
+ __result_ = T_TypeSigs_vOut49
+ in __result_ )
+ in C_TypeSigs_s50 v49
diff --git a/src-generated/AbstractSyntax.hs b/src-generated/AbstractSyntax.hs
index 5f74f59..d918729 100644..100755
--- a/src-generated/AbstractSyntax.hs
+++ b/src-generated/AbstractSyntax.hs
@@ -1,137 +1,137 @@
-
-
--- UUAGC 0.9.51 (src-ag/AbstractSyntax.ag)
-module AbstractSyntax where
-{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
-
--- AbstractSyntax.ag imports
-import Data.Set(Set)
-import Data.Map(Map)
-import Patterns (Pattern(..),Patterns)
-import Expression (Expression(..))
-import Macro --marcos
-import CommonTypes
-import ErrorMessages
-{-# LINE 16 "dist/build/AbstractSyntax.hs" #-}
--- Child -------------------------------------------------------
-{-
- alternatives:
- alternative Child:
- child name : {Identifier}
- child tp : {Type}
- child kind : {ChildKind}
--}
-data Child = Child (Identifier) (Type) (ChildKind)
--- Children ----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Child
- child tl : Children
- alternative Nil:
--}
-type Children = [Child]
--- Grammar -----------------------------------------------------
-{-
- alternatives:
- alternative Grammar:
- child typeSyns : {TypeSyns}
- child useMap : {UseMap}
- child derivings : {Derivings}
- child wrappers : {Set NontermIdent}
- child nonts : Nonterminals
- child pragmas : {PragmaMap}
- child manualAttrOrderMap : {AttrOrderMap}
- child paramMap : {ParamMap}
- child contextMap : {ContextMap}
- child quantMap : {QuantMap}
- child uniqueMap : {UniqueMap}
- child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
- child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
- child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))}
--}
-data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) ((Set NontermIdent)) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (QuantMap) (UniqueMap) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))))
--- Nonterminal -------------------------------------------------
-{-
- alternatives:
- alternative Nonterminal:
- child nt : {NontermIdent}
- child params : {[Identifier]}
- child inh : {Attributes}
- child syn : {Attributes}
- child prods : Productions
--}
-data Nonterminal = Nonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (Productions)
--- Nonterminals ------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Nonterminal
- child tl : Nonterminals
- alternative Nil:
--}
-type Nonterminals = [Nonterminal]
--- Production --------------------------------------------------
-{-
- alternatives:
- alternative Production:
- child con : {ConstructorIdent}
- child params : {[Identifier]}
- child constraints : {[Type]}
- child children : Children
- child rules : Rules
- child typeSigs : TypeSigs
- child macro : {MaybeMacro}
--}
-data Production = Production (ConstructorIdent) (([Identifier])) (([Type])) (Children) (Rules) (TypeSigs) (MaybeMacro)
--- Productions -------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Production
- child tl : Productions
- alternative Nil:
--}
-type Productions = [Production]
--- Rule --------------------------------------------------------
-{-
- alternatives:
- alternative Rule:
- child mbName : {Maybe Identifier}
- child pattern : {Pattern}
- child rhs : {Expression}
- child owrt : {Bool}
- child origin : {String}
- child explicit : {Bool}
- child pure : {Bool}
- child identity : {Bool}
- child mbError : {Maybe Error}
- child eager : {Bool}
--}
-data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) (Bool) ((Maybe Error)) (Bool)
--- Rules -------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Rule
- child tl : Rules
- alternative Nil:
--}
-type Rules = [Rule]
--- TypeSig -----------------------------------------------------
-{-
- alternatives:
- alternative TypeSig:
- child name : {Identifier}
- child tp : {Type}
--}
-data TypeSig = TypeSig (Identifier) (Type)
--- TypeSigs ----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : TypeSig
- child tl : TypeSigs
- alternative Nil:
--}
+
+
+-- UUAGC 0.9.51 (src-ag/AbstractSyntax.ag)
+module AbstractSyntax where
+{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
+
+-- AbstractSyntax.ag imports
+import Data.Set(Set)
+import Data.Map(Map)
+import Patterns (Pattern(..),Patterns)
+import Expression (Expression(..))
+import Macro --marcos
+import CommonTypes
+import ErrorMessages
+{-# LINE 16 "dist/build/AbstractSyntax.hs" #-}
+-- Child -------------------------------------------------------
+{-
+ alternatives:
+ alternative Child:
+ child name : {Identifier}
+ child tp : {Type}
+ child kind : {ChildKind}
+-}
+data Child = Child (Identifier) (Type) (ChildKind)
+-- Children ----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Child
+ child tl : Children
+ alternative Nil:
+-}
+type Children = [Child]
+-- Grammar -----------------------------------------------------
+{-
+ alternatives:
+ alternative Grammar:
+ child typeSyns : {TypeSyns}
+ child useMap : {UseMap}
+ child derivings : {Derivings}
+ child wrappers : {Set NontermIdent}
+ child nonts : Nonterminals
+ child pragmas : {PragmaMap}
+ child manualAttrOrderMap : {AttrOrderMap}
+ child paramMap : {ParamMap}
+ child contextMap : {ContextMap}
+ child quantMap : {QuantMap}
+ child uniqueMap : {UniqueMap}
+ child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
+ child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
+ child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))}
+-}
+data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) ((Set NontermIdent)) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (QuantMap) (UniqueMap) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))))
+-- Nonterminal -------------------------------------------------
+{-
+ alternatives:
+ alternative Nonterminal:
+ child nt : {NontermIdent}
+ child params : {[Identifier]}
+ child inh : {Attributes}
+ child syn : {Attributes}
+ child prods : Productions
+-}
+data Nonterminal = Nonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (Productions)
+-- Nonterminals ------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Nonterminal
+ child tl : Nonterminals
+ alternative Nil:
+-}
+type Nonterminals = [Nonterminal]
+-- Production --------------------------------------------------
+{-
+ alternatives:
+ alternative Production:
+ child con : {ConstructorIdent}
+ child params : {[Identifier]}
+ child constraints : {[Type]}
+ child children : Children
+ child rules : Rules
+ child typeSigs : TypeSigs
+ child macro : {MaybeMacro}
+-}
+data Production = Production (ConstructorIdent) (([Identifier])) (([Type])) (Children) (Rules) (TypeSigs) (MaybeMacro)
+-- Productions -------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Production
+ child tl : Productions
+ alternative Nil:
+-}
+type Productions = [Production]
+-- Rule --------------------------------------------------------
+{-
+ alternatives:
+ alternative Rule:
+ child mbName : {Maybe Identifier}
+ child pattern : {Pattern}
+ child rhs : {Expression}
+ child owrt : {Bool}
+ child origin : {String}
+ child explicit : {Bool}
+ child pure : {Bool}
+ child identity : {Bool}
+ child mbError : {Maybe Error}
+ child eager : {Bool}
+-}
+data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) (Bool) ((Maybe Error)) (Bool)
+-- Rules -------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Rule
+ child tl : Rules
+ alternative Nil:
+-}
+type Rules = [Rule]
+-- TypeSig -----------------------------------------------------
+{-
+ alternatives:
+ alternative TypeSig:
+ child name : {Identifier}
+ child tp : {Type}
+-}
+data TypeSig = TypeSig (Identifier) (Type)
+-- TypeSigs ----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : TypeSig
+ child tl : TypeSigs
+ alternative Nil:
+-}
type TypeSigs = [TypeSig] \ No newline at end of file
diff --git a/src-generated/AbstractSyntaxDump.hs b/src-generated/AbstractSyntaxDump.hs
index ee3b208..5ff1f4b 100644..100755
--- a/src-generated/AbstractSyntaxDump.hs
+++ b/src-generated/AbstractSyntaxDump.hs
@@ -1,1083 +1,1083 @@
-{-# LANGUAGE Rank2Types, GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module AbstractSyntaxDump where
-{-# LINE 2 "src-ag/Expression.ag" #-}
-
-import UU.Scanner.Position(Pos)
-import HsToken
-{-# LINE 10 "dist/build/AbstractSyntaxDump.hs" #-}
-
-{-# LINE 2 "src-ag/Patterns.ag" #-}
-
--- Patterns.ag imports
-import UU.Scanner.Position(Pos)
-import CommonTypes (ConstructorIdent,Identifier)
-{-# LINE 17 "dist/build/AbstractSyntaxDump.hs" #-}
-
-{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
-
--- AbstractSyntax.ag imports
-import Data.Set(Set)
-import Data.Map(Map)
-import Patterns (Pattern(..),Patterns)
-import Expression (Expression(..))
-import Macro --marcos
-import CommonTypes
-import ErrorMessages
-{-# LINE 29 "dist/build/AbstractSyntaxDump.hs" #-}
-
-{-# LINE 6 "src-ag/AbstractSyntaxDump.ag" #-}
-
-import Data.List
-import qualified Data.Map as Map
-
-import Pretty
-import PPUtil
-
-import AbstractSyntax
-import TokenDef
-{-# LINE 41 "dist/build/AbstractSyntaxDump.hs" #-}
-import Control.Monad.Identity (Identity)
-import qualified Control.Monad.Identity
--- Child -------------------------------------------------------
--- wrapper
-data Inh_Child = Inh_Child { }
-data Syn_Child = Syn_Child { pp_Syn_Child :: (PP_Doc) }
-{-# INLINABLE wrap_Child #-}
-wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
-wrap_Child (T_Child act) (Inh_Child ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg1 = T_Child_vIn1
- (T_Child_vOut1 _lhsOpp) <- return (inv_Child_s2 sem arg1)
- return (Syn_Child _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Child #-}
-sem_Child :: Child -> T_Child
-sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
-
--- semantic domain
-newtype T_Child = T_Child {
- attach_T_Child :: Identity (T_Child_s2 )
- }
-newtype T_Child_s2 = C_Child_s2 {
- inv_Child_s2 :: (T_Child_v1 )
- }
-data T_Child_s3 = C_Child_s3
-type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
-data T_Child_vIn1 = T_Child_vIn1
-data T_Child_vOut1 = T_Child_vOut1 (PP_Doc)
-{-# NOINLINE sem_Child_Child #-}
-sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
-sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where
- {-# NOINLINE st2 #-}
- st2 = let
- v1 :: T_Child_v1
- v1 = \ (T_Child_vIn1 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule0 arg_kind_ arg_name_ arg_tp_
- __result_ = T_Child_vOut1 _lhsOpp
- in __result_ )
- in C_Child_s2 v1
- {-# INLINE rule0 #-}
- {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-}
- rule0 = \ kind_ name_ tp_ ->
- {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "kind" $ ppShow kind_] []
- {-# LINE 91 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Children ----------------------------------------------------
--- wrapper
-data Inh_Children = Inh_Children { }
-data Syn_Children = Syn_Children { pp_Syn_Children :: (PP_Doc), ppL_Syn_Children :: ([PP_Doc]) }
-{-# INLINABLE wrap_Children #-}
-wrap_Children :: T_Children -> Inh_Children -> (Syn_Children )
-wrap_Children (T_Children act) (Inh_Children ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg4 = T_Children_vIn4
- (T_Children_vOut4 _lhsOpp _lhsOppL) <- return (inv_Children_s5 sem arg4)
- return (Syn_Children _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Children #-}
-sem_Children :: Children -> T_Children
-sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
-
--- semantic domain
-newtype T_Children = T_Children {
- attach_T_Children :: Identity (T_Children_s5 )
- }
-newtype T_Children_s5 = C_Children_s5 {
- inv_Children_s5 :: (T_Children_v4 )
- }
-data T_Children_s6 = C_Children_s6
-type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
-data T_Children_vIn4 = T_Children_vIn4
-data T_Children_vOut4 = T_Children_vOut4 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Children_Cons #-}
-sem_Children_Cons :: T_Child -> T_Children -> T_Children
-sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
- {-# NOINLINE st5 #-}
- st5 = let
- v4 :: T_Children_v4
- v4 = \ (T_Children_vIn4 ) -> ( let
- _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
- _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
- (T_Child_vOut1 _hdIpp) = inv_Child_s2 _hdX2 (T_Child_vIn1 )
- (T_Children_vOut4 _tlIpp _tlIppL) = inv_Children_s5 _tlX5 (T_Children_vIn4 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule1 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule2 _hdIpp _tlIpp
- __result_ = T_Children_vOut4 _lhsOpp _lhsOppL
- in __result_ )
- in C_Children_s5 v4
- {-# INLINE rule1 #-}
- {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-}
- rule1 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 146 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule2 #-}
- rule2 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_Children_Nil #-}
-sem_Children_Nil :: T_Children
-sem_Children_Nil = T_Children (return st5) where
- {-# NOINLINE st5 #-}
- st5 = let
- v4 :: T_Children_v4
- v4 = \ (T_Children_vIn4 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule3 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule4 ()
- __result_ = T_Children_vOut4 _lhsOpp _lhsOppL
- in __result_ )
- in C_Children_s5 v4
- {-# INLINE rule3 #-}
- {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-}
- rule3 = \ (_ :: ()) ->
- {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 169 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule4 #-}
- rule4 = \ (_ :: ()) ->
- empty
-
--- Expression --------------------------------------------------
--- wrapper
-data Inh_Expression = Inh_Expression { }
-data Syn_Expression = Syn_Expression { pp_Syn_Expression :: (PP_Doc) }
-{-# INLINABLE wrap_Expression #-}
-wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression )
-wrap_Expression (T_Expression act) (Inh_Expression ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg7 = T_Expression_vIn7
- (T_Expression_vOut7 _lhsOpp) <- return (inv_Expression_s8 sem arg7)
- return (Syn_Expression _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Expression #-}
-sem_Expression :: Expression -> T_Expression
-sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
-
--- semantic domain
-newtype T_Expression = T_Expression {
- attach_T_Expression :: Identity (T_Expression_s8 )
- }
-newtype T_Expression_s8 = C_Expression_s8 {
- inv_Expression_s8 :: (T_Expression_v7 )
- }
-data T_Expression_s9 = C_Expression_s9
-type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
-data T_Expression_vIn7 = T_Expression_vIn7
-data T_Expression_vOut7 = T_Expression_vOut7 (PP_Doc)
-{-# NOINLINE sem_Expression_Expression #-}
-sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
-sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where
- {-# NOINLINE st8 #-}
- st8 = let
- v7 :: T_Expression_v7
- v7 = \ (T_Expression_vIn7 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule5 arg_pos_ arg_tks_
- __result_ = T_Expression_vOut7 _lhsOpp
- in __result_ )
- in C_Expression_s8 v7
- {-# INLINE rule5 #-}
- {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-}
- rule5 = \ pos_ tks_ ->
- {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] []
- {-# LINE 221 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Grammar -----------------------------------------------------
--- wrapper
-data Inh_Grammar = Inh_Grammar { }
-data Syn_Grammar = Syn_Grammar { pp_Syn_Grammar :: (PP_Doc) }
-{-# INLINABLE wrap_Grammar #-}
-wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar )
-wrap_Grammar (T_Grammar act) (Inh_Grammar ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg10 = T_Grammar_vIn10
- (T_Grammar_vOut10 _lhsOpp) <- return (inv_Grammar_s11 sem arg10)
- return (Syn_Grammar _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Grammar #-}
-sem_Grammar :: Grammar -> T_Grammar
-sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
-
--- semantic domain
-newtype T_Grammar = T_Grammar {
- attach_T_Grammar :: Identity (T_Grammar_s11 )
- }
-newtype T_Grammar_s11 = C_Grammar_s11 {
- inv_Grammar_s11 :: (T_Grammar_v10 )
- }
-data T_Grammar_s12 = C_Grammar_s12
-type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
-data T_Grammar_vIn10 = T_Grammar_vIn10
-data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc)
-{-# NOINLINE sem_Grammar_Grammar #-}
-sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar
-sem_Grammar_Grammar arg_typeSyns_ arg_useMap_ arg_derivings_ arg_wrappers_ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
- {-# NOINLINE st11 #-}
- st11 = let
- v10 :: T_Grammar_v10
- v10 = \ (T_Grammar_vIn10 ) -> ( let
- _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
- (T_Nonterminals_vOut16 _nontsIpp _nontsIppL) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule6 _nontsIppL arg_derivings_ arg_typeSyns_ arg_useMap_ arg_wrappers_
- __result_ = T_Grammar_vOut10 _lhsOpp
- in __result_ )
- in C_Grammar_s11 v10
- {-# INLINE rule6 #-}
- {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-}
- rule6 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ useMap_ wrappers_ ->
- {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Grammar","Grammar"] []
- [ ppF "typeSyns" $ ppAssocL typeSyns_
- , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_
- , ppF "derivings" $ ppMap $ derivings_
- , ppF "wrappers" $ ppShow $ wrappers_
- , ppF "nonts" $ ppVList _nontsIppL
- ] []
- {-# LINE 278 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Nonterminal -------------------------------------------------
--- wrapper
-data Inh_Nonterminal = Inh_Nonterminal { }
-data Syn_Nonterminal = Syn_Nonterminal { pp_Syn_Nonterminal :: (PP_Doc) }
-{-# INLINABLE wrap_Nonterminal #-}
-wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal )
-wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg13 = T_Nonterminal_vIn13
- (T_Nonterminal_vOut13 _lhsOpp) <- return (inv_Nonterminal_s14 sem arg13)
- return (Syn_Nonterminal _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Nonterminal #-}
-sem_Nonterminal :: Nonterminal -> T_Nonterminal
-sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
-
--- semantic domain
-newtype T_Nonterminal = T_Nonterminal {
- attach_T_Nonterminal :: Identity (T_Nonterminal_s14 )
- }
-newtype T_Nonterminal_s14 = C_Nonterminal_s14 {
- inv_Nonterminal_s14 :: (T_Nonterminal_v13 )
- }
-data T_Nonterminal_s15 = C_Nonterminal_s15
-type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 )
-data T_Nonterminal_vIn13 = T_Nonterminal_vIn13
-data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (PP_Doc)
-{-# NOINLINE sem_Nonterminal_Nonterminal #-}
-sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
-sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_Nonterminal_v13
- v13 = \ (T_Nonterminal_vIn13 ) -> ( let
- _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
- (T_Productions_vOut28 _prodsIpp _prodsIppL) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule7 _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_
- __result_ = T_Nonterminal_vOut13 _lhsOpp
- in __result_ )
- in C_Nonterminal_s14 v13
- {-# INLINE rule7 #-}
- {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-}
- rule7 = \ ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ ->
- {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] []
- {-# LINE 329 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Nonterminals ------------------------------------------------
--- wrapper
-data Inh_Nonterminals = Inh_Nonterminals { }
-data Syn_Nonterminals = Syn_Nonterminals { pp_Syn_Nonterminals :: (PP_Doc), ppL_Syn_Nonterminals :: ([PP_Doc]) }
-{-# INLINABLE wrap_Nonterminals #-}
-wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals )
-wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg16 = T_Nonterminals_vIn16
- (T_Nonterminals_vOut16 _lhsOpp _lhsOppL) <- return (inv_Nonterminals_s17 sem arg16)
- return (Syn_Nonterminals _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Nonterminals #-}
-sem_Nonterminals :: Nonterminals -> T_Nonterminals
-sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
-
--- semantic domain
-newtype T_Nonterminals = T_Nonterminals {
- attach_T_Nonterminals :: Identity (T_Nonterminals_s17 )
- }
-newtype T_Nonterminals_s17 = C_Nonterminals_s17 {
- inv_Nonterminals_s17 :: (T_Nonterminals_v16 )
- }
-data T_Nonterminals_s18 = C_Nonterminals_s18
-type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 )
-data T_Nonterminals_vIn16 = T_Nonterminals_vIn16
-data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Nonterminals_Cons #-}
-sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
-sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_Nonterminals_v16
- v16 = \ (T_Nonterminals_vIn16 ) -> ( let
- _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
- _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
- (T_Nonterminal_vOut13 _hdIpp) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 )
- (T_Nonterminals_vOut16 _tlIpp _tlIppL) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule8 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule9 _hdIpp _tlIpp
- __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL
- in __result_ )
- in C_Nonterminals_s17 v16
- {-# INLINE rule8 #-}
- {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-}
- rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 384 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule9 #-}
- rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_Nonterminals_Nil #-}
-sem_Nonterminals_Nil :: T_Nonterminals
-sem_Nonterminals_Nil = T_Nonterminals (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_Nonterminals_v16
- v16 = \ (T_Nonterminals_vIn16 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule10 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule11 ()
- __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL
- in __result_ )
- in C_Nonterminals_s17 v16
- {-# INLINE rule10 #-}
- {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-}
- rule10 = \ (_ :: ()) ->
- {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 407 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule11 #-}
- rule11 = \ (_ :: ()) ->
- empty
-
--- Pattern -----------------------------------------------------
--- wrapper
-data Inh_Pattern = Inh_Pattern { }
-data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) }
-{-# INLINABLE wrap_Pattern #-}
-wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
-wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg19 = T_Pattern_vIn19
- (T_Pattern_vOut19 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s20 sem arg19)
- return (Syn_Pattern _lhsOcopy _lhsOpp)
- )
-
--- cata
-{-# NOINLINE sem_Pattern #-}
-sem_Pattern :: Pattern -> T_Pattern
-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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
-sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
-sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
-
--- semantic domain
-newtype T_Pattern = T_Pattern {
- attach_T_Pattern :: Identity (T_Pattern_s20 )
- }
-newtype T_Pattern_s20 = C_Pattern_s20 {
- inv_Pattern_s20 :: (T_Pattern_v19 )
- }
-data T_Pattern_s21 = C_Pattern_s21
-type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 )
-data T_Pattern_vIn19 = T_Pattern_vIn19
-data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) (PP_Doc)
-{-# NOINLINE sem_Pattern_Constr #-}
-sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
-sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_Pattern_v19
- v19 = \ (T_Pattern_vIn19 ) -> ( let
- _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule12 _patsIppL arg_name_
- _copy = rule13 _patsIcopy arg_name_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule14 _copy
- __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s20 v19
- {-# INLINE rule12 #-}
- {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-}
- rule12 = \ ((_patsIppL) :: [PP_Doc]) name_ ->
- {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []
- {-# LINE 468 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule13 #-}
- rule13 = \ ((_patsIcopy) :: Patterns) name_ ->
- Constr name_ _patsIcopy
- {-# INLINE rule14 #-}
- rule14 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Product #-}
-sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
-sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_Pattern_v19
- v19 = \ (T_Pattern_vIn19 ) -> ( let
- _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule15 _patsIppL arg_pos_
- _copy = rule16 _patsIcopy arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule17 _copy
- __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s20 v19
- {-# INLINE rule15 #-}
- {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-}
- rule15 = \ ((_patsIppL) :: [PP_Doc]) pos_ ->
- {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []
- {-# LINE 497 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule16 #-}
- rule16 = \ ((_patsIcopy) :: Patterns) pos_ ->
- Product pos_ _patsIcopy
- {-# INLINE rule17 #-}
- rule17 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Alias #-}
-sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
-sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_Pattern_v19
- v19 = \ (T_Pattern_vIn19 ) -> ( let
- _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule18 _patIpp arg_attr_ arg_field_
- _copy = rule19 _patIcopy arg_attr_ arg_field_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule20 _copy
- __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s20 v19
- {-# INLINE rule18 #-}
- {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-}
- rule18 = \ ((_patIpp) :: PP_Doc) attr_ field_ ->
- {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []
- {-# LINE 526 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule19 #-}
- rule19 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
- Alias field_ attr_ _patIcopy
- {-# INLINE rule20 #-}
- rule20 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Irrefutable #-}
-sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
-sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_Pattern_v19
- v19 = \ (T_Pattern_vIn19 ) -> ( let
- _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule21 _patIpp
- _copy = rule22 _patIcopy
- _lhsOcopy :: Pattern
- _lhsOcopy = rule23 _copy
- __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s20 v19
- {-# INLINE rule21 #-}
- rule21 = \ ((_patIpp) :: PP_Doc) ->
- _patIpp
- {-# INLINE rule22 #-}
- rule22 = \ ((_patIcopy) :: Pattern) ->
- Irrefutable _patIcopy
- {-# INLINE rule23 #-}
- rule23 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Underscore #-}
-sem_Pattern_Underscore :: (Pos) -> T_Pattern
-sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_Pattern_v19
- v19 = \ (T_Pattern_vIn19 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule24 arg_pos_
- _copy = rule25 arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule26 _copy
- __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s20 v19
- {-# INLINE rule24 #-}
- {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-}
- rule24 = \ pos_ ->
- {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []
- {-# LINE 579 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule25 #-}
- rule25 = \ pos_ ->
- Underscore pos_
- {-# INLINE rule26 #-}
- rule26 = \ _copy ->
- _copy
-
--- Patterns ----------------------------------------------------
--- wrapper
-data Inh_Patterns = Inh_Patterns { }
-data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) }
-{-# INLINABLE wrap_Patterns #-}
-wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
-wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg22 = T_Patterns_vIn22
- (T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s23 sem arg22)
- return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Patterns #-}
-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 {
- attach_T_Patterns :: Identity (T_Patterns_s23 )
- }
-newtype T_Patterns_s23 = C_Patterns_s23 {
- inv_Patterns_s23 :: (T_Patterns_v22 )
- }
-data T_Patterns_s24 = C_Patterns_s24
-type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 )
-data T_Patterns_vIn22 = T_Patterns_vIn22
-data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Patterns_Cons #-}
-sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
-sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where
- {-# NOINLINE st23 #-}
- st23 = let
- v22 :: T_Patterns_v22
- v22 = \ (T_Patterns_vIn22 ) -> ( let
- _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
- _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
- (T_Pattern_vOut19 _hdIcopy _hdIpp) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 )
- (T_Patterns_vOut22 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule27 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule28 _hdIpp _tlIpp
- _copy = rule29 _hdIcopy _tlIcopy
- _lhsOcopy :: Patterns
- _lhsOcopy = rule30 _copy
- __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL
- in __result_ )
- in C_Patterns_s23 v22
- {-# INLINE rule27 #-}
- {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-}
- rule27 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 643 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule28 #-}
- rule28 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
- {-# INLINE rule29 #-}
- rule29 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
- (:) _hdIcopy _tlIcopy
- {-# INLINE rule30 #-}
- rule30 = \ _copy ->
- _copy
-{-# NOINLINE sem_Patterns_Nil #-}
-sem_Patterns_Nil :: T_Patterns
-sem_Patterns_Nil = T_Patterns (return st23) where
- {-# NOINLINE st23 #-}
- st23 = let
- v22 :: T_Patterns_v22
- v22 = \ (T_Patterns_vIn22 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule31 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule32 ()
- _copy = rule33 ()
- _lhsOcopy :: Patterns
- _lhsOcopy = rule34 _copy
- __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL
- in __result_ )
- in C_Patterns_s23 v22
- {-# INLINE rule31 #-}
- {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-}
- rule31 = \ (_ :: ()) ->
- {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 675 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule32 #-}
- rule32 = \ (_ :: ()) ->
- empty
- {-# INLINE rule33 #-}
- rule33 = \ (_ :: ()) ->
- []
- {-# INLINE rule34 #-}
- rule34 = \ _copy ->
- _copy
-
--- Production --------------------------------------------------
--- wrapper
-data Inh_Production = Inh_Production { }
-data Syn_Production = Syn_Production { pp_Syn_Production :: (PP_Doc) }
-{-# INLINABLE wrap_Production #-}
-wrap_Production :: T_Production -> Inh_Production -> (Syn_Production )
-wrap_Production (T_Production act) (Inh_Production ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg25 = T_Production_vIn25
- (T_Production_vOut25 _lhsOpp) <- return (inv_Production_s26 sem arg25)
- return (Syn_Production _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Production #-}
-sem_Production :: Production -> T_Production
-sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_
-
--- semantic domain
-newtype T_Production = T_Production {
- attach_T_Production :: Identity (T_Production_s26 )
- }
-newtype T_Production_s26 = C_Production_s26 {
- inv_Production_s26 :: (T_Production_v25 )
- }
-data T_Production_s27 = C_Production_s27
-type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 )
-data T_Production_vIn25 = T_Production_vIn25
-data T_Production_vOut25 = T_Production_vOut25 (PP_Doc)
-{-# NOINLINE sem_Production_Production #-}
-sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
-sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where
- {-# NOINLINE st26 #-}
- st26 = let
- v25 :: T_Production_v25
- v25 = \ (T_Production_vIn25 ) -> ( let
- _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
- _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
- _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
- (T_Children_vOut4 _childrenIpp _childrenIppL) = inv_Children_s5 _childrenX5 (T_Children_vIn4 )
- (T_Rules_vOut34 _rulesIpp _rulesIppL) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 )
- (T_TypeSigs_vOut40 _typeSigsIpp _typeSigsIppL) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule35 _childrenIppL _rulesIppL _typeSigsIppL arg_con_
- __result_ = T_Production_vOut25 _lhsOpp
- in __result_ )
- in C_Production_s26 v25
- {-# INLINE rule35 #-}
- {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-}
- rule35 = \ ((_childrenIppL) :: [PP_Doc]) ((_rulesIppL) :: [PP_Doc]) ((_typeSigsIppL) :: [PP_Doc]) con_ ->
- {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] []
- {-# LINE 739 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Productions -------------------------------------------------
--- wrapper
-data Inh_Productions = Inh_Productions { }
-data Syn_Productions = Syn_Productions { pp_Syn_Productions :: (PP_Doc), ppL_Syn_Productions :: ([PP_Doc]) }
-{-# INLINABLE wrap_Productions #-}
-wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions )
-wrap_Productions (T_Productions act) (Inh_Productions ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg28 = T_Productions_vIn28
- (T_Productions_vOut28 _lhsOpp _lhsOppL) <- return (inv_Productions_s29 sem arg28)
- return (Syn_Productions _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Productions #-}
-sem_Productions :: Productions -> T_Productions
-sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
-
--- semantic domain
-newtype T_Productions = T_Productions {
- attach_T_Productions :: Identity (T_Productions_s29 )
- }
-newtype T_Productions_s29 = C_Productions_s29 {
- inv_Productions_s29 :: (T_Productions_v28 )
- }
-data T_Productions_s30 = C_Productions_s30
-type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 )
-data T_Productions_vIn28 = T_Productions_vIn28
-data T_Productions_vOut28 = T_Productions_vOut28 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Productions_Cons #-}
-sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
-sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Productions_v28
- v28 = \ (T_Productions_vIn28 ) -> ( let
- _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
- _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
- (T_Production_vOut25 _hdIpp) = inv_Production_s26 _hdX26 (T_Production_vIn25 )
- (T_Productions_vOut28 _tlIpp _tlIppL) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule36 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule37 _hdIpp _tlIpp
- __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL
- in __result_ )
- in C_Productions_s29 v28
- {-# INLINE rule36 #-}
- {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-}
- rule36 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 794 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule37 #-}
- rule37 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_Productions_Nil #-}
-sem_Productions_Nil :: T_Productions
-sem_Productions_Nil = T_Productions (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_Productions_v28
- v28 = \ (T_Productions_vIn28 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule38 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule39 ()
- __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL
- in __result_ )
- in C_Productions_s29 v28
- {-# INLINE rule38 #-}
- {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-}
- rule38 = \ (_ :: ()) ->
- {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 817 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule39 #-}
- rule39 = \ (_ :: ()) ->
- empty
-
--- Rule --------------------------------------------------------
--- wrapper
-data Inh_Rule = Inh_Rule { }
-data Syn_Rule = Syn_Rule { pp_Syn_Rule :: (PP_Doc) }
-{-# INLINABLE wrap_Rule #-}
-wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule )
-wrap_Rule (T_Rule act) (Inh_Rule ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg31 = T_Rule_vIn31
- (T_Rule_vOut31 _lhsOpp) <- return (inv_Rule_s32 sem arg31)
- return (Syn_Rule _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_Rule #-}
-sem_Rule :: Rule -> T_Rule
-sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
-
--- semantic domain
-newtype T_Rule = T_Rule {
- attach_T_Rule :: Identity (T_Rule_s32 )
- }
-newtype T_Rule_s32 = C_Rule_s32 {
- inv_Rule_s32 :: (T_Rule_v31 )
- }
-data T_Rule_s33 = C_Rule_s33
-type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 )
-data T_Rule_vIn31 = T_Rule_vIn31
-data T_Rule_vOut31 = T_Rule_vOut31 (PP_Doc)
-{-# NOINLINE sem_Rule_Rule #-}
-sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
-sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ _ _ _ _ _ = T_Rule (return st32) where
- {-# NOINLINE st32 #-}
- st32 = let
- v31 :: T_Rule_v31
- v31 = \ (T_Rule_vIn31 ) -> ( let
- _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
- _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
- (T_Pattern_vOut19 _patternIcopy _patternIpp) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 )
- (T_Expression_vOut7 _rhsIpp) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule40 _patternIpp _rhsIpp arg_origin_ arg_owrt_
- __result_ = T_Rule_vOut31 _lhsOpp
- in __result_ )
- in C_Rule_s32 v31
- {-# INLINE rule40 #-}
- {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-}
- rule40 = \ ((_patternIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) origin_ owrt_ ->
- {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] []
- {-# LINE 873 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- Rules -------------------------------------------------------
--- wrapper
-data Inh_Rules = Inh_Rules { }
-data Syn_Rules = Syn_Rules { pp_Syn_Rules :: (PP_Doc), ppL_Syn_Rules :: ([PP_Doc]) }
-{-# INLINABLE wrap_Rules #-}
-wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules )
-wrap_Rules (T_Rules act) (Inh_Rules ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg34 = T_Rules_vIn34
- (T_Rules_vOut34 _lhsOpp _lhsOppL) <- return (inv_Rules_s35 sem arg34)
- return (Syn_Rules _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Rules #-}
-sem_Rules :: Rules -> T_Rules
-sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
-
--- semantic domain
-newtype T_Rules = T_Rules {
- attach_T_Rules :: Identity (T_Rules_s35 )
- }
-newtype T_Rules_s35 = C_Rules_s35 {
- inv_Rules_s35 :: (T_Rules_v34 )
- }
-data T_Rules_s36 = C_Rules_s36
-type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 )
-data T_Rules_vIn34 = T_Rules_vIn34
-data T_Rules_vOut34 = T_Rules_vOut34 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Rules_Cons #-}
-sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
-sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Rules_v34
- v34 = \ (T_Rules_vIn34 ) -> ( let
- _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
- _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
- (T_Rule_vOut31 _hdIpp) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 )
- (T_Rules_vOut34 _tlIpp _tlIppL) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule41 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule42 _hdIpp _tlIpp
- __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL
- in __result_ )
- in C_Rules_s35 v34
- {-# INLINE rule41 #-}
- {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-}
- rule41 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 928 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule42 #-}
- rule42 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_Rules_Nil #-}
-sem_Rules_Nil :: T_Rules
-sem_Rules_Nil = T_Rules (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Rules_v34
- v34 = \ (T_Rules_vIn34 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule43 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule44 ()
- __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL
- in __result_ )
- in C_Rules_s35 v34
- {-# INLINE rule43 #-}
- {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-}
- rule43 = \ (_ :: ()) ->
- {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 951 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule44 #-}
- rule44 = \ (_ :: ()) ->
- empty
-
--- TypeSig -----------------------------------------------------
--- wrapper
-data Inh_TypeSig = Inh_TypeSig { }
-data Syn_TypeSig = Syn_TypeSig { pp_Syn_TypeSig :: (PP_Doc) }
-{-# INLINABLE wrap_TypeSig #-}
-wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
-wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg37 = T_TypeSig_vIn37
- (T_TypeSig_vOut37 _lhsOpp) <- return (inv_TypeSig_s38 sem arg37)
- return (Syn_TypeSig _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_TypeSig #-}
-sem_TypeSig :: TypeSig -> T_TypeSig
-sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
-
--- semantic domain
-newtype T_TypeSig = T_TypeSig {
- attach_T_TypeSig :: Identity (T_TypeSig_s38 )
- }
-newtype T_TypeSig_s38 = C_TypeSig_s38 {
- inv_TypeSig_s38 :: (T_TypeSig_v37 )
- }
-data T_TypeSig_s39 = C_TypeSig_s39
-type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 )
-data T_TypeSig_vIn37 = T_TypeSig_vIn37
-data T_TypeSig_vOut37 = T_TypeSig_vOut37 (PP_Doc)
-{-# NOINLINE sem_TypeSig_TypeSig #-}
-sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
-sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st38) where
- {-# NOINLINE st38 #-}
- st38 = let
- v37 :: T_TypeSig_v37
- v37 = \ (T_TypeSig_vIn37 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule45 arg_name_ arg_tp_
- __result_ = T_TypeSig_vOut37 _lhsOpp
- in __result_ )
- in C_TypeSig_s38 v37
- {-# INLINE rule45 #-}
- {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-}
- rule45 = \ name_ tp_ ->
- {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-}
- ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] []
- {-# LINE 1003 "dist/build/AbstractSyntaxDump.hs"#-}
-
--- TypeSigs ----------------------------------------------------
--- wrapper
-data Inh_TypeSigs = Inh_TypeSigs { }
-data Syn_TypeSigs = Syn_TypeSigs { pp_Syn_TypeSigs :: (PP_Doc), ppL_Syn_TypeSigs :: ([PP_Doc]) }
-{-# INLINABLE wrap_TypeSigs #-}
-wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
-wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg40 = T_TypeSigs_vIn40
- (T_TypeSigs_vOut40 _lhsOpp _lhsOppL) <- return (inv_TypeSigs_s41 sem arg40)
- return (Syn_TypeSigs _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_TypeSigs #-}
-sem_TypeSigs :: TypeSigs -> T_TypeSigs
-sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
-
--- semantic domain
-newtype T_TypeSigs = T_TypeSigs {
- attach_T_TypeSigs :: Identity (T_TypeSigs_s41 )
- }
-newtype T_TypeSigs_s41 = C_TypeSigs_s41 {
- inv_TypeSigs_s41 :: (T_TypeSigs_v40 )
- }
-data T_TypeSigs_s42 = C_TypeSigs_s42
-type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 )
-data T_TypeSigs_vIn40 = T_TypeSigs_vIn40
-data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_TypeSigs_Cons #-}
-sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
-sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where
- {-# NOINLINE st41 #-}
- st41 = let
- v40 :: T_TypeSigs_v40
- v40 = \ (T_TypeSigs_vIn40 ) -> ( let
- _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
- _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
- (T_TypeSig_vOut37 _hdIpp) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 )
- (T_TypeSigs_vOut40 _tlIpp _tlIppL) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule46 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule47 _hdIpp _tlIpp
- __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL
- in __result_ )
- in C_TypeSigs_s41 v40
- {-# INLINE rule46 #-}
- {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-}
- rule46 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 1058 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule47 #-}
- rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_TypeSigs_Nil #-}
-sem_TypeSigs_Nil :: T_TypeSigs
-sem_TypeSigs_Nil = T_TypeSigs (return st41) where
- {-# NOINLINE st41 #-}
- st41 = let
- v40 :: T_TypeSigs_v40
- v40 = \ (T_TypeSigs_vIn40 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule48 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule49 ()
- __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL
- in __result_ )
- in C_TypeSigs_s41 v40
- {-# INLINE rule48 #-}
- {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-}
- rule48 = \ (_ :: ()) ->
- {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-}
- []
- {-# LINE 1081 "dist/build/AbstractSyntaxDump.hs"#-}
- {-# INLINE rule49 #-}
- rule49 = \ (_ :: ()) ->
- empty
+{-# LANGUAGE Rank2Types, GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module AbstractSyntaxDump where
+{-# LINE 2 "src-ag/Expression.ag" #-}
+
+import UU.Scanner.Position(Pos)
+import HsToken
+{-# LINE 10 "dist/build/AbstractSyntaxDump.hs" #-}
+
+{-# LINE 2 "src-ag/Patterns.ag" #-}
+
+-- Patterns.ag imports
+import UU.Scanner.Position(Pos)
+import CommonTypes (ConstructorIdent,Identifier)
+{-# LINE 17 "dist/build/AbstractSyntaxDump.hs" #-}
+
+{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
+
+-- AbstractSyntax.ag imports
+import Data.Set(Set)
+import Data.Map(Map)
+import Patterns (Pattern(..),Patterns)
+import Expression (Expression(..))
+import Macro --marcos
+import CommonTypes
+import ErrorMessages
+{-# LINE 29 "dist/build/AbstractSyntaxDump.hs" #-}
+
+{-# LINE 6 "src-ag/AbstractSyntaxDump.ag" #-}
+
+import Data.List
+import qualified Data.Map as Map
+
+import Pretty
+import PPUtil
+
+import AbstractSyntax
+import TokenDef
+{-# LINE 41 "dist/build/AbstractSyntaxDump.hs" #-}
+import Control.Monad.Identity (Identity)
+import qualified Control.Monad.Identity
+-- Child -------------------------------------------------------
+-- wrapper
+data Inh_Child = Inh_Child { }
+data Syn_Child = Syn_Child { pp_Syn_Child :: (PP_Doc) }
+{-# INLINABLE wrap_Child #-}
+wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
+wrap_Child (T_Child act) (Inh_Child ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg1 = T_Child_vIn1
+ (T_Child_vOut1 _lhsOpp) <- return (inv_Child_s2 sem arg1)
+ return (Syn_Child _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Child #-}
+sem_Child :: Child -> T_Child
+sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
+
+-- semantic domain
+newtype T_Child = T_Child {
+ attach_T_Child :: Identity (T_Child_s2 )
+ }
+newtype T_Child_s2 = C_Child_s2 {
+ inv_Child_s2 :: (T_Child_v1 )
+ }
+data T_Child_s3 = C_Child_s3
+type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
+data T_Child_vIn1 = T_Child_vIn1
+data T_Child_vOut1 = T_Child_vOut1 (PP_Doc)
+{-# NOINLINE sem_Child_Child #-}
+sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
+sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where
+ {-# NOINLINE st2 #-}
+ st2 = let
+ v1 :: T_Child_v1
+ v1 = \ (T_Child_vIn1 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule0 arg_kind_ arg_name_ arg_tp_
+ __result_ = T_Child_vOut1 _lhsOpp
+ in __result_ )
+ in C_Child_s2 v1
+ {-# INLINE rule0 #-}
+ {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule0 = \ kind_ name_ tp_ ->
+ {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "kind" $ ppShow kind_] []
+ {-# LINE 91 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Children ----------------------------------------------------
+-- wrapper
+data Inh_Children = Inh_Children { }
+data Syn_Children = Syn_Children { pp_Syn_Children :: (PP_Doc), ppL_Syn_Children :: ([PP_Doc]) }
+{-# INLINABLE wrap_Children #-}
+wrap_Children :: T_Children -> Inh_Children -> (Syn_Children )
+wrap_Children (T_Children act) (Inh_Children ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg4 = T_Children_vIn4
+ (T_Children_vOut4 _lhsOpp _lhsOppL) <- return (inv_Children_s5 sem arg4)
+ return (Syn_Children _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Children #-}
+sem_Children :: Children -> T_Children
+sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
+
+-- semantic domain
+newtype T_Children = T_Children {
+ attach_T_Children :: Identity (T_Children_s5 )
+ }
+newtype T_Children_s5 = C_Children_s5 {
+ inv_Children_s5 :: (T_Children_v4 )
+ }
+data T_Children_s6 = C_Children_s6
+type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
+data T_Children_vIn4 = T_Children_vIn4
+data T_Children_vOut4 = T_Children_vOut4 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Children_Cons #-}
+sem_Children_Cons :: T_Child -> T_Children -> T_Children
+sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
+ {-# NOINLINE st5 #-}
+ st5 = let
+ v4 :: T_Children_v4
+ v4 = \ (T_Children_vIn4 ) -> ( let
+ _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
+ _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
+ (T_Child_vOut1 _hdIpp) = inv_Child_s2 _hdX2 (T_Child_vIn1 )
+ (T_Children_vOut4 _tlIpp _tlIppL) = inv_Children_s5 _tlX5 (T_Children_vIn4 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule1 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule2 _hdIpp _tlIpp
+ __result_ = T_Children_vOut4 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Children_s5 v4
+ {-# INLINE rule1 #-}
+ {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule1 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 146 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule2 #-}
+ rule2 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_Children_Nil #-}
+sem_Children_Nil :: T_Children
+sem_Children_Nil = T_Children (return st5) where
+ {-# NOINLINE st5 #-}
+ st5 = let
+ v4 :: T_Children_v4
+ v4 = \ (T_Children_vIn4 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule3 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule4 ()
+ __result_ = T_Children_vOut4 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Children_s5 v4
+ {-# INLINE rule3 #-}
+ {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule3 = \ (_ :: ()) ->
+ {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 169 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule4 #-}
+ rule4 = \ (_ :: ()) ->
+ empty
+
+-- Expression --------------------------------------------------
+-- wrapper
+data Inh_Expression = Inh_Expression { }
+data Syn_Expression = Syn_Expression { pp_Syn_Expression :: (PP_Doc) }
+{-# INLINABLE wrap_Expression #-}
+wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression )
+wrap_Expression (T_Expression act) (Inh_Expression ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg7 = T_Expression_vIn7
+ (T_Expression_vOut7 _lhsOpp) <- return (inv_Expression_s8 sem arg7)
+ return (Syn_Expression _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Expression #-}
+sem_Expression :: Expression -> T_Expression
+sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
+
+-- semantic domain
+newtype T_Expression = T_Expression {
+ attach_T_Expression :: Identity (T_Expression_s8 )
+ }
+newtype T_Expression_s8 = C_Expression_s8 {
+ inv_Expression_s8 :: (T_Expression_v7 )
+ }
+data T_Expression_s9 = C_Expression_s9
+type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
+data T_Expression_vIn7 = T_Expression_vIn7
+data T_Expression_vOut7 = T_Expression_vOut7 (PP_Doc)
+{-# NOINLINE sem_Expression_Expression #-}
+sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
+sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where
+ {-# NOINLINE st8 #-}
+ st8 = let
+ v7 :: T_Expression_v7
+ v7 = \ (T_Expression_vIn7 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule5 arg_pos_ arg_tks_
+ __result_ = T_Expression_vOut7 _lhsOpp
+ in __result_ )
+ in C_Expression_s8 v7
+ {-# INLINE rule5 #-}
+ {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule5 = \ pos_ tks_ ->
+ {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] []
+ {-# LINE 221 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Grammar -----------------------------------------------------
+-- wrapper
+data Inh_Grammar = Inh_Grammar { }
+data Syn_Grammar = Syn_Grammar { pp_Syn_Grammar :: (PP_Doc) }
+{-# INLINABLE wrap_Grammar #-}
+wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar )
+wrap_Grammar (T_Grammar act) (Inh_Grammar ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg10 = T_Grammar_vIn10
+ (T_Grammar_vOut10 _lhsOpp) <- return (inv_Grammar_s11 sem arg10)
+ return (Syn_Grammar _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Grammar #-}
+sem_Grammar :: Grammar -> T_Grammar
+sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
+
+-- semantic domain
+newtype T_Grammar = T_Grammar {
+ attach_T_Grammar :: Identity (T_Grammar_s11 )
+ }
+newtype T_Grammar_s11 = C_Grammar_s11 {
+ inv_Grammar_s11 :: (T_Grammar_v10 )
+ }
+data T_Grammar_s12 = C_Grammar_s12
+type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
+data T_Grammar_vIn10 = T_Grammar_vIn10
+data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc)
+{-# NOINLINE sem_Grammar_Grammar #-}
+sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar
+sem_Grammar_Grammar arg_typeSyns_ arg_useMap_ arg_derivings_ arg_wrappers_ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
+ {-# NOINLINE st11 #-}
+ st11 = let
+ v10 :: T_Grammar_v10
+ v10 = \ (T_Grammar_vIn10 ) -> ( let
+ _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
+ (T_Nonterminals_vOut16 _nontsIpp _nontsIppL) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule6 _nontsIppL arg_derivings_ arg_typeSyns_ arg_useMap_ arg_wrappers_
+ __result_ = T_Grammar_vOut10 _lhsOpp
+ in __result_ )
+ in C_Grammar_s11 v10
+ {-# INLINE rule6 #-}
+ {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule6 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ useMap_ wrappers_ ->
+ {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Grammar","Grammar"] []
+ [ ppF "typeSyns" $ ppAssocL typeSyns_
+ , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_
+ , ppF "derivings" $ ppMap $ derivings_
+ , ppF "wrappers" $ ppShow $ wrappers_
+ , ppF "nonts" $ ppVList _nontsIppL
+ ] []
+ {-# LINE 278 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Nonterminal -------------------------------------------------
+-- wrapper
+data Inh_Nonterminal = Inh_Nonterminal { }
+data Syn_Nonterminal = Syn_Nonterminal { pp_Syn_Nonterminal :: (PP_Doc) }
+{-# INLINABLE wrap_Nonterminal #-}
+wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal )
+wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg13 = T_Nonterminal_vIn13
+ (T_Nonterminal_vOut13 _lhsOpp) <- return (inv_Nonterminal_s14 sem arg13)
+ return (Syn_Nonterminal _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Nonterminal #-}
+sem_Nonterminal :: Nonterminal -> T_Nonterminal
+sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
+
+-- semantic domain
+newtype T_Nonterminal = T_Nonterminal {
+ attach_T_Nonterminal :: Identity (T_Nonterminal_s14 )
+ }
+newtype T_Nonterminal_s14 = C_Nonterminal_s14 {
+ inv_Nonterminal_s14 :: (T_Nonterminal_v13 )
+ }
+data T_Nonterminal_s15 = C_Nonterminal_s15
+type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 )
+data T_Nonterminal_vIn13 = T_Nonterminal_vIn13
+data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (PP_Doc)
+{-# NOINLINE sem_Nonterminal_Nonterminal #-}
+sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
+sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_Nonterminal_v13
+ v13 = \ (T_Nonterminal_vIn13 ) -> ( let
+ _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
+ (T_Productions_vOut28 _prodsIpp _prodsIppL) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule7 _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_
+ __result_ = T_Nonterminal_vOut13 _lhsOpp
+ in __result_ )
+ in C_Nonterminal_s14 v13
+ {-# INLINE rule7 #-}
+ {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule7 = \ ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ ->
+ {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] []
+ {-# LINE 329 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Nonterminals ------------------------------------------------
+-- wrapper
+data Inh_Nonterminals = Inh_Nonterminals { }
+data Syn_Nonterminals = Syn_Nonterminals { pp_Syn_Nonterminals :: (PP_Doc), ppL_Syn_Nonterminals :: ([PP_Doc]) }
+{-# INLINABLE wrap_Nonterminals #-}
+wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals )
+wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg16 = T_Nonterminals_vIn16
+ (T_Nonterminals_vOut16 _lhsOpp _lhsOppL) <- return (inv_Nonterminals_s17 sem arg16)
+ return (Syn_Nonterminals _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Nonterminals #-}
+sem_Nonterminals :: Nonterminals -> T_Nonterminals
+sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
+
+-- semantic domain
+newtype T_Nonterminals = T_Nonterminals {
+ attach_T_Nonterminals :: Identity (T_Nonterminals_s17 )
+ }
+newtype T_Nonterminals_s17 = C_Nonterminals_s17 {
+ inv_Nonterminals_s17 :: (T_Nonterminals_v16 )
+ }
+data T_Nonterminals_s18 = C_Nonterminals_s18
+type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 )
+data T_Nonterminals_vIn16 = T_Nonterminals_vIn16
+data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Nonterminals_Cons #-}
+sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
+sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_Nonterminals_v16
+ v16 = \ (T_Nonterminals_vIn16 ) -> ( let
+ _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
+ _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
+ (T_Nonterminal_vOut13 _hdIpp) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 )
+ (T_Nonterminals_vOut16 _tlIpp _tlIppL) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule8 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule9 _hdIpp _tlIpp
+ __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Nonterminals_s17 v16
+ {-# INLINE rule8 #-}
+ {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 384 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule9 #-}
+ rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_Nonterminals_Nil #-}
+sem_Nonterminals_Nil :: T_Nonterminals
+sem_Nonterminals_Nil = T_Nonterminals (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_Nonterminals_v16
+ v16 = \ (T_Nonterminals_vIn16 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule10 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule11 ()
+ __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Nonterminals_s17 v16
+ {-# INLINE rule10 #-}
+ {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule10 = \ (_ :: ()) ->
+ {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 407 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule11 #-}
+ rule11 = \ (_ :: ()) ->
+ empty
+
+-- Pattern -----------------------------------------------------
+-- wrapper
+data Inh_Pattern = Inh_Pattern { }
+data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) }
+{-# INLINABLE wrap_Pattern #-}
+wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
+wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg19 = T_Pattern_vIn19
+ (T_Pattern_vOut19 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s20 sem arg19)
+ return (Syn_Pattern _lhsOcopy _lhsOpp)
+ )
+
+-- cata
+{-# NOINLINE sem_Pattern #-}
+sem_Pattern :: Pattern -> T_Pattern
+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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
+sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
+sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
+
+-- semantic domain
+newtype T_Pattern = T_Pattern {
+ attach_T_Pattern :: Identity (T_Pattern_s20 )
+ }
+newtype T_Pattern_s20 = C_Pattern_s20 {
+ inv_Pattern_s20 :: (T_Pattern_v19 )
+ }
+data T_Pattern_s21 = C_Pattern_s21
+type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 )
+data T_Pattern_vIn19 = T_Pattern_vIn19
+data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) (PP_Doc)
+{-# NOINLINE sem_Pattern_Constr #-}
+sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
+sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_Pattern_v19
+ v19 = \ (T_Pattern_vIn19 ) -> ( let
+ _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule12 _patsIppL arg_name_
+ _copy = rule13 _patsIcopy arg_name_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule14 _copy
+ __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s20 v19
+ {-# INLINE rule12 #-}
+ {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule12 = \ ((_patsIppL) :: [PP_Doc]) name_ ->
+ {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []
+ {-# LINE 468 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule13 #-}
+ rule13 = \ ((_patsIcopy) :: Patterns) name_ ->
+ Constr name_ _patsIcopy
+ {-# INLINE rule14 #-}
+ rule14 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Product #-}
+sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
+sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_Pattern_v19
+ v19 = \ (T_Pattern_vIn19 ) -> ( let
+ _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule15 _patsIppL arg_pos_
+ _copy = rule16 _patsIcopy arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule17 _copy
+ __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s20 v19
+ {-# INLINE rule15 #-}
+ {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule15 = \ ((_patsIppL) :: [PP_Doc]) pos_ ->
+ {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []
+ {-# LINE 497 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule16 #-}
+ rule16 = \ ((_patsIcopy) :: Patterns) pos_ ->
+ Product pos_ _patsIcopy
+ {-# INLINE rule17 #-}
+ rule17 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Alias #-}
+sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
+sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_Pattern_v19
+ v19 = \ (T_Pattern_vIn19 ) -> ( let
+ _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule18 _patIpp arg_attr_ arg_field_
+ _copy = rule19 _patIcopy arg_attr_ arg_field_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule20 _copy
+ __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s20 v19
+ {-# INLINE rule18 #-}
+ {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule18 = \ ((_patIpp) :: PP_Doc) attr_ field_ ->
+ {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []
+ {-# LINE 526 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule19 #-}
+ rule19 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
+ Alias field_ attr_ _patIcopy
+ {-# INLINE rule20 #-}
+ rule20 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Irrefutable #-}
+sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
+sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_Pattern_v19
+ v19 = \ (T_Pattern_vIn19 ) -> ( let
+ _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule21 _patIpp
+ _copy = rule22 _patIcopy
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule23 _copy
+ __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s20 v19
+ {-# INLINE rule21 #-}
+ rule21 = \ ((_patIpp) :: PP_Doc) ->
+ _patIpp
+ {-# INLINE rule22 #-}
+ rule22 = \ ((_patIcopy) :: Pattern) ->
+ Irrefutable _patIcopy
+ {-# INLINE rule23 #-}
+ rule23 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Underscore #-}
+sem_Pattern_Underscore :: (Pos) -> T_Pattern
+sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_Pattern_v19
+ v19 = \ (T_Pattern_vIn19 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule24 arg_pos_
+ _copy = rule25 arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule26 _copy
+ __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s20 v19
+ {-# INLINE rule24 #-}
+ {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule24 = \ pos_ ->
+ {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []
+ {-# LINE 579 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule25 #-}
+ rule25 = \ pos_ ->
+ Underscore pos_
+ {-# INLINE rule26 #-}
+ rule26 = \ _copy ->
+ _copy
+
+-- Patterns ----------------------------------------------------
+-- wrapper
+data Inh_Patterns = Inh_Patterns { }
+data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) }
+{-# INLINABLE wrap_Patterns #-}
+wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
+wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg22 = T_Patterns_vIn22
+ (T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s23 sem arg22)
+ return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Patterns #-}
+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 {
+ attach_T_Patterns :: Identity (T_Patterns_s23 )
+ }
+newtype T_Patterns_s23 = C_Patterns_s23 {
+ inv_Patterns_s23 :: (T_Patterns_v22 )
+ }
+data T_Patterns_s24 = C_Patterns_s24
+type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 )
+data T_Patterns_vIn22 = T_Patterns_vIn22
+data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Patterns_Cons #-}
+sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
+sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where
+ {-# NOINLINE st23 #-}
+ st23 = let
+ v22 :: T_Patterns_v22
+ v22 = \ (T_Patterns_vIn22 ) -> ( let
+ _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
+ _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
+ (T_Pattern_vOut19 _hdIcopy _hdIpp) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 )
+ (T_Patterns_vOut22 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule27 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule28 _hdIpp _tlIpp
+ _copy = rule29 _hdIcopy _tlIcopy
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule30 _copy
+ __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Patterns_s23 v22
+ {-# INLINE rule27 #-}
+ {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule27 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 643 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule28 #-}
+ rule28 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+ {-# INLINE rule29 #-}
+ rule29 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
+ (:) _hdIcopy _tlIcopy
+ {-# INLINE rule30 #-}
+ rule30 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Patterns_Nil #-}
+sem_Patterns_Nil :: T_Patterns
+sem_Patterns_Nil = T_Patterns (return st23) where
+ {-# NOINLINE st23 #-}
+ st23 = let
+ v22 :: T_Patterns_v22
+ v22 = \ (T_Patterns_vIn22 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule31 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule32 ()
+ _copy = rule33 ()
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule34 _copy
+ __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Patterns_s23 v22
+ {-# INLINE rule31 #-}
+ {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule31 = \ (_ :: ()) ->
+ {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 675 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule32 #-}
+ rule32 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule33 #-}
+ rule33 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule34 #-}
+ rule34 = \ _copy ->
+ _copy
+
+-- Production --------------------------------------------------
+-- wrapper
+data Inh_Production = Inh_Production { }
+data Syn_Production = Syn_Production { pp_Syn_Production :: (PP_Doc) }
+{-# INLINABLE wrap_Production #-}
+wrap_Production :: T_Production -> Inh_Production -> (Syn_Production )
+wrap_Production (T_Production act) (Inh_Production ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg25 = T_Production_vIn25
+ (T_Production_vOut25 _lhsOpp) <- return (inv_Production_s26 sem arg25)
+ return (Syn_Production _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Production #-}
+sem_Production :: Production -> T_Production
+sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_
+
+-- semantic domain
+newtype T_Production = T_Production {
+ attach_T_Production :: Identity (T_Production_s26 )
+ }
+newtype T_Production_s26 = C_Production_s26 {
+ inv_Production_s26 :: (T_Production_v25 )
+ }
+data T_Production_s27 = C_Production_s27
+type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 )
+data T_Production_vIn25 = T_Production_vIn25
+data T_Production_vOut25 = T_Production_vOut25 (PP_Doc)
+{-# NOINLINE sem_Production_Production #-}
+sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
+sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where
+ {-# NOINLINE st26 #-}
+ st26 = let
+ v25 :: T_Production_v25
+ v25 = \ (T_Production_vIn25 ) -> ( let
+ _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
+ _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
+ _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
+ (T_Children_vOut4 _childrenIpp _childrenIppL) = inv_Children_s5 _childrenX5 (T_Children_vIn4 )
+ (T_Rules_vOut34 _rulesIpp _rulesIppL) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 )
+ (T_TypeSigs_vOut40 _typeSigsIpp _typeSigsIppL) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule35 _childrenIppL _rulesIppL _typeSigsIppL arg_con_
+ __result_ = T_Production_vOut25 _lhsOpp
+ in __result_ )
+ in C_Production_s26 v25
+ {-# INLINE rule35 #-}
+ {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule35 = \ ((_childrenIppL) :: [PP_Doc]) ((_rulesIppL) :: [PP_Doc]) ((_typeSigsIppL) :: [PP_Doc]) con_ ->
+ {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] []
+ {-# LINE 739 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Productions -------------------------------------------------
+-- wrapper
+data Inh_Productions = Inh_Productions { }
+data Syn_Productions = Syn_Productions { pp_Syn_Productions :: (PP_Doc), ppL_Syn_Productions :: ([PP_Doc]) }
+{-# INLINABLE wrap_Productions #-}
+wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions )
+wrap_Productions (T_Productions act) (Inh_Productions ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg28 = T_Productions_vIn28
+ (T_Productions_vOut28 _lhsOpp _lhsOppL) <- return (inv_Productions_s29 sem arg28)
+ return (Syn_Productions _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Productions #-}
+sem_Productions :: Productions -> T_Productions
+sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
+
+-- semantic domain
+newtype T_Productions = T_Productions {
+ attach_T_Productions :: Identity (T_Productions_s29 )
+ }
+newtype T_Productions_s29 = C_Productions_s29 {
+ inv_Productions_s29 :: (T_Productions_v28 )
+ }
+data T_Productions_s30 = C_Productions_s30
+type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 )
+data T_Productions_vIn28 = T_Productions_vIn28
+data T_Productions_vOut28 = T_Productions_vOut28 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Productions_Cons #-}
+sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
+sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Productions_v28
+ v28 = \ (T_Productions_vIn28 ) -> ( let
+ _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
+ _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
+ (T_Production_vOut25 _hdIpp) = inv_Production_s26 _hdX26 (T_Production_vIn25 )
+ (T_Productions_vOut28 _tlIpp _tlIppL) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule36 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule37 _hdIpp _tlIpp
+ __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Productions_s29 v28
+ {-# INLINE rule36 #-}
+ {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule36 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 794 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule37 #-}
+ rule37 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_Productions_Nil #-}
+sem_Productions_Nil :: T_Productions
+sem_Productions_Nil = T_Productions (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_Productions_v28
+ v28 = \ (T_Productions_vIn28 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule38 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule39 ()
+ __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Productions_s29 v28
+ {-# INLINE rule38 #-}
+ {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule38 = \ (_ :: ()) ->
+ {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 817 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule39 #-}
+ rule39 = \ (_ :: ()) ->
+ empty
+
+-- Rule --------------------------------------------------------
+-- wrapper
+data Inh_Rule = Inh_Rule { }
+data Syn_Rule = Syn_Rule { pp_Syn_Rule :: (PP_Doc) }
+{-# INLINABLE wrap_Rule #-}
+wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule )
+wrap_Rule (T_Rule act) (Inh_Rule ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg31 = T_Rule_vIn31
+ (T_Rule_vOut31 _lhsOpp) <- return (inv_Rule_s32 sem arg31)
+ return (Syn_Rule _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_Rule #-}
+sem_Rule :: Rule -> T_Rule
+sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
+
+-- semantic domain
+newtype T_Rule = T_Rule {
+ attach_T_Rule :: Identity (T_Rule_s32 )
+ }
+newtype T_Rule_s32 = C_Rule_s32 {
+ inv_Rule_s32 :: (T_Rule_v31 )
+ }
+data T_Rule_s33 = C_Rule_s33
+type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 )
+data T_Rule_vIn31 = T_Rule_vIn31
+data T_Rule_vOut31 = T_Rule_vOut31 (PP_Doc)
+{-# NOINLINE sem_Rule_Rule #-}
+sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
+sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ _ _ _ _ _ = T_Rule (return st32) where
+ {-# NOINLINE st32 #-}
+ st32 = let
+ v31 :: T_Rule_v31
+ v31 = \ (T_Rule_vIn31 ) -> ( let
+ _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
+ _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
+ (T_Pattern_vOut19 _patternIcopy _patternIpp) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 )
+ (T_Expression_vOut7 _rhsIpp) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule40 _patternIpp _rhsIpp arg_origin_ arg_owrt_
+ __result_ = T_Rule_vOut31 _lhsOpp
+ in __result_ )
+ in C_Rule_s32 v31
+ {-# INLINE rule40 #-}
+ {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule40 = \ ((_patternIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) origin_ owrt_ ->
+ {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] []
+ {-# LINE 873 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- Rules -------------------------------------------------------
+-- wrapper
+data Inh_Rules = Inh_Rules { }
+data Syn_Rules = Syn_Rules { pp_Syn_Rules :: (PP_Doc), ppL_Syn_Rules :: ([PP_Doc]) }
+{-# INLINABLE wrap_Rules #-}
+wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules )
+wrap_Rules (T_Rules act) (Inh_Rules ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg34 = T_Rules_vIn34
+ (T_Rules_vOut34 _lhsOpp _lhsOppL) <- return (inv_Rules_s35 sem arg34)
+ return (Syn_Rules _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Rules #-}
+sem_Rules :: Rules -> T_Rules
+sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
+
+-- semantic domain
+newtype T_Rules = T_Rules {
+ attach_T_Rules :: Identity (T_Rules_s35 )
+ }
+newtype T_Rules_s35 = C_Rules_s35 {
+ inv_Rules_s35 :: (T_Rules_v34 )
+ }
+data T_Rules_s36 = C_Rules_s36
+type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 )
+data T_Rules_vIn34 = T_Rules_vIn34
+data T_Rules_vOut34 = T_Rules_vOut34 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Rules_Cons #-}
+sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
+sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Rules_v34
+ v34 = \ (T_Rules_vIn34 ) -> ( let
+ _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
+ _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
+ (T_Rule_vOut31 _hdIpp) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 )
+ (T_Rules_vOut34 _tlIpp _tlIppL) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule41 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule42 _hdIpp _tlIpp
+ __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Rules_s35 v34
+ {-# INLINE rule41 #-}
+ {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule41 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 928 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule42 #-}
+ rule42 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_Rules_Nil #-}
+sem_Rules_Nil :: T_Rules
+sem_Rules_Nil = T_Rules (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Rules_v34
+ v34 = \ (T_Rules_vIn34 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule43 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule44 ()
+ __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Rules_s35 v34
+ {-# INLINE rule43 #-}
+ {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule43 = \ (_ :: ()) ->
+ {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 951 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule44 #-}
+ rule44 = \ (_ :: ()) ->
+ empty
+
+-- TypeSig -----------------------------------------------------
+-- wrapper
+data Inh_TypeSig = Inh_TypeSig { }
+data Syn_TypeSig = Syn_TypeSig { pp_Syn_TypeSig :: (PP_Doc) }
+{-# INLINABLE wrap_TypeSig #-}
+wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
+wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg37 = T_TypeSig_vIn37
+ (T_TypeSig_vOut37 _lhsOpp) <- return (inv_TypeSig_s38 sem arg37)
+ return (Syn_TypeSig _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_TypeSig #-}
+sem_TypeSig :: TypeSig -> T_TypeSig
+sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
+
+-- semantic domain
+newtype T_TypeSig = T_TypeSig {
+ attach_T_TypeSig :: Identity (T_TypeSig_s38 )
+ }
+newtype T_TypeSig_s38 = C_TypeSig_s38 {
+ inv_TypeSig_s38 :: (T_TypeSig_v37 )
+ }
+data T_TypeSig_s39 = C_TypeSig_s39
+type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 )
+data T_TypeSig_vIn37 = T_TypeSig_vIn37
+data T_TypeSig_vOut37 = T_TypeSig_vOut37 (PP_Doc)
+{-# NOINLINE sem_TypeSig_TypeSig #-}
+sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
+sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st38) where
+ {-# NOINLINE st38 #-}
+ st38 = let
+ v37 :: T_TypeSig_v37
+ v37 = \ (T_TypeSig_vIn37 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule45 arg_name_ arg_tp_
+ __result_ = T_TypeSig_vOut37 _lhsOpp
+ in __result_ )
+ in C_TypeSig_s38 v37
+ {-# INLINE rule45 #-}
+ {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule45 = \ name_ tp_ ->
+ {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-}
+ ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] []
+ {-# LINE 1003 "dist/build/AbstractSyntaxDump.hs"#-}
+
+-- TypeSigs ----------------------------------------------------
+-- wrapper
+data Inh_TypeSigs = Inh_TypeSigs { }
+data Syn_TypeSigs = Syn_TypeSigs { pp_Syn_TypeSigs :: (PP_Doc), ppL_Syn_TypeSigs :: ([PP_Doc]) }
+{-# INLINABLE wrap_TypeSigs #-}
+wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
+wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg40 = T_TypeSigs_vIn40
+ (T_TypeSigs_vOut40 _lhsOpp _lhsOppL) <- return (inv_TypeSigs_s41 sem arg40)
+ return (Syn_TypeSigs _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_TypeSigs #-}
+sem_TypeSigs :: TypeSigs -> T_TypeSigs
+sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
+
+-- semantic domain
+newtype T_TypeSigs = T_TypeSigs {
+ attach_T_TypeSigs :: Identity (T_TypeSigs_s41 )
+ }
+newtype T_TypeSigs_s41 = C_TypeSigs_s41 {
+ inv_TypeSigs_s41 :: (T_TypeSigs_v40 )
+ }
+data T_TypeSigs_s42 = C_TypeSigs_s42
+type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 )
+data T_TypeSigs_vIn40 = T_TypeSigs_vIn40
+data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_TypeSigs_Cons #-}
+sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
+sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where
+ {-# NOINLINE st41 #-}
+ st41 = let
+ v40 :: T_TypeSigs_v40
+ v40 = \ (T_TypeSigs_vIn40 ) -> ( let
+ _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
+ _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
+ (T_TypeSig_vOut37 _hdIpp) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 )
+ (T_TypeSigs_vOut40 _tlIpp _tlIppL) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule46 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule47 _hdIpp _tlIpp
+ __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_TypeSigs_s41 v40
+ {-# INLINE rule46 #-}
+ {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule46 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 1058 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule47 #-}
+ rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_TypeSigs_Nil #-}
+sem_TypeSigs_Nil :: T_TypeSigs
+sem_TypeSigs_Nil = T_TypeSigs (return st41) where
+ {-# NOINLINE st41 #-}
+ st41 = let
+ v40 :: T_TypeSigs_v40
+ v40 = \ (T_TypeSigs_vIn40 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule48 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule49 ()
+ __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_TypeSigs_s41 v40
+ {-# INLINE rule48 #-}
+ {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-}
+ rule48 = \ (_ :: ()) ->
+ {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-}
+ []
+ {-# LINE 1081 "dist/build/AbstractSyntaxDump.hs"#-}
+ {-# INLINE rule49 #-}
+ rule49 = \ (_ :: ()) ->
+ empty
diff --git a/src-generated/Code.hs b/src-generated/Code.hs
index 3c25c65..21a86c4 100644..100755
--- a/src-generated/Code.hs
+++ b/src-generated/Code.hs
@@ -1,356 +1,356 @@
-
-
--- UUAGC 0.9.51 (src-ag/Code.ag)
-module Code where
-{-# LINE 2 "src-ag/Code.ag" #-}
-
-import Patterns
-import Data.Set(Set)
-import qualified Data.Set as Set
-import Data.Map(Map)
-import qualified Data.Map as Map
-{-# LINE 13 "dist/build/Code.hs" #-}
-{-# LINE 146 "src-ag/Code.ag" #-}
-
--- Unboxed tuples
--- unbox Whether unboxed tuples are wanted or not
--- inh The inherited attributes.
--- If there are none, no unboxing can take place,
--- because in that case the semantic function (a top-level identifier) would have an unboxed type.
--- Of course we can't have an unboxed 1-tuple
-mkTupleExpr :: Bool -> Bool -> Exprs -> Expr
-mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs
- | otherwise = UnboxedTupleExpr exprs
-mkTupleType :: Bool -> Bool -> Types -> Type
-mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps
- | otherwise = UnboxedTupleType tps
-mkTupleLhs :: Bool -> Bool -> [String] -> Lhs
-mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps
- | otherwise = UnboxedTupleLhs comps
-{-# LINE 31 "dist/build/Code.hs" #-}
--- CaseAlt -----------------------------------------------------
-{-
- alternatives:
- alternative CaseAlt:
- child left : Lhs
- child expr : Expr
--}
-data CaseAlt = CaseAlt (Lhs) (Expr)
--- CaseAlts ----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CaseAlt
- child tl : CaseAlts
- alternative Nil:
--}
-type CaseAlts = [CaseAlt]
--- Chunk -------------------------------------------------------
-{-
- alternatives:
- alternative Chunk:
- child name : {String}
- child comment : Decl
- child info : Decls
- child dataDef : Decls
- child cataFun : Decls
- child semDom : Decls
- child semWrapper : Decls
- child semFunctions : Decls
- child semNames : {[String]}
--}
-data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) (([String]))
--- Chunks ------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Chunk
- child tl : Chunks
- alternative Nil:
--}
-type Chunks = [Chunk]
--- DataAlt -----------------------------------------------------
-{-
- alternatives:
- alternative DataAlt:
- child name : {String}
- child args : Types
- alternative Record:
- child name : {String}
- child args : NamedTypes
--}
-data DataAlt = DataAlt (String) (Types)
- | Record (String) (NamedTypes)
--- DataAlts ----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : DataAlt
- child tl : DataAlts
- alternative Nil:
--}
-type DataAlts = [DataAlt]
--- Decl --------------------------------------------------------
-{-
- alternatives:
- alternative Decl:
- child left : Lhs
- child rhs : Expr
- child binds : {Set String}
- child uses : {Set String}
- alternative Bind:
- child left : Lhs
- child rhs : Expr
- alternative BindLet:
- child left : Lhs
- child rhs : Expr
- alternative Data:
- child name : {String}
- child params : {[String]}
- child alts : DataAlts
- child strict : {Bool}
- child derivings : {[String]}
- alternative NewType:
- child name : {String}
- child params : {[String]}
- child con : {String}
- child tp : Type
- alternative Type:
- child name : {String}
- child params : {[String]}
- child tp : Type
- alternative TSig:
- child name : {String}
- child tp : Type
- alternative Comment:
- child txt : {String}
- alternative PragmaDecl:
- child txt : {String}
- alternative Resume:
- child monadic : {Bool}
- child nt : {String}
- child left : Lhs
- child rhs : Expr
- alternative EvalDecl:
- child nt : {String}
- child left : Lhs
- child rhs : Expr
--}
-data Decl = Decl (Lhs) (Expr) ((Set String)) ((Set String))
- | Bind (Lhs) (Expr)
- | BindLet (Lhs) (Expr)
- | Data (String) (([String])) (DataAlts) (Bool) (([String]))
- | NewType (String) (([String])) (String) (Type)
- | Type (String) (([String])) (Type)
- | TSig (String) (Type)
- | Comment (String)
- | PragmaDecl (String)
- | Resume (Bool) (String) (Lhs) (Expr)
- | EvalDecl (String) (Lhs) (Expr)
--- Decls -------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Decl
- child tl : Decls
- alternative Nil:
--}
-type Decls = [Decl]
--- Expr --------------------------------------------------------
-{-
- alternatives:
- alternative Let:
- child decls : Decls
- child body : Expr
- alternative Case:
- child expr : Expr
- child alts : CaseAlts
- alternative Do:
- child stmts : Decls
- child body : Expr
- alternative Lambda:
- child args : Exprs
- child body : Expr
- alternative TupleExpr:
- child exprs : Exprs
- alternative UnboxedTupleExpr:
- child exprs : Exprs
- alternative App:
- child name : {String}
- child args : Exprs
- alternative SimpleExpr:
- child txt : {String}
- alternative TextExpr:
- child lns : {[String]}
- alternative Trace:
- child txt : {String}
- child expr : Expr
- alternative PragmaExpr:
- child onLeftSide : {Bool}
- child onNewLine : {Bool}
- child txt : {String}
- child expr : Expr
- alternative LineExpr:
- child expr : Expr
- alternative TypedExpr:
- child expr : Expr
- child tp : Type
- alternative ResultExpr:
- child nt : {String}
- child expr : Expr
- alternative InvokeExpr:
- child nt : {String}
- child expr : Expr
- child args : Exprs
- alternative ResumeExpr:
- child nt : {String}
- child expr : Expr
- child left : Lhs
- child rhs : Expr
- alternative SemFun:
- child nt : {String}
- child args : Exprs
- child body : Expr
--}
-data Expr = Let (Decls) (Expr)
- | Case (Expr) (CaseAlts)
- | Do (Decls) (Expr)
- | Lambda (Exprs) (Expr)
- | TupleExpr (Exprs)
- | UnboxedTupleExpr (Exprs)
- | App (String) (Exprs)
- | SimpleExpr (String)
- | TextExpr (([String]))
- | Trace (String) (Expr)
- | PragmaExpr (Bool) (Bool) (String) (Expr)
- | LineExpr (Expr)
- | TypedExpr (Expr) (Type)
- | ResultExpr (String) (Expr)
- | InvokeExpr (String) (Expr) (Exprs)
- | ResumeExpr (String) (Expr) (Lhs) (Expr)
- | SemFun (String) (Exprs) (Expr)
--- Exprs -------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Expr
- child tl : Exprs
- alternative Nil:
--}
-type Exprs = [Expr]
--- Lhs ---------------------------------------------------------
-{-
- alternatives:
- alternative Pattern3:
- child pat3 : {Pattern}
- alternative Pattern3SM:
- child pat3 : {Pattern}
- alternative TupleLhs:
- child comps : {[String]}
- alternative UnboxedTupleLhs:
- child comps : {[String]}
- alternative Fun:
- child name : {String}
- child args : Exprs
- alternative Unwrap:
- child name : {String}
- child sub : Lhs
--}
-data Lhs = Pattern3 (Pattern)
- | Pattern3SM (Pattern)
- | TupleLhs (([String]))
- | UnboxedTupleLhs (([String]))
- | Fun (String) (Exprs)
- | Unwrap (String) (Lhs)
--- NamedType ---------------------------------------------------
-{-
- alternatives:
- alternative Named:
- child strict : {Bool}
- child name : {String}
- child tp : Type
--}
-data NamedType = Named (Bool) (String) (Type)
--- NamedTypes --------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : NamedType
- child tl : NamedTypes
- alternative Nil:
--}
-type NamedTypes = [NamedType]
--- Program -----------------------------------------------------
-{-
- alternatives:
- alternative Program:
- child chunks : Chunks
- child ordered : {Bool}
--}
-data Program = Program (Chunks) (Bool)
--- Type --------------------------------------------------------
-{-
- alternatives:
- alternative Arr:
- child left : Type
- child right : Type
- alternative CtxApp:
- child left : {[(String, [String])]}
- child right : Type
- alternative QuantApp:
- child left : {String}
- child right : Type
- alternative TypeApp:
- child func : Type
- child args : Types
- alternative TupleType:
- child tps : Types
- alternative UnboxedTupleType:
- child tps : Types
- alternative List:
- child tp : Type
- alternative SimpleType:
- child txt : {String}
- alternative NontermType:
- child name : {String}
- child params : {[String]}
- child deforested : {Bool}
- alternative TMaybe:
- child tp : Type
- alternative TEither:
- child left : Type
- child right : Type
- alternative TMap:
- child key : Type
- child value : Type
- alternative TIntMap:
- child value : Type
- alternative TSet:
- child tp : Type
- alternative TIntSet:
--}
-data Type = Arr (Type) (Type)
- | CtxApp (([(String, [String])])) (Type)
- | QuantApp (String) (Type)
- | TypeApp (Type) (Types)
- | TupleType (Types)
- | UnboxedTupleType (Types)
- | List (Type)
- | SimpleType (String)
- | NontermType (String) (([String])) (Bool)
- | TMaybe (Type)
- | TEither (Type) (Type)
- | TMap (Type) (Type)
- | TIntMap (Type)
- | TSet (Type)
- | TIntSet
- deriving ( Show)
--- Types -------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Type
- child tl : Types
- alternative Nil:
--}
+
+
+-- UUAGC 0.9.51 (src-ag/Code.ag)
+module Code where
+{-# LINE 2 "src-ag/Code.ag" #-}
+
+import Patterns
+import Data.Set(Set)
+import qualified Data.Set as Set
+import Data.Map(Map)
+import qualified Data.Map as Map
+{-# LINE 13 "dist/build/Code.hs" #-}
+{-# LINE 146 "src-ag/Code.ag" #-}
+
+-- Unboxed tuples
+-- unbox Whether unboxed tuples are wanted or not
+-- inh The inherited attributes.
+-- If there are none, no unboxing can take place,
+-- because in that case the semantic function (a top-level identifier) would have an unboxed type.
+-- Of course we can't have an unboxed 1-tuple
+mkTupleExpr :: Bool -> Bool -> Exprs -> Expr
+mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs
+ | otherwise = UnboxedTupleExpr exprs
+mkTupleType :: Bool -> Bool -> Types -> Type
+mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps
+ | otherwise = UnboxedTupleType tps
+mkTupleLhs :: Bool -> Bool -> [String] -> Lhs
+mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps
+ | otherwise = UnboxedTupleLhs comps
+{-# LINE 31 "dist/build/Code.hs" #-}
+-- CaseAlt -----------------------------------------------------
+{-
+ alternatives:
+ alternative CaseAlt:
+ child left : Lhs
+ child expr : Expr
+-}
+data CaseAlt = CaseAlt (Lhs) (Expr)
+-- CaseAlts ----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CaseAlt
+ child tl : CaseAlts
+ alternative Nil:
+-}
+type CaseAlts = [CaseAlt]
+-- Chunk -------------------------------------------------------
+{-
+ alternatives:
+ alternative Chunk:
+ child name : {String}
+ child comment : Decl
+ child info : Decls
+ child dataDef : Decls
+ child cataFun : Decls
+ child semDom : Decls
+ child semWrapper : Decls
+ child semFunctions : Decls
+ child semNames : {[String]}
+-}
+data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) (([String]))
+-- Chunks ------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Chunk
+ child tl : Chunks
+ alternative Nil:
+-}
+type Chunks = [Chunk]
+-- DataAlt -----------------------------------------------------
+{-
+ alternatives:
+ alternative DataAlt:
+ child name : {String}
+ child args : Types
+ alternative Record:
+ child name : {String}
+ child args : NamedTypes
+-}
+data DataAlt = DataAlt (String) (Types)
+ | Record (String) (NamedTypes)
+-- DataAlts ----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : DataAlt
+ child tl : DataAlts
+ alternative Nil:
+-}
+type DataAlts = [DataAlt]
+-- Decl --------------------------------------------------------
+{-
+ alternatives:
+ alternative Decl:
+ child left : Lhs
+ child rhs : Expr
+ child binds : {Set String}
+ child uses : {Set String}
+ alternative Bind:
+ child left : Lhs
+ child rhs : Expr
+ alternative BindLet:
+ child left : Lhs
+ child rhs : Expr
+ alternative Data:
+ child name : {String}
+ child params : {[String]}
+ child alts : DataAlts
+ child strict : {Bool}
+ child derivings : {[String]}
+ alternative NewType:
+ child name : {String}
+ child params : {[String]}
+ child con : {String}
+ child tp : Type
+ alternative Type:
+ child name : {String}
+ child params : {[String]}
+ child tp : Type
+ alternative TSig:
+ child name : {String}
+ child tp : Type
+ alternative Comment:
+ child txt : {String}
+ alternative PragmaDecl:
+ child txt : {String}
+ alternative Resume:
+ child monadic : {Bool}
+ child nt : {String}
+ child left : Lhs
+ child rhs : Expr
+ alternative EvalDecl:
+ child nt : {String}
+ child left : Lhs
+ child rhs : Expr
+-}
+data Decl = Decl (Lhs) (Expr) ((Set String)) ((Set String))
+ | Bind (Lhs) (Expr)
+ | BindLet (Lhs) (Expr)
+ | Data (String) (([String])) (DataAlts) (Bool) (([String]))
+ | NewType (String) (([String])) (String) (Type)
+ | Type (String) (([String])) (Type)
+ | TSig (String) (Type)
+ | Comment (String)
+ | PragmaDecl (String)
+ | Resume (Bool) (String) (Lhs) (Expr)
+ | EvalDecl (String) (Lhs) (Expr)
+-- Decls -------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Decl
+ child tl : Decls
+ alternative Nil:
+-}
+type Decls = [Decl]
+-- Expr --------------------------------------------------------
+{-
+ alternatives:
+ alternative Let:
+ child decls : Decls
+ child body : Expr
+ alternative Case:
+ child expr : Expr
+ child alts : CaseAlts
+ alternative Do:
+ child stmts : Decls
+ child body : Expr
+ alternative Lambda:
+ child args : Exprs
+ child body : Expr
+ alternative TupleExpr:
+ child exprs : Exprs
+ alternative UnboxedTupleExpr:
+ child exprs : Exprs
+ alternative App:
+ child name : {String}
+ child args : Exprs
+ alternative SimpleExpr:
+ child txt : {String}
+ alternative TextExpr:
+ child lns : {[String]}
+ alternative Trace:
+ child txt : {String}
+ child expr : Expr
+ alternative PragmaExpr:
+ child onLeftSide : {Bool}
+ child onNewLine : {Bool}
+ child txt : {String}
+ child expr : Expr
+ alternative LineExpr:
+ child expr : Expr
+ alternative TypedExpr:
+ child expr : Expr
+ child tp : Type
+ alternative ResultExpr:
+ child nt : {String}
+ child expr : Expr
+ alternative InvokeExpr:
+ child nt : {String}
+ child expr : Expr
+ child args : Exprs
+ alternative ResumeExpr:
+ child nt : {String}
+ child expr : Expr
+ child left : Lhs
+ child rhs : Expr
+ alternative SemFun:
+ child nt : {String}
+ child args : Exprs
+ child body : Expr
+-}
+data Expr = Let (Decls) (Expr)
+ | Case (Expr) (CaseAlts)
+ | Do (Decls) (Expr)
+ | Lambda (Exprs) (Expr)
+ | TupleExpr (Exprs)
+ | UnboxedTupleExpr (Exprs)
+ | App (String) (Exprs)
+ | SimpleExpr (String)
+ | TextExpr (([String]))
+ | Trace (String) (Expr)
+ | PragmaExpr (Bool) (Bool) (String) (Expr)
+ | LineExpr (Expr)
+ | TypedExpr (Expr) (Type)
+ | ResultExpr (String) (Expr)
+ | InvokeExpr (String) (Expr) (Exprs)
+ | ResumeExpr (String) (Expr) (Lhs) (Expr)
+ | SemFun (String) (Exprs) (Expr)
+-- Exprs -------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Expr
+ child tl : Exprs
+ alternative Nil:
+-}
+type Exprs = [Expr]
+-- Lhs ---------------------------------------------------------
+{-
+ alternatives:
+ alternative Pattern3:
+ child pat3 : {Pattern}
+ alternative Pattern3SM:
+ child pat3 : {Pattern}
+ alternative TupleLhs:
+ child comps : {[String]}
+ alternative UnboxedTupleLhs:
+ child comps : {[String]}
+ alternative Fun:
+ child name : {String}
+ child args : Exprs
+ alternative Unwrap:
+ child name : {String}
+ child sub : Lhs
+-}
+data Lhs = Pattern3 (Pattern)
+ | Pattern3SM (Pattern)
+ | TupleLhs (([String]))
+ | UnboxedTupleLhs (([String]))
+ | Fun (String) (Exprs)
+ | Unwrap (String) (Lhs)
+-- NamedType ---------------------------------------------------
+{-
+ alternatives:
+ alternative Named:
+ child strict : {Bool}
+ child name : {String}
+ child tp : Type
+-}
+data NamedType = Named (Bool) (String) (Type)
+-- NamedTypes --------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : NamedType
+ child tl : NamedTypes
+ alternative Nil:
+-}
+type NamedTypes = [NamedType]
+-- Program -----------------------------------------------------
+{-
+ alternatives:
+ alternative Program:
+ child chunks : Chunks
+ child ordered : {Bool}
+-}
+data Program = Program (Chunks) (Bool)
+-- Type --------------------------------------------------------
+{-
+ alternatives:
+ alternative Arr:
+ child left : Type
+ child right : Type
+ alternative CtxApp:
+ child left : {[(String, [String])]}
+ child right : Type
+ alternative QuantApp:
+ child left : {String}
+ child right : Type
+ alternative TypeApp:
+ child func : Type
+ child args : Types
+ alternative TupleType:
+ child tps : Types
+ alternative UnboxedTupleType:
+ child tps : Types
+ alternative List:
+ child tp : Type
+ alternative SimpleType:
+ child txt : {String}
+ alternative NontermType:
+ child name : {String}
+ child params : {[String]}
+ child deforested : {Bool}
+ alternative TMaybe:
+ child tp : Type
+ alternative TEither:
+ child left : Type
+ child right : Type
+ alternative TMap:
+ child key : Type
+ child value : Type
+ alternative TIntMap:
+ child value : Type
+ alternative TSet:
+ child tp : Type
+ alternative TIntSet:
+-}
+data Type = Arr (Type) (Type)
+ | CtxApp (([(String, [String])])) (Type)
+ | QuantApp (String) (Type)
+ | TypeApp (Type) (Types)
+ | TupleType (Types)
+ | UnboxedTupleType (Types)
+ | List (Type)
+ | SimpleType (String)
+ | NontermType (String) (([String])) (Bool)
+ | TMaybe (Type)
+ | TEither (Type) (Type)
+ | TMap (Type) (Type)
+ | TIntMap (Type)
+ | TSet (Type)
+ | TIntSet
+ deriving ( Show)
+-- Types -------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Type
+ child tl : Types
+ alternative Nil:
+-}
type Types = [Type] \ No newline at end of file
diff --git a/src-generated/CodeSyntax.hs b/src-generated/CodeSyntax.hs
index 3ec4393..307dc3d 100644..100755
--- a/src-generated/CodeSyntax.hs
+++ b/src-generated/CodeSyntax.hs
@@ -1,151 +1,151 @@
-
-
--- UUAGC 0.9.51 (src-ag/CodeSyntax.ag)
-module CodeSyntax where
-{-# LINE 2 "src-ag/CodeSyntax.ag" #-}
-
-import Patterns
-import CommonTypes
-import Data.Map(Map)
-import Data.Set(Set)
-{-# LINE 12 "dist/build/CodeSyntax.hs" #-}
--- CGrammar ----------------------------------------------------
-{-
- alternatives:
- alternative CGrammar:
- child typeSyns : {TypeSyns}
- child derivings : {Derivings}
- child wrappers : {Set NontermIdent}
- child nonts : CNonterminals
- child pragmas : {PragmaMap}
- child paramMap : {ParamMap}
- child contextMap : {ContextMap}
- child quantMap : {QuantMap}
- child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))}
- child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))}
- child multivisit : {Bool}
--}
-data CGrammar = CGrammar (TypeSyns) (Derivings) ((Set NontermIdent)) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) (QuantMap) ((Map NontermIdent (Map ConstructorIdent (Set Identifier)))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))) (Bool)
--- CInterface --------------------------------------------------
-{-
- alternatives:
- alternative CInterface:
- child seg : CSegments
--}
-data CInterface = CInterface (CSegments)
--- CNonterminal ------------------------------------------------
-{-
- alternatives:
- alternative CNonterminal:
- child nt : {NontermIdent}
- child params : {[Identifier]}
- child inh : {Attributes}
- child syn : {Attributes}
- child prods : CProductions
- child inter : CInterface
--}
-data CNonterminal = CNonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (CProductions) (CInterface)
--- CNonterminals -----------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CNonterminal
- child tl : CNonterminals
- alternative Nil:
--}
-type CNonterminals = [CNonterminal]
--- CProduction -------------------------------------------------
-{-
- alternatives:
- alternative CProduction:
- child con : {ConstructorIdent}
- child visits : CVisits
- child children : {[(Identifier,Type,ChildKind)]}
- child terminals : {[Identifier]}
--}
-data CProduction = CProduction (ConstructorIdent) (CVisits) (([(Identifier,Type,ChildKind)])) (([Identifier]))
--- CProductions ------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CProduction
- child tl : CProductions
- alternative Nil:
--}
-type CProductions = [CProduction]
--- CRule -------------------------------------------------------
-{-
- alternatives:
- alternative CRule:
- child name : {Identifier}
- child isIn : {Bool}
- child hasCode : {Bool}
- child nt : {NontermIdent}
- child con : {ConstructorIdent}
- child field : {Identifier}
- child childnt : {Maybe NontermIdent}
- child tp : {Maybe Type}
- child pattern : {Pattern}
- child rhs : {[String]}
- child defines : {Map Int (Identifier,Identifier,Maybe Type)}
- child owrt : {Bool}
- child origin : {String}
- child uses : {Set (Identifier, Identifier)}
- child explicit : {Bool}
- child mbNamed : {Maybe Identifier}
- alternative CChildVisit:
- child name : {Identifier}
- child nt : {NontermIdent}
- child nr : {Int}
- child inh : {Attributes}
- child syn : {Attributes}
- child isLast : {Bool}
--}
-data CRule = CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) ((Maybe NontermIdent)) ((Maybe Type)) (Pattern) (([String])) ((Map Int (Identifier,Identifier,Maybe Type))) (Bool) (String) ((Set (Identifier, Identifier))) (Bool) ((Maybe Identifier))
- | CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool)
--- CSegment ----------------------------------------------------
-{-
- alternatives:
- alternative CSegment:
- child inh : {Attributes}
- child syn : {Attributes}
--}
-data CSegment = CSegment (Attributes) (Attributes)
--- CSegments ---------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CSegment
- child tl : CSegments
- alternative Nil:
--}
-type CSegments = [CSegment]
--- CVisit ------------------------------------------------------
-{-
- alternatives:
- alternative CVisit:
- child inh : {Attributes}
- child syn : {Attributes}
- child vss : Sequence
- child intra : Sequence
- child ordered : {Bool}
--}
-data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool)
--- CVisits -----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CVisit
- child tl : CVisits
- alternative Nil:
--}
-type CVisits = [CVisit]
--- Sequence ----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : CRule
- child tl : Sequence
- alternative Nil:
--}
+
+
+-- UUAGC 0.9.51 (src-ag/CodeSyntax.ag)
+module CodeSyntax where
+{-# LINE 2 "src-ag/CodeSyntax.ag" #-}
+
+import Patterns
+import CommonTypes
+import Data.Map(Map)
+import Data.Set(Set)
+{-# LINE 12 "dist/build/CodeSyntax.hs" #-}
+-- CGrammar ----------------------------------------------------
+{-
+ alternatives:
+ alternative CGrammar:
+ child typeSyns : {TypeSyns}
+ child derivings : {Derivings}
+ child wrappers : {Set NontermIdent}
+ child nonts : CNonterminals
+ child pragmas : {PragmaMap}
+ child paramMap : {ParamMap}
+ child contextMap : {ContextMap}
+ child quantMap : {QuantMap}
+ child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))}
+ child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))}
+ child multivisit : {Bool}
+-}
+data CGrammar = CGrammar (TypeSyns) (Derivings) ((Set NontermIdent)) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) (QuantMap) ((Map NontermIdent (Map ConstructorIdent (Set Identifier)))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))) (Bool)
+-- CInterface --------------------------------------------------
+{-
+ alternatives:
+ alternative CInterface:
+ child seg : CSegments
+-}
+data CInterface = CInterface (CSegments)
+-- CNonterminal ------------------------------------------------
+{-
+ alternatives:
+ alternative CNonterminal:
+ child nt : {NontermIdent}
+ child params : {[Identifier]}
+ child inh : {Attributes}
+ child syn : {Attributes}
+ child prods : CProductions
+ child inter : CInterface
+-}
+data CNonterminal = CNonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (CProductions) (CInterface)
+-- CNonterminals -----------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CNonterminal
+ child tl : CNonterminals
+ alternative Nil:
+-}
+type CNonterminals = [CNonterminal]
+-- CProduction -------------------------------------------------
+{-
+ alternatives:
+ alternative CProduction:
+ child con : {ConstructorIdent}
+ child visits : CVisits
+ child children : {[(Identifier,Type,ChildKind)]}
+ child terminals : {[Identifier]}
+-}
+data CProduction = CProduction (ConstructorIdent) (CVisits) (([(Identifier,Type,ChildKind)])) (([Identifier]))
+-- CProductions ------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CProduction
+ child tl : CProductions
+ alternative Nil:
+-}
+type CProductions = [CProduction]
+-- CRule -------------------------------------------------------
+{-
+ alternatives:
+ alternative CRule:
+ child name : {Identifier}
+ child isIn : {Bool}
+ child hasCode : {Bool}
+ child nt : {NontermIdent}
+ child con : {ConstructorIdent}
+ child field : {Identifier}
+ child childnt : {Maybe NontermIdent}
+ child tp : {Maybe Type}
+ child pattern : {Pattern}
+ child rhs : {[String]}
+ child defines : {Map Int (Identifier,Identifier,Maybe Type)}
+ child owrt : {Bool}
+ child origin : {String}
+ child uses : {Set (Identifier, Identifier)}
+ child explicit : {Bool}
+ child mbNamed : {Maybe Identifier}
+ alternative CChildVisit:
+ child name : {Identifier}
+ child nt : {NontermIdent}
+ child nr : {Int}
+ child inh : {Attributes}
+ child syn : {Attributes}
+ child isLast : {Bool}
+-}
+data CRule = CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) ((Maybe NontermIdent)) ((Maybe Type)) (Pattern) (([String])) ((Map Int (Identifier,Identifier,Maybe Type))) (Bool) (String) ((Set (Identifier, Identifier))) (Bool) ((Maybe Identifier))
+ | CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool)
+-- CSegment ----------------------------------------------------
+{-
+ alternatives:
+ alternative CSegment:
+ child inh : {Attributes}
+ child syn : {Attributes}
+-}
+data CSegment = CSegment (Attributes) (Attributes)
+-- CSegments ---------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CSegment
+ child tl : CSegments
+ alternative Nil:
+-}
+type CSegments = [CSegment]
+-- CVisit ------------------------------------------------------
+{-
+ alternatives:
+ alternative CVisit:
+ child inh : {Attributes}
+ child syn : {Attributes}
+ child vss : Sequence
+ child intra : Sequence
+ child ordered : {Bool}
+-}
+data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool)
+-- CVisits -----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CVisit
+ child tl : CVisits
+ alternative Nil:
+-}
+type CVisits = [CVisit]
+-- Sequence ----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : CRule
+ child tl : Sequence
+ alternative Nil:
+-}
type Sequence = [CRule] \ No newline at end of file
diff --git a/src-generated/CodeSyntaxDump.hs b/src-generated/CodeSyntaxDump.hs
index fa366db..eba939d 100644..100755
--- a/src-generated/CodeSyntaxDump.hs
+++ b/src-generated/CodeSyntaxDump.hs
@@ -1,1109 +1,1109 @@
-{-# LANGUAGE Rank2Types, GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module CodeSyntaxDump where
-{-# LINE 2 "src-ag/Patterns.ag" #-}
-
--- Patterns.ag imports
-import UU.Scanner.Position(Pos)
-import CommonTypes (ConstructorIdent,Identifier)
-{-# LINE 11 "dist/build/CodeSyntaxDump.hs" #-}
-
-{-# LINE 2 "src-ag/CodeSyntax.ag" #-}
-
-import Patterns
-import CommonTypes
-import Data.Map(Map)
-import Data.Set(Set)
-{-# LINE 19 "dist/build/CodeSyntaxDump.hs" #-}
-
-{-# LINE 5 "src-ag/CodeSyntaxDump.ag" #-}
-
-import Data.List
-import qualified Data.Map as Map
-
-import Pretty
-import PPUtil
-
-import CodeSyntax
-{-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-}
-import Control.Monad.Identity (Identity)
-import qualified Control.Monad.Identity
-{-# LINE 15 "src-ag/CodeSyntaxDump.ag" #-}
-
-ppChild :: (Identifier,Type,ChildKind) -> PP_Doc
-ppChild (nm,tp,_)
- = pp nm >#< "::" >#< pp (show tp)
-
-ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc
-ppVertexMap m
- = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ]
-
-ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc
-ppAttr (fld,nm,mTp)
- = pp fld >|< "." >|< pp nm >#<
- case mTp of
- Just tp -> pp "::" >#< show tp
- Nothing -> empty
-
-ppBool :: Bool -> PP_Doc
-ppBool True = pp "T"
-ppBool False = pp "F"
-
-ppMaybeShow :: Show a => Maybe a -> PP_Doc
-ppMaybeShow (Just x) = pp (show x)
-ppMaybeShow Nothing = pp "_"
-
-ppStrings :: [String] -> PP_Doc
-ppStrings = vlist
-{-# LINE 60 "dist/build/CodeSyntaxDump.hs" #-}
--- CGrammar ----------------------------------------------------
--- wrapper
-data Inh_CGrammar = Inh_CGrammar { }
-data Syn_CGrammar = Syn_CGrammar { pp_Syn_CGrammar :: (PP_Doc) }
-{-# INLINABLE wrap_CGrammar #-}
-wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar )
-wrap_CGrammar (T_CGrammar act) (Inh_CGrammar ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg1 = T_CGrammar_vIn1
- (T_CGrammar_vOut1 _lhsOpp) <- return (inv_CGrammar_s2 sem arg1)
- return (Syn_CGrammar _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CGrammar #-}
-sem_CGrammar :: CGrammar -> T_CGrammar
-sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_
-
--- semantic domain
-newtype T_CGrammar = T_CGrammar {
- attach_T_CGrammar :: Identity (T_CGrammar_s2 )
- }
-newtype T_CGrammar_s2 = C_CGrammar_s2 {
- inv_CGrammar_s2 :: (T_CGrammar_v1 )
- }
-data T_CGrammar_s3 = C_CGrammar_s3
-type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 )
-data T_CGrammar_vIn1 = T_CGrammar_vIn1
-data T_CGrammar_vOut1 = T_CGrammar_vOut1 (PP_Doc)
-{-# NOINLINE sem_CGrammar_CGrammar #-}
-sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar
-sem_CGrammar_CGrammar arg_typeSyns_ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ = T_CGrammar (return st2) where
- {-# NOINLINE st2 #-}
- st2 = let
- v1 :: T_CGrammar_v1
- v1 = \ (T_CGrammar_vIn1 ) -> ( let
- _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_))
- (T_CNonterminals_vOut10 _nontsIpp _nontsIppL) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule0 _nontsIppL arg_derivings_ arg_typeSyns_
- __result_ = T_CGrammar_vOut1 _lhsOpp
- in __result_ )
- in C_CGrammar_s2 v1
- {-# INLINE rule0 #-}
- {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-}
- rule0 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ ->
- {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CGrammar","CGrammar"] []
- [ ppF "typeSyns" $ ppAssocL typeSyns_
- , ppF "derivings" $ ppMap $ derivings_
- , ppF "nonts" $ ppVList _nontsIppL
- ] []
- {-# LINE 114 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CInterface --------------------------------------------------
--- wrapper
-data Inh_CInterface = Inh_CInterface { }
-data Syn_CInterface = Syn_CInterface { pp_Syn_CInterface :: (PP_Doc) }
-{-# INLINABLE wrap_CInterface #-}
-wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface )
-wrap_CInterface (T_CInterface act) (Inh_CInterface ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg4 = T_CInterface_vIn4
- (T_CInterface_vOut4 _lhsOpp) <- return (inv_CInterface_s5 sem arg4)
- return (Syn_CInterface _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CInterface #-}
-sem_CInterface :: CInterface -> T_CInterface
-sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ )
-
--- semantic domain
-newtype T_CInterface = T_CInterface {
- attach_T_CInterface :: Identity (T_CInterface_s5 )
- }
-newtype T_CInterface_s5 = C_CInterface_s5 {
- inv_CInterface_s5 :: (T_CInterface_v4 )
- }
-data T_CInterface_s6 = C_CInterface_s6
-type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 )
-data T_CInterface_vIn4 = T_CInterface_vIn4
-data T_CInterface_vOut4 = T_CInterface_vOut4 (PP_Doc)
-{-# NOINLINE sem_CInterface_CInterface #-}
-sem_CInterface_CInterface :: T_CSegments -> T_CInterface
-sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where
- {-# NOINLINE st5 #-}
- st5 = let
- v4 :: T_CInterface_v4
- v4 = \ (T_CInterface_vIn4 ) -> ( let
- _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_))
- (T_CSegments_vOut25 _segIpp _segIppL) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule1 _segIppL
- __result_ = T_CInterface_vOut4 _lhsOpp
- in __result_ )
- in C_CInterface_s5 v4
- {-# INLINE rule1 #-}
- {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-}
- rule1 = \ ((_segIppL) :: [PP_Doc]) ->
- {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] []
- {-# LINE 165 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CNonterminal ------------------------------------------------
--- wrapper
-data Inh_CNonterminal = Inh_CNonterminal { }
-data Syn_CNonterminal = Syn_CNonterminal { pp_Syn_CNonterminal :: (PP_Doc) }
-{-# INLINABLE wrap_CNonterminal #-}
-wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal )
-wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg7 = T_CNonterminal_vIn7
- (T_CNonterminal_vOut7 _lhsOpp) <- return (inv_CNonterminal_s8 sem arg7)
- return (Syn_CNonterminal _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CNonterminal #-}
-sem_CNonterminal :: CNonterminal -> T_CNonterminal
-sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ )
-
--- semantic domain
-newtype T_CNonterminal = T_CNonterminal {
- attach_T_CNonterminal :: Identity (T_CNonterminal_s8 )
- }
-newtype T_CNonterminal_s8 = C_CNonterminal_s8 {
- inv_CNonterminal_s8 :: (T_CNonterminal_v7 )
- }
-data T_CNonterminal_s9 = C_CNonterminal_s9
-type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 )
-data T_CNonterminal_vIn7 = T_CNonterminal_vIn7
-data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 (PP_Doc)
-{-# NOINLINE sem_CNonterminal_CNonterminal #-}
-sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal
-sem_CNonterminal_CNonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where
- {-# NOINLINE st8 #-}
- st8 = let
- v7 :: T_CNonterminal_v7
- v7 = \ (T_CNonterminal_vIn7 ) -> ( let
- _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_))
- _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_))
- (T_CProductions_vOut16 _prodsIpp _prodsIppL) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 )
- (T_CInterface_vOut4 _interIpp) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule2 _interIpp _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_
- __result_ = T_CNonterminal_vOut7 _lhsOpp
- in __result_ )
- in C_CNonterminal_s8 v7
- {-# INLINE rule2 #-}
- {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-}
- rule2 = \ ((_interIpp) :: PP_Doc) ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ ->
- {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] []
- {-# LINE 218 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CNonterminals -----------------------------------------------
--- wrapper
-data Inh_CNonterminals = Inh_CNonterminals { }
-data Syn_CNonterminals = Syn_CNonterminals { pp_Syn_CNonterminals :: (PP_Doc), ppL_Syn_CNonterminals :: ([PP_Doc]) }
-{-# INLINABLE wrap_CNonterminals #-}
-wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals )
-wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg10 = T_CNonterminals_vIn10
- (T_CNonterminals_vOut10 _lhsOpp _lhsOppL) <- return (inv_CNonterminals_s11 sem arg10)
- return (Syn_CNonterminals _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_CNonterminals #-}
-sem_CNonterminals :: CNonterminals -> T_CNonterminals
-sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)
-
--- semantic domain
-newtype T_CNonterminals = T_CNonterminals {
- attach_T_CNonterminals :: Identity (T_CNonterminals_s11 )
- }
-newtype T_CNonterminals_s11 = C_CNonterminals_s11 {
- inv_CNonterminals_s11 :: (T_CNonterminals_v10 )
- }
-data T_CNonterminals_s12 = C_CNonterminals_s12
-type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 )
-data T_CNonterminals_vIn10 = T_CNonterminals_vIn10
-data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_CNonterminals_Cons #-}
-sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals
-sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where
- {-# NOINLINE st11 #-}
- st11 = let
- v10 :: T_CNonterminals_v10
- v10 = \ (T_CNonterminals_vIn10 ) -> ( let
- _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_))
- _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_))
- (T_CNonterminal_vOut7 _hdIpp) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 )
- (T_CNonterminals_vOut10 _tlIpp _tlIppL) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule3 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule4 _hdIpp _tlIpp
- __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL
- in __result_ )
- in C_CNonterminals_s11 v10
- {-# INLINE rule3 #-}
- {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-}
- rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 273 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule4 #-}
- rule4 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_CNonterminals_Nil #-}
-sem_CNonterminals_Nil :: T_CNonterminals
-sem_CNonterminals_Nil = T_CNonterminals (return st11) where
- {-# NOINLINE st11 #-}
- st11 = let
- v10 :: T_CNonterminals_v10
- v10 = \ (T_CNonterminals_vIn10 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule5 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule6 ()
- __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL
- in __result_ )
- in C_CNonterminals_s11 v10
- {-# INLINE rule5 #-}
- {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-}
- rule5 = \ (_ :: ()) ->
- {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 296 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule6 #-}
- rule6 = \ (_ :: ()) ->
- empty
-
--- CProduction -------------------------------------------------
--- wrapper
-data Inh_CProduction = Inh_CProduction { }
-data Syn_CProduction = Syn_CProduction { pp_Syn_CProduction :: (PP_Doc) }
-{-# INLINABLE wrap_CProduction #-}
-wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction )
-wrap_CProduction (T_CProduction act) (Inh_CProduction ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg13 = T_CProduction_vIn13
- (T_CProduction_vOut13 _lhsOpp) <- return (inv_CProduction_s14 sem arg13)
- return (Syn_CProduction _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CProduction #-}
-sem_CProduction :: CProduction -> T_CProduction
-sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_
-
--- semantic domain
-newtype T_CProduction = T_CProduction {
- attach_T_CProduction :: Identity (T_CProduction_s14 )
- }
-newtype T_CProduction_s14 = C_CProduction_s14 {
- inv_CProduction_s14 :: (T_CProduction_v13 )
- }
-data T_CProduction_s15 = C_CProduction_s15
-type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 )
-data T_CProduction_vIn13 = T_CProduction_vIn13
-data T_CProduction_vOut13 = T_CProduction_vOut13 (PP_Doc)
-{-# NOINLINE sem_CProduction_CProduction #-}
-sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction
-sem_CProduction_CProduction arg_con_ arg_visits_ arg_children_ arg_terminals_ = T_CProduction (return st14) where
- {-# NOINLINE st14 #-}
- st14 = let
- v13 :: T_CProduction_v13
- v13 = \ (T_CProduction_vIn13 ) -> ( let
- _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_))
- (T_CVisits_vOut31 _visitsIpp _visitsIppL) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule7 _visitsIppL arg_children_ arg_con_ arg_terminals_
- __result_ = T_CProduction_vOut13 _lhsOpp
- in __result_ )
- in C_CProduction_s14 v13
- {-# INLINE rule7 #-}
- {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-}
- rule7 = \ ((_visitsIppL) :: [PP_Doc]) children_ con_ terminals_ ->
- {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] []
- {-# LINE 350 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CProductions ------------------------------------------------
--- wrapper
-data Inh_CProductions = Inh_CProductions { }
-data Syn_CProductions = Syn_CProductions { pp_Syn_CProductions :: (PP_Doc), ppL_Syn_CProductions :: ([PP_Doc]) }
-{-# INLINABLE wrap_CProductions #-}
-wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions )
-wrap_CProductions (T_CProductions act) (Inh_CProductions ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg16 = T_CProductions_vIn16
- (T_CProductions_vOut16 _lhsOpp _lhsOppL) <- return (inv_CProductions_s17 sem arg16)
- return (Syn_CProductions _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_CProductions #-}
-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 {
- attach_T_CProductions :: Identity (T_CProductions_s17 )
- }
-newtype T_CProductions_s17 = C_CProductions_s17 {
- inv_CProductions_s17 :: (T_CProductions_v16 )
- }
-data T_CProductions_s18 = C_CProductions_s18
-type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 )
-data T_CProductions_vIn16 = T_CProductions_vIn16
-data T_CProductions_vOut16 = T_CProductions_vOut16 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_CProductions_Cons #-}
-sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions
-sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_CProductions_v16
- v16 = \ (T_CProductions_vIn16 ) -> ( let
- _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_))
- _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_))
- (T_CProduction_vOut13 _hdIpp) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 )
- (T_CProductions_vOut16 _tlIpp _tlIppL) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule8 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule9 _hdIpp _tlIpp
- __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL
- in __result_ )
- in C_CProductions_s17 v16
- {-# INLINE rule8 #-}
- {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-}
- rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 405 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule9 #-}
- rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_CProductions_Nil #-}
-sem_CProductions_Nil :: T_CProductions
-sem_CProductions_Nil = T_CProductions (return st17) where
- {-# NOINLINE st17 #-}
- st17 = let
- v16 :: T_CProductions_v16
- v16 = \ (T_CProductions_vIn16 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule10 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule11 ()
- __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL
- in __result_ )
- in C_CProductions_s17 v16
- {-# INLINE rule10 #-}
- {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-}
- rule10 = \ (_ :: ()) ->
- {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 428 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule11 #-}
- rule11 = \ (_ :: ()) ->
- empty
-
--- CRule -------------------------------------------------------
--- wrapper
-data Inh_CRule = Inh_CRule { }
-data Syn_CRule = Syn_CRule { pp_Syn_CRule :: (PP_Doc) }
-{-# INLINABLE wrap_CRule #-}
-wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule )
-wrap_CRule (T_CRule act) (Inh_CRule ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg19 = T_CRule_vIn19
- (T_CRule_vOut19 _lhsOpp) <- return (inv_CRule_s20 sem arg19)
- return (Syn_CRule _lhsOpp)
- )
-
--- cata
-{-# NOINLINE sem_CRule #-}
-sem_CRule :: CRule -> T_CRule
-sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_
-sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_
-
--- semantic domain
-newtype T_CRule = T_CRule {
- attach_T_CRule :: Identity (T_CRule_s20 )
- }
-newtype T_CRule_s20 = C_CRule_s20 {
- inv_CRule_s20 :: (T_CRule_v19 )
- }
-data T_CRule_s21 = C_CRule_s21
-type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 )
-data T_CRule_vIn19 = T_CRule_vIn19
-data T_CRule_vOut19 = T_CRule_vOut19 (PP_Doc)
-{-# NOINLINE sem_CRule_CRule #-}
-sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule
-sem_CRule_CRule arg_name_ arg_isIn_ arg_hasCode_ arg_nt_ arg_con_ arg_field_ arg_childnt_ arg_tp_ arg_pattern_ arg_rhs_ arg_defines_ arg_owrt_ arg_origin_ _ _ _ = T_CRule (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_CRule_v19
- v19 = \ (T_CRule_vIn19 ) -> ( let
- _patternX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
- (T_Pattern_vOut34 _patternIcopy _patternIpp) = inv_Pattern_s35 _patternX35 (T_Pattern_vIn34 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule12 _patternIpp arg_childnt_ arg_con_ arg_defines_ arg_field_ arg_hasCode_ arg_isIn_ arg_name_ arg_nt_ arg_origin_ arg_owrt_ arg_rhs_ arg_tp_
- __result_ = T_CRule_vOut19 _lhsOpp
- in __result_ )
- in C_CRule_s20 v19
- {-# INLINE rule12 #-}
- {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-}
- rule12 = \ ((_patternIpp) :: PP_Doc) childnt_ con_ defines_ field_ hasCode_ isIn_ name_ nt_ origin_ owrt_ rhs_ tp_ ->
- {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "<no pat because In>" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] []
- {-# LINE 483 "dist/build/CodeSyntaxDump.hs"#-}
-{-# NOINLINE sem_CRule_CChildVisit #-}
-sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule
-sem_CRule_CChildVisit arg_name_ arg_nt_ arg_nr_ arg_inh_ arg_syn_ arg_isLast_ = T_CRule (return st20) where
- {-# NOINLINE st20 #-}
- st20 = let
- v19 :: T_CRule_v19
- v19 = \ (T_CRule_vIn19 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule13 arg_inh_ arg_isLast_ arg_name_ arg_nr_ arg_nt_ arg_syn_
- __result_ = T_CRule_vOut19 _lhsOpp
- in __result_ )
- in C_CRule_s20 v19
- {-# INLINE rule13 #-}
- {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-}
- rule13 = \ inh_ isLast_ name_ nr_ nt_ syn_ ->
- {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] []
- {-# LINE 501 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CSegment ----------------------------------------------------
--- wrapper
-data Inh_CSegment = Inh_CSegment { }
-data Syn_CSegment = Syn_CSegment { pp_Syn_CSegment :: (PP_Doc) }
-{-# INLINABLE wrap_CSegment #-}
-wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment )
-wrap_CSegment (T_CSegment act) (Inh_CSegment ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg22 = T_CSegment_vIn22
- (T_CSegment_vOut22 _lhsOpp) <- return (inv_CSegment_s23 sem arg22)
- return (Syn_CSegment _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CSegment #-}
-sem_CSegment :: CSegment -> T_CSegment
-sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_
-
--- semantic domain
-newtype T_CSegment = T_CSegment {
- attach_T_CSegment :: Identity (T_CSegment_s23 )
- }
-newtype T_CSegment_s23 = C_CSegment_s23 {
- inv_CSegment_s23 :: (T_CSegment_v22 )
- }
-data T_CSegment_s24 = C_CSegment_s24
-type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 )
-data T_CSegment_vIn22 = T_CSegment_vIn22
-data T_CSegment_vOut22 = T_CSegment_vOut22 (PP_Doc)
-{-# NOINLINE sem_CSegment_CSegment #-}
-sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment
-sem_CSegment_CSegment arg_inh_ arg_syn_ = T_CSegment (return st23) where
- {-# NOINLINE st23 #-}
- st23 = let
- v22 :: T_CSegment_v22
- v22 = \ (T_CSegment_vIn22 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule14 arg_inh_ arg_syn_
- __result_ = T_CSegment_vOut22 _lhsOpp
- in __result_ )
- in C_CSegment_s23 v22
- {-# INLINE rule14 #-}
- {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-}
- rule14 = \ inh_ syn_ ->
- {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] []
- {-# LINE 550 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CSegments ---------------------------------------------------
--- wrapper
-data Inh_CSegments = Inh_CSegments { }
-data Syn_CSegments = Syn_CSegments { pp_Syn_CSegments :: (PP_Doc), ppL_Syn_CSegments :: ([PP_Doc]) }
-{-# INLINABLE wrap_CSegments #-}
-wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments )
-wrap_CSegments (T_CSegments act) (Inh_CSegments ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg25 = T_CSegments_vIn25
- (T_CSegments_vOut25 _lhsOpp _lhsOppL) <- return (inv_CSegments_s26 sem arg25)
- return (Syn_CSegments _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_CSegments #-}
-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 {
- attach_T_CSegments :: Identity (T_CSegments_s26 )
- }
-newtype T_CSegments_s26 = C_CSegments_s26 {
- inv_CSegments_s26 :: (T_CSegments_v25 )
- }
-data T_CSegments_s27 = C_CSegments_s27
-type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 )
-data T_CSegments_vIn25 = T_CSegments_vIn25
-data T_CSegments_vOut25 = T_CSegments_vOut25 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_CSegments_Cons #-}
-sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments
-sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where
- {-# NOINLINE st26 #-}
- st26 = let
- v25 :: T_CSegments_v25
- v25 = \ (T_CSegments_vIn25 ) -> ( let
- _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_))
- _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_))
- (T_CSegment_vOut22 _hdIpp) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 )
- (T_CSegments_vOut25 _tlIpp _tlIppL) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule15 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule16 _hdIpp _tlIpp
- __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL
- in __result_ )
- in C_CSegments_s26 v25
- {-# INLINE rule15 #-}
- {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-}
- rule15 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 605 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule16 #-}
- rule16 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_CSegments_Nil #-}
-sem_CSegments_Nil :: T_CSegments
-sem_CSegments_Nil = T_CSegments (return st26) where
- {-# NOINLINE st26 #-}
- st26 = let
- v25 :: T_CSegments_v25
- v25 = \ (T_CSegments_vIn25 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule17 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule18 ()
- __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL
- in __result_ )
- in C_CSegments_s26 v25
- {-# INLINE rule17 #-}
- {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-}
- rule17 = \ (_ :: ()) ->
- {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 628 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule18 #-}
- rule18 = \ (_ :: ()) ->
- empty
-
--- CVisit ------------------------------------------------------
--- wrapper
-data Inh_CVisit = Inh_CVisit { }
-data Syn_CVisit = Syn_CVisit { pp_Syn_CVisit :: (PP_Doc) }
-{-# INLINABLE wrap_CVisit #-}
-wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit )
-wrap_CVisit (T_CVisit act) (Inh_CVisit ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg28 = T_CVisit_vIn28
- (T_CVisit_vOut28 _lhsOpp) <- return (inv_CVisit_s29 sem arg28)
- return (Syn_CVisit _lhsOpp)
- )
-
--- cata
-{-# INLINE sem_CVisit #-}
-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 {
- attach_T_CVisit :: Identity (T_CVisit_s29 )
- }
-newtype T_CVisit_s29 = C_CVisit_s29 {
- inv_CVisit_s29 :: (T_CVisit_v28 )
- }
-data T_CVisit_s30 = C_CVisit_s30
-type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 )
-data T_CVisit_vIn28 = T_CVisit_vIn28
-data T_CVisit_vOut28 = T_CVisit_vOut28 (PP_Doc)
-{-# NOINLINE sem_CVisit_CVisit #-}
-sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit
-sem_CVisit_CVisit arg_inh_ arg_syn_ arg_vss_ arg_intra_ arg_ordered_ = T_CVisit (return st29) where
- {-# NOINLINE st29 #-}
- st29 = let
- v28 :: T_CVisit_v28
- v28 = \ (T_CVisit_vIn28 ) -> ( let
- _vssX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_))
- _intraX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_))
- (T_Sequence_vOut40 _vssIppL) = inv_Sequence_s41 _vssX41 (T_Sequence_vIn40 )
- (T_Sequence_vOut40 _intraIppL) = inv_Sequence_s41 _intraX41 (T_Sequence_vIn40 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule19 _intraIppL _vssIppL arg_inh_ arg_ordered_ arg_syn_
- __result_ = T_CVisit_vOut28 _lhsOpp
- in __result_ )
- in C_CVisit_s29 v28
- {-# INLINE rule19 #-}
- {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-}
- rule19 = \ ((_intraIppL) :: [PP_Doc]) ((_vssIppL) :: [PP_Doc]) inh_ ordered_ syn_ ->
- {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] []
- {-# LINE 684 "dist/build/CodeSyntaxDump.hs"#-}
-
--- CVisits -----------------------------------------------------
--- wrapper
-data Inh_CVisits = Inh_CVisits { }
-data Syn_CVisits = Syn_CVisits { pp_Syn_CVisits :: (PP_Doc), ppL_Syn_CVisits :: ([PP_Doc]) }
-{-# INLINABLE wrap_CVisits #-}
-wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits )
-wrap_CVisits (T_CVisits act) (Inh_CVisits ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg31 = T_CVisits_vIn31
- (T_CVisits_vOut31 _lhsOpp _lhsOppL) <- return (inv_CVisits_s32 sem arg31)
- return (Syn_CVisits _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_CVisits #-}
-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 {
- attach_T_CVisits :: Identity (T_CVisits_s32 )
- }
-newtype T_CVisits_s32 = C_CVisits_s32 {
- inv_CVisits_s32 :: (T_CVisits_v31 )
- }
-data T_CVisits_s33 = C_CVisits_s33
-type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 )
-data T_CVisits_vIn31 = T_CVisits_vIn31
-data T_CVisits_vOut31 = T_CVisits_vOut31 (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_CVisits_Cons #-}
-sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits
-sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where
- {-# NOINLINE st32 #-}
- st32 = let
- v31 :: T_CVisits_v31
- v31 = \ (T_CVisits_vIn31 ) -> ( let
- _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_))
- _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_))
- (T_CVisit_vOut28 _hdIpp) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 )
- (T_CVisits_vOut31 _tlIpp _tlIppL) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule20 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule21 _hdIpp _tlIpp
- __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL
- in __result_ )
- in C_CVisits_s32 v31
- {-# INLINE rule20 #-}
- {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-}
- rule20 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 739 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule21 #-}
- rule21 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
-{-# NOINLINE sem_CVisits_Nil #-}
-sem_CVisits_Nil :: T_CVisits
-sem_CVisits_Nil = T_CVisits (return st32) where
- {-# NOINLINE st32 #-}
- st32 = let
- v31 :: T_CVisits_v31
- v31 = \ (T_CVisits_vIn31 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule22 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule23 ()
- __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL
- in __result_ )
- in C_CVisits_s32 v31
- {-# INLINE rule22 #-}
- {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-}
- rule22 = \ (_ :: ()) ->
- {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 762 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule23 #-}
- rule23 = \ (_ :: ()) ->
- empty
-
--- Pattern -----------------------------------------------------
--- wrapper
-data Inh_Pattern = Inh_Pattern { }
-data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) }
-{-# INLINABLE wrap_Pattern #-}
-wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
-wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg34 = T_Pattern_vIn34
- (T_Pattern_vOut34 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s35 sem arg34)
- return (Syn_Pattern _lhsOcopy _lhsOpp)
- )
-
--- cata
-{-# NOINLINE sem_Pattern #-}
-sem_Pattern :: Pattern -> T_Pattern
-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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
-sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
-sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
-
--- semantic domain
-newtype T_Pattern = T_Pattern {
- attach_T_Pattern :: Identity (T_Pattern_s35 )
- }
-newtype T_Pattern_s35 = C_Pattern_s35 {
- inv_Pattern_s35 :: (T_Pattern_v34 )
- }
-data T_Pattern_s36 = C_Pattern_s36
-type T_Pattern_v34 = (T_Pattern_vIn34 ) -> (T_Pattern_vOut34 )
-data T_Pattern_vIn34 = T_Pattern_vIn34
-data T_Pattern_vOut34 = T_Pattern_vOut34 (Pattern) (PP_Doc)
-{-# NOINLINE sem_Pattern_Constr #-}
-sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
-sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Pattern_v34
- v34 = \ (T_Pattern_vIn34 ) -> ( let
- _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule24 _patsIppL arg_name_
- _copy = rule25 _patsIcopy arg_name_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule26 _copy
- __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s35 v34
- {-# INLINE rule24 #-}
- {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-}
- rule24 = \ ((_patsIppL) :: [PP_Doc]) name_ ->
- {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []
- {-# LINE 823 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule25 #-}
- rule25 = \ ((_patsIcopy) :: Patterns) name_ ->
- Constr name_ _patsIcopy
- {-# INLINE rule26 #-}
- rule26 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Product #-}
-sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
-sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Pattern_v34
- v34 = \ (T_Pattern_vIn34 ) -> ( let
- _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
- (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule27 _patsIppL arg_pos_
- _copy = rule28 _patsIcopy arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule29 _copy
- __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s35 v34
- {-# INLINE rule27 #-}
- {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-}
- rule27 = \ ((_patsIppL) :: [PP_Doc]) pos_ ->
- {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []
- {-# LINE 852 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule28 #-}
- rule28 = \ ((_patsIcopy) :: Patterns) pos_ ->
- Product pos_ _patsIcopy
- {-# INLINE rule29 #-}
- rule29 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Alias #-}
-sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
-sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Pattern_v34
- v34 = \ (T_Pattern_vIn34 ) -> ( let
- _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule30 _patIpp arg_attr_ arg_field_
- _copy = rule31 _patIcopy arg_attr_ arg_field_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule32 _copy
- __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s35 v34
- {-# INLINE rule30 #-}
- {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-}
- rule30 = \ ((_patIpp) :: PP_Doc) attr_ field_ ->
- {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []
- {-# LINE 881 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule31 #-}
- rule31 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
- Alias field_ attr_ _patIcopy
- {-# INLINE rule32 #-}
- rule32 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Irrefutable #-}
-sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
-sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Pattern_v34
- v34 = \ (T_Pattern_vIn34 ) -> ( let
- _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
- (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 )
- _lhsOpp :: PP_Doc
- _lhsOpp = rule33 _patIpp
- _copy = rule34 _patIcopy
- _lhsOcopy :: Pattern
- _lhsOcopy = rule35 _copy
- __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s35 v34
- {-# INLINE rule33 #-}
- rule33 = \ ((_patIpp) :: PP_Doc) ->
- _patIpp
- {-# INLINE rule34 #-}
- rule34 = \ ((_patIcopy) :: Pattern) ->
- Irrefutable _patIcopy
- {-# INLINE rule35 #-}
- rule35 = \ _copy ->
- _copy
-{-# NOINLINE sem_Pattern_Underscore #-}
-sem_Pattern_Underscore :: (Pos) -> T_Pattern
-sem_Pattern_Underscore arg_pos_ = T_Pattern (return st35) where
- {-# NOINLINE st35 #-}
- st35 = let
- v34 :: T_Pattern_v34
- v34 = \ (T_Pattern_vIn34 ) -> ( let
- _lhsOpp :: PP_Doc
- _lhsOpp = rule36 arg_pos_
- _copy = rule37 arg_pos_
- _lhsOcopy :: Pattern
- _lhsOcopy = rule38 _copy
- __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
- in __result_ )
- in C_Pattern_s35 v34
- {-# INLINE rule36 #-}
- {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-}
- rule36 = \ pos_ ->
- {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-}
- ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []
- {-# LINE 934 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule37 #-}
- rule37 = \ pos_ ->
- Underscore pos_
- {-# INLINE rule38 #-}
- rule38 = \ _copy ->
- _copy
-
--- Patterns ----------------------------------------------------
--- wrapper
-data Inh_Patterns = Inh_Patterns { }
-data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) }
-{-# INLINABLE wrap_Patterns #-}
-wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
-wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg37 = T_Patterns_vIn37
- (T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s38 sem arg37)
- return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Patterns #-}
-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 {
- attach_T_Patterns :: Identity (T_Patterns_s38 )
- }
-newtype T_Patterns_s38 = C_Patterns_s38 {
- inv_Patterns_s38 :: (T_Patterns_v37 )
- }
-data T_Patterns_s39 = C_Patterns_s39
-type T_Patterns_v37 = (T_Patterns_vIn37 ) -> (T_Patterns_vOut37 )
-data T_Patterns_vIn37 = T_Patterns_vIn37
-data T_Patterns_vOut37 = T_Patterns_vOut37 (Patterns) (PP_Doc) ([PP_Doc])
-{-# NOINLINE sem_Patterns_Cons #-}
-sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
-sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st38) where
- {-# NOINLINE st38 #-}
- st38 = let
- v37 :: T_Patterns_v37
- v37 = \ (T_Patterns_vIn37 ) -> ( let
- _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
- _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
- (T_Pattern_vOut34 _hdIcopy _hdIpp) = inv_Pattern_s35 _hdX35 (T_Pattern_vIn34 )
- (T_Patterns_vOut37 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s38 _tlX38 (T_Patterns_vIn37 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule39 _hdIpp _tlIppL
- _lhsOpp :: PP_Doc
- _lhsOpp = rule40 _hdIpp _tlIpp
- _copy = rule41 _hdIcopy _tlIcopy
- _lhsOcopy :: Patterns
- _lhsOcopy = rule42 _copy
- __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL
- in __result_ )
- in C_Patterns_s38 v37
- {-# INLINE rule39 #-}
- {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-}
- rule39 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 998 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule40 #-}
- rule40 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
- _hdIpp >-< _tlIpp
- {-# INLINE rule41 #-}
- rule41 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
- (:) _hdIcopy _tlIcopy
- {-# INLINE rule42 #-}
- rule42 = \ _copy ->
- _copy
-{-# NOINLINE sem_Patterns_Nil #-}
-sem_Patterns_Nil :: T_Patterns
-sem_Patterns_Nil = T_Patterns (return st38) where
- {-# NOINLINE st38 #-}
- st38 = let
- v37 :: T_Patterns_v37
- v37 = \ (T_Patterns_vIn37 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule43 ()
- _lhsOpp :: PP_Doc
- _lhsOpp = rule44 ()
- _copy = rule45 ()
- _lhsOcopy :: Patterns
- _lhsOcopy = rule46 _copy
- __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL
- in __result_ )
- in C_Patterns_s38 v37
- {-# INLINE rule43 #-}
- {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-}
- rule43 = \ (_ :: ()) ->
- {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 1030 "dist/build/CodeSyntaxDump.hs"#-}
- {-# INLINE rule44 #-}
- rule44 = \ (_ :: ()) ->
- empty
- {-# INLINE rule45 #-}
- rule45 = \ (_ :: ()) ->
- []
- {-# INLINE rule46 #-}
- rule46 = \ _copy ->
- _copy
-
--- Sequence ----------------------------------------------------
--- wrapper
-data Inh_Sequence = Inh_Sequence { }
-data Syn_Sequence = Syn_Sequence { ppL_Syn_Sequence :: ([PP_Doc]) }
-{-# INLINABLE wrap_Sequence #-}
-wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence )
-wrap_Sequence (T_Sequence act) (Inh_Sequence ) =
- Control.Monad.Identity.runIdentity (
- do sem <- act
- let arg40 = T_Sequence_vIn40
- (T_Sequence_vOut40 _lhsOppL) <- return (inv_Sequence_s41 sem arg40)
- return (Syn_Sequence _lhsOppL)
- )
-
--- cata
-{-# NOINLINE sem_Sequence #-}
-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 {
- attach_T_Sequence :: Identity (T_Sequence_s41 )
- }
-newtype T_Sequence_s41 = C_Sequence_s41 {
- inv_Sequence_s41 :: (T_Sequence_v40 )
- }
-data T_Sequence_s42 = C_Sequence_s42
-type T_Sequence_v40 = (T_Sequence_vIn40 ) -> (T_Sequence_vOut40 )
-data T_Sequence_vIn40 = T_Sequence_vIn40
-data T_Sequence_vOut40 = T_Sequence_vOut40 ([PP_Doc])
-{-# NOINLINE sem_Sequence_Cons #-}
-sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence
-sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st41) where
- {-# NOINLINE st41 #-}
- st41 = let
- v40 :: T_Sequence_v40
- v40 = \ (T_Sequence_vIn40 ) -> ( let
- _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_))
- _tlX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_))
- (T_CRule_vOut19 _hdIpp) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 )
- (T_Sequence_vOut40 _tlIppL) = inv_Sequence_s41 _tlX41 (T_Sequence_vIn40 )
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule47 _hdIpp _tlIppL
- __result_ = T_Sequence_vOut40 _lhsOppL
- in __result_ )
- in C_Sequence_s41 v40
- {-# INLINE rule47 #-}
- {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-}
- rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
- {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-}
- _hdIpp : _tlIppL
- {-# LINE 1092 "dist/build/CodeSyntaxDump.hs"#-}
-{-# NOINLINE sem_Sequence_Nil #-}
-sem_Sequence_Nil :: T_Sequence
-sem_Sequence_Nil = T_Sequence (return st41) where
- {-# NOINLINE st41 #-}
- st41 = let
- v40 :: T_Sequence_v40
- v40 = \ (T_Sequence_vIn40 ) -> ( let
- _lhsOppL :: [PP_Doc]
- _lhsOppL = rule48 ()
- __result_ = T_Sequence_vOut40 _lhsOppL
- in __result_ )
- in C_Sequence_s41 v40
- {-# INLINE rule48 #-}
- {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-}
- rule48 = \ (_ :: ()) ->
- {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-}
- []
- {-# LINE 1110 "dist/build/CodeSyntaxDump.hs"#-}
+{-# LANGUAGE Rank2Types, GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module CodeSyntaxDump where
+{-# LINE 2 "src-ag/Patterns.ag" #-}
+
+-- Patterns.ag imports
+import UU.Scanner.Position(Pos)
+import CommonTypes (ConstructorIdent,Identifier)
+{-# LINE 11 "dist/build/CodeSyntaxDump.hs" #-}
+
+{-# LINE 2 "src-ag/CodeSyntax.ag" #-}
+
+import Patterns
+import CommonTypes
+import Data.Map(Map)
+import Data.Set(Set)
+{-# LINE 19 "dist/build/CodeSyntaxDump.hs" #-}
+
+{-# LINE 5 "src-ag/CodeSyntaxDump.ag" #-}
+
+import Data.List
+import qualified Data.Map as Map
+
+import Pretty
+import PPUtil
+
+import CodeSyntax
+{-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-}
+import Control.Monad.Identity (Identity)
+import qualified Control.Monad.Identity
+{-# LINE 15 "src-ag/CodeSyntaxDump.ag" #-}
+
+ppChild :: (Identifier,Type,ChildKind) -> PP_Doc
+ppChild (nm,tp,_)
+ = pp nm >#< "::" >#< pp (show tp)
+
+ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc
+ppVertexMap m
+ = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ]
+
+ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc
+ppAttr (fld,nm,mTp)
+ = pp fld >|< "." >|< pp nm >#<
+ case mTp of
+ Just tp -> pp "::" >#< show tp
+ Nothing -> empty
+
+ppBool :: Bool -> PP_Doc
+ppBool True = pp "T"
+ppBool False = pp "F"
+
+ppMaybeShow :: Show a => Maybe a -> PP_Doc
+ppMaybeShow (Just x) = pp (show x)
+ppMaybeShow Nothing = pp "_"
+
+ppStrings :: [String] -> PP_Doc
+ppStrings = vlist
+{-# LINE 60 "dist/build/CodeSyntaxDump.hs" #-}
+-- CGrammar ----------------------------------------------------
+-- wrapper
+data Inh_CGrammar = Inh_CGrammar { }
+data Syn_CGrammar = Syn_CGrammar { pp_Syn_CGrammar :: (PP_Doc) }
+{-# INLINABLE wrap_CGrammar #-}
+wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar )
+wrap_CGrammar (T_CGrammar act) (Inh_CGrammar ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg1 = T_CGrammar_vIn1
+ (T_CGrammar_vOut1 _lhsOpp) <- return (inv_CGrammar_s2 sem arg1)
+ return (Syn_CGrammar _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CGrammar #-}
+sem_CGrammar :: CGrammar -> T_CGrammar
+sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_
+
+-- semantic domain
+newtype T_CGrammar = T_CGrammar {
+ attach_T_CGrammar :: Identity (T_CGrammar_s2 )
+ }
+newtype T_CGrammar_s2 = C_CGrammar_s2 {
+ inv_CGrammar_s2 :: (T_CGrammar_v1 )
+ }
+data T_CGrammar_s3 = C_CGrammar_s3
+type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 )
+data T_CGrammar_vIn1 = T_CGrammar_vIn1
+data T_CGrammar_vOut1 = T_CGrammar_vOut1 (PP_Doc)
+{-# NOINLINE sem_CGrammar_CGrammar #-}
+sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar
+sem_CGrammar_CGrammar arg_typeSyns_ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ = T_CGrammar (return st2) where
+ {-# NOINLINE st2 #-}
+ st2 = let
+ v1 :: T_CGrammar_v1
+ v1 = \ (T_CGrammar_vIn1 ) -> ( let
+ _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_))
+ (T_CNonterminals_vOut10 _nontsIpp _nontsIppL) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule0 _nontsIppL arg_derivings_ arg_typeSyns_
+ __result_ = T_CGrammar_vOut1 _lhsOpp
+ in __result_ )
+ in C_CGrammar_s2 v1
+ {-# INLINE rule0 #-}
+ {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-}
+ rule0 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ ->
+ {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CGrammar","CGrammar"] []
+ [ ppF "typeSyns" $ ppAssocL typeSyns_
+ , ppF "derivings" $ ppMap $ derivings_
+ , ppF "nonts" $ ppVList _nontsIppL
+ ] []
+ {-# LINE 114 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CInterface --------------------------------------------------
+-- wrapper
+data Inh_CInterface = Inh_CInterface { }
+data Syn_CInterface = Syn_CInterface { pp_Syn_CInterface :: (PP_Doc) }
+{-# INLINABLE wrap_CInterface #-}
+wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface )
+wrap_CInterface (T_CInterface act) (Inh_CInterface ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg4 = T_CInterface_vIn4
+ (T_CInterface_vOut4 _lhsOpp) <- return (inv_CInterface_s5 sem arg4)
+ return (Syn_CInterface _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CInterface #-}
+sem_CInterface :: CInterface -> T_CInterface
+sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ )
+
+-- semantic domain
+newtype T_CInterface = T_CInterface {
+ attach_T_CInterface :: Identity (T_CInterface_s5 )
+ }
+newtype T_CInterface_s5 = C_CInterface_s5 {
+ inv_CInterface_s5 :: (T_CInterface_v4 )
+ }
+data T_CInterface_s6 = C_CInterface_s6
+type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 )
+data T_CInterface_vIn4 = T_CInterface_vIn4
+data T_CInterface_vOut4 = T_CInterface_vOut4 (PP_Doc)
+{-# NOINLINE sem_CInterface_CInterface #-}
+sem_CInterface_CInterface :: T_CSegments -> T_CInterface
+sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where
+ {-# NOINLINE st5 #-}
+ st5 = let
+ v4 :: T_CInterface_v4
+ v4 = \ (T_CInterface_vIn4 ) -> ( let
+ _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_))
+ (T_CSegments_vOut25 _segIpp _segIppL) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule1 _segIppL
+ __result_ = T_CInterface_vOut4 _lhsOpp
+ in __result_ )
+ in C_CInterface_s5 v4
+ {-# INLINE rule1 #-}
+ {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-}
+ rule1 = \ ((_segIppL) :: [PP_Doc]) ->
+ {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] []
+ {-# LINE 165 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CNonterminal ------------------------------------------------
+-- wrapper
+data Inh_CNonterminal = Inh_CNonterminal { }
+data Syn_CNonterminal = Syn_CNonterminal { pp_Syn_CNonterminal :: (PP_Doc) }
+{-# INLINABLE wrap_CNonterminal #-}
+wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal )
+wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg7 = T_CNonterminal_vIn7
+ (T_CNonterminal_vOut7 _lhsOpp) <- return (inv_CNonterminal_s8 sem arg7)
+ return (Syn_CNonterminal _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CNonterminal #-}
+sem_CNonterminal :: CNonterminal -> T_CNonterminal
+sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ )
+
+-- semantic domain
+newtype T_CNonterminal = T_CNonterminal {
+ attach_T_CNonterminal :: Identity (T_CNonterminal_s8 )
+ }
+newtype T_CNonterminal_s8 = C_CNonterminal_s8 {
+ inv_CNonterminal_s8 :: (T_CNonterminal_v7 )
+ }
+data T_CNonterminal_s9 = C_CNonterminal_s9
+type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 )
+data T_CNonterminal_vIn7 = T_CNonterminal_vIn7
+data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 (PP_Doc)
+{-# NOINLINE sem_CNonterminal_CNonterminal #-}
+sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal
+sem_CNonterminal_CNonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where
+ {-# NOINLINE st8 #-}
+ st8 = let
+ v7 :: T_CNonterminal_v7
+ v7 = \ (T_CNonterminal_vIn7 ) -> ( let
+ _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_))
+ _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_))
+ (T_CProductions_vOut16 _prodsIpp _prodsIppL) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 )
+ (T_CInterface_vOut4 _interIpp) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule2 _interIpp _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_
+ __result_ = T_CNonterminal_vOut7 _lhsOpp
+ in __result_ )
+ in C_CNonterminal_s8 v7
+ {-# INLINE rule2 #-}
+ {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-}
+ rule2 = \ ((_interIpp) :: PP_Doc) ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ ->
+ {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] []
+ {-# LINE 218 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CNonterminals -----------------------------------------------
+-- wrapper
+data Inh_CNonterminals = Inh_CNonterminals { }
+data Syn_CNonterminals = Syn_CNonterminals { pp_Syn_CNonterminals :: (PP_Doc), ppL_Syn_CNonterminals :: ([PP_Doc]) }
+{-# INLINABLE wrap_CNonterminals #-}
+wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals )
+wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg10 = T_CNonterminals_vIn10
+ (T_CNonterminals_vOut10 _lhsOpp _lhsOppL) <- return (inv_CNonterminals_s11 sem arg10)
+ return (Syn_CNonterminals _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_CNonterminals #-}
+sem_CNonterminals :: CNonterminals -> T_CNonterminals
+sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)
+
+-- semantic domain
+newtype T_CNonterminals = T_CNonterminals {
+ attach_T_CNonterminals :: Identity (T_CNonterminals_s11 )
+ }
+newtype T_CNonterminals_s11 = C_CNonterminals_s11 {
+ inv_CNonterminals_s11 :: (T_CNonterminals_v10 )
+ }
+data T_CNonterminals_s12 = C_CNonterminals_s12
+type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 )
+data T_CNonterminals_vIn10 = T_CNonterminals_vIn10
+data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_CNonterminals_Cons #-}
+sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals
+sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where
+ {-# NOINLINE st11 #-}
+ st11 = let
+ v10 :: T_CNonterminals_v10
+ v10 = \ (T_CNonterminals_vIn10 ) -> ( let
+ _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_))
+ _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_))
+ (T_CNonterminal_vOut7 _hdIpp) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 )
+ (T_CNonterminals_vOut10 _tlIpp _tlIppL) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule3 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule4 _hdIpp _tlIpp
+ __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CNonterminals_s11 v10
+ {-# INLINE rule3 #-}
+ {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-}
+ rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 273 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule4 #-}
+ rule4 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_CNonterminals_Nil #-}
+sem_CNonterminals_Nil :: T_CNonterminals
+sem_CNonterminals_Nil = T_CNonterminals (return st11) where
+ {-# NOINLINE st11 #-}
+ st11 = let
+ v10 :: T_CNonterminals_v10
+ v10 = \ (T_CNonterminals_vIn10 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule5 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule6 ()
+ __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CNonterminals_s11 v10
+ {-# INLINE rule5 #-}
+ {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-}
+ rule5 = \ (_ :: ()) ->
+ {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 296 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule6 #-}
+ rule6 = \ (_ :: ()) ->
+ empty
+
+-- CProduction -------------------------------------------------
+-- wrapper
+data Inh_CProduction = Inh_CProduction { }
+data Syn_CProduction = Syn_CProduction { pp_Syn_CProduction :: (PP_Doc) }
+{-# INLINABLE wrap_CProduction #-}
+wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction )
+wrap_CProduction (T_CProduction act) (Inh_CProduction ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg13 = T_CProduction_vIn13
+ (T_CProduction_vOut13 _lhsOpp) <- return (inv_CProduction_s14 sem arg13)
+ return (Syn_CProduction _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CProduction #-}
+sem_CProduction :: CProduction -> T_CProduction
+sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_
+
+-- semantic domain
+newtype T_CProduction = T_CProduction {
+ attach_T_CProduction :: Identity (T_CProduction_s14 )
+ }
+newtype T_CProduction_s14 = C_CProduction_s14 {
+ inv_CProduction_s14 :: (T_CProduction_v13 )
+ }
+data T_CProduction_s15 = C_CProduction_s15
+type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 )
+data T_CProduction_vIn13 = T_CProduction_vIn13
+data T_CProduction_vOut13 = T_CProduction_vOut13 (PP_Doc)
+{-# NOINLINE sem_CProduction_CProduction #-}
+sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction
+sem_CProduction_CProduction arg_con_ arg_visits_ arg_children_ arg_terminals_ = T_CProduction (return st14) where
+ {-# NOINLINE st14 #-}
+ st14 = let
+ v13 :: T_CProduction_v13
+ v13 = \ (T_CProduction_vIn13 ) -> ( let
+ _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_))
+ (T_CVisits_vOut31 _visitsIpp _visitsIppL) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule7 _visitsIppL arg_children_ arg_con_ arg_terminals_
+ __result_ = T_CProduction_vOut13 _lhsOpp
+ in __result_ )
+ in C_CProduction_s14 v13
+ {-# INLINE rule7 #-}
+ {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-}
+ rule7 = \ ((_visitsIppL) :: [PP_Doc]) children_ con_ terminals_ ->
+ {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] []
+ {-# LINE 350 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CProductions ------------------------------------------------
+-- wrapper
+data Inh_CProductions = Inh_CProductions { }
+data Syn_CProductions = Syn_CProductions { pp_Syn_CProductions :: (PP_Doc), ppL_Syn_CProductions :: ([PP_Doc]) }
+{-# INLINABLE wrap_CProductions #-}
+wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions )
+wrap_CProductions (T_CProductions act) (Inh_CProductions ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg16 = T_CProductions_vIn16
+ (T_CProductions_vOut16 _lhsOpp _lhsOppL) <- return (inv_CProductions_s17 sem arg16)
+ return (Syn_CProductions _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_CProductions #-}
+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 {
+ attach_T_CProductions :: Identity (T_CProductions_s17 )
+ }
+newtype T_CProductions_s17 = C_CProductions_s17 {
+ inv_CProductions_s17 :: (T_CProductions_v16 )
+ }
+data T_CProductions_s18 = C_CProductions_s18
+type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 )
+data T_CProductions_vIn16 = T_CProductions_vIn16
+data T_CProductions_vOut16 = T_CProductions_vOut16 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_CProductions_Cons #-}
+sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions
+sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_CProductions_v16
+ v16 = \ (T_CProductions_vIn16 ) -> ( let
+ _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_))
+ _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_))
+ (T_CProduction_vOut13 _hdIpp) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 )
+ (T_CProductions_vOut16 _tlIpp _tlIppL) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule8 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule9 _hdIpp _tlIpp
+ __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CProductions_s17 v16
+ {-# INLINE rule8 #-}
+ {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-}
+ rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 405 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule9 #-}
+ rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_CProductions_Nil #-}
+sem_CProductions_Nil :: T_CProductions
+sem_CProductions_Nil = T_CProductions (return st17) where
+ {-# NOINLINE st17 #-}
+ st17 = let
+ v16 :: T_CProductions_v16
+ v16 = \ (T_CProductions_vIn16 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule10 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule11 ()
+ __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CProductions_s17 v16
+ {-# INLINE rule10 #-}
+ {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-}
+ rule10 = \ (_ :: ()) ->
+ {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 428 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule11 #-}
+ rule11 = \ (_ :: ()) ->
+ empty
+
+-- CRule -------------------------------------------------------
+-- wrapper
+data Inh_CRule = Inh_CRule { }
+data Syn_CRule = Syn_CRule { pp_Syn_CRule :: (PP_Doc) }
+{-# INLINABLE wrap_CRule #-}
+wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule )
+wrap_CRule (T_CRule act) (Inh_CRule ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg19 = T_CRule_vIn19
+ (T_CRule_vOut19 _lhsOpp) <- return (inv_CRule_s20 sem arg19)
+ return (Syn_CRule _lhsOpp)
+ )
+
+-- cata
+{-# NOINLINE sem_CRule #-}
+sem_CRule :: CRule -> T_CRule
+sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_
+sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_
+
+-- semantic domain
+newtype T_CRule = T_CRule {
+ attach_T_CRule :: Identity (T_CRule_s20 )
+ }
+newtype T_CRule_s20 = C_CRule_s20 {
+ inv_CRule_s20 :: (T_CRule_v19 )
+ }
+data T_CRule_s21 = C_CRule_s21
+type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 )
+data T_CRule_vIn19 = T_CRule_vIn19
+data T_CRule_vOut19 = T_CRule_vOut19 (PP_Doc)
+{-# NOINLINE sem_CRule_CRule #-}
+sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule
+sem_CRule_CRule arg_name_ arg_isIn_ arg_hasCode_ arg_nt_ arg_con_ arg_field_ arg_childnt_ arg_tp_ arg_pattern_ arg_rhs_ arg_defines_ arg_owrt_ arg_origin_ _ _ _ = T_CRule (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_CRule_v19
+ v19 = \ (T_CRule_vIn19 ) -> ( let
+ _patternX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
+ (T_Pattern_vOut34 _patternIcopy _patternIpp) = inv_Pattern_s35 _patternX35 (T_Pattern_vIn34 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule12 _patternIpp arg_childnt_ arg_con_ arg_defines_ arg_field_ arg_hasCode_ arg_isIn_ arg_name_ arg_nt_ arg_origin_ arg_owrt_ arg_rhs_ arg_tp_
+ __result_ = T_CRule_vOut19 _lhsOpp
+ in __result_ )
+ in C_CRule_s20 v19
+ {-# INLINE rule12 #-}
+ {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-}
+ rule12 = \ ((_patternIpp) :: PP_Doc) childnt_ con_ defines_ field_ hasCode_ isIn_ name_ nt_ origin_ owrt_ rhs_ tp_ ->
+ {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "<no pat because In>" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] []
+ {-# LINE 483 "dist/build/CodeSyntaxDump.hs"#-}
+{-# NOINLINE sem_CRule_CChildVisit #-}
+sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule
+sem_CRule_CChildVisit arg_name_ arg_nt_ arg_nr_ arg_inh_ arg_syn_ arg_isLast_ = T_CRule (return st20) where
+ {-# NOINLINE st20 #-}
+ st20 = let
+ v19 :: T_CRule_v19
+ v19 = \ (T_CRule_vIn19 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule13 arg_inh_ arg_isLast_ arg_name_ arg_nr_ arg_nt_ arg_syn_
+ __result_ = T_CRule_vOut19 _lhsOpp
+ in __result_ )
+ in C_CRule_s20 v19
+ {-# INLINE rule13 #-}
+ {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-}
+ rule13 = \ inh_ isLast_ name_ nr_ nt_ syn_ ->
+ {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] []
+ {-# LINE 501 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CSegment ----------------------------------------------------
+-- wrapper
+data Inh_CSegment = Inh_CSegment { }
+data Syn_CSegment = Syn_CSegment { pp_Syn_CSegment :: (PP_Doc) }
+{-# INLINABLE wrap_CSegment #-}
+wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment )
+wrap_CSegment (T_CSegment act) (Inh_CSegment ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg22 = T_CSegment_vIn22
+ (T_CSegment_vOut22 _lhsOpp) <- return (inv_CSegment_s23 sem arg22)
+ return (Syn_CSegment _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CSegment #-}
+sem_CSegment :: CSegment -> T_CSegment
+sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_
+
+-- semantic domain
+newtype T_CSegment = T_CSegment {
+ attach_T_CSegment :: Identity (T_CSegment_s23 )
+ }
+newtype T_CSegment_s23 = C_CSegment_s23 {
+ inv_CSegment_s23 :: (T_CSegment_v22 )
+ }
+data T_CSegment_s24 = C_CSegment_s24
+type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 )
+data T_CSegment_vIn22 = T_CSegment_vIn22
+data T_CSegment_vOut22 = T_CSegment_vOut22 (PP_Doc)
+{-# NOINLINE sem_CSegment_CSegment #-}
+sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment
+sem_CSegment_CSegment arg_inh_ arg_syn_ = T_CSegment (return st23) where
+ {-# NOINLINE st23 #-}
+ st23 = let
+ v22 :: T_CSegment_v22
+ v22 = \ (T_CSegment_vIn22 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule14 arg_inh_ arg_syn_
+ __result_ = T_CSegment_vOut22 _lhsOpp
+ in __result_ )
+ in C_CSegment_s23 v22
+ {-# INLINE rule14 #-}
+ {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-}
+ rule14 = \ inh_ syn_ ->
+ {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] []
+ {-# LINE 550 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CSegments ---------------------------------------------------
+-- wrapper
+data Inh_CSegments = Inh_CSegments { }
+data Syn_CSegments = Syn_CSegments { pp_Syn_CSegments :: (PP_Doc), ppL_Syn_CSegments :: ([PP_Doc]) }
+{-# INLINABLE wrap_CSegments #-}
+wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments )
+wrap_CSegments (T_CSegments act) (Inh_CSegments ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg25 = T_CSegments_vIn25
+ (T_CSegments_vOut25 _lhsOpp _lhsOppL) <- return (inv_CSegments_s26 sem arg25)
+ return (Syn_CSegments _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_CSegments #-}
+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 {
+ attach_T_CSegments :: Identity (T_CSegments_s26 )
+ }
+newtype T_CSegments_s26 = C_CSegments_s26 {
+ inv_CSegments_s26 :: (T_CSegments_v25 )
+ }
+data T_CSegments_s27 = C_CSegments_s27
+type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 )
+data T_CSegments_vIn25 = T_CSegments_vIn25
+data T_CSegments_vOut25 = T_CSegments_vOut25 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_CSegments_Cons #-}
+sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments
+sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where
+ {-# NOINLINE st26 #-}
+ st26 = let
+ v25 :: T_CSegments_v25
+ v25 = \ (T_CSegments_vIn25 ) -> ( let
+ _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_))
+ _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_))
+ (T_CSegment_vOut22 _hdIpp) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 )
+ (T_CSegments_vOut25 _tlIpp _tlIppL) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule15 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule16 _hdIpp _tlIpp
+ __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CSegments_s26 v25
+ {-# INLINE rule15 #-}
+ {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-}
+ rule15 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 605 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule16 #-}
+ rule16 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_CSegments_Nil #-}
+sem_CSegments_Nil :: T_CSegments
+sem_CSegments_Nil = T_CSegments (return st26) where
+ {-# NOINLINE st26 #-}
+ st26 = let
+ v25 :: T_CSegments_v25
+ v25 = \ (T_CSegments_vIn25 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule17 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule18 ()
+ __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CSegments_s26 v25
+ {-# INLINE rule17 #-}
+ {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-}
+ rule17 = \ (_ :: ()) ->
+ {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 628 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule18 #-}
+ rule18 = \ (_ :: ()) ->
+ empty
+
+-- CVisit ------------------------------------------------------
+-- wrapper
+data Inh_CVisit = Inh_CVisit { }
+data Syn_CVisit = Syn_CVisit { pp_Syn_CVisit :: (PP_Doc) }
+{-# INLINABLE wrap_CVisit #-}
+wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit )
+wrap_CVisit (T_CVisit act) (Inh_CVisit ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg28 = T_CVisit_vIn28
+ (T_CVisit_vOut28 _lhsOpp) <- return (inv_CVisit_s29 sem arg28)
+ return (Syn_CVisit _lhsOpp)
+ )
+
+-- cata
+{-# INLINE sem_CVisit #-}
+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 {
+ attach_T_CVisit :: Identity (T_CVisit_s29 )
+ }
+newtype T_CVisit_s29 = C_CVisit_s29 {
+ inv_CVisit_s29 :: (T_CVisit_v28 )
+ }
+data T_CVisit_s30 = C_CVisit_s30
+type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 )
+data T_CVisit_vIn28 = T_CVisit_vIn28
+data T_CVisit_vOut28 = T_CVisit_vOut28 (PP_Doc)
+{-# NOINLINE sem_CVisit_CVisit #-}
+sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit
+sem_CVisit_CVisit arg_inh_ arg_syn_ arg_vss_ arg_intra_ arg_ordered_ = T_CVisit (return st29) where
+ {-# NOINLINE st29 #-}
+ st29 = let
+ v28 :: T_CVisit_v28
+ v28 = \ (T_CVisit_vIn28 ) -> ( let
+ _vssX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_))
+ _intraX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_))
+ (T_Sequence_vOut40 _vssIppL) = inv_Sequence_s41 _vssX41 (T_Sequence_vIn40 )
+ (T_Sequence_vOut40 _intraIppL) = inv_Sequence_s41 _intraX41 (T_Sequence_vIn40 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule19 _intraIppL _vssIppL arg_inh_ arg_ordered_ arg_syn_
+ __result_ = T_CVisit_vOut28 _lhsOpp
+ in __result_ )
+ in C_CVisit_s29 v28
+ {-# INLINE rule19 #-}
+ {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-}
+ rule19 = \ ((_intraIppL) :: [PP_Doc]) ((_vssIppL) :: [PP_Doc]) inh_ ordered_ syn_ ->
+ {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] []
+ {-# LINE 684 "dist/build/CodeSyntaxDump.hs"#-}
+
+-- CVisits -----------------------------------------------------
+-- wrapper
+data Inh_CVisits = Inh_CVisits { }
+data Syn_CVisits = Syn_CVisits { pp_Syn_CVisits :: (PP_Doc), ppL_Syn_CVisits :: ([PP_Doc]) }
+{-# INLINABLE wrap_CVisits #-}
+wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits )
+wrap_CVisits (T_CVisits act) (Inh_CVisits ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg31 = T_CVisits_vIn31
+ (T_CVisits_vOut31 _lhsOpp _lhsOppL) <- return (inv_CVisits_s32 sem arg31)
+ return (Syn_CVisits _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_CVisits #-}
+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 {
+ attach_T_CVisits :: Identity (T_CVisits_s32 )
+ }
+newtype T_CVisits_s32 = C_CVisits_s32 {
+ inv_CVisits_s32 :: (T_CVisits_v31 )
+ }
+data T_CVisits_s33 = C_CVisits_s33
+type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 )
+data T_CVisits_vIn31 = T_CVisits_vIn31
+data T_CVisits_vOut31 = T_CVisits_vOut31 (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_CVisits_Cons #-}
+sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits
+sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where
+ {-# NOINLINE st32 #-}
+ st32 = let
+ v31 :: T_CVisits_v31
+ v31 = \ (T_CVisits_vIn31 ) -> ( let
+ _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_))
+ _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_))
+ (T_CVisit_vOut28 _hdIpp) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 )
+ (T_CVisits_vOut31 _tlIpp _tlIppL) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule20 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule21 _hdIpp _tlIpp
+ __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CVisits_s32 v31
+ {-# INLINE rule20 #-}
+ {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-}
+ rule20 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 739 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule21 #-}
+ rule21 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+{-# NOINLINE sem_CVisits_Nil #-}
+sem_CVisits_Nil :: T_CVisits
+sem_CVisits_Nil = T_CVisits (return st32) where
+ {-# NOINLINE st32 #-}
+ st32 = let
+ v31 :: T_CVisits_v31
+ v31 = \ (T_CVisits_vIn31 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule22 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule23 ()
+ __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL
+ in __result_ )
+ in C_CVisits_s32 v31
+ {-# INLINE rule22 #-}
+ {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-}
+ rule22 = \ (_ :: ()) ->
+ {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 762 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule23 #-}
+ rule23 = \ (_ :: ()) ->
+ empty
+
+-- Pattern -----------------------------------------------------
+-- wrapper
+data Inh_Pattern = Inh_Pattern { }
+data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) }
+{-# INLINABLE wrap_Pattern #-}
+wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
+wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg34 = T_Pattern_vIn34
+ (T_Pattern_vOut34 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s35 sem arg34)
+ return (Syn_Pattern _lhsOcopy _lhsOpp)
+ )
+
+-- cata
+{-# NOINLINE sem_Pattern #-}
+sem_Pattern :: Pattern -> T_Pattern
+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 ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
+sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
+sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
+
+-- semantic domain
+newtype T_Pattern = T_Pattern {
+ attach_T_Pattern :: Identity (T_Pattern_s35 )
+ }
+newtype T_Pattern_s35 = C_Pattern_s35 {
+ inv_Pattern_s35 :: (T_Pattern_v34 )
+ }
+data T_Pattern_s36 = C_Pattern_s36
+type T_Pattern_v34 = (T_Pattern_vIn34 ) -> (T_Pattern_vOut34 )
+data T_Pattern_vIn34 = T_Pattern_vIn34
+data T_Pattern_vOut34 = T_Pattern_vOut34 (Pattern) (PP_Doc)
+{-# NOINLINE sem_Pattern_Constr #-}
+sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
+sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Pattern_v34
+ v34 = \ (T_Pattern_vIn34 ) -> ( let
+ _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule24 _patsIppL arg_name_
+ _copy = rule25 _patsIcopy arg_name_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule26 _copy
+ __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s35 v34
+ {-# INLINE rule24 #-}
+ {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-}
+ rule24 = \ ((_patsIppL) :: [PP_Doc]) name_ ->
+ {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []
+ {-# LINE 823 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule25 #-}
+ rule25 = \ ((_patsIcopy) :: Patterns) name_ ->
+ Constr name_ _patsIcopy
+ {-# INLINE rule26 #-}
+ rule26 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Product #-}
+sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
+sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Pattern_v34
+ v34 = \ (T_Pattern_vIn34 ) -> ( let
+ _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
+ (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule27 _patsIppL arg_pos_
+ _copy = rule28 _patsIcopy arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule29 _copy
+ __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s35 v34
+ {-# INLINE rule27 #-}
+ {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-}
+ rule27 = \ ((_patsIppL) :: [PP_Doc]) pos_ ->
+ {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []
+ {-# LINE 852 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule28 #-}
+ rule28 = \ ((_patsIcopy) :: Patterns) pos_ ->
+ Product pos_ _patsIcopy
+ {-# INLINE rule29 #-}
+ rule29 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Alias #-}
+sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
+sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Pattern_v34
+ v34 = \ (T_Pattern_vIn34 ) -> ( let
+ _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule30 _patIpp arg_attr_ arg_field_
+ _copy = rule31 _patIcopy arg_attr_ arg_field_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule32 _copy
+ __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s35 v34
+ {-# INLINE rule30 #-}
+ {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-}
+ rule30 = \ ((_patIpp) :: PP_Doc) attr_ field_ ->
+ {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []
+ {-# LINE 881 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule31 #-}
+ rule31 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
+ Alias field_ attr_ _patIcopy
+ {-# INLINE rule32 #-}
+ rule32 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Irrefutable #-}
+sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
+sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Pattern_v34
+ v34 = \ (T_Pattern_vIn34 ) -> ( let
+ _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
+ (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 )
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule33 _patIpp
+ _copy = rule34 _patIcopy
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule35 _copy
+ __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s35 v34
+ {-# INLINE rule33 #-}
+ rule33 = \ ((_patIpp) :: PP_Doc) ->
+ _patIpp
+ {-# INLINE rule34 #-}
+ rule34 = \ ((_patIcopy) :: Pattern) ->
+ Irrefutable _patIcopy
+ {-# INLINE rule35 #-}
+ rule35 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Pattern_Underscore #-}
+sem_Pattern_Underscore :: (Pos) -> T_Pattern
+sem_Pattern_Underscore arg_pos_ = T_Pattern (return st35) where
+ {-# NOINLINE st35 #-}
+ st35 = let
+ v34 :: T_Pattern_v34
+ v34 = \ (T_Pattern_vIn34 ) -> ( let
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule36 arg_pos_
+ _copy = rule37 arg_pos_
+ _lhsOcopy :: Pattern
+ _lhsOcopy = rule38 _copy
+ __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp
+ in __result_ )
+ in C_Pattern_s35 v34
+ {-# INLINE rule36 #-}
+ {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-}
+ rule36 = \ pos_ ->
+ {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-}
+ ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []
+ {-# LINE 934 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule37 #-}
+ rule37 = \ pos_ ->
+ Underscore pos_
+ {-# INLINE rule38 #-}
+ rule38 = \ _copy ->
+ _copy
+
+-- Patterns ----------------------------------------------------
+-- wrapper
+data Inh_Patterns = Inh_Patterns { }
+data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) }
+{-# INLINABLE wrap_Patterns #-}
+wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
+wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg37 = T_Patterns_vIn37
+ (T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s38 sem arg37)
+ return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Patterns #-}
+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 {
+ attach_T_Patterns :: Identity (T_Patterns_s38 )
+ }
+newtype T_Patterns_s38 = C_Patterns_s38 {
+ inv_Patterns_s38 :: (T_Patterns_v37 )
+ }
+data T_Patterns_s39 = C_Patterns_s39
+type T_Patterns_v37 = (T_Patterns_vIn37 ) -> (T_Patterns_vOut37 )
+data T_Patterns_vIn37 = T_Patterns_vIn37
+data T_Patterns_vOut37 = T_Patterns_vOut37 (Patterns) (PP_Doc) ([PP_Doc])
+{-# NOINLINE sem_Patterns_Cons #-}
+sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
+sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st38) where
+ {-# NOINLINE st38 #-}
+ st38 = let
+ v37 :: T_Patterns_v37
+ v37 = \ (T_Patterns_vIn37 ) -> ( let
+ _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
+ _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
+ (T_Pattern_vOut34 _hdIcopy _hdIpp) = inv_Pattern_s35 _hdX35 (T_Pattern_vIn34 )
+ (T_Patterns_vOut37 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s38 _tlX38 (T_Patterns_vIn37 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule39 _hdIpp _tlIppL
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule40 _hdIpp _tlIpp
+ _copy = rule41 _hdIcopy _tlIcopy
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule42 _copy
+ __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Patterns_s38 v37
+ {-# INLINE rule39 #-}
+ {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-}
+ rule39 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 998 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule40 #-}
+ rule40 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) ->
+ _hdIpp >-< _tlIpp
+ {-# INLINE rule41 #-}
+ rule41 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
+ (:) _hdIcopy _tlIcopy
+ {-# INLINE rule42 #-}
+ rule42 = \ _copy ->
+ _copy
+{-# NOINLINE sem_Patterns_Nil #-}
+sem_Patterns_Nil :: T_Patterns
+sem_Patterns_Nil = T_Patterns (return st38) where
+ {-# NOINLINE st38 #-}
+ st38 = let
+ v37 :: T_Patterns_v37
+ v37 = \ (T_Patterns_vIn37 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule43 ()
+ _lhsOpp :: PP_Doc
+ _lhsOpp = rule44 ()
+ _copy = rule45 ()
+ _lhsOcopy :: Patterns
+ _lhsOcopy = rule46 _copy
+ __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL
+ in __result_ )
+ in C_Patterns_s38 v37
+ {-# INLINE rule43 #-}
+ {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-}
+ rule43 = \ (_ :: ()) ->
+ {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 1030 "dist/build/CodeSyntaxDump.hs"#-}
+ {-# INLINE rule44 #-}
+ rule44 = \ (_ :: ()) ->
+ empty
+ {-# INLINE rule45 #-}
+ rule45 = \ (_ :: ()) ->
+ []
+ {-# INLINE rule46 #-}
+ rule46 = \ _copy ->
+ _copy
+
+-- Sequence ----------------------------------------------------
+-- wrapper
+data Inh_Sequence = Inh_Sequence { }
+data Syn_Sequence = Syn_Sequence { ppL_Syn_Sequence :: ([PP_Doc]) }
+{-# INLINABLE wrap_Sequence #-}
+wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence )
+wrap_Sequence (T_Sequence act) (Inh_Sequence ) =
+ Control.Monad.Identity.runIdentity (
+ do sem <- act
+ let arg40 = T_Sequence_vIn40
+ (T_Sequence_vOut40 _lhsOppL) <- return (inv_Sequence_s41 sem arg40)
+ return (Syn_Sequence _lhsOppL)
+ )
+
+-- cata
+{-# NOINLINE sem_Sequence #-}
+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 {
+ attach_T_Sequence :: Identity (T_Sequence_s41 )
+ }
+newtype T_Sequence_s41 = C_Sequence_s41 {
+ inv_Sequence_s41 :: (T_Sequence_v40 )
+ }
+data T_Sequence_s42 = C_Sequence_s42
+type T_Sequence_v40 = (T_Sequence_vIn40 ) -> (T_Sequence_vOut40 )
+data T_Sequence_vIn40 = T_Sequence_vIn40
+data T_Sequence_vOut40 = T_Sequence_vOut40 ([PP_Doc])
+{-# NOINLINE sem_Sequence_Cons #-}
+sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence
+sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st41) where
+ {-# NOINLINE st41 #-}
+ st41 = let
+ v40 :: T_Sequence_v40
+ v40 = \ (T_Sequence_vIn40 ) -> ( let
+ _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_))
+ _tlX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_))
+ (T_CRule_vOut19 _hdIpp) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 )
+ (T_Sequence_vOut40 _tlIppL) = inv_Sequence_s41 _tlX41 (T_Sequence_vIn40 )
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule47 _hdIpp _tlIppL
+ __result_ = T_Sequence_vOut40 _lhsOppL
+ in __result_ )
+ in C_Sequence_s41 v40
+ {-# INLINE rule47 #-}
+ {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-}
+ rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) ->
+ {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-}
+ _hdIpp : _tlIppL
+ {-# LINE 1092 "dist/build/CodeSyntaxDump.hs"#-}
+{-# NOINLINE sem_Sequence_Nil #-}
+sem_Sequence_Nil :: T_Sequence
+sem_Sequence_Nil = T_Sequence (return st41) where
+ {-# NOINLINE st41 #-}
+ st41 = let
+ v40 :: T_Sequence_v40
+ v40 = \ (T_Sequence_vIn40 ) -> ( let
+ _lhsOppL :: [PP_Doc]
+ _lhsOppL = rule48 ()
+ __result_ = T_Sequence_vOut40 _lhsOppL
+ in __result_ )
+ in C_Sequence_s41 v40
+ {-# INLINE rule48 #-}
+ {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-}
+ rule48 = \ (_ :: ()) ->
+ {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-}
+ []
+ {-# LINE 1110 "dist/build/CodeSyntaxDump.hs"#-}
diff --git a/src-generated/ConcreteSyntax.hs b/src-generated/ConcreteSyntax.hs
index e6e7740..1b343a3 100644..100755
--- a/src-generated/ConcreteSyntax.hs
+++ b/src-generated/ConcreteSyntax.hs
@@ -1,261 +1,261 @@
-
-
--- UUAGC 0.9.51 (src-ag/ConcreteSyntax.ag)
-module ConcreteSyntax where
-{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-}
-
-import UU.Scanner.Position (Pos)
-import Patterns (Pattern)
-import Expression (Expression)
-import CommonTypes
-import Macro --marcos
-{-# LINE 13 "dist/build/ConcreteSyntax.hs" #-}
--- AG ----------------------------------------------------------
-{-
- alternatives:
- alternative AG:
- child elems : Elems
--}
-data AG = AG (Elems)
--- Alt ---------------------------------------------------------
-{-
- alternatives:
- alternative Alt:
- child pos : {Pos}
- child names : ConstructorSet
- child tyvars : {[Identifier]}
- child fields : Fields
- child macro : {MaybeMacro}
--}
-data Alt = Alt (Pos) (ConstructorSet) (([Identifier])) (Fields) (MaybeMacro)
--- Alts --------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Alt
- child tl : Alts
- alternative Nil:
--}
-type Alts = [Alt]
--- Attrs -------------------------------------------------------
-{-
- alternatives:
- alternative Attrs:
- child pos : {Pos}
- child inh : {AttrNames}
- child chn : {AttrNames}
- child syn : {AttrNames}
--}
-data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames)
--- ConstructorSet ----------------------------------------------
-{-
- alternatives:
- alternative CName:
- child name : {ConstructorIdent}
- alternative CUnion:
- child set1 : ConstructorSet
- child set2 : ConstructorSet
- alternative CDifference:
- child set1 : ConstructorSet
- child set2 : ConstructorSet
- alternative CAll:
--}
-data ConstructorSet = CName (ConstructorIdent)
- | CUnion (ConstructorSet) (ConstructorSet)
- | CDifference (ConstructorSet) (ConstructorSet)
- | CAll
--- Elem --------------------------------------------------------
-{-
- alternatives:
- alternative Data:
- child pos : {Pos}
- child contype : {ConstructorType}
- child ctx : {ClassContext}
- child names : NontSet
- child params : {[Identifier]}
- child attrs : Attrs
- child alts : Alts
- child ext : {Bool}
- alternative Type:
- child pos : {Pos}
- child ctx : {ClassContext}
- child name : {NontermIdent}
- child params : {[Identifier]}
- child type : {ComplexType}
- alternative Attr:
- child pos : {Pos}
- child ctx : {ClassContext}
- child names : NontSet
- child quants : {[String]}
- child attrs : Attrs
- alternative Sem:
- child pos : {Pos}
- child ctx : {ClassContext}
- child names : NontSet
- child attrs : Attrs
- child quants : {[String]}
- child alts : SemAlts
- alternative Txt:
- child pos : {Pos}
- child kind : {BlockKind}
- child mbNt : {Maybe NontermIdent}
- child lines : {[String]}
- alternative Set:
- child pos : {Pos}
- child name : {NontermIdent}
- child merge : {Bool}
- child set : NontSet
- alternative Deriving:
- child pos : {Pos}
- child set : NontSet
- child classes : {[NontermIdent]}
- alternative Wrapper:
- child pos : {Pos}
- child set : NontSet
- alternative Nocatas:
- child pos : {Pos}
- child set : NontSet
- alternative Pragma:
- child pos : {Pos}
- child names : {[NontermIdent]}
- alternative Module:
- child pos : {Pos}
- child name : {String}
- child exports : {String}
- child imports : {String}
--}
-data Elem = Data (Pos) (ConstructorType) (ClassContext) (NontSet) (([Identifier])) (Attrs) (Alts) (Bool)
- | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType)
- | Attr (Pos) (ClassContext) (NontSet) (([String])) (Attrs)
- | Sem (Pos) (ClassContext) (NontSet) (Attrs) (([String])) (SemAlts)
- | Txt (Pos) (BlockKind) ((Maybe NontermIdent)) (([String]))
- | Set (Pos) (NontermIdent) (Bool) (NontSet)
- | Deriving (Pos) (NontSet) (([NontermIdent]))
- | Wrapper (Pos) (NontSet)
- | Nocatas (Pos) (NontSet)
- | Pragma (Pos) (([NontermIdent]))
- | Module (Pos) (String) (String) (String)
--- Elems -------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Elem
- child tl : Elems
- alternative Nil:
--}
-type Elems = [Elem]
--- Field -------------------------------------------------------
-{-
- alternatives:
- alternative FChild:
- child name : {Identifier}
- child tp : {Type}
- alternative FCtx:
- child tps : {[Type]}
--}
-data Field = FChild (Identifier) (Type)
- | FCtx (([Type]))
--- Fields ------------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : Field
- child tl : Fields
- alternative Nil:
--}
-type Fields = [Field]
--- NontSet -----------------------------------------------------
-{-
- alternatives:
- alternative NamedSet:
- child name : {NontermIdent}
- alternative All:
- alternative Union:
- child set1 : NontSet
- child set2 : NontSet
- alternative Intersect:
- child set1 : NontSet
- child set2 : NontSet
- alternative Difference:
- child set1 : NontSet
- child set2 : NontSet
- alternative Path:
- child from : {NontermIdent}
- child to : {NontermIdent}
--}
-data NontSet = NamedSet (NontermIdent)
- | All
- | Union (NontSet) (NontSet)
- | Intersect (NontSet) (NontSet)
- | Difference (NontSet) (NontSet)
- | Path (NontermIdent) (NontermIdent)
--- SemAlt ------------------------------------------------------
-{-
- alternatives:
- alternative SemAlt:
- child pos : {Pos}
- child constructorSet : ConstructorSet
- child rules : SemDefs
--}
-data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs)
--- SemAlts -----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : SemAlt
- child tl : SemAlts
- alternative Nil:
--}
-type SemAlts = [SemAlt]
--- SemDef ------------------------------------------------------
-{-
- alternatives:
- alternative Def:
- child pos : {Pos}
- child mbName : {Maybe Identifier}
- child pattern : {Pattern}
- child rhs : {Expression}
- child owrt : {Bool}
- child pure : {Bool}
- child eager : {Bool}
- alternative TypeDef:
- child pos : {Pos}
- child ident : {Identifier}
- child tp : {Type}
- alternative UniqueDef:
- child ident : {Identifier}
- child ref : {Identifier}
- alternative AugmentDef:
- child ident : {Identifier}
- child rhs : {Expression}
- alternative AroundDef:
- child ident : {Identifier}
- child rhs : {Expression}
- alternative MergeDef:
- child target : {Identifier}
- child nt : {Identifier}
- child sources : {[Identifier]}
- child rhs : {Expression}
- alternative SemPragma:
- child names : {[NontermIdent]}
- alternative AttrOrderBefore:
- child before : {[Occurrence]}
- child after : {[Occurrence]}
--}
-data SemDef = Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) (Bool) (Bool)
- | TypeDef (Pos) (Identifier) (Type)
- | UniqueDef (Identifier) (Identifier)
- | AugmentDef (Identifier) (Expression)
- | AroundDef (Identifier) (Expression)
- | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression)
- | SemPragma (([NontermIdent]))
- | AttrOrderBefore (([Occurrence])) (([Occurrence]))
--- SemDefs -----------------------------------------------------
-{-
- alternatives:
- alternative Cons:
- child hd : SemDef
- child tl : SemDefs
- alternative Nil:
--}
+
+
+-- UUAGC 0.9.51 (src-ag/ConcreteSyntax.ag)
+module ConcreteSyntax where
+{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-}
+
+import UU.Scanner.Position (Pos)
+import Patterns (Pattern)
+import Expression (Expression)
+import CommonTypes
+import Macro --marcos
+{-# LINE 13 "dist/build/ConcreteSyntax.hs" #-}
+-- AG ----------------------------------------------------------
+{-
+ alternatives:
+ alternative AG:
+ child elems : Elems
+-}
+data AG = AG (Elems)
+-- Alt ---------------------------------------------------------
+{-
+ alternatives:
+ alternative Alt:
+ child pos : {Pos}
+ child names : ConstructorSet
+ child tyvars : {[Identifier]}
+ child fields : Fields
+ child macro : {MaybeMacro}
+-}
+data Alt = Alt (Pos) (ConstructorSet) (([Identifier])) (Fields) (MaybeMacro)
+-- Alts --------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Alt
+ child tl : Alts
+ alternative Nil:
+-}
+type Alts = [Alt]
+-- Attrs -------------------------------------------------------
+{-
+ alternatives:
+ alternative Attrs:
+ child pos : {Pos}
+ child inh : {AttrNames}
+ child chn : {AttrNames}
+ child syn : {AttrNames}
+-}
+data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames)
+-- ConstructorSet ----------------------------------------------
+{-
+ alternatives:
+ alternative CName:
+ child name : {ConstructorIdent}
+ alternative CUnion:
+ child set1 : ConstructorSet
+ child set2 : ConstructorSet
+ alternative CDifference:
+ child set1 : ConstructorSet
+ child set2 : ConstructorSet
+ alternative CAll:
+-}
+data ConstructorSet = CName (ConstructorIdent)
+ | CUnion (ConstructorSet) (ConstructorSet)
+ | CDifference (ConstructorSet) (ConstructorSet)
+ | CAll
+-- Elem --------------------------------------------------------
+{-
+ alternatives:
+ alternative Data:
+ child pos : {Pos}
+ child contype : {ConstructorType}
+ child ctx : {ClassContext}
+ child names : NontSet
+ child params : {[Identifier]}
+ child attrs : Attrs
+ child alts : Alts
+ child ext : {Bool}
+ alternative Type:
+ child pos : {Pos}
+ child ctx : {ClassContext}
+ child name : {NontermIdent}
+ child params : {[Identifier]}
+ child type : {ComplexType}
+ alternative Attr:
+ child pos : {Pos}
+ child ctx : {ClassContext}
+ child names : NontSet
+ child quants : {[String]}
+ child attrs : Attrs
+ alternative Sem:
+ child pos : {Pos}
+ child ctx : {ClassContext}
+ child names : NontSet
+ child attrs : Attrs
+ child quants : {[String]}
+ child alts : SemAlts
+ alternative Txt:
+ child pos : {Pos}
+ child kind : {BlockKind}
+ child mbNt : {Maybe NontermIdent}
+ child lines : {[String]}
+ alternative Set:
+ child pos : {Pos}
+ child name : {NontermIdent}
+ child merge : {Bool}
+ child set : NontSet
+ alternative Deriving:
+ child pos : {Pos}
+ child set : NontSet
+ child classes : {[NontermIdent]}
+ alternative Wrapper:
+ child pos : {Pos}
+ child set : NontSet
+ alternative Nocatas:
+ child pos : {Pos}
+ child set : NontSet
+ alternative Pragma:
+ child pos : {Pos}
+ child names : {[NontermIdent]}
+ alternative Module:
+ child pos : {Pos}
+ child name : {String}
+ child exports : {String}
+ child imports : {String}
+-}
+data Elem = Data (Pos) (ConstructorType) (ClassContext) (NontSet) (([Identifier])) (Attrs) (Alts) (Bool)
+ | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType)
+ | Attr (Pos) (ClassContext) (NontSet) (([String])) (Attrs)
+ | Sem (Pos) (ClassContext) (NontSet) (Attrs) (([String])) (SemAlts)
+ | Txt (Pos) (BlockKind) ((Maybe NontermIdent)) (([String]))
+ | Set (Pos) (NontermIdent) (Bool) (NontSet)
+ | Deriving (Pos) (NontSet) (([NontermIdent]))
+ | Wrapper (Pos) (NontSet)
+ | Nocatas (Pos) (NontSet)
+ | Pragma (Pos) (([NontermIdent]))
+ | Module (Pos) (String) (String) (String)
+-- Elems -------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Elem
+ child tl : Elems
+ alternative Nil:
+-}
+type Elems = [Elem]
+-- Field -------------------------------------------------------
+{-
+ alternatives:
+ alternative FChild:
+ child name : {Identifier}
+ child tp : {Type}
+ alternative FCtx:
+ child tps : {[Type]}
+-}
+data Field = FChild (Identifier) (Type)
+ | FCtx (([Type]))
+-- Fields ------------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : Field
+ child tl : Fields
+ alternative Nil:
+-}
+type Fields = [Field]
+-- NontSet -----------------------------------------------------
+{-
+ alternatives:
+ alternative NamedSet:
+ child name : {NontermIdent}
+ alternative All:
+ alternative Union:
+ child set1 : NontSet
+ child set2 : NontSet
+ alternative Intersect:
+ child set1 : NontSet
+ child set2 : NontSet
+ alternative Difference:
+ child set1 : NontSet
+ child set2 : NontSet
+ alternative Path:
+ child from : {NontermIdent}
+ child to : {NontermIdent}
+-}
+data NontSet = NamedSet (NontermIdent)
+ | All
+ | Union (NontSet) (NontSet)
+ | Intersect (NontSet) (NontSet)
+ | Difference (NontSet) (NontSet)
+ | Path (NontermIdent) (NontermIdent)
+-- SemAlt ------------------------------------------------------
+{-
+ alternatives:
+ alternative SemAlt:
+ child pos : {Pos}
+ child constructorSet : ConstructorSet
+ child rules : SemDefs
+-}
+data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs)
+-- SemAlts -----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : SemAlt
+ child tl : SemAlts
+ alternative Nil:
+-}
+type SemAlts = [SemAlt]
+-- SemDef ------------------------------------------------------
+{-
+ alternatives:
+ alternative Def:
+ child pos : {Pos}
+ child mbName : {Maybe Identifier}
+ child pattern : {Pattern}
+ child rhs : {Expression}
+ child owrt : {Bool}
+ child pure : {Bool}
+ child eager : {Bool}
+ alternative TypeDef:
+ child pos : {Pos}
+ child ident : {Identifier}
+ child tp : {Type}
+ alternative UniqueDef:
+ child ident : {Identifier}
+ child ref : {Identifier}
+ alternative AugmentDef:
+ child ident : {Identifier}
+ child rhs : {Expression}
+ alternative AroundDef:
+ child ident : {Identifier}
+ child rhs : {Expression}
+ alternative MergeDef:
+ child target : {Identifier}
+ child nt : {Identifier}
+ child sources : {[Identifier]}
+ child rhs : {Expression}
+ alternative SemPragma:
+ child names : {[NontermIdent]}
+ alternative AttrOrderBefore:
+ child before : {[Occurrence]}
+ child after : {[Occurrence]}
+-}
+data SemDef = Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) (Bool) (Bool)
+ | TypeDef (Pos) (Identifier) (Type)
+ | UniqueDef (Identifier) (Identifier)
+ | AugmentDef (Identifier) (Expression)
+ | AroundDef (Identifier) (Expression)
+ | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression)
+ | SemPragma (([NontermIdent]))
+ | AttrOrderBefore (([Occurrence])) (([Occurrence]))
+-- SemDefs -----------------------------------------------------
+{-
+ alternatives:
+ alternative Cons:
+ child hd : SemDef
+ child tl : SemDefs
+ alternative Nil:
+-}
type SemDefs = [SemDef] \ No newline at end of file
diff --git a/src-generated/DeclBlocks.hs b/src-generated/DeclBlocks.hs
index 8f9dcba..4a62fc9 100644..100755
--- a/src-generated/DeclBlocks.hs
+++ b/src-generated/DeclBlocks.hs
@@ -1,28 +1,28 @@
-
-
--- UUAGC 0.9.51 (src-ag/DeclBlocks.ag)
-module DeclBlocks where
-{-# LINE 2 "src-ag/DeclBlocks.ag" #-}
-
-import Code (Decl,Expr)
-{-# LINE 9 "dist/build/DeclBlocks.hs" #-}
--- DeclBlocks --------------------------------------------------
-{-
- alternatives:
- alternative DeclBlock:
- child defs : {[Decl]}
- child visit : {Decl}
- child next : DeclBlocks
- alternative DeclTerminator:
- child defs : {[Decl]}
- child result : {Expr}
--}
-data DeclBlocks = DeclBlock (([Decl])) (Decl) (DeclBlocks)
- | DeclTerminator (([Decl])) (Expr)
--- DeclBlocksRoot ----------------------------------------------
-{-
- alternatives:
- alternative DeclBlocksRoot:
- child blocks : DeclBlocks
--}
+
+
+-- UUAGC 0.9.51 (src-ag/DeclBlocks.ag)
+module DeclBlocks where
+{-# LINE 2 "src-ag/DeclBlocks.ag" #-}
+
+import Code (Decl,Expr)
+{-# LINE 9 "dist/build/DeclBlocks.hs" #-}
+-- DeclBlocks --------------------------------------------------
+{-
+ alternatives:
+ alternative DeclBlock:
+ child defs : {[Decl]}
+ child visit : {Decl}
+ child next : DeclBlocks
+ alternative DeclTerminator:
+ child defs : {[Decl]}
+ child result : {Expr}
+-}
+data DeclBlocks = DeclBlock (([Decl])) (Decl) (DeclBlocks)
+ | DeclTerminator (([Decl])) (Expr)
+-- DeclBlocksRoot ----------------------------------------------
+{-
+ alternatives:
+ alternative DeclBlocksRoot:
+ child blocks : DeclBlocks
+-}
data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks) \ No newline at end of file
diff --git a/src-generated/DefaultRules.hs b/src-generated/DefaultRules.hs
index b2c439c..5e7bf16 100644..100755
--- a/src-generated/DefaultRules.hs
+++ b/src-generated/DefaultRules.hs
@@ -1,4726 +1,4726 @@
-{-# LANGUAGE Rank2Types, GADTs #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module DefaultRules where
-{-# LINE 2 "src-ag/Patterns.ag" #-}
-
--- Patterns.ag imports
-import UU.Scanner.Position(Pos)
-import CommonTypes (ConstructorIdent,Identifier)
-{-# LINE 12 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}
-
--- AbstractSyntax.ag imports
-import Data.Set(Set)
-import Data.Map(Map)
-import Patterns (Pattern(..),Patterns)
-import Expression (Expression(..))
-import Macro --marcos
-import CommonTypes
-import ErrorMessages
-{-# LINE 24 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 15 "src-ag/DefaultRules.ag" #-}
-
-import qualified Data.List
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Data.Map(Map)
-import qualified Data.Sequence as Seq
-import Data.Sequence(Seq,(><))
-import UU.Scanner.Position(noPos)
-import Pretty
-import Data.Maybe
-import HsToken
-import HsTokenScanner
-import Data.List(intersperse)
-import Data.Char
-
-import AbstractSyntax
-import ErrorMessages
-
-import Options
-{-# LINE 46 "dist/build/DefaultRules.hs" #-}
-import Control.Monad.Identity (Identity)
-import qualified Control.Monad.Identity
-{-# LINE 80 "src-ag/DefaultRules.ag" #-}
-
-fieldName n = '@' : getName n
-
-locName n = "@loc." ++ getName n
-
-attrName fld attr
- | fld == _LOC = locName attr
- | fld == _FIELD = fieldName attr
- | otherwise = '@' : getName fld ++ "." ++ getName attr
-
-_ACHILD = Ident "(" noPos -- hack
-
-mkLocVar = AGField _LOC
-
-isRecordConstructor :: NontermIdent -> Map NontermIdent ConstructorType -> Bool
-isRecordConstructor nt ctm = Map.lookup nt ctm == Just RecordConstructor
-
-buildConExpr ocaml clean conmap typeSyns rename nt con1 fs'
- | nt `elem` map fst typeSyns = if ocaml then synonymMl
- else if clean then synonymClean
- else synonymHs
- | otherwise = normalExpr
- where fs = map fst fs'
- con = getName con1
- tup = " " ++ buildTuple fs
- args = " " ++ unwords fs
- normalExpr = if clean && isRecordConstructor nt conmap
- then "{" ++ con ++ "|" ++
- unwords (intersperse "," $ map (\(new, old) -> getName old ++ " = " ++ new) fs')
- ++ "}"
- else conname' ++ args
-
- conname' | rename = getName nt ++ "_" ++ getName con1
- | otherwise = getName con1
-
- synonymHs | con == "Tuple" = buildTuple fs
- | con == "Cons" = "(:)" ++ args
- | con == "Nil" = case lookup nt typeSyns of
- Just (Map _ _) -> "Data.Map.empty"
- Just (IntMap _) -> "Data.IntMap.empty"
- Just (OrdSet _) -> "Data.Set.empty"
- Just IntSet -> "Data.IntSet.empty"
- _ -> "[]"
- | con == "Just" = "Just" ++ args
- | con == "Nothing" = "Nothing"
- | con == "Entry" = ( case lookup nt typeSyns of
- Just (Map _ _) -> "Data.Map.insert"
- Just (IntMap _) -> "Data.IntMap.insert"
- Just (OrdSet _) -> "Data.Set.insert"
- Just IntSet -> "Data.IntSet.insert" ) ++ args
- | otherwise = normalExpr
-
- synonymMl | con == "Tuple" = buildTuple fs
- | con == "Cons" = "(::)" ++ tup
- | con == "Nil" = case lookup nt typeSyns of
- Just (Map _ _) -> prefixMod nt "empty"
- Just (IntMap _) -> prefixMod nt "empty"
- Just (OrdSet _) -> prefixMod nt "empty"
- Just IntSet -> prefixMod nt "empty"
- _ -> "[]"
- | con == "Just" = "Some" ++ tup
- | con == "Nothing" = "None"
- | con == "Entry" = ( case lookup nt typeSyns of
- Just (Map _ _) -> prefixMod nt "add"
- Just (IntMap _) -> prefixMod nt "add"
- Just (OrdSet _) -> prefixMod nt "add"
- Just IntSet -> prefixMod nt "add" ) ++ args
- | otherwise = normalExpr
-
- synonymClean | con == "Tuple" = buildTuple fs
- | con == "Cons" = "(\\x xs -> [x:xs])" ++ args
- | con == "Nil" = case lookup nt typeSyns of
- Just (Map _ _) -> "Data.Map.empty"
- Just (IntMap _) -> "Data.IntMap.empty"
- Just (OrdSet _) -> "Data.Set.empty"
- Just IntSet -> "Data.IntSet.empty"
- _ -> "[]"
- | con == "Just" = "Just" ++ args
- | con == "Nothing" = "Nothing"
- | con == "Entry" = ( case lookup nt typeSyns of
- Just (Map _ _) -> "Data.Map.insert"
- Just (IntMap _) -> "Data.IntMap.insert"
- Just (OrdSet _) -> "Data.Set.insert"
- Just IntSet -> "Data.IntSet.insert" ) ++ args
- | otherwise = normalExpr
-
-
- prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm
-
-concatSeq = foldr (Seq.><) Seq.empty
-
-splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String)
-splitAttrs _ []
- = ([],[])
-splitAttrs useMap (n:rest)
- = let (uses,normals) = splitAttrs useMap rest
- in case Map.lookup n useMap of
- Just x -> ((n,x):uses , normals )
- Nothing -> ( uses , n:normals )
-
-removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier])
-removeDefined defined (fld,as)
- = ( fld
- , [ a
- | a <- Map.keys as
- , not (Set.member (fld,a) defined)
- ]
- )
-
-{-# LINE 159 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 255 "src-ag/DefaultRules.ag" #-}
-
-
-
-
-deprecatedCopyRuleError nt con fld a
- = let mesg =
- "In the definitions for alternative"
- >#< getName con
- >#< "of nonterminal"
- >#< getName nt
- >|< ","
- >-< "the value of field"
- >#< getName a
- >#< "is copied by a copy-rule."
- >-< "Copying the value of a field using a copy-rule is deprecated"
- >-< "Please add the following lines to your code:"
- >-< ( "SEM"
- >#< getName nt
- >-< indent 2 ( "|"
- >#< getName con
- >#< getName fld
- >#< "."
- >#< a
- >#< "="
- >#< "@"
- >|< a
- )
- )
- in CustomError True (getPos a) mesg
-
-
-missingRuleErrorExpr clean nt con fld a
- = (if clean then "abort" else "error")
- ++ " \"missing rule: "
- ++ show nt ++ "." ++ show con ++ "."
- ++ show fld ++ "." ++ show a ++ "\""
-
-makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule
-makeRule (f1,a1) expr origin identity mbDelayedError
- = Rule Nothing
- (Alias f1 a1 (Underscore noPos))
- expr
- False
- origin
- False
- True
- identity
- mbDelayedError
- False
-
-
-useRule :: Options -> Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule
-useRule opts locals ch_outs (n,(op,e,pos))
- = let elems = [ fld
- | (fld,as) <- ch_outs
- , Map.member n as
- ]
-
- isOp [] = False
- isOp (c:cs)
- | isSpace c = isOp cs
- | isAlpha c = case dropWhile isAlpha cs of
- ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix
- _ -> False
- | c == '(' = False
- | otherwise = True
-
- tks | Set.member n locals = [mkLocVar n noPos Nothing]
- | null elems = lexTokens opts noPos e
- | otherwise = lexTokens opts noPos str
- where
- opExpr l r
- | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator
- | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right
- str = foldr1 opExpr (map (flip attrName n) elems)
-
- in makeRule (_LHS,n)
- (Expression noPos tks)
- ("use rule " ++ pos)
- False
- Nothing
-
-
-selfRule :: Bool -> Identifier -> [HsToken] -> Rule
-selfRule lhsNecLoc attr tks
- = makeRule (if lhsNecLoc then _LHS else _LOC,attr)
- (Expression noPos tks)
- "self rule"
- False
- Nothing
-
-
-
-
-concatRE rsess = let (rss,ess) = unzip rsess
- in (concat rss, concatSeq ess)
-
-
-copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error)
-copyRule options wrappers nt con modcopy locals (env,(fld,as))
- = concatRE (map copyRu as)
-
- where
- copyRu a
- = ( [ makeRule (fld,a)
- (Expression noPos tks)
- (cruletxt sel)
- True
- mbDelayedErr
- ]
- , err
- )
-
- where
- sel
- | not modcopy
- && Set.member a locals = Just _LOC
- | otherwise = Map.lookup a env
-
- (tks,err,mbDelayedErr)
- = case sel of
- Nothing -> let tks = [HsToken (missingRuleErrorExpr (clean options) nt con fld a) noPos]
- err = MissingRule nt con fld a
- in if nt `Set.member` wrappers && kennedyWarren options
- then (tks, Seq.empty, Just err) -- yield error only if the rule is actually scheduled; for kennedyWarren code gen only
- else (tks, Seq.singleton err, Nothing)
- Just f
- | f == _ACHILD -> ( [AGLocal a noPos Nothing]
- , Seq.singleton (deprecatedCopyRuleError nt con fld a)
- , Nothing
- )
- | otherwise -> ( [AGField f a noPos Nothing]
- , Seq.empty
- , Nothing
- )
-
- cruletxt sel
- | local = "copy rule (from local)"
- | deprChild = "deprecated child copy"
- | Set.member a locals && nonlocal = "modified copy rule"
- | incoming && outgoing = "copy rule (chain)"
- | incoming = "copy rule (down)"
- | outgoing = "copy rule (up)"
- | otherwise = "copy rule (chain)"
- where outgoing = fld == _LHS
- incoming = maybe False (== _LHS) sel
- nonlocal = maybe False (/= _LOC) sel
- local = maybe False (== _LOC) sel
- deprChild = maybe False (== _ACHILD) sel
-{-# LINE 311 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 488 "src-ag/DefaultRules.ag" #-}
-
-buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")"
-
-addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule]
-addAugments (_, exprs) rules
- | null exprs = rules
-addAugments (syn, exprs) rules
- = [rule] ++ funRules ++ map modify rules
- where
- rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False
- rhs = Expression noPos tks
- tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos]
- funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames)
-
- substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn)
- funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs
- funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs
-
- modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager)
- | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager
- modify r = r
-
- containsSyn (Constr _ pats) = any containsSyn pats
- containsSyn (Product _ pats) = any containsSyn pats
- containsSyn (Irrefutable pat) = containsSyn pat
- containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat
- containsSyn _ = False
-
- modifyPat (Constr name pats) = Constr name (map modifyPat pats)
- modifyPat (Product pos pats) = Product pos (map modifyPat pats)
- modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat)
- modifyPat (Alias field attr pat)
- | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat)
- | otherwise = Alias field attr (modifyPat pat)
- modifyPat p = p
-
--- adds the additional rules needed for around, which creates a sequence of
--- rules that form a function that each transforms the semantics of a child
--- before attaching the child.
--- The rule defines a local attribute "<child>_around" and <child> is dependent
--- on this attribute.
-addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule]
-addArounds (_, exprs) rules | null exprs = rules
-addArounds (child, exprs) rules
- = [rule] ++ funRules ++ rules
- where
- rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False
- rhs = Expression noPos tks
- tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos]
- funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames)
-
- childLoc = Ident (show child ++ "_around") (getPos child)
- funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs
- funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs
-
--- adds the additional rules needed for merging.
--- It produces for each merging child a rule with local attribute: "<child>_merged".
--- this rules takes the semantics of the first children and feeds it to the function
--- represented by this attribute. This attribute then defines the semantics for
--- the merging child.
-addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule]
-addMerges (target,(_,_,expr)) rules
- = rule : rules
- where
- rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False
- childLoc = Ident (show target ++ "_merge") (getPos target)
-{-# LINE 380 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 606 "src-ag/DefaultRules.ag" #-}
-
-elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type
-elimSelfId nt args Self = NT nt (map getName args) False
-elimSelfId _ _ tp = tp
-
-elimSelfStr :: NontermIdent -> [String] -> Type -> Type
-elimSelfStr nt args Self = NT nt args False
-elimSelfStr _ _ tp = tp
-{-# LINE 391 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 658 "src-ag/DefaultRules.ag" #-}
-
--- When a rule has a name, create an alias for a rule
--- and a modified rule that refers to the alias
--- Thus it removes rule names from rules
-mkRuleAlias :: Rule -> (Rule, Maybe Rule)
-mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing)
-mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where
- alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager
- pos = getPos nm
- expr' = Expression pos tks
- tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))]
- r' = Rule Nothing pat expr' owrt origin False True identity Nothing False
-{-# LINE 406 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 675 "src-ag/DefaultRules.ag" #-}
-
-needsMultiRules :: Options -> Bool
-needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts)
-{-# LINE 412 "dist/build/DefaultRules.hs" #-}
-
-{-# LINE 680 "src-ag/DefaultRules.ag" #-}
-
-{-
-multiRule replaces
- loc.(a,b) = e
-by
- loc.tup1 = e
- loc.(a,_) = @loc.tup1
- loc.(_,b) = @loc.tup1
-It needs to thread a unique number for inventing names for the tuples.
-
-It also works for nested tuples:
- loc.(a,(b,c)) = e
-becomes
- loc.tup1 = e
- loc.(a,_) = @loc.tup1
- loc.(_,tup2) = @loc.tup1
- loc.(b,_) = @loc.tup2
- loc.(_,c) = @loc.tup2
--}
-
-multiRule :: Rule -> Int -> ([Rule], Int)
-multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq
- = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int))
- f expl' w e (Product pos pats) n
- = let freshName = Ident ("_tup" ++ show n) pos
- freshExpr = Expression pos freshTks
- freshTks = [AGField _LOC freshName pos Nothing]
- freshPat = Alias _LOC freshName (Underscore pos)
- a = length pats - 1
- us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos))
- g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int)
- g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1
- in (x2:xs1, rs2++rs1, n2)
- (xs9,rs9,n9) = foldr g ([], [], n+1) pats
- in ( freshPat
- , ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9
- , n9
- )
- )
- f expl' w e p n
- = ( p
- , ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager]
- , n
- )
- )
- in snd (f expl id expr pat uniq)
-
-{-# LINE 462 "dist/build/DefaultRules.hs" #-}
--- Child -------------------------------------------------------
--- wrapper
-data Inh_Child = Inh_Child { con_Inh_Child :: !(ConstructorIdent), cr_Inh_Child :: !(Bool), inhMap_Inh_Child :: !(Map Identifier Attributes), merged_Inh_Child :: !(Set Identifier), nt_Inh_Child :: !(NontermIdent), params_Inh_Child :: !([Identifier]), synMap_Inh_Child :: !(Map Identifier Attributes) }
-data Syn_Child = Syn_Child { errors_Syn_Child :: !(Seq Error), field_Syn_Child :: !( (Identifier,Type,ChildKind) ), inherited_Syn_Child :: !(Attributes), name_Syn_Child :: !(Identifier), output_Syn_Child :: !(Child), synthesized_Syn_Child :: !(Attributes) }
-{-# INLINABLE wrap_Child #-}
-wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
-wrap_Child !(T_Child act) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) =
- Control.Monad.Identity.runIdentity (
- do !sem <- act
- let arg0 = T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap
- !(T_Child_vOut0 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) <- return (inv_Child_s0 sem K_Child_v0 arg0)
- return (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized)
- )
-
--- cata
-{-# INLINE sem_Child #-}
-sem_Child :: Child -> T_Child
-sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_
-
--- semantic domain
-newtype T_Child = T_Child {
- attach_T_Child :: Identity (T_Child_s0 )
- }
-data T_Child_s0 where C_Child_s0 :: {
- inv_Child_s0 :: !(forall t. K_Child_s0 t -> t)
- } -> T_Child_s0
-data T_Child_s1 = C_Child_s1
-data T_Child_s26 = C_Child_s26
-newtype T_Child_s56 = C_Child_s56 {
- inv_Child_s56 :: (T_Child_v53 )
- }
-data K_Child_s0 k where
- K_Child_v0 :: K_Child_s0 (T_Child_v0 )
- K_Child_v13 :: K_Child_s0 (T_Child_v13 )
- K_Child_v52 :: K_Child_s0 (T_Child_v52 )
-type T_Child_v0 = (T_Child_vIn0 ) -> (T_Child_vOut0 )
-data T_Child_vIn0 = T_Child_vIn0 !(ConstructorIdent) !(Bool) !(Map Identifier Attributes) !(Set Identifier) !(NontermIdent) !([Identifier]) !(Map Identifier Attributes)
-data T_Child_vOut0 = T_Child_vOut0 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes)
-type T_Child_v13 = (T_Child_vIn13 ) -> (T_Child_vOut13 )
-data T_Child_vIn13 = T_Child_vIn13 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes)
-data T_Child_vOut13 = T_Child_vOut13 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes)
-type T_Child_v52 = (T_Child_vIn52 ) -> (T_Child_vOut52 )
-data T_Child_vIn52 = T_Child_vIn52 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes)
-data T_Child_vOut52 = T_Child_vOut52 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Attributes) !(T_Child_s56 )
-type T_Child_v53 = (T_Child_vIn53 ) -> (T_Child_vOut53 )
-data T_Child_vIn53 = T_Child_vIn53
-data T_Child_vOut53 = T_Child_vOut53 !(Child)
-{-# NOINLINE sem_Child_Child #-}
-sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
-sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st0) where
- {-# NOINLINE st0 #-}
- !st0 = let
- k0 :: K_Child_s0 t -> t
- k0 K_Child_v0 = v0
- k0 K_Child_v13 = v13
- k0 K_Child_v52 = v52
- v0 :: T_Child_v0
- v0 = \ !(T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> (
- let _lhsOerrors :: Seq Error
- !_lhsOerrors = rule11 () in
- let _lhsOfield :: (Identifier,Type,ChildKind)
- !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in
- let !_chnt = rule0 arg_name_ arg_tp_ in
- let !_inh = rule1 _chnt _lhsIinhMap in
- let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in
- let !_inh1 = rule8 _inh _nt _params in
- let _lhsOinherited :: Attributes
- !_lhsOinherited = rule4 _inh1 in
- let _lhsOname :: Identifier
- !_lhsOname = rule3 arg_name_ in
- let _lhsOoutput :: Child
- !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in