asil-1.2: dist/build/GenInstrLib.hs
-- UUAGC 0.9.36 (src/GenInstrLib.ag)
module GenInstrLib(genInstrLib) where
{-# LINE 10 "src/GenInstrLib.ag" #-}
import Data.Word
import qualified Data.Set as Set
import Data.Set(Set)
import qualified Data.Map as Map
import Data.Map(Map)
import ProgInfo
import PrettyUtil
import SymInfo
import SymView
import Data.Monoid
import Data.Maybe
{-# LINE 20 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 27 "src/GenInstrLib.ag" #-}
genInstrLib :: String -> SymInfo -> [SymbolTables] -> Doc
genInstrLib nm gEnv tbls = res where
res = output_Syn_FileV syn
syn = wrap_FileV sem inh
inh = Inh_FileV { gEnv_Inh_FileV = gEnv, modNm_Inh_FileV = nm }
sem = sem_FileV fil
fil = tablesView tbls
{-# LINE 30 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 97 "src/GenInstrLib.ag" #-}
-- | Strips the qualifier from the qualified/encoded field name
unqualField :: String -> String
unqualField [] = error "unqualField: field name empty"
unqualField nm = case break (== '˳') nm of
(rem, []) -> last $ words $ map repl rem -- take the last of the normal dot chars
(_, rem) -> tail rem -- has the special dot char
where repl '.' = ' '
repl c = c
-- | Assumes that the name is already unqualified
genFieldClass :: String -> Doc
genFieldClass nm = vert
[ text "class K'" <> text str <+> text "a b | a -> b where"
, nest 2 $ text "k'" <> text str <+> text ":: Key a b"
]
where str = encodeNmHaskell nm
encodeNmHaskell :: String -> String
encodeNmHaskell = map repl where
repl '.' = '\''
repl '˳' = '\''
repl '-' = '_'
repl ':' = '_'
repl '/' = '_'
repl c = c
{-# LINE 59 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 133 "src/GenInstrLib.ag" #-}
genClassData :: String -> Doc
genClassData nm = vert
[ text "data T'" <> text str
, text "t'" <> text str <+> text ":: Type" <+> text "T'" <> text str
, text "t'" <> text str <+> text "= TypeObject" <+> text (show nm)
] where str = encodeNmHaskell nm
{-# LINE 69 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 163 "src/GenInstrLib.ag" #-}
genSuper :: String -> String -> Doc
genSuper super child = text "instance IsSuper" <+> text "T'" <> text superStr <+> text "T'" <> text childStr where
superStr = encodeNmHaskell super
childStr = encodeNmHaskell child
{-# LINE 77 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 207 "src/GenInstrLib.ag" #-}
genTrait :: String -> String -> Doc -> Doc -> Doc
genTrait classNm fieldNm val tp = vert
[ text "k'" <> text strClass <> text "'" <> text strField <+> text ":: Key T'" <> text strClass <+> parens tp
, text "k'" <> text strClass <> text "'" <> text strField <+> text "=" <+> val
, text "instance K'" <> text strField' <+> parens (text "T'" <> text strClass) <+> parens tp <+> text "where"
, nest 2 (text "k'" <> text strField' <+> text "=" <+> text "k'" <> text strClass <> text "'" <> text strField)
] where strClass = encodeNmHaskell classNm
strField = encodeNmHaskell fieldNm
fieldNm' = unqualField fieldNm
strField' = encodeNmHaskell fieldNm'
{-# LINE 91 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 227 "src/GenInstrLib.ag" #-}
genMethod :: String -> Doc -> Doc -> Doc
genMethod methodNm val tp = vert
[ text "m'" <> text strMethod <+> text "::" <+> tp
, text "m'" <> text strMethod <+> text "=" <+> val
] where strMethod = encodeNmHaskell methodNm
{-# LINE 100 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
{-# LINE 247 "src/GenInstrLib.ag" #-}
genSigVal :: [String] -> Doc
genSigVal = foldr (\l r -> parens (text "SpecsCons" <+> text "t'" <> text (encodeNmHaskell l) <+> r)) (text "SpecsEmpty")
genSigTp :: [String] -> Doc
genSigTp = foldr (\l r -> parens (text "T'" <> text (encodeNmHaskell l) <+> text "," <+> r)) (text "()")
{-# LINE 109 "dist/src/sdist.27680/asil-1.2/dist/build/GenInstrLib.hs" #-}
-- ClassV ------------------------------------------------------
-- cata
sem_ClassV :: ClassV ->
T_ClassV
sem_ClassV (ClassV_Class _ref _nm _mbSuper _itfs _dynTraits _staTraits ) =
(sem_ClassV_Class _ref (sem_NmV _nm ) (sem_MbSuperV _mbSuper ) (sem_ItfsV _itfs ) (sem_TraitsV _dynTraits ) (sem_TraitsV _staTraits ) )
-- semantic domain
type T_ClassV = ( (Set String),(Set String),T_ClassV_1 )
type T_ClassV_1 = (Set String) ->
(Set String) ->
SymInfo ->
(Set String) ->
(Set String) ->
( (Set String),(Set String),Doc)
sem_ClassV_Class :: ClassRef ->
T_NmV ->
T_MbSuperV ->
T_ItfsV ->
T_TraitsV ->
T_TraitsV ->
T_ClassV
sem_ClassV_Class ref_ nm_ mbSuper_ itfs_ dynTraits_ staTraits_ =
(case (staTraits_ ) of
{ ( _staTraitsIgathFields,staTraits_1) | True ->
(case (dynTraits_ ) of
{ ( _dynTraitsIgathFields,dynTraits_1) | True ->
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
_dynTraitsIgathFields `mappend` _staTraitsIgathFields
{-# LINE 138 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 54 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 143 "src/GenInstrLib.hs" #-}
)) of
{ _gathTypes_augmented_syn | _gathTypes_augmented_syn `seq` (True) ->
(case (nm_ ) of
{ ( _nmImbStrUni) | True ->
(case (({-# LINE 54 "src/GenInstrLib.ag" #-}
maybe id Set.insert _nmImbStrUni
{-# LINE 150 "src/GenInstrLib.hs" #-}
)) of
{ _gathTypes_augmented_f1 | _gathTypes_augmented_f1 `seq` (True) ->
(case (({-# LINE 54 "src/GenInstrLib.ag" #-}
foldr ($) _gathTypes_augmented_syn [_gathTypes_augmented_f1]
{-# LINE 155 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_ClassV_Class_1 :: T_ClassV_1
sem_ClassV_Class_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 167 "src/GenInstrLib.hs" #-}
)) of
{ _dynTraitsOnewFields | _dynTraitsOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 172 "src/GenInstrLib.hs" #-}
)) of
{ _dynTraitsOgEnv | _dynTraitsOgEnv `seq` (True) ->
(case (({-# LINE 149 "src/GenInstrLib.ag" #-}
maybe "{-# ClassV_Class: improper name #-}" id _nmImbStrUni
{-# LINE 177 "src/GenInstrLib.hs" #-}
)) of
{ _classNm | _classNm `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_classNm
{-# LINE 182 "src/GenInstrLib.hs" #-}
)) of
{ _dynTraitsOclassNm | _dynTraitsOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 187 "src/GenInstrLib.hs" #-}
)) of
{ _dynTraitsOallTypes | _dynTraitsOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 192 "src/GenInstrLib.hs" #-}
)) of
{ _dynTraitsOallFields | _dynTraitsOallFields `seq` (True) ->
(case (dynTraits_1 _dynTraitsOallFields _dynTraitsOallTypes _dynTraitsOclassNm _dynTraitsOgEnv _dynTraitsOnewFields ) of
{ ( _dynTraitsInewFields,_dynTraitsIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_dynTraitsInewFields
{-# LINE 199 "src/GenInstrLib.hs" #-}
)) of
{ _staTraitsOnewFields | _staTraitsOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 204 "src/GenInstrLib.hs" #-}
)) of
{ _staTraitsOgEnv | _staTraitsOgEnv `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_classNm
{-# LINE 209 "src/GenInstrLib.hs" #-}
)) of
{ _staTraitsOclassNm | _staTraitsOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 214 "src/GenInstrLib.hs" #-}
)) of
{ _staTraitsOallTypes | _staTraitsOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 219 "src/GenInstrLib.hs" #-}
)) of
{ _staTraitsOallFields | _staTraitsOallFields `seq` (True) ->
(case (staTraits_1 _staTraitsOallFields _staTraitsOallTypes _staTraitsOclassNm _staTraitsOgEnv _staTraitsOnewFields ) of
{ ( _staTraitsInewFields,_staTraitsIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_staTraitsInewFields
{-# LINE 226 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 231 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_classNm
{-# LINE 236 "src/GenInstrLib.hs" #-}
)) of
{ _itfsOclassNm | _itfsOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 241 "src/GenInstrLib.hs" #-}
)) of
{ _itfsOallTypes | _itfsOallTypes `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_classNm
{-# LINE 246 "src/GenInstrLib.hs" #-}
)) of
{ _mbSuperOclassNm | _mbSuperOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 251 "src/GenInstrLib.hs" #-}
)) of
{ _mbSuperOallTypes | _mbSuperOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 256 "src/GenInstrLib.hs" #-}
)) of
{ _itfsOgEnv | _itfsOgEnv `seq` (True) ->
(case (itfs_ _itfsOallTypes _itfsOclassNm _itfsOgEnv ) of
{ ( _itfsIoutput) | True ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 263 "src/GenInstrLib.hs" #-}
)) of
{ _mbSuperOgEnv | _mbSuperOgEnv `seq` (True) ->
(case (mbSuper_ _mbSuperOallTypes _mbSuperOclassNm _mbSuperOgEnv ) of
{ ( _mbSuperIoutput) | True ->
(case (({-# LINE 131 "src/GenInstrLib.ag" #-}
_mbSuperIoutput $+$ _itfsIoutput $+$ _dynTraitsIoutput $+$ _staTraitsIoutput
{-# LINE 270 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_syn | _output_augmented_syn `seq` (True) ->
(case (({-# LINE 131 "src/GenInstrLib.ag" #-}
maybe id (\str -> (genClassData str $+$)) _nmImbStrUni
{-# LINE 275 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_f1 | _output_augmented_f1 `seq` (True) ->
(case (({-# LINE 131 "src/GenInstrLib.ag" #-}
foldr ($) _output_augmented_syn [_output_augmented_f1]
{-# LINE 280 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_ClassV_Class_1)) of
{ ( sem_ClassV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_ClassV_1) }) }) }) }) }) }) }) })
-- ClassesV ----------------------------------------------------
-- cata
sem_ClassesV :: ClassesV ->
T_ClassesV
sem_ClassesV list =
(Prelude.foldr sem_ClassesV_Cons sem_ClassesV_Nil (Prelude.map sem_ClassV list) )
-- semantic domain
type T_ClassesV = ( (Set String),(Set String),T_ClassesV_1 )
type T_ClassesV_1 = (Set String) ->
(Set String) ->
SymInfo ->
(Set String) ->
(Set String) ->
( (Set String),(Set String),Doc)
sem_ClassesV_Cons :: T_ClassV ->
T_ClassesV ->
T_ClassesV
sem_ClassesV_Cons hd_ tl_ =
(case (tl_ ) of
{ ( _tlIgathFields,_tlIgathTypes,tl_1) | True ->
(case (hd_ ) of
{ ( _hdIgathFields,_hdIgathTypes,hd_1) | True ->
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
_hdIgathFields `mappend` _tlIgathFields
{-# LINE 311 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 51 "src/GenInstrLib.ag" #-}
_hdIgathTypes `mappend` _tlIgathTypes
{-# LINE 316 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_ClassesV_Cons_1 :: T_ClassesV_1
sem_ClassesV_Cons_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 328 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewFields | _hdOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 333 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewMethods | _hdOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 338 "src/GenInstrLib.hs" #-}
)) of
{ _hdOgEnv | _hdOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 343 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 348 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallFields | _hdOallFields `seq` (True) ->
(case (hd_1 _hdOallFields _hdOallTypes _hdOgEnv _hdOnewFields _hdOnewMethods ) of
{ ( _hdInewFields,_hdInewMethods,_hdIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_hdInewFields
{-# LINE 355 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewFields | _tlOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_hdInewMethods
{-# LINE 360 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewMethods | _tlOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 365 "src/GenInstrLib.hs" #-}
)) of
{ _tlOgEnv | _tlOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 370 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 375 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallFields | _tlOallFields `seq` (True) ->
(case (tl_1 _tlOallFields _tlOallTypes _tlOgEnv _tlOnewFields _tlOnewMethods ) of
{ ( _tlInewFields,_tlInewMethods,_tlIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_tlInewFields
{-# LINE 382 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_tlInewMethods
{-# LINE 387 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_hdIoutput $+$ _tlIoutput
{-# LINE 392 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_ClassesV_Cons_1)) of
{ ( sem_ClassesV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_ClassesV_1) }) }) }) }) })
sem_ClassesV_Nil :: T_ClassesV
sem_ClassesV_Nil =
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 403 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 51 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 408 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_ClassesV_Nil_1 :: T_ClassesV_1
sem_ClassesV_Nil_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 420 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 425 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 430 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }))
in sem_ClassesV_Nil_1)) of
{ ( sem_ClassesV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_ClassesV_1) }) }) })
-- FileV -------------------------------------------------------
-- cata
sem_FileV :: FileV ->
T_FileV
sem_FileV (FileV_File _tables ) =
(sem_FileV_File (sem_TablesV _tables ) )
-- semantic domain
type T_FileV = SymInfo ->
String ->
( Doc)
data Inh_FileV = Inh_FileV {gEnv_Inh_FileV :: !(SymInfo),modNm_Inh_FileV :: !(String)}
data Syn_FileV = Syn_FileV {output_Syn_FileV :: !(Doc)}
wrap_FileV :: T_FileV ->
Inh_FileV ->
Syn_FileV
wrap_FileV sem (Inh_FileV _lhsIgEnv _lhsImodNm ) =
(let ( _lhsOoutput) | True = sem _lhsIgEnv _lhsImodNm
in (Syn_FileV _lhsOoutput ))
sem_FileV_File :: T_TablesV ->
T_FileV
sem_FileV_File tables_ =
(\ _lhsIgEnv
_lhsImodNm ->
(case (({-# LINE 266 "src/GenInstrLib.ag" #-}
Set.empty
{-# LINE 462 "src/GenInstrLib.hs" #-}
)) of
{ _tablesOnewMethods | _tablesOnewMethods `seq` (True) ->
(case (({-# LINE 265 "src/GenInstrLib.ag" #-}
Set.empty
{-# LINE 467 "src/GenInstrLib.hs" #-}
)) of
{ _tablesOnewFields | _tablesOnewFields `seq` (True) ->
(case (tables_ ) of
{ ( _tablesIgathFields,_tablesIgathTypes,tables_1) | True ->
(case (({-# LINE 94 "src/GenInstrLib.ag" #-}
Set.toList $ Set.difference (Set.map unqualField _tablesIgathFields) (Set.map unqualField $ allFields _lhsIgEnv)
{-# LINE 474 "src/GenInstrLib.hs" #-}
)) of
{ _newFields | _newFields `seq` (True) ->
(case (({-# LINE 95 "src/GenInstrLib.ag" #-}
vert $ map genFieldClass _newFields
{-# LINE 479 "src/GenInstrLib.hs" #-}
)) of
{ _fieldsOutput | _fieldsOutput `seq` (True) ->
(case (({-# LINE 63 "src/GenInstrLib.ag" #-}
_tablesIgathTypes `mappend` (allTypes _lhsIgEnv)
{-# LINE 484 "src/GenInstrLib.hs" #-}
)) of
{ _tablesOallTypes | _tablesOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 489 "src/GenInstrLib.hs" #-}
)) of
{ _tablesOgEnv | _tablesOgEnv `seq` (True) ->
(case (({-# LINE 64 "src/GenInstrLib.ag" #-}
_tablesIgathFields `mappend` (allFields _lhsIgEnv)
{-# LINE 494 "src/GenInstrLib.hs" #-}
)) of
{ _tablesOallFields | _tablesOallFields `seq` (True) ->
(case (tables_1 _tablesOallFields _tablesOallTypes _tablesOgEnv _tablesOnewFields _tablesOnewMethods ) of
{ ( _tablesInewFields,_tablesInewMethods,_tablesIoutput) | True ->
(case (({-# LINE 42 "src/GenInstrLib.ag" #-}
vert [ text "{-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, OverlappingInstances, FlexibleInstances #-}"
, text "module" <+> text _lhsImodNm <+> text "where"
, text "import Instr"
, text "import InstrBaseLib"
, (vert $ map (\m -> text "import" <+> text m) $ Set.toList $ allModules _lhsIgEnv)
, _fieldsOutput
, _tablesIoutput ]
{-# LINE 507 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }) }) }) }) }) }) }) }) }) }))
-- ItfV --------------------------------------------------------
-- cata
sem_ItfV :: ItfV ->
T_ItfV
sem_ItfV (ItfV_Itf _tp ) =
(sem_ItfV_Itf (sem_TypeV _tp ) )
-- semantic domain
type T_ItfV = (Set String) ->
String ->
SymInfo ->
( Doc)
sem_ItfV_Itf :: T_TypeV ->
T_ItfV
sem_ItfV_Itf tp_ =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 530 "src/GenInstrLib.hs" #-}
)) of
{ _tpOallTypes | _tpOallTypes `seq` (True) ->
(case (({-# LINE 159 "src/GenInstrLib.ag" #-}
empty
{-# LINE 535 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_syn | _output_augmented_syn `seq` (True) ->
(case (tp_ _tpOallTypes ) of
{ ( _tpImbStrUni,_tpIstrAnnot,_tpIstrUni,_tpItpKnown) | True ->
(case (({-# LINE 158 "src/GenInstrLib.ag" #-}
maybe "{-# ItfV_Itf: improper name #-}" id _tpImbStrUni
{-# LINE 542 "src/GenInstrLib.hs" #-}
)) of
{ _super | _super `seq` (True) ->
(case (({-# LINE 159 "src/GenInstrLib.ag" #-}
if _tpItpKnown
then (genSuper _super _lhsIclassNm $+$)
else id
{-# LINE 549 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_f1 | _output_augmented_f1 `seq` (True) ->
(case (({-# LINE 159 "src/GenInstrLib.ag" #-}
foldr ($) _output_augmented_syn [_output_augmented_f1]
{-# LINE 554 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }) }) }) }) }) }))
-- ItfsV -------------------------------------------------------
-- cata
sem_ItfsV :: ItfsV ->
T_ItfsV
sem_ItfsV list =
(Prelude.foldr sem_ItfsV_Cons sem_ItfsV_Nil (Prelude.map sem_ItfV list) )
-- semantic domain
type T_ItfsV = (Set String) ->
String ->
SymInfo ->
( Doc)
sem_ItfsV_Cons :: T_ItfV ->
T_ItfsV ->
T_ItfsV
sem_ItfsV_Cons hd_ tl_ =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_lhsIclassNm
{-# LINE 578 "src/GenInstrLib.hs" #-}
)) of
{ _tlOclassNm | _tlOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 583 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_lhsIclassNm
{-# LINE 588 "src/GenInstrLib.hs" #-}
)) of
{ _hdOclassNm | _hdOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 593 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 598 "src/GenInstrLib.hs" #-}
)) of
{ _tlOgEnv | _tlOgEnv `seq` (True) ->
(case (tl_ _tlOallTypes _tlOclassNm _tlOgEnv ) of
{ ( _tlIoutput) | True ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 605 "src/GenInstrLib.hs" #-}
)) of
{ _hdOgEnv | _hdOgEnv `seq` (True) ->
(case (hd_ _hdOallTypes _hdOclassNm _hdOgEnv ) of
{ ( _hdIoutput) | True ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_hdIoutput $+$ _tlIoutput
{-# LINE 612 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }) }) }) }) }) }) }) }) }))
sem_ItfsV_Nil :: T_ItfsV
sem_ItfsV_Nil =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 623 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }))
-- MbNmV -------------------------------------------------------
-- cata
sem_MbNmV :: MbNmV ->
T_MbNmV
sem_MbNmV (Prelude.Just x ) =
(sem_MbNmV_Just (sem_NmV x ) )
sem_MbNmV Prelude.Nothing =
sem_MbNmV_Nothing
-- semantic domain
type T_MbNmV = ( )
sem_MbNmV_Just :: T_NmV ->
T_MbNmV
sem_MbNmV_Just just_ =
( )
sem_MbNmV_Nothing :: T_MbNmV
sem_MbNmV_Nothing =
( )
-- MbStrV ------------------------------------------------------
-- cata
sem_MbStrV :: MbStrV ->
T_MbStrV
sem_MbStrV (Prelude.Just x ) =
(sem_MbStrV_Just (sem_StrV x ) )
sem_MbStrV Prelude.Nothing =
sem_MbStrV_Nothing
-- semantic domain
type T_MbStrV = ( (Maybe String))
sem_MbStrV_Just :: T_StrV ->
T_MbStrV
sem_MbStrV_Just just_ =
(case (just_ ) of
{ ( _justIstr) | True ->
(case (({-# LINE 86 "src/GenInstrLib.ag" #-}
Just _justIstr
{-# LINE 661 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
( _lhsOmbStrUni) }) })
sem_MbStrV_Nothing :: T_MbStrV
sem_MbStrV_Nothing =
(case (({-# LINE 85 "src/GenInstrLib.ag" #-}
Nothing
{-# LINE 669 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
( _lhsOmbStrUni) })
-- MbSuperV ----------------------------------------------------
-- cata
sem_MbSuperV :: MbSuperV ->
T_MbSuperV
sem_MbSuperV (Prelude.Just x ) =
(sem_MbSuperV_Just (sem_SuperV x ) )
sem_MbSuperV Prelude.Nothing =
sem_MbSuperV_Nothing
-- semantic domain
type T_MbSuperV = (Set String) ->
String ->
SymInfo ->
( Doc)
sem_MbSuperV_Just :: T_SuperV ->
T_MbSuperV
sem_MbSuperV_Just just_ =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_lhsIclassNm
{-# LINE 694 "src/GenInstrLib.hs" #-}
)) of
{ _justOclassNm | _justOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 699 "src/GenInstrLib.hs" #-}
)) of
{ _justOallTypes | _justOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 704 "src/GenInstrLib.hs" #-}
)) of
{ _justOgEnv | _justOgEnv `seq` (True) ->
(case (just_ _justOallTypes _justOclassNm _justOgEnv ) of
{ ( _justIoutput) | True ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_justIoutput
{-# LINE 711 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }) }) }) }) }))
sem_MbSuperV_Nothing :: T_MbSuperV
sem_MbSuperV_Nothing =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 722 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }))
-- MethodV -----------------------------------------------------
-- cata
sem_MethodV :: MethodV ->
T_MethodV
sem_MethodV (MethodV_Method _mbNm _sig ) =
(sem_MethodV_Method (sem_MbStrV _mbNm ) (sem_SigV _sig ) )
-- semantic domain
type T_MethodV = (Set String) ->
SymInfo ->
(Set String) ->
( (Set String),Doc)
sem_MethodV_Method :: T_MbStrV ->
T_SigV ->
T_MethodV
sem_MethodV_Method mbNm_ sig_ =
(\ _lhsIallTypes
_lhsIgEnv
_lhsInewMethods ->
(case (({-# LINE 272 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 746 "src/GenInstrLib.hs" #-}
)) of
{ _newMethods_augmented_syn | _newMethods_augmented_syn `seq` (True) ->
(case (mbNm_ ) of
{ ( _mbNmImbStrUni) | True ->
(case (({-# LINE 272 "src/GenInstrLib.ag" #-}
maybe id Set.insert _mbNmImbStrUni
{-# LINE 753 "src/GenInstrLib.hs" #-}
)) of
{ _newMethods_augmented_f1 | _newMethods_augmented_f1 `seq` (True) ->
(case (({-# LINE 272 "src/GenInstrLib.ag" #-}
foldr ($) _newMethods_augmented_syn [_newMethods_augmented_f1]
{-# LINE 758 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 763 "src/GenInstrLib.hs" #-}
)) of
{ _sigOallTypes | _sigOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 768 "src/GenInstrLib.hs" #-}
)) of
{ _sigOgEnv | _sigOgEnv `seq` (True) ->
(case (sig_ _sigOallTypes _sigOgEnv ) of
{ ( _sigIoutput,_sigItpSig) | True ->
(case (({-# LINE 221 "src/GenInstrLib.ag" #-}
maybe empty (\nm -> vert [ text "-- method" <+> text (show nm)
, if nm `Set.member` _lhsInewMethods
then text "-- DUPLICATED method declaration"
else genMethod nm _sigIoutput _sigItpSig
]) _mbNmImbStrUni
{-# LINE 779 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }))
-- MethodsV ----------------------------------------------------
-- cata
sem_MethodsV :: MethodsV ->
T_MethodsV
sem_MethodsV list =
(Prelude.foldr sem_MethodsV_Cons sem_MethodsV_Nil (Prelude.map sem_MethodV list) )
-- semantic domain
type T_MethodsV = (Set String) ->
SymInfo ->
(Set String) ->
( (Set String),Doc)
sem_MethodsV_Cons :: T_MethodV ->
T_MethodsV ->
T_MethodsV
sem_MethodsV_Cons hd_ tl_ =
(\ _lhsIallTypes
_lhsIgEnv
_lhsInewMethods ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 803 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewMethods | _hdOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 808 "src/GenInstrLib.hs" #-}
)) of
{ _hdOgEnv | _hdOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 813 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (hd_ _hdOallTypes _hdOgEnv _hdOnewMethods ) of
{ ( _hdInewMethods,_hdIoutput) | True ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_hdInewMethods
{-# LINE 820 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewMethods | _tlOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 825 "src/GenInstrLib.hs" #-}
)) of
{ _tlOgEnv | _tlOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 830 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (tl_ _tlOallTypes _tlOgEnv _tlOnewMethods ) of
{ ( _tlInewMethods,_tlIoutput) | True ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_tlInewMethods
{-# LINE 837 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_hdIoutput $+$ _tlIoutput
{-# LINE 842 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }) }) }))
sem_MethodsV_Nil :: T_MethodsV
sem_MethodsV_Nil =
(\ _lhsIallTypes
_lhsIgEnv
_lhsInewMethods ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 853 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 858 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewMethods,_lhsOoutput) }) }))
-- NmV ---------------------------------------------------------
-- cata
sem_NmV :: NmV ->
T_NmV
sem_NmV (NmV_Other _id ) =
(sem_NmV_Other _id )
sem_NmV (NmV_Qual _id _ns _nm ) =
(sem_NmV_Qual _id (sem_NsV _ns ) (sem_StrV _nm ) )
sem_NmV (NmV_Quals _id _set _nm ) =
(sem_NmV_Quals _id (sem_NsSetV _set ) (sem_StrV _nm ) )
-- semantic domain
type T_NmV = ( (Maybe String))
sem_NmV_Other :: NameRef ->
T_NmV
sem_NmV_Other id_ =
(case (({-# LINE 78 "src/GenInstrLib.ag" #-}
Nothing
{-# LINE 879 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
( _lhsOmbStrUni) })
sem_NmV_Qual :: NameRef ->
T_NsV ->
T_StrV ->
T_NmV
sem_NmV_Qual id_ ns_ nm_ =
(case (ns_ ) of
{ ( _nsIstr) | True ->
(case (({-# LINE 74 "src/GenInstrLib.ag" #-}
null _nsIstr
{-# LINE 892 "src/GenInstrLib.hs" #-}
)) of
{ _noPrefix | _noPrefix `seq` (True) ->
(case (nm_ ) of
{ ( _nmIstr) | True ->
(case (({-# LINE 75 "src/GenInstrLib.ag" #-}
if _noPrefix then _nmIstr else _nsIstr ++ "˳" ++ _nmIstr
{-# LINE 899 "src/GenInstrLib.hs" #-}
)) of
{ _strUni | _strUni `seq` (True) ->
(case (({-# LINE 76 "src/GenInstrLib.ag" #-}
Just _strUni
{-# LINE 904 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
( _lhsOmbStrUni) }) }) }) }) })
sem_NmV_Quals :: NameRef ->
T_NsSetV ->
T_StrV ->
T_NmV
sem_NmV_Quals id_ set_ nm_ =
(case (({-# LINE 77 "src/GenInstrLib.ag" #-}
Nothing
{-# LINE 915 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
( _lhsOmbStrUni) })
-- NmsV --------------------------------------------------------
-- cata
sem_NmsV :: NmsV ->
T_NmsV
sem_NmsV list =
(Prelude.foldr sem_NmsV_Cons sem_NmsV_Nil (Prelude.map sem_NmV list) )
-- semantic domain
type T_NmsV = ( )
sem_NmsV_Cons :: T_NmV ->
T_NmsV ->
T_NmsV
sem_NmsV_Cons hd_ tl_ =
( )
sem_NmsV_Nil :: T_NmsV
sem_NmsV_Nil =
( )
-- NsSetV ------------------------------------------------------
-- cata
sem_NsSetV :: NsSetV ->
T_NsSetV
sem_NsSetV (NsSetV_Set _id _spaces ) =
(sem_NsSetV_Set _id (sem_NssV _spaces ) )
-- semantic domain
type T_NsSetV = ( )
sem_NsSetV_Set :: NamesetRef ->
T_NssV ->
T_NsSetV
sem_NsSetV_Set id_ spaces_ =
( )
-- NsV ---------------------------------------------------------
-- cata
sem_NsV :: NsV ->
T_NsV
sem_NsV (NsV_Ns _id _nm ) =
(sem_NsV_Ns _id (sem_StrV _nm ) )
-- semantic domain
type T_NsV = ( String)
sem_NsV_Ns :: NamespaceRef ->
T_StrV ->
T_NsV
sem_NsV_Ns id_ nm_ =
(case (nm_ ) of
{ ( _nmIstr) | True ->
(case (({-# LINE 80 "src/GenInstrLib.ag" #-}
_nmIstr
{-# LINE 964 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstr | _lhsOstr `seq` (True) ->
( _lhsOstr) }) })
-- NssV --------------------------------------------------------
-- cata
sem_NssV :: NssV ->
T_NssV
sem_NssV list =
(Prelude.foldr sem_NssV_Cons sem_NssV_Nil (Prelude.map sem_NsV list) )
-- semantic domain
type T_NssV = ( )
sem_NssV_Cons :: T_NsV ->
T_NssV ->
T_NssV
sem_NssV_Cons hd_ tl_ =
( )
sem_NssV_Nil :: T_NssV
sem_NssV_Nil =
( )
-- ParamV ------------------------------------------------------
-- cata
sem_ParamV :: ParamV ->
T_ParamV
sem_ParamV (ParamV_Param _mbNm _tp ) =
(sem_ParamV_Param (sem_MbStrV _mbNm ) (sem_TypeV _tp ) )
-- semantic domain
type T_ParamV = (Set String) ->
( ([String]))
sem_ParamV_Param :: T_MbStrV ->
T_TypeV ->
T_ParamV
sem_ParamV_Param mbNm_ tp_ =
(\ _lhsIallTypes ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1000 "src/GenInstrLib.hs" #-}
)) of
{ _tpOallTypes | _tpOallTypes `seq` (True) ->
(case (tp_ _tpOallTypes ) of
{ ( _tpImbStrUni,_tpIstrAnnot,_tpIstrUni,_tpItpKnown) | True ->
(case (({-# LINE 245 "src/GenInstrLib.ag" #-}
[_tpIstrUni]
{-# LINE 1007 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstrsUni | _lhsOstrsUni `seq` (True) ->
( _lhsOstrsUni) }) }) }))
-- ParamsV -----------------------------------------------------
-- cata
sem_ParamsV :: ParamsV ->
T_ParamsV
sem_ParamsV list =
(Prelude.foldr sem_ParamsV_Cons sem_ParamsV_Nil (Prelude.map sem_ParamV list) )
-- semantic domain
type T_ParamsV = (Set String) ->
( ([String]))
sem_ParamsV_Cons :: T_ParamV ->
T_ParamsV ->
T_ParamsV
sem_ParamsV_Cons hd_ tl_ =
(\ _lhsIallTypes ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1027 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1032 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (tl_ _tlOallTypes ) of
{ ( _tlIstrsUni) | True ->
(case (hd_ _hdOallTypes ) of
{ ( _hdIstrsUni) | True ->
(case (({-# LINE 242 "src/GenInstrLib.ag" #-}
_hdIstrsUni ++ _tlIstrsUni
{-# LINE 1041 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstrsUni | _lhsOstrsUni `seq` (True) ->
( _lhsOstrsUni) }) }) }) }) }))
sem_ParamsV_Nil :: T_ParamsV
sem_ParamsV_Nil =
(\ _lhsIallTypes ->
(case (({-# LINE 242 "src/GenInstrLib.ag" #-}
[]
{-# LINE 1050 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstrsUni | _lhsOstrsUni `seq` (True) ->
( _lhsOstrsUni) }))
-- SigV --------------------------------------------------------
-- cata
sem_SigV :: SigV ->
T_SigV
sem_SigV (SigV_Sig _id _ret _params ) =
(sem_SigV_Sig _id (sem_TypeV _ret ) (sem_ParamsV _params ) )
-- semantic domain
type T_SigV = (Set String) ->
SymInfo ->
( Doc,Doc)
sem_SigV_Sig :: MethodRef ->
T_TypeV ->
T_ParamsV ->
T_SigV
sem_SigV_Sig id_ ret_ params_ =
(\ _lhsIallTypes
_lhsIgEnv ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1073 "src/GenInstrLib.hs" #-}
)) of
{ _paramsOallTypes | _paramsOallTypes `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1078 "src/GenInstrLib.hs" #-}
)) of
{ _retOallTypes | _retOallTypes `seq` (True) ->
(case (params_ _paramsOallTypes ) of
{ ( _paramsIstrsUni) | True ->
(case (ret_ _retOallTypes ) of
{ ( _retImbStrUni,_retIstrAnnot,_retIstrUni,_retItpKnown) | True ->
(case (({-# LINE 239 "src/GenInstrLib.ag" #-}
text "FunSig" <+> parens (genSigVal _paramsIstrsUni) <+> parens (genSigVal [_retIstrUni])
{-# LINE 1087 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
(case (({-# LINE 240 "src/GenInstrLib.ag" #-}
text "FunSpec" <+> parens (genSigTp _paramsIstrsUni) <+> parens (genSigTp [_retIstrUni])
{-# LINE 1092 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOtpSig | _lhsOtpSig `seq` (True) ->
( _lhsOoutput,_lhsOtpSig) }) }) }) }) }) }))
-- StrV --------------------------------------------------------
-- cata
sem_StrV :: StrV ->
T_StrV
sem_StrV (StrV_Str _id _val ) =
(sem_StrV_Str _id _val )
-- semantic domain
type T_StrV = ( String)
sem_StrV_Str :: StringRef ->
String ->
T_StrV
sem_StrV_Str id_ val_ =
(case (({-# LINE 81 "src/GenInstrLib.ag" #-}
val_
{-# LINE 1110 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstr | _lhsOstr `seq` (True) ->
( _lhsOstr) })
-- SuperV ------------------------------------------------------
-- cata
sem_SuperV :: SuperV ->
T_SuperV
sem_SuperV (SuperV_Super _tp ) =
(sem_SuperV_Super (sem_TypeV _tp ) )
-- semantic domain
type T_SuperV = (Set String) ->
String ->
SymInfo ->
( Doc)
sem_SuperV_Super :: T_TypeV ->
T_SuperV
sem_SuperV_Super tp_ =
(\ _lhsIallTypes
_lhsIclassNm
_lhsIgEnv ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1133 "src/GenInstrLib.hs" #-}
)) of
{ _tpOallTypes | _tpOallTypes `seq` (True) ->
(case (({-# LINE 153 "src/GenInstrLib.ag" #-}
empty
{-# LINE 1138 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_syn | _output_augmented_syn `seq` (True) ->
(case (tp_ _tpOallTypes ) of
{ ( _tpImbStrUni,_tpIstrAnnot,_tpIstrUni,_tpItpKnown) | True ->
(case (({-# LINE 152 "src/GenInstrLib.ag" #-}
maybe "{-# SuperV_Super: improper name #-}" id _tpImbStrUni
{-# LINE 1145 "src/GenInstrLib.hs" #-}
)) of
{ _super | _super `seq` (True) ->
(case (({-# LINE 153 "src/GenInstrLib.ag" #-}
if _tpItpKnown
then (genSuper _super _lhsIclassNm $+$)
else id
{-# LINE 1152 "src/GenInstrLib.hs" #-}
)) of
{ _output_augmented_f1 | _output_augmented_f1 `seq` (True) ->
(case (({-# LINE 153 "src/GenInstrLib.ag" #-}
foldr ($) _output_augmented_syn [_output_augmented_f1]
{-# LINE 1157 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOoutput) }) }) }) }) }) }))
-- TableV ------------------------------------------------------
-- cata
sem_TableV :: TableV ->
T_TableV
sem_TableV (TableV_Table _classes _methods ) =
(sem_TableV_Table (sem_ClassesV _classes ) (sem_MethodsV _methods ) )
-- semantic domain
type T_TableV = ( (Set String),(Set String),T_TableV_1 )
type T_TableV_1 = (Set String) ->
(Set String) ->
SymInfo ->
(Set String) ->
(Set String) ->
( (Set String),(Set String),Doc)
sem_TableV_Table :: T_ClassesV ->
T_MethodsV ->
T_TableV
sem_TableV_Table classes_ methods_ =
(case (classes_ ) of
{ ( _classesIgathFields,_classesIgathTypes,classes_1) | True ->
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
_classesIgathFields
{-# LINE 1183 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 51 "src/GenInstrLib.ag" #-}
_classesIgathTypes
{-# LINE 1188 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_TableV_Table_1 :: T_TableV_1
sem_TableV_Table_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1200 "src/GenInstrLib.hs" #-}
)) of
{ _classesOnewFields | _classesOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 1205 "src/GenInstrLib.hs" #-}
)) of
{ _classesOnewMethods | _classesOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1210 "src/GenInstrLib.hs" #-}
)) of
{ _classesOgEnv | _classesOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1215 "src/GenInstrLib.hs" #-}
)) of
{ _classesOallTypes | _classesOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 1220 "src/GenInstrLib.hs" #-}
)) of
{ _classesOallFields | _classesOallFields `seq` (True) ->
(case (classes_1 _classesOallFields _classesOallTypes _classesOgEnv _classesOnewFields _classesOnewMethods ) of
{ ( _classesInewFields,_classesInewMethods,_classesIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_classesInewFields
{-# LINE 1227 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_classesInewMethods
{-# LINE 1232 "src/GenInstrLib.hs" #-}
)) of
{ _methodsOnewMethods | _methodsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1237 "src/GenInstrLib.hs" #-}
)) of
{ _methodsOgEnv | _methodsOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1242 "src/GenInstrLib.hs" #-}
)) of
{ _methodsOallTypes | _methodsOallTypes `seq` (True) ->
(case (methods_ _methodsOallTypes _methodsOgEnv _methodsOnewMethods ) of
{ ( _methodsInewMethods,_methodsIoutput) | True ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_methodsInewMethods
{-# LINE 1249 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_classesIoutput $+$ _methodsIoutput
{-# LINE 1254 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_TableV_Table_1)) of
{ ( sem_TableV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_TableV_1) }) }) }) })
-- TablesV -----------------------------------------------------
-- cata
sem_TablesV :: TablesV ->
T_TablesV
sem_TablesV list =
(Prelude.foldr sem_TablesV_Cons sem_TablesV_Nil (Prelude.map sem_TableV list) )
-- semantic domain
type T_TablesV = ( (Set String),(Set String),T_TablesV_1 )
type T_TablesV_1 = (Set String) ->
(Set String) ->
SymInfo ->
(Set String) ->
(Set String) ->
( (Set String),(Set String),Doc)
sem_TablesV_Cons :: T_TableV ->
T_TablesV ->
T_TablesV
sem_TablesV_Cons hd_ tl_ =
(case (tl_ ) of
{ ( _tlIgathFields,_tlIgathTypes,tl_1) | True ->
(case (hd_ ) of
{ ( _hdIgathFields,_hdIgathTypes,hd_1) | True ->
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
_hdIgathFields `mappend` _tlIgathFields
{-# LINE 1285 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 51 "src/GenInstrLib.ag" #-}
_hdIgathTypes `mappend` _tlIgathTypes
{-# LINE 1290 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_TablesV_Cons_1 :: T_TablesV_1
sem_TablesV_Cons_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1302 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewFields | _hdOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 1307 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewMethods | _hdOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1312 "src/GenInstrLib.hs" #-}
)) of
{ _hdOgEnv | _hdOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1317 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 1322 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallFields | _hdOallFields `seq` (True) ->
(case (hd_1 _hdOallFields _hdOallTypes _hdOgEnv _hdOnewFields _hdOnewMethods ) of
{ ( _hdInewFields,_hdInewMethods,_hdIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_hdInewFields
{-# LINE 1329 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewFields | _tlOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_hdInewMethods
{-# LINE 1334 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewMethods | _tlOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1339 "src/GenInstrLib.hs" #-}
)) of
{ _tlOgEnv | _tlOgEnv `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1344 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 1349 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallFields | _tlOallFields `seq` (True) ->
(case (tl_1 _tlOallFields _tlOallTypes _tlOgEnv _tlOnewFields _tlOnewMethods ) of
{ ( _tlInewFields,_tlInewMethods,_tlIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_tlInewFields
{-# LINE 1356 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_tlInewMethods
{-# LINE 1361 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_hdIoutput $+$ _tlIoutput
{-# LINE 1366 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_TablesV_Cons_1)) of
{ ( sem_TablesV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_TablesV_1) }) }) }) }) })
sem_TablesV_Nil :: T_TablesV
sem_TablesV_Nil =
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1377 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case (({-# LINE 51 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1382 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathTypes | _lhsOgathTypes `seq` (True) ->
(case ((let sem_TablesV_Nil_1 :: T_TablesV_1
sem_TablesV_Nil_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIgEnv
_lhsInewFields
_lhsInewMethods ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1394 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 262 "src/GenInstrLib.ag" #-}
_lhsInewMethods
{-# LINE 1399 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewMethods | _lhsOnewMethods `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 1404 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOnewMethods,_lhsOoutput) }) }) }))
in sem_TablesV_Nil_1)) of
{ ( sem_TablesV_1) | True ->
( _lhsOgathFields,_lhsOgathTypes,sem_TablesV_1) }) }) })
-- TraitV ------------------------------------------------------
-- cata
sem_TraitV :: TraitV ->
T_TraitV
sem_TraitV (TraitV_Field _nm _tp ) =
(sem_TraitV_Field (sem_NmV _nm ) (sem_TypeV _tp ) )
sem_TraitV (TraitV_Method _nm _sig ) =
(sem_TraitV_Method (sem_NmV _nm ) (sem_SigV _sig ) )
sem_TraitV (TraitV_Other _nm ) =
(sem_TraitV_Other (sem_NmV _nm ) )
-- semantic domain
type T_TraitV = ( (Set String),T_TraitV_1 )
type T_TraitV_1 = (Set String) ->
(Set String) ->
String ->
SymInfo ->
(Set String) ->
( (Set String),Doc)
sem_TraitV_Field :: T_NmV ->
T_TypeV ->
T_TraitV
sem_TraitV_Field nm_ tp_ =
(case (({-# LINE 56 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1435 "src/GenInstrLib.hs" #-}
)) of
{ _gathFields_augmented_syn | _gathFields_augmented_syn `seq` (True) ->
(case (nm_ ) of
{ ( _nmImbStrUni) | True ->
(case (({-# LINE 56 "src/GenInstrLib.ag" #-}
maybe id Set.insert _nmImbStrUni
{-# LINE 1442 "src/GenInstrLib.hs" #-}
)) of
{ _gathFields_augmented_f1 | _gathFields_augmented_f1 `seq` (True) ->
(case (({-# LINE 56 "src/GenInstrLib.ag" #-}
foldr ($) _gathFields_augmented_syn [_gathFields_augmented_f1]
{-# LINE 1447 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case ((let sem_TraitV_Field_1 :: T_TraitV_1
sem_TraitV_Field_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIclassNm
_lhsIgEnv
_lhsInewFields ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1459 "src/GenInstrLib.hs" #-}
)) of
{ _newFields_augmented_syn | _newFields_augmented_syn `seq` (True) ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
maybe id Set.insert _nmImbStrUni
{-# LINE 1464 "src/GenInstrLib.hs" #-}
)) of
{ _newFields_augmented_f1 | _newFields_augmented_f1 `seq` (True) ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
foldr ($) _newFields_augmented_syn [_newFields_augmented_f1]
{-# LINE 1469 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1474 "src/GenInstrLib.hs" #-}
)) of
{ _tpOallTypes | _tpOallTypes `seq` (True) ->
(case (tp_ _tpOallTypes ) of
{ ( _tpImbStrUni,_tpIstrAnnot,_tpIstrUni,_tpItpKnown) | True ->
(case (({-# LINE 186 "src/GenInstrLib.ag" #-}
maybe empty (\nm -> let strType = encodeNmHaskell _tpIstrUni
tp = text "T'" <> text strType
val = text "Key" <+> text (show nm)
in vert [ text "-- object field" <+> text (show nm) <+> text "::" <+> text (show _tpIstrAnnot)
, if nm `Set.member` _lhsInewFields
then text "-- DUPLICATED value field!"
else genTrait _lhsIclassNm nm val tp
]) _nmImbStrUni
{-# LINE 1488 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOoutput) }) }) }) }) }) }))
in sem_TraitV_Field_1)) of
{ ( sem_TraitV_1) | True ->
( _lhsOgathFields,sem_TraitV_1) }) }) }) }) })
sem_TraitV_Method :: T_NmV ->
T_SigV ->
T_TraitV
sem_TraitV_Method nm_ sig_ =
(case (({-# LINE 57 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1501 "src/GenInstrLib.hs" #-}
)) of
{ _gathFields_augmented_syn | _gathFields_augmented_syn `seq` (True) ->
(case (nm_ ) of
{ ( _nmImbStrUni) | True ->
(case (({-# LINE 57 "src/GenInstrLib.ag" #-}
maybe id Set.insert _nmImbStrUni
{-# LINE 1508 "src/GenInstrLib.hs" #-}
)) of
{ _gathFields_augmented_f1 | _gathFields_augmented_f1 `seq` (True) ->
(case (({-# LINE 57 "src/GenInstrLib.ag" #-}
foldr ($) _gathFields_augmented_syn [_gathFields_augmented_f1]
{-# LINE 1513 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case ((let sem_TraitV_Method_1 :: T_TraitV_1
sem_TraitV_Method_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIclassNm
_lhsIgEnv
_lhsInewFields ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1525 "src/GenInstrLib.hs" #-}
)) of
{ _newFields_augmented_syn | _newFields_augmented_syn `seq` (True) ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
maybe id Set.insert _nmImbStrUni
{-# LINE 1530 "src/GenInstrLib.hs" #-}
)) of
{ _newFields_augmented_f1 | _newFields_augmented_f1 `seq` (True) ->
(case (({-# LINE 269 "src/GenInstrLib.ag" #-}
foldr ($) _newFields_augmented_syn [_newFields_augmented_f1]
{-# LINE 1535 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1540 "src/GenInstrLib.hs" #-}
)) of
{ _sigOallTypes | _sigOallTypes `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1545 "src/GenInstrLib.hs" #-}
)) of
{ _sigOgEnv | _sigOgEnv `seq` (True) ->
(case (sig_ _sigOallTypes _sigOgEnv ) of
{ ( _sigIoutput,_sigItpSig) | True ->
(case (({-# LINE 201 "src/GenInstrLib.ag" #-}
maybe empty (\nm -> vert [ text "-- object method" <+> text (show nm)
, if nm `Set.member` _lhsInewFields
then text "-- DUPLICATED method field!"
else genTrait _lhsIclassNm nm (text "Key" <+> text (show nm)) _sigItpSig
]) _nmImbStrUni
{-# LINE 1556 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOoutput) }) }) }) }) }) }) }))
in sem_TraitV_Method_1)) of
{ ( sem_TraitV_1) | True ->
( _lhsOgathFields,sem_TraitV_1) }) }) }) }) })
sem_TraitV_Other :: T_NmV ->
T_TraitV
sem_TraitV_Other nm_ =
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1568 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case ((let sem_TraitV_Other_1 :: T_TraitV_1
sem_TraitV_Other_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIclassNm
_lhsIgEnv
_lhsInewFields ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1580 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 1585 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOoutput) }) }))
in sem_TraitV_Other_1)) of
{ ( sem_TraitV_1) | True ->
( _lhsOgathFields,sem_TraitV_1) }) })
-- TraitsV -----------------------------------------------------
-- cata
sem_TraitsV :: TraitsV ->
T_TraitsV
sem_TraitsV list =
(Prelude.foldr sem_TraitsV_Cons sem_TraitsV_Nil (Prelude.map sem_TraitV list) )
-- semantic domain
type T_TraitsV = ( (Set String),T_TraitsV_1 )
type T_TraitsV_1 = (Set String) ->
(Set String) ->
String ->
SymInfo ->
(Set String) ->
( (Set String),Doc)
sem_TraitsV_Cons :: T_TraitV ->
T_TraitsV ->
T_TraitsV
sem_TraitsV_Cons hd_ tl_ =
(case (tl_ ) of
{ ( _tlIgathFields,tl_1) | True ->
(case (hd_ ) of
{ ( _hdIgathFields,hd_1) | True ->
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
_hdIgathFields `mappend` _tlIgathFields
{-# LINE 1616 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case ((let sem_TraitsV_Cons_1 :: T_TraitsV_1
sem_TraitsV_Cons_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIclassNm
_lhsIgEnv
_lhsInewFields ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1628 "src/GenInstrLib.hs" #-}
)) of
{ _hdOnewFields | _hdOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1633 "src/GenInstrLib.hs" #-}
)) of
{ _hdOgEnv | _hdOgEnv `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_lhsIclassNm
{-# LINE 1638 "src/GenInstrLib.hs" #-}
)) of
{ _hdOclassNm | _hdOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1643 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallTypes | _hdOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 1648 "src/GenInstrLib.hs" #-}
)) of
{ _hdOallFields | _hdOallFields `seq` (True) ->
(case (hd_1 _hdOallFields _hdOallTypes _hdOclassNm _hdOgEnv _hdOnewFields ) of
{ ( _hdInewFields,_hdIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_hdInewFields
{-# LINE 1655 "src/GenInstrLib.hs" #-}
)) of
{ _tlOnewFields | _tlOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_lhsIgEnv
{-# LINE 1660 "src/GenInstrLib.hs" #-}
)) of
{ _tlOgEnv | _tlOgEnv `seq` (True) ->
(case (({-# LINE 147 "src/GenInstrLib.ag" #-}
_lhsIclassNm
{-# LINE 1665 "src/GenInstrLib.hs" #-}
)) of
{ _tlOclassNm | _tlOclassNm `seq` (True) ->
(case (({-# LINE 59 "src/GenInstrLib.ag" #-}
_lhsIallTypes
{-# LINE 1670 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallTypes | _tlOallTypes `seq` (True) ->
(case (({-# LINE 60 "src/GenInstrLib.ag" #-}
_lhsIallFields
{-# LINE 1675 "src/GenInstrLib.hs" #-}
)) of
{ _tlOallFields | _tlOallFields `seq` (True) ->
(case (tl_1 _tlOallFields _tlOallTypes _tlOclassNm _tlOgEnv _tlOnewFields ) of
{ ( _tlInewFields,_tlIoutput) | True ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_tlInewFields
{-# LINE 1682 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
_hdIoutput $+$ _tlIoutput
{-# LINE 1687 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_TraitsV_Cons_1)) of
{ ( sem_TraitsV_1) | True ->
( _lhsOgathFields,sem_TraitsV_1) }) }) }) })
sem_TraitsV_Nil :: T_TraitsV
sem_TraitsV_Nil =
(case (({-# LINE 52 "src/GenInstrLib.ag" #-}
mempty
{-# LINE 1698 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOgathFields | _lhsOgathFields `seq` (True) ->
(case ((let sem_TraitsV_Nil_1 :: T_TraitsV_1
sem_TraitsV_Nil_1 =
(\ _lhsIallFields
_lhsIallTypes
_lhsIclassNm
_lhsIgEnv
_lhsInewFields ->
(case (({-# LINE 261 "src/GenInstrLib.ag" #-}
_lhsInewFields
{-# LINE 1710 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOnewFields | _lhsOnewFields `seq` (True) ->
(case (({-# LINE 39 "src/GenInstrLib.ag" #-}
empty
{-# LINE 1715 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOoutput | _lhsOoutput `seq` (True) ->
( _lhsOnewFields,_lhsOoutput) }) }))
in sem_TraitsV_Nil_1)) of
{ ( sem_TraitsV_1) | True ->
( _lhsOgathFields,sem_TraitsV_1) }) })
-- TypeV -------------------------------------------------------
-- cata
sem_TypeV :: TypeV ->
T_TypeV
sem_TypeV (TypeV_Type _isNull _nm ) =
(sem_TypeV_Type _isNull (sem_NmV _nm ) )
-- semantic domain
type T_TypeV = (Set String) ->
( (Maybe String),String,String,Bool)
sem_TypeV_Type :: Bool ->
T_NmV ->
T_TypeV
sem_TypeV_Type isNull_ nm_ =
(\ _lhsIallTypes ->
(case (nm_ ) of
{ ( _nmImbStrUni) | True ->
(case (({-# LINE 72 "src/GenInstrLib.ag" #-}
_nmImbStrUni
{-# LINE 1740 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOmbStrUni | _lhsOmbStrUni `seq` (True) ->
(case (({-# LINE 183 "src/GenInstrLib.ag" #-}
maybe "" id _nmImbStrUni
{-# LINE 1745 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstrAnnot | _lhsOstrAnnot `seq` (True) ->
(case (({-# LINE 69 "src/GenInstrLib.ag" #-}
not isNull_ && maybe False (`Set.member` _lhsIallTypes) _nmImbStrUni
{-# LINE 1750 "src/GenInstrLib.hs" #-}
)) of
{ _tpKnown | _tpKnown `seq` (True) ->
(case (({-# LINE 177 "src/GenInstrLib.ag" #-}
if _tpKnown
then maybe "{-# TypeV_Type: expecting a type name #}" id _nmImbStrUni
else "any"
{-# LINE 1757 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOstrUni | _lhsOstrUni `seq` (True) ->
(case (({-# LINE 66 "src/GenInstrLib.ag" #-}
_tpKnown
{-# LINE 1762 "src/GenInstrLib.hs" #-}
)) of
{ _lhsOtpKnown | _lhsOtpKnown `seq` (True) ->
( _lhsOmbStrUni,_lhsOstrAnnot,_lhsOstrUni,_lhsOtpKnown) }) }) }) }) }) }))