compile.icl 9.07 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
2
3
4
5
6
implementation module compile

import StdEnv
import frontend
import backendinterface
import CoclSystemDependent
Martin Wierich's avatar
Martin Wierich committed
7
import portToNewSyntax
8
//import RWSDebug
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
9
10
11

::	CoclOptions =
	{
12
13
14
15
16
17
18
		moduleName:: {#Char}
	,	pathName ::{#Char}
	,	errorPath:: {#Char}
	,	errorMode::	Int
	,	outPath:: {#Char}
	,	outMode::	Int
	,	searchPaths:: SearchPaths
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
19
20
21
	}

InitialCoclOptions =
22
23
24
25
26
27
28
	{	moduleName=	""
	,	pathName=	""
	,	errorPath=	"errors"
	,	errorMode=	FWriteText
	,	outPath=	"out"
	,	outMode=	FWriteText
	,	searchPaths=	{sp_locations = [], sp_paths = []}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
29
30
	}

31
32
33
34
35
36
37
38
39
40
41
:: DclCache = {
	dcl_modules::!{#DclModule},
	functions_and_macros::!{#FunDef},
	predef_symbols::!.PredefinedSymbols,
	hash_table::!.HashTable,
	heaps::!.Heaps
 };

empty_cache :: *DclCache
empty_cache
	# heaps = {hp_var_heap = newHeap, hp_expression_heap = newHeap, hp_type_heaps = {th_vars = newHeap, th_attrs = newHeap}}
clean's avatar
clean committed
42
	# (predef_symbols, hash_table) = buildPredefinedSymbols newHashTable
43
44
45
46
47
48
	= {dcl_modules={},functions_and_macros={},predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps}

compile :: ![{#Char}] !*DclCache !*Files -> (!Bool,!*DclCache,!*Files)
compile args cache files
	# (args_without_modules,modules,cocl_options) = parseCommandLine args InitialCoclOptions
	= compile_modules modules 0 cocl_options args_without_modules cache files;
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
49

clean's avatar
clean committed
50
parseCommandLine :: [{#Char}] CoclOptions -> ([{#Char}],[{#Char}],CoclOptions)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
51
parseCommandLine [] options
clean's avatar
clean committed
52
53
54
	=	([],[],options)
/*
	// JVG: removed hack because the searchPaths list becomes too large when >1 file is compiled
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
55
56
57
58
59
60
	=	prependModulePath options
	where
		// RWS +++ hack, both module name and file path should be passed to frontEndInterface
		prependModulePath options=:{pathName, searchPaths}
			=	{	options
				&	moduleName = baseName pathName
61
				,	searchPaths = {searchPaths & sp_paths = [directoryName pathName : searchPaths.sp_paths]}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
62
				}
clean's avatar
clean committed
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
*/
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)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
80
81
parseCommandLine [arg : args] options
	| arg.[0] == '-'
clean's avatar
clean committed
82
83
		# (args,modules,options)=	parseCommandLine args options
		= ([arg:args],modules,options)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
84
	// otherwise
clean's avatar
clean committed
85
86
		# (args,modules,options) = parseCommandLine args options
		= (args,[arg : modules],options);
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

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))

136
compile_modules [module_:modules] n_compiles cocl_options args_without_modules cache files
clean's avatar
clean committed
137
138
139
140
141
142
143
144
145
	# 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]
				}
146
147
	# (ok,cache,files)
		= compileModule cocl_options (args_without_modules++[module_]) cache files;
clean's avatar
clean committed
148
149
150
151
152
153
	| ok
/*
		# 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;
*/
154
		= compile_modules modules (n_compiles+1) cocl_options args_without_modules cache files;
clean's avatar
clean committed
155

156
157
158
		= (ok,cache,files);
compile_modules [] n_compiles cocl_options args_without_modules cache files
	= (True,cache,files);
clean's avatar
clean committed
159

160
161
compileModule :: CoclOptions [{#Char}] *DclCache *Files -> (!Bool,!*DclCache,!*Files)
compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_symbols,hash_table,heaps} files
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
162
163
164
165
166
167
168
169
170
171
	# (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
clean's avatar
clean committed
172
173
//	  (moduleIdent, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
	# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
174
	# list_inferred_types = if (isMember "-lt" commandLineArgs) (Yes (not (isMember "-lattr" commandLineArgs))) No
clean's avatar
clean committed
175
	# (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)
clean's avatar
clean committed
176
		=	frontEndInterface FrontEndPhaseAll moduleIdent options.searchPaths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out heaps
clean's avatar
clean committed
177
	# unique_copy_of_predef_symbols={predef_symbol\\predef_symbol<-:predef_symbols}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
178
179
180
181
182
183
184
185
	# (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")
clean's avatar
clean committed
186
187
	# var_heap=heaps.hp_var_heap
	# (success,dcl_modules,functions_and_macros,n_functions_and_macros_in_dcl_modules,var_heap,error, files)
188
189
190
191
		= case optionalSyntaxTree of
			Yes syntaxTree
				# dcl_modules=syntaxTree.fe_dcls
				# functions_and_macros = syntaxTree.fe_icl.icl_functions
Martin Wierich's avatar
Martin Wierich committed
192
193
194
195
196
197
198
199
200
201
202
203
				# (porting_ok, files)
					 = switch_port_to_new_syntax 
							(createPortedFiles options.moduleName options.searchPaths files)
							(False, files)
				  error = switch_port_to_new_syntax 
				  			(case porting_ok of
				  				True
				  					-> error
				  				False
				  					-> error <<< "Error: couldn't write ported versions of module "
				  							 <<< options.moduleName <<< '\n')
				  			error
204
205
206
207
208
209
210
211
212
213
214
215
216
217
				# (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)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
218
219
220
221
		with
			outputPath
	//				=	/* directoryName options.pathName +++ "Clean System Files" +++ {DirectorySeparator} +++ */ baseName options.pathName
				=	baseName options.pathName
clean's avatar
clean committed
222
	# heaps = {heaps & hp_var_heap=var_heap}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
223
224
225
226
	# (closed, files)
		=	fclose error files
	| not closed
		=	abort ("couldn't close error file \"" +++ options.errorPath +++ "\"\n")
clean's avatar
clean committed
227
228
	| success
		# dcl_modules={{dcl_module \\ dcl_module<-:dcl_modules} & [main_dcl_module_n].dcl_conversions=No}
229
230
231
232
		# cache={dcl_modules=dcl_modules,functions_and_macros=cached_functions_and_macros,predef_symbols=unique_copy_of_predef_symbols,hash_table=hash_table,heaps=heaps}
		= (success,cache,files)
		# cache={dcl_modules=dcl_modules,functions_and_macros=cached_functions_and_macros,predef_symbols=unique_copy_of_predef_symbols,hash_table=hash_table,heaps=heaps}
		= (success,cache,files)