Commit 2e45ef2f authored by John van Groningen's avatar John van Groningen
Browse files

more changes caused by using type ModuleDirAndName instead of type String,

remove some unused functions and function arguments,
change order of some function arguments and tuples
parent 10f4ea83
......@@ -30,9 +30,6 @@ where
level3 (Level3 _) = True
level3 _ = False
traceInfo _ ps :== ps
//traceInfo i ps :== showInfo i ps
getFICache` ps
# (_,ps) = getFICache ps
# fi = FI_EmptyCache
......@@ -57,11 +54,9 @@ System :== "_system"
// Compile /Check Syntax of the designated module
CompileProjectModule :: !CompileOrCheckSyntax !Pathname !Project !SetMadeProjectFun !*GeneralSt -> *GeneralSt
CompileProjectModule compilerOrCheckSyntax imp_pathname project setproject ps
CompileProjectModule compileOrCheckSyntax imp_pathname project setproject ps
# ps = ClearCompilerCache` ps
# (syspaths,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
# srcpaths = AppendLists prjpaths syspaths
# (srcpaths,ps) = get_project_and_environment_paths project ps
# (mdn,imp_pathname) = determine_dir_and_filename imp_pathname srcpaths
#! (abccache,ps) = getABCCache ps
#! (fileinfo,ps) = getFICache` ps
......@@ -69,8 +64,8 @@ CompileProjectModule compilerOrCheckSyntax imp_pathname project setproject ps
= accFiles (DC_Setup srcpaths) ps
# ({be_verbose},ps) = getPrefs ps
#! ps = HandleDCErrors be_verbose errs warns ps
#! (ps,fileinfo,_,abccache,project,ok,newpaths,_,_)
= CompileTheProjectModule compilerOrCheckSyntax mdn imp_pathname fileinfo dircache abccache project ps
#! (fileinfo,abccache,project,ok,newpaths,_,_,_,ps)
= CompileTheProjectModule compileOrCheckSyntax mdn imp_pathname fileinfo abccache project dircache ps
# ps = setABCCache abccache ps
# ps = setFICache fileinfo ps
= setproject ok newpaths project ps
......@@ -78,9 +73,7 @@ CompileProjectModule compilerOrCheckSyntax imp_pathname project setproject ps
GenAsmProjectModule :: !.Pathname !Project !SetMadeProjectFun !*GeneralSt -> *GeneralSt
GenAsmProjectModule imp_pathname project setproject ps
# ps = ClearCompilerCache` ps
# (syspaths,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
# srcpaths = AppendLists prjpaths syspaths
# (srcpaths,ps) = get_project_and_environment_paths project ps
# (mdn,imp_pathname) = determine_dir_and_filename imp_pathname srcpaths
# (abccache,ps) = getABCCache ps
#! (fileinfo,ps) = getFICache` ps
......@@ -88,13 +81,13 @@ GenAsmProjectModule imp_pathname project setproject ps
= accFiles (DC_Setup srcpaths) ps
# ({be_verbose},ps) = getPrefs ps
# ps = HandleDCErrors be_verbose errs warns ps
# (ps,fileinfo,_,abccache,project,ok,newpaths,abcpath,_)
= CompileTheProjectModule Compilation mdn imp_pathname fileinfo dircache abccache project ps
# (fileinfo,abccache,project,ok,newpaths,abcpath,_,_,ps)
= CompileTheProjectModule Compilation mdn imp_pathname fileinfo abccache project dircache ps
| not ok || newpaths
# ps = setABCCache abccache ps
# ps = setFICache fileinfo ps
= setproject True False project ps
# (ps,abccache,fileinfo,project,ok,_)
# (ps,abccache,fileinfo,project,ok,_)
= GenCodeTheProjectModule True False AsmGeneration mdn abcpath abccache fileinfo project ps
# ps = setABCCache abccache ps
# ps = setFICache fileinfo ps
......@@ -195,22 +188,24 @@ where
//-- Private stuff
get_project_and_environment_paths :: Project *GeneralSt -> *(!List String,!*GeneralSt)
get_project_and_environment_paths project ps
# (syspaths,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
= (AppendLists prjpaths syspaths,ps)
:: MTPContinuation :== Bool Bool Bool FileInfoCache StaticLibInfo [!ModuleDirAndName] Project Bool *(*ABCCache,GeneralSt) -> *(*DriverState,*GeneralSt)
MakeTheProject :: !Bool !FileInfoCache !StaticLibInfo !*ABCCache !Project !MTPContinuation !GeneralSt -> (!*DriverState,!*GeneralSt)
MakeTheProject force fileinfo libsinfo abccache project continue ps
# (syspaths,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
# srcpaths = AppendLists prjpaths syspaths
# (srcpaths,ps) = get_project_and_environment_paths project ps
# ((errs,warns,dircache),ps)
= accFiles (DC_Setup srcpaths) ps
# ({be_verbose},ps) = getPrefs ps
# ps = HandleDCErrors be_verbose errs warns ps
# (root,project) = PR_GetRootPathName project
# root = MakeDefPathname root // avoid double compilation...
# (root_mdn,project) = PR_GetRootModuleDirAndName project
# (env_static_libs,ps) = getCurrentSlibs ps
# sfiles = (StrictListToList(Concat (SL_Libs libsinfo) env_static_libs))
# sfiles = StrictListToList (Concat (SL_Libs libsinfo) env_static_libs)
# (err,ps) = check_exists sfiles ps
| isJust err
# line = Level3 ["Error: Unable to find static library: '" +++ fromJust err +++ "'."]
......@@ -441,7 +436,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# ccstring = "dummy ccstring for now.."
# (abcpath,res,ps) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
completed.iclModule completed.options.listTypes ps // types param
# (_,(ps,fileinfo,dircache,abccache,project,ok,newpaths`,_,deps))
# (_,(fileinfo,abccache,project,ok,newpaths`,_,deps,dircache,ps))
= ProcessCompilerMsg Nothing Compilation completed.options completed.iclModule abcpath res ds.fileinfo dircache ds.abccache ds.project ps
# ds = {ds & newpaths = ds.newpaths || newpaths`, fileinfo = fileinfo, abccache = abccache, project = project, ok = ok}
| ok
......@@ -506,7 +501,7 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# ccstring = "dummy ccstring for now.."
# (abcpath,res,ps) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
completed.iclModule completed.options.listTypes ps // types param
# (_,(ps,fileinfo,dircache,abccache,project,ok,newpaths`,_,deps))
# (_,(fileinfo,abccache,project,ok,newpaths`,_,deps,dircache,ps))
= ProcessCompilerMsg Nothing Compilation completed.options completed.iclModule abcpath res ds.fileinfo dircache ds.abccache ds.project ps
# ds = {ds & newpaths = ds.newpaths || newpaths`, fileinfo = fileinfo, abccache = abccache, project = project, ok = ok}
| ok
......@@ -571,7 +566,7 @@ step intr (DGene [!mdn:rest] SyncCodeGeneration ds) ps
| not ds.ok || intr
# ds = {ds & ok = False}
= step intr (DLink ds) ps
# (ps,abccache,fileinfo,gen,abcpath) = CheckABCOutOfDate False mdn ds.abccache ds.fileinfo ds.project ps
# (abccache,fileinfo,gen,abcpath,ps) = check_object_file_out_of_date mdn False ds.abccache ds.fileinfo ds.project ps
# (ps,abccache,fileinfo,project,ok,_) = GenCodeTheProjectModule gen False CodeGeneration mdn abcpath abccache fileinfo ds.project ps
# ds = {ds & abccache = abccache, fileinfo = fileinfo, project = project, ok = ok}
| not ok
......@@ -642,7 +637,7 @@ step intr (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes,comp
# ds = {ds & fileinfo = fileinfo, project = project, ok = ds.ok && ok && not intr}
| not ds.ok
= cont (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}) ds,ps)
| (length busy_processes>=max_n_processes || (case paths of [!] -> True ; _ -> False))
| length busy_processes>=max_n_processes || (case paths of [!] -> True ; _ -> False)
# ps = DelayEventLoop ps
= cont (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}) ds,ps)
# (ok,paths,busy_processes,fileinfo,abccache,ps) = start_code_generators paths busy_processes ds.fileinfo ds.abccache ps
......@@ -652,33 +647,28 @@ step intr (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes,comp
| length busy_processes>=max_n_processes
# ps = DelayEventLoop ps
= (True,paths,busy_processes,fileinfo,abccache,ps)
# (ps,abccache,fileinfo,gen,abc_path)
= CheckABCOutOfDate False mdn abccache fileinfo project ps
# (abccache,fileinfo,gen,abc_path,ps)
= check_object_file_out_of_date mdn False abccache fileinfo project ps
# cgo = PR_GetCodeGenOptions project
# (proc,ps) = getCurrentProc ps
# ((abccache,fileinfo,info), ps)
# ((info,abccache,fileinfo), ps)
= FI_GetFileInfo proc mdn abccache fileinfo ps
| not gen
= start_code_generators rest busy_processes fileinfo abccache ps
# module_name = mdn.mdn_name
# ps = showInfo (Level2 (
(foldl (+++) ("Generating code for "
+++ module_name) [" "+++cgp_module_name \\ {cgp_module_name}<-busy_processes])
(foldl (+++) ("Generating code for " +++ module_name)
[" "+++cgp_module_name \\ {cgp_module_name}<-busy_processes])
)) ps
# (startupdir,ps) = getStup ps
# (cgen,ps) = getCurrentCgen ps
# ao = PR_GetApplicationOptions project
# (prefs,ps) = getPrefs ps
# defaultCO = prefs.compopts
# modname = GetModuleName abc_path
# co = case (PR_GetModuleInfo modname project) of
Just modinfo -> modinfo.compilerOptions
_ -> defaultCO
# timeprofile = ao.profiling && (not co.neverTimeProfile)
(cgen,ps) = getCurrentCgen ps
(neverTimeProfile,ps) = get_neverTimeProfile_option module_name project ps
ao = PR_GetApplicationOptions project
timeprofile = ao.profiling && (not neverTimeProfile)
# free_slot = hd (removeMembers [0..max_n_processes-1] [cgp_process_n \\ {cgp_process_n} <- busy_processes])
# (res,obj_path,compiler_process_ids,ps) = StartCodeGenerator cgen updateErrorWindow CodeGeneration abc_path free_slot timeprofile cgo proc ao startupdir compiler_process_ids ps
| not res
| not res
= (False,rest,busy_processes,fileinfo,abccache,ps)
# busy_processes = [{cgp_process_n=free_slot,cgp_module_name=module_name,cgp_obj_path=obj_path}:busy_processes]
= start_code_generators rest busy_processes fileinfo abccache ps
......@@ -726,10 +716,10 @@ step intr (DGene paths (ASyncCodeGenerationWin busy_processes win_max_n_processe
start_code_generators paths=:[!mdn:rest] busy_processes fileinfo abccache ps
| length busy_processes>=win_max_n_processes
= (True,paths,busy_processes,fileinfo,abccache,ps)
# (ps,abccache,fileinfo,gen,abc_path)
= CheckABCOutOfDate False mdn abccache fileinfo project ps
# (abccache,fileinfo,gen,abc_path,ps)
= check_object_file_out_of_date mdn False abccache fileinfo project ps
# (proc,ps) = getCurrentProc ps
# ((abccache,fileinfo,_), ps) = FI_GetFileInfo proc mdn abccache fileinfo ps
# ((_,abccache,fileinfo), ps) = FI_GetFileInfo proc mdn abccache fileinfo ps
| not gen
= start_code_generators rest busy_processes fileinfo abccache ps
# module_name = mdn.mdn_name
......@@ -750,7 +740,6 @@ step intr (DGene paths (ASyncCodeGenerationWin busy_processes win_max_n_processe
| not res
= (False,rest,busy_processes,fileinfo,abccache,ps)
# obj_path = ModuleDirAndNameToObjSystemPathname proc mdn
# abc_path = ModuleDirAndNameToABCSystemPathname mdn
# new_process = {wcgp_process_n=free_slot,wcgp_process_handle=process_handle,wcgp_scg=scg,wcgp_module_name=module_name,wcgp_obj_path=obj_path}
# busy_processes = [new_process:busy_processes]
= start_code_generators rest busy_processes fileinfo abccache ps
......@@ -766,52 +755,50 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# lo = PR_GetLinkOptions project
# (prj_path,ps) = getProjectFilePath ps
# (app_path,ps) = getStup ps
# (defpaths,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
# srcpaths = AppendLists prjpaths defpaths
# (srcpaths,ps) = get_project_and_environment_paths project ps
// set up dircache for 'Clean System Files'
# ((errs,warns,abcPathsCache),ps) = accFiles (DC_Setup (Map MakeSystemPathname srcpaths)) ps
// need to handle this differently? Now barfs on paths without Clean System File subdirs
// maybe use variant DC_Setup which ignores nonexistent CSF-dirs...
# ({be_verbose},ps) = getPrefs ps
# ps = HandleDCErrors be_verbose errs warns ps
# (ok,full_sys0,_,abcPathsCache) = DC_Search (MakeABCPathname System) abcPathsCache
# full_sys = full_sys0 +++ DirSeparatorString +++ (MakeABCPathname System)
# system_abc = MakeABCPathname System
# (ok,full_sys0,_,abcPathsCache) = DC_Search system_abc abcPathsCache
# full_sys = full_sys0 +++ DirSeparatorString +++ system_abc
# system_mdn = {mdn_dir=full_sys0,mdn_name=System}
# ao = PR_GetApplicationOptions project
// possibly patch _system to correct profiling settings...
# (tp,ps) = getCurrentProc ps
# ((abccache,fileinfo,modinfo),ps)
# ((modinfo,abccache,fileinfo),ps)
= FI_GetFileInfo tp system_mdn abccache fileinfo ps
# wantstp = ao.profiling //&& (not co.neverTimeProfile)
# compile = /*mp <> info.abcOptions.abcMemoryProfile ||*/ wantstp <> modinfo.abcOptions.abcTimeProfile
# lines = if (be_verbose && compile)
(Level3 ["["+++(MakeABCPathname System)+++",]: compiled with different options"])
(Level3 ["["+++system_abc+++",]: compiled with different options"])
(Level3 [])
# ps = verboseInfo be_verbose lines ps
# (version,ps) = getCurrentVers ps
# (patched, ps) = accFiles (PatchSystemABC version compile full_sys /*ao.memoryProfiling*/ wantstp) ps
| not patched
# line = Level3 ["Error: ["+++(MakeABCPathname System)+++",]: could not be patched."]
# line = Level3 ["Error: ["+++system_abc+++",]: could not be patched."]
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# ((abcdate,fileinfo), ps) = accFiles (FI_UpdateAbcDate System full_sys wantstp fileinfo) ps
# (ps,abccache,fileinfo,genabc,abcpath)
# (abccache,fileinfo,genabc,abcpath,ps)
// check _system module out of date
= CheckABCOutOfDate True system_mdn abccache fileinfo project ps
= check_object_file_out_of_date system_mdn True abccache fileinfo project ps
# (ps,abccache,fileinfo,project,ok,system_obj_path)
// if out of date regenerate
= GenCodeTheProjectModule genabc True CodeGeneration system_mdn abcpath abccache fileinfo project ps
# (sys_date, ps) = accFiles (FModified full_sys) ps
# sys_obj = full_sys0 +++ DirSeparatorString +++ (MakeObjPathname tp System)
# (sys_obj_date,ps) = accFiles (FModified sys_obj) ps
# sys_obj_date_time = DATEtoDateTime sys_obj_date
# (abcPathsCache,ps) = case genabc of
True
# sys_obj = full_sys0 +++ DirSeparatorString +++ (MakeObjPathname tp System)
(sys_obj_date,ps) = accFiles (FModified sys_obj) ps
sys_obj_date_time = DATEtoDateTime sys_obj_date
-> (DC_Update ((MakeObjPathname tp System),full_sys0,sys_obj_date_time) abcPathsCache,ps)
// need to check if line above actually works now...
False
......@@ -822,10 +809,10 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# ((ok,_,_,_,sys_objs,sys_libs,abccache),ps)
= accFiles (ParseABCDependencies` abcpath sys_date abccache) ps
| not ok
# line = Level3 ["Error: ["+++(MakeABCPathname System)+++",]: could not be analysed."]
# line = Level3 ["Error: ["+++system_abc+++",]: could not be analysed."]
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# execpath = PR_GetExecPath project
# prj_path` = PR_GetRootDir project
# execpath = fulPath app_path prj_path` execpath
......@@ -840,14 +827,14 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
= case ao.standard_rte of
True -> GetPathNames stdo Nil abcPathsCache
False -> (True,Nil,abcPathsCache)
# (stdlOk,lfiles,abcPathsCache)
= case ao.standard_rte of
True -> GetPathNames stdl Nil abcPathsCache
False -> (True,Nil,abcPathsCache)
| not stdoOk
# line = Level3 ["Link error: File: '" +++ (Head ofiles) +++ "' not found."]
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# (stdlOk,lfiles,abcPathsCache)
= case ao.standard_rte of
True -> GetPathNames stdl Nil abcPathsCache
False -> (True,Nil,abcPathsCache)
| not stdlOk
# line = Level3 ["Link error: File: '" +++ (Head lfiles) +++ "' not found."]
# ps = showInfo line ps
......@@ -862,8 +849,8 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
// clean modules
# (clmodpaths,fileinfo) = FI_GetCleanModules system_obj_path libsinfo fileinfo
// why couldn't we use ds.modpaths above??? No we need to do trickery to ensure main module is first!
# (rootpath,project) = PR_GetRootPathName project
# rootpath = MakeObjSystemPathname tp rootpath
# (root_mdn,project) = PR_GetRootModuleDirAndName project
# rootpath = ModuleDirAndNameToObjSystemPathname tp root_mdn
# clmodpaths = RemoveStringFromList rootpath clmodpaths
# ofiles` = ofiles
# ofiles = rootpath :! ofiles
......@@ -965,18 +952,6 @@ removeFromCurrent completedSlot [current=:{slot} : rest]
# (completed, rest) = removeFromCurrent completedSlot rest
= (completed, [current : rest])
dcl_to_icl_file_name file_name
# s = size file_name;
| s>4 && file_name.[s-4]=='.' && file_name.[s-4]=='.' && file_name.[s-3]=='d' && file_name.[s-2]=='c' && file_name.[s-1]=='l'
= file_name := (s-3,'i');
= file_name;
icl_to_dcl_file_name file_name
# s = size file_name;
| s>4 && file_name.[s-4]=='.' && file_name.[s-4]=='.' && file_name.[s-3]=='i' && file_name.[s-2]=='c' && file_name.[s-1]=='l'
= file_name := (s-3,'d');
= file_name;
append_object_file_extension_if_dot_at_end tp use_64_bit_processor s
| s.[size s - 1] == '.'
| use_64_bit_processor && DirSeparator=='\\'
......@@ -1027,18 +1002,14 @@ UpdateDependencies force mdn rest compinfo dircache ds ps`
# line = Level2 ((if verbose ("Analyzing \'" +++ module_name +++ "\'. ") ("")) +++ cinf)
# ps = verboseInfo verbose line ps
# (proc,ps) = getCurrentProc ps
# ((abccache,fileinfo,info),ps)
# ((info,abccache,fileinfo),ps)
= FI_GetFileInfo proc mdn ds.abccache ds.fileinfo ps
# ds = {ds & abccache = abccache, fileinfo = fileinfo}
# abcexists = info.abcdate.exists
| not abcexists
# lines = Level3 ["["+++module_name+++".icl,]: no abc file"]
#! ps = showInfo lines ps
= case compinfo of
Sync -> UpdateSyncDependencies mdn rest impname co dircache ds ps
(Async current async_compiling_info) -> UpdateAsyncDependencies current async_compiling_info mdn impname rest co dircache ds ps
(AsyncWin current win_compiling_info)-> UpdateAsyncDependenciesWin current win_compiling_info mdn impname rest co dircache ds ps
(Pers info) -> UpdatePersDependencies mdn info rest impname co dircache ds ps
= compile_module compinfo mdn impname rest co dircache ds ps
| info.sys // system module
# wrongVersion = info.version <> version
| wrongVersion
......@@ -1100,11 +1071,7 @@ UpdateDependencies force mdn rest compinfo dircache ds ps`
| force
# lines = Level3 ["["+++module_name+++".icl,]: force compile"]
#! ps = showInfo lines ps
= case compinfo of
Sync -> UpdateSyncDependencies mdn rest impname co dircache ds ps
(Async current async_compiling_info) -> UpdateAsyncDependencies current async_compiling_info mdn impname rest co dircache ds ps
(AsyncWin cmax current) -> UpdateAsyncDependenciesWin cmax current mdn impname rest co dircache ds ps
(Pers info) -> UpdatePersDependencies mdn info rest impname co dircache ds ps
= compile_module compinfo mdn impname rest co dircache ds ps
# ((ok,mods,xxx_md,xxx_dd,objs,libs,abccache),ps)
= accFiles (ParseABCDependencies` info.abcpath info.abcdate ds.abccache) ps
# ds = {ds & abccache = abccache}
......@@ -1129,11 +1096,7 @@ UpdateDependencies force mdn rest compinfo dircache ds ps`
# lines = Level3 [if okC whyA whyC]
#! ps = showInfo lines ps
= case compinfo of
Sync -> UpdateSyncDependencies mdn rest impname co dircache ds ps
(Async current compiling_info) -> UpdateAsyncDependencies current compiling_info mdn impname rest co dircache ds ps
(AsyncWin current win_compiling_info)-> UpdateAsyncDependenciesWin current win_compiling_info mdn impname rest co dircache ds ps
(Pers info) -> UpdatePersDependencies mdn info rest impname co dircache ds ps
= compile_module compinfo mdn impname rest co dircache ds ps
where
(prefs,ps) = getPrefs ps` // lift to DriverState
......@@ -1152,68 +1115,73 @@ where
defeo = {pos_size = NoWindowPosAndSize, eo = eo}
impeo = {pos_size = NoWindowPosAndSize, eo = eo}
UpdateAsyncDependenciesWin current {win_max_n_processes,win_compiler_process_ids} mdn imp_pathname rest co dircache ds ps
compile_module Sync mdn impname rest co dircache ds ps
= UpdateSyncDependencies mdn rest impname co dircache ds ps
compile_module (Async current async_compiling_info) mdn impname rest co dircache ds ps
= UpdateAsyncDependencies current async_compiling_info mdn impname rest co dircache ds ps
compile_module (AsyncWin current win_compiling_info) mdn impname rest co dircache ds ps
= UpdateAsyncDependenciesWin current win_compiling_info mdn impname rest co dircache ds ps
compile_module (Pers info) mdn impname rest co dircache ds ps
= UpdatePersDependencies mdn info rest impname co dircache ds ps
UpdateSyncDependencies mdn rest impname co dircache ds ps
# (fileinfo,abccache,project,ok,newpaths,_,deps,dircache,ps)
= CompileTheProjectModule Compilation mdn impname ds.fileinfo ds.abccache ds.project dircache ps
# ds = {ds & fileinfo = fileinfo, abccache = abccache, project = project}
= (ps,dircache,ok,newpaths,deps++|rest,Sync,ds,ok)
UpdateAsyncDependencies current {max_n_processes,compiler_process_ids,unknown_finished_processors} mdn imp_pathname rest co dircache ds ps
# free_slot = get_free_slot current
# (compileStarted, fileinfo, dircache, abccache,win_compiler_process_ids,ps)
= CompileTheProjectModuleStart Compilation mdn imp_pathname free_slot ds.fileinfo dircache ds.abccache ds.project win_compiler_process_ids ps;
# (compileStarted, fileinfo, dircache, abccache,compiler_process_ids,ps)
= CompileTheProjectModuleStart Compilation mdn imp_pathname free_slot ds.fileinfo dircache ds.abccache ds.project compiler_process_ids ps
# ds = {ds & fileinfo = fileinfo, abccache = abccache}
| compileStarted
# current = [{iclModule = mdn, options = co, slot = free_slot} : current]
# cinf = compiling_info_async current
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
# async = Async current {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}
= (ps,dircache,True,False,rest,async,ds,True)
// not compileStarted
# cinf = compiling_info_async current
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
# async = Async current {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}
= (ps,dircache,False,False,rest,async,ds,False)
where
get_free_slot :: [CurrentlyCompiled] -> Int
get_free_slot current
= hd (removeMembers [0..] [slot \\ {slot} <- current])
UpdateAsyncDependencies current {max_n_processes,compiler_process_ids,unknown_finished_processors} mdn imp_pathname rest co dircache ds ps
UpdateAsyncDependenciesWin current {win_max_n_processes,win_compiler_process_ids} mdn imp_pathname rest co dircache ds ps
# free_slot = get_free_slot current
# (compileStarted, fileinfo, dircache, abccache,compiler_process_ids,ps)
= CompileTheProjectModuleStart Compilation mdn imp_pathname free_slot ds.fileinfo dircache ds.abccache ds.project compiler_process_ids ps
# (compileStarted, fileinfo, dircache, abccache,win_compiler_process_ids,ps)
= CompileTheProjectModuleStart Compilation mdn imp_pathname free_slot ds.fileinfo dircache ds.abccache ds.project win_compiler_process_ids ps;
# ds = {ds & fileinfo = fileinfo, abccache = abccache}
| compileStarted
# current = [{iclModule = mdn, options = co, slot = free_slot} : current]
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = Async current {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
= (ps,dircache,True,False,rest,async,ds,True)
// not compileStarted
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = Async current {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
= (ps,dircache,False,False,rest,async,ds,False)
where
get_free_slot :: [CurrentlyCompiled] -> Int
get_free_slot current
= hd (removeMembers [0..] [slot \\ {slot} <- current])
UpdateSyncDependencies mdn rest impname co dircache ds ps
# (ps,fileinfo,dircache,abccache,project,ok,newpaths,_,deps)
= CompileTheProjectModule Compilation mdn impname ds.fileinfo dircache ds.abccache ds.project ps
# ds = {ds & fileinfo = fileinfo, abccache = abccache, project = project}
= (ps,dircache,ok,newpaths,deps++|rest,Sync,ds,ok)
get_free_slot :: [CurrentlyCompiled] -> Int
get_free_slot current
= hd (removeMembers [0..] [slot \\ {slot} <- current])
UpdatePersDependencies mdn cstate rest impname co dircache ds ps
# (cstate,(ps,fileinfo,dircache,abccache,project,ok,newpaths,_,deps))
# (cstate,(fileinfo,abccache,project,ok,newpaths,_,deps,dircache,ps))
= PersistentCompile cstate Compilation mdn impname ds.fileinfo dircache ds.abccache ds.project ps
# ds = {ds & fileinfo = fileinfo, abccache = abccache, project = project}
= (ps,dircache,ok,newpaths,deps++|rest,Pers cstate,ds,ok)
// Compile the designated module.
CompileTheProjectModule :: !CompileOrCheckSyntax !ModuleDirAndName !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*GeneralSt
-> *(*GeneralSt,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,[!ModuleDirAndName])
CompileTheProjectModule compileOrCheckSyntax mdn imp_pathname fileinfo dircache abccache project ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= ShowInfoAndCompile compileOrCheckSyntax mdn.mdn_name fileinfo abccache project ps
CompileTheProjectModule :: !CompileOrCheckSyntax !ModuleDirAndName !Pathname !FileInfoCache !*ABCCache !Project !*DirCache !*GeneralSt
-> *(FileInfoCache,*ABCCache,Project,Bool,Bool,Pathname,[!ModuleDirAndName],*DirCache,*GeneralSt)
CompileTheProjectModule compileOrCheckSyntax mdn imp_pathname fileinfo abccache project dircache ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,ps)
= ShowInfoAndCompile compileOrCheckSyntax mdn.mdn_name project ps
| not ok
= (ps,fileinfo,dircache,abccache,project,False,False,"",[!])
= (fileinfo,abccache,project,False,False,"",[!],dircache,ps)
# (use_compiler_process_ids,compiler_process_ids,ps) = get_use_compiler_process_ids_and_compiler_process_ids ps
# (abcpath,res,compiler_process_ids,ps)
= Compile ccstring use_compiler_process_ids write_module_times errwin typwin compileOrCheckSyntax mdn imp_pathname srcpaths mp tp eod co startupdir compiler_process_ids ps
......@@ -1231,38 +1199,35 @@ get_use_compiler_process_ids_and_compiler_process_ids ps
CompileTheProjectModuleStart :: !CompileOrCheckSyntax !ModuleDirAndName !Pathname !Int !FileInfoCache !*DirCache !*ABCCache !Project !CompilerProcessIds !*GeneralSt
-> *(!Bool, FileInfoCache, *DirCache, *ABCCache, CompilerProcessIds, *GeneralSt)
CompileTheProjectModuleStart compileOrCheckSyntax mdn imp_pathname slot fileinfo dircache abccache project compiler_process_ids ps
# (ok,ccstring,write_module_times,errwin,_,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= CTPMcommon mdn.mdn_name fileinfo abccache project ps
# (ok,ccstring,write_module_times,errwin,_,srcpaths,mp,tp,eod,co,startupdir,ps)
= CTPMcommon mdn.mdn_name project ps
| not ok
= (False, fileinfo, dircache, abccache,compiler_process_ids,ps)
# (compileStarted,compiler_process_ids,ps) = CompileStartCommand ccstring write_module_times errwin compileOrCheckSyntax imp_pathname srcpaths slot mp tp eod co startupdir compiler_process_ids ps
= (compileStarted, fileinfo, dircache, abccache,compiler_process_ids,ps)
PersistentCompile :: !*CompilingInfo !CompileOrCheckSyntax !ModuleDirAndName !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*GeneralSt
-> (*CompilingInfo,*(*GeneralSt,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,[!ModuleDirAndName]))
-> (*CompilingInfo,*(FileInfoCache,*ABCCache,Project,Bool,Bool,Pathname,[!ModuleDirAndName],*DirCache,*GeneralSt))
PersistentCompile cstate compileOrCheckSyntax mdn imp_pathname fileinfo dircache abccache project ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= ShowInfoAndCompile compileOrCheckSyntax mdn.mdn_name fileinfo abccache project ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,ps)
= ShowInfoAndCompile compileOrCheckSyntax mdn.mdn_name project ps
| not ok
= (cstate,(ps,fileinfo,dircache,abccache,project,False,False,"",[!]))
= (cstate,(fileinfo,abccache,project,False,False,"",[!],dircache,ps))
# (cstate,(ps,abcpath,res)) = CompilePersistent ccstring write_module_times errwin typwin compileOrCheckSyntax mdn imp_pathname srcpaths mp tp eod co startupdir cstate ps
# (Just cstate,rest)
= ProcessCompilerMsg (Just cstate) compileOrCheckSyntax co mdn abcpath res fileinfo dircache abccache project ps
= (cstate,rest)
//ShowInfoAndCompile :: !CompileOrCheckSyntax !Pathname !FileInfoCache !*ABCCache !Project !*GeneralSt
// -> *(Bool, String, Bool, (!([String]) !*GeneralSt -> *GeneralSt), _, _, _, _, _, _, _, FileInfoCache, *ABCCache, *GeneralSt)
ShowInfoAndCompile compileOrCheckSyntax path fileinfo abccache project ps
# mn = GetModuleName path
# line = Level2 ((if (compileOrCheckSyntax == Compilation) "Compiling '" "Checking '") +++ mn +++ "'.")
ShowInfoAndCompile :: !CompileOrCheckSyntax !Pathname !Project !*GeneralSt
-> *(Bool, String, Bool, ([String] *GeneralSt -> *GeneralSt), ([String] *GeneralSt -> *GeneralSt), List String, Bool, Bool, Bool, CompilerOptions, String, *GeneralSt)
ShowInfoAndCompile compileOrCheckSyntax module_name project ps
# line = Level2 ((if (compileOrCheckSyntax == Compilation) "Compiling '" "Checking '") +++ module_name +++ "'.")
# ps = showInfo line ps
= CTPMcommon mn fileinfo abccache project ps
= CTPMcommon module_name project ps
//CTPMcommon :: !Pathname !Modulename !FileInfoCache !*ABCCache !Project !*GeneralSt
// -> *(Bool, String, Bool, (!([String]) !*GeneralSt -> *GeneralSt), _, _, _, _, _, _, _, FileInfoCache, *ABCCache, *GeneralSt)
CTPMcommon mn fileinfo abccache project ps0
//XXX # ps = showInfo line ps
CTPMcommon :: !Modulename !Project !*GeneralSt
-> *(Bool, String, Bool, ([String] *GeneralSt -> *GeneralSt), ([String] *GeneralSt -> *GeneralSt), List String, Bool, Bool, Bool, CompilerOptions, String, *GeneralSt)
CTPMcommon mn project ps0
# (startupdir,ps) = getStup ps
# ({compopts},ps) = getPrefs ps
# defaultCO = compopts
......@@ -1273,7 +1238,7 @@ CTPMcommon mn fileinfo abccache project ps0
# write_module_times = True//version == 918
#! srcpaths = Concat prjpaths syspaths
= (True,ccstring,write_module_times,updateErrorWindow,typewin mn,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= (True,ccstring,write_module_times,updateErrorWindow,typewin mn,srcpaths,mp,tp,eod,co,startupdir,ps)
where
(syspaths,ps1) = getCurrentPaths ps0
(version,ps) = getCurrentVers ps1
......@@ -1283,7 +1248,7 @@ where
typewin :: !String ![String] !*GeneralSt -> *GeneralSt