Parser.icl 9.11 KB
Newer Older
1
2
3
4
5
implementation module Parser;

import StdEnv;
import AbsSyn;
from PmEnvironment import EnvsFileName;
6
from PmTypes import :: Output(..);
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

parseCpmLogic :: ![String] -> CpmAction;
parseCpmLogic [_:args] = parse_CpmLogic args;
parseCpmLogic _ = CpmHelp;

parse_CpmLogic :: ![String] -> CpmAction;
parse_CpmLogic ["make"] = CpmMake;
parse_CpmLogic ["project",project_name:project_args] = parse_Project project_args project_name;
parse_CpmLogic ["module",module_name:module_args] = parse_Module module_args module_name;
parse_CpmLogic ["environment":environment_args] = parse_Environment environment_args;
parse_CpmLogic [project_name:project_build_args] = parse_Project_build_args project_build_args False EnvsFileName project_name CpmHelp;
parse_CpmLogic _ = CpmHelp;

parse_Project :: ![String] !String -> CpmAction;
parse_Project ["create"] project_name = Project project_name CreateProject;
parse_Project ["show"] project_name = Project project_name ShowProject;
parse_Project ["build":project_build_args] project_name
	= parse_Project_build_args project_build_args False EnvsFileName project_name (Project "" ProjectHelp);
25
26
parse_Project ["compile":s] project_name
	| length s <> 0 = Project project_name (Compile s);
27
parse_Project ["path":project_path_args] project_name = parse_Project_path_args project_path_args project_name;
28
29
30
parse_Project ["root",s] project_name
	| size s > 0 && and [c == '.'\\ c<-:s]
		= Project project_name (SetRelativeRoot s);
31
32
parse_Project ["target",s] project_name = Project project_name (SetTarget s);
parse_Project ["exec",s] project_name = Project project_name (SetExec s);
33
34
35
36
37
parse_Project ["set":project_option_args] project_name
	# (ok,project_options) = parse_Project_options project_option_args;
	| ok
		= Project project_name (SetProjectOptions project_options);
		= Project "" ProjectHelp;
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
parse_Project _ project_name = Project "" ProjectHelp;

parse_Project_build_args :: ![String] !Bool !String !String !CpmAction -> CpmAction;
parse_Project_build_args ["--force":project_build_args] force environment project_name error_cpm_action
	= parse_Project_build_args project_build_args True environment project_name error_cpm_action;
parse_Project_build_args [project_build_arg:project_build_args] force environment project_name error_cpm_action
	| size project_build_arg>6 && project_build_arg % (0,5)=="--env="
		# environment = project_build_arg % (6,size project_build_arg-1);
		= parse_Project_build_args project_build_args force environment project_name error_cpm_action;
parse_Project_build_args [] force environment project_name error_cpm_action
	= Project project_name (BuildProject force environment);
parse_Project_build_args _ _ _ _ error_cpm_action
	= error_cpm_action;

parse_Project_path_args :: ![String] !String -> CpmAction;
53
54
parse_Project_path_args ["add":path] project_name
	| length path <> 0 = Project project_name (ProjectPath (AddPathAction path));
55
56
57
58
59
60
61
62
63
parse_Project_path_args ["remove",i] project_name
	| size i>0 && only_digits_in_string 0 i
		= Project project_name (ProjectPath (RemovePathAction (toInt i)));
parse_Project_path_args ["list"] project_name
	= Project project_name (ProjectPath ListPathsAction);
parse_Project_path_args ["move",i,direction_name] project_name
	# (is_direction,direction) = parse_PathDirection direction_name;
	| size i>0 && only_digits_in_string 0 i && is_direction
		= Project project_name (ProjectPath (MovePathAction (toInt i) direction));
64
65
parse_Project_path_args _ project_name
	= Project project_name (ProjectPath PathHelp);
66
67
68
69
70
71
72
73
74
75
76
77
78
79

parse_PathDirection :: !String -> (!Bool,PathDirection);
parse_PathDirection "up" = (True,MovePathUp);
parse_PathDirection "down" = (True,MovePathDown);
parse_PathDirection "top" = (True,MovePathTop);
parse_PathDirection "bottom" = (True,MovePathBottom);
parse_PathDirection _ = (False,abort "parse_PathDirection");

only_digits_in_string :: !Int !String -> Bool;
only_digits_in_string i s
	| i<size s
		= isDigit s.[i] && only_digits_in_string (i+1) s;
		= True;

