Skip to content

GitLab

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

use type GeneralSt from PmCallBack instead of (PSt General)

parent 7a6889c2
Hide whitespace changes
Inline Side-by-side
Pm/PmDriver.dcl
View file @ 7fb7c206
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
Pm/PmDriver.icl
View file @ 7fb7c206
......@@ -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