1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
implementation module portToNewSyntax
import StdEnv, scanner, Directory, merge, checksupport
switch_port_to_new_syntax port dont_port :== port
cTabWidth :== 4
resultFolderName =: "PortedModules"
createPortedFiles :: !String !SearchPaths !*Files -> (!Bool, !*Files)
createPortedFiles fileName searchPaths files
# (ok, files)
= case findDirOfModule fileName searchPaths files of
(No, files)
-> (False, files)
(Yes path, files)
# (ok, files)
= ensureSubDirExists path fileName files
| not ok
-> (ok, files)
# (ok1, files)
= tryToCreatePortedFile fileName "icl" path files
(ok2, files)
= tryToCreatePortedFile fileName "dcl" path files
-> (ok1&&ok2, files)
(_, files)
= fremove (RelativePath [PathDown "icl.txt"]) files
(_, files)
= fremove (RelativePath [PathDown "dcl.txt"]) files
= (ok, files)
tryToCreatePortedFile :: !String !String !Path !*Files -> (!Bool,!*Files)
tryToCreatePortedFile file_name suffix path ms_files
# with_suffix
= file_name+++"."+++suffix
# (old_module_filename, ms_files)
= pathToPD_String (pathAppend path [PathDown with_suffix]) ms_files
(ok, old, ms_files) = fopen old_module_filename FReadData ms_files
| not ok
= (ok, ms_files)
# (new_module_filename, ms_files)
= pathToPD_String (pathAppend path [PathDown resultFolderName,
PathDown with_suffix]) ms_files
inferred_filename = suffix+++".txt"
(ok1, inferred, ms_files) = fopen inferred_filename FReadText ms_files
(ok2, new, ms_files) = fopen new_module_filename FWriteText ms_files
| not (ok1&&ok2)
= (False, ms_files)
# (old, inferred, new) = mergeFiles old inferred new
(ok3, ms_files) = fclose old ms_files
(ok4, ms_files) = fclose inferred ms_files
(ok5, ms_files) = fclose new ms_files
= (ok3&&ok4&&ok5, ms_files)
findDirOfModule :: !{#Char} !SearchPaths *Files -> (!Optional Path, !*Files)
findDirOfModule fileName searchPaths files
# filtered_locations
= filter (\(moduleName,pd_path) -> moduleName == fileName) searchPaths.sp_locations
| not (isEmpty filtered_locations)
# ((ok, path), files)
= pd_StringToPath (snd (hd filtered_locations)) files
| not ok
= (No, files)
= (Yes path, files)
= loop searchPaths.sp_paths (fileName+++".icl") files
where
loop :: ![String] !String !*Files -> (!Optional Path, !*Files)
loop [] _ files
= (No, files)
loop [pd_path:pd_paths] fileName files
# ((ok, path), files)
= pd_StringToPath pd_path files
| not ok
= (No, files)
# ((dir_error, _), files)
= getFileInfo (pathAppend path [PathDown fileName]) files
| dir_error == NoDirError
= (Yes path, files)
= loop pd_paths fileName files
pathAppend (RelativePath p) x = RelativePath (p++x)
pathAppend (AbsolutePath diskname p) x = AbsolutePath diskname (p++x)
ensureSubDirExists path fileName files
# path_result_folder = pathAppend path [PathDown resultFolderName]
((err_code, _), files) = getFileInfo path_result_folder files
(errorCode, files) = case err_code of
NoDirError -> (NoDirError, files)
_ -> createDirectory path_result_folder files
= (errorCode==NoDirError, files)
writeExplImportsToFile :: !String ![([Declaration],a)] !{#u:DclModule} !*CheckState
-> (!{#u:DclModule},!.CheckState)
writeExplImportsToFile file_name si_explicit dcl_modules cs
# (file, cs)
= openFile file_name cs
(dcl_modules, file)
= foldSt (write_expl_import (flatten (map fst si_explicit))) (reverse si_explicit) (dcl_modules, file)
= (dcl_modules, closeFile file cs)
write_expl_import all_expl_imp_decls (declarations, _) (dcl_modules, file)
# (declaration_strings, dcl_modules)
= mapFilterYesSt (decl_to_opt_string all_expl_imp_decls) (reverse declarations) dcl_modules
= (dcl_modules, fwriteNewSyntax declaration_strings file)
// only for portToNewSyntax
decl_to_opt_string all_expl_imp_decls decl=:{dcl_ident, dcl_index, dcl_kind=STE_Imported ste_kind def_mod_index}
dcl_modules
= imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index ste_kind def_mod_index
dcl_modules
decl_to_opt_string _ {dcl_ident, dcl_kind=STE_FunctionOrMacro _} dcl_modules
= (Yes dcl_ident.id_name, dcl_modules)
decl_to_opt_string all_expl_imp_decls decl dcl_modules
= abort ("decl_to_opt_string failed"--->decl)
// only for portToNewSyntax
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Constructor def_mod_index
dcl_modules
= (No, dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Member def_mod_index
dcl_modules
= (No, dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_DclFunction def_mod_index
dcl_modules
= (Yes dcl_ident.id_name, dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Class def_mod_index
dcl_modules
= (Yes ("class "+++dcl_ident.id_name+++"(..)"), dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index (STE_Instance _) def_mod_index
dcl_modules
# ({ins_type}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_instance_defs.[dcl_index]
= (Yes ("instance "+++dcl_ident.id_name+++" "+++
separated " " (map type_to_string ins_type.it_types)), dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Type def_mod_index
dcl_modules
# ({td_rhs}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index]
dcl_string
= ":: "+++(case td_rhs of
AlgType constructors
-> dcl_ident.id_name+++constructor_bracket def_mod_index all_expl_imp_decls constructors
RecordType _
-> dcl_ident.id_name+++"{..}"
_
-> dcl_ident.id_name)
= (Yes dcl_string, dcl_modules)
imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Generic def_mod_index
dcl_modules
= (Yes ("generic "+++dcl_ident.id_name+++"(..)"), dcl_modules)
// only for portToNewSyntax
type_to_string (TA {type_name} _) = possibly_replace_predef_symbols type_name.id_name
type_to_string (TB type) = toString type
type_to_string (TV {tv_name}) = tv_name.id_name
type_to_string x = abort ("bug nr 945 in module check"--->x)
possibly_replace_predef_symbols s
| s=="_list"
= "[]"
| s % (0,5) == "_tuple"
= (toString ['(':repeatn ((toInt (s%(6, (size s) - 1))) - 1) ','])+++")"
| s=="_array"
= "{}"
| s=="_!array"
= "{!}"
| s=="_#array"
= "{#}"
= s
instance toString BasicType
where
toString BT_Int = "Int"
toString BT_Char = "Char"
toString BT_Real = "Real"
toString BT_Bool = "Bool"
toString BT_Dynamic = "Dynamic"
toString BT_File = "File"
toString BT_World = "World"
toString _ = abort "bug nr 346 in module check"
// only for portToNewSyntax
separated _ []
= ""
separated separator [h:t]
= foldl (\l r->l+++separator+++r) h t
constructor_bracket def_mod_index all_expl_imp_decls constructors
# expl_imp_constructor_strings
= [ ds_ident.id_name \\ {ds_ident} <- constructors
| is_expl_imported_constructor def_mod_index ds_ident all_expl_imp_decls ]
| isEmpty expl_imp_constructor_strings
= ""
= "("+++separated "," expl_imp_constructor_strings+++")"
// only for portToNewSyntax
is_expl_imported_constructor def_mod_index ds_ident []
= False
is_expl_imported_constructor def_mod_index ds_ident [{dcl_ident, dcl_kind=STE_Imported STE_Constructor def_mod_index2}:_]
| dcl_ident==ds_ident && def_mod_index==def_mod_index2
= True
// GOTO next alternative
is_expl_imported_constructor def_mod_index ds_ident [h:t]
= is_expl_imported_constructor def_mod_index ds_ident t
fwriteNewSyntax importStrings file
| isEmpty importStrings
= fwrites "import @#$@@!!" file
# with_commas = (map (\s->s+++", ") (butLast importStrings))++[last importStrings+++";"]
lines = split_in_lines 12 with_commas [] []
lines = [hd lines:[["\t":line]\\ line<-tl lines]]
line_strings = [ foldl (+++) " " (line++["\n"]) \\ line<-lines ]
= fwrites (foldl (+++) "import" line_strings) file
where
max_line_length = 80
split_in_lines i [] inner_accu outer_accu
# accu = if (isEmpty inner_accu) outer_accu [reverse inner_accu:outer_accu]
= reverse accu
split_in_lines i [h:t] inner_accu outer_accu
# s = size h
| s+i>max_line_length
| isEmpty inner_accu
= split_in_lines (s+i) t [h] outer_accu
= split_in_lines (s+cTabWidth) t [h] [inner_accu:outer_accu]
= split_in_lines (s+i) t [h:inner_accu] outer_accu
// only for portToNewSyntax
butLast [] = []
butLast [x] = []
butLast [h:t] = [h: butLast t]
// MW: fake..
openFile file_name cs
# world = bigBang
(ok, newFile, world) = fopen file_name FWriteText world
cs = forget world cs
cs = case ok of
True -> cs
_ # cs_error = checkError "" ("can't open file \""+++file_name+++" in current directory.") cs.cs_error
-> { cs & cs_error=cs_error }
= (newFile, cs)
closeFile file cs
# world = bigBang
(ok, world) = fclose file world
= forget world cs
bigBang :: .World
bigBang = cast 1
// creates a world from scratch
forget :: !.x !.y -> .y
forget x y = y
cast :: !.a -> .b
cast a
= code
{
pop_a 0
}
// ..fake
|
