diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2021-12-13 14:22:32 +0100 |
|---|---|---|
| committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2021-12-13 15:35:46 +0100 |
| commit | 1773bf8c509a9cb9ac222e5a9fc970795441d9ce (patch) | |
| tree | 22c026c1bacaa6a4375054b73714f9122235430a | |
| parent | 8590d22e4bd0265efa45e75357b2b40921b48f92 (diff) | |
| download | haskell-1773bf8c509a9cb9ac222e5a9fc970795441d9ce.tar.gz | |
Add closure type to args json
| -rw-r--r-- | compiler/GHC/StgToCmm/Ticky.hs | 16 |
1 files changed, 7 insertions, 9 deletions
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs index 7b9d419465..87198f0b2c 100644 --- a/compiler/GHC/StgToCmm/Ticky.hs +++ b/compiler/GHC/StgToCmm/Ticky.hs @@ -152,9 +152,6 @@ import GHC.Utils.Json -- ----------------------------------------------------------------------------- --- | Ticky "arg" info. Describes args for functions and fvs for thunks. -data TickyEntryDesc = DescFunThunk [NonVoid Id] [NonVoid Id] | DescFunArgs [NonVoid Id] | DescThunkFvs [StgArg] | DescTickyCon - -- | "Arguments" for a ticky counter. FVs for thunks, actual arguments for functions. tickyArgArity :: TickyClosureType -> Int tickyArgArity (TickyFun _ _fvs args) = length args @@ -180,15 +177,16 @@ tickyFvDesc arg_info = instance ToJson TickyClosureType where json info = case info of - (TickyFun {}) -> mkInfo (tickyFvDesc info) (tickyArgDesc info) - (TickyLNE {}) -> mkInfo [] (tickyArgDesc info) - (TickyThunk {}) -> mkInfo (tickyFvDesc info) [] - (TickyCon{}) -> mkInfo [] [] + (TickyFun {}) -> mkInfo (tickyFvDesc info) (tickyArgDesc info) "fun" + (TickyLNE {}) -> mkInfo [] (tickyArgDesc info) "lne" + (TickyThunk uf _ _) -> mkInfo (tickyFvDesc info) [] ("thk" ++ if uf then "_u" else "") + (TickyCon{}) -> mkInfo [] [] "con" where - mkInfo :: String -> String -> JsonDoc - mkInfo fvs args = + mkInfo :: String -> String -> String -> JsonDoc + mkInfo fvs args ty = JSObject [("type", json "entCntr") + ,("subTy", json ty) ,("fvs_c", json (length fvs)) ,("fvs" , json fvs) ,("args", json args) |