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