-- 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) }) }) }) }) }) }))