htoclean.icl 2.66 KB
Newer Older
1
2
3
4
5
module htoclean;

import StdEnv;
import fclc;

6
7
/* for windows */

8
9
10
11
12
13
14
15
16
17
18
19
import code from "program_args.o";

n_args :: Int;
n_args = code {
	ccall n_args "-I"
}

program_arg :: !Int -> {#Char};
program_arg i = code {
	ccall program_arg "I-S"
}

20
21
22
23
DirectorySeparator :== '\\';

/* */

24
/*  old unix code ?
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
	n_args:==GetArgC;
	program_arg i:==GetArgvN i;
	
	GetArgC :: Int;
	GetArgC = code {
			ccall get_argc ":I"
		}
	
	GetArgvN :: !Int -> String;
	GetArgvN n = code {
			ccall get_argv_n "I:S"
		}

	DirectorySeparator :== '/';
*/

/*	for macintosh

	DirectorySeparator :== ':';
	import mac_file_selector_carbon;

*/

48
49
50
51
52
53
54
55
56
57
58
/*  for unix

	import ArgEnv;

	args=:getCommandLine;
	n_args:==size args;
	program_arg i:==args.[i];

	DirectorySeparator :== '/';
*/

59
60
split_path_name_in_file_and_directory_name :: !{#Char} -> (!{#Char},{#Char});
split_path_name_in_file_and_directory_name path_name
61
	# last_directory_separator_index = find_last_directory_separator (size path_name-1);
62
		with {
63
64
			find_last_directory_separator n
				| n<0 || path_name.[n]==DirectorySeparator
65
					= n;
66
					= find_last_directory_separator (n-1);
67
		}
68
	= (path_name % (0,last_directory_separator_index),path_name % (last_directory_separator_index+1,size path_name-1));
69
70
71
72
73
74
75
76
77
78
79

write_errors [] stdio
	= stdio;
write_errors [HError string line:l] stdio
	| line<>0
		# stdio=stdio <<< string <<< " [line:" <<< line <<< "]\n";
		= write_errors l stdio;
		# stdio=stdio <<< string <<< '\n';
		= write_errors l stdio;

wait_for_keypress w
80
/* for windows and mac */
81
82
83
84
85
86
	# (stdio,w) = stdio w;
	  stdio = stdio <<< "Press any key to exit";
	  (ok,c,stdio) = freadc stdio;
	  (ok,w) = fclose stdio w;
	= w;

87
88
89
90
force_file_io file w :== snd (fclose file w);

//force_file_io :: !.File !*World -> World; force_file_io file w = w; //Solaris and Linux

91
Start w
92
/* not for macintosh */
93
94
95
96
	# n_arguments=n_args;
	| n_arguments<>2
		# stderr=fwrites "Usage: htoclean h_file_name\n" stderr;
		  stderr=fwrites "Generates a .icl and .dcl file for a c header file\n" stderr;
97
		  w = force_file_io stderr w;
98
99
		= wait_for_keypress w;
		# path_name = program_arg 1;
100
101
102
103
104
105
106
107
/* */
/* for macintosh
		# (stdio_,w) = stdio w;
	 	  stdio_ = stdio_ <<< "Select the C header file\n";
		  w = force_file_io stdio_ w;
		  (ok,path_name,w) = SelectInputFile w;
*/
		# (directory_name,file_name) = split_path_name_in_file_and_directory_name path_name;
108
109
110
111
112
113
		  h_file_name = if (file_name % (size file_name-2,size file_name-1)==".h") (file_name % (0,size file_name-3)) file_name;
		  (errors,w) = accFiles (compile_header directory_name h_file_name) w;
		= case errors of {
			[]	->	w;
			_	# (stdio,w) = stdio w;
		  		  stdio = write_errors errors stdio;
114
		  		  w = force_file_io stdio w;
115
116
				-> wait_for_keypress w;
		  };