implementation module EdProjectAux

/*	This module contains auxilary functions needed for the implementation of EdProject.
	The need for a seperate module arises from the fact that the Clean Linker complains about
	object file format size (> 32K).
*/

import StdClass
import StdBool, StdString, StdInt
import EdTypes, EdLists, EdMyIO, EdPath, EdProgramState

EmptyInfListItem
	:== {	mn		= "",
			info	= EmtyModInfo,
			src		= True,
			abc		= True }

//	First element of InfList (if any) is the root module.

::	InfList		:==	List InfListItem
	
::	InfListItem	=	{	mn		:: !Modulename, 
						info	:: !ModInfo,
						src		:: !Bool,
						abc		:: !Bool }
	// module name, ,module info, src up to date?, abc up to date?

::	InfUpdate 	:== InfListItem -> (!InfListItem, !Bool)

EmtyModInfo :: ModInfo
EmtyModInfo	= {	dir		= EmptyPathname,
				compilerOptions		= DefaultCompilerOptions,
				defeo 	= {eo=DefaultEditOptions,pos_size=DefWindowPos_and_Size},
				impeo	= {eo=DefaultEditOptions,pos_size=DefWindowPos_and_Size},
				defopen = False,
				impopen = False,
				date	= NoDate,
				deps	= Nil,
				abcLinkInfo = { linkObjFileNames=Nil, linkLibraryNames=Nil }	// MW++
			  }

P_MapR :: !(s -> (!t,!Bool)) !(List s) -> (!List t,!Bool)
P_MapR f Nil
	=	(Nil, True)
P_MapR f (x:!xs)
	=	P_MapR2 b f xs fx Nil
	where
		(fx,b)
			=	f x

P_MapR2 :: !Bool !(s -> (!t,!Bool)) !(List s) !t !(List t) -> (!List t,!Bool)
P_MapR2 unchanged f Nil		first acc = (first:!acc, unchanged)
P_MapR2 unchanged f (x:!xs)	first acc = P_MapR2 (unchanged && b) f xs first (fx:!acc)
where
	(fx,b)	= f x

GetDeps2	:: !Bool !(List Modulename) !(List Modulename) !InfList !InfList -> List Modulename
GetDeps2 changed done closure list Nil
	| changed	= GetDeps2 False done closure list list
				= closure
GetDeps2 changed done closure list
				(({mn,info={deps}}):!rest)
	| in_done	= GetDeps2 changed done closure list rest
	| in_clos	= GetDeps2 True done` closure` list rest
				= GetDeps2 changed done closure list rest
	where
		in_done		= StringOccurs mn done
		in_clos		= StringOccurs mn closure
		done`		= mn :! done
		closure`	= UnionStringList closure deps

RemoveUnusedModules :: !InfList -> InfList
RemoveUnusedModules Nil = Nil
RemoveUnusedModules list=:(root:!Nil) = list
RemoveUnusedModules ((root=:{mn=rootmn,info={deps}}):!rest)
	= root :! FilterR member rest
	where
		closure		= GetDeps2 False Nil deps rest rest
		member {mn}	= StringOccurs mn closure && rootmn <> mn
	
//
//	Operations on tables
//

TryInsertInList :: !String !(List String) !InfList -> (!InfList,!Bool)
TryInsertInList importer importees Nil
	= (Nil,True)
TryInsertInList importer importees ((root=:{mn,info={compilerOptions,defeo,impeo}}):!rest)
	| importermn == mn
		= (root` :! TryInsertImportees compilerOptions impeo importees rest,not_removeda)
		with
			(root`,not_removeda)	= UpdateImporter importerdir importees root
		= (root :! TryInsertImportees compilerOptions impeo importees rest`,not_removedb)
		with
			(rest`,not_removedb)	= TryInsertImporter compilerOptions impeo importerdir importermn  importees rest rest
	where
		importermn				= GetModuleName importer
		importerdir				= RemoveFilename importer
							
