{-# OPTIONS_GHC -optc-DPROFILING #-}{-# LINE 1 "GHC/Stack/CCS.hsc" #-}{-# LANGUAGE Trustworthy #-}{-# LINE 2 "GHC/Stack/CCS.hsc" #-}------------------------------------------------------------------------------- |-- Module : GHC.Stack.CCS-- Copyright : (c) The University of Glasgow 2011-- License : see libraries/base/LICENSE---- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC Extensions)---- Access to GHC's call-stack simulation---- @since 4.5.0.0-----------------------------------------------------------------------------{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}moduleGHC. Stack.CCS(-- * Call stackscurrentCallStack,whoCreated ,-- * InternalsCostCentreStack,CostCentre,getCurrentCCS,getCCSOf ,clearCCS,ccsCC ,ccsParent ,ccLabel ,ccModule ,ccSrcSpan,ccsToStrings,renderStack)whereimportForeign importForeign .CimportGHC.Base importGHC.Ptr importGHC.ForeignasGHCimportGHC.IO.EncodingimportGHC.List(concatMap,reverse){-# LINE 49 "GHC/Stack/CCS.hsc" #-}{-# LINE 50 "GHC/Stack/CCS.hsc" #-}dataCostCentreStackdataCostCentregetCurrentCCS::dummy->IO (Ptr CostCentreStack)getCurrentCCSdummy=IO$\s->casegetCurrentCCS#dummysof(#s' ,addr #)->(#s' ,Ptr addr #)getCCSOf::a->IO(PtrCostCentreStack)getCCSOf obj=IO$\s ->casegetCCSOf#objsof(#s',addr# )->(# s' ,Ptraddr#)clearCCS::IOa->IOaclearCCS(IOm )=IO $ \s ->clearCCS#ms ccsCC::PtrCostCentreStack->IO(PtrCostCentre)ccsCCp=((\hsc_ptr->peekByteOffhsc_ptr8))p{-# LINE 69 "GHC/Stack/CCS.hsc" #-}ccsParent::PtrCostCentreStack->IO (PtrCostCentreStack)ccsParentp=((\hsc_ptr->peekByteOffhsc_ptr16))p{-# LINE 72 "GHC/Stack/CCS.hsc" #-}ccLabel ::PtrCostCentre->IO CString ccLabelp=((\hsc_ptr->peekByteOffhsc_ptr8))p{-# LINE 75 "GHC/Stack/CCS.hsc" #-}ccModule::PtrCostCentre->IOCStringccModulep=((\hsc_ptr->peekByteOffhsc_ptr16))p{-# LINE 78 "GHC/Stack/CCS.hsc" #-}ccSrcSpan::PtrCostCentre->IOCStringccSrcSpanp=((\hsc_ptr->peekByteOffhsc_ptr24))p{-# LINE 81 "GHC/Stack/CCS.hsc" #-}-- | Returns a @[String]@ representing the current call stack. This-- can be useful for debugging.---- The implementation uses the call-stack simulation maintined by the-- profiler, so it only works if the program was compiled with @-prof@-- and contains suitable SCC annotations (e.g. by using @-fprof-auto@).-- Otherwise, the list returned is likely to be empty or-- uninformative.---- @since 4.5.0.0currentCallStack::IO [String ]currentCallStack=ccsToStrings=<< getCurrentCCS()ccsToStrings::PtrCostCentreStack->IO[String]ccsToStringsccs0=goccs0[]wheregoccsacc|ccs==nullPtr=returnacc|otherwise=docc<-ccsCCccslbl<-GHC.peekCStringutf8=<<ccLabelccmdl<-GHC.peekCStringutf8=<<ccModuleccloc<-GHC.peekCStringutf8=<<ccSrcSpanccparent<-ccsParentccsif(mdl== "MAIN"&&lbl=="MAIN")thenreturnaccelsego parent((mdl ++'.':lbl++' ':'(':loc++")"):acc)-- | Get the stack trace attached to an object.---- @since 4.5.0.0whoCreated::a->IO[String]whoCreatedobj=doccs<-getCCSOfobjccsToStringsccsrenderStack::[String]->StringrenderStackstrs="CallStack (from -prof):"++concatMap("\n "++)(reversestrs)