-(*\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"
projects / scilab.git / blobdiff