Verified Commit b38832ba authored by Camil Staps's avatar Camil Staps 🚀

Move types and parsing/preparing functions to separate module

parent adac3d22
definition module PGCL
from Data.Error import :: MaybeError
from Data.Set import :: Set
:: Profile =
{ modules :: !.{#String}
, cost_centres :: !.{#CostCentre}
, profile :: !ProfileStack
}
:: CostCentre =
{ cc_module :: !Int
, cc_name :: !String
}
:: ProfileStack =
{ cost_centre :: !Int
, ticks :: !Int
, words :: !Int
, scalls :: !Int
, lcalls :: !Int
, ccalls :: !Int
, children :: ![ProfileStack]
// Aggregates:
, cumulative_ticks :: !Int
, cumulative_words :: !Int
, profiler_calls :: !Int
}
read_profile :: !*File -> (!MaybeError String Profile, !*File)
prepare :: !Int !(Set String) !Profile -> Profile
implementation module PGCL
import StdEnv
import Data.Error
import Data.Func
import Data.Maybe
import qualified Data.Set
import Data._Array
import Text
read_profile :: !*File -> (!MaybeError String Profile, !*File)
read_profile f
# (header,f) = freads f 4
| header <> "prof" = (Error "invalid header",f)
# (ok,version,f) = freadi f
| not ok = (unexpected_eof,f)
| version <> 1 = (Error "invalid version number",f)
# (ok,n_modules,f) = freadi f
| not ok = (unexpected_eof,f)
# (ok,n_cost_centres,f) = freadi f
| not ok = (unexpected_eof,f)
# (modules,f) = read_modules 0 n_modules (unsafeCreateArray n_modules) f
| isError modules = (Error (fromError modules),f)
# (cost_centres,f) = read_cost_centres 0 n_cost_centres (unsafeCreateArray n_cost_centres) f
| isError cost_centres = (Error (fromError cost_centres),f)
# (profile,f) = read_profile_stack f
| isError profile = (Error (fromError profile),f)
# (end,f) = fend f
| not end = (Error "garbage at end of file",f)
# profile =
{ modules = fromOk modules
, cost_centres = fromOk cost_centres
, profile = fromOk profile
}
= (Ok profile,f)
where
unexpected_eof :: .MaybeError String .a
unexpected_eof = Error "unexpected end of file"
read_modules :: !Int !Int !*{#String} !*File -> (!MaybeError String *{#String}, !*File)
read_modules i n arr f
| i==n
= (Ok arr,f)
# (name,f) = read_nul_terminated_string [] f
| isError name
= (Error (fromError name),f)
= read_modules (i+1) n {arr & [i]=fromOk name} f
read_cost_centres :: !Int !Int !*{#CostCentre} !*File -> (!MaybeError String *{#CostCentre}, !*File)
read_cost_centres i n arr f
| i==n
= (Ok arr,f)
# (ok,module_id,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (name,f) = read_nul_terminated_string [] f
| isError name
= (Error (fromError name),f)
= read_cost_centres (i+1) n {arr & [i]={cc_module=module_id-1,cc_name=fromOk name}} f
read_profile_stack :: !*File -> (!MaybeError String ProfileStack, !*File)
read_profile_stack f
# (ok,cost_centre,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,ticks,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,words,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,tail_and_return_calls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,scalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,lcalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,ccalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,n_children,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (children,f) = read_profile_stacks n_children [] f
| isError children = (Error (fromError children),f)
# profile =
{ cost_centre = cost_centre-1
, ticks = ticks
, words = words
, scalls = scalls
, lcalls = lcalls
, ccalls = ccalls
, children = fromOk children
, cumulative_ticks = -1
, cumulative_words = -1
, profiler_calls = tail_and_return_calls+scalls+lcalls+ccalls
}
= (Ok profile,f)
where
read_profile_stacks :: !Int ![ProfileStack] !*File -> (!MaybeError String [ProfileStack], !*File)
read_profile_stacks 0 ss f
= (Ok ss,f)
read_profile_stacks i ss f
# (stack,f) = read_profile_stack f
| isError stack
= (Error (fromError stack),f)
= read_profile_stacks (i-1) [fromOk stack:ss] f
read_nul_terminated_string :: ![Char] !*File -> (!MaybeError String {#Char},!*File)
read_nul_terminated_string cs f
# (ok,c,f) = freadc f
| not ok
= (unexpected_eof,f)
| c=='\0'
= (Ok {c \\ c <- reverse cs},f)
= read_nul_terminated_string [c:cs] f
read_var_width_int :: !*File -> (!Bool,!Int,!*File)
read_var_width_int f = read 0 0 f
where
read :: !Int !Int !*File -> (!Bool,!Int,!*File)
read i sft f
# (ok,c,f) = freadc f
| not ok = (False,0,f)
# i = i + ((toInt c bitand 0x7f) << sft)
| toInt c bitand 0x80==0
= (True,i,f)
= read i (sft+7) f
prepare :: !Int !('Data.Set'.Set String) !Profile -> Profile
prepare min_cumulative_ticks excluded p =
{ p
& profile =
compute_sums_prune_and_sort (fromMaybe -1 gc_id) min_cumulative_ticks $
(case gc_id of
Nothing -> id
Just id -> lift_garbage_collector id) $
(if ('Data.Set'.size excluded==0) id (remove_excluded_functions excluded_ids))
p.profile
}
where
gc_id =
case
[ i \\ c <-: p.cost_centres & i <- [0..]
| c.cc_name=="garbage_collector"
&& p.modules.[c.cc_module]=="System"]
of
[id:_]
-> Just id
-> Nothing
excluded_ids = 'Data.Set'.fromList
[ i \\ c <-: p.cost_centres & i <- [0..]
| 'Data.Set'.member (concat [p.modules.[c.cc_module],":",c.cc_name]) excluded
]
remove_excluded_functions :: !('Data.Set'.Set Int) !ProfileStack -> ProfileStack
remove_excluded_functions excluded s =
{ s
& children =
[ remove_excluded_functions excluded c
\\ c <- s.children
| not ('Data.Set'.member c.cost_centre excluded)
]
}
lift_garbage_collector :: !Int !ProfileStack -> ProfileStack
lift_garbage_collector cost_centre_id s
# (s,(ticks,calls)) = walk s 0 0
| calls==0
= s
= {s & children=[gc:s.children]}
with
gc =
{ cost_centre = cost_centre_id
, ccalls = 0
, lcalls = 0
, scalls = calls
, words = 0
, ticks = ticks
, children = []
, cumulative_ticks = ticks
, cumulative_words = 0
, profiler_calls = 2*calls
}
where
walk :: !ProfileStack !Int !Int -> (!ProfileStack, !(!Int,!Int))
walk s ticks calls
| s.cost_centre==cost_centre_id
= (s, (ticks+s.ticks, calls+s.scalls))
# (children,counts) = mapSt (\c (ts,cs) -> walk c ts cs) s.children (ticks,calls)
= ({s & children=[c \\ c <- children | c.cost_centre <> cost_centre_id]}, counts)
compute_sums_prune_and_sort :: !Int !Int !ProfileStack -> ProfileStack
compute_sums_prune_and_sort gc_id min_cumulative_ticks s
# children = reverse (sort [compute_sums_prune_and_sort gc_id min_cumulative_ticks c \\ c <- s.children])
s & cumulative_ticks = s.ticks + sum [c.cumulative_ticks \\ c <- children]
s & cumulative_words = s.words + sum [c.cumulative_words \\ c <- children]
s & children = [c \\ c <- children | c.cumulative_ticks >= min_cumulative_ticks || c.cost_centre==gc_id]
= s
instance < ProfileStack where < a b = a.cumulative_ticks < b.cumulative_ticks
......@@ -2,10 +2,8 @@ module profile2html
import StdEnv
import Data._Array
import Data.Error
import Data.Func
import Data.Maybe
import qualified Data.Set
import System.CommandLine
import System.File
......@@ -14,29 +12,7 @@ import System.Options
from Text import class Text(concat,join), instance Text String, <+
import qualified Text.HTML
:: Profile =
{ modules :: !.{#String}
, cost_centres :: !.{#CostCentre}
, profile :: !Stack
}
:: CostCentre =
{ cc_module :: !Int
, cc_name :: !String
}
:: Stack =
{ cost_centre :: !Int
, ticks :: !Int
, words :: !Int
, scalls :: !Int
, lcalls :: !Int
, ccalls :: !Int
, children :: ![Stack]
, cumulative_ticks :: !Int // Filled in by this application
, cumulative_words :: !Int // Filled in by this application
, profiler_calls :: !Int // Filled in by this application
}
import PGCL
:: Options =
{ input :: !FilePath
......@@ -105,193 +81,6 @@ where
# (_,w) = fclose (stderr <<< err <<< '\n') w
= setReturnCode -1 w
read_profile :: !*File -> (!MaybeError String Profile, !*File)
read_profile f
# (header,f) = freads f 4
| header <> "prof" = (Error "invalid header",f)
# (ok,version,f) = freadi f
| not ok = (unexpected_eof,f)
| version <> 1 = (Error "invalid version number",f)
# (ok,n_modules,f) = freadi f
| not ok = (unexpected_eof,f)
# (ok,n_cost_centres,f) = freadi f
| not ok = (unexpected_eof,f)
# (modules,f) = read_modules 0 n_modules (unsafeCreateArray n_modules) f
| isError modules = (Error (fromError modules),f)
# (cost_centres,f) = read_cost_centres 0 n_cost_centres (unsafeCreateArray n_cost_centres) f
| isError cost_centres = (Error (fromError cost_centres),f)
# (profile,f) = read_profile_stack f
| isError profile = (Error (fromError profile),f)
# (end,f) = fend f
| not end = (Error "garbage at end of file",f)
# profile =
{ modules = fromOk modules
, cost_centres = fromOk cost_centres
, profile = fromOk profile
}
= (Ok profile,f)
where
unexpected_eof :: .MaybeError String .a
unexpected_eof = Error "unexpected end of file"
read_modules :: !Int !Int !*{#String} !*File -> (!MaybeError String *{#String}, !*File)
read_modules i n arr f
| i==n
= (Ok arr,f)
# (name,f) = read_nul_terminated_string [] f
| isError name
= (Error (fromError name),f)
= read_modules (i+1) n {arr & [i]=fromOk name} f
read_cost_centres :: !Int !Int !*{#CostCentre} !*File -> (!MaybeError String *{#CostCentre}, !*File)
read_cost_centres i n arr f
| i==n
= (Ok arr,f)
# (ok,module_id,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (name,f) = read_nul_terminated_string [] f
| isError name
= (Error (fromError name),f)
= read_cost_centres (i+1) n {arr & [i]={cc_module=module_id-1,cc_name=fromOk name}} f
read_profile_stack :: !*File -> (!MaybeError String Stack, !*File)
read_profile_stack f
# (ok,cost_centre,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,ticks,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,words,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,tail_and_return_calls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,scalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,lcalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,ccalls,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (ok,n_children,f) = read_var_width_int f
| not ok = (unexpected_eof,f)
# (children,f) = read_profile_stacks n_children [] f
| isError children = (Error (fromError children),f)
# profile =
{ cost_centre = cost_centre-1
, ticks = ticks
, words = words
, scalls = scalls
, lcalls = lcalls
, ccalls = ccalls
, children = fromOk children
, cumulative_ticks = -1
, cumulative_words = -1
, profiler_calls = tail_and_return_calls+scalls+lcalls+ccalls
}
= (Ok profile,f)
where
read_profile_stacks :: !Int ![Stack] !*File -> (!MaybeError String [Stack], !*File)
read_profile_stacks 0 ss f
= (Ok ss,f)
read_profile_stacks i ss f
# (stack,f) = read_profile_stack f
| isError stack
= (Error (fromError stack),f)
= read_profile_stacks (i-1) [fromOk stack:ss] f
read_nul_terminated_string :: ![Char] !*File -> (!MaybeError String {#Char},!*File)
read_nul_terminated_string cs f
# (ok,c,f) = freadc f
| not ok
= (unexpected_eof,f)
| c=='\0'
= (Ok {c \\ c <- reverse cs},f)
= read_nul_terminated_string [c:cs] f
read_var_width_int :: !*File -> (!Bool,!Int,!*File)
read_var_width_int f = read 0 0 f
where
read :: !Int !Int !*File -> (!Bool,!Int,!*File)
read i sft f
# (ok,c,f) = freadc f
| not ok = (False,0,f)
# i = i + ((toInt c bitand 0x7f) << sft)
| toInt c bitand 0x80==0
= (True,i,f)
= read i (sft+7) f
prepare :: !Int !('Data.Set'.Set String) !Profile -> Profile
prepare min_cumulative_ticks excluded p =
{ p
& profile =
compute_sums_prune_and_sort (fromMaybe -1 gc_id) min_cumulative_ticks $
(case gc_id of
Nothing -> id
Just id -> lift_garbage_collector id) $
(if ('Data.Set'.size excluded==0) id (remove_excluded_functions excluded_ids))
p.profile
}
where
gc_id =
case
[ i \\ c <-: p.cost_centres & i <- [0..]
| c.cc_name=="garbage_collector"
&& p.modules.[c.cc_module]=="System"]
of
[id:_]
-> Just id
-> Nothing
excluded_ids = 'Data.Set'.fromList
[ i \\ c <-: p.cost_centres & i <- [0..]
| 'Data.Set'.member (concat [p.modules.[c.cc_module],":",c.cc_name]) excluded
]
remove_excluded_functions :: !('Data.Set'.Set Int) !Stack -> Stack
remove_excluded_functions excluded s =
{ s
& children =
[ remove_excluded_functions excluded c
\\ c <- s.children
| not ('Data.Set'.member c.cost_centre excluded)
]
}
lift_garbage_collector :: !Int !Stack -> Stack
lift_garbage_collector cost_centre_id s
# (s,(ticks,calls)) = walk s 0 0
| calls==0
= s
= {s & children=[gc:s.children]}
with
gc =
{ cost_centre = cost_centre_id
, ccalls = 0
, lcalls = 0
, scalls = calls
, words = 0
, ticks = ticks
, children = []
, cumulative_ticks = ticks
, cumulative_words = 0
, profiler_calls = 2*calls
}
where
walk :: !Stack !Int !Int -> (!Stack, !(!Int,!Int))
walk s ticks calls
| s.cost_centre==cost_centre_id
= (s, (ticks+s.ticks, calls+s.scalls))
# (children,counts) = mapSt (\c (ts,cs) -> walk c ts cs) s.children (ticks,calls)
= ({s & children=[c \\ c <- children | c.cost_centre <> cost_centre_id]}, counts)
compute_sums_prune_and_sort :: !Int !Int !Stack -> Stack
compute_sums_prune_and_sort gc_id min_cumulative_ticks s
# children = reverse (sort [compute_sums_prune_and_sort gc_id min_cumulative_ticks c \\ c <- s.children])
s & cumulative_ticks = s.ticks + sum [c.cumulative_ticks \\ c <- children]
s & cumulative_words = s.words + sum [c.cumulative_words \\ c <- children]
s & children = [c \\ c <- children | c.cumulative_ticks >= min_cumulative_ticks || c.cost_centre==gc_id]
= s
instance < Stack where < a b = a.cumulative_ticks < b.cumulative_ticks
instance <<< Profile
where
<<< f p
......@@ -317,10 +106,10 @@ where
<<< "</body>"
<<< "</html>"
write_stack :: !Profile !Stack !*File -> *File
write_stack :: !Profile !ProfileStack !*File -> *File
write_stack p s f = write s.cumulative_ticks s.cumulative_words s f
where
write :: !Int !Int !Stack !*File -> *File
write :: !Int !Int !ProfileStack !*File -> *File
write parent_ticks parent_words s f
# f = f <<< "<div class=\"entry\">"
<<< "<div class=\"entry-header\">"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment