Commit 20f15543 authored by Diederik van Arkel's avatar Diederik van Arkel

TimeProfiler platform dependencies

parent 5bba00ad
...@@ -7,7 +7,7 @@ import StdIOCommon, StdPicture, StdPSt, StdPrint ...@@ -7,7 +7,7 @@ import StdIOCommon, StdPicture, StdPSt, StdPrint
open_profile :: {#.Char} !*a -> *((.Bool,[.Profile]),!*a) | FileSystem a; open_profile :: {#.Char} !*a -> *((.Bool,[.Profile]),!*a) | FileSystem a;
sum_time_and_allocation :: ![.Profile] -> .(Int,Int,Int,Int,Real); sum_time_and_allocation :: ![.Profile] -> .(Int,Int,Int,Int,Real);
totals_per_module :: ![.Profile] -> ![.Profile] totals_per_module :: ![.Profile] -> [.Profile]
format_profile :: .Int .Int .Int .Int .Real [.Profile] -> ([.FormattedProfile],.FormattedProfile); format_profile :: .Int .Int .Int .Int .Real [.Profile] -> ([.FormattedProfile],.FormattedProfile);
le_module_name :: !.Profile !.Profile -> Bool; le_module_name :: !.Profile !.Profile -> Bool;
......
...@@ -228,7 +228,7 @@ where ...@@ -228,7 +228,7 @@ where
= (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a+n_allocated_words,t+time) = (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a+n_allocated_words,t+time)
= (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a,t+time) = (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a,t+time)
totals_per_module :: ![.Profile] -> ![.Profile] totals_per_module :: ![.Profile] -> [.Profile]
totals_per_module [] totals_per_module []
= [] = []
totals_per_module [f=:{module_name}:l] totals_per_module [f=:{module_name}:l]
...@@ -355,7 +355,7 @@ where ...@@ -355,7 +355,7 @@ where
where where
error file = (False,abort "error in read_function_profile",file) error file = (False,abort "error in read_function_profile",file)
read_function_name :: !*File -> !(!Bool,!String,!*File) read_function_name :: !*File -> (!Bool,!String,!*File)
read_function_name file read_function_name file
# (ok,c,file) = freadc file # (ok,c,file) = freadc file
| not ok || c==' ' || c=='\n' | not ok || c==' ' || c=='\n'
......
...@@ -4,10 +4,10 @@ import StdArray, StdBool, StdList, StdFunc, StdTuple, StdOrdList ...@@ -4,10 +4,10 @@ import StdArray, StdBool, StdList, StdFunc, StdTuple, StdOrdList
import StdProcess, StdId, StdMenu, StdReceiver, StdMenuElement, StdFileSelect, StdPStClass import StdProcess, StdId, StdMenu, StdReceiver, StdMenuElement, StdFileSelect, StdPStClass
import flexwin import flexwin
import ArgEnv
import ExtNotice import ExtNotice
import Help import Help
import ShowProfile import ShowProfile
import Platform
ApplicationName :== "ShowTimeProfile" ApplicationName :== "ShowTimeProfile"
HelpFileName :== ApplicationName +++ "Help" HelpFileName :== ApplicationName +++ "Help"
...@@ -72,7 +72,7 @@ where ...@@ -72,7 +72,7 @@ where
# (_,ps) = openMenu Void (sort_menu recId) ps # (_,ps) = openMenu Void (sort_menu recId) ps
# (_,ps) = openMenu Void (view_menu recId) ps # (_,ps) = openMenu Void (view_menu recId) ps
# (_,ps) = openMenu Void (help_menu) ps # (_,ps) = openMenu Void (help_menu) ps
= ps = installPlatformEventHandlers ps
file_menu hasClose winId closeId printId recId = file_menu hasClose winId closeId printId recId =
Menu "&File" Menu "&File"
...@@ -130,23 +130,15 @@ info = ...@@ -130,23 +130,15 @@ info =
//-- Support functions... //-- Support functions...
open_time_file_from_command_line ps open_time_file_from_command_line ps
| size commandline == 1 # (commandline,ps) = initPlatformCommandLine ps
= (([],[],""),ps) | length commandline <= 1
# (ok,pathname) = GetLongPathName commandline.[1]
| not ok
= (([],[],""),ps) = (([],[],""),ps)
= open_file_function pathname ps = open_file_function (commandline!!1) ps
where
commandline
= getCommandLine
openFiles _ _ _ _ [] ps = ps openFiles _ _ _ _ [] ps = ps
openFiles winId closeId printId recId [h:t] ps openFiles winId closeId printId recId [h:t] ps
# (ok,pathname) = GetLongPathName h
| not ok
= ps
# ((mods,funs,name),ps) # ((mods,funs,name),ps)
= open_file_function pathname ps = open_file_function h ps
# (viewer_mode,ps) = accPLoc (\vs=:{mode}-> (mode,{vs & mods = mods, funs = funs, name = name})) ps # (viewer_mode,ps) = accPLoc (\vs=:{mode}-> (mode,{vs & mods = mods, funs = funs, name = name})) ps
# info = case viewer_mode of # info = case viewer_mode of
ViewByModule -> mods ViewByModule -> mods
...@@ -234,12 +226,16 @@ printfun recId ps ...@@ -234,12 +226,16 @@ printfun recId ps
= ps = ps
# info = fromJust info # info = fromJust info
# (functionData,[sumData:_]) = splitAt (dec (length info)) info # (functionData,[sumData:_]) = splitAt (dec (length info)) info
# ((ok,printFont),ps) = accPIO (accScreenPicture (openFont {fName="Courier New",fStyles=[BoldStyle],fSize=8})) ps # ((ok,printFont),ps) = accPIO (accScreenPicture (openFont printFont)) ps
| not ok // | not ok
= ps // = ps
# (printSetup,ps) = printTable printFont printSetup functionData sumData ps # (printSetup,ps) = printTable printFont printSetup functionData sumData ps
# ps = appPLoc (\vs -> {vs & pset = printSetup}) ps # ps = appPLoc (\vs -> {vs & pset = printSetup}) ps
= ps = ps
where
printFont = PlatformDependant
{fName="Courier New",fStyles=[BoldStyle],fSize=8}
{fName="Monaco",fStyles=[],fSize=8}
//-- Profile stuff... //-- Profile stuff...
...@@ -296,10 +292,3 @@ where ...@@ -296,10 +292,3 @@ where
# line_height = fontLineHeight metrics # line_height = fontLineHeight metrics
= line_height * (length lines) = line_height * (length lines)
//--
import expand_8_3_names_in_path
GetLongPathName :: !String -> (!Bool,!String);
GetLongPathName short_path
= (True, expand_8_3_names_in_path short_path);
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