Commit 7fb7c206 authored by John van Groningen's avatar John van Groningen

use type GeneralSt from PmCallBack instead of (PSt General)

parent 7a6889c2
definition module PmDriver
import StdPSt
from PmProject import :: Project, :: Pathname
from IdeState import :: General
from PmCleanSystem import :: CompileOrCheckSyntax
import PmCallBack
:: SetMadeProjectFun :==
( Bool
-> Bool
-> Project
-> (PSt General) -> PSt General)
-> GeneralSt -> GeneralSt)
:: CleanupCont :==
Pathname
Bool
Bool
*(PSt *General) -> *(PSt *General)
*GeneralSt -> *GeneralSt
CompileProjectModule :: // Compile or Syntax-check a single module
!CompileOrCheckSyntax
!Pathname
!Project
!SetMadeProjectFun
!*(PSt General) -> *(PSt General)
!*GeneralSt -> *GeneralSt
GenAsmProjectModule :: // Generate assembly for a single module
!.Pathname
!Project
!SetMadeProjectFun
!*(PSt General) -> *(PSt *General)
!*GeneralSt -> *GeneralSt
BringProjectUptoDate :: // Bring complete project up-to-date
!Bool // force recompile...
CleanupCont
!*(PSt *General) -> *PSt *General
!*GeneralSt -> *GeneralSt
......@@ -14,6 +14,8 @@ from errwin import updateErrorWindow, ew_safe_close
from messwin import showInfo, :: InfoMessage(..)
from projwin import pm_update_project_window
import PmCallBack
import PmCleanSystem
import PmPath
import PmProject
......@@ -69,10 +71,10 @@ System :== "_system"
//--- project manager routines
:: SetMadeProjectFun :== (Bool -> Bool -> Project -> (PSt General) -> PSt General)
:: SetMadeProjectFun :== Bool -> Bool -> Project -> GeneralSt -> GeneralSt
// Compile /Check Syntax of the designated module
CompileProjectModule :: !CompileOrCheckSyntax !Pathname !Project !SetMadeProjectFun !*(PSt General) -> *(PSt General)
CompileProjectModule :: !CompileOrCheckSyntax !Pathname !Project !SetMadeProjectFun !*GeneralSt -> *GeneralSt
CompileProjectModule compilerOrCheckSyntax path project setproject ps
# ps = ClearCompilerCache` ps
# (syspaths,ps) = getCurrentPaths ps
......@@ -90,7 +92,7 @@ CompileProjectModule compilerOrCheckSyntax path project setproject ps
# ps = setFICache fileinfo ps
= setproject ok newpaths project ps
GenAsmProjectModule :: !.Pathname !Project !SetMadeProjectFun !*(PSt General) -> *(PSt *General)
GenAsmProjectModule :: !.Pathname !Project !SetMadeProjectFun !*GeneralSt -> *GeneralSt
GenAsmProjectModule path project setproject ps
# ps = ClearCompilerCache` ps
# (syspaths,ps) = getCurrentPaths ps
......@@ -114,7 +116,7 @@ GenAsmProjectModule path project setproject ps
# ps = setFICache fileinfo ps
= setproject True ok project ps
:: CleanupCont :== Pathname Bool Bool *(PSt *General) -> *(PSt *General)
:: CleanupCont :== Pathname Bool Bool *GeneralSt -> *GeneralSt
:: *DriverCompilingInfo
= Sync
......@@ -133,7 +135,7 @@ GenAsmProjectModule path project setproject ps
unknown_finished_processors :: !UnknownFinishedProcessors
};
BringProjectUptoDate :: !Bool CleanupCont !*(PSt *General) -> *PSt *General
BringProjectUptoDate :: !Bool CleanupCont !*GeneralSt -> *GeneralSt
BringProjectUptoDate force continuation ps
# (project,ps) = getProject ps
......@@ -175,7 +177,7 @@ where
= ps
= ps
cleanup :: !Bool !Bool !Bool !FileInfoCache !StaticLibInfo !(List Modulename) !Project !Bool (!*ABCCache,!(PSt *General)) -> *(!*DriverState,!PSt *General)
cleanup :: !Bool !Bool !Bool !FileInfoCache !StaticLibInfo !(List Modulename) !Project !Bool (!*ABCCache,!GeneralSt) -> *(!*DriverState,!*GeneralSt)
cleanup ok newpaths linked fileinfo libsinfo modpaths project intr (abccache,ps)
| newpaths && not intr // if paths have changed -> try again
# ps = showInfo (Level1 "Paths have changed: remaking.") ps
......@@ -197,9 +199,9 @@ where
//-- Private stuff
:: MTPContinuation :== Bool Bool Bool FileInfoCache StaticLibInfo (List Modulename) Project Bool *(*ABCCache,(PSt *General)) -> *(*DriverState,PSt *General)
:: MTPContinuation :== Bool Bool Bool FileInfoCache StaticLibInfo (List Modulename) Project Bool *(*ABCCache,GeneralSt) -> *(*DriverState,*GeneralSt)
MakeTheProject :: !Bool !FileInfoCache !StaticLibInfo !*ABCCache !Project !MTPContinuation !(PSt General) -> (!*DriverState,!PSt General)
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
......@@ -284,19 +286,19 @@ where
//--
cont :: !*(.a,!*(PSt *General)) -> *(.a,!*(PSt *General));
cont :: !*(.a,!*GeneralSt) -> *(.a,!*GeneralSt);
cont (ls,ps)
# (intr_info,ps) = getInterrupt ps
# ps = ContIntr intr_info ps
= (ls,ps)
stop :: !*(.a,!*(PSt *General)) -> *(.a,!*(PSt *General));
stop :: !*(.a,!*GeneralSt) -> *(.a,!*GeneralSt);
stop (ls,ps)
# (intr_info,ps) = getInterrupt ps
# ps = StopIntr intr_info ps
= (ls,ps)
step :: !Bool !*DriverState !*(PSt General) -> (!*DriverState,!*(PSt General))
step :: !Bool !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
step intr (DInit force project setproject) ps
// # ps = showInfo (Level1 "Make the project...") ps
# libsinfo = PR_GetStaticLibsInfo project
......@@ -405,7 +407,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# (state, ps) = start_compilations state ps
= cont (state, ps)
where
check_completed :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
check_completed :: !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
check_completed state=:(DComp force _ (Async current=:[_:_] {max_n_processes}) _ _) ps
= case (CompilePollCompleted ps) of
(NoFinishedCompiler,ps)
......@@ -444,7 +446,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
check_unknow_processors_are_known state ps
= (state, ps)
process_completed :: !Int !Int !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
process_completed :: !Int !Int !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
process_completed completedSlot exitcode (DComp force dircache (Async current {max_n_processes,compiler_process_ids,unknown_finished_processors}) todo ds) ps
# (completed, current) = removeFromCurrent completedSlot current
# unknown_finished_processors = remove_from_unknown_finished_processors completedSlot unknown_finished_processors
......@@ -474,7 +476,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# (completed, rest) = removeFromCurrent completedSlot rest
= (completed, [current : rest])
start_compilations :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
start_compilations :: !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
start_compilations state=:(DComp force dircache (Async current {max_n_processes,compiler_process_ids,unknown_finished_processors}) (next :! rest) ds) ps
// all threads used?
| length current >= max_n_processes
......@@ -512,7 +514,7 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# (state, ps) = start_compilations state ps
= cont (state, ps)
where
check_completed :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
check_completed :: !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
check_completed state=:(DComp _ _ (AsyncWin current=:[_:_] _) _ _) ps
= case (CompilePollCompleted ps) of
(NoFinishedCompiler, ps)
......@@ -525,7 +527,7 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
check_completed state ps
= (state, ps)
process_completed :: !Int !Int !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
process_completed :: !Int !Int !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
process_completed completedSlot exitcode (DComp force dircache (AsyncWin current {win_max_n_processes,win_compiler_process_ids}) todo ds) ps
# (completed, current) = removeFromCurrent completedSlot current
# (startupdir,ps) = getStup ps
......@@ -554,7 +556,7 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# (completed, rest) = removeFromCurrent completedSlot rest
= (completed, [current : rest])
start_compilations :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
start_compilations :: !*DriverState !*GeneralSt -> (!*DriverState,!*GeneralSt)
start_compilations state=:(DComp force dircache (AsyncWin current {win_max_n_processes,win_compiler_process_ids}) (next :! rest) ds) ps
| length current >= win_max_n_processes
# ps = DelayEventLoop ps;
......@@ -674,7 +676,7 @@ step intr (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes,comp
= 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
with
start_code_generators :: (List {#Char}) [(Int,{#Char},{#Char})] FileInfoCache *ABCCache !*(PSt *General) -> *(.Bool,(List {#Char}),[(Int,{#Char},{#Char})],FileInfoCache,*ABCCache,!*(PSt *General))
start_code_generators :: (List {#Char}) [(Int,{#Char},{#Char})] FileInfoCache *ABCCache !*GeneralSt -> *(.Bool,(List {#Char}),[(Int,{#Char},{#Char})],FileInfoCache,*ABCCache,!*GeneralSt)
start_code_generators paths=:(path :! rest) busy_processes fileinfo abccache ps
| length busy_processes>=max_n_processes
# ps = DelayEventLoop ps
......@@ -998,8 +1000,8 @@ compiling_info_async current
= foldl (\s c -> s +++ " "+++(GetModuleName c.iclModule)) "Compiling:" current
// Scan modified modules and update the dependencies (recompile if necessary).
UpdateDependencies :: !Bool !String !(List String) !DriverCompilingInfo !*DirCache !DriverStateRecord !*(PSt *General)
-> (*(PSt *General),*DirCache,Bool,Bool,List String,DriverCompilingInfo,DriverStateRecord,Bool)
UpdateDependencies :: !Bool !String !(List String) !DriverCompilingInfo !*DirCache !DriverStateRecord !*GeneralSt
-> (*GeneralSt,*DirCache,Bool,Bool,List String,DriverCompilingInfo,DriverStateRecord,Bool)
UpdateDependencies force next rest compinfo dircache ds ps`
# impname = MakeImpPathname next
......@@ -1195,8 +1197,8 @@ UpdatePersDependencies cstate rest impname co dircache ds ps
= (ps,dircache,ok,newpaths,Concat deps rest,Pers cstate,ds,ok)
// Compile the designated module.
CompileTheProjectModule :: !CompileOrCheckSyntax !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*(PSt *General)
-> *(*PSt *General,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,List Pathname)
CompileTheProjectModule :: !CompileOrCheckSyntax !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*GeneralSt
-> *(*GeneralSt,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,List Pathname)
CompileTheProjectModule compileOrCheckSyntax path fileinfo dircache abccache project ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= ShowInfoAndCompile compileOrCheckSyntax path fileinfo abccache project ps
......@@ -1208,15 +1210,15 @@ CompileTheProjectModule compileOrCheckSyntax path fileinfo dircache abccache pro
# (_,res) = ProcessCompilerMsg Nothing compileOrCheckSyntax co path abcpath res fileinfo dircache abccache project ps
= res
get_use_compiler_process_ids_and_compiler_process_ids :: !*(PSt *General) -> (!Bool,!CompilerProcessIds,!*(PSt *General))
get_use_compiler_process_ids_and_compiler_process_ids :: !*GeneralSt -> (!Bool,!CompilerProcessIds,!*GeneralSt)
get_use_compiler_process_ids_and_compiler_process_ids ps
# (method,ps) = getCurrentMeth ps
# use_compiler_process_ids = case method of CompileAsync _ -> True ; _ -> False
# (compiler_process_ids,ps) = getCompilerProcessIds ps
= (use_compiler_process_ids,compiler_process_ids,ps)
CompileTheProjectModuleStart :: !CompileOrCheckSyntax !Pathname !Int !FileInfoCache !*DirCache !*ABCCache !Project !CompilerProcessIds !*(PSt *General)
-> *(!Bool, FileInfoCache, *DirCache, *ABCCache, CompilerProcessIds, PSt *General)
CompileTheProjectModuleStart :: !CompileOrCheckSyntax !Pathname !Int !FileInfoCache !*DirCache !*ABCCache !Project !CompilerProcessIds !*GeneralSt
-> *(!Bool, FileInfoCache, *DirCache, *ABCCache, CompilerProcessIds, *GeneralSt)
CompileTheProjectModuleStart compileOrCheckSyntax path slot fileinfo dircache abccache project compiler_process_ids ps
# mn = GetModuleName path
# (ok,ccstring,write_module_times,errwin,_,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
......@@ -1226,8 +1228,8 @@ CompileTheProjectModuleStart compileOrCheckSyntax path slot fileinfo dircache ab
# (compileStarted,compiler_process_ids,ps) = CompileStartCommand ccstring write_module_times errwin compileOrCheckSyntax path srcpaths slot mp tp eod co startupdir compiler_process_ids ps
= (compileStarted, fileinfo, dircache, abccache,compiler_process_ids,ps)
PersistentCompile :: !*CompilingInfo !CompileOrCheckSyntax !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*(PSt *General)
-> (*CompilingInfo,*(*PSt *General,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,List Pathname))
PersistentCompile :: !*CompilingInfo !CompileOrCheckSyntax !Pathname !FileInfoCache !*DirCache !*ABCCache !Project !*GeneralSt
-> (*CompilingInfo,*(*GeneralSt,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,List Pathname))
PersistentCompile cstate compileOrCheckSyntax path fileinfo dircache abccache project ps
# (ok,ccstring,write_module_times,errwin,typwin,srcpaths,mp,tp,eod,co,startupdir,fileinfo,abccache,ps)
= ShowInfoAndCompile compileOrCheckSyntax path fileinfo abccache project ps
......@@ -1239,16 +1241,16 @@ PersistentCompile cstate compileOrCheckSyntax path fileinfo dircache abccache pr
= (cstate,rest)
//ShowInfoAndCompile :: !CompileOrCheckSyntax !Pathname !FileInfoCache !*ABCCache !Project !*(PSt *General)
// -> *(Bool, String, Bool, (!([String]) !*(PSt *General) -> *PSt *General), _, _, _, _, _, _, _, FileInfoCache, *ABCCache, PSt *General)
//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 +++ "'.")
# ps = showInfo line ps
= CTPMcommon /*compileOrCheckSyntax*/ path mn fileinfo abccache project ps
//CTPMcommon :: !CompileOrCheckSyntax !Pathname !Modulename !FileInfoCache !*ABCCache !Project !*(PSt *General)
// -> *(Bool, String, Bool, (!([String]) !*(PSt *General) -> *PSt *General), _, _, _, _, _, _, _, FileInfoCache, *ABCCache, PSt *General)
//CTPMcommon :: !CompileOrCheckSyntax !Pathname !Modulename !FileInfoCache !*ABCCache !Project !*GeneralSt
// -> *(Bool, String, Bool, (!([String]) !*GeneralSt -> *GeneralSt), _, _, _, _, _, _, _, FileInfoCache, *ABCCache, *GeneralSt)
CTPMcommon /*compileOrCheckSyntax*/ path mn fileinfo abccache project ps0
//XXX # ps = showInfo line ps
# (startupdir,ps) = getStup ps
......@@ -1270,7 +1272,7 @@ where
ao = PR_GetApplicationOptions project
prjpaths = PR_GetPaths project
// proc = PR_GetProcessor project
typewin :: !String ![String] !*(PSt *General) -> *PSt *General
typewin :: !String ![String] !*GeneralSt -> *GeneralSt
typewin mn strings ps
# (interact, ps) = getInteract ps
= updateTypeWindow interact mn [typeWinKeyboard, typeWinMouse] strings ps
......@@ -1282,8 +1284,8 @@ where
// LM_Eager -> True
LM_Dynamic -> True
// ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*(PSt *General)
// -> *(*PSt *General,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String)
// ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*GeneralSt
// -> *(*GeneralSt,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String)
ProcessCompilerMsg cstate compileOrCheckSyntax _ path abcpath (Patherror pathname) fileinfo dircache abccache project ps
# (interact, ps) = getInteract ps
| not interact
......@@ -1307,7 +1309,7 @@ ProcessCompilerMsg cstate compileOrCheckSyntax _ path abcpath (Patherror pathnam
= (cstate,CompileTheProjectModule compileOrCheckSyntax path fileinfo dircache abccache project ps)
= (cstate,(ps,fileinfo,dircache,abccache,project,False,new,abcpath,Nil))
where
NewPathsDialog :: !String !String !Project !*(PSt General) -> *(*PSt General,Project,Bool)
NewPathsDialog :: !String !String !Project !*GeneralSt -> *(*GeneralSt,Project,Bool)
NewPathsDialog module_name path project ps
# (ap,ps) = getStup ps
# (pp,ps) = getPath ps
......@@ -1450,7 +1452,7 @@ where
//-- Generate Phase...
// Generate code for the designated module.
GenCodeTheProjectModule :: !.Bool !.Bool !.CodeGenerateAsmOrCode !.Pathname !*ABCCache !FileInfoCache !Project !*(PSt General) -> *(*PSt General,*ABCCache,FileInfoCache,Project,Bool,Pathname)
GenCodeTheProjectModule :: !.Bool !.Bool !.CodeGenerateAsmOrCode !.Pathname !*ABCCache !FileInfoCache !Project !*GeneralSt -> *(*GeneralSt,*ABCCache,FileInfoCache,Project,Bool,Pathname)
GenCodeTheProjectModule outofdate sys genAsmOrCode abc_path abccache fileinfo project ps`
# (proc,ps) = getCurrentProc ps
# ((abccache,fileinfo,info), ps) = FI_GetFileInfo proc abc_path abccache fileinfo ps
......@@ -1484,7 +1486,7 @@ where
(prefs,ps) = getPrefs ps`
// Checks whether .o files in the project are out of date.
CheckABCOutOfDate :: !.Bool !.Pathname !*ABCCache !FileInfoCache !Project !*(PSt General) -> *(*(PSt General),*ABCCache,FileInfoCache,Bool,Pathname)
CheckABCOutOfDate :: !.Bool !.Pathname !*ABCCache !FileInfoCache !Project !*GeneralSt -> *(*GeneralSt,*ABCCache,FileInfoCache,Bool,Pathname)
CheckABCOutOfDate sys path abccache fileinfo project ps
// # tp = PR_GetProcessor project
# (tp,ps) = getCurrentProc ps
......@@ -1559,7 +1561,7 @@ where
| Older_Date date objDate = trace_n` ("OlderDate",hd,date,objDate) (True,files)
= check date tl files
CheckExecOutOfDate :: !Bool !Pathname !FileInfoCache !Project !*(PSt General) -> *(Bool,*PSt General)
CheckExecOutOfDate :: !Bool !Pathname !FileInfoCache !Project !*GeneralSt -> *(Bool,*GeneralSt)
CheckExecOutOfDate gen execpath fileinfo project ps
| gen
= (True,ps)
......@@ -1646,7 +1648,7 @@ finddef path dircache
//-- Handle DirCache Setup Errors...
HandleDCErrors :: !Bool ![String] ![Warn] !*(PSt *General) -> *(PSt *General)
HandleDCErrors :: !Bool ![String] ![Warn] !*GeneralSt -> *GeneralSt
HandleDCErrors _ [] [] ps
= ps
HandleDCErrors verbose [] warns ps
......
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