implementation module compile

import StdEnv
import frontend
import backendinterface
import CoclSystemDependent
import RWSDebug

::	CoclOptions =
	{
		moduleName
			:: {#Char}
	,	pathName ::
			{#Char}
	,	errorPath
			:: {#Char}
	,	errorMode
			::	Int
	,	outPath
			:: {#Char}
	,	outMode
			::	Int
	,	searchPaths
			:: SearchPaths
	}

InitialCoclOptions =
	{	moduleName
			=	""
	,	pathName
			=	""
	,	errorPath
			=	"errors"
	,	errorMode
			=	FWriteText
	,	outPath
			=	"out"
	,	outMode
			=	FWriteText
	,	searchPaths
			=	{sp_locations = [], sp_paths = []}
	}

compile :: [{#Char}] *Files -> (!Bool, !*Files)
compile args files
	# (args_without_modules,modules,cocl_options) = parseCommandLine args InitialCoclOptions
	# heaps = { hp_var_heap = newHeap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }}
	# (predef_symbols, hash_table) = buildPredefinedSymbols newHashTable
	= compile_modules modules 0 cocl_options args_without_modules {} {} predef_symbols hash_table heaps files;

parseCommandLine :: [{#Char}] CoclOptions -> ([{#Char}],[{#Char}],CoclOptions)
parseCommandLine [] options
	=	([],[],options)
/*
	// JVG: removed hack because the searchPaths list becomes too large when >1 file is compiled
	=	prependModulePath options
	where
		// RWS +++ hack, both module name and file path should be passed to frontEndInterface
		prependModulePath options=:{pathName, searchPaths}
			=	{	options
				&	moduleName = baseName pathName
				,	searchPaths = {searchPaths & sp_paths = [directoryName pathName : searchPaths.sp_paths]}
				}
*/
parseCommandLine [arg1=:"-P", searchPathsString : args] options=:{searchPaths}
// RWS, voor Maarten +++	=	parseCommandLine args {options & searchPaths = {searchPaths & sp_paths = splitPaths searchPathsString}}
	# (args,modules,options) =	parseCommandLine args {options & searchPaths.sp_paths = splitPaths searchPathsString}
	= ([arg1,searchPathsString:args],modules,options)
parseCommandLine [arg1=:"-RO", outPath : args] options
	# (args,modules,options)=	parseCommandLine args {options & outPath = stripQuotes outPath, outMode = FWriteText}
	= ([arg1,outPath:args],modules,options)
parseCommandLine [arg1=:"-RAO", outPath : args] options
	# (args,modules,options)=	parseCommandLine args {options & outPath = stripQuotes outPath, outMode = FAppendText}
	= ([arg1,outPath:args],modules,options)
parseCommandLine [arg1=:"-RE", errorPath : args] options
	# (args,modules,options)=	parseCommandLine args {options & errorPath = stripQuotes errorPath, errorMode = FWriteText}
	= ([arg1,errorPath:args],modules,options)
parseCommandLine [arg1=:"-RAE", errorPath : args] options
	# (args,modules,options)=	parseCommandLine args {options & errorPath = stripQuotes errorPath, errorMode = FAppendText}
	= ([arg1,errorPath:args],modules,options)
parseCommandLine [arg : args] options
	| arg.[0] == '-'
		# (args,modules,options)=	parseCommandLine args options
		= ([arg:args],modules,options)
	// otherwise
		# (args,modules,options) = parseCommandLine args options
		= (args,[arg : modules],options);

stripExtension :: {#Char} {#Char} -> {#Char}
stripExtension extension string
	| stringSize >= extensionSize && (string % (stringSize-extensionSize, stringSize-1)) == extension
		=	string % (0, stringSize-extensionSize-1)
	// otherwise
		=	string
	where
		stringSize
			=	size string
		extensionSize
			=	size extension

stripQuotes :: {#Char} -> {#Char}
stripQuotes string
	| stringSize > 1 && string.[0] == '"' && string.[stringSize-1] == '"'
		=	string % (1, stringSize-2)
	// otherwise
		=	string
	where
		stringSize
			=	size string

splitPaths :: {#Char} -> [{#Char}]
splitPaths paths
	=	[path +++ {DirectorySeparator} \\ path <- splitBy PathSeparator paths]

splitBy :: Char {#Char} -> [{#Char}]
splitBy char string
	=	splitBy` 0 0
	where
		splitBy` frm to
			| to >= stringSize
				=	[string % (frm, to-1)]
			| string.[to] == char
				=	[string % (frm, to-1) : splitBy` (to+1) (to+1)]
			// otherwise
				=	splitBy` frm (to+1)
		stringSize
			=	size string

baseName :: {#Char} -> {#Char}
baseName path
	=	last (splitBy DirectorySeparator path)

directoryName :: {#Char} -> {#Char}
directoryName path
	=	foldr (\p ps -> p +++ {DirectorySeparator} +++ ps) "" (init (splitBy DirectorySeparator path))

compile_modules [module_:modules] n_compiles cocl_options args_without_modules dcl_modules functions_and_macros predef_symbols hash_table heaps files
	# cocl_options = prependModulePath {cocl_options & pathName=stripExtension ".icl" (stripQuotes module_)}
		with
		// RWS +++ hack, both module name and file path should be passed to frontEndInterface
		prependModulePath options=:{pathName, searchPaths}
			=	{	options
				&	moduleName = baseName pathName
					// RWS, voor Maarten +++				,	searchPaths = {searchPaths & sp_paths = [directoryName pathName : searchPaths.sp_paths]}
//				,	searchPaths = [directoryName pathName : searchPaths]
				}
	# (ok,dcl_modules,functions_and_macros,n_functions_and_macros_in_dcl_modules,predef_symbols,hash_table,heaps,files)
		= compileModule cocl_options (args_without_modules++[module_]) dcl_modules functions_and_macros predef_symbols hash_table heaps files;
	| ok
//		# hash_table=remove_module_idents_from_symbol_table 0 dcl_modules hash_table;
/*		# hash_table=remove_module_ident_from_symbol_table dcl_modules.[0] hash_table;
			with
			remove_module_idents_from_symbol_table module_n dcl_modules hash_table
				| module_n==size dcl_modules
					= hash_table;
					# hash_table = remove_module_ident_from_symbol_table dcl_modules.[module_n] hash_table
					= remove_module_idents_from_symbol_table (module_n+1) dcl_modules hash_table

			remove_module_ident_from_symbol_table dcl_module hash_table
					# module_symbol_pointer = dcl_module.dcl_name.id_info;
					# symbol_heap=hash_table.hte_symbol_heap;
					# (hte_entry,symbol_heap) = readPtr module_symbol_pointer symbol_heap
					# symbol_heap=writePtr module_symbol_pointer {hte_entry & ste_kind=STE_Empty} symbol_heap
					= {hash_table & hte_symbol_heap=symbol_heap}
		# dcl_modules = {dcl_modules.[module_n] \\ module_n <-[1..size dcl_modules-1]}
*/
/*
		# heaps = { hp_var_heap = newHeap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }}
		# (predef_symbols, hash_table) = buildPredefinedSymbols newHashTable
		= compile_modules modules 0 cocl_options args_without_modules {} {} predef_symbols hash_table heaps files;
*/
		= compile_modules modules (n_compiles+1) cocl_options args_without_modules dcl_modules functions_and_macros predef_symbols hash_table heaps files;

		= (ok,files);
compile_modules [] n_compiles cocl_options args_without_modules dcl_modules functions_and_macros predef_symbols hash_table heaps files
	= (True,files);

compileModule :: CoclOptions [{#Char}] {#DclModule} {#FunDef} *PredefinedSymbols !*HashTable *Heaps *Files -> (!Bool,!{#DclModule},!{#FunDef},!Int,!*PredefinedSymbols,!*HashTable,!*Heaps, !*Files)
compileModule options commandLineArgs dcl_modules functions_and_macros predef_symbols hash_table heaps files
	# (opened, error, files)
		=	fopen options.errorPath options.errorMode files
	| not opened
		=	abort ("couldn't open error file \"" +++ options.errorPath +++ "\"\n")
	# (opened, out, files)
		=	fopen options.outPath options.outMode files
	| not opened
		=	abort ("couldn't open out file \"" +++ options.outPath +++ "\"\n")
	# (io, files)
		=	stdio files
//	  (moduleIdent, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
	# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
	#  list_inferred_types = if (isMember "-lt" commandLineArgs) (Yes (not (isMember "-lattr" commandLineArgs))) No
	# (optionalSyntaxTree,cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out,heaps)
		=	frontEndInterface FrontEndPhaseAll moduleIdent options.searchPaths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out heaps
	# unique_copy_of_predef_symbols={predef_symbol\\predef_symbol<-:predef_symbols}
	# (closed, files)
		=	fclose io files
	| not closed
		=	abort ("couldn't close stdio")
	# (closed, files)
		=	fclose out files
	| not closed
		=	abort ("couldn't close out file \"" +++ options.outPath +++ "\"\n")
	# var_heap=heaps.hp_var_heap
	# (success,dcl_modules,functions_and_macros,n_functions_and_macros_in_dcl_modules,var_heap,error, files)
		=	case optionalSyntaxTree of
				Yes syntaxTree
					# dcl_modules=syntaxTree.fe_dcls
					# functions_and_macros = syntaxTree.fe_icl.icl_functions
					# (success,var_heap,error, files) = backEndInterface outputPath (map appendRedirection commandLineArgs) predef_symbols syntaxTree main_dcl_module_n var_heap error files
					-> (success,dcl_modules,functions_and_macros,n_functions_and_macros_in_dcl_modules,var_heap,error, files)
					with
						appendRedirection arg
							= case arg of
								"-RE"
									-> "-RAE"
								"-RO"
									-> "-RAO"
								arg
									->	arg
				No
					-> (False,{},{},0,var_heap,error, files)
		with
			outputPath
	//				=	/* directoryName options.pathName +++ "Clean System Files" +++ {DirectorySeparator} +++ */ baseName options.pathName
				=	baseName options.pathName
	# heaps = {heaps & hp_var_heap=var_heap}
	# (closed, files)
		=	fclose error files
	| not closed
		=	abort ("couldn't close error file \"" +++ options.errorPath +++ "\"\n")
	| success
		# dcl_modules={{dcl_module \\ dcl_module<-:dcl_modules} & [main_dcl_module_n].dcl_conversions=No}
		=	(success,dcl_modules,cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,unique_copy_of_predef_symbols,hash_table,heaps,files)
		=	(success,dcl_modules,cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,unique_copy_of_predef_symbols,hash_table,heaps,files)