80
81
82
83
84
85
86
parse_Project_options :: ![String] -> (!Bool,![ProjectOption]);
parse_Project_options ["-dynamics":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[DynamicsOn:project_options]);
parse_Project_options ["-ndynamics":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[DynamicsOff:project_options]);
87
88
89
90
91
92
parse_Project_options ["-generic_fusion":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[GenericFusionOn:project_options]);
parse_Project_options ["-ngeneric_fusion":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[GenericFusionOff:project_options]);
93
94
95
96
97
98
parse_Project_options ["-descexl":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[DescExLOn:project_options]);
parse_Project_options ["-ndescexl":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok,[DescExLOff:project_options]);
99
100
101
102
103
104
105
106
107
108
parse_Project_options ["-h",heap_size:project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	# heap_size = parseByteSuffix heap_size;
	| heap_size > 0
		= (ok,[HeapSize heap_size:project_options]);
parse_Project_options ["-s",stack_size:project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	# stack_size = parseByteSuffix stack_size;
	| stack_size > 0
		= (ok,[StackSize stack_size:project_options]);
109
110
111
112
113
114
115
116
117
118
119
120
parse_Project_options ["-b":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [Output BasicValuesOnly:project_options]);
parse_Project_options ["-sc":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [Output ShowConstructors:project_options]);
parse_Project_options ["-nr":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [Output NoReturnType:project_options]);
parse_Project_options ["-nc":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [Output NoConsole:project_options]);
121
122
123
124
125
126
parse_Project_options ["-nstrip":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [LinkerGenerateSymbolsOn:project_options]);
parse_Project_options ["-strip":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [LinkerGenerateSymbolsOff:project_options]);
127
128
129
130
131
132
parse_Project_options ["-nrtsopts":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [RTSFlagsOff:project_options]);
parse_Project_options ["-rtsopts":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [RTSFlagsOn:project_options]);
Mart Lubbers's avatar
Mart Lubbers committed
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
parse_Project_options ["-pt":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [TimeProfileOn:project_options]);
parse_Project_options ["-npt":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [TimeProfileOn:project_options]);
parse_Project_options ["-tst":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [StackTraceOn:project_options]);
parse_Project_options ["-ntst":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [StackTraceOff:project_options]);
parse_Project_options ["-mp":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [MemoryProfileOn:project_options]);
parse_Project_options ["-nmp":project_option_args]
	# (ok,project_options) = parse_Project_options project_option_args;
	= (ok, [MemoryProfileOff:project_options]);
151
152
153
154
155
parse_Project_options []
	= (True,[]);
parse_Project_options _
	= (False,[]);

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
parseByteSuffix :: !String -> Int;
parseByteSuffix s
	| size s == 0
		= 0;
	# suffix = s.[dec (size s)];
	| suffix == 'k' || suffix == 'K'
		= 1024 * safeToInt (s % (0, size s - 2));
	| suffix == 'm' || suffix == 'M'
		= 1024 * 1024 * safeToInt (s % (0, size s - 2));
		= safeToInt s;

safeToInt :: !String -> Int;
safeToInt s
	| only_digits_in_string 0 s
		= toInt s;
		= 0;

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
parse_Module :: ![String] !String -> CpmAction;
parse_Module ["create"] module_name = Module module_name (CreateModule LibraryModule);
parse_Module ["create","application"] module_name = Module module_name (CreateModule ApplicationModule);
parse_Module _ module_name = Module "" ModuleHelp;

parse_Environment :: ![String] -> CpmAction;
parse_Environment ["list"] = Environment ListEnvironments;
parse_Environment ["import",s] = Environment (ImportEnvironment s);
parse_Environment ["create",s] = Environment (CreateEnvironment s);
parse_Environment ["remove",s] = Environment (RemoveEnvironment s);
parse_Environment ["show",s] = Environment (ShowEnvironment s);
parse_Environment ["export",s] = Environment (ExportEnvironment s);
parse_Environment ["rename",s1,s2] = Environment (RenameEnvironment s1 s2);
parse_Environment ["setcompiler",s1,s2] = Environment (SetEnvironmentCompiler s1 s2);
parse_Environment ["setcodegen",s1,s2] = Environment (SetEnvironmentCodeGen s1 s2);
parse_Environment _ = Environment EnvironmentHelp;