end of line
[scilab.git] / scilab / modules / scicos / src / translator / parsing / syntax.ml
1 (*
2  *  Translator from Modelica 2.x to flat Modelica
3  *
4  *  Copyright (C) 2005 - 2007 Imagine S.A.
5  *  For more information or commercial use please contact us at www.amesim.com
6  *
7  *  This program is free software; you can redistribute it and/or
8  *  modify it under the terms of the GNU General Public License
9  *  as published by the Free Software Foundation; either version 2
10  *  of the License, or (at your option) any later version.
11  *
12  *  This program is distributed in the hope that it will be useful,
13  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  *  GNU General Public License for more details.
16  *
17  *  You should have received a copy of the GNU General Public License
18  *  along with this program; if not, write to the Free Software
19  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
20  *
21  *)
22
23 (* 'info denotes the type of the information attached to the syntax nodes
24    (location for instance) in the parse tree *)
25
26 type ('a, 'info) node =
27   {
28     nature: 'a;
29     info: 'info
30   }
31
32 and 'info toplevel_element = ('info toplevel_element_desc, 'info) node
33
34 and 'info toplevel_element_desc =
35   | ClassDefinitions of 'info class_definition list
36   | Expression of 'info expression
37   | VariablesDefinitions of 'info expression * 'info array_subscripts option *
38       'info component_declaration list
39   | Command of 'info algorithm
40   | Within of string list
41   | Import of 'info import_clause
42
43 and 'info class_definition = ('info class_definition_desc, 'info) node
44
45 and 'info class_definition_desc =
46   | ClassDefinition of final option * 'info definition
47
48 and final = Final
49
50 and 'info definition = ('info definition_desc, 'info) node
51
52 and 'info definition_desc =
53   | Definition of encapsulated option * partial option * class_kind *
54       'info class_specifier
55
56 and class_kind =
57   | Class
58   | Model
59   | Block
60   | Record
61   | ExpandableConnector
62   | Connector
63   | Type
64   | Package
65   | Function
66
67 and encapsulated = Encapsulated
68
69 and partial = Partial
70
71 and 'info class_specifier = ('info class_specifier_desc, 'info) node
72
73 and 'info class_specifier_desc =
74   | LongSpecifier of ident * string list * 'info composition
75   | ShortSpecifier of ident * 'info base_prefix * 'info expression *
76       'info array_subscripts option * 'info class_modification option *
77       'info comment
78   | EnumerationSpecifier of ident * 'info enumeration_composition *
79       'info comment
80   | ExtensionSpecifier of ident * 'info class_modification option *
81       string list * 'info composition
82
83 and 'info base_prefix = 'info type_prefix
84
85 and 'info enumeration_composition = ('info enumeration_composition_desc, 'info) node
86
87 and 'info enumeration_composition_desc =
88   | EnumList of 'info enumeration_literal list option
89   | EnumColon
90
91 and 'info enumeration_literal = ('info enumeration_literal_desc, 'info) node
92
93 and 'info enumeration_literal_desc =
94   | EnumerationLiteral of ident * 'info comment
95
96 and 'info composition = ('info composition_desc, 'info) node
97
98 and 'info composition_desc =
99   | Composition of 'info element list * 'info other_elements list *
100       'info externalll option
101
102 and 'info element = ('info element_desc, 'info) node
103
104 and 'info element_desc =
105   | ClassAnnotation of 'info annotation
106   | ImportClause of 'info import_clause * 'info annotation option
107   | ExtendsClause of 'info extends_clause * 'info annotation option
108   | ElementDefinition of redeclare option * final option *
109       dynamic_scope option * 'info element_definition *
110       'info annotation option
111
112 and 'info element_definition = ('info element_definition_desc, 'info) node
113
114 and 'info element_definition_desc =
115   | ClassDefinitionElement of replaceable option * 'info definition *
116       'info constraining_clause list
117   | ComponentClauseElement of replaceable option * 'info component_clause *
118       'info constraining_clause list
119
120 and replaceable = Replaceable
121
122 and redeclare = Redeclare
123
124 and dynamic_scope = Inner | Outer | InnerOuter
125
126 and 'info extends_clause = ('info extends_clause_desc, 'info) node
127
128 and 'info extends_clause_desc =
129   | Extends of 'info expression * 'info class_modification option *
130       'info annotation option
131
132 and 'info constraining_clause = ('info constraining_clause_desc, 'info) node
133
134 and 'info constraining_clause_desc =
135   | Constraint of constraint_kind * 'info expression *
136       'info class_modification option * 'info comment
137
138 and constraint_kind = Extension | Restriction
139
140 and 'info other_elements = ('info other_elements_desc, 'info) node
141
142 and 'info other_elements_desc =
143   | Public of 'info element list
144   | Protected of 'info element list
145   | EquationClause of initial option * 'info equation_definition list
146   | AlgorithmClause of initial option * 'info algorithm_definition list
147
148 and initial = Initial
149
150 and 'info externalll = ('info externalll_desc, 'info) node
151
152 and 'info externalll_desc =
153   | External of string option * 'info external_function_call option *
154       'info annotation option * 'info annotation option
155
156 and 'info external_function_call = ('info external_function_call_desc, 'info) node
157
158 and 'info external_function_call_desc =
159   | ExternalFunctionCall of 'info expression option * ident * 'info expression list
160
161 and 'info import_clause = ('info import_clause_desc, 'info) node
162
163 and 'info import_clause_desc =
164   | NewIdentifier of ident * 'info expression * 'info comment
165   | OldIdentifier of 'info expression * 'info comment
166   | AllIdentifiers of 'info expression * 'info comment
167
168 and 'info component_clause = ('info component_clause_desc, 'info) node
169
170 and 'info component_clause_desc =
171   | ComponentClause of 'info type_prefix * 'info type_specifier *
172       'info array_subscripts option * 'info component_declaration list
173
174 and 'info type_prefix = ('info type_prefix_desc, 'info) node
175
176 and 'info type_prefix_desc =
177   | TypePrefix of flow option * variability option * inout option
178
179 and flow = Flow
180
181 and variability = Discrete | Parameter | Constant
182
183 and inout = Input | Output
184
185 and 'info type_specifier = 'info expression
186
187 and 'info component_declaration = ('info component_declaration_desc, 'info) node
188
189 and 'info component_declaration_desc =
190   | ComponentDeclaration of 'info declaration * 'info comment
191
192 and 'info declaration = ('info declaration_desc, 'info) node
193
194 and 'info declaration_desc =
195   | Declaration of ident * 'info array_subscripts option *
196       'info modification option
197
198 and 'info modification = ('info modification_desc, 'info) node
199
200 and 'info modification_desc =
201   | Modification of 'info class_modification * 'info expression option
202   | Eq of 'info expression
203   | ColEq of 'info expression
204
205 and 'info class_modification = ('info class_modification_desc, 'info) node
206
207 and 'info class_modification_desc =
208   | ClassModification of 'info argument list
209
210 and 'info argument = ('info argument_desc, 'info) node
211
212 and 'info argument_desc =
213   | ElementModification of each option * final option * 'info expression *
214       'info modification option * string list
215   | ElementRedeclaration of each option * final option *
216       'info element_definition
217
218 and each = Each
219
220 and 'info equation_definition = ('info equation_definition_desc, 'info) node
221
222 and 'info equation_definition_desc =
223   | Equation of 'info equation * 'info comment * 'info annotation option
224
225 and 'info algorithm_definition = ('info algorithm_definition_desc, 'info) node
226
227 and 'info algorithm_definition_desc =
228   | Algorithm of 'info algorithm * 'info comment * 'info annotation option
229
230 and 'info equation = ('info equation_desc, 'info) node
231
232 and 'info equation_desc =
233   | Equal of 'info expression * 'info expression
234   | ConditionalEquationE of ('info expression * 'info equation list) list *
235       'info equation list option
236   | ForClauseE of 'info for_indices * 'info equation list
237   | ConnectClause of 'info expression * 'info expression
238   | WhenClauseE of ('info expression * 'info equation list) list
239   | FunctionCallE of 'info expression * 'info function_arguments option
240
241 and 'info algorithm = ('info algorithm_desc, 'info) node
242
243 and 'info algorithm_desc =
244   | Assign of 'info expression * 'info expression
245   | FunctionCallA of 'info expression * 'info function_arguments option
246   | MultipleAssign of 'info expression list * 'info expression *
247       'info function_arguments option
248   | Break
249   | Return
250   | ConditionalEquationA of ('info expression * 'info algorithm list) list *
251       'info algorithm list option
252   | ForClauseA of 'info for_indices * 'info algorithm list
253   | WhileClause of 'info expression * 'info algorithm list
254   | WhenClauseA of ('info expression * 'info algorithm list) list
255
256 and 'info for_indices = (ident * 'info expression option) list
257
258 and 'info expression = ('info expression_desc, 'info) node
259
260 and 'info expression_desc =
261   | BinaryOperation of 'info binary_operator_kind * 'info expression * 'info expression
262   | End
263   | False
264   | FieldAccess of 'info expression * ident
265   | FunctionCall of 'info expression * 'info function_arguments option
266   | Identifier of string
267   | If of ('info expression * 'info expression) list * 'info expression
268   | IndexedAccess of 'info expression * 'info array_subscripts
269   | Integer of string
270   | MatrixConstruction of 'info expression list list
271   | NoEvent of 'info expression
272   | Range of 'info expression * 'info expression option * 'info expression
273   | Real of string
274   | String of string
275   | True
276   | Tuple of 'info expression list
277   | UnaryOperation of 'info unary_operator_kind * 'info expression
278   | Vector of 'info vector_elements
279
280 and 'info unary_operator_kind = ('info unary_operator_kind_desc, 'info) node
281
282 and 'info unary_operator_kind_desc =
283   | UnaryMinus
284   | Not
285   | UnaryPlus
286
287 and 'info binary_operator_kind = ('info binary_operator_kind_desc, 'info) node
288
289 and 'info binary_operator_kind_desc =
290   | Plus
291   | And
292   | Divide
293   | EqualEqual
294   | GreaterEqual
295   | Greater
296   | LessEqual
297   | Less
298   | Times
299   | NotEqual
300   | Or
301   | Power
302   | Minus
303
304 and 'info vector_elements = ('info vector_elements_desc, 'info) node
305
306 and 'info vector_elements_desc =
307   | VectorReduction of 'info expression * 'info for_indices
308   | VectorElements of 'info expression list
309
310 and ident = string
311
312 and 'info function_arguments = ('info function_arguments_desc, 'info) node
313
314 and 'info function_arguments_desc =
315   | Reduction of 'info expression * 'info for_indices
316   | ArgumentList of 'info function_arguments_element list
317
318 and 'info function_arguments_element = ('info function_arguments_element_desc, 'info) node
319
320 and 'info function_arguments_element_desc =
321   | Argument of 'info expression
322   | NamedArgument of ident * 'info expression
323
324 and 'info array_subscripts = ('info array_subscripts_desc, 'info) node
325
326 and 'info array_subscripts_desc =
327   | Subscripts of 'info array_subscript list
328
329 and 'info array_subscript = ('info array_subscript_desc, 'info) node
330
331 and 'info array_subscript_desc =
332   | Colon
333   | Subscript of 'info expression
334
335 and 'info comment = ('info comment_desc, 'info) node
336
337 and 'info comment_desc =
338   | Comment of string list * 'info annotation option
339
340 and 'info annotation = ('info annotation_desc, 'info) node
341
342 and 'info annotation_desc =
343   | Annotation of 'info class_modification
344
345 (* Conversion of elements to string, used for error information display *)
346
347 let rec string_of_expression expr =
348   string_of_subexpression None expr
349
350 and string_of_subexpression expr_option subexpr =
351   let string_of_subexpression' =
352     match subexpr.nature with
353       | BinaryOperation (kind, arg1, arg2) ->
354           string_of_binOper subexpr kind arg1 arg2
355       | End -> "end"
356       | False -> "false"
357       | FieldAccess (expr, id) ->
358           (string_of_expression expr) ^ "." ^ id
359       | FunctionCall (expr, fun_args) ->
360           string_of_function_call expr fun_args
361       | Identifier id -> id
362       | If (alts, expr) -> string_of_if expr_option alts expr
363       | IndexedAccess (expr, subs) -> string_of_indexedAccess expr subs
364       | Integer s -> s
365       | MatrixConstruction exprss -> string_of_matrix exprss
366       | NoEvent expr -> "noEvent(" ^ (string_of_expression expr) ^ ")"
367       | Range (start, step, stop) -> string_of_range start step stop
368       | Real s -> s
369       | String s -> "\"" ^ s ^ "\""
370       | True -> "true"
371       | Tuple exprs -> string_of_tuple exprs
372       | UnaryOperation (kind, arg) ->
373           string_of_unOper subexpr kind arg
374       | Vector vec_elts -> string_of_vector vec_elts in
375   parenthesize expr_option string_of_subexpression' subexpr
376
377 and parenthesize expr_option s subexpr =
378   let add_parenthesis =
379     "(" ^ s ^ ")" in
380   let parenthesize_un_bin_Oper kind kind' =
381     match kind.nature, kind'.nature with
382       | (UnaryMinus | UnaryPlus),
383         (Plus | Minus) ->
384           add_parenthesis
385       | Not, _ ->
386           add_parenthesis
387       | _, _ -> s in
388   let parenthesize_bin_bin_Oper kind kind' =
389     match kind.nature, kind'.nature with
390       | Divide,
391         (Plus | Minus | Times) ->
392         add_parenthesis
393       | Times,
394         (Plus | Minus | Divide) ->
395           add_parenthesis
396       | Power, _ ->
397           add_parenthesis
398       | ( EqualEqual | GreaterEqual | Greater |
399           LessEqual | Less | NotEqual | And |
400           Or),
401         ( EqualEqual | GreaterEqual | Greater |
402           LessEqual | Less | NotEqual) ->
403           add_parenthesis
404       | And, Or -> add_parenthesis
405       | Or, And -> add_parenthesis
406       | _, _ -> s in
407   let parenthesize' expr =
408     match expr.nature, subexpr.nature with
409       | BinaryOperation (kind, _, _),
410         BinaryOperation (kind', _, _) ->
411           parenthesize_bin_bin_Oper kind kind'
412       | UnaryOperation (kind, _),
413         BinaryOperation (kind', _, _) ->
414           parenthesize_un_bin_Oper kind kind'
415       | ( BinaryOperation (_, _, _) |
416           UnaryOperation (_, _) ),
417         UnaryOperation (_, _) ->
418           add_parenthesis
419       | _, _ -> s in
420   match expr_option with
421     | None -> s
422     | Some expr -> parenthesize' expr
423
424 and string_of_binOperKind kind =
425   match kind.nature with
426     | Plus -> " + "
427     | And -> " and "
428     | Divide -> " / "
429     | EqualEqual -> " == "
430     | GreaterEqual -> " >= "
431     | Greater -> " > "
432     | LessEqual -> " <= "
433     | Less -> " < "
434     | Times -> " * "
435     | NotEqual -> " <> "
436     | Or -> " or "
437     | Power -> " ^ "
438     | Minus -> " - "
439
440 and string_of_binOper expr kind arg1 arg2 =
441   (string_of_subexpression (Some expr) arg1) ^
442   (string_of_binOperKind kind) ^
443   (string_of_subexpression (Some expr) arg2)
444
445 and string_of_range start step stop =
446   let sstep = match step with
447     | None -> ":"
448     | Some step -> ":" ^ (string_of_expression step)  ^ ":" in
449   (string_of_expression start) ^ sstep ^ (string_of_expression stop)
450
451 and string_of_unOperKind kind =
452   match kind.nature with
453     | UnaryMinus -> "- "
454     | Not -> "not "
455     | UnaryPlus -> "+ "
456
457 and string_of_unOper expr kind arg =
458   (string_of_unOperKind kind) ^
459   (string_of_subexpression (Some expr) arg)
460
461 and string_of_tuple exprs =
462   let rec string_of_tuple' exprs =
463     match exprs with
464       | [] -> ""
465       | [expr] -> string_of_expression expr
466       | expr :: exprs ->
467           (string_of_expression expr) ^ ", " ^ (string_of_tuple' exprs) in
468   "(" ^ (string_of_tuple' exprs) ^ ")"
469
470 and string_of_if expr_option alts expr =
471   let add_parenthesis s =
472     "(" ^ s ^ ")" in
473   let rec string_of_alts alts = match alts with
474     | [] -> ""
475     | (cond, expr) :: alts ->
476         "if (" ^ (string_of_expression cond) ^ ") then (" ^
477         (string_of_expression expr) ^ ") else" ^
478         (string_of_alts alts) in
479   let string_of_if' =
480     (string_of_alts alts) ^ " " ^
481     (add_parenthesis (string_of_expression expr)) in
482   match expr_option with
483     | None -> string_of_if'
484     | Some _ -> add_parenthesis string_of_if'
485
486 and string_of_for_inds for_inds =
487   let string_of_for_ind for_ind = match for_ind with
488     | id, None -> id
489     | id, Some expr -> id ^ " in " ^ string_of_expression expr in
490   let rec string_of_for_inds' for_inds = match for_inds with
491     | [] -> ""
492     | [for_ind] -> string_of_for_ind for_ind
493     | for_ind :: for_inds ->
494         (string_of_for_ind for_ind) ^ ", " ^ (string_of_for_inds' for_inds) in
495   "for " ^ (string_of_for_inds' for_inds)
496
497 and string_of_function_call expr fun_args =
498   let string_of_arg arg = match arg.nature with
499     | Argument expr -> string_of_expression expr
500     | NamedArgument (id, expr) ->
501         id ^ " = " ^ (string_of_expression expr) in
502   let rec string_of_args args = match args with
503     | [] -> ""
504     | [arg] -> string_of_arg arg
505     | arg :: args -> (string_of_arg arg) ^ ", " ^ (string_of_args args) in
506   let string_of_fun_args fun_args = match fun_args.nature with
507     | ArgumentList args -> string_of_args args
508     | Reduction (expr, for_inds) when for_inds = [] ->
509         string_of_expression expr
510     | Reduction (expr, for_inds) ->
511         (string_of_expression expr) ^ " " ^
512         (string_of_for_inds for_inds) in
513   let string_of_fun_args_option fun_args = match fun_args with
514     | None -> ""
515     | Some fun_args -> string_of_fun_args fun_args in
516   (string_of_expression expr) ^
517   "(" ^ (string_of_fun_args_option fun_args) ^ ")"
518
519 and string_of_indexedAccess expr subs =
520   let string_of_sub sub = match sub.nature with
521     | Colon -> " : "
522     | Subscript expr -> string_of_expression expr in
523   let rec string_of_subs subs = match subs with
524     | [] -> ""
525     | [sub] -> string_of_sub sub
526     | sub :: subs ->
527         (string_of_sub sub) ^ ", " ^ string_of_subs subs in
528   match subs.nature with
529     | Subscripts subs ->
530         (string_of_expression expr) ^ "[" ^ (string_of_subs subs) ^ "]"
531
532 and string_of_vectorElements exprs = match exprs with
533   | [] -> ""
534   | [expr] -> string_of_expression expr
535   | expr :: exprs ->
536       (string_of_expression expr) ^ ", " ^
537       (string_of_vectorElements exprs)
538
539 and string_of_vector vec_elts =
540   let string_of_vector' = match vec_elts.nature with
541     | VectorReduction (expr, for_inds) ->
542         "{" ^ (string_of_expression expr) ^ " " ^
543         (string_of_for_inds for_inds) ^ "}"
544     | VectorElements exprs ->
545         "{" ^ string_of_vectorElements exprs ^ "}" in
546   string_of_vector'
547
548 and string_of_matrix exprss =
549   let rec string_of_matrix' exprss = match exprss with
550     | [] -> ""
551     | [exprs] -> string_of_vectorElements exprs
552     | exprs :: exprss ->
553         (string_of_vectorElements exprs) ^ "; " ^
554         (string_of_matrix' exprss) in
555   "[" ^ (string_of_matrix' exprss) ^ "]"
556
557 let string_of_classDefinitions cl_defs = ""
558
559 let string_of_within path =
560   let rec string_of_path path = match path with
561     | [] -> ""
562     | [s] -> s
563     | s :: path -> s ^ "." ^ (string_of_path path) in
564   "within " ^ (string_of_path path) ^ ";"
565
566 let string_of_import imprt =
567   let string_of_import' = match imprt.nature with
568     | NewIdentifier (id, expr, _) ->
569         id ^ " = " ^ (string_of_expression expr)
570     | OldIdentifier (expr, _) ->
571         string_of_expression expr
572     | AllIdentifiers (expr, _) ->
573         (string_of_expression expr) ^ ".*" in
574   "import " ^ string_of_import' ^ ";"
575
576 let string_of_MultipleAssign exprs expr func_args =
577   let rec string_of_LHS exprs = match exprs with
578     | [] -> ""
579     | [expr] -> string_of_expression expr
580     | expr :: exprs ->
581         (string_of_expression expr) ^ ", " ^ (string_of_LHS exprs) in
582   (string_of_LHS exprs) ^ " := " ^ (string_of_function_call expr func_args)
583
584 let string_of_for_clause for_inds algos =
585   (string_of_for_inds for_inds) ^ " loop ... end for"
586
587 let string_of_while_clause expr algos =
588   "while " ^ (string_of_expression expr) ^ " loop ... end while"
589
590 let string_of_when_clause alts = match alts with
591   | [] -> ""
592   | (expr, algos) :: alts ->
593       "when " ^ (string_of_expression expr) ^ " then ... end when"
594
595 let string_of_if_cond cond =
596   "if (" ^ (string_of_expression cond) ^ ") then ... end if"
597
598 let string_of_conditional_equ alts algos = match alts with
599   | [] -> ""
600   | (expr, algos) :: alts -> string_of_if_cond expr
601
602 let string_of_algo algo = match algo.nature with
603   | Assign (expr, expr') ->
604       (string_of_expression expr) ^ " := " ^ (string_of_expression expr')
605   | FunctionCallA (expr, func_args) ->
606       string_of_function_call expr func_args
607   | MultipleAssign (exprs, expr, func_args) ->
608       string_of_MultipleAssign exprs expr func_args
609   | Break -> "break"
610   | Return -> "return"
611   | ConditionalEquationA (alts, algos) ->
612       string_of_conditional_equ alts algos
613   | ForClauseA (for_inds, algos) ->
614       string_of_for_clause for_inds algos
615   | WhileClause (expr, algos) ->
616       string_of_while_clause expr algos
617   | WhenClauseA alts ->
618       string_of_when_clause alts
619
620 let string_of_toplevel_element node = match node.nature with
621   | ClassDefinitions cl_defs -> string_of_classDefinitions cl_defs
622   | Expression expr -> string_of_expression expr
623   | VariablesDefinitions (expr, subs, cpnt_decls) ->
624       string_of_expression expr
625   | Command algo -> string_of_algo algo
626   | Within path -> string_of_within path
627   | Import imprt -> string_of_import imprt
628
629 let string_of_base_prefix base_pref =
630   let string_of_flow flow_option = match flow_option with
631     | None -> ""
632     | Some _ -> "flow " in
633   let string_of_var var_option = match var_option with
634     | None -> ""
635     | Some Discrete -> "discrete "
636     | Some Parameter -> "parameter "
637     | Some Constant -> "constant " in
638   let string_of_inout inout_option = match inout_option with
639     | None -> ""
640     | Some Input -> "input "
641     | Some Output -> "output " in
642   match base_pref.nature with
643     | TypePrefix (flow_option, var_option, inout_option) ->
644         (string_of_flow flow_option) ^
645         (string_of_var var_option) ^
646         (string_of_inout inout_option)