end of line
[scilab.git] / scilab / modules / scicos / src / translator / compilation / types.ml
index c6d07aa..7da9b7c 100644 (file)
-(*\r
- *  Translator from Modelica 2.x to flat Modelica\r
- *\r
- *  Copyright (C) 2005 - 2007 Imagine S.A.\r
- *  For more information or commercial use please contact us at www.amesim.com\r
- *\r
- *  This program is free software; you can redistribute it and/or\r
- *  modify it under the terms of the GNU General Public License\r
- *  as published by the Free Software Foundation; either version 2\r
- *  of the License, or (at your option) any later version.\r
- *\r
- *  This program is distributed in the hope that it will be useful,\r
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of\r
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
- *  GNU General Public License for more details.\r
- *\r
- *  You should have received a copy of the GNU General Public License\r
- *  along with this program; if not, write to the Free Software\r
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.\r
- *\r
- *)\r
-\r
-\r
-\r
-type element_type =\r
-  {\r
-    protected: bool;\r
-    final: bool;\r
-    replaceable: bool;\r
-    dynamic_scope: dynamic_scope option;\r
-    element_nature: element_nature\r
-  }\r
-\r
-and class_type =\r
-  {\r
-    partial: bool;\r
-    kind: kind Lazy.t;\r
-    named_elements: (string * element_type Lazy.t) list\r
-  }\r
-\r
-and kind =\r
-  | Class\r
-  | Model\r
-  | Block\r
-  | Record\r
-  | ExpandableConnector\r
-  | Connector\r
-  | Package\r
-  | Function\r
-\r
-and dynamic_scope =\r
-  | Inner\r
-  | Outer\r
-  | InnerOuter\r
-\r
-and element_nature =\r
-  | ComponentElement of component_type\r
-  | ClassElement of class_specifier Lazy.t\r
-  | ComponentTypeElement of component_type\r
-  | PredefinedTypeElement of predefined_type\r
-\r
-and component_type =\r
-  {\r
-    flow: bool Lazy.t;\r
-    variability: variability Lazy.t;\r
-    causality: causality Lazy.t;\r
-    base_class: class_specifier Lazy.t;\r
-  }\r
-\r
-and variability = Continuous | Discrete | Parameter | Constant\r
-\r
-and causality = Acausal | Input | Output\r
-\r
-and class_specifier =\r
-  | PredefinedType of predefined_type\r
-  | ClassType of class_type\r
-  | ComponentType of component_type\r
-  | ArrayType of dimension * class_specifier\r
-  | TupleType of class_specifier list\r
-\r
-and predefined_type =\r
-  {\r
-    base_type: base_type;\r
-    attributes: (string * bool) list\r
- }\r
-\r
-and base_type =\r
-  | BooleanType\r
-  | IntegerType\r
-  | RealType\r
-  | StringType\r
-  | EnumerationType of string list\r
-\r
-and dimension =\r
-  | ConstantDimension of int32\r
-  | ParameterDimension\r
-  | DiscreteDimension\r
-\r
-type type_comparison =\r
-  | NotRelated\r
-  | Subtype\r
-  | Supertype\r
-  | SameType\r
-\r
-\r
-(* Useful functions *)\r
-\r
-let evaluate x = Lazy.force x\r
-\r
-(* type calculations *)\r
-\r
-let min_variability var var' = match var, var' with\r
-  | Constant, _ | _, Constant -> Constant\r
-  | Parameter, _ | _, Parameter -> Parameter\r
-  | Discrete, _ | _, Discrete -> Discrete\r
-  | Continuous, Continuous -> Continuous\r
-\r
-and max_variability var var' = match var, var' with\r
-  | Continuous, _ | _, Continuous -> Continuous\r
-  | Discrete, _ | _, Discrete -> Discrete\r
-  | Parameter, _ | _, Parameter -> Parameter\r
-  | Constant, Constant -> Constant\r
-\r
-let higher_variability var var' =\r
-  (max_variability var var') = var\r
-\r
-and lower_variability var var' =\r
-  (max_variability var var') = var'\r
-\r
-let add_dimensions dims cl_spec =\r
-  let add_dimension dim cl_spec = ArrayType (dim, cl_spec) in\r
-  List.fold_right add_dimension dims cl_spec\r
-\r
-(* Utilities *)\r
-\r
-let empty_tuple_class_type = TupleType []\r
-\r
-let boolean_class_type =\r
-  PredefinedType { base_type = BooleanType; attributes = ["start", false] }\r
-\r
-and integer_class_type =\r
-  PredefinedType\r
-    { base_type = IntegerType; attributes = ["start", false; "nominal", false] }\r
-\r
-and real_class_type =\r
-  PredefinedType\r
-    { base_type = RealType; attributes = ["start", false; "nominal", false] }\r
-\r
-and string_class_type =\r
-  PredefinedType { base_type = StringType; attributes = ["start", false] }\r
-\r
-and enumeration_class_type enum_lits =\r
-  PredefinedType\r
-    { base_type = EnumerationType enum_lits; attributes = ["start", false] }\r
-\r
-let boolean_component_type var =\r
-  {\r
-    flow = lazy false;\r
-    variability = lazy var;\r
-    causality = lazy Acausal;\r
-    base_class = lazy boolean_class_type;\r
-  }\r
-\r
-let integer_component_type var =\r
-  { (boolean_component_type var) with\r
-    base_class = lazy integer_class_type\r
-  }\r
-\r
-let real_component_type var =\r
-  { (boolean_component_type var) with\r
-    base_class = lazy real_class_type\r
-  }\r
-\r
-let string_component_type var =\r
-  { (boolean_component_type var) with\r
-    base_class = lazy string_class_type\r
-  }\r
-\r
-let enumeration_component_type var enum_lits =\r
-  { \r
-    (boolean_component_type var) with\r
-    base_class = lazy (enumeration_class_type enum_lits)\r
-  }\r
-\r
-let integer_array_component_type var dims =\r
-  let cl_spec = integer_class_type in\r
-  {\r
-    flow = lazy false;\r
-    variability = lazy var;\r
-    causality = lazy Acausal;\r
-    base_class = lazy (add_dimensions dims cl_spec)\r
-  }\r
-\r
-let empty_tuple_type var =\r
-  ComponentElement\r
-    { (boolean_component_type var) with\r
-      base_class = lazy (empty_tuple_class_type)\r
-    }\r
-\r
-let boolean_type var = ComponentElement (boolean_component_type var)\r
-\r
-let integer_type var = ComponentElement (integer_component_type var)\r
-\r
-let integer_array_type var dim =\r
-  let cl_spec =\r
-    ArrayType\r
-      (dim,\r
-       PredefinedType { base_type = IntegerType; attributes = [] }) in\r
-  let cpnt_type =\r
-    {\r
-      flow = lazy false;\r
-      variability = lazy var;\r
-      causality = lazy Acausal;\r
-      base_class = lazy cl_spec\r
-    } in\r
-  ComponentElement cpnt_type\r
-\r
-let real_type var = ComponentElement (real_component_type var)\r
-\r
-let string_type var =\r
-  ComponentElement (string_component_type var)\r
-\r
-let enumeration_type var enum_lits =\r
-  ComponentElement (enumeration_component_type var enum_lits)\r
-\r
-let function_type inputs outputs =\r
-  let named_elements inout args =\r
-    let element_type cpnt_type =\r
-      {\r
-        protected = false;\r
-        final = true;\r
-        replaceable = false;\r
-        dynamic_scope = None;\r
-        element_nature =\r
-          ComponentElement { cpnt_type with causality = lazy inout }\r
-      } in\r
-    let named_element (id, cpnt_type) = id, lazy (element_type cpnt_type) in\r
-    List.map named_element args in\r
-  let cl_type =\r
-    {\r
-      partial = false;\r
-      kind = lazy Function;\r
-      named_elements =\r
-        named_elements Input inputs @ named_elements Output outputs\r
-    } in\r
-  ClassElement (lazy (ClassType cl_type))\r
-\r
-let reversed_element_dimensions elt_type =\r
-  let rec reversed_dimensions dims = function\r
-    | ArrayType (dim, cl_spec) -> reversed_dimensions (dim :: dims) cl_spec\r
-    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> dims in\r
-  match elt_type with\r
-    | ComponentElement cpnt_type ->\r
-        let cl_spec = evaluate cpnt_type.base_class in\r
-        reversed_dimensions [] cl_spec\r
-    | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _ -> []\r
-\r
-let scalar_component_type cpnt_type =\r
-  let rec scalar_class_specifier cl_spec = match cl_spec with\r
-    | ArrayType (_, cl_spec) -> scalar_class_specifier cl_spec\r
-    | _ -> cl_spec in\r
-  {\r
-    cpnt_type with\r
-    base_class = lazy (scalar_class_specifier (evaluate cpnt_type.base_class))\r
-  }\r
-\r
-\r
-(* General type comparisons *)\r
-\r
-let rec compare_class_types ct ct' =\r
-  match Lazy.force ct.kind, Lazy.force ct'.kind with\r
-  | Class, Class -> compare_classes ct ct'\r
-  | Model, Model -> compare_models ct ct'\r
-  | Block, Block -> compare_blocks ct ct'\r
-  | Record, Record -> compare_records ct ct'\r
-  | ExpandableConnector, ExpandableConnector ->\r
-      compare_expandable_connectors ct ct'\r
-  | Connector, Connector -> compare_connectors ct ct'\r
-  | Package, Package -> compare_packages ct ct'\r
-  | Function, Function -> compare_functions ct ct'\r
-  | _ -> NotRelated\r
-\r
-and compare_classes ct ct' =\r
-  let rec compare_classes' type_cmp named_elts named_elts' =\r
-    match named_elts' with\r
-    | [] -> type_cmp\r
-    | (s', _) :: _ when not (List.mem_assoc s' named_elts) -> NotRelated\r
-    | (s', elt_type') :: named_elts' ->\r
-        begin\r
-          let type_cmp' =\r
-            compare_elements\r
-              (Lazy.force (List.assoc s' named_elts))\r
-              (Lazy.force elt_type') in\r
-          match type_cmp, type_cmp' with\r
-            | SameType, (SameType | Subtype) ->\r
-                compare_classes' type_cmp' named_elts named_elts'\r
-            | Subtype, (SameType | Subtype) ->\r
-                compare_classes' Subtype named_elts named_elts'\r
-            | _ -> NotRelated\r
-        end in\r
-  let named_elts = ct.named_elements\r
-  and named_elts' = ct'.named_elements in\r
-  let l = List.length named_elts\r
-  and l' = List.length named_elts' in\r
-  if l < l' then invert (compare_classes' Subtype named_elts' named_elts)\r
-  else if l = l' then compare_classes' SameType named_elts named_elts'\r
-  else compare_classes' Subtype named_elts named_elts'\r
-\r
-and invert = function\r
-  | NotRelated -> NotRelated\r
-  | Subtype -> Supertype\r
-  | Supertype -> Subtype\r
-  | SameType -> SameType\r
-\r
-and compare_models ct ct' = compare_classes ct ct'\r
-\r
-and compare_blocks ct ct' = compare_classes ct ct'\r
-\r
-and compare_records ct ct' = compare_classes ct ct'\r
-\r
-and compare_expandable_connectors ct ct' = compare_classes ct ct'\r
-\r
-and compare_connectors ct ct' = compare_classes ct ct'\r
-\r
-and compare_packages ct ct' = compare_classes ct ct'\r
-\r
-and compare_functions ct ct' = compare_classes ct ct'\r
-\r
-and compare_elements elt_type elt_type' =\r
-  if\r
-    elt_type.protected = elt_type'.protected &&\r
-    elt_type.final = elt_type'.final &&\r
-    elt_type.replaceable = elt_type'.replaceable &&\r
-    elt_type.dynamic_scope = elt_type'.dynamic_scope\r
-  then compare_element_natures elt_type.element_nature elt_type'.element_nature\r
-  else NotRelated\r
-\r
-and compare_element_natures elt_nature elt_nature' = match elt_nature, elt_nature' with\r
-  | ComponentElement cpntt, ComponentElement cpntt' -> compare_component_types cpntt cpntt'\r
-  | ClassElement cs, ClassElement cs' -> compare_specifiers (Lazy.force cs) (Lazy.force cs')\r
-  | ComponentTypeElement cpntt, ComponentTypeElement cpntt' -> compare_component_types cpntt cpntt'\r
-  | PredefinedTypeElement pt, PredefinedTypeElement pt' -> compare_predefined_types pt pt'\r
-  | (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _),\r
-    (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _) ->\r
-      NotRelated\r
-\r
-and compare_component_types cpntt cpntt' =\r
-  (*if\r
-    Lazy.force cpntt.flow = Lazy.force cpntt'.flow &&\r
-    Lazy.force cpntt.variability = Lazy.force cpntt'.variability &&\r
-    Lazy.force cpntt.causality = Lazy.force cpntt'.causality\r
-  then*)\r
-    compare_specifiers (Lazy.force cpntt.base_class) (Lazy.force cpntt'.base_class)\r
-  (*else NotRelated*)\r
-\r
-and compare_specifiers cs cs' = match cs, cs' with\r
-  | PredefinedType pt, PredefinedType pt' -> compare_predefined_types pt pt'\r
-  | ClassType ct, ClassType ct' -> compare_class_types ct ct'\r
-  | ComponentType cpntt, ComponentType cpntt' -> compare_component_types cpntt cpntt'\r
-  | ArrayType (dim, cs), ArrayType (dim', cs')\r
-    when compare_dimensions dim dim' ->\r
-      compare_specifiers cs cs'\r
-  | TupleType css, TupleType css' -> compare_tuple_types css css'\r
-  | (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _),\r
-    (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _) ->\r
-      NotRelated\r
-\r
-and compare_dimensions dim dim' = match dim, dim' with\r
-  | ConstantDimension i, ConstantDimension i' when i <> i' -> false\r
-  | _ -> true\r
-\r
-and compare_tuple_types css css' =\r
-  if List.for_all2 (fun cs cs' -> compare_specifiers cs cs' = SameType) css css' then\r
-    SameType\r
-  else NotRelated\r
-\r
-and compare_predefined_types pt pt' = match pt.base_type, pt'.base_type with\r
-  | BooleanType, BooleanType -> SameType\r
-  | IntegerType, IntegerType -> SameType\r
-  | RealType, RealType -> SameType\r
-  | RealType, IntegerType -> Supertype\r
-  | IntegerType, RealType -> Subtype\r
-  | StringType, StringType -> SameType\r
-  | EnumerationType enum_elts, EnumerationType enum_elts'\r
-    when enum_elts = enum_elts' -> SameType\r
-  | _ -> NotRelated\r
-\r
-(* Printing utilities *)\r
-\r
-let fprint_tabs oc offset =\r
-  for i = 1 to offset do Printf.fprintf oc "\t" done\r
-\r
-let rec fprint_class_type oc id cl_type =\r
-  if cl_type.partial then Printf.fprintf oc "partial ";\r
-  fprint_kind oc (Lazy.force cl_type.kind);\r
-  Printf.fprintf oc "%s\n" id;\r
-  fprint_named_elements oc 1 cl_type.named_elements;\r
-  Printf.fprintf oc "end %s;\n" id\r
-\r
-and fprint_kind oc = function\r
-  | Class -> Printf.fprintf oc "class "\r
-  | Model -> Printf.fprintf oc "model "\r
-  | Block -> Printf.fprintf oc "block "\r
-  | Record -> Printf.fprintf oc "record "\r
-  | ExpandableConnector -> Printf.fprintf oc "expandable connector "\r
-  | Connector -> Printf.fprintf oc "connector "\r
-  | Package -> Printf.fprintf oc "package "\r
-  | Function -> Printf.fprintf oc "function "\r
-\r
-and fprint_named_elements oc offset named_elts =\r
-  List.iter\r
-    (function (s, elt_type) -> fprint_named_element oc offset (s, Lazy.force elt_type))\r
-    named_elts\r
-\r
-and fprint_named_element oc offset (id, elt_type) =\r
-  fprint_tabs oc offset;\r
-  if elt_type.protected then Printf.fprintf oc "protected ";\r
-  if elt_type.final then Printf.fprintf oc "final ";\r
-  if elt_type.replaceable then Printf.fprintf oc "replaceable ";\r
-  fprint_dynamic_scope oc elt_type.dynamic_scope;\r
-  fprint_element_nature oc offset id elt_type.element_nature\r
-\r
-and fprint_dynamic_scope oc = function\r
-  | None -> ()\r
-  | Some Inner -> Printf.fprintf oc "inner "\r
-  | Some Outer -> Printf.fprintf oc "outer "\r
-  | Some InnerOuter -> Printf.fprintf oc "inner outer "\r
-\r
-and fprint_element_nature oc offset id = function\r
-  | ComponentElement cpnt_type -> fprint_component_type oc offset id cpnt_type\r
-  | ClassElement cl_spec -> fprint_class_specifier oc offset id (Lazy.force cl_spec)\r
-  | ComponentTypeElement cpnt_type -> fprint_component_type_type oc offset id cpnt_type\r
-  | PredefinedTypeElement predef_type -> fprint_predefined_type_type oc id predef_type\r
-\r
-and fprint_class_specifier oc offset id = function\r
-  | PredefinedType _ -> assert false\r
-  | ClassType cl_type -> fprint_class_type_specifier oc offset id cl_type\r
-  | ComponentType _ -> assert false\r
-  | ArrayType (_, cs) -> fprint_class_specifier oc offset id cs\r
-  | TupleType _ -> assert false\r
-\r
-and fprint_class_type_specifier oc offset id cl_type =\r
-  if cl_type.partial then Printf.fprintf oc "partial ";\r
-  fprint_kind oc (Lazy.force cl_type.kind);\r
-  Printf.fprintf oc "%s\n" id;\r
-  fprint_named_elements oc (offset + 1) cl_type.named_elements;\r
-  fprint_tabs oc offset;\r
-  Printf.fprintf oc "end %s;\n" id\r
-\r
-and fprint_component_type_type oc offset id cpnt_type =\r
-  Printf.fprintf oc "type %s = " id;\r
-  fprint_component_type oc offset "" cpnt_type;\r
-  Printf.fprintf oc ";\n"\r
-\r
-and fprint_predefined_type_type oc id predef_type =\r
-  Printf.fprintf oc "type %s = " id;\r
-  fprint_predefined_type oc predef_type;\r
-  Printf.fprintf oc ";\n"\r
-\r
-and fprint_component_type oc offset id cpnt_type =\r
-  if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";\r
-  fprint_variability oc (Lazy.force cpnt_type.variability);\r
-  fprint_causality oc (Lazy.force cpnt_type.causality);\r
-  fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);\r
-  fprint_dimensions oc (Lazy.force cpnt_type.base_class);\r
-  Printf.fprintf oc " %s;\n" id\r
-\r
-and fprint_variability oc = function\r
-  | Continuous -> ()\r
-  | Discrete -> Printf.fprintf oc "discrete "\r
-  | Parameter -> Printf.fprintf oc "parameter "\r
-  | Constant -> Printf.fprintf oc "constant "\r
-\r
-and fprint_causality oc = function\r
-  | Acausal -> ()\r
-  | Input -> Printf.fprintf oc "input "\r
-  | Output -> Printf.fprintf oc "output "\r
-\r
-and fprint_class_specifier_type oc offset = function\r
-  | PredefinedType predef_type -> fprint_predefined_type oc predef_type\r
-  | ClassType cl_type -> fprint_class_type_specifier_type oc offset cl_type\r
-  | ComponentType cpnt_type -> fprint_component_type_specifier_type oc offset cpnt_type\r
-  | ArrayType (_, cs) -> fprint_class_specifier_type oc offset cs\r
-  | TupleType _ -> assert false\r
-\r
-and fprint_predefined_type oc predef_type = match predef_type.base_type with\r
-  | BooleanType -> Printf.fprintf oc "Boolean"\r
-  | IntegerType -> Printf.fprintf oc "Integer"\r
-  | RealType -> Printf.fprintf oc "Real"\r
-  | StringType -> Printf.fprintf oc "String"\r
-  | EnumerationType enum_elts -> fprint_enumeration_type oc enum_elts\r
-\r
-and fprint_enumeration_type oc ss =\r
-  let rec fprint_enumeration_type' = function\r
-    | [] -> ()\r
-    | [s] -> Printf.fprintf oc "%s" s\r
-    | s :: ss -> Printf.fprintf oc "%s, " s; fprint_enumeration_type' ss in\r
-  Printf.fprintf oc "enumeration(";\r
-  fprint_enumeration_type' ss;\r
-  Printf.fprintf oc ")"\r
-\r
-and fprint_class_type_specifier_type oc offset cl_type =\r
-  if cl_type.partial then Printf.fprintf oc "partial ";\r
-  fprint_kind oc (Lazy.force cl_type.kind);\r
-  Printf.fprintf oc "_\n";\r
-  fprint_named_elements oc (offset + 1) cl_type.named_elements;\r
-  fprint_tabs oc offset;\r
-  Printf.fprintf oc "end _"\r
-\r
-and fprint_component_type_specifier_type oc offset cpnt_type =\r
-  Printf.fprintf oc "(";\r
-  if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";\r
-  fprint_variability oc (Lazy.force cpnt_type.variability);\r
-  fprint_causality oc (Lazy.force cpnt_type.causality);\r
-  fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);\r
-  fprint_dimensions oc (Lazy.force cpnt_type.base_class);\r
-  Printf.fprintf oc ")"\r
-\r
-and fprint_dimensions oc cs =\r
-  let fprint_dimension = function\r
-    | ConstantDimension d -> Printf.fprintf oc "%ld" d\r
-    | ParameterDimension -> Printf.fprintf oc "p"\r
-    | DiscreteDimension -> Printf.fprintf oc ":" in\r
-  let rec fprint_dimensions' dim = function\r
-    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ ->\r
-        fprint_dimension dim\r
-    | ArrayType (dim', cs') ->\r
-        fprint_dimension dim;\r
-        Printf.fprintf oc ", ";\r
-        fprint_dimensions' dim' cs' in\r
-  match cs with\r
-    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> ()\r
-    | ArrayType (dim, cs) ->\r
-        Printf.fprintf oc "["; fprint_dimensions' dim cs; Printf.fprintf oc "]"\r
-\r
-(* String conversion utilities *)\r
-\r
-let rec string_of_kind kind = match kind with\r
-  | Class -> "class "\r
-  | Model -> "model "\r
-  | Block -> "block "\r
-  | Record -> "record "\r
-  | ExpandableConnector -> "expandable connector "\r
-  | Connector -> "connector "\r
-  | Package -> "package "\r
-  | Function -> "function "\r
-\r
-and string_of_dynamic_scope dyn_scope = match dyn_scope with\r
-  | None -> ""\r
-  | Some Inner -> "inner "\r
-  | Some Outer -> "outer "\r
-  | Some InnerOuter -> "inner outer "\r
-\r
-and string_of_class_specifier cl_spec =\r
-  let string_of_dimension dim = match dim with\r
-    | ConstantDimension d -> Int32.to_string d\r
-    | ParameterDimension -> "p"\r
-    | DiscreteDimension -> ":" in\r
-  let string_of_dimensions dims =\r
-    let rec string_of_dimensions' dims = match dims with\r
-      | [] -> ""\r
-      | [dim] -> string_of_dimension dim\r
-      | dim :: dims ->\r
-          (string_of_dimension dim) ^ ", " ^ (string_of_dimensions' dims) in\r
-    match dims with\r
-      | [] -> ""\r
-      | _ -> "[" ^ (string_of_dimensions' dims) ^ "]" in\r
-  let rec string_of_class_specifier' dims cl_spec = match cl_spec with\r
-    | PredefinedType predef_type ->\r
-        (string_of_predefined_type predef_type) ^\r
-        (string_of_dimensions dims)\r
-    | ClassType cl_type ->\r
-        (string_of_class_type cl_type) ^\r
-        (string_of_dimensions dims) \r
-    | ComponentType cpnt_type ->\r
-        (string_of_component_type cpnt_type) ^\r
-        (string_of_dimensions dims) \r
-    | ArrayType (dim, cs) ->\r
-        string_of_class_specifier' (dim :: dims) cs\r
-    | TupleType cl_specs ->\r
-        "(" ^ (string_of_tuple_type cl_specs) ^ ")" ^\r
-        (string_of_dimensions dims) in\r
-  string_of_class_specifier' [] cl_spec\r
-\r
-and string_of_tuple_type cl_specs = match cl_specs with\r
-  | [] -> ""\r
-  | [cl_spec] -> string_of_class_specifier cl_spec\r
-  | cl_spec :: cl_specs ->\r
-      (string_of_class_specifier cl_spec) ^ ", " ^\r
-      (string_of_tuple_type cl_specs)\r
-\r
-and string_of_class_type cl_type =\r
-  string_of_kind (Lazy.force cl_type.kind)\r
-\r
-and string_of_component_type cpnt_type =\r
-  string_of_class_specifier (Lazy.force cpnt_type.base_class)\r
-\r
-and string_of_variability var = match var with\r
-  | Continuous -> "continuous"\r
-  | Discrete -> "discrete"\r
-  | Parameter -> "parameter"\r
-  | Constant -> "constant"\r
-\r
-and string_of_causality c = match c with\r
-  | Acausal -> ""\r
-  | Input -> "input"\r
-  | Output -> "output"\r
-\r
-and string_of_predefined_type predef_type =\r
-  string_of_base_type predef_type.base_type\r
-\r
-and string_of_base_type base_type = match base_type with\r
-  | BooleanType -> "Boolean"\r
-  | IntegerType -> "Integer"\r
-  | RealType -> "Real"\r
-  | StringType -> "String"\r
-  | EnumerationType enum_elts -> string_of_enumeration_type enum_elts\r
-\r
-and string_of_enumeration_type ss =\r
-  let rec string_of_enumeration_type' ss = match ss with\r
-    | [] -> ""\r
-    | [s] -> s\r
-    | s :: ss -> s ^ ", " ^ (string_of_enumeration_type' ss) in\r
-  "enumeration(" ^ (string_of_enumeration_type' ss) ^ ")"\r
-\r
-and string_of_element_nature = function\r
-  | ComponentElement _ -> "_ComponentElement"\r
-  | ClassElement _ -> "_ClassElement"\r
-  | ComponentTypeElement _ -> "_ComponentTypeElement"\r
-  | PredefinedTypeElement _ -> "_PredefinedTypeElement"\r
+(*
+ *  Translator from Modelica 2.x to flat Modelica
+ *
+ *  Copyright (C) 2005 - 2007 Imagine S.A.
+ *  For more information or commercial use please contact us at www.amesim.com
+ *
+ *  This program is free software; you can redistribute it and/or
+ *  modify it under the terms of the GNU General Public License
+ *  as published by the Free Software Foundation; either version 2
+ *  of the License, or (at your option) any later version.
+ *
+ *  This program is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with this program; if not, write to the Free Software
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ *)
+
+
+
+type element_type =
+  {
+    protected: bool;
+    final: bool;
+    replaceable: bool;
+    dynamic_scope: dynamic_scope option;
+    element_nature: element_nature
+  }
+
+and class_type =
+  {
+    partial: bool;
+    kind: kind Lazy.t;
+    named_elements: (string * element_type Lazy.t) list
+  }
+
+and kind =
+  | Class
+  | Model
+  | Block
+  | Record
+  | ExpandableConnector
+  | Connector
+  | Package
+  | Function
+
+and dynamic_scope =
+  | Inner
+  | Outer
+  | InnerOuter
+
+and element_nature =
+  | ComponentElement of component_type
+  | ClassElement of class_specifier Lazy.t
+  | ComponentTypeElement of component_type
+  | PredefinedTypeElement of predefined_type
+
+and component_type =
+  {
+    flow: bool Lazy.t;
+    variability: variability Lazy.t;
+    causality: causality Lazy.t;
+    base_class: class_specifier Lazy.t;
+  }
+
+and variability = Continuous | Discrete | Parameter | Constant
+
+and causality = Acausal | Input | Output
+
+and class_specifier =
+  | PredefinedType of predefined_type
+  | ClassType of class_type
+  | ComponentType of component_type
+  | ArrayType of dimension * class_specifier
+  | TupleType of class_specifier list
+
+and predefined_type =
+  {
+    base_type: base_type;
+    attributes: (string * bool) list
+ }
+
+and base_type =
+  | BooleanType
+  | IntegerType
+  | RealType
+  | StringType
+  | EnumerationType of string list
+
+and dimension =
+  | ConstantDimension of int32
+  | ParameterDimension
+  | DiscreteDimension
+
+type type_comparison =
+  | NotRelated
+  | Subtype
+  | Supertype
+  | SameType
+
+
+(* Useful functions *)
+
+let evaluate x = Lazy.force x
+
+(* type calculations *)
+
+let min_variability var var' = match var, var' with
+  | Constant, _ | _, Constant -> Constant
+  | Parameter, _ | _, Parameter -> Parameter
+  | Discrete, _ | _, Discrete -> Discrete
+  | Continuous, Continuous -> Continuous
+
+and max_variability var var' = match var, var' with
+  | Continuous, _ | _, Continuous -> Continuous
+  | Discrete, _ | _, Discrete -> Discrete
+  | Parameter, _ | _, Parameter -> Parameter
+  | Constant, Constant -> Constant
+
+let higher_variability var var' =
+  (max_variability var var') = var
+
+and lower_variability var var' =
+  (max_variability var var') = var'
+
+let add_dimensions dims cl_spec =
+  let add_dimension dim cl_spec = ArrayType (dim, cl_spec) in
+  List.fold_right add_dimension dims cl_spec
+
+(* Utilities *)
+
+let empty_tuple_class_type = TupleType []
+
+let boolean_class_type =
+  PredefinedType { base_type = BooleanType; attributes = ["start", false] }
+
+and integer_class_type =
+  PredefinedType
+    { base_type = IntegerType; attributes = ["start", false; "nominal", false] }
+
+and real_class_type =
+  PredefinedType
+    { base_type = RealType; attributes = ["start", false; "nominal", false] }
+
+and string_class_type =
+  PredefinedType { base_type = StringType; attributes = ["start", false] }
+
+and enumeration_class_type enum_lits =
+  PredefinedType
+    { base_type = EnumerationType enum_lits; attributes = ["start", false] }
+
+let boolean_component_type var =
+  {
+    flow = lazy false;
+    variability = lazy var;
+    causality = lazy Acausal;
+    base_class = lazy boolean_class_type;
+  }
+
+let integer_component_type var =
+  { (boolean_component_type var) with
+    base_class = lazy integer_class_type
+  }
+
+let real_component_type var =
+  { (boolean_component_type var) with
+    base_class = lazy real_class_type
+  }
+
+let string_component_type var =
+  { (boolean_component_type var) with
+    base_class = lazy string_class_type
+  }
+
+let enumeration_component_type var enum_lits =
+  { 
+    (boolean_component_type var) with
+    base_class = lazy (enumeration_class_type enum_lits)
+  }
+
+let integer_array_component_type var dims =
+  let cl_spec = integer_class_type in
+  {
+    flow = lazy false;
+    variability = lazy var;
+    causality = lazy Acausal;
+    base_class = lazy (add_dimensions dims cl_spec)
+  }
+
+let empty_tuple_type var =
+  ComponentElement
+    { (boolean_component_type var) with
+      base_class = lazy (empty_tuple_class_type)
+    }
+
+let boolean_type var = ComponentElement (boolean_component_type var)
+
+let integer_type var = ComponentElement (integer_component_type var)
+
+let integer_array_type var dim =
+  let cl_spec =
+    ArrayType
+      (dim,
+       PredefinedType { base_type = IntegerType; attributes = [] }) in
+  let cpnt_type =
+    {
+      flow = lazy false;
+      variability = lazy var;
+      causality = lazy Acausal;
+      base_class = lazy cl_spec
+    } in
+  ComponentElement cpnt_type
+
+let real_type var = ComponentElement (real_component_type var)
+
+let string_type var =
+  ComponentElement (string_component_type var)
+
+let enumeration_type var enum_lits =
+  ComponentElement (enumeration_component_type var enum_lits)
+
+let function_type inputs outputs =
+  let named_elements inout args =
+    let element_type cpnt_type =
+      {
+        protected = false;
+        final = true;
+        replaceable = false;
+        dynamic_scope = None;
+        element_nature =
+          ComponentElement { cpnt_type with causality = lazy inout }
+      } in
+    let named_element (id, cpnt_type) = id, lazy (element_type cpnt_type) in
+    List.map named_element args in
+  let cl_type =
+    {
+      partial = false;
+      kind = lazy Function;
+      named_elements =
+        named_elements Input inputs @ named_elements Output outputs
+    } in
+  ClassElement (lazy (ClassType cl_type))
+
+let reversed_element_dimensions elt_type =
+  let rec reversed_dimensions dims = function
+    | ArrayType (dim, cl_spec) -> reversed_dimensions (dim :: dims) cl_spec
+    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> dims in
+  match elt_type with
+    | ComponentElement cpnt_type ->
+        let cl_spec = evaluate cpnt_type.base_class in
+        reversed_dimensions [] cl_spec
+    | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _ -> []
+
+let scalar_component_type cpnt_type =
+  let rec scalar_class_specifier cl_spec = match cl_spec with
+    | ArrayType (_, cl_spec) -> scalar_class_specifier cl_spec
+    | _ -> cl_spec in
+  {
+    cpnt_type with
+    base_class = lazy (scalar_class_specifier (evaluate cpnt_type.base_class))
+  }
+
+
+(* General type comparisons *)
+
+let rec compare_class_types ct ct' =
+  match Lazy.force ct.kind, Lazy.force ct'.kind with
+  | Class, Class -> compare_classes ct ct'
+  | Model, Model -> compare_models ct ct'
+  | Block, Block -> compare_blocks ct ct'
+  | Record, Record -> compare_records ct ct'
+  | ExpandableConnector, ExpandableConnector ->
+      compare_expandable_connectors ct ct'
+  | Connector, Connector -> compare_connectors ct ct'
+  | Package, Package -> compare_packages ct ct'
+  | Function, Function -> compare_functions ct ct'
+  | _ -> NotRelated
+
+and compare_classes ct ct' =
+  let rec compare_classes' type_cmp named_elts named_elts' =
+    match named_elts' with
+    | [] -> type_cmp
+    | (s', _) :: _ when not (List.mem_assoc s' named_elts) -> NotRelated
+    | (s', elt_type') :: named_elts' ->
+        begin
+          let type_cmp' =
+            compare_elements
+              (Lazy.force (List.assoc s' named_elts))
+              (Lazy.force elt_type') in
+          match type_cmp, type_cmp' with
+            | SameType, (SameType | Subtype) ->
+                compare_classes' type_cmp' named_elts named_elts'
+            | Subtype, (SameType | Subtype) ->
+                compare_classes' Subtype named_elts named_elts'
+            | _ -> NotRelated
+        end in
+  let named_elts = ct.named_elements
+  and named_elts' = ct'.named_elements in
+  let l = List.length named_elts
+  and l' = List.length named_elts' in
+  if l < l' then invert (compare_classes' Subtype named_elts' named_elts)
+  else if l = l' then compare_classes' SameType named_elts named_elts'
+  else compare_classes' Subtype named_elts named_elts'
+
+and invert = function
+  | NotRelated -> NotRelated
+  | Subtype -> Supertype
+  | Supertype -> Subtype
+  | SameType -> SameType
+
+and compare_models ct ct' = compare_classes ct ct'
+
+and compare_blocks ct ct' = compare_classes ct ct'
+
+and compare_records ct ct' = compare_classes ct ct'
+
+and compare_expandable_connectors ct ct' = compare_classes ct ct'
+
+and compare_connectors ct ct' = compare_classes ct ct'
+
+and compare_packages ct ct' = compare_classes ct ct'
+
+and compare_functions ct ct' = compare_classes ct ct'
+
+and compare_elements elt_type elt_type' =
+  if
+    elt_type.protected = elt_type'.protected &&
+    elt_type.final = elt_type'.final &&
+    elt_type.replaceable = elt_type'.replaceable &&
+    elt_type.dynamic_scope = elt_type'.dynamic_scope
+  then compare_element_natures elt_type.element_nature elt_type'.element_nature
+  else NotRelated
+
+and compare_element_natures elt_nature elt_nature' = match elt_nature, elt_nature' with
+  | ComponentElement cpntt, ComponentElement cpntt' -> compare_component_types cpntt cpntt'
+  | ClassElement cs, ClassElement cs' -> compare_specifiers (Lazy.force cs) (Lazy.force cs')
+  | ComponentTypeElement cpntt, ComponentTypeElement cpntt' -> compare_component_types cpntt cpntt'
+  | PredefinedTypeElement pt, PredefinedTypeElement pt' -> compare_predefined_types pt pt'
+  | (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _),
+    (ComponentElement _ | ClassElement _ | ComponentTypeElement _ | PredefinedTypeElement _) ->
+      NotRelated
+
+and compare_component_types cpntt cpntt' =
+  (*if
+    Lazy.force cpntt.flow = Lazy.force cpntt'.flow &&
+    Lazy.force cpntt.variability = Lazy.force cpntt'.variability &&
+    Lazy.force cpntt.causality = Lazy.force cpntt'.causality
+  then*)
+    compare_specifiers (Lazy.force cpntt.base_class) (Lazy.force cpntt'.base_class)
+  (*else NotRelated*)
+
+and compare_specifiers cs cs' = match cs, cs' with
+  | PredefinedType pt, PredefinedType pt' -> compare_predefined_types pt pt'
+  | ClassType ct, ClassType ct' -> compare_class_types ct ct'
+  | ComponentType cpntt, ComponentType cpntt' -> compare_component_types cpntt cpntt'
+  | ArrayType (dim, cs), ArrayType (dim', cs')
+    when compare_dimensions dim dim' ->
+      compare_specifiers cs cs'
+  | TupleType css, TupleType css' -> compare_tuple_types css css'
+  | (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _),
+    (PredefinedType _ | ClassType _ | ComponentType _ | ArrayType _ | TupleType _) ->
+      NotRelated
+
+and compare_dimensions dim dim' = match dim, dim' with
+  | ConstantDimension i, ConstantDimension i' when i <> i' -> false
+  | _ -> true
+
+and compare_tuple_types css css' =
+  if List.for_all2 (fun cs cs' -> compare_specifiers cs cs' = SameType) css css' then
+    SameType
+  else NotRelated
+
+and compare_predefined_types pt pt' = match pt.base_type, pt'.base_type with
+  | BooleanType, BooleanType -> SameType
+  | IntegerType, IntegerType -> SameType
+  | RealType, RealType -> SameType
+  | RealType, IntegerType -> Supertype
+  | IntegerType, RealType -> Subtype
+  | StringType, StringType -> SameType
+  | EnumerationType enum_elts, EnumerationType enum_elts'
+    when enum_elts = enum_elts' -> SameType
+  | _ -> NotRelated
+
+(* Printing utilities *)
+
+let fprint_tabs oc offset =
+  for i = 1 to offset do Printf.fprintf oc "\t" done
+
+let rec fprint_class_type oc id cl_type =
+  if cl_type.partial then Printf.fprintf oc "partial ";
+  fprint_kind oc (Lazy.force cl_type.kind);
+  Printf.fprintf oc "%s\n" id;
+  fprint_named_elements oc 1 cl_type.named_elements;
+  Printf.fprintf oc "end %s;\n" id
+
+and fprint_kind oc = function
+  | Class -> Printf.fprintf oc "class "
+  | Model -> Printf.fprintf oc "model "
+  | Block -> Printf.fprintf oc "block "
+  | Record -> Printf.fprintf oc "record "
+  | ExpandableConnector -> Printf.fprintf oc "expandable connector "
+  | Connector -> Printf.fprintf oc "connector "
+  | Package -> Printf.fprintf oc "package "
+  | Function -> Printf.fprintf oc "function "
+
+and fprint_named_elements oc offset named_elts =
+  List.iter
+    (function (s, elt_type) -> fprint_named_element oc offset (s, Lazy.force elt_type))
+    named_elts
+
+and fprint_named_element oc offset (id, elt_type) =
+  fprint_tabs oc offset;
+  if elt_type.protected then Printf.fprintf oc "protected ";
+  if elt_type.final then Printf.fprintf oc "final ";
+  if elt_type.replaceable then Printf.fprintf oc "replaceable ";
+  fprint_dynamic_scope oc elt_type.dynamic_scope;
+  fprint_element_nature oc offset id elt_type.element_nature
+
+and fprint_dynamic_scope oc = function
+  | None -> ()
+  | Some Inner -> Printf.fprintf oc "inner "
+  | Some Outer -> Printf.fprintf oc "outer "
+  | Some InnerOuter -> Printf.fprintf oc "inner outer "
+
+and fprint_element_nature oc offset id = function
+  | ComponentElement cpnt_type -> fprint_component_type oc offset id cpnt_type
+  | ClassElement cl_spec -> fprint_class_specifier oc offset id (Lazy.force cl_spec)
+  | ComponentTypeElement cpnt_type -> fprint_component_type_type oc offset id cpnt_type
+  | PredefinedTypeElement predef_type -> fprint_predefined_type_type oc id predef_type
+
+and fprint_class_specifier oc offset id = function
+  | PredefinedType _ -> assert false
+  | ClassType cl_type -> fprint_class_type_specifier oc offset id cl_type
+  | ComponentType _ -> assert false
+  | ArrayType (_, cs) -> fprint_class_specifier oc offset id cs
+  | TupleType _ -> assert false
+
+and fprint_class_type_specifier oc offset id cl_type =
+  if cl_type.partial then Printf.fprintf oc "partial ";
+  fprint_kind oc (Lazy.force cl_type.kind);
+  Printf.fprintf oc "%s\n" id;
+  fprint_named_elements oc (offset + 1) cl_type.named_elements;
+  fprint_tabs oc offset;
+  Printf.fprintf oc "end %s;\n" id
+
+and fprint_component_type_type oc offset id cpnt_type =
+  Printf.fprintf oc "type %s = " id;
+  fprint_component_type oc offset "" cpnt_type;
+  Printf.fprintf oc ";\n"
+
+and fprint_predefined_type_type oc id predef_type =
+  Printf.fprintf oc "type %s = " id;
+  fprint_predefined_type oc predef_type;
+  Printf.fprintf oc ";\n"
+
+and fprint_component_type oc offset id cpnt_type =
+  if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";
+  fprint_variability oc (Lazy.force cpnt_type.variability);
+  fprint_causality oc (Lazy.force cpnt_type.causality);
+  fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);
+  fprint_dimensions oc (Lazy.force cpnt_type.base_class);
+  Printf.fprintf oc " %s;\n" id
+
+and fprint_variability oc = function
+  | Continuous -> ()
+  | Discrete -> Printf.fprintf oc "discrete "
+  | Parameter -> Printf.fprintf oc "parameter "
+  | Constant -> Printf.fprintf oc "constant "
+
+and fprint_causality oc = function
+  | Acausal -> ()
+  | Input -> Printf.fprintf oc "input "
+  | Output -> Printf.fprintf oc "output "
+
+and fprint_class_specifier_type oc offset = function
+  | PredefinedType predef_type -> fprint_predefined_type oc predef_type
+  | ClassType cl_type -> fprint_class_type_specifier_type oc offset cl_type
+  | ComponentType cpnt_type -> fprint_component_type_specifier_type oc offset cpnt_type
+  | ArrayType (_, cs) -> fprint_class_specifier_type oc offset cs
+  | TupleType _ -> assert false
+
+and fprint_predefined_type oc predef_type = match predef_type.base_type with
+  | BooleanType -> Printf.fprintf oc "Boolean"
+  | IntegerType -> Printf.fprintf oc "Integer"
+  | RealType -> Printf.fprintf oc "Real"
+  | StringType -> Printf.fprintf oc "String"
+  | EnumerationType enum_elts -> fprint_enumeration_type oc enum_elts
+
+and fprint_enumeration_type oc ss =
+  let rec fprint_enumeration_type' = function
+    | [] -> ()
+    | [s] -> Printf.fprintf oc "%s" s
+    | s :: ss -> Printf.fprintf oc "%s, " s; fprint_enumeration_type' ss in
+  Printf.fprintf oc "enumeration(";
+  fprint_enumeration_type' ss;
+  Printf.fprintf oc ")"
+
+and fprint_class_type_specifier_type oc offset cl_type =
+  if cl_type.partial then Printf.fprintf oc "partial ";
+  fprint_kind oc (Lazy.force cl_type.kind);
+  Printf.fprintf oc "_\n";
+  fprint_named_elements oc (offset + 1) cl_type.named_elements;
+  fprint_tabs oc offset;
+  Printf.fprintf oc "end _"
+
+and fprint_component_type_specifier_type oc offset cpnt_type =
+  Printf.fprintf oc "(";
+  if Lazy.force cpnt_type.flow then Printf.fprintf oc "flow ";
+  fprint_variability oc (Lazy.force cpnt_type.variability);
+  fprint_causality oc (Lazy.force cpnt_type.causality);
+  fprint_class_specifier_type oc offset (Lazy.force cpnt_type.base_class);
+  fprint_dimensions oc (Lazy.force cpnt_type.base_class);
+  Printf.fprintf oc ")"
+
+and fprint_dimensions oc cs =
+  let fprint_dimension = function
+    | ConstantDimension d -> Printf.fprintf oc "%ld" d
+    | ParameterDimension -> Printf.fprintf oc "p"
+    | DiscreteDimension -> Printf.fprintf oc ":" in
+  let rec fprint_dimensions' dim = function
+    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ ->
+        fprint_dimension dim
+    | ArrayType (dim', cs') ->
+        fprint_dimension dim;
+        Printf.fprintf oc ", ";
+        fprint_dimensions' dim' cs' in
+  match cs with
+    | PredefinedType _ | ClassType _ | ComponentType _ | TupleType _ -> ()
+    | ArrayType (dim, cs) ->
+        Printf.fprintf oc "["; fprint_dimensions' dim cs; Printf.fprintf oc "]"
+
+(* String conversion utilities *)
+
+let rec string_of_kind kind = match kind with
+  | Class -> "class "
+  | Model -> "model "
+  | Block -> "block "
+  | Record -> "record "
+  | ExpandableConnector -> "expandable connector "
+  | Connector -> "connector "
+  | Package -> "package "
+  | Function -> "function "
+
+and string_of_dynamic_scope dyn_scope = match dyn_scope with
+  | None -> ""
+  | Some Inner -> "inner "
+  | Some Outer -> "outer "
+  | Some InnerOuter -> "inner outer "
+
+and string_of_class_specifier cl_spec =
+  let string_of_dimension dim = match dim with
+    | ConstantDimension d -> Int32.to_string d
+    | ParameterDimension -> "p"
+    | DiscreteDimension -> ":" in
+  let string_of_dimensions dims =
+    let rec string_of_dimensions' dims = match dims with
+      | [] -> ""
+      | [dim] -> string_of_dimension dim
+      | dim :: dims ->
+          (string_of_dimension dim) ^ ", " ^ (string_of_dimensions' dims) in
+    match dims with
+      | [] -> ""
+      | _ -> "[" ^ (string_of_dimensions' dims) ^ "]" in
+  let rec string_of_class_specifier' dims cl_spec = match cl_spec with
+    | PredefinedType predef_type ->
+        (string_of_predefined_type predef_type) ^
+        (string_of_dimensions dims)
+    | ClassType cl_type ->
+        (string_of_class_type cl_type) ^
+        (string_of_dimensions dims) 
+    | ComponentType cpnt_type ->
+        (string_of_component_type cpnt_type) ^
+        (string_of_dimensions dims) 
+    | ArrayType (dim, cs) ->
+        string_of_class_specifier' (dim :: dims) cs
+    | TupleType cl_specs ->
+        "(" ^ (string_of_tuple_type cl_specs) ^ ")" ^
+        (string_of_dimensions dims) in
+  string_of_class_specifier' [] cl_spec
+
+and string_of_tuple_type cl_specs = match cl_specs with
+  | [] -> ""
+  | [cl_spec] -> string_of_class_specifier cl_spec
+  | cl_spec :: cl_specs ->
+      (string_of_class_specifier cl_spec) ^ ", " ^
+      (string_of_tuple_type cl_specs)
+
+and string_of_class_type cl_type =
+  string_of_kind (Lazy.force cl_type.kind)
+
+and string_of_component_type cpnt_type =
+  string_of_class_specifier (Lazy.force cpnt_type.base_class)
+
+and string_of_variability var = match var with
+  | Continuous -> "continuous"
+  | Discrete -> "discrete"
+  | Parameter -> "parameter"
+  | Constant -> "constant"
+
+and string_of_causality c = match c with
+  | Acausal -> ""
+  | Input -> "input"
+  | Output -> "output"
+
+and string_of_predefined_type predef_type =
+  string_of_base_type predef_type.base_type
+
+and string_of_base_type base_type = match base_type with
+  | BooleanType -> "Boolean"
+  | IntegerType -> "Integer"
+  | RealType -> "Real"
+  | StringType -> "String"
+  | EnumerationType enum_elts -> string_of_enumeration_type enum_elts
+
+and string_of_enumeration_type ss =
+  let rec string_of_enumeration_type' ss = match ss with
+    | [] -> ""
+    | [s] -> s
+    | s :: ss -> s ^ ", " ^ (string_of_enumeration_type' ss) in
+  "enumeration(" ^ (string_of_enumeration_type' ss) ^ ")"
+
+and string_of_element_nature = function
+  | ComponentElement _ -> "_ComponentElement"
+  | ClassElement _ -> "_ClassElement"
+  | ComponentTypeElement _ -> "_ComponentTypeElement"
+  | PredefinedTypeElement _ -> "_PredefinedTypeElement"