add translator & XML2modelica
[scilab.git] / scilab / modules / scicos / src / translator / compilation / types.ml
1 (*\r
2  *  Translator from Modelica 2.x to flat Modelica\r
3  *\r
4  *  Copyright (C) 2005 - 2007 Imagine S.A.\r
5  *  For more information or commercial use please contact us at www.amesim.com\r
6  *\r
7  *  This program is free software; you can redistribute it and/or\r
8  *  modify it under the terms of the GNU General Public License\r
9  *  as published by the Free Software Foundation; either version 2\r
10  *  of the License, or (at your option) any later version.\r
11  *\r
12  *  This program is distributed in the hope that it will be useful,\r
13  *  but WITHOUT ANY WARRANTY; without even the implied warranty of\r
14  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
15  *  GNU General Public License for more details.\r
16  *\r
17  *  You should have received a copy of the GNU General Public License\r
18  *  along with this program; if not, write to the Free Software\r
19  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.\r
20  *\r
21  *)\r
22 \r
23 \r
24 \r
25 type element_type =\r
26   {\r
27     protected: bool;\r
28     final: bool;\r
29     replaceable: bool;\r
30     dynamic_scope: dynamic_scope option;\r
31     element_nature: element_nature\r
32   }\r
33 \r
34 and class_type =\r
35   {\r
36     partial: bool;\r
37     kind: kind Lazy.t;\r
38     named_elements: (string * element_type Lazy.t) list\r
39   }\r
40 \r
41 and kind =\r
42   | Class\r
43   | Model\r
44   | Block\r
45   | Record\r
46   | ExpandableConnector\r
47   | Connector\r
48   | Package\r
49   | Function\r
50 \r
51 and dynamic_scope =\r
52   | Inner\r
53   | Outer\r
54   | InnerOuter\r
55 \r
56 and element_nature =\r
57   | ComponentElement of component_type\r
58   | ClassElement of class_specifier Lazy.t\r
59   | ComponentTypeElement of component_type\r
60   | PredefinedTypeElement of predefined_type\r
61 \r
62 and component_type =\r
63   {\r
64     flow: bool Lazy.t;\r
65     variability: variability Lazy.t;\r
66     causality: causality Lazy.t;\r
67     base_class: class_specifier Lazy.t;\r
68   }\r
69 \r
70 and variability = Continuous | Discrete | Parameter | Constant\r
71 \r
72 and causality = Acausal | Input | Output\r
73 \r
74 and class_specifier =\r
75   | PredefinedType of predefined_type\r
76   | ClassType of class_type\r
77   | ComponentType of component_type\r
78   | ArrayType of dimension * class_specifier\r
79   | TupleType of class_specifier list\r
80 \r
81 and predefined_type =\r
82   {\r
83     base_type: base_type;\r
84     attributes: (string * bool) list\r
85  }\r
86 \r
87 and base_type =\r
88   | BooleanType\r
89   | IntegerType\r
90   | RealType\r
91   | StringType\r
92   | EnumerationType of string list\r
93 \r
94 and dimension =\r
95   | ConstantDimension of int32\r
96   | ParameterDimension\r
97   | DiscreteDimension\r
98 \r
99 type type_comparison =\r
100   | NotRelated\r
101   | Subtype\r
102   | Supertype\r
103   | SameType\r
104 \r
105 \r
106 (* Useful functions *)\r
107 \r
108 let evaluate x = Lazy.force x\r
109 \r
110 (* type calculations *)\r
111 \r
112 let min_variability var var' = match var, var' with\r
113   | Constant, _ | _, Constant -> Constant\r
114   | Parameter, _ | _, Parameter -> Parameter\r
115   | Discrete, _ | _, Discrete -> Discrete\r
116   | Continuous, Continuous -> Continuous\r
117 \r
118 and max_variability var var' = match var, var' with\r
119   | Continuous, _ | _, Continuous -> Continuous\r
120   | Discrete, _ | _, Discrete -> Discrete\r
121   | Parameter, _ | _, Parameter -> Parameter\r
122   | Constant, Constant -> Constant\r
123 \r
124 let higher_variability var var' =\r
125   (max_variability var var') = var\r
126 \r
127 and lower_variability var var' =\r
128   (max_variability var var') = var'\r
129 \r
130 let add_dimensions dims cl_spec =\r
131   let add_dimension dim cl_spec = ArrayType (dim, cl_spec) in\r
132   List.fold_right add_dimension dims cl_spec\r
133 \r
134 (* Utilities *)\r
135 \r
136 let empty_tuple_class_type = TupleType []\r
137 \r
138 let boolean_class_type =\r
139   PredefinedType { base_type = BooleanType; attributes = ["start", false] }\r
140 \r
141 and integer_class_type =\r
142   PredefinedType\r
143     { base_type = IntegerType; attributes = ["start", false; "nominal", false] }\r
144 \r
145 and real_class_type =\r
146   PredefinedType\r
147     { base_type = RealType; attributes = ["start", false; "nominal", false] }\r
148 \r
149 and string_class_type =\r
150   PredefinedType { base_type = StringType; attributes = ["start", false] }\r
151 \r
152 and enumeration_class_type enum_lits =\r
153   PredefinedType\r
154     { base_type = EnumerationType enum_lits; attributes = ["start", false] }\r
155 \r
156 let boolean_component_type var =\r
157   {\r
158     flow = lazy false;\r
159     variability = lazy var;\r
160     causality = lazy Acausal;\r
161     base_class = lazy boolean_class_type;\r
162   }\r
163 \r
164 let integer_component_type var =\r
165   { (boolean_component_type var) with\r
166     base_class = lazy integer_class_type\r
167   }\r
168 \r
169 let real_component_type var =\r
170   { (boolean_component_type var) with\r
171     base_class = lazy real_class_type\r
172   }\r
173 \r
174 let string_component_type var =\r
175   { (boolean_component_type var) with\r
176     base_class = lazy string_class_type\r
177   }\r
178 \r
179 let enumeration_component_type var enum_lits =\r
180   { \r
181     (boolean_component_type var) with\r
182     base_class = lazy (enumeration_class_type enum_lits)\r
183   }\r
184 \r
185 let integer_array_component_type var dims =\r
186   let cl_spec = integer_class_type in\r
187   {\r
188     flow = lazy false;\r
189     variability = lazy var;\r
190     causality = lazy Acausal;\r
191     base_class = lazy (add_dimensions dims cl_spec)\r
192   }\r
193 \r
194 let empty_tuple_type var =\r
195   ComponentElement\r
196     { (boolean_component_type var) with\r
197       base_class = lazy (empty_tuple_class_type)\r
198     }\r
199 \r
200 let boolean_type var = ComponentElement (boolean_component_type var)\r
201 \r
202 let integer_type var = ComponentElement (integer_component_type var)\r
203 \r
204 let integer_array_type var dim =\r
205   let cl_spec =\r
206     ArrayType\r
207       (dim,\r
208        PredefinedType { base_type = IntegerType; attributes = [] }) in\r
209   let cpnt_type =\r
210     {\r
211       flow = lazy false;\r
212       variability = lazy var;\r
213       causality = lazy Acausal;\r
214       base_class = lazy cl_spec\r
215     } in\r
216   ComponentElement cpnt_type\r
217 \r
218 let real_type var = ComponentElement (real_component_type var)\r
219 \r
220 let string_type var =\r
221   ComponentElement (string_component_type var)\r
222 \r
223 let enumeration_type var enum_lits =\r
224   ComponentElement (enumeration_component_type var enum_lits)\r
225 \r
226 let function_type inputs outputs =\r
227   let named_elements inout args =\r
228     let element_type cpnt_type =\r
229       {\r
230         protected = false;\r
231         final = true;\r
232         replaceable = false;\r
233         dynamic_scope = None;\r
234         element_nature =\r
235           ComponentElement { cpnt_type with causality = lazy inout }\r
236       } in\r
237     let named_element (id, cpnt_type) = id, lazy (element_type cpnt_type) in\r
238     List.map named_element args in\r
239   let cl_type =\r
240     {\r
241       partial = false;\r
242       kind = lazy Function;\r
243       named_elements =\r
244         named_elements Input inputs @ named_elements Output outputs\r
245     } in\r
246   ClassElement (lazy (ClassType cl_type))\r
247 \r
248 let reversed_element_dimensions elt_type =\r
249   let rec reversed_dimensions dims = function\r
250     | ArrayType (dim, cl_spec) -> reversed_dimensions (dim :: dims) cl_spec\r
251     | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> dims in\r
252   match elt_type with\r
253     | ComponentElement cpnt_type ->\r
254         let cl_spec = evaluate cpnt_type.base_class in\r
255         reversed_dimensions [] cl_spec\r
256     | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _ -> []\r
257 \r
258 let scalar_component_type cpnt_type =\r
259   let rec scalar_class_specifier cl_spec = match cl_spec with\r
260     | ArrayType (_, cl_spec) -> scalar_class_specifier cl_spec\r
261     | _ -> cl_spec in\r
262   {\r
263     cpnt_type with\r
264     base_class = lazy (scalar_class_specifier (evaluate cpnt_type.base_class))\r
265   }\r
266 \r
267 \r
268 (* General type comparisons *)\r
269 \r
270 let rec compare_class_types ct ct' =\r
271   match Lazy.force ct.kind, Lazy.force ct'.kind with\r
272   | Class, Class -> compare_classes ct ct'\r
273   | Model, Model -> compare_models ct ct'\r
274   | Block, Block -> compare_blocks ct ct'\r
275   | Record, Record -> compare_records ct ct'\r
276   | ExpandableConnector, ExpandableConnector ->\r
277       compare_expandable_connectors ct ct'\r
278   | Connector, Connector -> compare_connectors ct ct'\r
279   | Package, Package -> compare_packages ct ct'\r
280   | Function, Function -> compare_functions ct ct'\r
281   | _ -> NotRelated\r
282 \r
283 and compare_classes ct ct' =\r
284   let rec compare_classes' type_cmp named_elts named_elts' =\r
285     match named_elts' with\r
286     | [] -> type_cmp\r
287     | (s', _) :: _ when not (List.mem_assoc s' named_elts) -> NotRelated\r
288     | (s', elt_type') :: named_elts' ->\r
289         begin\r
290           let type_cmp' =\r
291             compare_elements\r
292               (Lazy.force (List.assoc s' named_elts))\r
293               (Lazy.force elt_type') in\r
294           match type_cmp, type_cmp' with\r
295             | SameType, (SameType | Subtype) ->\r
296                 compare_classes' type_cmp' named_elts named_elts'\r
297             | Subtype, (SameType | Subtype) ->\r
298                 compare_classes' Subtype named_elts named_elts'\r
299             | _ -> NotRelated\r
300         end in\r
301   let named_elts = ct.named_elements\r
302   and named_elts' = ct'.named_elements in\r
303   let l = List.length named_elts\r
304   and l' = List.length named_elts' in\r
305   if l < l' then invert (compare_classes' Subtype named_elts' named_elts)\r
306   else if l = l' then compare_classes' SameType named_elts named_elts'\r
307   else compare_classes' Subtype named_elts named_elts'\r
308 \r
309 and invert = function\r
310   | NotRelated -> NotRelated\r
311   | Subtype -> Supertype\r
312   | Supertype -> Subtype\r
313   | SameType -> SameType\r
314 \r
315 and compare_models ct ct' = compare_classes ct ct'\r
316 \r
317 and compare_blocks ct ct' = compare_classes ct ct'\r
318 \r
319 and compare_records ct ct' = compare_classes ct ct'\r
320 \r
321 and compare_expandable_connectors ct ct' = compare_classes ct ct'\r
322 \r
323 and compare_connectors ct ct' = compare_classes ct ct'\r
324 \r
325 and compare_packages ct ct' = compare_classes ct ct'\r
326 \r
327 and compare_functions ct ct' = compare_classes ct ct'\r
328 \r
329 and compare_elements elt_type elt_type' =\r
330   if\r
331     elt_type.protected = elt_type'.protected &&\r
332     elt_type.final = elt_type'.final &&\r
333     elt_type.replaceable = elt_type'.replaceable &&\r
334     elt_type.dynamic_scope = elt_type'.dynamic_scope\r
335   then compare_element_natures elt_type.element_nature elt_type'.element_nature\r
336   else NotRelated\r
337 \r
338 and compare_element_natures elt_nature elt_nature' = match elt_nature, elt_nature' with\r
339   | ComponentElement cpntt, ComponentElement cpntt' -> compare_component_types cpntt cpntt'\r
340   | ClassElement cs, ClassElement cs' -> compare_specifiers (Lazy.force cs) (Lazy.force cs')\r
341   | ComponentTypeElement cpntt, ComponentTypeElement cpntt' -> compare_component_types cpntt cpntt'\r
342   | PredefinedTypeElement pt, PredefinedTypeElement pt' -> compare_predefined_types pt pt'\r
343   | (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _),\r
344     (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _) ->\r
345       NotRelated\r
346 \r
347 and compare_component_types cpntt cpntt' =\r
348   (*if\r
349     Lazy.force cpntt.flow = Lazy.force cpntt'.flow &&\r
350     Lazy.force cpntt.variability = Lazy.force cpntt'.variability &&\r
351     Lazy.force cpntt.causality = Lazy.force cpntt'.causality\r
352   then*)\r
353     compare_specifiers (Lazy.force cpntt.base_class) (Lazy.force cpntt'.base_class)\r
354   (*else NotRelated*)\r
355 \r
356 and compare_specifiers cs cs' = match cs, cs' with\r
357   | PredefinedType pt, PredefinedType pt' -> compare_predefined_types pt pt'\r
358   | ClassType ct, ClassType ct' -> compare_class_types ct ct'\r
359   | ComponentType cpntt, ComponentType cpntt' -> compare_component_types cpntt cpntt'\r
360   | ArrayType (dim, cs), ArrayType (dim', cs')\r
361     when compare_dimensions dim dim' ->\r
362       compare_specifiers cs cs'\r
363   | TupleType css, TupleType css' -> compare_tuple_types css css'\r
364   | (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _),\r
365     (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _) ->\r
366       NotRelated\r
367 \r
368 and compare_dimensions dim dim' = match dim, dim' with\r
369   | ConstantDimension i, ConstantDimension i' when i <> i' -> false\r
370   | _ -> true\r
371 \r
372 and compare_tuple_types css css' =\r
373   if List.for_all2 (fun cs cs' -> compare_specifiers cs cs' = SameType) css css' then\r
374     SameType\r
375   else NotRelated\r
376 \r
377 and compare_predefined_types pt pt' = match pt.base_type, pt'.base_type with\r
378   | BooleanType, BooleanType -> SameType\r
379   | IntegerType, IntegerType -> SameType\r
380   | RealType, RealType -> SameType\r
381   | RealType, IntegerType -> Supertype\r
382   | IntegerType, RealType -> Subtype\r
383   | StringType, StringType -> SameType\r
384   | EnumerationType enum_elts, EnumerationType enum_elts'\r
385     when enum_elts = enum_elts' -> SameType\r
386   | _ -> NotRelated\r
387 \r
388 (* Printing utilities *)\r
389 \r
390 let fprint_tabs oc offset =\r
391   for i = 1 to offset do Printf.fprintf oc "\t" done\r
392 \r
393 let rec fprint_class_type oc id cl_type =\r
394   if cl_type.partial then Printf.fprintf oc "partial ";\r
395   fprint_kind oc (Lazy.force cl_type.kind);\r
396   Printf.fprintf oc "%s\n" id;\r
397   fprint_named_elements oc 1 cl_type.named_elements;\r
398   Printf.fprintf oc "end %s;\n" id\r
399 \r
400 and fprint_kind oc = function\r
401   | Class -> Printf.fprintf oc "class "\r
402   | Model -> Printf.fprintf oc "model "\r
403   | Block -> Printf.fprintf oc "block "\r
404   | Record -> Printf.fprintf oc "record "\r
405   | ExpandableConnector -> Printf.fprintf oc "expandable connector "\r
406   | Connector -> Printf.fprintf oc "connector "\r
407   | Package -> Printf.fprintf oc "package "\r
408   | Function -> Printf.fprintf oc "function "\r
409 \r
410 and fprint_named_elements oc offset named_elts =\r
411   List.iter\r
412     (function (s, elt_type) -> fprint_named_element oc offset (s, Lazy.force elt_type))\r
413     named_elts\r
414 \r
415 and fprint_named_element oc offset (id, elt_type) =\r
416   fprint_tabs oc offset;\r
417   if elt_type.protected then Printf.fprintf oc "protected ";\r
418   if elt_type.final then Printf.fprintf oc "final ";\r
419   if elt_type.replaceable then Printf.fprintf oc "replaceable ";\r
420   fprint_dynamic_scope oc elt_type.dynamic_scope;\r
421   fprint_element_nature oc offset id elt_type.element_nature\r
422 \r
423 and fprint_dynamic_scope oc = function\r
424   | None -> ()\r
425   | Some Inner -> Printf.fprintf oc "inner "\r
426   | Some Outer -> Printf.fprintf oc "outer "\r
427   | Some InnerOuter -> Printf.fprintf oc "inner outer "\r
428 \r
429 and fprint_element_nature oc offset id = function\r
430   | ComponentElement cpnt_type -> fprint_component_type oc offset id cpnt_type\r
431   | ClassElement cl_spec -> fprint_class_specifier oc offset id (Lazy.force cl_spec)\r
432   | ComponentTypeElement cpnt_type -> fprint_component_type_type oc offset id cpnt_type\r
433   | PredefinedTypeElement predef_type -> fprint_predefined_type_type oc id predef_type\r
434 \r
435 and fprint_class_specifier oc offset id = function\r
436   | PredefinedType _ -> assert false\r
437   | ClassType cl_type -> fprint_class_type_specifier oc offset id cl_type\r
438   | ComponentType _ -> assert false\r
439   | ArrayType (_, cs) -> fprint_class_specifier oc offset id cs\r
440   | TupleType _ -> assert false\r
441 \r
442 and fprint_class_type_specifier oc offset id cl_type =\r
443   if cl_type.partial then Printf.fprintf oc "partial ";\r
444   fprint_kind oc (Lazy.force cl_type.kind);\r
445   Printf.fprintf oc "%s\n" id;\r
446   fprint_named_elements oc (offset + 1) cl_type.named_elements;\r
447   fprint_tabs oc offset;\r
448   Printf.fprintf oc "end %s;\n" id\r
449 \r
450 and fprint_component_type_type oc offset id cpnt_type =\r
451   Printf.fprintf oc "type %s = " id;\r
452   fprint_component_type oc offset "" cpnt_type;\r
453   Printf.fprintf oc ";\n"\r
454 \r
455 and fprint_predefined_type_type oc id predef_type =\r
456   Printf.fprintf oc "type %s = " id;\r
457   fprint_predefined_type oc predef_type;\r
458   Printf.fprintf oc ";\n"\r
459 \r
460 and fprint_component_type oc offset id cpnt_type =\r
461   if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";\r
462   fprint_variability oc (Lazy.force cpnt_type.variability);\r
463   fprint_causality oc (Lazy.force cpnt_type.causality);\r
464   fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);\r
465   fprint_dimensions oc (Lazy.force cpnt_type.base_class);\r
466   Printf.fprintf oc " %s;\n" id\r
467 \r
468 and fprint_variability oc = function\r
469   | Continuous -> ()\r
470   | Discrete -> Printf.fprintf oc "discrete "\r
471   | Parameter -> Printf.fprintf oc "parameter "\r
472   | Constant -> Printf.fprintf oc "constant "\r
473 \r
474 and fprint_causality oc = function\r
475   | Acausal -> ()\r
476   | Input -> Printf.fprintf oc "input "\r
477   | Output -> Printf.fprintf oc "output "\r
478 \r
479 and fprint_class_specifier_type oc offset = function\r
480   | PredefinedType predef_type -> fprint_predefined_type oc predef_type\r
481   | ClassType cl_type -> fprint_class_type_specifier_type oc offset cl_type\r
482   | ComponentType cpnt_type -> fprint_component_type_specifier_type oc offset cpnt_type\r
483   | ArrayType (_, cs) -> fprint_class_specifier_type oc offset cs\r
484   | TupleType _ -> assert false\r
485 \r
486 and fprint_predefined_type oc predef_type = match predef_type.base_type with\r
487   | BooleanType -> Printf.fprintf oc "Boolean"\r
488   | IntegerType -> Printf.fprintf oc "Integer"\r
489   | RealType -> Printf.fprintf oc "Real"\r
490   | StringType -> Printf.fprintf oc "String"\r
491   | EnumerationType enum_elts -> fprint_enumeration_type oc enum_elts\r
492 \r
493 and fprint_enumeration_type oc ss =\r
494   let rec fprint_enumeration_type' = function\r
495     | [] -> ()\r
496     | [s] -> Printf.fprintf oc "%s" s\r
497     | s :: ss -> Printf.fprintf oc "%s, " s; fprint_enumeration_type' ss in\r
498   Printf.fprintf oc "enumeration(";\r
499   fprint_enumeration_type' ss;\r
500   Printf.fprintf oc ")"\r
501 \r
502 and fprint_class_type_specifier_type oc offset cl_type =\r
503   if cl_type.partial then Printf.fprintf oc "partial ";\r
504   fprint_kind oc (Lazy.force cl_type.kind);\r
505   Printf.fprintf oc "_\n";\r
506   fprint_named_elements oc (offset + 1) cl_type.named_elements;\r
507   fprint_tabs oc offset;\r
508   Printf.fprintf oc "end _"\r
509 \r
510 and fprint_component_type_specifier_type oc offset cpnt_type =\r
511   Printf.fprintf oc "(";\r
512   if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";\r
513   fprint_variability oc (Lazy.force cpnt_type.variability);\r
514   fprint_causality oc (Lazy.force cpnt_type.causality);\r
515   fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);\r
516   fprint_dimensions oc (Lazy.force cpnt_type.base_class);\r
517   Printf.fprintf oc ")"\r
518 \r
519 and fprint_dimensions oc cs =\r
520   let fprint_dimension = function\r
521     | ConstantDimension d -> Printf.fprintf oc "%ld" d\r
522     | ParameterDimension -> Printf.fprintf oc "p"\r
523     | DiscreteDimension -> Printf.fprintf oc ":" in\r
524   let rec fprint_dimensions' dim = function\r
525     | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ ->\r
526         fprint_dimension dim\r
527     | ArrayType (dim', cs') ->\r
528         fprint_dimension dim;\r
529         Printf.fprintf oc ", ";\r
530         fprint_dimensions' dim' cs' in\r
531   match cs with\r
532     | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> ()\r
533     | ArrayType (dim, cs) ->\r
534         Printf.fprintf oc "["; fprint_dimensions' dim cs; Printf.fprintf oc "]"\r
535 \r
536 (* String conversion utilities *)\r
537 \r
538 let rec string_of_kind kind = match kind with\r
539   | Class -> "class "\r
540   | Model -> "model "\r
541   | Block -> "block "\r
542   | Record -> "record "\r
543   | ExpandableConnector -> "expandable connector "\r
544   | Connector -> "connector "\r
545   | Package -> "package "\r
546   | Function -> "function "\r
547 \r
548 and string_of_dynamic_scope dyn_scope = match dyn_scope with\r
549   | None -> ""\r
550   | Some Inner -> "inner "\r
551   | Some Outer -> "outer "\r
552   | Some InnerOuter -> "inner outer "\r
553 \r
554 and string_of_class_specifier cl_spec =\r
555   let string_of_dimension dim = match dim with\r
556     | ConstantDimension d -> Int32.to_string d\r
557     | ParameterDimension -> "p"\r
558     | DiscreteDimension -> ":" in\r
559   let string_of_dimensions dims =\r
560     let rec string_of_dimensions' dims = match dims with\r
561       | [] -> ""\r
562       | [dim] -> string_of_dimension dim\r
563       | dim :: dims ->\r
564           (string_of_dimension dim) ^ ", " ^ (string_of_dimensions' dims) in\r
565     match dims with\r
566       | [] -> ""\r
567       | _ -> "[" ^ (string_of_dimensions' dims) ^ "]" in\r
568   let rec string_of_class_specifier' dims cl_spec = match cl_spec with\r
569     | PredefinedType predef_type ->\r
570         (string_of_predefined_type predef_type) ^\r
571         (string_of_dimensions dims)\r
572     | ClassType cl_type ->\r
573         (string_of_class_type cl_type) ^\r
574         (string_of_dimensions dims) \r
575     | ComponentType cpnt_type ->\r
576         (string_of_component_type cpnt_type) ^\r
577         (string_of_dimensions dims) \r
578     | ArrayType (dim, cs) ->\r
579         string_of_class_specifier' (dim :: dims) cs\r
580     | TupleType cl_specs ->\r
581         "(" ^ (string_of_tuple_type cl_specs) ^ ")" ^\r
582         (string_of_dimensions dims) in\r
583   string_of_class_specifier' [] cl_spec\r
584 \r
585 and string_of_tuple_type cl_specs = match cl_specs with\r
586   | [] -> ""\r
587   | [cl_spec] -> string_of_class_specifier cl_spec\r
588   | cl_spec :: cl_specs ->\r
589       (string_of_class_specifier cl_spec) ^ ", " ^\r
590       (string_of_tuple_type cl_specs)\r
591 \r
592 and string_of_class_type cl_type =\r
593   string_of_kind (Lazy.force cl_type.kind)\r
594 \r
595 and string_of_component_type cpnt_type =\r
596   string_of_class_specifier (Lazy.force cpnt_type.base_class)\r
597 \r
598 and string_of_variability var = match var with\r
599   | Continuous -> "continuous"\r
600   | Discrete -> "discrete"\r
601   | Parameter -> "parameter"\r
602   | Constant -> "constant"\r
603 \r
604 and string_of_causality c = match c with\r
605   | Acausal -> ""\r
606   | Input -> "input"\r
607   | Output -> "output"\r
608 \r
609 and string_of_predefined_type predef_type =\r
610   string_of_base_type predef_type.base_type\r
611 \r
612 and string_of_base_type base_type = match base_type with\r
613   | BooleanType -> "Boolean"\r
614   | IntegerType -> "Integer"\r
615   | RealType -> "Real"\r
616   | StringType -> "String"\r
617   | EnumerationType enum_elts -> string_of_enumeration_type enum_elts\r
618 \r
619 and string_of_enumeration_type ss =\r
620   let rec string_of_enumeration_type' ss = match ss with\r
621     | [] -> ""\r
622     | [s] -> s\r
623     | s :: ss -> s ^ ", " ^ (string_of_enumeration_type' ss) in\r
624   "enumeration(" ^ (string_of_enumeration_type' ss) ^ ")"\r
625 \r
626 and string_of_element_nature = function\r
627   | ComponentElement _ -> "_ComponentElement"\r
628   | ClassElement _ -> "_ClassElement"\r
629   | ComponentTypeElement _ -> "_ComponentTypeElement"\r
630   | PredefinedTypeElement _ -> "_PredefinedTypeElement"\r