TryInsertImporter ::	!CompilerOptions !EditWdOptions !String !String !(List String) !InfList !InfList
						-> (!InfList,!Bool)
TryInsertImporter co eo importerdir importermn importees Nil list
	= (MakeNewItem co eo importerdir importermn importees :! list, True)
TryInsertImporter co eo importerdir importermn importees ((itm=:{mn}):!rest) list
	| importermn<>mn
		= TryInsertImporter co eo importerdir importermn importees rest list
		= UpdateList importermn update list
		with
			update itm = UpdateImporter importerdir importees itm
					
TryInsertImportee :: !CompilerOptions !EditWdOptions !String !String !InfList !InfList -> InfList
TryInsertImportee co eo importeedir importeemn  Nil list
	= MakeNewItem co eo importeedir importeemn Nil :! list
TryInsertImportee co eo importeedir importeemn ({mn,info={dir}}:!rest) list
	| not_found_importee	= TryInsertImportee co eo importeedir importeemn rest list
	| same_dir				= list
							= list`
	where
		not_found_importee	= mn <> importeemn
		same_dir			= importeedir == dir
		(list`,_)			= UpdateList importeemn update list
		update itm			= UpdateImportee importeedir itm
	
TryInsertImportees :: !CompilerOptions !EditWdOptions !(List String) !InfList -> InfList
TryInsertImportees co eo Nil list
	= list
TryInsertImportees co eo (importee:!rest)  list
	= TryInsertImportees co eo rest (TryInsertImportee co eo importeedir importeemn list list)
	where
		importeedir	= RemoveFilename importee
		importeemn	= GetModuleName importee

