-- UUAGC 0.9.36 (src/InstrLocFilter.ag) module InstrLocFilter(instrLocFilter) where {-# LINE 11 "src/InstrLocFilter.ag" #-} import Data.ByteString.Lazy(ByteString,pack) import ByteCode import Data.Word import Data.Bits import qualified Data.IntSet as IntSet import Data.IntSet(IntSet) import Data.Monoid {-# LINE 16 "dist/src/sdist.27680/asil-1.2/dist/build/InstrLocFilter.hs" #-} {-# LINE 23 "src/InstrLocFilter.ag" #-} -- | Computes the minimum length of an instruction (in bytes) instrLocFilter :: BodyInfo -> BodyInfo instrLocFilter body = body' where inh = Inh_BodyInfo {} sem = sem_BodyInfo body syn = wrap_BodyInfo sem inh body' = output_Syn_BodyInfo syn {-# LINE 27 "dist/src/sdist.27680/asil-1.2/dist/build/InstrLocFilter.hs" #-} -- AbcFile ----------------------------------------------------- -- cata sem_AbcFile :: AbcFile -> T_AbcFile sem_AbcFile (AbcFile_File _minorVersion _majorVersion _constantPool _methods _metadatas _instances _classes _scripts _bodies ) = (sem_AbcFile_File _minorVersion _majorVersion (sem_PoolInfo _constantPool ) (sem_MethodInfos _methods ) (sem_MetaInfos _metadatas ) (sem_InstanceInfos _instances ) (sem_ClassInfos _classes ) (sem_ScriptInfos _scripts ) (sem_BodyInfos _bodies ) ) -- semantic domain type T_AbcFile = ( ) sem_AbcFile_File :: Word16 -> Word16 -> T_PoolInfo -> T_MethodInfos -> T_MetaInfos -> T_InstanceInfos -> T_ClassInfos -> T_ScriptInfos -> T_BodyInfos -> T_AbcFile sem_AbcFile_File minorVersion_ majorVersion_ constantPool_ methods_ metadatas_ instances_ classes_ scripts_ bodies_ = ( ) -- AbcFlag ----------------------------------------------------- -- cata sem_AbcFlag :: AbcFlag -> T_AbcFlag sem_AbcFlag (AbcFlag_LazyInit ) = (sem_AbcFlag_LazyInit ) -- semantic domain type T_AbcFlag = ( ) sem_AbcFlag_LazyInit :: T_AbcFlag sem_AbcFlag_LazyInit = ( ) -- AbcFlags ---------------------------------------------------- -- cata sem_AbcFlags :: AbcFlags -> T_AbcFlags sem_AbcFlags list = (Prelude.foldr sem_AbcFlags_Cons sem_AbcFlags_Nil (Prelude.map sem_AbcFlag list) ) -- semantic domain type T_AbcFlags = ( ) sem_AbcFlags_Cons :: T_AbcFlag -> T_AbcFlags -> T_AbcFlags sem_AbcFlags_Cons hd_ tl_ = ( ) sem_AbcFlags_Nil :: T_AbcFlags sem_AbcFlags_Nil = ( ) -- BodyInfo ---------------------------------------------------- -- cata sem_BodyInfo :: BodyInfo -> T_BodyInfo sem_BodyInfo (BodyInfo_Info _method _maxStack _localCount _initScopeDepth _maxScopeDepth _instructions _exceptions _traits ) = (sem_BodyInfo_Info _method _maxStack _localCount _initScopeDepth _maxScopeDepth (sem_Instructions _instructions ) (sem_Exceptions _exceptions ) (sem_Traits _traits ) ) -- semantic domain type T_BodyInfo = ( BodyInfo ) data Inh_BodyInfo = Inh_BodyInfo {} data Syn_BodyInfo = Syn_BodyInfo {output_Syn_BodyInfo :: !(BodyInfo )} wrap_BodyInfo :: T_BodyInfo -> Inh_BodyInfo -> Syn_BodyInfo wrap_BodyInfo sem (Inh_BodyInfo ) = (let ( _lhsOoutput) | True = sem in (Syn_BodyInfo _lhsOoutput )) sem_BodyInfo_Info :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> T_Instructions -> T_Exceptions -> T_Traits -> T_BodyInfo sem_BodyInfo_Info method_ maxStack_ localCount_ initScopeDepth_ maxScopeDepth_ instructions_ exceptions_ traits_ = (case (({-# LINE 2 "src/ByteCodeLocationInfo.ag" #-} 0 {-# LINE 103 "src/InstrLocFilter.hs" #-} )) of { _instructionsOlocation | _instructionsOlocation `seq` (True) -> (case (({-# LINE 38 "src/InstrLocFilter.ag" #-} True {-# LINE 108 "src/InstrLocFilter.hs" #-} )) of { _instructionsOisBranch | _instructionsOisBranch `seq` (True) -> (case (instructions_ _instructionsOisBranch _instructionsOlocation ) of { ( _instructionsIisBranch,_instructionsIlocation,instructions_1) | True -> (case (({-# LINE 3 "src/ByteCodeLocationInfo.ag" #-} 0 {-# LINE 115 "src/InstrLocFilter.hs" #-} )) of { _instructionsOrevLocation | _instructionsOrevLocation `seq` (True) -> (case (({-# LINE 39 "src/InstrLocFilter.ag" #-} False {-# LINE 120 "src/InstrLocFilter.hs" #-} )) of { _instructionsOrevIsBranch | _instructionsOrevIsBranch `seq` (True) -> (case (exceptions_ ) of { ( _exceptionsIlocs,_exceptionsIoutput) | True -> (case (instructions_1 _instructionsOrevIsBranch _instructionsOrevLocation ) of { ( _instructionsIlocs,_instructionsIrevIsBranch,_instructionsIrevLocation,instructions_2) | True -> (case (({-# LINE 47 "src/InstrLocFilter.ag" #-} _instructionsIlocs `mappend` _exceptionsIlocs {-# LINE 129 "src/InstrLocFilter.hs" #-} )) of { _instructionsOretain | _instructionsOretain `seq` (True) -> (case (traits_ ) of { ( _traitsIoutput) | True -> (case (instructions_2 _instructionsOretain ) of { ( _instructionsIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} BodyInfo_Info method_ maxStack_ localCount_ initScopeDepth_ maxScopeDepth_ _instructionsIoutput _exceptionsIoutput _traitsIoutput {-# LINE 138 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 143 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) -- BodyInfos --------------------------------------------------- -- cata sem_BodyInfos :: BodyInfos -> T_BodyInfos sem_BodyInfos list = (Prelude.foldr sem_BodyInfos_Cons sem_BodyInfos_Nil (Prelude.map sem_BodyInfo list) ) -- semantic domain type T_BodyInfos = ( ) sem_BodyInfos_Cons :: T_BodyInfo -> T_BodyInfos -> T_BodyInfos sem_BodyInfos_Cons hd_ tl_ = ( ) sem_BodyInfos_Nil :: T_BodyInfos sem_BodyInfos_Nil = ( ) -- CaseOffsets ------------------------------------------------- -- cata sem_CaseOffsets :: CaseOffsets -> T_CaseOffsets sem_CaseOffsets list = (Prelude.foldr sem_CaseOffsets_Cons sem_CaseOffsets_Nil list ) -- semantic domain type T_CaseOffsets = Int -> ( Int,T_CaseOffsets_1 ) type T_CaseOffsets_1 = Int -> ( IntSet,CaseOffsets ,Int) sem_CaseOffsets_Cons :: Word32 -> T_CaseOffsets -> T_CaseOffsets sem_CaseOffsets_Cons hd_ tl_ = (\ _lhsIlocation -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 181 "src/InstrLocFilter.hs" #-} )) of { _tlOlocation | _tlOlocation `seq` (True) -> (case (tl_ _tlOlocation ) of { ( _tlIlocation,tl_1) | True -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _tlIlocation {-# LINE 188 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_CaseOffsets_Cons_1 :: T_CaseOffsets_1 sem_CaseOffsets_Cons_1 = (\ _lhsIrevLocation -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 196 "src/InstrLocFilter.hs" #-} )) of { _tlOrevLocation | _tlOrevLocation `seq` (True) -> (case (tl_1 _tlOrevLocation ) of { ( _tlIlocs,_tlIoutput,_tlIrevLocation) | True -> (case (({-# LINE 88 "src/InstrLocFilter.ag" #-} _tlIlocs {-# LINE 203 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 30 "src/ByteCodeLocationInfo.ag" #-} fromS24 hd_ {-# LINE 208 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 31 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation + _relative {-# LINE 213 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 88 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 218 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 88 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 223 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} (:) hd_ _tlIoutput {-# LINE 228 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 233 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _tlIrevLocation {-# LINE 238 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> ( _lhsOlocs,_lhsOoutput,_lhsOrevLocation) }) }) }) }) }) }) }) }) }) })) in sem_CaseOffsets_Cons_1)) of { ( sem_CaseOffsets_1) | True -> ( _lhsOlocation,sem_CaseOffsets_1) }) }) }) })) sem_CaseOffsets_Nil :: T_CaseOffsets sem_CaseOffsets_Nil = (\ _lhsIlocation -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 250 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_CaseOffsets_Nil_1 :: T_CaseOffsets_1 sem_CaseOffsets_Nil_1 = (\ _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 258 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 263 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 268 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 273 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> ( _lhsOlocs,_lhsOoutput,_lhsOrevLocation) }) }) }) })) in sem_CaseOffsets_Nil_1)) of { ( sem_CaseOffsets_1) | True -> ( _lhsOlocation,sem_CaseOffsets_1) }) })) -- ClassInfo --------------------------------------------------- -- cata sem_ClassInfo :: ClassInfo -> T_ClassInfo sem_ClassInfo (ClassInfo_Info _con _traits ) = (sem_ClassInfo_Info _con (sem_Traits _traits ) ) -- semantic domain type T_ClassInfo = ( ) sem_ClassInfo_Info :: Word32 -> T_Traits -> T_ClassInfo sem_ClassInfo_Info con_ traits_ = ( ) -- ClassInfos -------------------------------------------------- -- cata sem_ClassInfos :: ClassInfos -> T_ClassInfos sem_ClassInfos list = (Prelude.foldr sem_ClassInfos_Cons sem_ClassInfos_Nil (Prelude.map sem_ClassInfo list) ) -- semantic domain type T_ClassInfos = ( ) sem_ClassInfos_Cons :: T_ClassInfo -> T_ClassInfos -> T_ClassInfos sem_ClassInfos_Cons hd_ tl_ = ( ) sem_ClassInfos_Nil :: T_ClassInfos sem_ClassInfos_Nil = ( ) -- DebugType --------------------------------------------------- -- cata sem_DebugType :: DebugType -> T_DebugType sem_DebugType (DebugType_Local ) = (sem_DebugType_Local ) -- semantic domain type T_DebugType = ( DebugType ) sem_DebugType_Local :: T_DebugType sem_DebugType_Local = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} DebugType_Local {-# LINE 321 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 326 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- Exception --------------------------------------------------- -- cata sem_Exception :: Exception -> T_Exception sem_Exception (Exception_Info _from _to _target _tp _name ) = (sem_Exception_Info _from _to _target _tp _name ) -- semantic domain type T_Exception = ( IntSet,Exception ) sem_Exception_Info :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> T_Exception sem_Exception_Info from_ to_ target_ tp_ name_ = (case (({-# LINE 77 "src/InstrLocFilter.ag" #-} IntSet.fromList $ map fromIntegral $ [from_,to_,target_] {-# LINE 347 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Exception_Info from_ to_ target_ tp_ name_ {-# LINE 352 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 357 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOlocs,_lhsOoutput) }) }) }) -- Exceptions -------------------------------------------------- -- cata sem_Exceptions :: Exceptions -> T_Exceptions sem_Exceptions list = (Prelude.foldr sem_Exceptions_Cons sem_Exceptions_Nil (Prelude.map sem_Exception list) ) -- semantic domain type T_Exceptions = ( IntSet,Exceptions ) sem_Exceptions_Cons :: T_Exception -> T_Exceptions -> T_Exceptions sem_Exceptions_Cons hd_ tl_ = (case (tl_ ) of { ( _tlIlocs,_tlIoutput) | True -> (case (hd_ ) of { ( _hdIlocs,_hdIoutput) | True -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} _hdIlocs `mappend` _tlIlocs {-# LINE 379 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} (:) _hdIoutput _tlIoutput {-# LINE 384 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 389 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOlocs,_lhsOoutput) }) }) }) }) }) sem_Exceptions_Nil :: T_Exceptions sem_Exceptions_Nil = (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 397 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 402 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 407 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOlocs,_lhsOoutput) }) }) }) -- InstanceFlag ------------------------------------------------ -- cata sem_InstanceFlag :: InstanceFlag -> T_InstanceFlag sem_InstanceFlag (InstanceFlag_ClassFinal ) = (sem_InstanceFlag_ClassFinal ) sem_InstanceFlag (InstanceFlag_ClassInterface ) = (sem_InstanceFlag_ClassInterface ) sem_InstanceFlag (InstanceFlag_ClassProtected ) = (sem_InstanceFlag_ClassProtected ) sem_InstanceFlag (InstanceFlag_ClassSealed ) = (sem_InstanceFlag_ClassSealed ) -- semantic domain type T_InstanceFlag = ( ) sem_InstanceFlag_ClassFinal :: T_InstanceFlag sem_InstanceFlag_ClassFinal = ( ) sem_InstanceFlag_ClassInterface :: T_InstanceFlag sem_InstanceFlag_ClassInterface = ( ) sem_InstanceFlag_ClassProtected :: T_InstanceFlag sem_InstanceFlag_ClassProtected = ( ) sem_InstanceFlag_ClassSealed :: T_InstanceFlag sem_InstanceFlag_ClassSealed = ( ) -- InstanceFlags ----------------------------------------------- -- cata sem_InstanceFlags :: InstanceFlags -> T_InstanceFlags sem_InstanceFlags list = (Prelude.foldr sem_InstanceFlags_Cons sem_InstanceFlags_Nil (Prelude.map sem_InstanceFlag list) ) -- semantic domain type T_InstanceFlags = ( ) sem_InstanceFlags_Cons :: T_InstanceFlag -> T_InstanceFlags -> T_InstanceFlags sem_InstanceFlags_Cons hd_ tl_ = ( ) sem_InstanceFlags_Nil :: T_InstanceFlags sem_InstanceFlags_Nil = ( ) -- InstanceInfo ------------------------------------------------ -- cata sem_InstanceInfo :: InstanceInfo -> T_InstanceInfo sem_InstanceInfo (InstanceInfo_Info _name _super _flags _protectedNs _interfaces _constructor _traits ) = (sem_InstanceInfo_Info _name _super (sem_InstanceFlags _flags ) _protectedNs (sem_Interfaces _interfaces ) _constructor (sem_Traits _traits ) ) -- semantic domain type T_InstanceInfo = ( ) sem_InstanceInfo_Info :: Word32 -> Word32 -> T_InstanceFlags -> Word32 -> T_Interfaces -> Word32 -> T_Traits -> T_InstanceInfo sem_InstanceInfo_Info name_ super_ flags_ protectedNs_ interfaces_ constructor_ traits_ = ( ) -- InstanceInfos ----------------------------------------------- -- cata sem_InstanceInfos :: InstanceInfos -> T_InstanceInfos sem_InstanceInfos list = (Prelude.foldr sem_InstanceInfos_Cons sem_InstanceInfos_Nil (Prelude.map sem_InstanceInfo list) ) -- semantic domain type T_InstanceInfos = ( ) sem_InstanceInfos_Cons :: T_InstanceInfo -> T_InstanceInfos -> T_InstanceInfos sem_InstanceInfos_Cons hd_ tl_ = ( ) sem_InstanceInfos_Nil :: T_InstanceInfos sem_InstanceInfos_Nil = ( ) -- Instruction ------------------------------------------------- -- cata sem_Instruction :: Instruction -> T_Instruction sem_Instruction (Instruction_Add ) = (sem_Instruction_Add ) sem_Instruction (Instruction_Add_d ) = (sem_Instruction_Add_d ) sem_Instruction (Instruction_Add_i ) = (sem_Instruction_Add_i ) sem_Instruction (Instruction_ApplyType _name ) = (sem_Instruction_ApplyType _name ) sem_Instruction (Instruction_AsType _name ) = (sem_Instruction_AsType _name ) sem_Instruction (Instruction_AsTypeLate ) = (sem_Instruction_AsTypeLate ) sem_Instruction (Instruction_BitAnd ) = (sem_Instruction_BitAnd ) sem_Instruction (Instruction_BitNot ) = (sem_Instruction_BitNot ) sem_Instruction (Instruction_BitOr ) = (sem_Instruction_BitOr ) sem_Instruction (Instruction_BitXor ) = (sem_Instruction_BitXor ) sem_Instruction (Instruction_BreakLine _line ) = (sem_Instruction_BreakLine _line ) sem_Instruction (Instruction_Breakpoint ) = (sem_Instruction_Breakpoint ) sem_Instruction (Instruction_Call _argCount ) = (sem_Instruction_Call _argCount ) sem_Instruction (Instruction_CallInterface _name _argCount ) = (sem_Instruction_CallInterface _name _argCount ) sem_Instruction (Instruction_CallMethod _index _argCount ) = (sem_Instruction_CallMethod _index _argCount ) sem_Instruction (Instruction_CallProp _name _argCount ) = (sem_Instruction_CallProp _name _argCount ) sem_Instruction (Instruction_CallPropLex _name _argCount ) = (sem_Instruction_CallPropLex _name _argCount ) sem_Instruction (Instruction_CallPropVoid _name _argCount ) = (sem_Instruction_CallPropVoid _name _argCount ) sem_Instruction (Instruction_CallStatic _method _argCount ) = (sem_Instruction_CallStatic _method _argCount ) sem_Instruction (Instruction_CallSuper _name _argCount ) = (sem_Instruction_CallSuper _name _argCount ) sem_Instruction (Instruction_CallSuperId ) = (sem_Instruction_CallSuperId ) sem_Instruction (Instruction_CallSuperVoid _name _argCount ) = (sem_Instruction_CallSuperVoid _name _argCount ) sem_Instruction (Instruction_CheckFilter ) = (sem_Instruction_CheckFilter ) sem_Instruction (Instruction_Coerce _name ) = (sem_Instruction_Coerce _name ) sem_Instruction (Instruction_Coerce_a ) = (sem_Instruction_Coerce_a ) sem_Instruction (Instruction_Coerce_b ) = (sem_Instruction_Coerce_b ) sem_Instruction (Instruction_Coerce_d ) = (sem_Instruction_Coerce_d ) sem_Instruction (Instruction_Coerce_i ) = (sem_Instruction_Coerce_i ) sem_Instruction (Instruction_Coerce_o ) = (sem_Instruction_Coerce_o ) sem_Instruction (Instruction_Coerce_s ) = (sem_Instruction_Coerce_s ) sem_Instruction (Instruction_Coerce_u ) = (sem_Instruction_Coerce_u ) sem_Instruction (Instruction_Concat ) = (sem_Instruction_Concat ) sem_Instruction (Instruction_Construct _argCount ) = (sem_Instruction_Construct _argCount ) sem_Instruction (Instruction_ConstructProp _name _argCount ) = (sem_Instruction_ConstructProp _name _argCount ) sem_Instruction (Instruction_ConstructSuper _argCount ) = (sem_Instruction_ConstructSuper _argCount ) sem_Instruction (Instruction_Convert_b ) = (sem_Instruction_Convert_b ) sem_Instruction (Instruction_Convert_d ) = (sem_Instruction_Convert_d ) sem_Instruction (Instruction_Convert_i ) = (sem_Instruction_Convert_i ) sem_Instruction (Instruction_Convert_o ) = (sem_Instruction_Convert_o ) sem_Instruction (Instruction_Convert_s ) = (sem_Instruction_Convert_s ) sem_Instruction (Instruction_Convert_u ) = (sem_Instruction_Convert_u ) sem_Instruction (Instruction_Debug _tp _name _reg _extra ) = (sem_Instruction_Debug (sem_DebugType _tp ) _name _reg _extra ) sem_Instruction (Instruction_DebugFile _name ) = (sem_Instruction_DebugFile _name ) sem_Instruction (Instruction_DebugLine _line ) = (sem_Instruction_DebugLine _line ) sem_Instruction (Instruction_DecLocal _reg ) = (sem_Instruction_DecLocal _reg ) sem_Instruction (Instruction_DecLocal_i _reg ) = (sem_Instruction_DecLocal_i _reg ) sem_Instruction (Instruction_Decrement ) = (sem_Instruction_Decrement ) sem_Instruction (Instruction_Decrement_i ) = (sem_Instruction_Decrement_i ) sem_Instruction (Instruction_DeleteProperty _name ) = (sem_Instruction_DeleteProperty _name ) sem_Instruction (Instruction_DeletePropertyLate ) = (sem_Instruction_DeletePropertyLate ) sem_Instruction (Instruction_Divide ) = (sem_Instruction_Divide ) sem_Instruction (Instruction_Dup ) = (sem_Instruction_Dup ) sem_Instruction (Instruction_Dxns _name ) = (sem_Instruction_Dxns _name ) sem_Instruction (Instruction_DxnsLate ) = (sem_Instruction_DxnsLate ) sem_Instruction (Instruction_Equals ) = (sem_Instruction_Equals ) sem_Instruction (Instruction_EscXAttr ) = (sem_Instruction_EscXAttr ) sem_Instruction (Instruction_EscXElem ) = (sem_Instruction_EscXElem ) sem_Instruction (Instruction_FindDef _name ) = (sem_Instruction_FindDef _name ) sem_Instruction (Instruction_FindPropStrict _name ) = (sem_Instruction_FindPropStrict _name ) sem_Instruction (Instruction_FindProperty _name ) = (sem_Instruction_FindProperty _name ) sem_Instruction (Instruction_FindPropertyGlobal _name ) = (sem_Instruction_FindPropertyGlobal _name ) sem_Instruction (Instruction_FindPropertyGlobalStrict _name ) = (sem_Instruction_FindPropertyGlobalStrict _name ) sem_Instruction (Instruction_GetDescendants _name ) = (sem_Instruction_GetDescendants _name ) sem_Instruction (Instruction_GetGlobalScope ) = (sem_Instruction_GetGlobalScope ) sem_Instruction (Instruction_GetGlobalSlot _slot ) = (sem_Instruction_GetGlobalSlot _slot ) sem_Instruction (Instruction_GetLex _name ) = (sem_Instruction_GetLex _name ) sem_Instruction (Instruction_GetLocal _reg ) = (sem_Instruction_GetLocal _reg ) sem_Instruction (Instruction_GetLocal0 ) = (sem_Instruction_GetLocal0 ) sem_Instruction (Instruction_GetLocal1 ) = (sem_Instruction_GetLocal1 ) sem_Instruction (Instruction_GetLocal2 ) = (sem_Instruction_GetLocal2 ) sem_Instruction (Instruction_GetLocal3 ) = (sem_Instruction_GetLocal3 ) sem_Instruction (Instruction_GetOuterScope _name ) = (sem_Instruction_GetOuterScope _name ) sem_Instruction (Instruction_GetProperty _name ) = (sem_Instruction_GetProperty _name ) sem_Instruction (Instruction_GetScopeObject _index ) = (sem_Instruction_GetScopeObject _index ) sem_Instruction (Instruction_GetSlot _slot ) = (sem_Instruction_GetSlot _slot ) sem_Instruction (Instruction_GetSuper _name ) = (sem_Instruction_GetSuper _name ) sem_Instruction (Instruction_GreaterEquals ) = (sem_Instruction_GreaterEquals ) sem_Instruction (Instruction_GreaterThan ) = (sem_Instruction_GreaterThan ) sem_Instruction (Instruction_HasNext ) = (sem_Instruction_HasNext ) sem_Instruction (Instruction_HasNext2 _objectReg _indexReg ) = (sem_Instruction_HasNext2 _objectReg _indexReg ) sem_Instruction (Instruction_IfEq _offset ) = (sem_Instruction_IfEq _offset ) sem_Instruction (Instruction_IfFalse _offset ) = (sem_Instruction_IfFalse _offset ) sem_Instruction (Instruction_IfGe _offset ) = (sem_Instruction_IfGe _offset ) sem_Instruction (Instruction_IfGt _offset ) = (sem_Instruction_IfGt _offset ) sem_Instruction (Instruction_IfLe _offset ) = (sem_Instruction_IfLe _offset ) sem_Instruction (Instruction_IfLt _offset ) = (sem_Instruction_IfLt _offset ) sem_Instruction (Instruction_IfNGe _offset ) = (sem_Instruction_IfNGe _offset ) sem_Instruction (Instruction_IfNGt _offset ) = (sem_Instruction_IfNGt _offset ) sem_Instruction (Instruction_IfNLe _offset ) = (sem_Instruction_IfNLe _offset ) sem_Instruction (Instruction_IfNLt _offset ) = (sem_Instruction_IfNLt _offset ) sem_Instruction (Instruction_IfNe _offset ) = (sem_Instruction_IfNe _offset ) sem_Instruction (Instruction_IfStrictEq _offset ) = (sem_Instruction_IfStrictEq _offset ) sem_Instruction (Instruction_IfStrictNe _offset ) = (sem_Instruction_IfStrictNe _offset ) sem_Instruction (Instruction_IfTrue _offset ) = (sem_Instruction_IfTrue _offset ) sem_Instruction (Instruction_In ) = (sem_Instruction_In ) sem_Instruction (Instruction_IncLocal _reg ) = (sem_Instruction_IncLocal _reg ) sem_Instruction (Instruction_IncLocal_i _reg ) = (sem_Instruction_IncLocal_i _reg ) sem_Instruction (Instruction_Increment ) = (sem_Instruction_Increment ) sem_Instruction (Instruction_Increment_i ) = (sem_Instruction_Increment_i ) sem_Instruction (Instruction_InitProperty _name ) = (sem_Instruction_InitProperty _name ) sem_Instruction (Instruction_InstanceOf ) = (sem_Instruction_InstanceOf ) sem_Instruction (Instruction_IsType _name ) = (sem_Instruction_IsType _name ) sem_Instruction (Instruction_IsTypeLate ) = (sem_Instruction_IsTypeLate ) sem_Instruction (Instruction_Jump _offset ) = (sem_Instruction_Jump _offset ) sem_Instruction (Instruction_Kill _reg ) = (sem_Instruction_Kill _reg ) sem_Instruction (Instruction_Label ) = (sem_Instruction_Label ) sem_Instruction (Instruction_LessEquals ) = (sem_Instruction_LessEquals ) sem_Instruction (Instruction_LessThan ) = (sem_Instruction_LessThan ) sem_Instruction (Instruction_LoadFloat32 ) = (sem_Instruction_LoadFloat32 ) sem_Instruction (Instruction_LoadFloat64 ) = (sem_Instruction_LoadFloat64 ) sem_Instruction (Instruction_LoadIndirect16 ) = (sem_Instruction_LoadIndirect16 ) sem_Instruction (Instruction_LoadIndirect32 ) = (sem_Instruction_LoadIndirect32 ) sem_Instruction (Instruction_LoadIndirect8 ) = (sem_Instruction_LoadIndirect8 ) sem_Instruction (Instruction_Location _index ) = (sem_Instruction_Location _index ) sem_Instruction (Instruction_LookupSwitch _defaultOffset _caseOffsets ) = (sem_Instruction_LookupSwitch _defaultOffset (sem_CaseOffsets _caseOffsets ) ) sem_Instruction (Instruction_Lshift ) = (sem_Instruction_Lshift ) sem_Instruction (Instruction_Modulo ) = (sem_Instruction_Modulo ) sem_Instruction (Instruction_Multiply ) = (sem_Instruction_Multiply ) sem_Instruction (Instruction_Multiply_i ) = (sem_Instruction_Multiply_i ) sem_Instruction (Instruction_Negate ) = (sem_Instruction_Negate ) sem_Instruction (Instruction_Negate_i ) = (sem_Instruction_Negate_i ) sem_Instruction (Instruction_NewActivation ) = (sem_Instruction_NewActivation ) sem_Instruction (Instruction_NewArray _argCount ) = (sem_Instruction_NewArray _argCount ) sem_Instruction (Instruction_NewCatch _exception ) = (sem_Instruction_NewCatch _exception ) sem_Instruction (Instruction_NewClass _class ) = (sem_Instruction_NewClass _class ) sem_Instruction (Instruction_NewFunction _method ) = (sem_Instruction_NewFunction _method ) sem_Instruction (Instruction_NewObject _argCount ) = (sem_Instruction_NewObject _argCount ) sem_Instruction (Instruction_NextName ) = (sem_Instruction_NextName ) sem_Instruction (Instruction_NextValue ) = (sem_Instruction_NextValue ) sem_Instruction (Instruction_Nop ) = (sem_Instruction_Nop ) sem_Instruction (Instruction_Not ) = (sem_Instruction_Not ) sem_Instruction (Instruction_Pop ) = (sem_Instruction_Pop ) sem_Instruction (Instruction_PopScope ) = (sem_Instruction_PopScope ) sem_Instruction (Instruction_PushByte _val ) = (sem_Instruction_PushByte _val ) sem_Instruction (Instruction_PushDouble _name ) = (sem_Instruction_PushDouble _name ) sem_Instruction (Instruction_PushFalse ) = (sem_Instruction_PushFalse ) sem_Instruction (Instruction_PushInt _name ) = (sem_Instruction_PushInt _name ) sem_Instruction (Instruction_PushNaN ) = (sem_Instruction_PushNaN ) sem_Instruction (Instruction_PushNamespace _name ) = (sem_Instruction_PushNamespace _name ) sem_Instruction (Instruction_PushNull ) = (sem_Instruction_PushNull ) sem_Instruction (Instruction_PushScope ) = (sem_Instruction_PushScope ) sem_Instruction (Instruction_PushShort _val ) = (sem_Instruction_PushShort _val ) sem_Instruction (Instruction_PushString _name ) = (sem_Instruction_PushString _name ) sem_Instruction (Instruction_PushTrue ) = (sem_Instruction_PushTrue ) sem_Instruction (Instruction_PushUInt _name ) = (sem_Instruction_PushUInt _name ) sem_Instruction (Instruction_PushUndefined ) = (sem_Instruction_PushUndefined ) sem_Instruction (Instruction_PushWith ) = (sem_Instruction_PushWith ) sem_Instruction (Instruction_ReturnValue ) = (sem_Instruction_ReturnValue ) sem_Instruction (Instruction_ReturnVoid ) = (sem_Instruction_ReturnVoid ) sem_Instruction (Instruction_Rshift ) = (sem_Instruction_Rshift ) sem_Instruction (Instruction_SetGlobalSlot _slot ) = (sem_Instruction_SetGlobalSlot _slot ) sem_Instruction (Instruction_SetLocal _reg ) = (sem_Instruction_SetLocal _reg ) sem_Instruction (Instruction_SetLocal0 ) = (sem_Instruction_SetLocal0 ) sem_Instruction (Instruction_SetLocal1 ) = (sem_Instruction_SetLocal1 ) sem_Instruction (Instruction_SetLocal2 ) = (sem_Instruction_SetLocal2 ) sem_Instruction (Instruction_SetLocal3 ) = (sem_Instruction_SetLocal3 ) sem_Instruction (Instruction_SetProperty _name ) = (sem_Instruction_SetProperty _name ) sem_Instruction (Instruction_SetPropertyLate ) = (sem_Instruction_SetPropertyLate ) sem_Instruction (Instruction_SetSlot _slot ) = (sem_Instruction_SetSlot _slot ) sem_Instruction (Instruction_SetSuper _name ) = (sem_Instruction_SetSuper _name ) sem_Instruction (Instruction_SignExtend1 ) = (sem_Instruction_SignExtend1 ) sem_Instruction (Instruction_SignExtend16 ) = (sem_Instruction_SignExtend16 ) sem_Instruction (Instruction_SignExtend8 ) = (sem_Instruction_SignExtend8 ) sem_Instruction (Instruction_StoreFloat32 ) = (sem_Instruction_StoreFloat32 ) sem_Instruction (Instruction_StoreFloat64 ) = (sem_Instruction_StoreFloat64 ) sem_Instruction (Instruction_StoreIndirect16 ) = (sem_Instruction_StoreIndirect16 ) sem_Instruction (Instruction_StoreIndirect32 ) = (sem_Instruction_StoreIndirect32 ) sem_Instruction (Instruction_StoreIndirect8 ) = (sem_Instruction_StoreIndirect8 ) sem_Instruction (Instruction_StrictEquals ) = (sem_Instruction_StrictEquals ) sem_Instruction (Instruction_Substract ) = (sem_Instruction_Substract ) sem_Instruction (Instruction_Substract_i ) = (sem_Instruction_Substract_i ) sem_Instruction (Instruction_Swap ) = (sem_Instruction_Swap ) sem_Instruction (Instruction_Throw ) = (sem_Instruction_Throw ) sem_Instruction (Instruction_Timestamp ) = (sem_Instruction_Timestamp ) sem_Instruction (Instruction_TypeOf ) = (sem_Instruction_TypeOf ) sem_Instruction (Instruction_Urshift ) = (sem_Instruction_Urshift ) -- semantic domain type T_Instruction = Int -> ( Bool,Int,T_Instruction_1 ) type T_Instruction_1 = Bool -> Bool -> Int -> ( IntSet,Bool,Int,T_Instruction_2 ) type T_Instruction_2 = IntSet -> ( Instruction ,Bool) sem_Instruction_Add :: T_Instruction sem_Instruction_Add = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 857 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 862 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Add_1 :: T_Instruction_1 sem_Instruction_Add_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 872 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 877 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 882 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Add_2 :: T_Instruction_2 sem_Instruction_Add_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Add {-# LINE 890 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 895 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 900 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Add_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Add_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Add_d :: T_Instruction sem_Instruction_Add_d = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 915 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 920 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Add_d_1 :: T_Instruction_1 sem_Instruction_Add_d_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 930 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 935 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 940 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Add_d_2 :: T_Instruction_2 sem_Instruction_Add_d_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Add_d {-# LINE 948 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 953 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 958 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Add_d_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Add_d_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Add_i :: T_Instruction sem_Instruction_Add_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 973 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 978 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Add_i_1 :: T_Instruction_1 sem_Instruction_Add_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 988 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 993 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 998 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Add_i_2 :: T_Instruction_2 sem_Instruction_Add_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Add_i {-# LINE 1006 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1011 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1016 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Add_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Add_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_ApplyType :: Word32 -> T_Instruction sem_Instruction_ApplyType name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1032 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1037 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_ApplyType_1 :: T_Instruction_1 sem_Instruction_ApplyType_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1047 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1052 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1057 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_ApplyType_2 :: T_Instruction_2 sem_Instruction_ApplyType_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_ApplyType name_ {-# LINE 1065 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1070 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1075 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_ApplyType_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_ApplyType_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_AsType :: Word32 -> T_Instruction sem_Instruction_AsType name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1091 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1096 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_AsType_1 :: T_Instruction_1 sem_Instruction_AsType_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1106 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1111 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1116 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_AsType_2 :: T_Instruction_2 sem_Instruction_AsType_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_AsType name_ {-# LINE 1124 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1129 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1134 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_AsType_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_AsType_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_AsTypeLate :: T_Instruction sem_Instruction_AsTypeLate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1149 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1154 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_AsTypeLate_1 :: T_Instruction_1 sem_Instruction_AsTypeLate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1164 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1169 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1174 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_AsTypeLate_2 :: T_Instruction_2 sem_Instruction_AsTypeLate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_AsTypeLate {-# LINE 1182 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1187 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1192 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_AsTypeLate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_AsTypeLate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_BitAnd :: T_Instruction sem_Instruction_BitAnd = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1207 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1212 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_BitAnd_1 :: T_Instruction_1 sem_Instruction_BitAnd_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1222 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1227 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1232 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_BitAnd_2 :: T_Instruction_2 sem_Instruction_BitAnd_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_BitAnd {-# LINE 1240 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1245 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1250 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_BitAnd_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_BitAnd_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_BitNot :: T_Instruction sem_Instruction_BitNot = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1265 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1270 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_BitNot_1 :: T_Instruction_1 sem_Instruction_BitNot_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1280 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1285 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1290 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_BitNot_2 :: T_Instruction_2 sem_Instruction_BitNot_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_BitNot {-# LINE 1298 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1303 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1308 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_BitNot_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_BitNot_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_BitOr :: T_Instruction sem_Instruction_BitOr = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1323 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1328 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_BitOr_1 :: T_Instruction_1 sem_Instruction_BitOr_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1338 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1343 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1348 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_BitOr_2 :: T_Instruction_2 sem_Instruction_BitOr_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_BitOr {-# LINE 1356 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1361 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1366 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_BitOr_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_BitOr_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_BitXor :: T_Instruction sem_Instruction_BitXor = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1381 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1386 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_BitXor_1 :: T_Instruction_1 sem_Instruction_BitXor_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1396 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1401 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1406 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_BitXor_2 :: T_Instruction_2 sem_Instruction_BitXor_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_BitXor {-# LINE 1414 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1419 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1424 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_BitXor_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_BitXor_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_BreakLine :: Word32 -> T_Instruction sem_Instruction_BreakLine line_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1440 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1445 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_BreakLine_1 :: T_Instruction_1 sem_Instruction_BreakLine_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1455 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1460 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1465 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_BreakLine_2 :: T_Instruction_2 sem_Instruction_BreakLine_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_BreakLine line_ {-# LINE 1473 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1478 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1483 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_BreakLine_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_BreakLine_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Breakpoint :: T_Instruction sem_Instruction_Breakpoint = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1498 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1503 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Breakpoint_1 :: T_Instruction_1 sem_Instruction_Breakpoint_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1513 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1518 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1523 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Breakpoint_2 :: T_Instruction_2 sem_Instruction_Breakpoint_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Breakpoint {-# LINE 1531 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1536 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1541 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Breakpoint_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Breakpoint_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Call :: Word32 -> T_Instruction sem_Instruction_Call argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1557 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1562 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Call_1 :: T_Instruction_1 sem_Instruction_Call_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1572 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1577 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1582 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Call_2 :: T_Instruction_2 sem_Instruction_Call_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Call argCount_ {-# LINE 1590 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1595 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1600 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Call_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Call_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallInterface :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallInterface name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1617 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1622 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallInterface_1 :: T_Instruction_1 sem_Instruction_CallInterface_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1632 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1637 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1642 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallInterface_2 :: T_Instruction_2 sem_Instruction_CallInterface_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallInterface name_ argCount_ {-# LINE 1650 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1655 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1660 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallInterface_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallInterface_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallMethod :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallMethod index_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1677 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1682 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallMethod_1 :: T_Instruction_1 sem_Instruction_CallMethod_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1692 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1697 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1702 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallMethod_2 :: T_Instruction_2 sem_Instruction_CallMethod_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallMethod index_ argCount_ {-# LINE 1710 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1715 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1720 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallMethod_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallMethod_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallProp :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallProp name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1737 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1742 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallProp_1 :: T_Instruction_1 sem_Instruction_CallProp_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1752 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1757 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1762 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallProp_2 :: T_Instruction_2 sem_Instruction_CallProp_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallProp name_ argCount_ {-# LINE 1770 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1775 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1780 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallProp_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallProp_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallPropLex :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallPropLex name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1797 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1802 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallPropLex_1 :: T_Instruction_1 sem_Instruction_CallPropLex_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1812 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1817 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1822 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallPropLex_2 :: T_Instruction_2 sem_Instruction_CallPropLex_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallPropLex name_ argCount_ {-# LINE 1830 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1835 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1840 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallPropLex_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallPropLex_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallPropVoid :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallPropVoid name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1857 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1862 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallPropVoid_1 :: T_Instruction_1 sem_Instruction_CallPropVoid_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1872 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1877 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1882 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallPropVoid_2 :: T_Instruction_2 sem_Instruction_CallPropVoid_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallPropVoid name_ argCount_ {-# LINE 1890 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1895 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1900 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallPropVoid_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallPropVoid_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallStatic :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallStatic method_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1917 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1922 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallStatic_1 :: T_Instruction_1 sem_Instruction_CallStatic_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1932 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1937 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 1942 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallStatic_2 :: T_Instruction_2 sem_Instruction_CallStatic_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallStatic method_ argCount_ {-# LINE 1950 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 1955 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 1960 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallStatic_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallStatic_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallSuper :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallSuper name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 1977 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 1982 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallSuper_1 :: T_Instruction_1 sem_Instruction_CallSuper_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 1992 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 1997 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2002 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallSuper_2 :: T_Instruction_2 sem_Instruction_CallSuper_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallSuper name_ argCount_ {-# LINE 2010 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2015 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2020 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallSuper_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallSuper_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallSuperId :: T_Instruction sem_Instruction_CallSuperId = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2035 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2040 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallSuperId_1 :: T_Instruction_1 sem_Instruction_CallSuperId_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2050 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2055 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2060 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallSuperId_2 :: T_Instruction_2 sem_Instruction_CallSuperId_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallSuperId {-# LINE 2068 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2073 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2078 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallSuperId_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallSuperId_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CallSuperVoid :: Word32 -> Word32 -> T_Instruction sem_Instruction_CallSuperVoid name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2095 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2100 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CallSuperVoid_1 :: T_Instruction_1 sem_Instruction_CallSuperVoid_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2110 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2115 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2120 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CallSuperVoid_2 :: T_Instruction_2 sem_Instruction_CallSuperVoid_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CallSuperVoid name_ argCount_ {-# LINE 2128 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2133 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2138 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CallSuperVoid_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CallSuperVoid_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_CheckFilter :: T_Instruction sem_Instruction_CheckFilter = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2153 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2158 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_CheckFilter_1 :: T_Instruction_1 sem_Instruction_CheckFilter_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2168 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2173 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2178 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_CheckFilter_2 :: T_Instruction_2 sem_Instruction_CheckFilter_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_CheckFilter {-# LINE 2186 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2191 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2196 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_CheckFilter_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_CheckFilter_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce :: Word32 -> T_Instruction sem_Instruction_Coerce name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2212 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2217 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_1 :: T_Instruction_1 sem_Instruction_Coerce_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2227 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2232 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2237 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_2 :: T_Instruction_2 sem_Instruction_Coerce_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce name_ {-# LINE 2245 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2250 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2255 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_a :: T_Instruction sem_Instruction_Coerce_a = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2270 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2275 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_a_1 :: T_Instruction_1 sem_Instruction_Coerce_a_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2285 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2290 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2295 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_a_2 :: T_Instruction_2 sem_Instruction_Coerce_a_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_a {-# LINE 2303 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2308 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2313 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_a_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_a_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_b :: T_Instruction sem_Instruction_Coerce_b = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2328 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2333 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_b_1 :: T_Instruction_1 sem_Instruction_Coerce_b_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2343 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2348 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2353 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_b_2 :: T_Instruction_2 sem_Instruction_Coerce_b_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_b {-# LINE 2361 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2366 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2371 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_b_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_b_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_d :: T_Instruction sem_Instruction_Coerce_d = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2386 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2391 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_d_1 :: T_Instruction_1 sem_Instruction_Coerce_d_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2401 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2406 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2411 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_d_2 :: T_Instruction_2 sem_Instruction_Coerce_d_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_d {-# LINE 2419 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2424 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2429 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_d_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_d_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_i :: T_Instruction sem_Instruction_Coerce_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2444 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2449 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_i_1 :: T_Instruction_1 sem_Instruction_Coerce_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2459 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2464 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2469 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_i_2 :: T_Instruction_2 sem_Instruction_Coerce_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_i {-# LINE 2477 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2482 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2487 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_o :: T_Instruction sem_Instruction_Coerce_o = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2502 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2507 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_o_1 :: T_Instruction_1 sem_Instruction_Coerce_o_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2517 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2522 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2527 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_o_2 :: T_Instruction_2 sem_Instruction_Coerce_o_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_o {-# LINE 2535 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2540 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2545 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_o_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_o_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_s :: T_Instruction sem_Instruction_Coerce_s = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2560 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2565 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_s_1 :: T_Instruction_1 sem_Instruction_Coerce_s_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2575 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2580 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2585 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_s_2 :: T_Instruction_2 sem_Instruction_Coerce_s_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_s {-# LINE 2593 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2598 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2603 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_s_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_s_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Coerce_u :: T_Instruction sem_Instruction_Coerce_u = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2618 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2623 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Coerce_u_1 :: T_Instruction_1 sem_Instruction_Coerce_u_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2633 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2638 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2643 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Coerce_u_2 :: T_Instruction_2 sem_Instruction_Coerce_u_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Coerce_u {-# LINE 2651 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2656 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2661 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Coerce_u_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Coerce_u_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Concat :: T_Instruction sem_Instruction_Concat = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2676 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2681 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Concat_1 :: T_Instruction_1 sem_Instruction_Concat_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2691 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2696 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2701 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Concat_2 :: T_Instruction_2 sem_Instruction_Concat_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Concat {-# LINE 2709 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2714 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2719 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Concat_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Concat_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Construct :: Word32 -> T_Instruction sem_Instruction_Construct argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2735 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2740 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Construct_1 :: T_Instruction_1 sem_Instruction_Construct_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2750 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2755 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2760 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Construct_2 :: T_Instruction_2 sem_Instruction_Construct_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Construct argCount_ {-# LINE 2768 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2773 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2778 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Construct_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Construct_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_ConstructProp :: Word32 -> Word32 -> T_Instruction sem_Instruction_ConstructProp name_ argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2795 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2800 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_ConstructProp_1 :: T_Instruction_1 sem_Instruction_ConstructProp_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2810 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2815 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2820 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_ConstructProp_2 :: T_Instruction_2 sem_Instruction_ConstructProp_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_ConstructProp name_ argCount_ {-# LINE 2828 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2833 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2838 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_ConstructProp_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_ConstructProp_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_ConstructSuper :: Word32 -> T_Instruction sem_Instruction_ConstructSuper argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2854 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2859 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_ConstructSuper_1 :: T_Instruction_1 sem_Instruction_ConstructSuper_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2869 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2874 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2879 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_ConstructSuper_2 :: T_Instruction_2 sem_Instruction_ConstructSuper_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_ConstructSuper argCount_ {-# LINE 2887 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2892 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2897 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_ConstructSuper_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_ConstructSuper_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_b :: T_Instruction sem_Instruction_Convert_b = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2912 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2917 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_b_1 :: T_Instruction_1 sem_Instruction_Convert_b_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2927 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2932 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2937 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_b_2 :: T_Instruction_2 sem_Instruction_Convert_b_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_b {-# LINE 2945 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 2950 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 2955 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_b_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_b_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_d :: T_Instruction sem_Instruction_Convert_d = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 2970 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 2975 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_d_1 :: T_Instruction_1 sem_Instruction_Convert_d_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 2985 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 2990 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 2995 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_d_2 :: T_Instruction_2 sem_Instruction_Convert_d_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_d {-# LINE 3003 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3008 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3013 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_d_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_d_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_i :: T_Instruction sem_Instruction_Convert_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3028 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3033 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_i_1 :: T_Instruction_1 sem_Instruction_Convert_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3043 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3048 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3053 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_i_2 :: T_Instruction_2 sem_Instruction_Convert_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_i {-# LINE 3061 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3066 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3071 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_o :: T_Instruction sem_Instruction_Convert_o = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3086 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3091 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_o_1 :: T_Instruction_1 sem_Instruction_Convert_o_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3101 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3106 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3111 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_o_2 :: T_Instruction_2 sem_Instruction_Convert_o_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_o {-# LINE 3119 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3124 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3129 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_o_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_o_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_s :: T_Instruction sem_Instruction_Convert_s = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3144 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3149 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_s_1 :: T_Instruction_1 sem_Instruction_Convert_s_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3159 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3164 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3169 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_s_2 :: T_Instruction_2 sem_Instruction_Convert_s_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_s {-# LINE 3177 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3182 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3187 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_s_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_s_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Convert_u :: T_Instruction sem_Instruction_Convert_u = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3202 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3207 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Convert_u_1 :: T_Instruction_1 sem_Instruction_Convert_u_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3217 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3222 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3227 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Convert_u_2 :: T_Instruction_2 sem_Instruction_Convert_u_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Convert_u {-# LINE 3235 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3240 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3245 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Convert_u_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Convert_u_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Debug :: T_DebugType -> Word32 -> Word32 -> Word32 -> T_Instruction sem_Instruction_Debug tp_ name_ reg_ extra_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3264 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3269 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Debug_1 :: T_Instruction_1 sem_Instruction_Debug_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3279 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3284 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3289 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Debug_2 :: T_Instruction_2 sem_Instruction_Debug_2 = (\ _lhsIretain -> (case (tp_ ) of { ( _tpIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Debug _tpIoutput name_ reg_ extra_ {-# LINE 3299 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3304 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3309 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) }) })) in sem_Instruction_Debug_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Debug_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DebugFile :: Word32 -> T_Instruction sem_Instruction_DebugFile name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3325 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3330 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DebugFile_1 :: T_Instruction_1 sem_Instruction_DebugFile_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3340 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3345 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3350 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DebugFile_2 :: T_Instruction_2 sem_Instruction_DebugFile_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DebugFile name_ {-# LINE 3358 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3363 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3368 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DebugFile_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DebugFile_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DebugLine :: Word32 -> T_Instruction sem_Instruction_DebugLine line_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3384 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3389 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DebugLine_1 :: T_Instruction_1 sem_Instruction_DebugLine_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3399 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3404 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3409 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DebugLine_2 :: T_Instruction_2 sem_Instruction_DebugLine_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DebugLine line_ {-# LINE 3417 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3422 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3427 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DebugLine_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DebugLine_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DecLocal :: Word32 -> T_Instruction sem_Instruction_DecLocal reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3443 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3448 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DecLocal_1 :: T_Instruction_1 sem_Instruction_DecLocal_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3458 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3463 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3468 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DecLocal_2 :: T_Instruction_2 sem_Instruction_DecLocal_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DecLocal reg_ {-# LINE 3476 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3481 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3486 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DecLocal_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DecLocal_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DecLocal_i :: Word32 -> T_Instruction sem_Instruction_DecLocal_i reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3502 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3507 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DecLocal_i_1 :: T_Instruction_1 sem_Instruction_DecLocal_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3517 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3522 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3527 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DecLocal_i_2 :: T_Instruction_2 sem_Instruction_DecLocal_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DecLocal_i reg_ {-# LINE 3535 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3540 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3545 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DecLocal_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DecLocal_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Decrement :: T_Instruction sem_Instruction_Decrement = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3560 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3565 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Decrement_1 :: T_Instruction_1 sem_Instruction_Decrement_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3575 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3580 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3585 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Decrement_2 :: T_Instruction_2 sem_Instruction_Decrement_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Decrement {-# LINE 3593 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3598 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3603 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Decrement_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Decrement_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Decrement_i :: T_Instruction sem_Instruction_Decrement_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3618 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3623 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Decrement_i_1 :: T_Instruction_1 sem_Instruction_Decrement_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3633 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3638 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3643 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Decrement_i_2 :: T_Instruction_2 sem_Instruction_Decrement_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Decrement_i {-# LINE 3651 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3656 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3661 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Decrement_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Decrement_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DeleteProperty :: Word32 -> T_Instruction sem_Instruction_DeleteProperty name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3677 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3682 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DeleteProperty_1 :: T_Instruction_1 sem_Instruction_DeleteProperty_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3692 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3697 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3702 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DeleteProperty_2 :: T_Instruction_2 sem_Instruction_DeleteProperty_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DeleteProperty name_ {-# LINE 3710 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3715 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3720 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DeleteProperty_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DeleteProperty_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DeletePropertyLate :: T_Instruction sem_Instruction_DeletePropertyLate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3735 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3740 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DeletePropertyLate_1 :: T_Instruction_1 sem_Instruction_DeletePropertyLate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3750 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3755 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3760 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DeletePropertyLate_2 :: T_Instruction_2 sem_Instruction_DeletePropertyLate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DeletePropertyLate {-# LINE 3768 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3773 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3778 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DeletePropertyLate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DeletePropertyLate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Divide :: T_Instruction sem_Instruction_Divide = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3793 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3798 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Divide_1 :: T_Instruction_1 sem_Instruction_Divide_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3808 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3813 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3818 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Divide_2 :: T_Instruction_2 sem_Instruction_Divide_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Divide {-# LINE 3826 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3831 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3836 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Divide_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Divide_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Dup :: T_Instruction sem_Instruction_Dup = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3851 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3856 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Dup_1 :: T_Instruction_1 sem_Instruction_Dup_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3866 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3871 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3876 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Dup_2 :: T_Instruction_2 sem_Instruction_Dup_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Dup {-# LINE 3884 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3889 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3894 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Dup_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Dup_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Dxns :: Word32 -> T_Instruction sem_Instruction_Dxns name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3910 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3915 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Dxns_1 :: T_Instruction_1 sem_Instruction_Dxns_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3925 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3930 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3935 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Dxns_2 :: T_Instruction_2 sem_Instruction_Dxns_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Dxns name_ {-# LINE 3943 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 3948 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 3953 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Dxns_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Dxns_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_DxnsLate :: T_Instruction sem_Instruction_DxnsLate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 3968 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 3973 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_DxnsLate_1 :: T_Instruction_1 sem_Instruction_DxnsLate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 3983 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 3988 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 3993 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_DxnsLate_2 :: T_Instruction_2 sem_Instruction_DxnsLate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_DxnsLate {-# LINE 4001 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4006 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4011 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_DxnsLate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_DxnsLate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Equals :: T_Instruction sem_Instruction_Equals = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4026 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4031 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Equals_1 :: T_Instruction_1 sem_Instruction_Equals_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4041 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4046 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4051 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Equals_2 :: T_Instruction_2 sem_Instruction_Equals_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Equals {-# LINE 4059 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4064 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4069 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Equals_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Equals_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_EscXAttr :: T_Instruction sem_Instruction_EscXAttr = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4084 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4089 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_EscXAttr_1 :: T_Instruction_1 sem_Instruction_EscXAttr_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4099 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4104 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4109 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_EscXAttr_2 :: T_Instruction_2 sem_Instruction_EscXAttr_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_EscXAttr {-# LINE 4117 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4122 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4127 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_EscXAttr_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_EscXAttr_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_EscXElem :: T_Instruction sem_Instruction_EscXElem = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4142 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4147 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_EscXElem_1 :: T_Instruction_1 sem_Instruction_EscXElem_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4157 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4162 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4167 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_EscXElem_2 :: T_Instruction_2 sem_Instruction_EscXElem_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_EscXElem {-# LINE 4175 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4180 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4185 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_EscXElem_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_EscXElem_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_FindDef :: Word32 -> T_Instruction sem_Instruction_FindDef name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4201 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4206 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_FindDef_1 :: T_Instruction_1 sem_Instruction_FindDef_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4216 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4221 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4226 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_FindDef_2 :: T_Instruction_2 sem_Instruction_FindDef_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_FindDef name_ {-# LINE 4234 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4239 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4244 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_FindDef_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_FindDef_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_FindPropStrict :: Word32 -> T_Instruction sem_Instruction_FindPropStrict name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4260 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4265 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_FindPropStrict_1 :: T_Instruction_1 sem_Instruction_FindPropStrict_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4275 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4280 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4285 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_FindPropStrict_2 :: T_Instruction_2 sem_Instruction_FindPropStrict_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_FindPropStrict name_ {-# LINE 4293 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4298 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4303 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_FindPropStrict_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_FindPropStrict_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_FindProperty :: Word32 -> T_Instruction sem_Instruction_FindProperty name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4319 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4324 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_FindProperty_1 :: T_Instruction_1 sem_Instruction_FindProperty_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4334 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4339 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4344 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_FindProperty_2 :: T_Instruction_2 sem_Instruction_FindProperty_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_FindProperty name_ {-# LINE 4352 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4357 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4362 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_FindProperty_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_FindProperty_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_FindPropertyGlobal :: Word32 -> T_Instruction sem_Instruction_FindPropertyGlobal name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4378 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4383 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_FindPropertyGlobal_1 :: T_Instruction_1 sem_Instruction_FindPropertyGlobal_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4393 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4398 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4403 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_FindPropertyGlobal_2 :: T_Instruction_2 sem_Instruction_FindPropertyGlobal_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_FindPropertyGlobal name_ {-# LINE 4411 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4416 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4421 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_FindPropertyGlobal_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_FindPropertyGlobal_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_FindPropertyGlobalStrict :: Word32 -> T_Instruction sem_Instruction_FindPropertyGlobalStrict name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4437 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4442 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_FindPropertyGlobalStrict_1 :: T_Instruction_1 sem_Instruction_FindPropertyGlobalStrict_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4452 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4457 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4462 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_FindPropertyGlobalStrict_2 :: T_Instruction_2 sem_Instruction_FindPropertyGlobalStrict_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_FindPropertyGlobalStrict name_ {-# LINE 4470 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4475 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4480 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_FindPropertyGlobalStrict_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_FindPropertyGlobalStrict_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetDescendants :: Word32 -> T_Instruction sem_Instruction_GetDescendants name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4496 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4501 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetDescendants_1 :: T_Instruction_1 sem_Instruction_GetDescendants_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4511 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4516 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4521 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetDescendants_2 :: T_Instruction_2 sem_Instruction_GetDescendants_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetDescendants name_ {-# LINE 4529 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4534 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4539 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetDescendants_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetDescendants_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetGlobalScope :: T_Instruction sem_Instruction_GetGlobalScope = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4554 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4559 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetGlobalScope_1 :: T_Instruction_1 sem_Instruction_GetGlobalScope_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4569 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4574 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4579 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetGlobalScope_2 :: T_Instruction_2 sem_Instruction_GetGlobalScope_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetGlobalScope {-# LINE 4587 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4592 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4597 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetGlobalScope_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetGlobalScope_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetGlobalSlot :: Word32 -> T_Instruction sem_Instruction_GetGlobalSlot slot_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4613 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4618 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetGlobalSlot_1 :: T_Instruction_1 sem_Instruction_GetGlobalSlot_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4628 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4633 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4638 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetGlobalSlot_2 :: T_Instruction_2 sem_Instruction_GetGlobalSlot_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetGlobalSlot slot_ {-# LINE 4646 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4651 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4656 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetGlobalSlot_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetGlobalSlot_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLex :: Word32 -> T_Instruction sem_Instruction_GetLex name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4672 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4677 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLex_1 :: T_Instruction_1 sem_Instruction_GetLex_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4687 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4692 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4697 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLex_2 :: T_Instruction_2 sem_Instruction_GetLex_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLex name_ {-# LINE 4705 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4710 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4715 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLex_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLex_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLocal :: Word32 -> T_Instruction sem_Instruction_GetLocal reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4731 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4736 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLocal_1 :: T_Instruction_1 sem_Instruction_GetLocal_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4746 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4751 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4756 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLocal_2 :: T_Instruction_2 sem_Instruction_GetLocal_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLocal reg_ {-# LINE 4764 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4769 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4774 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLocal_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLocal_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLocal0 :: T_Instruction sem_Instruction_GetLocal0 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4789 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4794 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLocal0_1 :: T_Instruction_1 sem_Instruction_GetLocal0_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4804 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4809 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4814 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLocal0_2 :: T_Instruction_2 sem_Instruction_GetLocal0_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLocal0 {-# LINE 4822 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4827 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4832 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLocal0_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLocal0_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLocal1 :: T_Instruction sem_Instruction_GetLocal1 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4847 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4852 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLocal1_1 :: T_Instruction_1 sem_Instruction_GetLocal1_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4862 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4867 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4872 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLocal1_2 :: T_Instruction_2 sem_Instruction_GetLocal1_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLocal1 {-# LINE 4880 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4885 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4890 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLocal1_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLocal1_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLocal2 :: T_Instruction sem_Instruction_GetLocal2 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4905 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4910 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLocal2_1 :: T_Instruction_1 sem_Instruction_GetLocal2_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4920 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4925 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4930 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLocal2_2 :: T_Instruction_2 sem_Instruction_GetLocal2_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLocal2 {-# LINE 4938 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 4943 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 4948 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLocal2_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLocal2_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetLocal3 :: T_Instruction sem_Instruction_GetLocal3 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 4963 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 4968 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetLocal3_1 :: T_Instruction_1 sem_Instruction_GetLocal3_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 4978 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 4983 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 4988 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetLocal3_2 :: T_Instruction_2 sem_Instruction_GetLocal3_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetLocal3 {-# LINE 4996 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5001 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5006 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetLocal3_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetLocal3_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetOuterScope :: Word32 -> T_Instruction sem_Instruction_GetOuterScope name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5022 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5027 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetOuterScope_1 :: T_Instruction_1 sem_Instruction_GetOuterScope_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5037 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5042 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5047 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetOuterScope_2 :: T_Instruction_2 sem_Instruction_GetOuterScope_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetOuterScope name_ {-# LINE 5055 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5060 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5065 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetOuterScope_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetOuterScope_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetProperty :: Word32 -> T_Instruction sem_Instruction_GetProperty name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5081 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5086 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetProperty_1 :: T_Instruction_1 sem_Instruction_GetProperty_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5096 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5101 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5106 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetProperty_2 :: T_Instruction_2 sem_Instruction_GetProperty_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetProperty name_ {-# LINE 5114 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5119 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5124 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetProperty_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetProperty_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetScopeObject :: Word8 -> T_Instruction sem_Instruction_GetScopeObject index_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5140 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5145 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetScopeObject_1 :: T_Instruction_1 sem_Instruction_GetScopeObject_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5155 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5160 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5165 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetScopeObject_2 :: T_Instruction_2 sem_Instruction_GetScopeObject_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetScopeObject index_ {-# LINE 5173 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5178 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5183 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetScopeObject_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetScopeObject_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetSlot :: Word32 -> T_Instruction sem_Instruction_GetSlot slot_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5199 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5204 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetSlot_1 :: T_Instruction_1 sem_Instruction_GetSlot_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5214 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5219 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5224 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetSlot_2 :: T_Instruction_2 sem_Instruction_GetSlot_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetSlot slot_ {-# LINE 5232 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5237 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5242 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetSlot_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetSlot_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GetSuper :: Word32 -> T_Instruction sem_Instruction_GetSuper name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5258 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5263 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GetSuper_1 :: T_Instruction_1 sem_Instruction_GetSuper_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5273 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5278 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5283 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GetSuper_2 :: T_Instruction_2 sem_Instruction_GetSuper_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GetSuper name_ {-# LINE 5291 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5296 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5301 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GetSuper_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GetSuper_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GreaterEquals :: T_Instruction sem_Instruction_GreaterEquals = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5316 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5321 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GreaterEquals_1 :: T_Instruction_1 sem_Instruction_GreaterEquals_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5331 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5336 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5341 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GreaterEquals_2 :: T_Instruction_2 sem_Instruction_GreaterEquals_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GreaterEquals {-# LINE 5349 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5354 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5359 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GreaterEquals_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GreaterEquals_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_GreaterThan :: T_Instruction sem_Instruction_GreaterThan = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5374 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5379 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_GreaterThan_1 :: T_Instruction_1 sem_Instruction_GreaterThan_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5389 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5394 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5399 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_GreaterThan_2 :: T_Instruction_2 sem_Instruction_GreaterThan_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_GreaterThan {-# LINE 5407 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5412 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5417 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_GreaterThan_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_GreaterThan_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_HasNext :: T_Instruction sem_Instruction_HasNext = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5432 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5437 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_HasNext_1 :: T_Instruction_1 sem_Instruction_HasNext_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5447 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5452 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5457 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_HasNext_2 :: T_Instruction_2 sem_Instruction_HasNext_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_HasNext {-# LINE 5465 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5470 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5475 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_HasNext_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_HasNext_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_HasNext2 :: Word32 -> Word32 -> T_Instruction sem_Instruction_HasNext2 objectReg_ indexReg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 5492 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5497 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_HasNext2_1 :: T_Instruction_1 sem_Instruction_HasNext2_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5507 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 5512 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5517 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_HasNext2_2 :: T_Instruction_2 sem_Instruction_HasNext2_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_HasNext2 objectReg_ indexReg_ {-# LINE 5525 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5530 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5535 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_HasNext2_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_HasNext2_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfEq :: Word32 -> T_Instruction sem_Instruction_IfEq offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5551 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5556 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfEq_1 :: T_Instruction_1 sem_Instruction_IfEq_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5566 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5571 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5576 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5581 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5586 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5591 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5596 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfEq_2 :: T_Instruction_2 sem_Instruction_IfEq_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfEq offset_ {-# LINE 5604 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5609 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5614 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfEq_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfEq_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfFalse :: Word32 -> T_Instruction sem_Instruction_IfFalse offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5630 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5635 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfFalse_1 :: T_Instruction_1 sem_Instruction_IfFalse_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5645 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5650 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5655 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5660 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5665 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5670 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5675 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfFalse_2 :: T_Instruction_2 sem_Instruction_IfFalse_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfFalse offset_ {-# LINE 5683 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5688 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5693 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfFalse_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfFalse_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfGe :: Word32 -> T_Instruction sem_Instruction_IfGe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5709 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5714 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfGe_1 :: T_Instruction_1 sem_Instruction_IfGe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5724 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5729 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5734 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5739 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5744 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5749 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5754 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfGe_2 :: T_Instruction_2 sem_Instruction_IfGe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfGe offset_ {-# LINE 5762 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5767 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5772 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfGe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfGe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfGt :: Word32 -> T_Instruction sem_Instruction_IfGt offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5788 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5793 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfGt_1 :: T_Instruction_1 sem_Instruction_IfGt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5803 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5808 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5813 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5818 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5823 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5828 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5833 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfGt_2 :: T_Instruction_2 sem_Instruction_IfGt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfGt offset_ {-# LINE 5841 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5846 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5851 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfGt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfGt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfLe :: Word32 -> T_Instruction sem_Instruction_IfLe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5867 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5872 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfLe_1 :: T_Instruction_1 sem_Instruction_IfLe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5882 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5887 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5892 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5897 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5902 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5907 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5912 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfLe_2 :: T_Instruction_2 sem_Instruction_IfLe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfLe offset_ {-# LINE 5920 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 5925 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 5930 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfLe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfLe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfLt :: Word32 -> T_Instruction sem_Instruction_IfLt offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 5946 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 5951 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfLt_1 :: T_Instruction_1 sem_Instruction_IfLt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 5961 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 5966 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 5971 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 5976 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 5981 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 5986 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 5991 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfLt_2 :: T_Instruction_2 sem_Instruction_IfLt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfLt offset_ {-# LINE 5999 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6004 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6009 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfLt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfLt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfNGe :: Word32 -> T_Instruction sem_Instruction_IfNGe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6025 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6030 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfNGe_1 :: T_Instruction_1 sem_Instruction_IfNGe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6040 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6045 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6050 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6055 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6060 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6065 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6070 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfNGe_2 :: T_Instruction_2 sem_Instruction_IfNGe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfNGe offset_ {-# LINE 6078 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6083 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6088 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfNGe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfNGe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfNGt :: Word32 -> T_Instruction sem_Instruction_IfNGt offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6104 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6109 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfNGt_1 :: T_Instruction_1 sem_Instruction_IfNGt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6119 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6124 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6129 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6134 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6139 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6144 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6149 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfNGt_2 :: T_Instruction_2 sem_Instruction_IfNGt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfNGt offset_ {-# LINE 6157 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6162 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6167 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfNGt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfNGt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfNLe :: Word32 -> T_Instruction sem_Instruction_IfNLe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6183 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6188 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfNLe_1 :: T_Instruction_1 sem_Instruction_IfNLe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6198 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6203 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6208 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6213 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6218 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6223 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6228 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfNLe_2 :: T_Instruction_2 sem_Instruction_IfNLe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfNLe offset_ {-# LINE 6236 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6241 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6246 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfNLe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfNLe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfNLt :: Word32 -> T_Instruction sem_Instruction_IfNLt offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6262 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6267 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfNLt_1 :: T_Instruction_1 sem_Instruction_IfNLt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6277 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6282 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6287 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6292 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6297 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6302 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6307 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfNLt_2 :: T_Instruction_2 sem_Instruction_IfNLt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfNLt offset_ {-# LINE 6315 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6320 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6325 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfNLt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfNLt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfNe :: Word32 -> T_Instruction sem_Instruction_IfNe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6341 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6346 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfNe_1 :: T_Instruction_1 sem_Instruction_IfNe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6356 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6361 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6366 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6371 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6376 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6381 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6386 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfNe_2 :: T_Instruction_2 sem_Instruction_IfNe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfNe offset_ {-# LINE 6394 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6399 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6404 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfNe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfNe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfStrictEq :: Word32 -> T_Instruction sem_Instruction_IfStrictEq offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6420 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6425 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfStrictEq_1 :: T_Instruction_1 sem_Instruction_IfStrictEq_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6435 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6440 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6445 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6450 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6455 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6460 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6465 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfStrictEq_2 :: T_Instruction_2 sem_Instruction_IfStrictEq_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfStrictEq offset_ {-# LINE 6473 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6478 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6483 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfStrictEq_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfStrictEq_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfStrictNe :: Word32 -> T_Instruction sem_Instruction_IfStrictNe offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6499 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6504 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfStrictNe_1 :: T_Instruction_1 sem_Instruction_IfStrictNe_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6514 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6519 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6524 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6529 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6534 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6539 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6544 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfStrictNe_2 :: T_Instruction_2 sem_Instruction_IfStrictNe_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfStrictNe offset_ {-# LINE 6552 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6557 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6562 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfStrictNe_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfStrictNe_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IfTrue :: Word32 -> T_Instruction sem_Instruction_IfTrue offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 6578 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6583 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IfTrue_1 :: T_Instruction_1 sem_Instruction_IfTrue_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6593 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 6598 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 6603 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 6608 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 6613 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 6618 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6623 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IfTrue_2 :: T_Instruction_2 sem_Instruction_IfTrue_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IfTrue offset_ {-# LINE 6631 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6636 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6641 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IfTrue_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_IfTrue_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_In :: T_Instruction sem_Instruction_In = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6656 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6661 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_In_1 :: T_Instruction_1 sem_Instruction_In_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6671 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6676 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6681 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_In_2 :: T_Instruction_2 sem_Instruction_In_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_In {-# LINE 6689 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6694 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6699 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_In_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_In_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IncLocal :: Word32 -> T_Instruction sem_Instruction_IncLocal reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6715 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6720 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IncLocal_1 :: T_Instruction_1 sem_Instruction_IncLocal_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6730 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6735 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6740 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IncLocal_2 :: T_Instruction_2 sem_Instruction_IncLocal_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IncLocal reg_ {-# LINE 6748 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6753 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6758 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IncLocal_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_IncLocal_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IncLocal_i :: Word32 -> T_Instruction sem_Instruction_IncLocal_i reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6774 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6779 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IncLocal_i_1 :: T_Instruction_1 sem_Instruction_IncLocal_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6789 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6794 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6799 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IncLocal_i_2 :: T_Instruction_2 sem_Instruction_IncLocal_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IncLocal_i reg_ {-# LINE 6807 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6812 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6817 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IncLocal_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_IncLocal_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Increment :: T_Instruction sem_Instruction_Increment = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6832 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6837 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Increment_1 :: T_Instruction_1 sem_Instruction_Increment_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6847 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6852 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6857 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Increment_2 :: T_Instruction_2 sem_Instruction_Increment_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Increment {-# LINE 6865 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6870 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6875 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Increment_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Increment_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Increment_i :: T_Instruction sem_Instruction_Increment_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6890 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6895 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Increment_i_1 :: T_Instruction_1 sem_Instruction_Increment_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6905 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6910 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6915 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Increment_i_2 :: T_Instruction_2 sem_Instruction_Increment_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Increment_i {-# LINE 6923 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6928 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6933 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Increment_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Increment_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_InitProperty :: Word32 -> T_Instruction sem_Instruction_InitProperty name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 6949 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 6954 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_InitProperty_1 :: T_Instruction_1 sem_Instruction_InitProperty_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 6964 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 6969 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 6974 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_InitProperty_2 :: T_Instruction_2 sem_Instruction_InitProperty_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_InitProperty name_ {-# LINE 6982 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 6987 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 6992 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_InitProperty_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_InitProperty_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_InstanceOf :: T_Instruction sem_Instruction_InstanceOf = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7007 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7012 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_InstanceOf_1 :: T_Instruction_1 sem_Instruction_InstanceOf_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7022 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7027 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7032 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_InstanceOf_2 :: T_Instruction_2 sem_Instruction_InstanceOf_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_InstanceOf {-# LINE 7040 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7045 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7050 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_InstanceOf_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_InstanceOf_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IsType :: Word32 -> T_Instruction sem_Instruction_IsType name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7066 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7071 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IsType_1 :: T_Instruction_1 sem_Instruction_IsType_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7081 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7086 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7091 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IsType_2 :: T_Instruction_2 sem_Instruction_IsType_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IsType name_ {-# LINE 7099 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7104 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7109 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IsType_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_IsType_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_IsTypeLate :: T_Instruction sem_Instruction_IsTypeLate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7124 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7129 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_IsTypeLate_1 :: T_Instruction_1 sem_Instruction_IsTypeLate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7139 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7144 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7149 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_IsTypeLate_2 :: T_Instruction_2 sem_Instruction_IsTypeLate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_IsTypeLate {-# LINE 7157 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7162 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7167 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_IsTypeLate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_IsTypeLate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Jump :: Word32 -> T_Instruction sem_Instruction_Jump offset_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 7183 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7188 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Jump_1 :: T_Instruction_1 sem_Instruction_Jump_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7198 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 26 "src/ByteCodeLocationInfo.ag" #-} fromS24 offset_ {-# LINE 7203 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 27 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation + _relative {-# LINE 7208 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 7213 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 7218 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 7223 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7228 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Jump_2 :: T_Instruction_2 sem_Instruction_Jump_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Jump offset_ {-# LINE 7236 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7241 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7246 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Jump_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) })) in sem_Instruction_Jump_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Kill :: Word32 -> T_Instruction sem_Instruction_Kill reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7262 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7267 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Kill_1 :: T_Instruction_1 sem_Instruction_Kill_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7277 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7282 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7287 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Kill_2 :: T_Instruction_2 sem_Instruction_Kill_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Kill reg_ {-# LINE 7295 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7300 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7305 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Kill_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Kill_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Label :: T_Instruction sem_Instruction_Label = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7320 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7325 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Label_1 :: T_Instruction_1 sem_Instruction_Label_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7335 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7340 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7345 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Label_2 :: T_Instruction_2 sem_Instruction_Label_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Label {-# LINE 7353 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7358 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7363 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Label_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Label_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LessEquals :: T_Instruction sem_Instruction_LessEquals = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7378 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7383 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LessEquals_1 :: T_Instruction_1 sem_Instruction_LessEquals_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7393 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7398 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7403 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LessEquals_2 :: T_Instruction_2 sem_Instruction_LessEquals_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LessEquals {-# LINE 7411 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7416 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7421 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LessEquals_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LessEquals_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LessThan :: T_Instruction sem_Instruction_LessThan = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7436 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7441 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LessThan_1 :: T_Instruction_1 sem_Instruction_LessThan_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7451 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7456 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7461 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LessThan_2 :: T_Instruction_2 sem_Instruction_LessThan_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LessThan {-# LINE 7469 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7474 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7479 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LessThan_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LessThan_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LoadFloat32 :: T_Instruction sem_Instruction_LoadFloat32 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7494 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7499 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LoadFloat32_1 :: T_Instruction_1 sem_Instruction_LoadFloat32_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7509 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7514 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7519 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LoadFloat32_2 :: T_Instruction_2 sem_Instruction_LoadFloat32_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LoadFloat32 {-# LINE 7527 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7532 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7537 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LoadFloat32_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LoadFloat32_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LoadFloat64 :: T_Instruction sem_Instruction_LoadFloat64 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7552 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7557 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LoadFloat64_1 :: T_Instruction_1 sem_Instruction_LoadFloat64_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7567 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7572 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7577 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LoadFloat64_2 :: T_Instruction_2 sem_Instruction_LoadFloat64_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LoadFloat64 {-# LINE 7585 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7590 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7595 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LoadFloat64_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LoadFloat64_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LoadIndirect16 :: T_Instruction sem_Instruction_LoadIndirect16 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7610 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7615 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect16_1 :: T_Instruction_1 sem_Instruction_LoadIndirect16_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7625 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7630 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7635 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect16_2 :: T_Instruction_2 sem_Instruction_LoadIndirect16_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LoadIndirect16 {-# LINE 7643 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7648 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7653 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LoadIndirect16_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LoadIndirect16_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LoadIndirect32 :: T_Instruction sem_Instruction_LoadIndirect32 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7668 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7673 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect32_1 :: T_Instruction_1 sem_Instruction_LoadIndirect32_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7683 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7688 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7693 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect32_2 :: T_Instruction_2 sem_Instruction_LoadIndirect32_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LoadIndirect32 {-# LINE 7701 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7706 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7711 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LoadIndirect32_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LoadIndirect32_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LoadIndirect8 :: T_Instruction sem_Instruction_LoadIndirect8 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7726 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7731 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect8_1 :: T_Instruction_1 sem_Instruction_LoadIndirect8_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7741 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7746 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7751 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LoadIndirect8_2 :: T_Instruction_2 sem_Instruction_LoadIndirect8_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LoadIndirect8 {-# LINE 7759 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7764 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7769 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LoadIndirect8_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_LoadIndirect8_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Location :: Int -> T_Instruction sem_Instruction_Location index_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7785 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 7 "src/ByteCodeLocationInfo.ag" #-} index_ {-# LINE 7790 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Location_1 :: T_Instruction_1 sem_Instruction_Location_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 81 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7800 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 81 "src/InstrLocFilter.ag" #-} if _lhsIisBranch || _lhsIrevIsBranch then (IntSet.insert index_) else id {-# LINE 7805 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 81 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 7810 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7815 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 11 "src/ByteCodeLocationInfo.ag" #-} index_ {-# LINE 7820 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Location_2 :: T_Instruction_2 sem_Instruction_Location_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Location index_ {-# LINE 7828 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7833 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 55 "src/InstrLocFilter.ag" #-} not (IntSet.member index_ _lhsIretain) {-# LINE 7838 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Location_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) })) in sem_Instruction_Location_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_LookupSwitch :: Word32 -> T_CaseOffsets -> T_Instruction sem_Instruction_LookupSwitch defaultOffset_ caseOffsets_ = (\ _lhsIlocation -> (case (({-# LINE 65 "src/InstrLocFilter.ag" #-} True {-# LINE 7855 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7860 "src/InstrLocFilter.hs" #-} )) of { _caseOffsetsOlocation | _caseOffsetsOlocation `seq` (True) -> (case (caseOffsets_ _caseOffsetsOlocation ) of { ( _caseOffsetsIlocation,caseOffsets_1) | True -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _caseOffsetsIlocation {-# LINE 7867 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_LookupSwitch_1 :: T_Instruction_1 sem_Instruction_LookupSwitch_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7877 "src/InstrLocFilter.hs" #-} )) of { _caseOffsetsOrevLocation | _caseOffsetsOrevLocation `seq` (True) -> (case (caseOffsets_1 _caseOffsetsOrevLocation ) of { ( _caseOffsetsIlocs,_caseOffsetsIoutput,_caseOffsetsIrevLocation) | True -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} _caseOffsetsIlocs {-# LINE 7884 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_syn | _locs_augmented_syn `seq` (True) -> (case (({-# LINE 23 "src/ByteCodeLocationInfo.ag" #-} fromS24 defaultOffset_ {-# LINE 7889 "src/InstrLocFilter.hs" #-} )) of { _relative | _relative `seq` (True) -> (case (({-# LINE 24 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation + _relative {-# LINE 7894 "src/InstrLocFilter.hs" #-} )) of { _target | _target `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} IntSet.insert _target {-# LINE 7899 "src/InstrLocFilter.hs" #-} )) of { _locs_augmented_f1 | _locs_augmented_f1 `seq` (True) -> (case (({-# LINE 85 "src/InstrLocFilter.ag" #-} foldr ($) _locs_augmented_syn [_locs_augmented_f1] {-# LINE 7904 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 66 "src/InstrLocFilter.ag" #-} True {-# LINE 7909 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _caseOffsetsIrevLocation {-# LINE 7914 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_LookupSwitch_2 :: T_Instruction_2 sem_Instruction_LookupSwitch_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_LookupSwitch defaultOffset_ _caseOffsetsIoutput {-# LINE 7922 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7927 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7932 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_LookupSwitch_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) }) }) }) }) }) }) })) in sem_Instruction_LookupSwitch_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) }) }) })) sem_Instruction_Lshift :: T_Instruction sem_Instruction_Lshift = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 7947 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 7952 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Lshift_1 :: T_Instruction_1 sem_Instruction_Lshift_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 7962 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 7967 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 7972 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Lshift_2 :: T_Instruction_2 sem_Instruction_Lshift_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Lshift {-# LINE 7980 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 7985 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 7990 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Lshift_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Lshift_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Modulo :: T_Instruction sem_Instruction_Modulo = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8005 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8010 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Modulo_1 :: T_Instruction_1 sem_Instruction_Modulo_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8020 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8025 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8030 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Modulo_2 :: T_Instruction_2 sem_Instruction_Modulo_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Modulo {-# LINE 8038 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8043 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8048 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Modulo_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Modulo_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Multiply :: T_Instruction sem_Instruction_Multiply = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8063 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8068 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Multiply_1 :: T_Instruction_1 sem_Instruction_Multiply_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8078 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8083 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8088 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Multiply_2 :: T_Instruction_2 sem_Instruction_Multiply_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Multiply {-# LINE 8096 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8101 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8106 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Multiply_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Multiply_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Multiply_i :: T_Instruction sem_Instruction_Multiply_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8121 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8126 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Multiply_i_1 :: T_Instruction_1 sem_Instruction_Multiply_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8136 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8141 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8146 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Multiply_i_2 :: T_Instruction_2 sem_Instruction_Multiply_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Multiply_i {-# LINE 8154 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8159 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8164 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Multiply_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Multiply_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Negate :: T_Instruction sem_Instruction_Negate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8179 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8184 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Negate_1 :: T_Instruction_1 sem_Instruction_Negate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8194 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8199 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8204 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Negate_2 :: T_Instruction_2 sem_Instruction_Negate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Negate {-# LINE 8212 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8217 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8222 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Negate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Negate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Negate_i :: T_Instruction sem_Instruction_Negate_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8237 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8242 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Negate_i_1 :: T_Instruction_1 sem_Instruction_Negate_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8252 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8257 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8262 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Negate_i_2 :: T_Instruction_2 sem_Instruction_Negate_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Negate_i {-# LINE 8270 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8275 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8280 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Negate_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Negate_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewActivation :: T_Instruction sem_Instruction_NewActivation = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8295 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8300 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewActivation_1 :: T_Instruction_1 sem_Instruction_NewActivation_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8310 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8315 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8320 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewActivation_2 :: T_Instruction_2 sem_Instruction_NewActivation_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewActivation {-# LINE 8328 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8333 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8338 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewActivation_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewActivation_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewArray :: Word32 -> T_Instruction sem_Instruction_NewArray argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8354 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8359 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewArray_1 :: T_Instruction_1 sem_Instruction_NewArray_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8369 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8374 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8379 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewArray_2 :: T_Instruction_2 sem_Instruction_NewArray_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewArray argCount_ {-# LINE 8387 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8392 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8397 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewArray_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewArray_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewCatch :: Word32 -> T_Instruction sem_Instruction_NewCatch exception_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8413 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8418 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewCatch_1 :: T_Instruction_1 sem_Instruction_NewCatch_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8428 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8433 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8438 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewCatch_2 :: T_Instruction_2 sem_Instruction_NewCatch_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewCatch exception_ {-# LINE 8446 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8451 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8456 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewCatch_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewCatch_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewClass :: Word32 -> T_Instruction sem_Instruction_NewClass class_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8472 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8477 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewClass_1 :: T_Instruction_1 sem_Instruction_NewClass_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8487 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8492 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8497 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewClass_2 :: T_Instruction_2 sem_Instruction_NewClass_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewClass class_ {-# LINE 8505 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8510 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8515 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewClass_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewClass_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewFunction :: Word32 -> T_Instruction sem_Instruction_NewFunction method_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8531 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8536 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewFunction_1 :: T_Instruction_1 sem_Instruction_NewFunction_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8546 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8551 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8556 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewFunction_2 :: T_Instruction_2 sem_Instruction_NewFunction_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewFunction method_ {-# LINE 8564 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8569 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8574 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewFunction_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewFunction_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NewObject :: Word32 -> T_Instruction sem_Instruction_NewObject argCount_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8590 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8595 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NewObject_1 :: T_Instruction_1 sem_Instruction_NewObject_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8605 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8610 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8615 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NewObject_2 :: T_Instruction_2 sem_Instruction_NewObject_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NewObject argCount_ {-# LINE 8623 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8628 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8633 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NewObject_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NewObject_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NextName :: T_Instruction sem_Instruction_NextName = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8648 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8653 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NextName_1 :: T_Instruction_1 sem_Instruction_NextName_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8663 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8668 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8673 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NextName_2 :: T_Instruction_2 sem_Instruction_NextName_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NextName {-# LINE 8681 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8686 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8691 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NextName_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NextName_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_NextValue :: T_Instruction sem_Instruction_NextValue = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8706 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8711 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_NextValue_1 :: T_Instruction_1 sem_Instruction_NextValue_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8721 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8726 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8731 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_NextValue_2 :: T_Instruction_2 sem_Instruction_NextValue_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_NextValue {-# LINE 8739 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8744 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8749 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_NextValue_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_NextValue_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Nop :: T_Instruction sem_Instruction_Nop = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8764 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8769 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Nop_1 :: T_Instruction_1 sem_Instruction_Nop_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8779 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8784 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8789 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Nop_2 :: T_Instruction_2 sem_Instruction_Nop_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Nop {-# LINE 8797 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8802 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8807 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Nop_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Nop_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Not :: T_Instruction sem_Instruction_Not = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8822 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8827 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Not_1 :: T_Instruction_1 sem_Instruction_Not_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8837 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8842 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8847 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Not_2 :: T_Instruction_2 sem_Instruction_Not_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Not {-# LINE 8855 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8860 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8865 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Not_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Not_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Pop :: T_Instruction sem_Instruction_Pop = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8880 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8885 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Pop_1 :: T_Instruction_1 sem_Instruction_Pop_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8895 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8900 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8905 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Pop_2 :: T_Instruction_2 sem_Instruction_Pop_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Pop {-# LINE 8913 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8918 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8923 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Pop_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Pop_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PopScope :: T_Instruction sem_Instruction_PopScope = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8938 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 8943 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PopScope_1 :: T_Instruction_1 sem_Instruction_PopScope_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 8953 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 8958 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 8963 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PopScope_2 :: T_Instruction_2 sem_Instruction_PopScope_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PopScope {-# LINE 8971 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 8976 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 8981 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PopScope_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PopScope_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushByte :: Word8 -> T_Instruction sem_Instruction_PushByte val_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 8997 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9002 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushByte_1 :: T_Instruction_1 sem_Instruction_PushByte_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9012 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9017 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9022 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushByte_2 :: T_Instruction_2 sem_Instruction_PushByte_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushByte val_ {-# LINE 9030 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9035 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9040 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushByte_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushByte_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushDouble :: Word32 -> T_Instruction sem_Instruction_PushDouble name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9056 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9061 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushDouble_1 :: T_Instruction_1 sem_Instruction_PushDouble_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9071 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9076 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9081 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushDouble_2 :: T_Instruction_2 sem_Instruction_PushDouble_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushDouble name_ {-# LINE 9089 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9094 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9099 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushDouble_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushDouble_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushFalse :: T_Instruction sem_Instruction_PushFalse = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9114 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9119 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushFalse_1 :: T_Instruction_1 sem_Instruction_PushFalse_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9129 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9134 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9139 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushFalse_2 :: T_Instruction_2 sem_Instruction_PushFalse_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushFalse {-# LINE 9147 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9152 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9157 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushFalse_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushFalse_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushInt :: Word32 -> T_Instruction sem_Instruction_PushInt name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9173 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9178 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushInt_1 :: T_Instruction_1 sem_Instruction_PushInt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9188 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9193 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9198 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushInt_2 :: T_Instruction_2 sem_Instruction_PushInt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushInt name_ {-# LINE 9206 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9211 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9216 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushInt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushInt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushNaN :: T_Instruction sem_Instruction_PushNaN = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9231 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9236 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushNaN_1 :: T_Instruction_1 sem_Instruction_PushNaN_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9246 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9251 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9256 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushNaN_2 :: T_Instruction_2 sem_Instruction_PushNaN_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushNaN {-# LINE 9264 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9269 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9274 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushNaN_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushNaN_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushNamespace :: Word32 -> T_Instruction sem_Instruction_PushNamespace name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9290 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9295 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushNamespace_1 :: T_Instruction_1 sem_Instruction_PushNamespace_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9305 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9310 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9315 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushNamespace_2 :: T_Instruction_2 sem_Instruction_PushNamespace_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushNamespace name_ {-# LINE 9323 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9328 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9333 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushNamespace_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushNamespace_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushNull :: T_Instruction sem_Instruction_PushNull = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9348 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9353 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushNull_1 :: T_Instruction_1 sem_Instruction_PushNull_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9363 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9368 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9373 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushNull_2 :: T_Instruction_2 sem_Instruction_PushNull_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushNull {-# LINE 9381 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9386 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9391 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushNull_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushNull_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushScope :: T_Instruction sem_Instruction_PushScope = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9406 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9411 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushScope_1 :: T_Instruction_1 sem_Instruction_PushScope_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9421 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9426 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9431 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushScope_2 :: T_Instruction_2 sem_Instruction_PushScope_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushScope {-# LINE 9439 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9444 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9449 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushScope_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushScope_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushShort :: Word32 -> T_Instruction sem_Instruction_PushShort val_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9465 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9470 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushShort_1 :: T_Instruction_1 sem_Instruction_PushShort_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9480 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9485 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9490 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushShort_2 :: T_Instruction_2 sem_Instruction_PushShort_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushShort val_ {-# LINE 9498 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9503 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9508 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushShort_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushShort_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushString :: Word32 -> T_Instruction sem_Instruction_PushString name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9524 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9529 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushString_1 :: T_Instruction_1 sem_Instruction_PushString_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9539 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9544 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9549 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushString_2 :: T_Instruction_2 sem_Instruction_PushString_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushString name_ {-# LINE 9557 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9562 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9567 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushString_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushString_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushTrue :: T_Instruction sem_Instruction_PushTrue = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9582 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9587 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushTrue_1 :: T_Instruction_1 sem_Instruction_PushTrue_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9597 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9602 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9607 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushTrue_2 :: T_Instruction_2 sem_Instruction_PushTrue_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushTrue {-# LINE 9615 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9620 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9625 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushTrue_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushTrue_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushUInt :: Word32 -> T_Instruction sem_Instruction_PushUInt name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9641 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9646 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushUInt_1 :: T_Instruction_1 sem_Instruction_PushUInt_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9656 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9661 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9666 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushUInt_2 :: T_Instruction_2 sem_Instruction_PushUInt_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushUInt name_ {-# LINE 9674 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9679 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9684 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushUInt_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushUInt_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushUndefined :: T_Instruction sem_Instruction_PushUndefined = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9699 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9704 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushUndefined_1 :: T_Instruction_1 sem_Instruction_PushUndefined_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9714 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9719 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9724 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushUndefined_2 :: T_Instruction_2 sem_Instruction_PushUndefined_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushUndefined {-# LINE 9732 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9737 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9742 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushUndefined_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushUndefined_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_PushWith :: T_Instruction sem_Instruction_PushWith = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9757 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9762 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_PushWith_1 :: T_Instruction_1 sem_Instruction_PushWith_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9772 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9777 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9782 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_PushWith_2 :: T_Instruction_2 sem_Instruction_PushWith_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_PushWith {-# LINE 9790 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9795 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9800 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_PushWith_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_PushWith_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_ReturnValue :: T_Instruction sem_Instruction_ReturnValue = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9815 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9820 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_ReturnValue_1 :: T_Instruction_1 sem_Instruction_ReturnValue_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9830 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9835 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9840 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_ReturnValue_2 :: T_Instruction_2 sem_Instruction_ReturnValue_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_ReturnValue {-# LINE 9848 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9853 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9858 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_ReturnValue_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_ReturnValue_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_ReturnVoid :: T_Instruction sem_Instruction_ReturnVoid = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9873 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9878 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_ReturnVoid_1 :: T_Instruction_1 sem_Instruction_ReturnVoid_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9888 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9893 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9898 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_ReturnVoid_2 :: T_Instruction_2 sem_Instruction_ReturnVoid_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_ReturnVoid {-# LINE 9906 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9911 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9916 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_ReturnVoid_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_ReturnVoid_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Rshift :: T_Instruction sem_Instruction_Rshift = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9931 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9936 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Rshift_1 :: T_Instruction_1 sem_Instruction_Rshift_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 9946 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 9951 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 9956 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Rshift_2 :: T_Instruction_2 sem_Instruction_Rshift_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Rshift {-# LINE 9964 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 9969 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 9974 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Rshift_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Rshift_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetGlobalSlot :: Word32 -> T_Instruction sem_Instruction_SetGlobalSlot slot_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 9990 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 9995 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetGlobalSlot_1 :: T_Instruction_1 sem_Instruction_SetGlobalSlot_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10005 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10010 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10015 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetGlobalSlot_2 :: T_Instruction_2 sem_Instruction_SetGlobalSlot_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetGlobalSlot slot_ {-# LINE 10023 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10028 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10033 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetGlobalSlot_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetGlobalSlot_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetLocal :: Word32 -> T_Instruction sem_Instruction_SetLocal reg_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10049 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10054 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetLocal_1 :: T_Instruction_1 sem_Instruction_SetLocal_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10064 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10069 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10074 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetLocal_2 :: T_Instruction_2 sem_Instruction_SetLocal_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetLocal reg_ {-# LINE 10082 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10087 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10092 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetLocal_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetLocal_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetLocal0 :: T_Instruction sem_Instruction_SetLocal0 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10107 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10112 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetLocal0_1 :: T_Instruction_1 sem_Instruction_SetLocal0_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10122 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10127 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10132 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetLocal0_2 :: T_Instruction_2 sem_Instruction_SetLocal0_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetLocal0 {-# LINE 10140 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10145 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10150 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetLocal0_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetLocal0_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetLocal1 :: T_Instruction sem_Instruction_SetLocal1 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10165 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10170 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetLocal1_1 :: T_Instruction_1 sem_Instruction_SetLocal1_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10180 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10185 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10190 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetLocal1_2 :: T_Instruction_2 sem_Instruction_SetLocal1_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetLocal1 {-# LINE 10198 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10203 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10208 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetLocal1_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetLocal1_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetLocal2 :: T_Instruction sem_Instruction_SetLocal2 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10223 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10228 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetLocal2_1 :: T_Instruction_1 sem_Instruction_SetLocal2_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10238 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10243 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10248 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetLocal2_2 :: T_Instruction_2 sem_Instruction_SetLocal2_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetLocal2 {-# LINE 10256 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10261 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10266 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetLocal2_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetLocal2_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetLocal3 :: T_Instruction sem_Instruction_SetLocal3 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10281 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10286 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetLocal3_1 :: T_Instruction_1 sem_Instruction_SetLocal3_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10296 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10301 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10306 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetLocal3_2 :: T_Instruction_2 sem_Instruction_SetLocal3_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetLocal3 {-# LINE 10314 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10319 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10324 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetLocal3_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetLocal3_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetProperty :: Word32 -> T_Instruction sem_Instruction_SetProperty name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10340 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10345 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetProperty_1 :: T_Instruction_1 sem_Instruction_SetProperty_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10355 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10360 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10365 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetProperty_2 :: T_Instruction_2 sem_Instruction_SetProperty_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetProperty name_ {-# LINE 10373 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10378 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10383 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetProperty_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetProperty_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetPropertyLate :: T_Instruction sem_Instruction_SetPropertyLate = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10398 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10403 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetPropertyLate_1 :: T_Instruction_1 sem_Instruction_SetPropertyLate_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10413 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10418 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10423 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetPropertyLate_2 :: T_Instruction_2 sem_Instruction_SetPropertyLate_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetPropertyLate {-# LINE 10431 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10436 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10441 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetPropertyLate_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetPropertyLate_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetSlot :: Word32 -> T_Instruction sem_Instruction_SetSlot slot_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10457 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10462 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetSlot_1 :: T_Instruction_1 sem_Instruction_SetSlot_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10472 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10477 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10482 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetSlot_2 :: T_Instruction_2 sem_Instruction_SetSlot_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetSlot slot_ {-# LINE 10490 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10495 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10500 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetSlot_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetSlot_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SetSuper :: Word32 -> T_Instruction sem_Instruction_SetSuper name_ = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10516 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10521 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SetSuper_1 :: T_Instruction_1 sem_Instruction_SetSuper_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10531 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10536 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10541 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SetSuper_2 :: T_Instruction_2 sem_Instruction_SetSuper_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SetSuper name_ {-# LINE 10549 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10554 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10559 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SetSuper_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SetSuper_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SignExtend1 :: T_Instruction sem_Instruction_SignExtend1 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10574 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10579 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SignExtend1_1 :: T_Instruction_1 sem_Instruction_SignExtend1_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10589 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10594 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10599 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SignExtend1_2 :: T_Instruction_2 sem_Instruction_SignExtend1_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SignExtend1 {-# LINE 10607 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10612 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10617 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SignExtend1_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SignExtend1_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SignExtend16 :: T_Instruction sem_Instruction_SignExtend16 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10632 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10637 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SignExtend16_1 :: T_Instruction_1 sem_Instruction_SignExtend16_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10647 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10652 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10657 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SignExtend16_2 :: T_Instruction_2 sem_Instruction_SignExtend16_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SignExtend16 {-# LINE 10665 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10670 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10675 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SignExtend16_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SignExtend16_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_SignExtend8 :: T_Instruction sem_Instruction_SignExtend8 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10690 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10695 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_SignExtend8_1 :: T_Instruction_1 sem_Instruction_SignExtend8_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10705 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10710 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10715 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_SignExtend8_2 :: T_Instruction_2 sem_Instruction_SignExtend8_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_SignExtend8 {-# LINE 10723 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10728 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10733 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_SignExtend8_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_SignExtend8_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StoreFloat32 :: T_Instruction sem_Instruction_StoreFloat32 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10748 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10753 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StoreFloat32_1 :: T_Instruction_1 sem_Instruction_StoreFloat32_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10763 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10768 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10773 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StoreFloat32_2 :: T_Instruction_2 sem_Instruction_StoreFloat32_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StoreFloat32 {-# LINE 10781 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10786 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10791 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StoreFloat32_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StoreFloat32_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StoreFloat64 :: T_Instruction sem_Instruction_StoreFloat64 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10806 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10811 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StoreFloat64_1 :: T_Instruction_1 sem_Instruction_StoreFloat64_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10821 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10826 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10831 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StoreFloat64_2 :: T_Instruction_2 sem_Instruction_StoreFloat64_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StoreFloat64 {-# LINE 10839 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10844 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10849 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StoreFloat64_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StoreFloat64_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StoreIndirect16 :: T_Instruction sem_Instruction_StoreIndirect16 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10864 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10869 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect16_1 :: T_Instruction_1 sem_Instruction_StoreIndirect16_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10879 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10884 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10889 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect16_2 :: T_Instruction_2 sem_Instruction_StoreIndirect16_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StoreIndirect16 {-# LINE 10897 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10902 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10907 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StoreIndirect16_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StoreIndirect16_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StoreIndirect32 :: T_Instruction sem_Instruction_StoreIndirect32 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10922 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10927 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect32_1 :: T_Instruction_1 sem_Instruction_StoreIndirect32_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10937 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 10942 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 10947 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect32_2 :: T_Instruction_2 sem_Instruction_StoreIndirect32_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StoreIndirect32 {-# LINE 10955 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 10960 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 10965 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StoreIndirect32_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StoreIndirect32_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StoreIndirect8 :: T_Instruction sem_Instruction_StoreIndirect8 = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 10980 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 10985 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect8_1 :: T_Instruction_1 sem_Instruction_StoreIndirect8_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 10995 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11000 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11005 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StoreIndirect8_2 :: T_Instruction_2 sem_Instruction_StoreIndirect8_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StoreIndirect8 {-# LINE 11013 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11018 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11023 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StoreIndirect8_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StoreIndirect8_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_StrictEquals :: T_Instruction sem_Instruction_StrictEquals = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11038 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11043 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_StrictEquals_1 :: T_Instruction_1 sem_Instruction_StrictEquals_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11053 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11058 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11063 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_StrictEquals_2 :: T_Instruction_2 sem_Instruction_StrictEquals_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_StrictEquals {-# LINE 11071 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11076 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11081 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_StrictEquals_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_StrictEquals_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Substract :: T_Instruction sem_Instruction_Substract = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11096 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11101 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Substract_1 :: T_Instruction_1 sem_Instruction_Substract_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11111 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11116 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11121 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Substract_2 :: T_Instruction_2 sem_Instruction_Substract_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Substract {-# LINE 11129 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11134 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11139 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Substract_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Substract_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Substract_i :: T_Instruction sem_Instruction_Substract_i = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11154 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11159 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Substract_i_1 :: T_Instruction_1 sem_Instruction_Substract_i_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11169 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11174 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11179 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Substract_i_2 :: T_Instruction_2 sem_Instruction_Substract_i_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Substract_i {-# LINE 11187 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11192 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11197 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Substract_i_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Substract_i_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Swap :: T_Instruction sem_Instruction_Swap = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11212 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11217 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Swap_1 :: T_Instruction_1 sem_Instruction_Swap_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11227 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11232 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11237 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Swap_2 :: T_Instruction_2 sem_Instruction_Swap_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Swap {-# LINE 11245 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11250 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11255 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Swap_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Swap_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Throw :: T_Instruction sem_Instruction_Throw = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11270 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11275 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Throw_1 :: T_Instruction_1 sem_Instruction_Throw_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11285 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11290 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11295 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Throw_2 :: T_Instruction_2 sem_Instruction_Throw_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Throw {-# LINE 11303 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11308 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11313 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Throw_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Throw_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Timestamp :: T_Instruction sem_Instruction_Timestamp = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11328 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11333 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Timestamp_1 :: T_Instruction_1 sem_Instruction_Timestamp_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11343 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11348 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11353 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Timestamp_2 :: T_Instruction_2 sem_Instruction_Timestamp_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Timestamp {-# LINE 11361 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11366 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11371 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Timestamp_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Timestamp_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_TypeOf :: T_Instruction sem_Instruction_TypeOf = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11386 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11391 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_TypeOf_1 :: T_Instruction_1 sem_Instruction_TypeOf_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11401 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11406 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11411 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_TypeOf_2 :: T_Instruction_2 sem_Instruction_TypeOf_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_TypeOf {-# LINE 11419 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11424 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11429 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_TypeOf_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_TypeOf_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) sem_Instruction_Urshift :: T_Instruction sem_Instruction_Urshift = (\ _lhsIlocation -> (case (({-# LINE 62 "src/InstrLocFilter.ag" #-} False {-# LINE 11444 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11449 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instruction_Urshift_1 :: T_Instruction_1 sem_Instruction_Urshift_1 = (\ _lhsIisBranch _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11459 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 63 "src/InstrLocFilter.ag" #-} False {-# LINE 11464 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11469 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instruction_Urshift_2 :: T_Instruction_2 sem_Instruction_Urshift_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Instruction_Urshift {-# LINE 11477 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11482 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> (case (({-# LINE 52 "src/InstrLocFilter.ag" #-} False {-# LINE 11487 "src/InstrLocFilter.hs" #-} )) of { _lhsOskip | _lhsOskip `seq` (True) -> ( _lhsOoutput,_lhsOskip) }) }) })) in sem_Instruction_Urshift_2)) of { ( sem_Instruction_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instruction_2) }) }) }) })) in sem_Instruction_Urshift_1)) of { ( sem_Instruction_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instruction_1) }) }) })) -- Instructions ------------------------------------------------ -- cata sem_Instructions :: Instructions -> T_Instructions sem_Instructions list = (Prelude.foldr sem_Instructions_Cons sem_Instructions_Nil (Prelude.map sem_Instruction list) ) -- semantic domain type T_Instructions = Bool -> Int -> ( Bool,Int,T_Instructions_1 ) type T_Instructions_1 = Bool -> Int -> ( IntSet,Bool,Int,T_Instructions_2 ) type T_Instructions_2 = IntSet -> ( Instructions ) sem_Instructions_Cons :: T_Instruction -> T_Instructions -> T_Instructions sem_Instructions_Cons hd_ tl_ = (\ _lhsIisBranch _lhsIlocation -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11520 "src/InstrLocFilter.hs" #-} )) of { _hdOlocation | _hdOlocation `seq` (True) -> (case (hd_ _hdOlocation ) of { ( _hdIisBranch,_hdIlocation,hd_1) | True -> (case (({-# LINE 59 "src/InstrLocFilter.ag" #-} _hdIisBranch {-# LINE 11527 "src/InstrLocFilter.hs" #-} )) of { _tlOisBranch | _tlOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _hdIlocation {-# LINE 11532 "src/InstrLocFilter.hs" #-} )) of { _tlOlocation | _tlOlocation `seq` (True) -> (case (tl_ _tlOisBranch _tlOlocation ) of { ( _tlIisBranch,_tlIlocation,tl_1) | True -> (case (({-# LINE 59 "src/InstrLocFilter.ag" #-} _tlIisBranch {-# LINE 11539 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _tlIlocation {-# LINE 11544 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instructions_Cons_1 :: T_Instructions_1 sem_Instructions_Cons_1 = (\ _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 59 "src/InstrLocFilter.ag" #-} _lhsIisBranch {-# LINE 11553 "src/InstrLocFilter.hs" #-} )) of { _hdOisBranch | _hdOisBranch `seq` (True) -> (case (({-# LINE 13 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11558 "src/InstrLocFilter.hs" #-} )) of { _tlOrevLocation | _tlOrevLocation `seq` (True) -> (case (({-# LINE 69 "src/InstrLocFilter.ag" #-} _lhsIrevIsBranch {-# LINE 11563 "src/InstrLocFilter.hs" #-} )) of { _tlOrevIsBranch | _tlOrevIsBranch `seq` (True) -> (case (tl_1 _tlOrevIsBranch _tlOrevLocation ) of { ( _tlIlocs,_tlIrevIsBranch,_tlIrevLocation,tl_2) | True -> (case (({-# LINE 14 "src/ByteCodeLocationInfo.ag" #-} _tlIrevLocation {-# LINE 11570 "src/InstrLocFilter.hs" #-} )) of { _hdOrevLocation | _hdOrevLocation `seq` (True) -> (case (({-# LINE 70 "src/InstrLocFilter.ag" #-} _tlIrevIsBranch {-# LINE 11575 "src/InstrLocFilter.hs" #-} )) of { _hdOrevIsBranch | _hdOrevIsBranch `seq` (True) -> (case (hd_1 _hdOisBranch _hdOrevIsBranch _hdOrevLocation ) of { ( _hdIlocs,_hdIrevIsBranch,_hdIrevLocation,hd_2) | True -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} _hdIlocs `mappend` _tlIlocs {-# LINE 11582 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 71 "src/InstrLocFilter.ag" #-} _hdIrevIsBranch {-# LINE 11587 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 15 "src/ByteCodeLocationInfo.ag" #-} _hdIrevLocation {-# LINE 11592 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instructions_Cons_2 :: T_Instructions_2 sem_Instructions_Cons_2 = (\ _lhsIretain -> (case (({-# LINE 45 "src/InstrLocFilter.ag" #-} _lhsIretain {-# LINE 11600 "src/InstrLocFilter.hs" #-} )) of { _tlOretain | _tlOretain `seq` (True) -> (case (({-# LINE 45 "src/InstrLocFilter.ag" #-} _lhsIretain {-# LINE 11605 "src/InstrLocFilter.hs" #-} )) of { _hdOretain | _hdOretain `seq` (True) -> (case (tl_2 _tlOretain ) of { ( _tlIoutput) | True -> (case (hd_2 _hdOretain ) of { ( _hdIoutput,_hdIskip) | True -> (case (({-# LINE 42 "src/InstrLocFilter.ag" #-} if _hdIskip then _tlIoutput else _hdIoutput : _tlIoutput {-# LINE 11614 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) }) })) in sem_Instructions_Cons_2)) of { ( sem_Instructions_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instructions_2) }) }) }) }) }) }) }) }) }) }) })) in sem_Instructions_Cons_1)) of { ( sem_Instructions_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instructions_1) }) }) }) }) }) }) }) })) sem_Instructions_Nil :: T_Instructions sem_Instructions_Nil = (\ _lhsIisBranch _lhsIlocation -> (case (({-# LINE 59 "src/InstrLocFilter.ag" #-} _lhsIisBranch {-# LINE 11630 "src/InstrLocFilter.hs" #-} )) of { _lhsOisBranch | _lhsOisBranch `seq` (True) -> (case (({-# LINE 6 "src/ByteCodeLocationInfo.ag" #-} _lhsIlocation {-# LINE 11635 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocation | _lhsOlocation `seq` (True) -> (case ((let sem_Instructions_Nil_1 :: T_Instructions_1 sem_Instructions_Nil_1 = (\ _lhsIrevIsBranch _lhsIrevLocation -> (case (({-# LINE 74 "src/InstrLocFilter.ag" #-} mempty {-# LINE 11644 "src/InstrLocFilter.hs" #-} )) of { _lhsOlocs | _lhsOlocs `seq` (True) -> (case (({-# LINE 59 "src/InstrLocFilter.ag" #-} _lhsIrevIsBranch {-# LINE 11649 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevIsBranch | _lhsOrevIsBranch `seq` (True) -> (case (({-# LINE 10 "src/ByteCodeLocationInfo.ag" #-} _lhsIrevLocation {-# LINE 11654 "src/InstrLocFilter.hs" #-} )) of { _lhsOrevLocation | _lhsOrevLocation `seq` (True) -> (case ((let sem_Instructions_Nil_2 :: T_Instructions_2 sem_Instructions_Nil_2 = (\ _lhsIretain -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 11662 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 11667 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) })) in sem_Instructions_Nil_2)) of { ( sem_Instructions_2) | True -> ( _lhsOlocs,_lhsOrevIsBranch,_lhsOrevLocation,sem_Instructions_2) }) }) }) })) in sem_Instructions_Nil_1)) of { ( sem_Instructions_1) | True -> ( _lhsOisBranch,_lhsOlocation,sem_Instructions_1) }) }) })) -- Interfaces -------------------------------------------------- -- cata sem_Interfaces :: Interfaces -> T_Interfaces sem_Interfaces list = (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil list ) -- semantic domain type T_Interfaces = ( ) sem_Interfaces_Cons :: Word32 -> T_Interfaces -> T_Interfaces sem_Interfaces_Cons hd_ tl_ = ( ) sem_Interfaces_Nil :: T_Interfaces sem_Interfaces_Nil = ( ) -- MetaInfo ---------------------------------------------------- -- cata sem_MetaInfo :: MetaInfo -> T_MetaInfo sem_MetaInfo (MetaInfo_Info _name _items ) = (sem_MetaInfo_Info _name (sem_MetaItems _items ) ) -- semantic domain type T_MetaInfo = ( ) sem_MetaInfo_Info :: Word32 -> T_MetaItems -> T_MetaInfo sem_MetaInfo_Info name_ items_ = ( ) -- MetaInfos --------------------------------------------------- -- cata sem_MetaInfos :: MetaInfos -> T_MetaInfos sem_MetaInfos list = (Prelude.foldr sem_MetaInfos_Cons sem_MetaInfos_Nil (Prelude.map sem_MetaInfo list) ) -- semantic domain type T_MetaInfos = ( ) sem_MetaInfos_Cons :: T_MetaInfo -> T_MetaInfos -> T_MetaInfos sem_MetaInfos_Cons hd_ tl_ = ( ) sem_MetaInfos_Nil :: T_MetaInfos sem_MetaInfos_Nil = ( ) -- MetaItem ---------------------------------------------------- -- cata sem_MetaItem :: MetaItem -> T_MetaItem sem_MetaItem (MetaItem_Item _key _value ) = (sem_MetaItem_Item _key _value ) -- semantic domain type T_MetaItem = ( ) sem_MetaItem_Item :: Word32 -> Word32 -> T_MetaItem sem_MetaItem_Item key_ value_ = ( ) -- MetaItems --------------------------------------------------- -- cata sem_MetaItems :: MetaItems -> T_MetaItems sem_MetaItems list = (Prelude.foldr sem_MetaItems_Cons sem_MetaItems_Nil (Prelude.map sem_MetaItem list) ) -- semantic domain type T_MetaItems = ( ) sem_MetaItems_Cons :: T_MetaItem -> T_MetaItems -> T_MetaItems sem_MetaItems_Cons hd_ tl_ = ( ) sem_MetaItems_Nil :: T_MetaItems sem_MetaItems_Nil = ( ) -- MethodFlag -------------------------------------------------- -- cata sem_MethodFlag :: MethodFlag -> T_MethodFlag sem_MethodFlag (MethodFlag_HasOptionals ) = (sem_MethodFlag_HasOptionals ) sem_MethodFlag (MethodFlag_HasParamNames ) = (sem_MethodFlag_HasParamNames ) sem_MethodFlag (MethodFlag_NeedAct ) = (sem_MethodFlag_NeedAct ) sem_MethodFlag (MethodFlag_NeedArgs ) = (sem_MethodFlag_NeedArgs ) sem_MethodFlag (MethodFlag_NeedRest ) = (sem_MethodFlag_NeedRest ) sem_MethodFlag (MethodFlag_SetDXNS ) = (sem_MethodFlag_SetDXNS ) -- semantic domain type T_MethodFlag = ( ) sem_MethodFlag_HasOptionals :: T_MethodFlag sem_MethodFlag_HasOptionals = ( ) sem_MethodFlag_HasParamNames :: T_MethodFlag sem_MethodFlag_HasParamNames = ( ) sem_MethodFlag_NeedAct :: T_MethodFlag sem_MethodFlag_NeedAct = ( ) sem_MethodFlag_NeedArgs :: T_MethodFlag sem_MethodFlag_NeedArgs = ( ) sem_MethodFlag_NeedRest :: T_MethodFlag sem_MethodFlag_NeedRest = ( ) sem_MethodFlag_SetDXNS :: T_MethodFlag sem_MethodFlag_SetDXNS = ( ) -- MethodFlags ------------------------------------------------- -- cata sem_MethodFlags :: MethodFlags -> T_MethodFlags sem_MethodFlags list = (Prelude.foldr sem_MethodFlags_Cons sem_MethodFlags_Nil (Prelude.map sem_MethodFlag list) ) -- semantic domain type T_MethodFlags = ( ) sem_MethodFlags_Cons :: T_MethodFlag -> T_MethodFlags -> T_MethodFlags sem_MethodFlags_Cons hd_ tl_ = ( ) sem_MethodFlags_Nil :: T_MethodFlags sem_MethodFlags_Nil = ( ) -- MethodInfo -------------------------------------------------- -- cata sem_MethodInfo :: MethodInfo -> T_MethodInfo sem_MethodInfo (MethodInfo_Info _return _params _name _flags _options _names ) = (sem_MethodInfo_Info _return (sem_ParamTypes _params ) _name (sem_MethodFlags _flags ) (sem_Optionals _options ) (sem_ParamNames _names ) ) -- semantic domain type T_MethodInfo = ( ) sem_MethodInfo_Info :: Word32 -> T_ParamTypes -> Word32 -> T_MethodFlags -> T_Optionals -> T_ParamNames -> T_MethodInfo sem_MethodInfo_Info return_ params_ name_ flags_ options_ names_ = ( ) -- MethodInfos ------------------------------------------------- -- cata sem_MethodInfos :: MethodInfos -> T_MethodInfos sem_MethodInfos list = (Prelude.foldr sem_MethodInfos_Cons sem_MethodInfos_Nil (Prelude.map sem_MethodInfo list) ) -- semantic domain type T_MethodInfos = ( ) sem_MethodInfos_Cons :: T_MethodInfo -> T_MethodInfos -> T_MethodInfos sem_MethodInfos_Cons hd_ tl_ = ( ) sem_MethodInfos_Nil :: T_MethodInfos sem_MethodInfos_Nil = ( ) -- MultinameInfo ----------------------------------------------- -- cata sem_MultinameInfo :: MultinameInfo -> T_MultinameInfo sem_MultinameInfo (MultinameInfo_Generic _name _params ) = (sem_MultinameInfo_Generic _name (sem_ParamNames _params ) ) sem_MultinameInfo (MultinameInfo_Multiname _name _set ) = (sem_MultinameInfo_Multiname _name _set ) sem_MultinameInfo (MultinameInfo_MultinameA _name _set ) = (sem_MultinameInfo_MultinameA _name _set ) sem_MultinameInfo (MultinameInfo_MultinameL _set ) = (sem_MultinameInfo_MultinameL _set ) sem_MultinameInfo (MultinameInfo_MultinameLA _set ) = (sem_MultinameInfo_MultinameLA _set ) sem_MultinameInfo (MultinameInfo_QName _namespace _name ) = (sem_MultinameInfo_QName _namespace _name ) sem_MultinameInfo (MultinameInfo_QNameA _namespace _name ) = (sem_MultinameInfo_QNameA _namespace _name ) sem_MultinameInfo (MultinameInfo_RTQName _name ) = (sem_MultinameInfo_RTQName _name ) sem_MultinameInfo (MultinameInfo_RTQNameA _name ) = (sem_MultinameInfo_RTQNameA _name ) sem_MultinameInfo (MultinameInfo_RTQNameL ) = (sem_MultinameInfo_RTQNameL ) sem_MultinameInfo (MultinameInfo_RTQNameLA ) = (sem_MultinameInfo_RTQNameLA ) -- semantic domain type T_MultinameInfo = ( ) sem_MultinameInfo_Generic :: Word32 -> T_ParamNames -> T_MultinameInfo sem_MultinameInfo_Generic name_ params_ = ( ) sem_MultinameInfo_Multiname :: Word32 -> Word32 -> T_MultinameInfo sem_MultinameInfo_Multiname name_ set_ = ( ) sem_MultinameInfo_MultinameA :: Word32 -> Word32 -> T_MultinameInfo sem_MultinameInfo_MultinameA name_ set_ = ( ) sem_MultinameInfo_MultinameL :: Word32 -> T_MultinameInfo sem_MultinameInfo_MultinameL set_ = ( ) sem_MultinameInfo_MultinameLA :: Word32 -> T_MultinameInfo sem_MultinameInfo_MultinameLA set_ = ( ) sem_MultinameInfo_QName :: Word32 -> Word32 -> T_MultinameInfo sem_MultinameInfo_QName namespace_ name_ = ( ) sem_MultinameInfo_QNameA :: Word32 -> Word32 -> T_MultinameInfo sem_MultinameInfo_QNameA namespace_ name_ = ( ) sem_MultinameInfo_RTQName :: Word32 -> T_MultinameInfo sem_MultinameInfo_RTQName name_ = ( ) sem_MultinameInfo_RTQNameA :: Word32 -> T_MultinameInfo sem_MultinameInfo_RTQNameA name_ = ( ) sem_MultinameInfo_RTQNameL :: T_MultinameInfo sem_MultinameInfo_RTQNameL = ( ) sem_MultinameInfo_RTQNameLA :: T_MultinameInfo sem_MultinameInfo_RTQNameLA = ( ) -- MultinameInfos ---------------------------------------------- -- cata sem_MultinameInfos :: MultinameInfos -> T_MultinameInfos sem_MultinameInfos list = (Prelude.foldr sem_MultinameInfos_Cons sem_MultinameInfos_Nil (Prelude.map sem_MultinameInfo list) ) -- semantic domain type T_MultinameInfos = ( ) sem_MultinameInfos_Cons :: T_MultinameInfo -> T_MultinameInfos -> T_MultinameInfos sem_MultinameInfos_Cons hd_ tl_ = ( ) sem_MultinameInfos_Nil :: T_MultinameInfos sem_MultinameInfos_Nil = ( ) -- MultinameKind ----------------------------------------------- -- cata sem_MultinameKind :: MultinameKind -> T_MultinameKind sem_MultinameKind (MultinameKind_Generic ) = (sem_MultinameKind_Generic ) sem_MultinameKind (MultinameKind_Multiname ) = (sem_MultinameKind_Multiname ) sem_MultinameKind (MultinameKind_MultinameA ) = (sem_MultinameKind_MultinameA ) sem_MultinameKind (MultinameKind_MultinameL ) = (sem_MultinameKind_MultinameL ) sem_MultinameKind (MultinameKind_MultinameLA ) = (sem_MultinameKind_MultinameLA ) sem_MultinameKind (MultinameKind_QName ) = (sem_MultinameKind_QName ) sem_MultinameKind (MultinameKind_QNameA ) = (sem_MultinameKind_QNameA ) sem_MultinameKind (MultinameKind_RTQName ) = (sem_MultinameKind_RTQName ) sem_MultinameKind (MultinameKind_RTQNameA ) = (sem_MultinameKind_RTQNameA ) sem_MultinameKind (MultinameKind_RTQNameL ) = (sem_MultinameKind_RTQNameL ) sem_MultinameKind (MultinameKind_RTQNameLA ) = (sem_MultinameKind_RTQNameLA ) -- semantic domain type T_MultinameKind = ( ) sem_MultinameKind_Generic :: T_MultinameKind sem_MultinameKind_Generic = ( ) sem_MultinameKind_Multiname :: T_MultinameKind sem_MultinameKind_Multiname = ( ) sem_MultinameKind_MultinameA :: T_MultinameKind sem_MultinameKind_MultinameA = ( ) sem_MultinameKind_MultinameL :: T_MultinameKind sem_MultinameKind_MultinameL = ( ) sem_MultinameKind_MultinameLA :: T_MultinameKind sem_MultinameKind_MultinameLA = ( ) sem_MultinameKind_QName :: T_MultinameKind sem_MultinameKind_QName = ( ) sem_MultinameKind_QNameA :: T_MultinameKind sem_MultinameKind_QNameA = ( ) sem_MultinameKind_RTQName :: T_MultinameKind sem_MultinameKind_RTQName = ( ) sem_MultinameKind_RTQNameA :: T_MultinameKind sem_MultinameKind_RTQNameA = ( ) sem_MultinameKind_RTQNameL :: T_MultinameKind sem_MultinameKind_RTQNameL = ( ) sem_MultinameKind_RTQNameLA :: T_MultinameKind sem_MultinameKind_RTQNameLA = ( ) -- NamespaceInfo ----------------------------------------------- -- cata sem_NamespaceInfo :: NamespaceInfo -> T_NamespaceInfo sem_NamespaceInfo (NamespaceInfo_Info _kind _name ) = (sem_NamespaceInfo_Info (sem_NamespaceKind _kind ) _name ) -- semantic domain type T_NamespaceInfo = ( ) sem_NamespaceInfo_Info :: T_NamespaceKind -> Word32 -> T_NamespaceInfo sem_NamespaceInfo_Info kind_ name_ = ( ) -- NamespaceInfos ---------------------------------------------- -- cata sem_NamespaceInfos :: NamespaceInfos -> T_NamespaceInfos sem_NamespaceInfos list = (Prelude.foldr sem_NamespaceInfos_Cons sem_NamespaceInfos_Nil (Prelude.map sem_NamespaceInfo list) ) -- semantic domain type T_NamespaceInfos = ( ) sem_NamespaceInfos_Cons :: T_NamespaceInfo -> T_NamespaceInfos -> T_NamespaceInfos sem_NamespaceInfos_Cons hd_ tl_ = ( ) sem_NamespaceInfos_Nil :: T_NamespaceInfos sem_NamespaceInfos_Nil = ( ) -- NamespaceKind ----------------------------------------------- -- cata sem_NamespaceKind :: NamespaceKind -> T_NamespaceKind sem_NamespaceKind (NamespaceKind_Explicit ) = (sem_NamespaceKind_Explicit ) sem_NamespaceKind (NamespaceKind_General ) = (sem_NamespaceKind_General ) sem_NamespaceKind (NamespaceKind_Internal ) = (sem_NamespaceKind_Internal ) sem_NamespaceKind (NamespaceKind_Package ) = (sem_NamespaceKind_Package ) sem_NamespaceKind (NamespaceKind_Private ) = (sem_NamespaceKind_Private ) sem_NamespaceKind (NamespaceKind_Protected ) = (sem_NamespaceKind_Protected ) sem_NamespaceKind (NamespaceKind_Static ) = (sem_NamespaceKind_Static ) -- semantic domain type T_NamespaceKind = ( ) sem_NamespaceKind_Explicit :: T_NamespaceKind sem_NamespaceKind_Explicit = ( ) sem_NamespaceKind_General :: T_NamespaceKind sem_NamespaceKind_General = ( ) sem_NamespaceKind_Internal :: T_NamespaceKind sem_NamespaceKind_Internal = ( ) sem_NamespaceKind_Package :: T_NamespaceKind sem_NamespaceKind_Package = ( ) sem_NamespaceKind_Private :: T_NamespaceKind sem_NamespaceKind_Private = ( ) sem_NamespaceKind_Protected :: T_NamespaceKind sem_NamespaceKind_Protected = ( ) sem_NamespaceKind_Static :: T_NamespaceKind sem_NamespaceKind_Static = ( ) -- NamespaceNames ---------------------------------------------- -- cata sem_NamespaceNames :: NamespaceNames -> T_NamespaceNames sem_NamespaceNames list = (Prelude.foldr sem_NamespaceNames_Cons sem_NamespaceNames_Nil list ) -- semantic domain type T_NamespaceNames = ( ) sem_NamespaceNames_Cons :: Word32 -> T_NamespaceNames -> T_NamespaceNames sem_NamespaceNames_Cons hd_ tl_ = ( ) sem_NamespaceNames_Nil :: T_NamespaceNames sem_NamespaceNames_Nil = ( ) -- Optional ---------------------------------------------------- -- cata sem_Optional :: Optional -> T_Optional sem_Optional (Optional_Detail _val _kind ) = (sem_Optional_Detail _val (sem_ValueKind _kind ) ) -- semantic domain type T_Optional = ( ) sem_Optional_Detail :: Word32 -> T_ValueKind -> T_Optional sem_Optional_Detail val_ kind_ = ( ) -- Optionals --------------------------------------------------- -- cata sem_Optionals :: Optionals -> T_Optionals sem_Optionals list = (Prelude.foldr sem_Optionals_Cons sem_Optionals_Nil (Prelude.map sem_Optional list) ) -- semantic domain type T_Optionals = ( ) sem_Optionals_Cons :: T_Optional -> T_Optionals -> T_Optionals sem_Optionals_Cons hd_ tl_ = ( ) sem_Optionals_Nil :: T_Optionals sem_Optionals_Nil = ( ) -- ParamNames -------------------------------------------------- -- cata sem_ParamNames :: ParamNames -> T_ParamNames sem_ParamNames list = (Prelude.foldr sem_ParamNames_Cons sem_ParamNames_Nil list ) -- semantic domain type T_ParamNames = ( ) sem_ParamNames_Cons :: Word32 -> T_ParamNames -> T_ParamNames sem_ParamNames_Cons hd_ tl_ = ( ) sem_ParamNames_Nil :: T_ParamNames sem_ParamNames_Nil = ( ) -- ParamTypes -------------------------------------------------- -- cata sem_ParamTypes :: ParamTypes -> T_ParamTypes sem_ParamTypes list = (Prelude.foldr sem_ParamTypes_Cons sem_ParamTypes_Nil list ) -- semantic domain type T_ParamTypes = ( ) sem_ParamTypes_Cons :: Word32 -> T_ParamTypes -> T_ParamTypes sem_ParamTypes_Cons hd_ tl_ = ( ) sem_ParamTypes_Nil :: T_ParamTypes sem_ParamTypes_Nil = ( ) -- PoolDoubles ------------------------------------------------- -- cata sem_PoolDoubles :: PoolDoubles -> T_PoolDoubles sem_PoolDoubles list = (Prelude.foldr sem_PoolDoubles_Cons sem_PoolDoubles_Nil list ) -- semantic domain type T_PoolDoubles = ( ) sem_PoolDoubles_Cons :: Double -> T_PoolDoubles -> T_PoolDoubles sem_PoolDoubles_Cons hd_ tl_ = ( ) sem_PoolDoubles_Nil :: T_PoolDoubles sem_PoolDoubles_Nil = ( ) -- PoolInfo ---------------------------------------------------- -- cata sem_PoolInfo :: PoolInfo -> T_PoolInfo sem_PoolInfo (PoolInfo_Info _integers _uintegers _doubles _strings _namespaces _namesets _multinames ) = (sem_PoolInfo_Info (sem_PoolInts _integers ) (sem_PoolUInts _uintegers ) (sem_PoolDoubles _doubles ) (sem_PoolStrings _strings ) (sem_NamespaceInfos _namespaces ) (sem_SetInfos _namesets ) (sem_MultinameInfos _multinames ) ) -- semantic domain type T_PoolInfo = ( ) sem_PoolInfo_Info :: T_PoolInts -> T_PoolUInts -> T_PoolDoubles -> T_PoolStrings -> T_NamespaceInfos -> T_SetInfos -> T_MultinameInfos -> T_PoolInfo sem_PoolInfo_Info integers_ uintegers_ doubles_ strings_ namespaces_ namesets_ multinames_ = ( ) -- PoolInts ---------------------------------------------------- -- cata sem_PoolInts :: PoolInts -> T_PoolInts sem_PoolInts list = (Prelude.foldr sem_PoolInts_Cons sem_PoolInts_Nil list ) -- semantic domain type T_PoolInts = ( ) sem_PoolInts_Cons :: Word32 -> T_PoolInts -> T_PoolInts sem_PoolInts_Cons hd_ tl_ = ( ) sem_PoolInts_Nil :: T_PoolInts sem_PoolInts_Nil = ( ) -- PoolStrings ------------------------------------------------- -- cata sem_PoolStrings :: PoolStrings -> T_PoolStrings sem_PoolStrings list = (Prelude.foldr sem_PoolStrings_Cons sem_PoolStrings_Nil list ) -- semantic domain type T_PoolStrings = ( ) sem_PoolStrings_Cons :: ByteString -> T_PoolStrings -> T_PoolStrings sem_PoolStrings_Cons hd_ tl_ = ( ) sem_PoolStrings_Nil :: T_PoolStrings sem_PoolStrings_Nil = ( ) -- PoolUInts --------------------------------------------------- -- cata sem_PoolUInts :: PoolUInts -> T_PoolUInts sem_PoolUInts list = (Prelude.foldr sem_PoolUInts_Cons sem_PoolUInts_Nil list ) -- semantic domain type T_PoolUInts = ( ) sem_PoolUInts_Cons :: Word32 -> T_PoolUInts -> T_PoolUInts sem_PoolUInts_Cons hd_ tl_ = ( ) sem_PoolUInts_Nil :: T_PoolUInts sem_PoolUInts_Nil = ( ) -- Rect -------------------------------------------------------- -- cata sem_Rect :: Rect -> T_Rect sem_Rect (Rect_Rect _bits _xMin _xMax _yMin _yMax ) = (sem_Rect_Rect _bits _xMin _xMax _yMin _yMax ) -- semantic domain type T_Rect = ( ) sem_Rect_Rect :: Int -> Word32 -> Word32 -> Word32 -> Word32 -> T_Rect sem_Rect_Rect bits_ xMin_ xMax_ yMin_ yMax_ = ( ) -- ScriptInfo -------------------------------------------------- -- cata sem_ScriptInfo :: ScriptInfo -> T_ScriptInfo sem_ScriptInfo (ScriptInfo_Info _method _traits ) = (sem_ScriptInfo_Info _method (sem_Traits _traits ) ) -- semantic domain type T_ScriptInfo = ( ) sem_ScriptInfo_Info :: Word32 -> T_Traits -> T_ScriptInfo sem_ScriptInfo_Info method_ traits_ = ( ) -- ScriptInfos ------------------------------------------------- -- cata sem_ScriptInfos :: ScriptInfos -> T_ScriptInfos sem_ScriptInfos list = (Prelude.foldr sem_ScriptInfos_Cons sem_ScriptInfos_Nil (Prelude.map sem_ScriptInfo list) ) -- semantic domain type T_ScriptInfos = ( ) sem_ScriptInfos_Cons :: T_ScriptInfo -> T_ScriptInfos -> T_ScriptInfos sem_ScriptInfos_Cons hd_ tl_ = ( ) sem_ScriptInfos_Nil :: T_ScriptInfos sem_ScriptInfos_Nil = ( ) -- SetInfo ----------------------------------------------------- -- cata sem_SetInfo :: SetInfo -> T_SetInfo sem_SetInfo (SetInfo_Info _names ) = (sem_SetInfo_Info (sem_NamespaceNames _names ) ) -- semantic domain type T_SetInfo = ( ) sem_SetInfo_Info :: T_NamespaceNames -> T_SetInfo sem_SetInfo_Info names_ = ( ) -- SetInfos ---------------------------------------------------- -- cata sem_SetInfos :: SetInfos -> T_SetInfos sem_SetInfos list = (Prelude.foldr sem_SetInfos_Cons sem_SetInfos_Nil (Prelude.map sem_SetInfo list) ) -- semantic domain type T_SetInfos = ( ) sem_SetInfos_Cons :: T_SetInfo -> T_SetInfos -> T_SetInfos sem_SetInfos_Cons hd_ tl_ = ( ) sem_SetInfos_Nil :: T_SetInfos sem_SetInfos_Nil = ( ) -- SwfFile ----------------------------------------------------- -- cata sem_SwfFile :: SwfFile -> T_SwfFile sem_SwfFile (SwfFile_File _compressed _version _length _size _rate _count _tags ) = (sem_SwfFile_File _compressed _version _length (sem_Rect _size ) _rate _count (sem_Tags _tags ) ) -- semantic domain type T_SwfFile = ( ) sem_SwfFile_File :: Bool -> Word8 -> Word32 -> T_Rect -> Word16 -> Word16 -> T_Tags -> T_SwfFile sem_SwfFile_File compressed_ version_ length_ size_ rate_ count_ tags_ = ( ) -- Tag --------------------------------------------------------- -- cata sem_Tag :: Tag -> T_Tag sem_Tag (Tag_Abc _flags _name _file ) = (sem_Tag_Abc (sem_AbcFlags _flags ) _name (sem_AbcFile _file ) ) sem_Tag (Tag_End ) = (sem_Tag_End ) sem_Tag (Tag_FileAttributes _useDirectBlit _useGPU _hasMetaData _hasAS3 _useNetwork ) = (sem_Tag_FileAttributes _useDirectBlit _useGPU _hasMetaData _hasAS3 _useNetwork ) sem_Tag (Tag_Opaque _kind _length _body ) = (sem_Tag_Opaque (sem_TagKind _kind ) _length _body ) -- semantic domain type T_Tag = ( ) sem_Tag_Abc :: T_AbcFlags -> ByteString -> T_AbcFile -> T_Tag sem_Tag_Abc flags_ name_ file_ = ( ) sem_Tag_End :: T_Tag sem_Tag_End = ( ) sem_Tag_FileAttributes :: Bool -> Bool -> Bool -> Bool -> Bool -> T_Tag sem_Tag_FileAttributes useDirectBlit_ useGPU_ hasMetaData_ hasAS3_ useNetwork_ = ( ) sem_Tag_Opaque :: T_TagKind -> Word32 -> ByteString -> T_Tag sem_Tag_Opaque kind_ length_ body_ = ( ) -- TagKind ----------------------------------------------------- -- cata sem_TagKind :: TagKind -> T_TagKind sem_TagKind (TagKind_CSMTextSettings ) = (sem_TagKind_CSMTextSettings ) sem_TagKind (TagKind_DefineBinaryData ) = (sem_TagKind_DefineBinaryData ) sem_TagKind (TagKind_DefineBits ) = (sem_TagKind_DefineBits ) sem_TagKind (TagKind_DefineBitsJPEG2 ) = (sem_TagKind_DefineBitsJPEG2 ) sem_TagKind (TagKind_DefineBitsJPEG3 ) = (sem_TagKind_DefineBitsJPEG3 ) sem_TagKind (TagKind_DefineBitsJPEG4 ) = (sem_TagKind_DefineBitsJPEG4 ) sem_TagKind (TagKind_DefineBitsLossless ) = (sem_TagKind_DefineBitsLossless ) sem_TagKind (TagKind_DefineBitsLossless2 ) = (sem_TagKind_DefineBitsLossless2 ) sem_TagKind (TagKind_DefineButton ) = (sem_TagKind_DefineButton ) sem_TagKind (TagKind_DefineButton2 ) = (sem_TagKind_DefineButton2 ) sem_TagKind (TagKind_DefineButtonCxform ) = (sem_TagKind_DefineButtonCxform ) sem_TagKind (TagKind_DefineButtonSound ) = (sem_TagKind_DefineButtonSound ) sem_TagKind (TagKind_DefineEditText ) = (sem_TagKind_DefineEditText ) sem_TagKind (TagKind_DefineFont ) = (sem_TagKind_DefineFont ) sem_TagKind (TagKind_DefineFont2 ) = (sem_TagKind_DefineFont2 ) sem_TagKind (TagKind_DefineFont3 ) = (sem_TagKind_DefineFont3 ) sem_TagKind (TagKind_DefineFont4 ) = (sem_TagKind_DefineFont4 ) sem_TagKind (TagKind_DefineFontAlignZones ) = (sem_TagKind_DefineFontAlignZones ) sem_TagKind (TagKind_DefineFontInfo ) = (sem_TagKind_DefineFontInfo ) sem_TagKind (TagKind_DefineFontInfo2 ) = (sem_TagKind_DefineFontInfo2 ) sem_TagKind (TagKind_DefineFontName ) = (sem_TagKind_DefineFontName ) sem_TagKind (TagKind_DefineMorphShape ) = (sem_TagKind_DefineMorphShape ) sem_TagKind (TagKind_DefineMorphShape2 ) = (sem_TagKind_DefineMorphShape2 ) sem_TagKind (TagKind_DefineScalingGrid ) = (sem_TagKind_DefineScalingGrid ) sem_TagKind (TagKind_DefineSceneAndFrameLabelData ) = (sem_TagKind_DefineSceneAndFrameLabelData ) sem_TagKind (TagKind_DefineShape ) = (sem_TagKind_DefineShape ) sem_TagKind (TagKind_DefineShape2 ) = (sem_TagKind_DefineShape2 ) sem_TagKind (TagKind_DefineShape3 ) = (sem_TagKind_DefineShape3 ) sem_TagKind (TagKind_DefineShape4 ) = (sem_TagKind_DefineShape4 ) sem_TagKind (TagKind_DefineSound ) = (sem_TagKind_DefineSound ) sem_TagKind (TagKind_DefineSprite ) = (sem_TagKind_DefineSprite ) sem_TagKind (TagKind_DefineText ) = (sem_TagKind_DefineText ) sem_TagKind (TagKind_DefineText2 ) = (sem_TagKind_DefineText2 ) sem_TagKind (TagKind_DefineVideoStream ) = (sem_TagKind_DefineVideoStream ) sem_TagKind (TagKind_DoABC ) = (sem_TagKind_DoABC ) sem_TagKind (TagKind_DoAction ) = (sem_TagKind_DoAction ) sem_TagKind (TagKind_DoInitAction ) = (sem_TagKind_DoInitAction ) sem_TagKind (TagKind_EnableDebugger ) = (sem_TagKind_EnableDebugger ) sem_TagKind (TagKind_EnableDebugger2 ) = (sem_TagKind_EnableDebugger2 ) sem_TagKind (TagKind_End ) = (sem_TagKind_End ) sem_TagKind (TagKind_ExportAssets ) = (sem_TagKind_ExportAssets ) sem_TagKind (TagKind_FileAttributes ) = (sem_TagKind_FileAttributes ) sem_TagKind (TagKind_FrameLabel ) = (sem_TagKind_FrameLabel ) sem_TagKind (TagKind_ImportAssets ) = (sem_TagKind_ImportAssets ) sem_TagKind (TagKind_ImportAssets2 ) = (sem_TagKind_ImportAssets2 ) sem_TagKind (TagKind_JPEGTables ) = (sem_TagKind_JPEGTables ) sem_TagKind (TagKind_Metadata ) = (sem_TagKind_Metadata ) sem_TagKind (TagKind_Other _code ) = (sem_TagKind_Other _code ) sem_TagKind (TagKind_PlaceObject ) = (sem_TagKind_PlaceObject ) sem_TagKind (TagKind_PlaceObject2 ) = (sem_TagKind_PlaceObject2 ) sem_TagKind (TagKind_PlaceObject3 ) = (sem_TagKind_PlaceObject3 ) sem_TagKind (TagKind_Protect ) = (sem_TagKind_Protect ) sem_TagKind (TagKind_RemoveObject ) = (sem_TagKind_RemoveObject ) sem_TagKind (TagKind_RemoveObject2 ) = (sem_TagKind_RemoveObject2 ) sem_TagKind (TagKind_ScriptLimits ) = (sem_TagKind_ScriptLimits ) sem_TagKind (TagKind_SetBackgroundColor ) = (sem_TagKind_SetBackgroundColor ) sem_TagKind (TagKind_SetTabIndex ) = (sem_TagKind_SetTabIndex ) sem_TagKind (TagKind_ShowFrame ) = (sem_TagKind_ShowFrame ) sem_TagKind (TagKind_SoundStreamBlock ) = (sem_TagKind_SoundStreamBlock ) sem_TagKind (TagKind_SoundStreamHead ) = (sem_TagKind_SoundStreamHead ) sem_TagKind (TagKind_SoundStreamHead2 ) = (sem_TagKind_SoundStreamHead2 ) sem_TagKind (TagKind_StartSound ) = (sem_TagKind_StartSound ) sem_TagKind (TagKind_StartSound2 ) = (sem_TagKind_StartSound2 ) sem_TagKind (TagKind_SymbolClass ) = (sem_TagKind_SymbolClass ) sem_TagKind (TagKind_VideoFrame ) = (sem_TagKind_VideoFrame ) -- semantic domain type T_TagKind = ( ) sem_TagKind_CSMTextSettings :: T_TagKind sem_TagKind_CSMTextSettings = ( ) sem_TagKind_DefineBinaryData :: T_TagKind sem_TagKind_DefineBinaryData = ( ) sem_TagKind_DefineBits :: T_TagKind sem_TagKind_DefineBits = ( ) sem_TagKind_DefineBitsJPEG2 :: T_TagKind sem_TagKind_DefineBitsJPEG2 = ( ) sem_TagKind_DefineBitsJPEG3 :: T_TagKind sem_TagKind_DefineBitsJPEG3 = ( ) sem_TagKind_DefineBitsJPEG4 :: T_TagKind sem_TagKind_DefineBitsJPEG4 = ( ) sem_TagKind_DefineBitsLossless :: T_TagKind sem_TagKind_DefineBitsLossless = ( ) sem_TagKind_DefineBitsLossless2 :: T_TagKind sem_TagKind_DefineBitsLossless2 = ( ) sem_TagKind_DefineButton :: T_TagKind sem_TagKind_DefineButton = ( ) sem_TagKind_DefineButton2 :: T_TagKind sem_TagKind_DefineButton2 = ( ) sem_TagKind_DefineButtonCxform :: T_TagKind sem_TagKind_DefineButtonCxform = ( ) sem_TagKind_DefineButtonSound :: T_TagKind sem_TagKind_DefineButtonSound = ( ) sem_TagKind_DefineEditText :: T_TagKind sem_TagKind_DefineEditText = ( ) sem_TagKind_DefineFont :: T_TagKind sem_TagKind_DefineFont = ( ) sem_TagKind_DefineFont2 :: T_TagKind sem_TagKind_DefineFont2 = ( ) sem_TagKind_DefineFont3 :: T_TagKind sem_TagKind_DefineFont3 = ( ) sem_TagKind_DefineFont4 :: T_TagKind sem_TagKind_DefineFont4 = ( ) sem_TagKind_DefineFontAlignZones :: T_TagKind sem_TagKind_DefineFontAlignZones = ( ) sem_TagKind_DefineFontInfo :: T_TagKind sem_TagKind_DefineFontInfo = ( ) sem_TagKind_DefineFontInfo2 :: T_TagKind sem_TagKind_DefineFontInfo2 = ( ) sem_TagKind_DefineFontName :: T_TagKind sem_TagKind_DefineFontName = ( ) sem_TagKind_DefineMorphShape :: T_TagKind sem_TagKind_DefineMorphShape = ( ) sem_TagKind_DefineMorphShape2 :: T_TagKind sem_TagKind_DefineMorphShape2 = ( ) sem_TagKind_DefineScalingGrid :: T_TagKind sem_TagKind_DefineScalingGrid = ( ) sem_TagKind_DefineSceneAndFrameLabelData :: T_TagKind sem_TagKind_DefineSceneAndFrameLabelData = ( ) sem_TagKind_DefineShape :: T_TagKind sem_TagKind_DefineShape = ( ) sem_TagKind_DefineShape2 :: T_TagKind sem_TagKind_DefineShape2 = ( ) sem_TagKind_DefineShape3 :: T_TagKind sem_TagKind_DefineShape3 = ( ) sem_TagKind_DefineShape4 :: T_TagKind sem_TagKind_DefineShape4 = ( ) sem_TagKind_DefineSound :: T_TagKind sem_TagKind_DefineSound = ( ) sem_TagKind_DefineSprite :: T_TagKind sem_TagKind_DefineSprite = ( ) sem_TagKind_DefineText :: T_TagKind sem_TagKind_DefineText = ( ) sem_TagKind_DefineText2 :: T_TagKind sem_TagKind_DefineText2 = ( ) sem_TagKind_DefineVideoStream :: T_TagKind sem_TagKind_DefineVideoStream = ( ) sem_TagKind_DoABC :: T_TagKind sem_TagKind_DoABC = ( ) sem_TagKind_DoAction :: T_TagKind sem_TagKind_DoAction = ( ) sem_TagKind_DoInitAction :: T_TagKind sem_TagKind_DoInitAction = ( ) sem_TagKind_EnableDebugger :: T_TagKind sem_TagKind_EnableDebugger = ( ) sem_TagKind_EnableDebugger2 :: T_TagKind sem_TagKind_EnableDebugger2 = ( ) sem_TagKind_End :: T_TagKind sem_TagKind_End = ( ) sem_TagKind_ExportAssets :: T_TagKind sem_TagKind_ExportAssets = ( ) sem_TagKind_FileAttributes :: T_TagKind sem_TagKind_FileAttributes = ( ) sem_TagKind_FrameLabel :: T_TagKind sem_TagKind_FrameLabel = ( ) sem_TagKind_ImportAssets :: T_TagKind sem_TagKind_ImportAssets = ( ) sem_TagKind_ImportAssets2 :: T_TagKind sem_TagKind_ImportAssets2 = ( ) sem_TagKind_JPEGTables :: T_TagKind sem_TagKind_JPEGTables = ( ) sem_TagKind_Metadata :: T_TagKind sem_TagKind_Metadata = ( ) sem_TagKind_Other :: Word16 -> T_TagKind sem_TagKind_Other code_ = ( ) sem_TagKind_PlaceObject :: T_TagKind sem_TagKind_PlaceObject = ( ) sem_TagKind_PlaceObject2 :: T_TagKind sem_TagKind_PlaceObject2 = ( ) sem_TagKind_PlaceObject3 :: T_TagKind sem_TagKind_PlaceObject3 = ( ) sem_TagKind_Protect :: T_TagKind sem_TagKind_Protect = ( ) sem_TagKind_RemoveObject :: T_TagKind sem_TagKind_RemoveObject = ( ) sem_TagKind_RemoveObject2 :: T_TagKind sem_TagKind_RemoveObject2 = ( ) sem_TagKind_ScriptLimits :: T_TagKind sem_TagKind_ScriptLimits = ( ) sem_TagKind_SetBackgroundColor :: T_TagKind sem_TagKind_SetBackgroundColor = ( ) sem_TagKind_SetTabIndex :: T_TagKind sem_TagKind_SetTabIndex = ( ) sem_TagKind_ShowFrame :: T_TagKind sem_TagKind_ShowFrame = ( ) sem_TagKind_SoundStreamBlock :: T_TagKind sem_TagKind_SoundStreamBlock = ( ) sem_TagKind_SoundStreamHead :: T_TagKind sem_TagKind_SoundStreamHead = ( ) sem_TagKind_SoundStreamHead2 :: T_TagKind sem_TagKind_SoundStreamHead2 = ( ) sem_TagKind_StartSound :: T_TagKind sem_TagKind_StartSound = ( ) sem_TagKind_StartSound2 :: T_TagKind sem_TagKind_StartSound2 = ( ) sem_TagKind_SymbolClass :: T_TagKind sem_TagKind_SymbolClass = ( ) sem_TagKind_VideoFrame :: T_TagKind sem_TagKind_VideoFrame = ( ) -- Tags -------------------------------------------------------- -- cata sem_Tags :: Tags -> T_Tags sem_Tags list = (Prelude.foldr sem_Tags_Cons sem_Tags_Nil (Prelude.map sem_Tag list) ) -- semantic domain type T_Tags = ( ) sem_Tags_Cons :: T_Tag -> T_Tags -> T_Tags sem_Tags_Cons hd_ tl_ = ( ) sem_Tags_Nil :: T_Tags sem_Tags_Nil = ( ) -- Trait ------------------------------------------------------- -- cata sem_Trait :: Trait -> T_Trait sem_Trait (Trait_Trait _name _data _attrs _meta ) = (sem_Trait_Trait _name (sem_TraitData _data ) (sem_TraitAttrs _attrs ) (sem_TraitMeta _meta ) ) -- semantic domain type T_Trait = ( Trait ) sem_Trait_Trait :: Word32 -> T_TraitData -> T_TraitAttrs -> T_TraitMeta -> T_Trait sem_Trait_Trait name_ data_ attrs_ meta_ = (case (meta_ ) of { ( _metaIoutput) | True -> (case (attrs_ ) of { ( _attrsIoutput) | True -> (case (data_ ) of { ( _dataIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} Trait_Trait name_ _dataIoutput _attrsIoutput _metaIoutput {-# LINE 12715 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12720 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) }) }) -- TraitAttr --------------------------------------------------- -- cata sem_TraitAttr :: TraitAttr -> T_TraitAttr sem_TraitAttr (TraitAttr_Final ) = (sem_TraitAttr_Final ) sem_TraitAttr (TraitAttr_Metadata ) = (sem_TraitAttr_Metadata ) sem_TraitAttr (TraitAttr_Override ) = (sem_TraitAttr_Override ) -- semantic domain type T_TraitAttr = ( TraitAttr ) sem_TraitAttr_Final :: T_TraitAttr sem_TraitAttr_Final = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitAttr_Final {-# LINE 12740 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12745 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitAttr_Metadata :: T_TraitAttr sem_TraitAttr_Metadata = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitAttr_Metadata {-# LINE 12753 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12758 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitAttr_Override :: T_TraitAttr sem_TraitAttr_Override = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitAttr_Override {-# LINE 12766 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12771 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- TraitAttrs -------------------------------------------------- -- cata sem_TraitAttrs :: TraitAttrs -> T_TraitAttrs sem_TraitAttrs list = (Prelude.foldr sem_TraitAttrs_Cons sem_TraitAttrs_Nil (Prelude.map sem_TraitAttr list) ) -- semantic domain type T_TraitAttrs = ( TraitAttrs ) sem_TraitAttrs_Cons :: T_TraitAttr -> T_TraitAttrs -> T_TraitAttrs sem_TraitAttrs_Cons hd_ tl_ = (case (tl_ ) of { ( _tlIoutput) | True -> (case (hd_ ) of { ( _hdIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} (:) _hdIoutput _tlIoutput {-# LINE 12793 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12798 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) }) sem_TraitAttrs_Nil :: T_TraitAttrs sem_TraitAttrs_Nil = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 12806 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12811 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- TraitData --------------------------------------------------- -- cata sem_TraitData :: TraitData -> T_TraitData sem_TraitData (TraitData_Class _slotId _class ) = (sem_TraitData_Class _slotId _class ) sem_TraitData (TraitData_Const _slotId _tp _vindex _vkind ) = (sem_TraitData_Const _slotId _tp _vindex (sem_ValueKind _vkind ) ) sem_TraitData (TraitData_Function _dispId _method ) = (sem_TraitData_Function _dispId _method ) sem_TraitData (TraitData_Getter _dispId _method ) = (sem_TraitData_Getter _dispId _method ) sem_TraitData (TraitData_Method _dispId _method ) = (sem_TraitData_Method _dispId _method ) sem_TraitData (TraitData_Setter _dispId _method ) = (sem_TraitData_Setter _dispId _method ) sem_TraitData (TraitData_Slot _slotId _tp _vindex _vkind ) = (sem_TraitData_Slot _slotId _tp _vindex (sem_ValueKind _vkind ) ) -- semantic domain type T_TraitData = ( TraitData ) sem_TraitData_Class :: Word32 -> Word32 -> T_TraitData sem_TraitData_Class slotId_ class_ = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Class slotId_ class_ {-# LINE 12841 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12846 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitData_Const :: Word32 -> Word32 -> Word32 -> T_ValueKind -> T_TraitData sem_TraitData_Const slotId_ tp_ vindex_ vkind_ = (case (vkind_ ) of { ( _vkindIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Const slotId_ tp_ vindex_ _vkindIoutput {-# LINE 12860 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12865 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) sem_TraitData_Function :: Word32 -> Word32 -> T_TraitData sem_TraitData_Function dispId_ method_ = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Function dispId_ method_ {-# LINE 12875 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12880 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitData_Getter :: Word32 -> Word32 -> T_TraitData sem_TraitData_Getter dispId_ method_ = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Getter dispId_ method_ {-# LINE 12890 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12895 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitData_Method :: Word32 -> Word32 -> T_TraitData sem_TraitData_Method dispId_ method_ = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Method dispId_ method_ {-# LINE 12905 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12910 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitData_Setter :: Word32 -> Word32 -> T_TraitData sem_TraitData_Setter dispId_ method_ = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Setter dispId_ method_ {-# LINE 12920 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12925 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitData_Slot :: Word32 -> Word32 -> Word32 -> T_ValueKind -> T_TraitData sem_TraitData_Slot slotId_ tp_ vindex_ vkind_ = (case (vkind_ ) of { ( _vkindIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitData_Slot slotId_ tp_ vindex_ _vkindIoutput {-# LINE 12939 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12944 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) -- TraitKind --------------------------------------------------- -- cata sem_TraitKind :: TraitKind -> T_TraitKind sem_TraitKind (TraitKind_Class ) = (sem_TraitKind_Class ) sem_TraitKind (TraitKind_Const ) = (sem_TraitKind_Const ) sem_TraitKind (TraitKind_Function ) = (sem_TraitKind_Function ) sem_TraitKind (TraitKind_Getter ) = (sem_TraitKind_Getter ) sem_TraitKind (TraitKind_Method ) = (sem_TraitKind_Method ) sem_TraitKind (TraitKind_Setter ) = (sem_TraitKind_Setter ) sem_TraitKind (TraitKind_Slot ) = (sem_TraitKind_Slot ) -- semantic domain type T_TraitKind = ( TraitKind ) sem_TraitKind_Class :: T_TraitKind sem_TraitKind_Class = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Class {-# LINE 12972 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12977 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Const :: T_TraitKind sem_TraitKind_Const = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Const {-# LINE 12985 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 12990 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Function :: T_TraitKind sem_TraitKind_Function = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Function {-# LINE 12998 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13003 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Getter :: T_TraitKind sem_TraitKind_Getter = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Getter {-# LINE 13011 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13016 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Method :: T_TraitKind sem_TraitKind_Method = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Method {-# LINE 13024 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13029 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Setter :: T_TraitKind sem_TraitKind_Setter = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Setter {-# LINE 13037 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13042 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_TraitKind_Slot :: T_TraitKind sem_TraitKind_Slot = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} TraitKind_Slot {-# LINE 13050 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13055 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- TraitMeta --------------------------------------------------- -- cata sem_TraitMeta :: TraitMeta -> T_TraitMeta sem_TraitMeta list = (Prelude.foldr sem_TraitMeta_Cons sem_TraitMeta_Nil list ) -- semantic domain type T_TraitMeta = ( TraitMeta ) sem_TraitMeta_Cons :: Word32 -> T_TraitMeta -> T_TraitMeta sem_TraitMeta_Cons hd_ tl_ = (case (tl_ ) of { ( _tlIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} (:) hd_ _tlIoutput {-# LINE 13075 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13080 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) sem_TraitMeta_Nil :: T_TraitMeta sem_TraitMeta_Nil = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 13088 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13093 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- Traits ------------------------------------------------------ -- cata sem_Traits :: Traits -> T_Traits sem_Traits list = (Prelude.foldr sem_Traits_Cons sem_Traits_Nil (Prelude.map sem_Trait list) ) -- semantic domain type T_Traits = ( Traits ) sem_Traits_Cons :: T_Trait -> T_Traits -> T_Traits sem_Traits_Cons hd_ tl_ = (case (tl_ ) of { ( _tlIoutput) | True -> (case (hd_ ) of { ( _hdIoutput) | True -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} (:) _hdIoutput _tlIoutput {-# LINE 13115 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13120 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) }) }) sem_Traits_Nil :: T_Traits sem_Traits_Nil = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} [] {-# LINE 13128 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13133 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) -- ValueKind --------------------------------------------------- -- cata sem_ValueKind :: ValueKind -> T_ValueKind sem_ValueKind (ValueKind_Double ) = (sem_ValueKind_Double ) sem_ValueKind (ValueKind_Explicit ) = (sem_ValueKind_Explicit ) sem_ValueKind (ValueKind_False ) = (sem_ValueKind_False ) sem_ValueKind (ValueKind_Int ) = (sem_ValueKind_Int ) sem_ValueKind (ValueKind_Internal ) = (sem_ValueKind_Internal ) sem_ValueKind (ValueKind_Namespace ) = (sem_ValueKind_Namespace ) sem_ValueKind (ValueKind_Null ) = (sem_ValueKind_Null ) sem_ValueKind (ValueKind_Package ) = (sem_ValueKind_Package ) sem_ValueKind (ValueKind_Private ) = (sem_ValueKind_Private ) sem_ValueKind (ValueKind_Protected ) = (sem_ValueKind_Protected ) sem_ValueKind (ValueKind_Static ) = (sem_ValueKind_Static ) sem_ValueKind (ValueKind_True ) = (sem_ValueKind_True ) sem_ValueKind (ValueKind_UInt ) = (sem_ValueKind_UInt ) sem_ValueKind (ValueKind_Undefined ) = (sem_ValueKind_Undefined ) sem_ValueKind (ValueKind_Utf8 ) = (sem_ValueKind_Utf8 ) -- semantic domain type T_ValueKind = ( ValueKind ) sem_ValueKind_Double :: T_ValueKind sem_ValueKind_Double = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Double {-# LINE 13177 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13182 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Explicit :: T_ValueKind sem_ValueKind_Explicit = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Explicit {-# LINE 13190 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13195 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_False :: T_ValueKind sem_ValueKind_False = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_False {-# LINE 13203 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13208 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Int :: T_ValueKind sem_ValueKind_Int = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Int {-# LINE 13216 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13221 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Internal :: T_ValueKind sem_ValueKind_Internal = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Internal {-# LINE 13229 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13234 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Namespace :: T_ValueKind sem_ValueKind_Namespace = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Namespace {-# LINE 13242 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13247 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Null :: T_ValueKind sem_ValueKind_Null = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Null {-# LINE 13255 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13260 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Package :: T_ValueKind sem_ValueKind_Package = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Package {-# LINE 13268 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13273 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Private :: T_ValueKind sem_ValueKind_Private = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Private {-# LINE 13281 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13286 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Protected :: T_ValueKind sem_ValueKind_Protected = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Protected {-# LINE 13294 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13299 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Static :: T_ValueKind sem_ValueKind_Static = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Static {-# LINE 13307 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13312 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_True :: T_ValueKind sem_ValueKind_True = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_True {-# LINE 13320 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13325 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_UInt :: T_ValueKind sem_ValueKind_UInt = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_UInt {-# LINE 13333 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13338 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Undefined :: T_ValueKind sem_ValueKind_Undefined = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Undefined {-# LINE 13346 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13351 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) }) sem_ValueKind_Utf8 :: T_ValueKind sem_ValueKind_Utf8 = (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} ValueKind_Utf8 {-# LINE 13359 "src/InstrLocFilter.hs" #-} )) of { _output | _output `seq` (True) -> (case (({-# LINE 35 "src/InstrLocFilter.ag" #-} _output {-# LINE 13364 "src/InstrLocFilter.hs" #-} )) of { _lhsOoutput | _lhsOoutput `seq` (True) -> ( _lhsOoutput) }) })