UpdateImporter :: !String !(List String) !InfListItem -> (!InfListItem,!Bool)
UpdateImporter importerdir importees itm=:{mn,info=minfo=:{dir,deps}}
	= ({itm & info = imports`},not_removed)
	where
		imports`			= {minfo & dir = dir`, deps = deps`}
		deps`				= SortStrings (mn:!MapR GetModuleName importees)
		dir` | dir == ""	= importerdir
							= dir
		not_removed			= case deps of
									_:!Nil	-> True
									_		-> False
 
	
UpdateImportee :: !String !InfListItem -> (!InfListItem,!Bool)
UpdateImportee importeedir itm=:{info} = ({itm & info = {info & dir = importeedir}}, True)
	
MakeNewItem :: !CompilerOptions !EditWdOptions !String !String  !(List String) -> InfListItem
MakeNewItem compilerOptions eo dir mn importees
	= {	mn		= mn, 
		info	= { dir		= dir,
					compilerOptions = compilerOptions,
					defeo	= eo,
					impeo	= eo,
					defopen	= False,
					impopen	= False,
					date	= NoDate,
					deps	= deps,
					abcLinkInfo = { linkObjFileNames=Nil, linkLibraryNames=Nil } // MW++
				},
		src		= True,
		abc		= True }
	where
		deps	= SortStrings (mn :! MapR GetModuleName importees)

UpdateList :: !String InfUpdate !InfList -> (!InfList,!Bool)
UpdateList key update list = UpdateList2 key update list Nil
	
UpdateList2 :: !String InfUpdate !InfList !InfList -> (!InfList,!Bool)
UpdateList2 key update Nil							acc
	=  (Reverse2 acc Nil,True)
UpdateList2 key update ((first=:{mn,info}):!rest)	acc
	| mn <> key
		= UpdateList2 key update rest (first:!acc)
		= (Reverse2 acc (first` :! rest), changed)
	where
		(first`,changed)	= update first
	
FindInList	:: !String !InfList -> (!Bool, !InfListItem)
FindInList key Nil									= (False, EmptyInfListItem)
FindInList key ((itm=:{mn,info}):!rest)	| mn <> key	= FindInList key rest
													= (True, itm)

/* Comparison functions for project options */

instance == ModInfo
where
	(==) :: !ModInfo !ModInfo -> Bool
	(==) info1 info2
		=	info1.defeo.eo == info2.defeo.eo &&
			info1.impeo.eo == info2.impeo.eo &&
			info1.compilerOptions == info2.compilerOptions &&
			info1.defeo.pos_size == info2.defeo.pos_size && 
			info1.impeo.pos_size == info2.impeo.pos_size &&
			info1.defopen == info2.defopen &&
			info1.impopen == info2.impopen

instance == EditOptions
where
	(==) :: !EditOptions !EditOptions -> Bool
	(==) eo1 eo2
		=	eo1.tabs == eo2.tabs &&
			eo1.EditOptions.fontname == eo2.EditOptions.fontname &&
			eo1.EditOptions.fontsize == eo2.EditOptions.fontsize &&
			eo1.EditOptions.autoi == eo2.EditOptions.autoi

instance == WindowPos_and_Size
where
	(==) :: !WindowPos_and_Size !WindowPos_and_Size -> Bool
	(==) pos1 pos2
		=	pos1.posx == pos2.posx &&
			pos1.posy == pos2.posy &&
			pos1.sizex == pos2.sizex &&
			pos1.sizey == pos2.sizey

instance == CompilerOptions
where
	(==) :: !CompilerOptions !CompilerOptions -> Bool
	(==) co1 co2
		=	co1.neverTimeProfile == co2.neverTimeProfile &&
			co1.neverMemoryProfile == co2.neverMemoryProfile &&
			co1.sa == co2.sa &&
			co1.CompilerOptions.listTypes == co2.CompilerOptions.listTypes &&
			co1.gw == co2.gw &&
			co1.bv == co2.bv &&
			co1.gc == co2.gc
		
instance == CodeGenOptions
where
	(==) :: !CodeGenOptions !CodeGenOptions -> Bool
	(==) cg1 cg2
		=	cg1.cs == cg2.cs &&
			cg1.ci == cg2.ci &&
			cg1.tp == cg2.tp

instance == ApplicationOptions
where
	(==) :: !ApplicationOptions !ApplicationOptions -> Bool
	(==) ao1 ao2
		=	ao1.hs == ao2.hs &&
			ao1.ss == ao2.ss &&
			ao1.em == ao2.em &&
			ao1.set == ao2.set &&
			ao1.sgc == ao2.sgc &&
			ao1.pss == ao2.pss &&
			ao1.o == ao2.o &&
			ao1.fn == ao2.fn &&
			ao1.fs == ao2.fs &&
			ao1.marking_collection == ao2.marking_collection &&
			ao1.heap_size_multiple == ao2.heap_size_multiple &&
			ao1.initial_heap_size == ao2.initial_heap_size &&
			ao1.memoryProfiling == ao2.memoryProfiling &&
			ao1.memoryProfilingMinimumHeapSize == ao2.memoryProfilingMinimumHeapSize &&
			ao1.profiling601 == ao2.profiling601 &&
			ao1.profiling == ao2.profiling

instance == LinkOptions
where
	(==) :: !LinkOptions !LinkOptions -> Bool
	(==) lo1 lo2
		=	lo1.useDefaultSystemObjects == lo2.useDefaultSystemObjects &&
			lo1.useDefaultLibraries == lo2.useDefaultLibraries &&
			EQStrings (SortStrings lo1.extraObjectModules) (SortStrings lo2.extraObjectModules) &&
			EQStrings (SortStrings lo1.libraries) (SortStrings lo2.libraries)

instance == ProjectOptions
where
	(==) :: !ProjectOptions !ProjectOptions -> Bool
	(==) po1 po2
		= po1.ProjectOptions.verbose == po2.ProjectOptions.verbose
	
instance == DATE
where
	(==) :: !DATE !DATE -> Bool
	(==) date1 date2
		=	date1.exists == date2.exists &&
			date1.yy == date2.yy &&
			date1.mm == date2.mm &&
			date1.dd == date2.dd &&
			date1.h == date2.h &&
			date1.m == date2.m &&
			date1.s == date2.s
