add translator & XML2modelica
Allan CORNET [Wed, 6 Jan 2010 09:26:40 +0000 (10:26 +0100)]
32 files changed:
scilab/modules/scicos/.gitignore
scilab/modules/scicos/src/translator/compilation/.depend [new file with mode: 0644]
scilab/modules/scicos/src/translator/compilation/nameResolve.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/compilation/types.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/exceptionHandling/.depend [new file with mode: 0644]
scilab/modules/scicos/src/translator/exceptionHandling/errorDico.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/exceptionHandling/exceptHandler.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/exceptionHandling/msgDico.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/instantiation/.depend [new file with mode: 0644]
scilab/modules/scicos/src/translator/instantiation/instantiation.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/.depend [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/lexer.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/lexer.mll [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/linenum.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/linenum.mll [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/parser.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/parser.mly [new file with mode: 0644]
scilab/modules/scicos/src/translator/parsing/syntax.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/translation/.depend [new file with mode: 0644]
scilab/modules/scicos/src/translator/translation/codeGeneration.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/translation/libraryManager.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/translation/translator.ml [new file with mode: 0644]
scilab/modules/scicos/src/translator/translation/versiondate.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/.depend [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/linenum.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/modelicaCodeGenerator.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/stringLexer.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/stringParser.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/xML2Modelica.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/xMLLexer.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/xMLParser.ml [new file with mode: 0644]
scilab/modules/scicos/src/xml2modelica/xMLTree.ml [new file with mode: 0644]

index 102eb8d..c4585ce 100644 (file)
@@ -12,6 +12,34 @@ src/modelica_compiler/doc
 src/modelica_compiler/modelicac.exe
 src/modelica_compiler/*.obj
 
+
+#XML2Modelica
+XML2Modelica
+src/xml2modelica/*.cmi
+src/xml2modelica/*.cmo
+
+#translator
+src/translator/compilation/compilation.a
+src/translator/compilation/*.cmxa
+src/translator/compilation/*.cmi
+src/translator/compilation/*.cmx
+src/translator/exceptionHandling/*.cmi
+src/translator/exceptionHandling/*.cmx
+src/translator/exceptionHandling/exceptionHandling.a
+src/translator/exceptionHandling/*.cmxa
+src/translator/instantiation/instantiation.a
+src/translator/instantiation/*.cmi
+src/translator/instantiation/*.cmx
+src/translator/instantiation/*.cmxa
+src/translator/parsing/*.cmi
+src/translator/parsing/*.cmo
+src/translator/parsing/*.cma
+src/translator/parsing/*.cmx
+src/translator/parsing/parsing.a
+src/translator/parsing/*.cmxa
+src/translator/translation/*.cmi
+src/translator/translation/*.cmx
+
 #
 #generated .def files (windows)
 #
diff --git a/scilab/modules/scicos/src/translator/compilation/.depend b/scilab/modules/scicos/src/translator/compilation/.depend
new file mode 100644 (file)
index 0000000..8c9318d
--- /dev/null
@@ -0,0 +1,4 @@
+types.cmo: 
+types.cmx: 
+nameResolve.cmo: types.cmo ../parsing/syntax.cmo ../parsing/parser.cmo 
+nameResolve.cmx: types.cmx ../parsing/syntax.cmx ../parsing/parser.cmx 
diff --git a/scilab/modules/scicos/src/translator/compilation/nameResolve.ml b/scilab/modules/scicos/src/translator/compilation/nameResolve.ml
new file mode 100644 (file)
index 0000000..9edbcf4
--- /dev/null
@@ -0,0 +1,5153 @@
+(*\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
+(** Resolution of types for Modelica elements from the abstract syntax tree.\r
+The main functions are:\r
+{ul\r
+{- [ resolve_toplevel ]: Main function. Resolve a list of top level syntax element}\r
+{- [ resolve_variable_definition ]: Resolution of a variable definition}\r
+{- [ resolve_class_definition ]: Resolution of a class definition}\r
+{- [ resolve_modification ]: Resolution of modifications}\r
+{- [ resolve_expression ]: Resolution of syntax expressions\r
+  {ul\r
+  {- [ resolve_binary_operation ]: Resolve binary operation expression }\r
+  {- [ resolve_unuary_operation ]: Resolve unary operation }\r
+  {- [ resolve_identifier ]: scoping algorithm and resolution of identifiers}\r
+  {- [ apply_binary_coercions, apply_rhs_coercions ]: Adding of Real to Integer implicit coercions}\r
+  {- [ resolve_function_call ]: Resolution of a function call expression }\r
+  {- [ resolve_field_access ]: Resolve field access }\r
+  {- [ resolve_if ]: Resolve [ if ] expression }\r
+  {- [ resolve_indexed_access ]: Resolve indexed access }\r
+  {- [ resolve_vector ]: Resolve vector expression }\r
+  {- [ resolve_range ]: resolve range expression }\r
+  }\r
+}\r
+{- [ resolve_equation ]: Resolution of an equation\r
+  {ul\r
+  {- [ resolve_equal ]: Resolution of a simple equation of the form [ expr1 = expr2 ] }\r
+  {- [ resolve_conditional_equation_e ]: Resolution of conditional equations }\r
+  {- [ resolve_for_clause_e ]: Resolution of for equations }\r
+  {- [ resolve_connect_clause ]: resolution of connect equations }\r
+  {- [ resolve_when_clause_e ]: resolution of when equations}\r
+  {- [ equations ]: resolution of array, record and for equations\r
+  }\r
+}\r
+}\r
+*)\r
+\r
+(* The type [ node ] is used to attach syntax information to resolved elements *)\r
+type ('a, 'b) node =\r
+  {\r
+    nature: 'a;\r
+    info: 'b\r
+  }\r
+\r
+(* Type of resolved elements *)\r
+\r
+and element_description =\r
+  {\r
+    element_type: Types.element_type Lazy.t;\r
+    redeclare: bool;\r
+    element_nature: element_nature;\r
+    element_location: Parser.location\r
+  }\r
+\r
+and element_nature =\r
+  | Component of component_description\r
+  | Class of class_definition\r
+  | ComponentType of component_type_description\r
+  | PredefinedType of Types.predefined_type\r
+\r
+and component_description =\r
+  {\r
+    component_type: Types.component_type Lazy.t;\r
+    type_specifier: expression Lazy.t;\r
+    dimensions: dimension list Lazy.t;\r
+    modification: modification option Lazy.t;\r
+    comment: string\r
+  }\r
+\r
+and dimension =\r
+  | Colon\r
+  | Expression of expression\r
+\r
+and class_definition =\r
+  {\r
+    class_type: Types.class_specifier Lazy.t;\r
+    enclosing_class: class_definition option;\r
+    encapsulated: bool;\r
+    description: class_description Lazy.t;\r
+  }\r
+\r
+and class_description =\r
+  | LongDescription of long_description\r
+  | ShortDescription of modified_class\r
+\r
+and long_description =\r
+  {\r
+    class_annotations: (annotation list) Lazy.t;\r
+    imports: import_description list;\r
+    extensions: (visibility * modified_class) list;\r
+    named_elements: named_element list;\r
+    unnamed_elements: equation_or_algorithm_clause list Lazy.t;\r
+    external_call: external_call option Lazy.t\r
+  }\r
+\r
+and annotation =\r
+  | InverseFunction of inverse_function Lazy.t\r
+  | UnknownAnnotation of (Parser.location Syntax.class_modification) Lazy.t\r
+\r
+and inverse_function =\r
+  {\r
+    function_class: expression;\r
+    arguments: (string * string) list\r
+  }\r
+\r
+and import_description = unit\r
+\r
+and visibility = Public | Protected\r
+\r
+and named_element = string * element_description\r
+\r
+and modified_class =\r
+  {\r
+    modified_class_type: Types.class_type Lazy.t;\r
+    base_class: expression Lazy.t;\r
+    class_modification: class_modification Lazy.t\r
+  }\r
+\r
+and component_type_description =\r
+  {\r
+    described_type: Types.component_type Lazy.t;\r
+    base_type: expression Lazy.t;\r
+    type_dimensions: dimension list Lazy.t;\r
+    type_modification: class_modification Lazy.t\r
+  }\r
+\r
+and external_call = (external_call_desc, Parser.location Syntax.externalll) node\r
+\r
+and external_call_desc =\r
+  | PrimitiveCall of string\r
+  | ExternalProcedureCall of language *\r
+      expression option (* rhs *) * string * expression list\r
+\r
+and language = C | FORTRAN\r
+\r
+and modification =\r
+  | Modification of class_modification * expression Lazy.t option\r
+  | Assignment of expression Lazy.t\r
+  | Equality of expression Lazy.t\r
+\r
+and class_modification = modification_argument list\r
+\r
+and modification_argument =\r
+  {\r
+    each: bool;\r
+    final: bool;\r
+    target: string;\r
+    action: modification_action option\r
+  }\r
+\r
+and modification_action =\r
+  | ElementModification of modification\r
+  | ElementRedeclaration of element_description\r
+\r
+(* Type of equations and algorithms *)\r
+\r
+and equation_or_algorithm_clause =\r
+  | EquationClause of validity * equation list\r
+  | AlgorithmClause of validity * algorithm list\r
+\r
+and validity = Initial | Permanent\r
+\r
+and equation = (equation_desc, Parser.location Syntax.equation option) node\r
+\r
+and equation_desc =\r
+  | Equal of expression * expression\r
+  | ConditionalEquationE of (expression * equation list) list * equation list\r
+  | ForClauseE of expression list (* ranges *) * equation list\r
+  | ConnectFlows of sign * expression * sign * expression\r
+  | WhenClauseE of (expression * equation list) list\r
+\r
+and sign = Positive | Negative\r
+\r
+and algorithm = (algorithm_desc, Parser.location Syntax.algorithm option) node\r
+\r
+and algorithm_desc =\r
+  | Assign of expression * expression\r
+  | FunctionCallA of expression * expression list\r
+  | MultipleAssign of expression list * expression * expression list\r
+  | Break\r
+  | Return\r
+  | ConditionalEquationA of (expression * algorithm list) list *\r
+      algorithm list\r
+  | ForClauseA of expression list (* ranges *) * algorithm list\r
+  | WhileClause of expression * algorithm list\r
+  | WhenClauseA of (expression * algorithm list) list\r
+\r
+(* Type of expressions *)\r
+\r
+and expression = (expression_desc, expression_information) node\r
+\r
+(* Type of a resolved expression:\r
+- [ syntax ]: expression syntax (this information is optional, some expressions\r
+  are dynamicaly created during typing analysis)\r
+- [ type_description ]: expression type *)\r
+and expression_information =\r
+  {\r
+    syntax: Parser.location Syntax.expression option;\r
+    type_description: Types.element_nature\r
+  }\r
+\r
+and expression_desc =\r
+  | BinaryOperation of binary_operator_kind * expression * expression\r
+  | DynamicIdentifier of int (** number of nested classes to skip *) *\r
+      string (** name to be searched for at instanciation time *)\r
+  | False\r
+  | FieldAccess of expression * string\r
+  | FunctionArgument of int (** the position of the argument in the call *)\r
+  | FunctionCall of expression (** function *) *\r
+      expression list (** arguments *) *\r
+      expression (** the expression involving the function call *)\r
+      (** creation of a dynamic function context *)\r
+  | FunctionInvocation of expression list\r
+      (** invocation of the current function in context *)\r
+  | If of (expression (** condition *) * expression) list *\r
+      expression (** default *)\r
+  | IndexedAccess of expression * expression list (* subscripts *)\r
+  | Integer of int32\r
+  | LocalIdentifier of int (** number of nested classes to skip *) *\r
+      string (** key in the dictionary of the defining class *)\r
+  | LoopVariable of int (** number of nested for loops to skip *)\r
+  | NoEvent of expression\r
+  | PredefinedIdentifier of string (** predefined identifier *)\r
+  | Range of expression * expression * expression\r
+  | Real of float\r
+  | String of string\r
+  | ToplevelIdentifier of string (** key in the toplevel dictionary *)\r
+  | True\r
+  | Tuple of expression list\r
+  | UnaryOperation of unary_operator_kind * expression\r
+  | Vector of expression list\r
+  | VectorReduction of expression list (** nested ranges *) * expression\r
+  | Coercion of coercion_kind * expression\r
+\r
+and coercion_kind =\r
+  | RealOfInteger (** Implicit conversion of Integer to Real *)\r
+\r
+and unary_operator_kind =\r
+  | Not\r
+  | UnaryMinus\r
+  | UnaryPlus\r
+\r
+and binary_operator_kind =\r
+  | And\r
+  | Divide\r
+  | EqualEqual\r
+  | GreaterEqual\r
+  | Greater\r
+  | LessEqual\r
+  | Less\r
+  | Times\r
+  | NotEqual\r
+  | Or\r
+  | Plus\r
+  | Power\r
+  | Minus\r
+\r
+(* Context types. Contexts are used to resolve identifiers in expressions *)\r
+\r
+type context =\r
+  {\r
+    toplevel: (string * element_description) list Lazy.t;\r
+    context_nature: context_nature;\r
+    location: Parser.location\r
+  }\r
+\r
+and context_nature =\r
+  | ToplevelContext\r
+  | ClassContext of class_definition\r
+  | SubscriptContext of\r
+      context * expression (* evaluating to an array *) *\r
+      int32 (* dimension index *) * Types.dimension\r
+  | ForContext of context * string * Types.element_nature\r
+\r
+(* Type Errors detected during compilation *)\r
+\r
+type error_description =\r
+  {\r
+    err_msg: string list;\r
+    err_info: (string * string) list;\r
+    err_ctx: context\r
+  }\r
+\r
+exception CompilError of error_description\r
+\r
+(* Utilities *)\r
+\r
+let evaluate x = Lazy.force x\r
+\r
+let resolve_elements add_element elts other_elts =\r
+  let resolve_other_elements other_elt acc = match other_elt.Syntax.nature with\r
+    | Syntax.Public elts -> List.fold_right (add_element Public) elts acc\r
+    | Syntax.Protected elts -> List.fold_right (add_element Protected) elts acc\r
+    | Syntax.EquationClause _ | Syntax.AlgorithmClause _ -> acc in\r
+  List.fold_right\r
+    (add_element Public)\r
+    elts\r
+    (List.fold_right resolve_other_elements other_elts [])\r
+\r
+let resolved_expression syntax nat elt_nat =\r
+  {\r
+    nature = nat;\r
+    info = { syntax = syntax; type_description = elt_nat }\r
+  }\r
+\r
+let one =\r
+  let nat = Integer 1l\r
+  and elt_nat = Types.integer_type Types.Constant in\r
+  resolved_expression None nat elt_nat\r
+\r
+\r
+(* Name resolution functions *)\r
+\r
+let rec resolve_toplevel dic nodes =\r
+  let add_element ctx acc (id, elt_desc) =\r
+    match List.mem_assoc id acc with\r
+    | true ->\r
+        let ctx = { ctx with location = elt_desc.element_location } in\r
+        raise (CompilError\r
+          {err_msg = ["_DuplicateDeclarationOfElement"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | false -> acc @ [ (id, elt_desc) ] in\r
+  let rec ctx =\r
+    {\r
+      toplevel =\r
+        lazy (List.fold_left (add_element ctx) dic (evaluate elt_descs));\r
+      context_nature = ToplevelContext;\r
+      location =\r
+        {\r
+          Parser.start = 0;\r
+                  Parser.enddd = 0;\r
+          Parser.filename = Parser.CommandLine\r
+        }\r
+    }\r
+  and elt_descs = lazy (resolve_toplevel_nodes ctx nodes) in\r
+  evaluate ctx.toplevel\r
+\r
+and resolve_toplevel_nodes ctx nodes =\r
+  let rec resolve_toplevel_nodes' nodes' =\r
+    match nodes' with\r
+      | [] -> []\r
+      | node :: nodes' ->\r
+          (resolve_toplevel_statements ctx node) @\r
+          (resolve_toplevel_nodes' nodes') in\r
+  let collect_toplevel_defs (cl_defs, nodes) node =\r
+    match node.Syntax.nature with\r
+      | Syntax.ClassDefinitions cl_defs' -> cl_defs' @ cl_defs, nodes\r
+      | _ -> cl_defs, [node] @ nodes in\r
+  let cl_defs, nodes = List.fold_left collect_toplevel_defs ([], []) nodes in\r
+  let node = {Syntax.nature = Syntax.ClassDefinitions cl_defs;\r
+              Syntax.info = ctx.location} in\r
+  (resolve_toplevel_statements ctx node) @\r
+  resolve_toplevel_nodes' nodes\r
+\r
+and resolve_toplevel_statements ctx node = match node.Syntax.nature with\r
+  | Syntax.ClassDefinitions cl_defs -> resolve_class_definitions ctx cl_defs\r
+  | Syntax.Expression expr -> raise (CompilError\r
+      {err_msg = ["_NotYetImplemented"; "_TopLevelExpr"];\r
+       err_info = [];\r
+       err_ctx = {ctx with location = expr.Syntax.info}})\r
+  | Syntax.VariablesDefinitions (expr, subs, cpnt_decls) ->\r
+      resole_variables_definitions ctx expr subs cpnt_decls\r
+  | Syntax.Command algo -> raise (CompilError\r
+      {err_msg = ["_NotYetImplemented"; "_TopLevelAlgorithm"];\r
+       err_info = [];\r
+       err_ctx = {ctx with location = algo.Syntax.info}})\r
+  | Syntax.Within path -> raise (CompilError\r
+      {err_msg = ["_NotYetImplemented"; "_WithinClause"];\r
+       err_info = [("_Expr", Syntax.string_of_toplevel_element node)];\r
+       err_ctx = {ctx with location = node.Syntax.info}})\r
+  | Syntax.Import imprt -> raise (CompilError\r
+      {err_msg = ["_NotYetImplemented"; "_ImportClause"];\r
+       err_info = [("_Expr", Syntax.string_of_toplevel_element node)];\r
+       err_ctx = {ctx with location = imprt.Syntax.info}})\r
+\r
+and resole_variables_definitions ctx expr subs cpnt_decls =\r
+  let type_spec = lazy (resolve_expression ctx expr)\r
+  and dims = lazy (resolve_dimensions ctx subs) in\r
+  List.map (resolve_variable_definition ctx type_spec dims expr) cpnt_decls\r
+\r
+and resolve_variable_definition ctx type_spec dims expr cpnt_decl =\r
+  let type_pref = false, None, Types.Acausal in\r
+  let id, elt_nat, elt_loc =\r
+    resolve_component_declaration ctx type_pref type_spec dims expr cpnt_decl in\r
+  let rec elt_desc =\r
+    {\r
+      element_type =\r
+        lazy (element_type ctx false None None None elt_desc);\r
+      redeclare = false;\r
+      element_nature = elt_nat;\r
+      element_location = elt_loc\r
+    } in\r
+  id, elt_desc\r
+\r
+and resolve_class_definitions ctx cl_defs =\r
+  List.map (resolve_class_definition ctx) cl_defs\r
+\r
+and resolve_class_definition ctx cl_def = match cl_def.Syntax.nature with\r
+  | Syntax.ClassDefinition (final, def) ->\r
+      let loc = (match def.Syntax.nature with\r
+        | Syntax.Definition (_, _, _, cl_spec) -> cl_spec.Syntax.info) in\r
+      let rec elt_desc =\r
+        {\r
+          element_type = lazy (element_type ctx false final None None elt_desc);\r
+          redeclare = false;\r
+          element_nature = resolve_definition ctx def;\r
+          element_location = loc\r
+        } in\r
+      let s = class_definition_name def in\r
+      s, elt_desc\r
+\r
+and class_definition_name def = match def.Syntax.nature with\r
+  | Syntax.Definition (_, _, _, cl_spec) -> class_specifier_name cl_spec\r
+\r
+and class_specifier_name cl_spec = match cl_spec.Syntax.nature with\r
+  | Syntax.LongSpecifier (id, _, _) |\r
+    Syntax.ShortSpecifier (id, _, _, _, _, _) |\r
+    Syntax.EnumerationSpecifier (id, _, _) |\r
+    Syntax.ExtensionSpecifier (id, _, _, _) -> id\r
+\r
+and resolve_definition ctx def =\r
+  let ctx = {ctx with location = def.Syntax.info} in \r
+  match def.Syntax.nature with\r
+    | Syntax.Definition (encap, part, kind, cl_spec) ->\r
+        resolve_specification ctx encap part kind cl_spec\r
+\r
+and resolve_specification ctx encap part kind cl_spec =\r
+  let encap' = bool_of_encapsulated encap in\r
+  match kind with\r
+    | Syntax.Class ->\r
+        resolve_class_specification ctx encap' part Types.Class cl_spec\r
+    | Syntax.Model ->\r
+        resolve_class_specification ctx encap' part Types.Model cl_spec\r
+    | Syntax.Block ->\r
+        resolve_class_specification ctx encap' part Types.Block cl_spec\r
+    | Syntax.Record ->\r
+        resolve_class_specification ctx encap' part Types.Record cl_spec\r
+    | Syntax.ExpandableConnector ->\r
+       resolve_class_specification\r
+          ctx\r
+          encap'\r
+          part\r
+          Types.ExpandableConnector\r
+          cl_spec\r
+    | Syntax.Connector ->\r
+        resolve_class_specification ctx encap' part Types.Connector cl_spec\r
+    | Syntax.Type when encap' ->\r
+        raise (CompilError\r
+          {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_TypeDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Syntax.Type -> resolve_type_specification ctx cl_spec\r
+    | Syntax.Package ->\r
+        resolve_class_specification ctx encap' part Types.Package cl_spec\r
+    | Syntax.Function ->\r
+        resolve_class_specification ctx encap' part Types.Function cl_spec\r
+\r
+and resolve_type_specification ctx cl_spec =\r
+  let ctx = {ctx with location = cl_spec.Syntax.info} in\r
+  match cl_spec.Syntax.nature with\r
+    | Syntax.LongSpecifier _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidTypeDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Syntax.ExtensionSpecifier _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidTypeDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Syntax.ShortSpecifier (_, base_pref, cl_spec, subs, cl_modif, _) ->\r
+        let cpnt_type =\r
+          resolve_type_composition ctx base_pref cl_spec subs cl_modif in\r
+        ComponentType cpnt_type\r
+    | Syntax.EnumerationSpecifier (idt, enum_comp, _) ->\r
+        let enum_type = resolve_enumeration_composition ctx enum_comp in\r
+        PredefinedType enum_type\r
+\r
+and resolve_type_composition ctx base_pref cl_spec subs cl_modif =\r
+  let base_pref' = type_prefix base_pref\r
+  and base_type = lazy (resolve_expression ctx cl_spec)\r
+  and dims = lazy (resolve_dimensions ctx subs) in\r
+  let cpnt_type = lazy (component_type ctx base_pref' base_type dims) in\r
+  let cl_modif' = lazy (resolve_type_modification ctx cpnt_type cl_modif) in\r
+  {\r
+    described_type = lazy (modified_described_type ctx cpnt_type cl_modif');\r
+    base_type = base_type;\r
+    type_dimensions = dims;\r
+    type_modification = cl_modif'\r
+  }\r
+\r
+and resolve_enumeration_composition ctx enum_comp =\r
+  let resolve_enumeration_literal enum_lit ids =\r
+    match enum_lit.Syntax.nature with\r
+      | Syntax.EnumerationLiteral (id, _) when List.mem id ids ->\r
+          raise (CompilError\r
+            {err_msg = ["_EnumTypeDefWithDuplicLit"; id];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = enum_lit.Syntax.info}}) (*error*)\r
+      | Syntax.EnumerationLiteral (id, _) -> id :: ids in\r
+  match enum_comp.Syntax.nature with\r
+    | Syntax.EnumList (Some enum_lits) ->\r
+        let elts = List.fold_right resolve_enumeration_literal enum_lits [] in\r
+        {\r
+          Types.base_type = Types.EnumerationType elts;\r
+                attributes = ["start", false]\r
+        }\r
+    | Syntax.EnumList None ->\r
+        raise (CompilError\r
+          {err_msg = ["_UnspecifiedEnumLits"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = enum_comp.Syntax.info}}) (*error*)\r
+    | Syntax.EnumColon ->\r
+        raise (CompilError\r
+          {err_msg = ["_UnspecifiedEnumLits"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = enum_comp.Syntax.info}}) (*error*)\r
+\r
+and resolve_class_specification ctx encap part kind cl_spec =\r
+  let ctx = {ctx with location = cl_spec.Syntax.info} in\r
+  let resolve_specifier encap' cl_def =\r
+    let ctx' = {ctx with context_nature = ClassContext cl_def} in\r
+    resolve_class_specifier ctx ctx' encap cl_spec in\r
+  let rec cl_def =\r
+    {\r
+      class_type = lazy (class_specifier_type ctx part kind cl_def cl_spec);\r
+      enclosing_class = enclosing_class ctx;\r
+      encapsulated = encap;\r
+      description = lazy (resolve_specifier encap cl_def)\r
+    } in\r
+  Class cl_def\r
+\r
+and enclosing_class ctx = match ctx.context_nature with\r
+  | ToplevelContext -> None\r
+  | ClassContext cl_def -> Some cl_def\r
+  | SubscriptContext (ctx, _, _, _) |\r
+    ForContext (ctx, _, _) -> enclosing_class ctx\r
+\r
+and bool_of_encapsulated = function\r
+  | None -> false\r
+  | Some Syntax.Encapsulated -> true\r
+\r
+and resolve_class_specifier ctx ctx' encap cl_spec =\r
+  let ctx = {ctx with location = cl_spec.Syntax.info}\r
+  and ctx' = {ctx' with location = cl_spec.Syntax.info} in\r
+  match cl_spec.Syntax.nature with\r
+    | Syntax.LongSpecifier (_, _, comp) ->\r
+        LongDescription (resolve_composition ctx ctx' comp)\r
+    | Syntax.ShortSpecifier _ when encap ->\r
+        raise (CompilError\r
+          {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_ShortClassDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Syntax.ShortSpecifier (_, base_pref, cl_spec, subs, cl_modif, _) ->\r
+        let short_desc =\r
+          resolve_short_specifier ctx base_pref cl_spec subs cl_modif in\r
+        ShortDescription short_desc\r
+    | Syntax.ExtensionSpecifier _ when encap ->\r
+        raise (CompilError\r
+          {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_ClassDefByExtension"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Syntax.ExtensionSpecifier (id , cl_modif, _, comp) ->\r
+        let long_desc =\r
+          resolve_extension_composition ctx ctx' id cl_modif comp in\r
+        LongDescription long_desc\r
+    | Syntax.EnumerationSpecifier _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidUseOfEnumKeyword"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_short_specifier ctx base_pref cl_spec subs cl_modif =\r
+  let ctx = {ctx with location = cl_spec.Syntax.info} in\r
+  match base_pref.Syntax.nature, subs with\r
+    | Syntax.TypePrefix (None, None, None), None ->\r
+        resolve_modified_class ctx ctx cl_spec cl_modif\r
+    | (Syntax.TypePrefix (Some _, _, _) | Syntax.TypePrefix (_, Some _, _) |\r
+       Syntax.TypePrefix (_, _, Some _)), _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_UseOfTypePrefixInShortClassDef"];\r
+           err_info =\r
+             [("_TypePrefix", Syntax.string_of_base_prefix base_pref)];\r
+           err_ctx = {ctx with location = base_pref.Syntax.info}}) (*error*)\r
+    | Syntax.TypePrefix (None, None, None), Some subs ->\r
+        raise (CompilError\r
+          {err_msg = ["_UseOfSubsInShortClassDef"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = subs.Syntax.info}}) (*error*)\r
+\r
+and resolve_extension_composition ctx ctx' id cl_modif comp =\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented"; "_ClassExtendsDef"];\r
+     err_info = [];\r
+     err_ctx = ctx})\r
+\r
+and resolve_composition ctx ctx' comp = match comp.Syntax.nature with\r
+  | Syntax.Composition (elts, other_elts, extern) ->\r
+      {\r
+        class_annotations = lazy (resolve_class_annotations ctx' elts other_elts);\r
+        imports = resolve_imports ctx' elts other_elts;\r
+        extensions = resolve_extensions ctx ctx' elts other_elts;\r
+        named_elements = resolve_named_elements ctx' elts other_elts;\r
+        unnamed_elements = lazy (resolve_unnamed_elements ctx' other_elts);\r
+        external_call = lazy (resolve_external_call ctx' extern)\r
+      }\r
+\r
+and resolve_external_call ctx extern =\r
+  let resolve_external_call' extern' = match extern'.Syntax.nature with\r
+    | Syntax.External (Some id, None, _, _) ->\r
+        { nature = PrimitiveCall id; info = extern' }\r
+    | Syntax.External (Some lang, Some extern_call, _, _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_ExternalProcedureCall"];\r
+           err_info = [];\r
+           err_ctx =\r
+              {ctx with location = extern'.Syntax.info}}) (*error*)\r
+    | Syntax.External (None, _, _, _) ->\r
+        { nature = PrimitiveCall "C"; info = extern' } in\r
+        (*raise (CompilError\r
+          {err_msg = ["_UnspecifiedExtCallLang"];\r
+           err_info = [];\r
+           err_ctx =\r
+              {ctx with location = extern'.Syntax.info}}) (*error*) in*)\r
+  match extern with\r
+    | None -> None\r
+    | Some extern' -> Some (resolve_external_call' extern')\r
+\r
+and resolve_class_annotations ctx elts other_elts =\r
+  let add_class_annotation vis elt anns = match vis, elt.Syntax.nature with\r
+    | _, Syntax.ClassAnnotation ann ->\r
+        begin match resolve_class_annotation ctx ann with\r
+          | [] -> anns\r
+          | anns' -> anns' @ anns\r
+        end\r
+    | _, (Syntax.ImportClause _ | Syntax.ExtendsClause _ |\r
+      Syntax.ElementDefinition _) -> anns in\r
+  resolve_elements add_class_annotation elts other_elts\r
+\r
+and resolve_imports ctx elts other_elts =\r
+  let add_import vis elt imps = match vis, elt.Syntax.nature with\r
+    | _, Syntax.ImportClause (imp_clause, _) ->\r
+        resolve_import_clause ctx imp_clause :: imps\r
+    | _, (Syntax.ClassAnnotation _ | Syntax.ExtendsClause _ |\r
+      Syntax.ElementDefinition _) -> imps in\r
+  resolve_elements add_import elts other_elts\r
+\r
+and resolve_extensions ctx ctx' elts other_elts =\r
+  let add_extension vis elt exts = match vis, elt.Syntax.nature with\r
+    | Public, Syntax.ExtendsClause (ext_clause, _) ->\r
+        (Public, resolve_extends_clause ctx ctx' ext_clause) :: exts\r
+    | Protected, Syntax.ExtendsClause (ext_clause, _) ->\r
+        (Protected, resolve_extends_clause ctx ctx' ext_clause) :: exts\r
+    | _, (Syntax.ClassAnnotation _ | Syntax.ImportClause _ |\r
+      Syntax.ElementDefinition _) -> exts in\r
+  resolve_elements add_extension elts other_elts\r
+\r
+and resolve_named_elements ctx elts other_elts =\r
+  let add_named_element (id, elt_desc) elts =\r
+    match List.mem_assoc id elts with\r
+    | true ->\r
+        raise (CompilError\r
+          {err_msg = ["_DuplicateDeclarationOfElement"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | false -> (id, elt_desc) :: elts in\r
+  let add_named_elements vis elt elts = match vis, elt.Syntax.nature with\r
+    | Public,\r
+      Syntax.ElementDefinition (redecl, final, dyn_scope, elt_def, _) ->\r
+        let elts' =\r
+          resolve_element_definition ctx false redecl final dyn_scope elt_def in\r
+        List.fold_right add_named_element elts' elts\r
+    | Protected,\r
+      Syntax.ElementDefinition (redecl, final, dyn_scope, elt_def, _) ->\r
+        let elts' =\r
+          resolve_element_definition ctx true redecl final dyn_scope elt_def in\r
+        List.fold_right add_named_element elts' elts\r
+    | _, (Syntax.ClassAnnotation _ | Syntax.ImportClause _ |\r
+      Syntax.ExtendsClause _) -> elts in\r
+  resolve_elements add_named_elements elts other_elts\r
+\r
+and resolve_class_annotation ctx ann =\r
+  let rec resolve_class_annotation' cl_modif =\r
+    let add_annotation_information arg acc = match arg.Syntax.nature with\r
+      | Syntax.ElementModification (\r
+          None,\r
+          None,\r
+          { Syntax.nature = Syntax.Identifier "Imagine" },\r
+          Some\r
+            {\r
+              Syntax.nature =\r
+                Syntax.Modification (\r
+                  {\r
+                    Syntax.nature =\r
+                      Syntax.ClassModification\r
+                        [\r
+                          {\r
+                            Syntax.nature =\r
+                              Syntax.ElementModification (\r
+                                None,\r
+                                None,\r
+                                {\r
+                                  Syntax.nature = Syntax.Identifier "AMESim"\r
+                                },\r
+                                Some\r
+                                  {\r
+                                    Syntax.nature =\r
+                                      Syntax.Modification (cl_modif, None)\r
+                                  },\r
+                                [])\r
+                          }\r
+                        ]\r
+                  },\r
+                  None)\r
+            },\r
+          []) -> add_amesim_annotations ctx cl_modif acc\r
+      | Syntax.ElementModification _ | Syntax.ElementRedeclaration _ ->\r
+          (UnknownAnnotation (lazy cl_modif)) :: acc in\r
+    match cl_modif.Syntax.nature with\r
+    | Syntax.ClassModification args ->\r
+        List.fold_right add_annotation_information args [] in\r
+  match ann.Syntax.nature with\r
+  | Syntax.Annotation cl_modif -> resolve_class_annotation' cl_modif\r
+\r
+and add_amesim_annotations ctx cl_modif acc =\r
+  let add_inverse_declarations cl_modif =\r
+    let add_inverse_declaration arg acc =\r
+      let add_inverse_declaration' expr modif =\r
+        match expr.Syntax.nature, modif.Syntax.nature with\r
+        | Syntax.IndexedAccess (\r
+            { Syntax.nature = Syntax.Identifier "inverse" }, _),\r
+          Syntax.Eq\r
+            {\r
+              Syntax.nature =\r
+                Syntax.FunctionCall (expr, Some fun_args)\r
+            } -> (resolve_inverse_declaration ctx expr fun_args) :: acc\r
+        | _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidModifExpr"];\r
+               err_info = [];\r
+               err_ctx =\r
+                 {ctx with location = expr.Syntax.info}}) (*error*) in\r
+      match arg.Syntax.nature with\r
+      | Syntax.ElementModification (Some _, _, _, _, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfEachKeywordNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, Some _, _, _, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfFinalKeywordNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, None, _, None, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UnspecifiedModification"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, None, expr, Some modif, _) ->\r
+          add_inverse_declaration' expr modif\r
+      | Syntax.ElementRedeclaration _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_RedeclarationNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in\r
+    match cl_modif.Syntax.nature with\r
+    | Syntax.ClassModification args ->\r
+        List.fold_right add_inverse_declaration args acc in\r
+  match cl_modif.Syntax.nature with\r
+  | Syntax.ClassModification\r
+      [\r
+        {\r
+          Syntax.nature =\r
+            Syntax.ElementModification (\r
+              None,\r
+              None,\r
+              {\r
+                Syntax.nature = Syntax.Identifier "InverseFunctions"\r
+              },\r
+              Some\r
+                {\r
+                  Syntax.nature =\r
+                    Syntax.Modification (cl_modif, None)\r
+                },\r
+                [])\r
+        }\r
+      ] -> add_inverse_declarations cl_modif\r
+  | Syntax.ClassModification _ -> acc\r
+\r
+and resolve_inverse_declaration ctx expr fun_args =\r
+  let inverse_function_arguments expr' fun_args =\r
+    let map_function_arguments named_args =\r
+      let map_function_argument arg =\r
+        match arg.Syntax.nature with\r
+        | Syntax.NamedArgument (id, expr)\r
+          when List.mem_assoc id named_args ->\r
+            let expr' = resolve_expression ctx expr in\r
+            begin match expr'.nature with\r
+              | LocalIdentifier (0, id') -> id, id'\r
+              | _ ->\r
+                  raise (CompilError\r
+                    {err_msg = ["_InvalidAnnOfInvFunc";\r
+                                "_InvalidFuncArgModif"];\r
+                     err_info = [];\r
+                     err_ctx =\r
+                        {ctx with\r
+                          location = expr.Syntax.info}}) (*error*)\r
+            end\r
+        | Syntax.NamedArgument (id, expr) ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidAnnOfInvFunc";\r
+                          "_UnknownArgName"; id];\r
+               err_info = [];\r
+               err_ctx =\r
+                 {ctx with location = arg.Syntax.info}}) (*error*)\r
+        | Syntax.Argument _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidAnnOfInvFunc";\r
+                          "_CannotUseUnnamedFuncArg"];\r
+               err_info = [];\r
+               err_ctx =\r
+                 {ctx with location = arg.Syntax.info}}) (*error*) in\r
+      match fun_args.Syntax.nature with\r
+      | Syntax.ArgumentList args -> List.map map_function_argument args\r
+      | Syntax.Reduction _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc";\r
+                        "_FuncArgReductionNotAllowed"];\r
+             err_info = [];\r
+             err_ctx =\r
+               {ctx with location = fun_args.Syntax.info}}) (*error*) in\r
+    let inverse_function_arguments' cl_type =\r
+      match cl_type.Types.partial, evaluate cl_type.Types.kind with\r
+      | true, _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc";\r
+                        "_UseOfPartialClassElement"];\r
+             err_info = [("_ElementFound",\r
+                          Syntax.string_of_expression expr)];\r
+             err_ctx =\r
+               {ctx with location = expr.Syntax.info}}) (*error*)\r
+      | false, Types.Function ->\r
+          map_function_arguments cl_type.Types.named_elements\r
+      | _, kind ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc";\r
+                        "_InvalidTypeOfFuncCallExpr"];\r
+             err_info = [("_ExpectedType", "_Function");\r
+                         ("_TypeFound", Types.string_of_kind kind)];\r
+             err_ctx =\r
+               {ctx with location = expr.Syntax.info}}) (*error*) in\r
+    let elt_nat = expr'.info.type_description in\r
+    match elt_nat with\r
+    | Types.ClassElement cl_spec ->\r
+        let cl_spec = evaluate cl_spec in\r
+        begin match cl_spec with\r
+          | Types.ClassType cl_type ->\r
+              inverse_function_arguments' cl_type\r
+          | _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_InvalidAnnOfInvFunc";\r
+                            "_InvalidTypeOfFuncCallExpr"];\r
+                 err_info =\r
+                   [("_ExpectedType", "_ClassType");\r
+                    ("_TypeFound",\r
+                     Types.string_of_class_specifier cl_spec)];\r
+                 err_ctx =\r
+                   {ctx with location = expr.Syntax.info}}) (*error*)\r
+        end\r
+    | Types.ComponentTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidAnnOfInvFunc";\r
+                      "_InvalidTypeOfFuncCallExpr"];\r
+           err_info = [("_ExpectedType", "_ClassElement");\r
+                       ("_TypeFound", "_ComponentTypeElement")];\r
+           err_ctx =\r
+             {ctx with location = expr.Syntax.info}}) (*error*)\r
+    | Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidAnnOfInvFunc";\r
+                      "_InvalidTypeOfFuncCallExpr"];\r
+           err_info = [("_ExpectedType", "_ClassElement");\r
+                       ("_TypeFound", "_PredefinedTypeElement")];\r
+           err_ctx =\r
+             {ctx with location = expr.Syntax.info}}) (*error*)\r
+    | Types.ComponentElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidAnnOfInvFunc";\r
+                      "_InvalidTypeOfFuncCallExpr"];\r
+           err_info = [("_ExpectedType", "_ClassElement");\r
+                       ("_TypeFound", "_ComponentElement")];\r
+           err_ctx =\r
+             {ctx with location = expr.Syntax.info}}) (*error*) in\r
+  let expr' = resolve_expression ctx expr in\r
+  match expr'.nature with\r
+  | ToplevelIdentifier _ | LocalIdentifier _ ->\r
+      InverseFunction\r
+        (lazy\r
+          {\r
+            function_class = expr';\r
+            arguments = inverse_function_arguments expr' fun_args\r
+          })\r
+  | _ ->\r
+      raise (CompilError\r
+        {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidFuncCallExpr"];\r
+         err_info = [];\r
+         err_ctx =\r
+           {ctx with location = expr.Syntax.info}}) (*error*)\r
+\r
+(*and resolve_inverse_function_annotation ctx ann =\r
+  let rec resolve_class_annotation' cl_modif =\r
+    let resolve_inverse_declaration expr fun_args =\r
+      let inverse_function_arguments expr' fun_args =\r
+        let map_function_arguments named_args =\r
+          let map_function_argument arg =\r
+            match arg.Syntax.nature with\r
+              | Syntax.NamedArgument (id, expr)\r
+                when List.mem_assoc id named_args ->\r
+                  let expr' = resolve_expression ctx expr in\r
+                  begin match expr'.nature with\r
+                    | LocalIdentifier (0, id') -> id, id'\r
+                    | _ ->\r
+                        raise (CompilError\r
+                          {err_msg = ["_InvalidAnnOfInvFunc";\r
+                                      "_InvalidFuncArgModif"];\r
+                           err_info = [];\r
+                           err_ctx =\r
+                              {ctx with\r
+                                location = expr.Syntax.info}}) (*error*)\r
+                  end\r
+              | Syntax.NamedArgument (id, expr) ->\r
+                  raise (CompilError\r
+                    {err_msg = ["_InvalidAnnOfInvFunc";\r
+                                "_UnknownArgName"; id];\r
+                     err_info = [];\r
+                     err_ctx =\r
+                       {ctx with location = arg.Syntax.info}}) (*error*)\r
+              | Syntax.Argument _ ->\r
+                  raise (CompilError\r
+                    {err_msg = ["_InvalidAnnOfInvFunc";\r
+                                "_CannotUseUnnamedFuncArg"];\r
+                     err_info = [];\r
+                     err_ctx =\r
+                        {ctx with location = arg.Syntax.info}}) (*error*) in\r
+          match fun_args.Syntax.nature with\r
+            | Syntax.ArgumentList args -> List.map map_function_argument args\r
+            | Syntax.Reduction _ ->\r
+                raise (CompilError\r
+                  {err_msg = ["_InvalidAnnOfInvFunc";\r
+                              "_FuncArgReductionNotAllowed"];\r
+                   err_info = [];\r
+                   err_ctx =\r
+                      {ctx with location = fun_args.Syntax.info}}) (*error*) in\r
+        let inverse_function_arguments' cl_type =\r
+          match cl_type.Types.partial, evaluate cl_type.Types.kind with\r
+            | true, _ ->\r
+                raise (CompilError\r
+                  {err_msg = ["_InvalidAnnOfInvFunc";\r
+                              "_UseOfPartialClassElement"];\r
+                   err_info = [("_ElementFound",\r
+                                Syntax.string_of_expression expr)];\r
+                   err_ctx =\r
+                      {ctx with location = expr.Syntax.info}}) (*error*)\r
+            | false, Types.Function ->\r
+                map_function_arguments cl_type.Types.named_elements\r
+            | _, kind ->\r
+                raise (CompilError\r
+                  {err_msg = ["_InvalidAnnOfInvFunc";\r
+                              "_InvalidTypeOfFuncCallExpr"];\r
+                   err_info = [("_ExpectedType", "_Function");\r
+                               ("_TypeFound", Types.string_of_kind kind)];\r
+                   err_ctx =\r
+                     {ctx with location = expr.Syntax.info}}) (*error*) in\r
+        let elt_nat = expr'.info.type_description in\r
+        match elt_nat with\r
+          | Types.ClassElement cl_spec ->\r
+              let cl_spec = evaluate cl_spec in\r
+              begin match cl_spec with\r
+                | Types.ClassType cl_type ->\r
+                    inverse_function_arguments' cl_type\r
+                | _ ->\r
+                    raise (CompilError\r
+                      {err_msg = ["_InvalidAnnOfInvFunc";\r
+                                  "_InvalidTypeOfFuncCallExpr"];\r
+                       err_info =\r
+                         [("_ExpectedType", "_ClassType");\r
+                          ("_TypeFound",\r
+                           Types.string_of_class_specifier cl_spec)];\r
+                       err_ctx =\r
+                         {ctx with location = expr.Syntax.info}}) (*error*)\r
+              end\r
+          | Types.ComponentTypeElement _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_InvalidAnnOfInvFunc";\r
+                            "_InvalidTypeOfFuncCallExpr"];\r
+                 err_info = [("_ExpectedType", "_ClassElement");\r
+                             ("_TypeFound", "_ComponentTypeElement")];\r
+                 err_ctx =\r
+                   {ctx with location = expr.Syntax.info}}) (*error*)\r
+          | Types.PredefinedTypeElement _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_InvalidAnnOfInvFunc";\r
+                            "_InvalidTypeOfFuncCallExpr"];\r
+                 err_info = [("_ExpectedType", "_ClassElement");\r
+                             ("_TypeFound", "_PredefinedTypeElement")];\r
+                 err_ctx =\r
+                   {ctx with location = expr.Syntax.info}}) (*error*)\r
+          | Types.ComponentElement _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_InvalidAnnOfInvFunc";\r
+                            "_InvalidTypeOfFuncCallExpr"];\r
+                 err_info = [("_ExpectedType", "_ClassElement");\r
+                             ("_TypeFound", "_ComponentElement")];\r
+                 err_ctx =\r
+                   {ctx with location = expr.Syntax.info}}) (*error*) in\r
+      let expr' = resolve_expression ctx expr in\r
+      match expr'.nature with\r
+        | ToplevelIdentifier _ | LocalIdentifier _ ->\r
+            {\r
+              function_class = expr';\r
+              arguments =\r
+                inverse_function_arguments expr' fun_args\r
+            }\r
+        | _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidFuncCallExpr"];\r
+               err_info = [];\r
+               err_ctx =\r
+                 {ctx with location = expr.Syntax.info}}) (*error*) in\r
+    let add_inverse_declaration arg acc =\r
+      let add_inverse_declaration' expr modif =\r
+        match expr.Syntax.nature, modif.Syntax.nature with\r
+        | Syntax.IndexedAccess (\r
+            { Syntax.nature = Syntax.Identifier "inverse" }, _),\r
+          Syntax.Eq\r
+            {\r
+              Syntax.nature =\r
+                Syntax.FunctionCall (expr, Some fun_args)\r
+            } -> lazy (resolve_inverse_declaration expr fun_args) :: acc\r
+        | _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidModifExpr"];\r
+               err_info = [];\r
+               err_ctx =\r
+                 {ctx with location = expr.Syntax.info}}) (*error*) in\r
+      match arg.Syntax.nature with\r
+      | Syntax.ElementModification (Some _, _, _, _, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfEachKeywordNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, Some _, _, _, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfFinalKeywordNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, None, _, None, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_UnspecifiedModification"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+      | Syntax.ElementModification (None, None, expr, Some modif, _) ->\r
+          add_inverse_declaration' expr modif\r
+      | Syntax.ElementRedeclaration _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidAnnOfInvFunc"; "_RedeclarationNotAllowed"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in\r
+    let add_inverse_declarations cl_modif acc =\r
+      let add_inverse_declarations' cl_modif = \r
+        match cl_modif.Syntax.nature with\r
+        | Syntax.ClassModification args ->\r
+            List.fold_right add_inverse_declaration args acc in\r
+      match cl_modif.Syntax.nature with\r
+      | Syntax.ClassModification\r
+          [\r
+            {\r
+              Syntax.nature =\r
+                Syntax.ElementModification (\r
+                  None,\r
+                  None,\r
+                  {\r
+                    Syntax.nature = Syntax.Identifier "InverseFunctions"\r
+                  },\r
+                  Some\r
+                    {\r
+                      Syntax.nature =\r
+                        Syntax.Modification (cl_modif, None)\r
+                    },\r
+                    [])\r
+            }\r
+          ] -> add_inverse_declarations' cl_modif\r
+      | Syntax.ClassModification _ -> acc in\r
+    let add_annotation_information arg acc = match arg.Syntax.nature with\r
+      | Syntax.ElementModification (\r
+          None,\r
+          None,\r
+          { Syntax.nature = Syntax.Identifier "Imagine" },\r
+          Some\r
+            {\r
+              Syntax.nature =\r
+                Syntax.Modification (\r
+                  {\r
+                    Syntax.nature =\r
+                      Syntax.ClassModification\r
+                        [\r
+                          {\r
+                            Syntax.nature =\r
+                              Syntax.ElementModification (\r
+                                None,\r
+                                None,\r
+                                {\r
+                                  Syntax.nature = Syntax.Identifier "AMESim"\r
+                                },\r
+                                Some\r
+                                  {\r
+                                    Syntax.nature =\r
+                                      Syntax.Modification (cl_modif, None)\r
+                                  },\r
+                                [])\r
+                          }\r
+                        ]\r
+                  },\r
+                  None)\r
+            },\r
+          []) -> add_inverse_declarations cl_modif acc\r
+      | Syntax.ElementModification _ | Syntax.ElementRedeclaration _ -> acc in\r
+    match cl_modif.Syntax.nature with\r
+    | Syntax.ClassModification args ->\r
+        List.fold_right add_annotation_information args [] in\r
+  match ann.Syntax.nature with\r
+  | Syntax.Annotation cl_modif -> resolve_class_annotation' cl_modif*)\r
+\r
+and resolve_import_clause ctx imp_clause =\r
+  let ctx = {ctx with location = imp_clause.Syntax.info} in\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented"; "_ImportClause"];\r
+     err_info = [("_Expr", Syntax.string_of_import imp_clause)];\r
+     err_ctx = ctx})\r
+\r
+and resolve_extends_clause ctx ctx' ext_clause =\r
+  match ext_clause.Syntax.nature with\r
+    | Syntax.Extends (cl_spec, cl_modif, _) ->\r
+        resolve_extension ctx ctx' cl_spec cl_modif\r
+\r
+and resolve_extension ctx ctx' cl_spec cl_modif =\r
+  let ctx' = {ctx' with location = cl_spec.Syntax.info} in\r
+  let base_class = lazy (resolve_extension_expression ctx cl_spec) in\r
+  let cl_spec' = lazy (base_class_type ctx' cl_spec base_class) in\r
+  let cl_modif' =\r
+    lazy (resolve_class_modification_option ctx' cl_spec' cl_modif) in\r
+  {\r
+    modified_class_type = lazy (modified_class_type ctx' cl_spec' cl_modif');\r
+    base_class = base_class;\r
+    class_modification = cl_modif'\r
+  }\r
+\r
+and resolve_extension_expression ctx cl_spec =\r
+  let rec modify_resolved_expression expr = match expr.nature with\r
+    | LocalIdentifier (level, id) ->\r
+        { expr with nature = LocalIdentifier (level + 1, id) }\r
+    | FieldAccess (expr', id) ->\r
+        { expr with\r
+          nature = FieldAccess (modify_resolved_expression expr', id)\r
+        }\r
+    | IndexedAccess (expr', exprs') ->\r
+        let exprs' = List.map modify_resolved_expression exprs' in\r
+        { expr with\r
+          nature = IndexedAccess (modify_resolved_expression expr', exprs')\r
+        }\r
+    | ToplevelIdentifier _ -> expr\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidExtensionDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+  match ctx.context_nature with\r
+    | ToplevelContext | ClassContext _ ->\r
+        let base_class = resolve_expression ctx cl_spec in\r
+        modify_resolved_expression base_class\r
+    | SubscriptContext _ | ForContext _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidExtensionDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_modified_class ctx ctx' cl_spec cl_modif =\r
+  let ctx' = {ctx' with location = cl_spec.Syntax.info} in\r
+  let base_class = lazy (resolve_expression ctx cl_spec) in\r
+  let cl_spec' = lazy (base_class_type ctx' cl_spec base_class) in\r
+  let cl_modif' =\r
+    lazy (resolve_class_modification_option ctx' cl_spec' cl_modif) in\r
+  {\r
+    modified_class_type = lazy (modified_class_type ctx' cl_spec' cl_modif');\r
+    base_class = base_class;\r
+    class_modification = cl_modif'\r
+  }\r
+\r
+and resolve_element_definition ctx protect redecl final dyn_scope elt_def =\r
+  let repl = replaceable_attribute elt_def in\r
+  let element_description (id, elt_nat, elt_loc) =\r
+    let rec elt_desc =\r
+      {\r
+        element_type =\r
+          lazy (element_type ctx protect final repl dyn_scope elt_desc);\r
+        redeclare = bool_of_redeclare redecl;\r
+        element_nature = elt_nat;\r
+        element_location = elt_loc\r
+      } in\r
+    id, elt_desc in\r
+  List.map element_description (declared_elements ctx elt_def)\r
+\r
+and replaceable_attribute elt_def = match elt_def.Syntax.nature with\r
+  | Syntax.ClassDefinitionElement (repl, _, _) |\r
+    Syntax.ComponentClauseElement (repl, _, _) -> repl\r
+\r
+and bool_of_redeclare = function\r
+  | None -> false\r
+  | Some Syntax.Redeclare -> true\r
+\r
+and resolve_type_constraint ctx elt_def = match elt_def.Syntax.nature with\r
+  | Syntax.ClassDefinitionElement (_, _, []) |\r
+    Syntax.ComponentClauseElement (_, _, []) -> None\r
+  | Syntax.ClassDefinitionElement (_, _, _ :: _) |\r
+    Syntax.ComponentClauseElement (_, _, _ :: _) -> assert false\r
+\r
+and declared_elements ctx elt_def = match elt_def.Syntax.nature with\r
+  | Syntax.ClassDefinitionElement (_, def, _) ->\r
+      let s = class_definition_name def\r
+      and elt_nat = resolve_definition ctx def\r
+      and loc = match def.Syntax.nature with\r
+        | Syntax.Definition (encap, part, kind, cl_spec) ->\r
+            cl_spec.Syntax.info in\r
+      [s, elt_nat, loc]\r
+  | Syntax.ComponentClauseElement (_, cpnt_cl, _) ->\r
+      resolve_component_clause ctx cpnt_cl\r
+\r
+and resolve_component_clause ctx cpnt_cl = match cpnt_cl.Syntax.nature with\r
+  | Syntax.ComponentClause (type_pref, type_spec, subs, cpnt_decls) ->\r
+      let type_pref' = type_prefix type_pref\r
+      and type_spec' = lazy (resolve_expression ctx type_spec)\r
+      and dims = lazy (resolve_dimensions ctx subs) in\r
+      List.map\r
+        (resolve_component_declaration ctx type_pref' type_spec' dims type_spec)\r
+        cpnt_decls\r
+\r
+and type_prefix type_pref =\r
+  let bool_of_flow = function\r
+    | None -> false\r
+    | Some Syntax.Flow -> true\r
+  and variability_of_variability = function\r
+    | None -> None\r
+    | Some Syntax.Constant -> Some Types.Constant\r
+    | Some Syntax.Parameter -> Some Types.Parameter\r
+    | Some Syntax.Discrete -> Some Types.Discrete\r
+  and causality_of_inout = function\r
+    | None -> Types.Acausal\r
+    | Some Syntax.Input -> Types.Input\r
+    | Some Syntax.Output -> Types.Output in\r
+  match type_pref.Syntax.nature with\r
+    | Syntax.TypePrefix (flow, var, inout) ->\r
+        bool_of_flow flow,\r
+        variability_of_variability var,\r
+        causality_of_inout inout\r
+\r
+and resolve_component_declaration\r
+  ctx type_pref type_spec' dims type_spec cpnt_decl =\r
+    let build_comment_string cmt = match cmt.Syntax.nature with\r
+      | Syntax.Comment (ss, _) -> List.fold_right ( ^ ) ss "" in\r
+    match cpnt_decl.Syntax.nature with\r
+      | Syntax.ComponentDeclaration (decl, cmt) ->\r
+          let cmt' = build_comment_string cmt in\r
+          resolve_declaration ctx type_pref type_spec' dims decl cmt' type_spec\r
+\r
+and resolve_declaration ctx type_pref type_spec' dims decl cmt type_spec =\r
+  let ctx = {ctx with location = decl.Syntax.info} in\r
+  match decl.Syntax.nature with\r
+    | Syntax.Declaration (id, subs, modif) ->\r
+        let dims = lazy ((resolve_dimensions ctx subs) @ (evaluate dims)) in\r
+        let cpnt_type = lazy (component_type ctx type_pref type_spec' dims) in\r
+        let modif' =\r
+          lazy (resolve_component_modification ctx cpnt_type modif) in\r
+        let cpnt_desc =\r
+          {\r
+            component_type =\r
+              lazy (modified_component_type ctx (evaluate cpnt_type) modif');\r
+            type_specifier = type_spec';\r
+            dimensions = dims;\r
+            modification = modif';\r
+            comment = cmt;\r
+          } in\r
+        (id, Component cpnt_desc, decl.Syntax.info)\r
+\r
+and resolve_dimensions ctx subs =\r
+  let resolve_dimension sub = match sub.Syntax.nature with\r
+    | Syntax.Colon -> Colon\r
+    | Syntax.Subscript expr ->\r
+        Expression (resolve_subscript_expression ctx expr) in\r
+  let resolve_dimensions' = function\r
+    | None -> []\r
+    | Some { Syntax.nature = Syntax.Subscripts subs_elts } ->\r
+        List.map resolve_dimension subs_elts in\r
+  resolve_dimensions' subs\r
+\r
+and base_class_type ctx cl_spec base_class =\r
+  match (evaluate base_class).info.type_description with\r
+    | Types.ClassElement cl_spec -> evaluate cl_spec\r
+    | Types.ComponentTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_CannotInheritFrom"; "_ComponentTypeElement"];\r
+           err_info =\r
+             [("_ElemFound", Syntax.string_of_expression cl_spec)];\r
+           err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)\r
+    | Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_CannotInheritFrom"; "_PredefinedTypeElement"];\r
+           err_info =\r
+             [("_ElemFound", Syntax.string_of_expression cl_spec)];\r
+           err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)\r
+    | Types.ComponentElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_CannotInheritFrom"; "_ComponentElement"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)\r
+\r
+and component_type ctx (flow, var, inout) base_type dims =\r
+  let base_type = evaluate base_type in\r
+  let lower_variability var var' = match var, var' with\r
+    | Some Types.Constant,\r
+      (Types.Constant | Types.Parameter | Types.Discrete | Types.Continuous) ->\r
+        Types.Constant\r
+    | Some Types.Parameter,\r
+      (Types.Parameter | Types.Discrete | Types.Continuous) -> Types.Parameter\r
+    | Some Types.Discrete, (Types.Discrete | Types.Continuous) -> Types.Discrete\r
+    | Some Types.Continuous, Types.Continuous -> Types.Continuous\r
+    | None, _ -> var'\r
+    | Some var, (Types.Constant | Types.Parameter | Types.Discrete) ->\r
+        raise (CompilError\r
+          {err_msg = ["_VariablityConflictsInCompDef"];\r
+           err_info =\r
+             [("_TypePrefix", Types.string_of_variability var);\r
+              ("_TypeSpecifierVariability", Types.string_of_variability var')];\r
+           err_ctx = ctx}) (*error*)\r
+  and propagate_causality inout inout' = match inout, inout' with\r
+    | Types.Acausal, (Types.Acausal | Types.Input | Types.Output) -> inout'\r
+    | (Types.Input | Types.Output), Types.Acausal -> inout\r
+    | Types.Input, Types.Input | Types.Output, Types.Output -> inout\r
+    | Types.Input, Types.Output | Types.Output, Types.Input ->\r
+        raise (CompilError\r
+          {err_msg = ["_CausalityConflictsInCompDef"];\r
+           err_info = [("_TypePrefix", Types.string_of_causality inout);\r
+                       ("_TypeSpecifierCausality",\r
+                        Types.string_of_causality inout')];\r
+           err_ctx = ctx}) (*error*) in\r
+  let predefined_type_variability predef = match predef with\r
+    | { Types.base_type = Types.RealType } -> Types.Continuous\r
+    | _ -> Types.Discrete in\r
+  let rec class_specifier_variability cl_spec = match cl_spec with\r
+    | Types.PredefinedType predef -> predefined_type_variability predef\r
+    | Types.ClassType cl_type -> Types.Continuous\r
+    | Types.ComponentType cpnt_type -> evaluate cpnt_type.Types.variability\r
+    | Types.ArrayType (dim, cl_spec) -> class_specifier_variability cl_spec\r
+    | Types.TupleType cl_specs -> assert false in\r
+  match base_type.info.type_description with\r
+    | Types.ComponentElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["class"; "_ElemExpected"];\r
+           err_info = [("TypeFound", "_ComponentElement")];\r
+           err_ctx = ctx}) (*error*)\r
+    | Types.ClassElement cl_spec ->\r
+        let cl_spec = evaluate cl_spec in\r
+        let var' = class_specifier_variability cl_spec in\r
+        let var' = lazy (lower_variability var var')\r
+        and base_class = lazy (add_dimensions dims cl_spec) in\r
+        component_element (lazy flow) var' (lazy inout) base_class\r
+    | Types.ComponentTypeElement cpnt_type ->\r
+        let flow' = lazy (flow || evaluate cpnt_type.Types.flow)\r
+        and var' =\r
+          lazy (lower_variability var (evaluate cpnt_type.Types.variability))\r
+        and inout' =\r
+          lazy (propagate_causality inout (evaluate cpnt_type.Types.causality))\r
+        and base_class =\r
+          lazy (add_dimensions dims (Types.ComponentType cpnt_type)) in\r
+        component_element flow' var' inout' base_class\r
+    | Types.PredefinedTypeElement predef ->\r
+        let var' = predefined_type_variability predef in\r
+        let var' = lazy (lower_variability var var')\r
+        and base_class =\r
+          lazy (add_dimensions dims (Types.PredefinedType predef)) in\r
+        component_element (lazy flow) var' (lazy inout) base_class\r
+\r
+and add_dimensions dims cl_spec =\r
+  let add_dimension dim cl_spec = match dim with\r
+    | Expression { nature = Integer i } ->\r
+        Types.ArrayType (Types.ConstantDimension i, cl_spec)\r
+    | Expression _ -> Types.ArrayType (Types.ParameterDimension, cl_spec)\r
+    | Colon -> Types.ArrayType (Types.DiscreteDimension, cl_spec) in\r
+  List.fold_right add_dimension (evaluate dims) cl_spec\r
+\r
+and modified_described_type ctx cpnt_type cl_modif =\r
+  let cpnt_type' = evaluate cpnt_type in\r
+  let cl_spec = cpnt_type'.Types.base_class in\r
+  { cpnt_type' with\r
+    Types.base_class =\r
+      lazy (modify_class_specifier ctx (evaluate cl_modif) cl_spec)\r
+  }\r
+\r
+and modified_class_type ctx cl_spec cl_modif =\r
+  let cl_spec' = modify_class_specifier ctx (evaluate cl_modif) cl_spec in\r
+  match cl_spec' with\r
+    | Types.ClassType cl_type -> cl_type\r
+    | Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |\r
+      Types.TupleType _ ->\r
+        raise (CompilError\r
+          {err_msg = ["class"; "_ElemExpected"];\r
+           err_info = [("TypeFound",\r
+                        Types.string_of_class_specifier cl_spec')];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and modified_component_type ctx cpnt_type modif =\r
+  let modified_component_type' = function\r
+    | Modification (cl_modif, _) -> modify_component_type ctx cl_modif cpnt_type\r
+    | Assignment _ | Equality _ -> cpnt_type in\r
+  match evaluate modif with\r
+    | None -> cpnt_type\r
+    | Some modif' -> modified_component_type' modif'\r
+\r
+(* We can abstract dimensions away since they have been already checked at *)\r
+(* modification resolution time.                                           *)\r
+and modify_class_specifier ctx cl_modif cl_spec =\r
+  let rec modify_class_specifier' cl_spec' = match cl_spec' with\r
+    | Types.PredefinedType predef ->\r
+        Types.PredefinedType (modify_predefined_type ctx cl_modif predef)\r
+    | Types.ClassType cl_type ->\r
+        Types.ClassType (modify_class_type ctx cl_modif cl_type)\r
+    | Types.ComponentType cpnt_type ->\r
+        Types.ComponentType (modify_component_type ctx cl_modif cpnt_type)\r
+    | Types.ArrayType (dim, cl_spec) ->\r
+        Types.ArrayType (dim, modify_class_specifier' cl_spec)\r
+    | Types.TupleType _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidTypeOfClassSpec"];\r
+           err_info = [("_TypeFound",\r
+                        Types.string_of_class_specifier cl_spec')];\r
+           err_ctx = ctx}) (*error*) in\r
+  modify_class_specifier' (evaluate cl_spec)\r
+\r
+and modify_predefined_type ctx cl_modif predef =\r
+  { predef with\r
+    Types.attributes =\r
+      modify_predefined_attributes ctx cl_modif predef.Types.attributes\r
+  }\r
+\r
+and modify_predefined_attributes ctx cl_modif attrs =\r
+  let apply_modifications ((id, final) as attr) = function\r
+    | [] -> attr\r
+    | [_] when final -> assert false (*error*)\r
+    | [final', (Assignment _ | Equality _)] -> id, final'\r
+    | _ :: _ -> assert false (*error*) in\r
+  let modify_attribute ((id, _) as attr) =\r
+    let modifs, elt_descs = partition_modifications cl_modif id in\r
+    match modifs, elt_descs with\r
+      | [], [] -> attr\r
+      | _ :: _, [] -> apply_modifications attr modifs\r
+      | [], _ :: _\r
+      | _ :: _, _ :: _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_RedeclarePredefTypeAttrib"; id];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*) in\r
+  List.map modify_attribute attrs\r
+\r
+and modify_class_type ctx cl_modif cl_type =\r
+  let modify_named_element (id, elt_type) =\r
+    id, lazy (modify_element ctx cl_modif id (evaluate elt_type)) in\r
+  { cl_type with\r
+    Types.named_elements =\r
+      List.map modify_named_element cl_type.Types.named_elements\r
+  }\r
+\r
+and modify_element ctx cl_modif id elt_type =\r
+  let modifs, elt_descs = partition_modifications cl_modif id in\r
+  match modifs, elt_descs with\r
+    | [], [] -> elt_type\r
+    | _ :: _, [] -> apply_element_modifications ctx modifs elt_type id\r
+    | [], [elt_desc] -> apply_element_redeclaration ctx elt_desc elt_type\r
+    | [], _ :: _ :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidElemModifDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | _ :: _, _ :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidElemModifDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and partition_modifications cl_modif id =\r
+  let add_element_modification modif_arg modifs = match modif_arg.action with\r
+    | Some (ElementModification modif) -> (modif_arg.final, modif) :: modifs\r
+    | None | Some (ElementRedeclaration _) -> modifs\r
+  and add_element_redeclaration modif_arg elt_descs =\r
+    match modif_arg.action with\r
+      | None | Some (ElementModification _) -> elt_descs\r
+      | Some (ElementRedeclaration elt_desc) ->\r
+          (modif_arg.final, elt_desc) :: elt_descs in\r
+  let is_current_element_modification modif_arg = modif_arg.target = id in\r
+  let cl_modif' = List.filter is_current_element_modification cl_modif in\r
+  let modifs = List.fold_right add_element_modification cl_modif' []\r
+  and elt_descs = List.fold_right add_element_redeclaration cl_modif' [] in\r
+  modifs, elt_descs\r
+\r
+and apply_element_redeclaration ctx elt_desc elt_type =\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented"; "_ElementRedeclaration"];\r
+     err_info = [];\r
+     err_ctx = ctx})\r
+\r
+and apply_element_modifications ctx modifs elt_type id =\r
+  let add_modification_arguments (final, modif) cl_modifs = match modif with\r
+    | Modification (cl_modif, _) -> (final, cl_modif) :: cl_modifs\r
+    | Assignment _ | Equality _ -> cl_modifs\r
+  and add_value_modification (final, modif) val_modifs = match modif with\r
+    | Modification (_, Some _) | Assignment _ | Equality _ ->\r
+        final :: val_modifs\r
+    | Modification (_, None) -> val_modifs in\r
+  let cl_modifs = List.fold_right add_modification_arguments modifs []\r
+  and val_modifs = List.fold_right add_value_modification modifs [] in\r
+  let elt_type' = modify_element_type ctx cl_modifs elt_type id in\r
+  modify_element_value ctx val_modifs elt_type' id\r
+\r
+and modify_element_type ctx cl_modifs elt_type id =\r
+  let propagate_final_attribute final modif_arg cl_modif =\r
+    { modif_arg with final = final } :: cl_modif in\r
+  let merge_modifications (final, cl_modif) cl_modif' =\r
+    List.fold_right (propagate_final_attribute final) cl_modif cl_modif' in\r
+  let cl_modif = List.fold_right merge_modifications cl_modifs [] in\r
+  { elt_type with\r
+    Types.element_nature = modify_element_nature ctx cl_modif elt_type id\r
+  }\r
+\r
+and modify_element_nature ctx cl_modif elt_type id =\r
+  match elt_type.Types.element_nature with\r
+    | _ when elt_type.Types.final ->\r
+        raise (CompilError\r
+          {err_msg = ["_FinalElemModifNotAllowed"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Types.ComponentElement cpnt_type ->\r
+        Types.ComponentElement (modify_component_type ctx cl_modif cpnt_type)\r
+    | Types.ClassElement cl_spec ->\r
+        let cl_spec' = lazy (modify_class_specifier ctx cl_modif cl_spec) in\r
+        Types.ClassElement cl_spec'\r
+    | Types.ComponentTypeElement cpnt_type ->\r
+        let cpnt_type' = modify_component_type ctx cl_modif cpnt_type in\r
+        Types.ComponentTypeElement cpnt_type'\r
+    | Types.PredefinedTypeElement predef ->\r
+        Types.PredefinedTypeElement (modify_predefined_type ctx cl_modif predef)\r
+\r
+and modify_element_value ctx val_modifs elt_type id =\r
+  match val_modifs with\r
+    | [] -> elt_type\r
+    | [_] when elt_type.Types.final ->\r
+        raise (CompilError\r
+          {err_msg = ["_FinalElemModifNotAllowed"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | [final] -> { elt_type with Types.final = final }\r
+    | _ :: _ :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_DuplicatedModifOfElem"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and modify_component_type ctx cl_modif cpnt_type =\r
+  { cpnt_type with\r
+    Types.base_class =\r
+      lazy (modify_class_specifier ctx cl_modif cpnt_type.Types.base_class)\r
+  }\r
+\r
+and resolve_type_modification ctx cpnt_type cl_modif =\r
+  let cl_spec = (evaluate cpnt_type).Types.base_class in\r
+  resolve_class_modification_option ctx cl_spec cl_modif\r
+\r
+and resolve_component_modification ctx cpnt_type = function\r
+  | None -> None\r
+  | Some modif' ->\r
+      let elt_nat = Types.ComponentElement (evaluate cpnt_type) in\r
+      Some (resolve_modification ctx elt_nat modif')\r
+\r
+and resolve_class_modification_option ctx cl_spec = function\r
+  | None -> []\r
+  | Some cl_modif -> resolve_class_modification ctx cl_spec cl_modif\r
+\r
+and resolve_modification ctx elt_nat modif =\r
+  let ctx = {ctx with location = modif.Syntax.info} in\r
+  match elt_nat, modif.Syntax.nature with\r
+    | Types.ComponentElement cpnt_type, Syntax.Modification (cl_modif, expr) |\r
+      Types.ComponentTypeElement cpnt_type,\r
+      Syntax.Modification (cl_modif, (None as expr)) ->\r
+        resolve_component_type_modification ctx cpnt_type cl_modif expr\r
+    | Types.ComponentTypeElement _, Syntax.Modification (_, Some _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidClassElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Types.ClassElement cl_spec, Syntax.Modification (cl_modif, None) ->\r
+        let cl_modif' = resolve_class_modification ctx cl_spec cl_modif in\r
+        Modification (cl_modif', None)\r
+    | Types.ClassElement _, Syntax.Modification (_, Some _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidClassElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | (Types.PredefinedTypeElement _),\r
+      (Syntax.Modification _ | Syntax.Eq _ | Syntax.ColEq _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidClassElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | Types.ComponentElement cpnt_type, Syntax.Eq expr ->\r
+        let expr' = lazy (resolve_modification_equation ctx cpnt_type expr) in\r
+        Equality expr'\r
+    | Types.ComponentElement cpnt_type, Syntax.ColEq expr ->\r
+        let expr' = lazy (resolve_modification_algorithm ctx cpnt_type expr) in\r
+        Assignment expr'\r
+    | (Types.ClassElement _ | Types.ComponentTypeElement _),\r
+      (Syntax.Eq _ | Syntax.ColEq _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidClassElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_component_type_modification ctx cpnt_type cl_modif expr =\r
+  let ctx = {ctx with location = cl_modif.Syntax.info} in\r
+  let cl_spec = cpnt_type.Types.base_class in\r
+  let cl_modif' = resolve_class_modification ctx cl_spec cl_modif in\r
+  let cpnt_type' = modify_component_type ctx cl_modif' cpnt_type in\r
+  let expr' = resolve_value_modification_option ctx cpnt_type' expr in\r
+  Modification (cl_modif', expr')\r
+\r
+and resolve_value_modification_option ctx cpnt_type = function\r
+  | None -> None\r
+  | Some expr -> Some (lazy (resolve_modification_equation ctx cpnt_type expr))\r
+\r
+and resolve_modification_equation ctx cpnt_type expr =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  let resolve_modification_equation' cpnt_type' expr' =\r
+    let var = evaluate cpnt_type.Types.variability\r
+    and var' = evaluate cpnt_type'.Types.variability in\r
+    match Types.compare_component_types cpnt_type cpnt_type' with\r
+    | Types.SameType\r
+      when Types.higher_variability var var' -> expr'\r
+    | Types.SameType ->\r
+        let var = Types.string_of_variability var\r
+        and var' = Types.string_of_variability var' in\r
+        raise (CompilError\r
+          {err_msg = ["_VariabilityConflicts"];\r
+           err_info = [("_ExprKind", "A = B");\r
+                       ("_VariabilityOfA", var);\r
+                       ("_VariabilityOfB", var')];\r
+           err_ctx = ctx}) (*error*)\r
+    | _ ->\r
+              let type_A = Types.string_of_component_type cpnt_type\r
+              and type_B = Types.string_of_component_type cpnt_type' in\r
+              raise (CompilError\r
+                {err_msg = [ "_EquTermsNotOfTheSameType"];\r
+                 err_info = [("_ExprKind", "A = B");\r
+                             ("_TypeOfA", type_A);\r
+                             ("_TypeOfB", type_B)];\r
+           err_ctx = ctx}) (*error*) in\r
+  let expr' = resolve_expression ctx expr in\r
+  let expr' = apply_rhs_coercions cpnt_type expr' in\r
+  match expr'.info.type_description with\r
+  | Types.ComponentElement cpnt_type' ->\r
+      resolve_modification_equation' cpnt_type' expr'\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_modification_algorithm ctx cpnt_type expr =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  let resolve_modification_algorithm' cpnt_type' expr' =\r
+          let var = evaluate cpnt_type.Types.variability\r
+          and var' = evaluate cpnt_type'.Types.variability in\r
+          match Types.compare_component_types cpnt_type cpnt_type' with\r
+    | Types.SameType\r
+              when Types.higher_variability var var' -> expr'\r
+    | Types.SameType ->\r
+              let var = Types.string_of_variability var\r
+              and var' = Types.string_of_variability var' in\r
+              raise (CompilError\r
+          {err_msg = ["_VariabilityConflicts"];\r
+                 err_info = [("_ExprKind", "A := B");\r
+                             ("_VariabilityOfA", var);\r
+                             ("_VariabilityOfB", var')];\r
+                 err_ctx = ctx}) (*error*)\r
+    | _ ->\r
+              let type_A = Types.string_of_component_type cpnt_type\r
+              and type_B = Types.string_of_component_type cpnt_type' in\r
+              raise (CompilError\r
+          {err_msg = [ "_TypeConflictsInAssign"];\r
+                 err_info = [("_ExprKind", "A := B");\r
+                             ("_TypeOfA", type_A);\r
+                             ("_TypeOfB", type_B)];\r
+           err_ctx = ctx}) (*error*) in\r
+  let expr' = resolve_expression ctx expr in\r
+  let expr' = apply_rhs_coercions cpnt_type expr' in\r
+  match expr'.info.type_description with\r
+  | Types.ComponentElement cpnt_type' ->\r
+      resolve_modification_algorithm' cpnt_type' expr'\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_class_modification ctx cl_spec cl_modif =\r
+  match cl_modif.Syntax.nature with\r
+    | Syntax.ClassModification args ->\r
+        List.map (resolve_modification_argument ctx cl_spec) args\r
+\r
+and resolve_modification_argument ctx cl_spec arg =\r
+  let ctx = {ctx with location = arg.Syntax.info} in\r
+  let apply_each each =\r
+    let rec drop_dimensions cl_spec = match cl_spec with\r
+      | Types.ArrayType (_, cl_spec') -> drop_dimensions cl_spec'\r
+      | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+        Types.TupleType _ -> cl_spec in\r
+    let cl_spec' = evaluate cl_spec in\r
+    match cl_spec' with\r
+      | Types.ArrayType _ when each -> drop_dimensions cl_spec'\r
+      | Types.PredefinedType _\r
+      | Types.ClassType _\r
+      | Types.ComponentType _\r
+      | Types.TupleType _ when each ->\r
+          raise (CompilError\r
+            {err_msg = ["_EachAppliedToNonArrayElem"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | Types.ArrayType _ | Types.PredefinedType _ | Types.ClassType _ |\r
+        Types.ComponentType _ | Types.TupleType _ -> cl_spec' in\r
+  match arg.Syntax.nature with\r
+    | Syntax.ElementModification (each, final, expr, modif, _) ->\r
+        let each' = bool_of_each each\r
+        and final' = bool_of_final final in\r
+        let cl_spec' = apply_each each' in\r
+        resolve_element_modification ctx cl_spec' each' final' expr modif\r
+    | Syntax.ElementRedeclaration (each, final, elt_def) ->\r
+        let each' = bool_of_each each\r
+        and final' = bool_of_final final in\r
+        let cl_spec' = apply_each each' in\r
+        resolve_element_redeclaration ctx cl_spec' each' final' elt_def\r
+\r
+and bool_of_each = function\r
+  | None -> false\r
+  | Some Syntax.Each -> true\r
+\r
+and bool_of_final = function\r
+  | None -> false\r
+  | Some Syntax.Final -> true\r
+\r
+and resolve_element_modification ctx cl_spec each final expr modif =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  let rec path_of_expression path expr = match expr.Syntax.nature with\r
+    | Syntax.Identifier id ->\r
+        modification_arguments_of_path cl_spec each final id (List.rev path)\r
+    | Syntax.FieldAccess (expr, id) -> path_of_expression (id :: path) expr\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidExprInElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+  and modification_arguments_of_path cl_spec each final id path =\r
+    let flow = false\r
+    and var = Types.Continuous\r
+    and inout = Types.Acausal in\r
+    let elt_nat = element_field_type_nature ctx flow var inout cl_spec id in\r
+    {\r
+      each = each;\r
+      final = final;\r
+      target = id;\r
+      action = resolve_modification_action ctx modif elt_nat path\r
+    }\r
+  and resolve_modification_action ctx modif elt_nat = function\r
+    | [] -> resolve_modification_option ctx elt_nat modif\r
+    | id :: path ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_FieldAccessInElemModifExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx})\r
+  and resolve_modification_option ctx elt_nat = function\r
+    | None -> None\r
+    | Some modif ->\r
+        Some (ElementModification (resolve_modification ctx elt_nat modif)) in\r
+  path_of_expression [] expr\r
+\r
+and resolve_element_redeclaration ctx cl_spec each final elt_def =\r
+  let ctx = {ctx with location = elt_def.Syntax.info} in\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented"; "_ElementRedeclaration"];\r
+     err_info = [];\r
+     err_ctx = ctx})\r
+\r
+and resolve_unnamed_elements ctx other_elts =\r
+  let class_kind =\r
+    let class_context' cl_spec = match cl_spec with\r
+      | Types.ClassType cl_type ->\r
+          Some (evaluate cl_type.Types.kind)\r
+      | _ -> None in\r
+    match ctx.context_nature with\r
+    | ClassContext cl_def ->\r
+        class_context' (evaluate cl_def.class_type)\r
+    | _ -> None in\r
+  let add_equation_or_algorithm_clause other_elt acc =\r
+    match other_elt.Syntax.nature, class_kind with\r
+      | (Syntax.EquationClause _), Some kind\r
+        when List.mem kind [Types.Function; Types.Record; Types.Connector] ->\r
+          raise (CompilError\r
+            {err_msg = ["_EquNotAllowedInTheDefOf"; Types.string_of_kind kind];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | Syntax.EquationClause (init, equ_defs), _ ->\r
+          let init' = bool_of_initial init\r
+          and equ_defs' = resolve_equation_definitions ctx equ_defs in\r
+          EquationClause (init', equ_defs') :: acc\r
+      | Syntax.AlgorithmClause (init, algo_defs), _ ->\r
+          let init' = bool_of_initial init\r
+          and algo_defs' = resolve_algorithm_definitions ctx algo_defs in\r
+          AlgorithmClause (init', algo_defs') :: acc\r
+      | (Syntax.Public _ | Syntax.Protected _), _ -> acc in\r
+  List.fold_right add_equation_or_algorithm_clause other_elts []\r
+\r
+and bool_of_initial = function\r
+  | None -> Permanent\r
+  | Some Syntax.Initial -> Initial\r
+\r
+and resolve_equation_definitions ctx equ_defs =\r
+  let resolve_equation_definition equ_def = match equ_def.Syntax.nature with\r
+    | Syntax.Equation (equ, _, _) -> resolve_equation ctx equ in\r
+  List.flatten (List.map resolve_equation_definition equ_defs)\r
+\r
+and resolve_algorithm_definitions ctx algo_defs =\r
+  let resolve_algorithm_definition algo_def = match algo_def.Syntax.nature with\r
+    | Syntax.Algorithm (algo, _, _) -> resolve_algorithm ctx algo in\r
+  List.map resolve_algorithm_definition algo_defs\r
+\r
+and resolve_equation ctx equ =\r
+  let ctx = {ctx with location = equ.Syntax.info} in\r
+  match equ.Syntax.nature with\r
+    | Syntax.Equal (expr, expr') -> resolve_equal ctx equ expr expr'\r
+    | Syntax.ConditionalEquationE (alts, default) ->\r
+        resolve_conditional_equation_e ctx equ alts default\r
+    | Syntax.ForClauseE (for_inds, equs) ->\r
+        resolve_for_clause_e ctx equ for_inds equs\r
+    | Syntax.ConnectClause (expr, expr') ->\r
+        resolve_connect_clause ctx equ expr expr'\r
+    | Syntax.WhenClauseE alts ->\r
+        resolve_when_clause_e ctx equ alts\r
+    | Syntax.FunctionCallE (expr, fun_args) ->\r
+        resolve_functional_call_e ctx equ expr fun_args\r
+\r
+and resolve_equal ctx equ expres expres' =\r
+  let resolve_equal' cpnt_type expr cpnt_type' expr' =\r
+    let resolved_equation syn expr expr' =\r
+      {\r
+        nature = Equal (expr, expr');\r
+        info = syn\r
+      } in\r
+    let var = evaluate cpnt_type.Types.variability\r
+    and var' = evaluate cpnt_type'.Types.variability in\r
+    match var, var' with\r
+    | Types.Continuous, _ | _, Types.Continuous ->\r
+        equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr'\r
+    | Types.Discrete, _ | _, Types.Discrete\r
+      when expression_of_variable expres ->\r
+        equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr'\r
+    | Types.Discrete, _ | _, Types.Discrete ->\r
+        raise (CompilError\r
+          {err_msg = ["_LHSOfDiscreteEquMustBeAVar"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = expres.Syntax.info}}) (*error*)\r
+    | _ ->\r
+        equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' in\r
+  let expr = resolve_expression ctx expres\r
+  and expr' = resolve_expression ctx expres' in\r
+  let exprs = apply_binary_coercions [ expr; expr' ] in\r
+  let expr = List.nth exprs 0\r
+  and expr' = List.nth exprs 1 in\r
+  let elt_nat = expr.info.type_description\r
+  and elt_nat' = expr'.info.type_description in\r
+  match elt_nat, elt_nat' with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_equal' cpnt_type expr cpnt_type' expr'\r
+    | (Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _), _ ->\r
+        let ctx = {ctx with location = expres.Syntax.info} in\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | _, (Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _) ->\r
+        let ctx = {ctx with location = expres'.Syntax.info} in\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_conditional_equation_e ctx equ alts default =\r
+  let resolve_alternative (expr, equs) =\r
+    let ctx = {ctx with location = expr.Syntax.info} in\r
+    let expr' = resolve_expression ctx expr in\r
+    let resolve_alternative' cpnt_type =\r
+      let cl_spec = evaluate cpnt_type.Types.base_class in\r
+      match cl_spec with\r
+        | Types.PredefinedType { Types.base_type = Types.BooleanType } ->\r
+            let equs' = List.flatten (List.map (resolve_equation ctx) equs) in\r
+            expr', equs'\r
+        | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+          Types.ArrayType _ | Types.TupleType _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_NonBooleanIfCondExpr"];\r
+               err_info =\r
+                 [("_ExprKind", "...if A then...");\r
+                  ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+               err_ctx = ctx}) (*error*) in\r
+    match expr'.info.type_description with\r
+      | Types.ComponentElement cpnt_type -> resolve_alternative' cpnt_type\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*) in\r
+  let alts' = List.map resolve_alternative alts in\r
+  let default' = match default with\r
+    | None -> []\r
+    | Some equs -> List.flatten (List.map (resolve_equation ctx) equs) in\r
+  [{\r
+    nature = ConditionalEquationE (alts', default');\r
+    info = Some equ\r
+  }]\r
+\r
+and resolve_for_clause_e ctx equ for_inds equs =\r
+  let range_element_type expr range =\r
+    let ctx = {ctx with location = expr.Syntax.info} in\r
+    let sub_dimension cl_spec = match cl_spec with\r
+      | Types.ArrayType (dim, cl_spec) -> cl_spec\r
+      | Types.PredefinedType _ | Types.ClassType _ |\r
+        Types.ComponentType _ | Types.TupleType _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidTypeInRangeExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "Integer");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    match range.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let cpnt_type' =\r
+            { cpnt_type with\r
+              Types.base_class = lazy (sub_dimension cl_spec)\r
+            } in\r
+          Types.ComponentElement cpnt_type'\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*) in\r
+  let rec resolve_for_clause_e' acc ctx = function\r
+    | [] ->\r
+        let equs' = List.flatten (List.map (resolve_equation ctx) equs) in\r
+        [{\r
+          nature = ForClauseE (List.rev acc, equs');\r
+          info = Some equ\r
+        }]\r
+    | (_, None) :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_ImplicitIterRange"];\r
+           err_info = [];\r
+           err_ctx = ctx})\r
+    | (id, Some expr) :: for_inds ->\r
+        let range = resolve_expression ctx expr in\r
+        let elt_nat = range_element_type expr range in\r
+        let ctx' =\r
+          { ctx with\r
+            context_nature = ForContext (ctx, id, elt_nat)\r
+          } in\r
+        resolve_for_clause_e' (range :: acc) ctx' for_inds in\r
+  resolve_for_clause_e' [] ctx for_inds\r
+\r
+and resolve_connect_clause ctx equ expres expres' =\r
+  let expr = resolve_expression ctx expres\r
+  and expr' = resolve_expression ctx expres' in\r
+  let resolve_connect_clause' cpnt_typ cpnt_typ' =\r
+    let rec class_type_of_class_specifier cl_spec = match cl_spec with\r
+      | Types.ClassType cl_type -> cl_type\r
+      | Types.ComponentType cpnt_type ->\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          class_type_of_class_specifier cl_spec\r
+      | Types.ArrayType (_, cl_spec) -> class_type_of_class_specifier cl_spec\r
+      | Types.PredefinedType _ | Types.TupleType _ ->\r
+          raise (CompilError\r
+              {err_msg = ["_InvalidTypeOfArgInConnectStat"];\r
+               err_info =\r
+                 [("_ExprKind", "connect(A, B)");\r
+                  ("_TypeOfA", Types.string_of_component_type cpnt_typ);\r
+                  ("_TypeOfB", Types.string_of_component_type cpnt_typ')];\r
+               err_ctx = ctx}) (*error*) in\r
+    let connector_sign expr =\r
+      let is_connector_type expr =\r
+        let is_connector_type' cpnt_type =\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let cl_type = class_type_of_class_specifier cl_spec in\r
+          match evaluate cl_type.Types.kind with\r
+            | Types.Connector | Types.ExpandableConnector -> true\r
+            | Types.Class | Types.Model | Types.Block -> false\r
+            | Types.Record ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["record"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | Types.Package ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["package"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | Types.Function ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["function"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*) in\r
+        match expr.info.type_description with\r
+          | Types.ComponentElement cpnt_type ->\r
+              is_connector_type' cpnt_type\r
+          | _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_ClassElemFoundInExpr"];\r
+                 err_info = [];\r
+                 err_ctx = ctx}) (*error*) in\r
+      let is_connectable expr =\r
+        let is_connectable' cpnt_type =\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let cl_type = class_type_of_class_specifier cl_spec in\r
+          match evaluate cl_type.Types.kind with\r
+            | Types.Class | Types.Model | Types.Block -> true\r
+            | Types.Connector | Types.ExpandableConnector -> false\r
+            | Types.Record ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["record"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | Types.Package ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["package"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | Types.Function ->\r
+                raise (CompilError\r
+                  {err_msg =\r
+                     ["function"; "_InstanceUsedInConnection"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*) in\r
+        match expr.info.type_description with\r
+          | Types.ComponentElement cpnt_type ->\r
+              is_connectable' cpnt_type\r
+          | _ ->\r
+              raise (CompilError\r
+                {err_msg = ["_ClassElemFoundInExpr"];\r
+                 err_info = [];\r
+                 err_ctx = ctx}) (*error*) in\r
+      let rec connector_sign' expr = match expr.nature with\r
+        | LocalIdentifier (0, _) when is_connector_type expr -> Some Negative\r
+        | LocalIdentifier (0, _) when is_connectable expr -> Some Positive\r
+        | (FieldAccess (expr', _) | IndexedAccess (expr', _))\r
+          when is_connector_type expr -> connector_sign' expr'\r
+        | (FieldAccess (expr', _) | IndexedAccess (expr', _))\r
+          when is_connectable expr' -> connector_sign' expr'\r
+        | _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidTypeOfArgInConnectStat"];\r
+               err_info =\r
+                 [("_ExprKind", "connect(A, B)");\r
+                  ("_TypeOfA", Types.string_of_component_type cpnt_typ);\r
+                  ("_TypeOfB", Types.string_of_component_type cpnt_typ')];\r
+               err_ctx = ctx}) (*error*) in\r
+      match expr.nature with\r
+        | _ when not (is_connector_type expr) ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidTypeOfArgInConnectStat"];\r
+               err_info =\r
+                 [("_ExprKind", "connect(A, B)");\r
+                  ("_TypeOfA", Types.string_of_component_type cpnt_typ);\r
+                  ("_TypeOfB", Types.string_of_component_type cpnt_typ')];\r
+               err_ctx = ctx}) (*error*)\r
+        | LocalIdentifier (0, _) -> Some Negative\r
+        | _ -> connector_sign' expr in\r
+    let connect sign cpnt_type sign' cpnt_type' =\r
+      let resolved_equation syn expr expr' =\r
+        let elt_nat = expr.info.type_description\r
+        and elt_nat' = expr'.info.type_description in\r
+        let flow, _, _ = type_prefixes_of_element_nature elt_nat\r
+        and flow', _, _ = type_prefixes_of_element_nature elt_nat' in\r
+        match flow, flow' with\r
+          | false, false ->\r
+              {\r
+                nature = Equal (expr, expr');\r
+                info = syn\r
+              }\r
+          | true, true ->\r
+              {\r
+                nature = ConnectFlows (sign, expr, sign', expr');\r
+                info = syn\r
+              }\r
+          | false, true ->\r
+              raise (CompilError\r
+                {err_msg = ["_CannotConnectFlowAndNonFlowComp"];\r
+                 err_info =\r
+                   [("_ExprKind", "connect(A, B)");\r
+                    ("_TypeOfA", "non-flow connector");\r
+                    ("_TypeOfB", "flow connector")];\r
+                 err_ctx = ctx}) (*error*)\r
+          | true, false ->\r
+              raise (CompilError\r
+                {err_msg = ["_CannotConnectFlowAndNonFlowComp"];\r
+                 err_info =\r
+                   [("_ExprKind", "connect(A, B)");\r
+                    ("_TypeOfA", "flow connector");\r
+                    ("_TypeOfB", "non-flow connector")];\r
+                 err_ctx = ctx}) (*error*) in\r
+      equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' in\r
+    match connector_sign expr, connector_sign expr' with\r
+      | Some sign, Some sign' -> connect sign cpnt_typ sign' cpnt_typ'\r
+      | None, Some _ -> assert false\r
+      | Some _, None -> assert false\r
+      | None, None -> assert false in\r
+  let elt_nat = expr.info.type_description\r
+  and elt_nat' = expr'.info.type_description in\r
+  match elt_nat, elt_nat' with\r
+    | Types.ComponentElement cpnt_typ, Types.ComponentElement cpnt_typ' ->\r
+        resolve_connect_clause' cpnt_typ cpnt_typ'\r
+    | _, _ ->\r
+        raise (CompilError\r
+            {err_msg = ["_InvalidTypeOfArgInConnectStat"];\r
+             err_info =\r
+               [("_ExprKind", "connect(A, B)");\r
+                ("_TypeOfA", Types.string_of_element_nature elt_nat);\r
+                ("_TypeOfB", Types.string_of_element_nature elt_nat')];\r
+             err_ctx = ctx}) (*error*)\r
+\r
+and resolve_when_clause_e ctx equ alts =\r
+  let resolve_alternative (expr, equs) =\r
+    let expr' = resolve_expression ctx expr in\r
+    let rec check_equation equ =\r
+      let check_equal expr expr' =\r
+        match expr.Syntax.nature, expr'.Syntax.nature with\r
+        | _, _ when expression_of_variable expr -> true\r
+        | Syntax.Tuple exprs, Syntax.FunctionCall _\r
+            when List.for_all expression_of_variable exprs -> true\r
+        | _, _ -> raise (CompilError\r
+            {err_msg = ["_InvalidWhenEquation"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in\r
+      let check_alternative (expr, equs) =\r
+        List.for_all check_equation equs in\r
+      let check_function_call_e expr fun_args =\r
+        match expr.Syntax.nature with\r
+        | Syntax.Identifier "assert" |\r
+          Syntax.Identifier "terminate" |\r
+          Syntax.Identifier "reinit" -> true\r
+        | _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_InvalidWhenEquation"];\r
+               err_info = [];\r
+               err_ctx = {ctx with location = expr.Syntax.info}}) in\r
+      match equ.Syntax.nature with\r
+      | Syntax.Equal (expr, expr') -> check_equal expr expr'\r
+      | Syntax.ConditionalEquationE (alts, None) ->\r
+          List.for_all check_alternative alts\r
+      | Syntax.ConditionalEquationE (alts, Some equs) ->\r
+          (List.for_all check_alternative alts) &&\r
+          (List.for_all check_equation equs)\r
+      | Syntax.ForClauseE (for_inds, equs) ->\r
+          List.for_all check_equation equs\r
+      | Syntax.ConnectClause (expr, expr') ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidWhenEquation"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)\r
+      | Syntax.WhenClauseE alts ->\r
+          raise (CompilError\r
+            {err_msg = ["_WhenClausesCannotBeNested"];\r
+             err_info = [];\r
+             err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)\r
+      | Syntax.FunctionCallE (expr, fun_args) ->\r
+          check_function_call_e expr fun_args in\r
+    let resolve_alternative' cpnt_type =\r
+      let cl_spec = evaluate cpnt_type.Types.base_class in\r
+      match cl_spec with\r
+      | Types.ArrayType (Types.DiscreteDimension, _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidTypeOfWhenCond"];\r
+             err_info =\r
+               [("_ExprKind", "...when A then...");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = {ctx with location = expr.Syntax.info}}) (*error*)\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType } |\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType { Types.base_type = Types.BooleanType })\r
+              when List.for_all check_equation equs ->\r
+              let equs' = List.flatten (List.map (resolve_equation ctx) equs) in\r
+              expr', equs'\r
+      | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+        Types.ArrayType _ | Types.TupleType _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidTypeOfWhenCond"];\r
+             err_info =\r
+               [("_ExprKind", "...when A then...");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in\r
+    match expr'.info.type_description with\r
+    | Types.ComponentElement cpnt_type\r
+        when (evaluate cpnt_type.Types.variability) <> Types.Continuous ->\r
+          resolve_alternative' cpnt_type\r
+    | Types.ComponentElement cpnt_type ->\r
+        raise (CompilError\r
+          {err_msg = ["_WhenConditionMustBeDiscrete"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = expr.Syntax.info}}) (*error*)\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in\r
+  let alts' = List.map resolve_alternative alts in\r
+  [{\r
+    nature = WhenClauseE alts';\r
+    info = Some equ\r
+  }]\r
+\r
+and resolve_functional_call_e ctx equ expr fun_args =\r
+  let ctx = {ctx with location = equ.Syntax.info} in\r
+  let res =\r
+    let nat = Tuple []\r
+    and elt_nat = Types.empty_tuple_type Types.Constant in\r
+    resolved_expression None nat elt_nat in\r
+  let fun_call = resolve_function_call ctx None expr fun_args in\r
+  let resolve_functional_call_e cpnt_type =\r
+    let cl_spec = evaluate cpnt_type.Types.base_class in\r
+    match cl_spec with\r
+      | Types.TupleType [] ->\r
+          [{\r
+            nature = Equal (res, fun_call);\r
+            info = Some equ\r
+          }]\r
+      | _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_NonEmptyFuncCallUsedAsAnEqu"];\r
+             err_info =\r
+               [("_TypeOfFuncValue", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+  match fun_call.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> resolve_functional_call_e cpnt_type\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' =\r
+  let equivalent_types predef predef' =\r
+    match Types.compare_predefined_types predef predef',\r
+          Types.compare_predefined_types predef' predef with\r
+    | _, Types.NotRelated | Types.NotRelated, _ -> false\r
+    | _ -> true in\r
+  let rec equations' i subs cl_spec expr cl_spec' expr' =\r
+    match cl_spec, cl_spec' with\r
+      | Types.PredefinedType predef, Types.PredefinedType predef'\r
+          when equivalent_types predef predef' ->\r
+            [equation subs expr expr']\r
+      | Types.ComponentType cpnt_type, Types.ComponentType cpnt_type' ->\r
+          raise (CompilError\r
+            {err_msg = ["_NotYetImplemented"; "_ComponentTypeEqu"];\r
+             err_info = [];\r
+             err_ctx = ctx})\r
+      | Types.ClassType cl_type, Types.ClassType cl_type' ->\r
+          record_equations subs cl_type expr cl_type' expr'\r
+      | Types.ArrayType (dim, cl_spec), Types.ArrayType (dim', cl_spec') ->\r
+          [for_equation i subs dim cl_spec expr dim' cl_spec' expr']\r
+      | Types.TupleType cl_specs, Types.TupleType cl_specs' ->\r
+          [{\r
+            nature = Equal (expr, expr');\r
+            info = Some equ\r
+          }]\r
+      | (Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |\r
+         Types.TupleType _ | Types.ClassType _),\r
+        (Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |\r
+         Types.TupleType _ | Types.ClassType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_EquTermsNotOfTheSameType"];\r
+             err_info =\r
+               [("_ExprKind", "A = B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)\r
+  and for_equation i subs dim cl_spec expr dim' cl_spec' expr' =\r
+    match dim, dim' with\r
+      | Types.ConstantDimension n, Types.ConstantDimension n' when n <> n' ->\r
+          let type_A = Types.string_of_component_type cpnt_type\r
+          and type_B = Types.string_of_component_type cpnt_type' in\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimMismatchInEqu"];\r
+             err_info = [("_ExprKind", "A = B");\r
+                         ("_TypeOfA", type_A);\r
+                         ("_TypeOfB", type_B)];\r
+             err_ctx = ctx}) (*error*)\r
+      | (Types.ConstantDimension _ | Types.ParameterDimension),\r
+        (Types.ConstantDimension _ | Types.ParameterDimension) ->\r
+          let range = resolve_colon ctx expr (Int32.of_int i) dim in\r
+          let subs =\r
+            let nat = LoopVariable (i - 1)\r
+            and elt_nat = Types.integer_type Types.Constant in\r
+            resolved_expression None nat elt_nat :: subs in\r
+          let equs = equations' (i + 1) subs cl_spec expr cl_spec' expr' in\r
+          {\r
+            nature = ForClauseE ([range], equs);\r
+            info = Some equ\r
+          }\r
+      | (Types.ConstantDimension _ | Types.ParameterDimension |\r
+         Types.DiscreteDimension),\r
+        (Types.ConstantDimension _ | Types.ParameterDimension |\r
+         Types.DiscreteDimension) ->\r
+          let type_A = Types.string_of_component_type cpnt_type\r
+          and type_B = Types.string_of_component_type cpnt_type' in\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimMismatchInEqu"];\r
+             err_info = [("_ExprKind", "A = B");\r
+                         ("_TypeOfA", type_A);\r
+                         ("_TypeOfB", type_B)];\r
+             err_ctx = ctx}) (*error*)\r
+  and record_equations subs cl_type expr cl_type' expr' =\r
+    let named_elts = cl_type.Types.named_elements\r
+    and named_elts' = cl_type'.Types.named_elements in\r
+    let record_equations' expr expr' =\r
+      let class_spec_of_element_type elt_type =\r
+        let elt_type' = evaluate elt_type in\r
+        element_nature_class ctx elt_type'.Types.element_nature in\r
+      let record_equation (id, elt_type) =\r
+        let elt_type' =\r
+          try\r
+            List.assoc id named_elts'\r
+          with _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_EquTermsNotOfTheSameType"];\r
+               err_info =\r
+                 [("_ExprKind", "A = B");\r
+                  ("_TypeOfA", Types.string_of_component_type cpnt_type);\r
+                  ("_TypeOfB", Types.string_of_component_type cpnt_type')];\r
+               err_ctx = {ctx with location = equ.Syntax.info}}) (*error*) in\r
+        let cl_spec = class_spec_of_element_type elt_type\r
+        and cl_spec' = class_spec_of_element_type elt_type' in\r
+        let expr =\r
+          let nat = FieldAccess (expr, id)\r
+          and flow, var, inout =\r
+            type_prefixes_of_element_nature expr.info.type_description\r
+          and cl_spec = element_nature_class ctx expr.info.type_description in\r
+          let elt_nat =\r
+            element_field_type_nature ctx flow var inout cl_spec id in\r
+          resolved_expression None nat elt_nat\r
+        and expr' =\r
+          let nat = FieldAccess (expr', id)\r
+          and flow, var, inout =\r
+            type_prefixes_of_element_nature expr'.info.type_description\r
+          and cl_spec = element_nature_class ctx expr'.info.type_description in\r
+          let elt_nat =\r
+            element_field_type_nature ctx flow var inout cl_spec id in\r
+          resolved_expression None nat elt_nat in\r
+        equations' 1 [] cl_spec expr cl_spec' expr' in\r
+      List.flatten (List.map record_equation named_elts) in\r
+    match subs with\r
+      | [] -> record_equations' expr expr'\r
+      | subs ->\r
+          let expr =\r
+            let elt_nat = expr.info.type_description in\r
+            let nat = IndexedAccess (expr, subs)\r
+            and elt_nat' = scalar_element_nature elt_nat in\r
+            resolved_expression None nat elt_nat'\r
+          and expr' =\r
+            let elt_nat = expr'.info.type_description in\r
+            let nat = IndexedAccess (expr', subs)\r
+            and elt_nat' = scalar_element_nature elt_nat in\r
+            resolved_expression None nat elt_nat' in\r
+          record_equations' expr expr'\r
+  and equation subs expr expr' = match subs with\r
+    | [] -> resolved_equation (Some equ) expr expr'\r
+    | subs ->\r
+        let expr =\r
+          let elt_nat = expr.info.type_description in\r
+          let nat = IndexedAccess (expr, subs)\r
+          and elt_nat' = scalar_element_nature elt_nat in\r
+          resolved_expression None nat elt_nat'\r
+        and expr' =\r
+          let elt_nat = expr'.info.type_description in\r
+          let nat = IndexedAccess (expr', subs)\r
+          and elt_nat' = scalar_element_nature elt_nat in\r
+          resolved_expression None nat elt_nat' in\r
+        resolved_equation None expr expr' in\r
+  let cl_spec = evaluate cpnt_type.Types.base_class\r
+  and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+  equations' 1 [] cl_spec expr cl_spec' expr'\r
+\r
+and resolve_algorithm ctx algo =\r
+  let ctx = {ctx with location = algo.Syntax.info} in\r
+  match algo.Syntax.nature with\r
+    | Syntax.Assign _ |\r
+      Syntax.FunctionCallA _ |\r
+      Syntax.MultipleAssign _ |\r
+      Syntax.Break |\r
+      Syntax.Return |\r
+      Syntax.ConditionalEquationA _ |\r
+      Syntax.ForClauseA _ |\r
+      Syntax.WhileClause _ |\r
+      Syntax.WhenClauseA _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_AlgoClause"];\r
+           err_info = [];\r
+           err_ctx = ctx})\r
+\r
+and resolve_expression ctx expr =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  match expr.Syntax.nature with\r
+    | Syntax.BinaryOperation (kind, arg1, arg2) ->\r
+        resolve_binary_operation ctx expr kind arg1 arg2\r
+    | Syntax.End -> resolve_end ctx expr\r
+    | Syntax.False -> resolve_false ctx expr\r
+    | Syntax.FieldAccess (expr', id) -> resolve_field_access ctx expr expr' id\r
+    | Syntax.FunctionCall (expr', fun_args) ->\r
+        resolve_function_call ctx (Some expr) expr' fun_args\r
+    | Syntax.Identifier id -> resolve_identifier ctx expr id\r
+    | Syntax.If (alts, expr') -> resolve_if ctx expr alts expr'\r
+    | Syntax.IndexedAccess (expr', subs) ->\r
+        resolve_indexed_access ctx expr expr' subs\r
+    | Syntax.Integer s -> resolve_integer ctx expr s\r
+    | Syntax.MatrixConstruction exprss ->\r
+        resolve_matrix_construction ctx expr exprss\r
+    | Syntax.NoEvent expr' ->\r
+        resolve_no_event ctx expr expr'\r
+    | Syntax.Range (start, step, stop) ->\r
+        resolve_range ctx expr start step stop\r
+    | Syntax.Real s -> resolve_real ctx expr s\r
+    | Syntax.String s -> resolve_string ctx expr s\r
+    | Syntax.True -> resolve_true ctx expr\r
+    | Syntax.Tuple exprs -> resolve_tuple ctx expr exprs\r
+    | Syntax.UnaryOperation (kind, arg) ->\r
+        resolve_unuary_operation ctx expr kind arg\r
+    | Syntax.Vector vec_elts -> resolve_vector ctx expr vec_elts\r
+\r
+and resolve_binary_operation ctx expr kind arg1 arg2 =\r
+  let arg1' = resolve_expression ctx arg1\r
+  and arg2' = resolve_expression ctx arg2 in\r
+  let args' = apply_binary_coercions [ arg1'; arg2' ] in\r
+  let arg1' = List.nth args' 0\r
+  and arg2' = List.nth args' 1 in\r
+  match kind.Syntax.nature with\r
+    | Syntax.Plus -> resolve_addition ctx expr arg1' arg2'\r
+    | Syntax.And -> resolve_and ctx expr arg1' arg2'\r
+    | Syntax.Divide -> resolve_division ctx expr arg1' arg2'\r
+    | Syntax.EqualEqual -> raise (CompilError\r
+        {err_msg = ["_NotYetImplemented"; "_BinaryOperEQUEQU"];\r
+         err_info = [];\r
+         err_ctx = ctx})\r
+    | Syntax.GreaterEqual ->\r
+        resolve_comparison ctx expr GreaterEqual arg1' arg2'\r
+    | Syntax.Greater -> resolve_comparison ctx expr Greater arg1' arg2'\r
+    | Syntax.LessEqual -> resolve_comparison ctx expr LessEqual arg1' arg2'\r
+    | Syntax.Less -> resolve_comparison ctx expr Less arg1' arg2'\r
+    | Syntax.Times -> resolve_multiplication ctx expr arg1' arg2'\r
+    | Syntax.NotEqual -> raise (CompilError\r
+        {err_msg = ["_NotYetImplemented"; "_BinaryOperDIFF"];\r
+         err_info = [];\r
+         err_ctx = ctx})\r
+    | Syntax.Or -> resolve_or ctx expr arg1' arg2'\r
+    | Syntax.Power -> resolve_power ctx expr arg1' arg2'\r
+    | Syntax.Minus -> resolve_subtraction ctx expr arg1' arg2'\r
+\r
+and resolve_end ctx expr =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  match ctx.context_nature with\r
+    | SubscriptContext (_, _, _, Types.ConstantDimension n) ->\r
+        let nat = Integer n\r
+        and elt_nat = Types.integer_type Types.Constant in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | SubscriptContext (_, expr', n, Types.ParameterDimension) ->\r
+        size_function_call ctx (Some expr) expr' n\r
+    | SubscriptContext (_, expr', n, Types.DiscreteDimension) ->\r
+        size_function_call ctx (Some expr) expr' n\r
+    | ForContext (ctx', _, _) -> resolve_end ctx' expr\r
+    | ToplevelContext | ClassContext _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidKeyWordEndInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_false ctx expr =\r
+  resolved_expression (Some expr) False (Types.boolean_type Types.Constant)\r
+\r
+and resolve_field_access ctx expr expr' id =\r
+  let expr' = resolve_expression ctx expr' in\r
+  let resolve_field_access' expr' id =\r
+  let nat = FieldAccess (expr', id)\r
+  and flow, var, inout =\r
+    type_prefixes_of_element_nature expr'.info.type_description\r
+  and cl_spec = element_nature_class ctx expr'.info.type_description in\r
+  let elt_nat = element_field_type_nature ctx flow var inout cl_spec id in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  let is_package cl_spec = match evaluate cl_spec with\r
+    | Types.ClassType cl_type\r
+      when evaluate cl_type.Types.kind = Types.Package -> true\r
+    | _ -> false in\r
+  match expr'.info.type_description with\r
+  | Types.ComponentElement _  ->\r
+      resolve_field_access' expr' id\r
+  | Types.ClassElement cl_spec when is_package cl_spec ->\r
+      resolve_field_access' expr' id\r
+  | _ ->\r
+      raise (CompilError\r
+        {err_msg = ["component or package"; "_ElemExpected"];\r
+         err_info = [];\r
+         err_ctx = { ctx with location = expr.Syntax.info }}) (*error*)\r
+\r
+and type_prefixes_of_element_nature = function\r
+  | Types.ComponentElement cpnt_type ->\r
+      evaluate cpnt_type.Types.flow,\r
+      evaluate cpnt_type.Types.variability,\r
+      evaluate cpnt_type.Types.causality\r
+  | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+    Types.PredefinedTypeElement _ ->\r
+      false, Types.Constant, Types.Acausal\r
+\r
+and resolve_function_call ctx syn expr fun_args =\r
+  let ctx = {ctx with location = expr.Syntax.info} in\r
+  let expr' = resolve_expression ctx expr in\r
+  let resolve_function_arguments named_elts =\r
+    let reversed_additional_dimensions input_types args =\r
+      let additional_named_element_dimensions id arg =\r
+        let rec subtract_dimensions fun_dims arg_dims =\r
+          match fun_dims, arg_dims with\r
+            | [], _ ->  arg_dims\r
+            | _, [] ->\r
+                raise (CompilError\r
+                  {err_msg = ["_ArgDimMismatch"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | Types.ConstantDimension i :: _, Types.ConstantDimension i' :: _\r
+              when i <> i' ->\r
+                raise (CompilError\r
+                  {err_msg = ["_ArgDimMismatch"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*)\r
+            | _ :: fun_dims, _ :: arg_dims ->\r
+                subtract_dimensions fun_dims arg_dims in\r
+        let elt_type = List.assoc id input_types in\r
+        let elt_type' = evaluate elt_type in\r
+        let fun_dims =\r
+          Types.reversed_element_dimensions elt_type'.Types.element_nature\r
+        and arg_dims =\r
+          Types.reversed_element_dimensions arg.info.type_description in\r
+        subtract_dimensions fun_dims arg_dims in\r
+      let rec reversed_additional_dimensions' ids dims args =\r
+        match args with\r
+          | [] -> ids, dims\r
+          | (id, arg) :: args ->\r
+              let dims' = additional_named_element_dimensions id arg in\r
+              update_additional_dimensions ids dims id dims' args\r
+      and update_additional_dimensions ids dims id dims' args =\r
+        match dims, dims' with\r
+          | _, [] -> reversed_additional_dimensions' ids dims args\r
+          | [], _ :: _ ->\r
+              let ids' = id :: ids in\r
+              reversed_additional_dimensions' ids' dims' args\r
+          | _ :: _, _ :: _ when dims <> dims' ->\r
+              raise (CompilError\r
+                {err_msg = ["_ArgDimMismatchInVectCall"];\r
+                 err_info = [];\r
+                 err_ctx = ctx}) (*error*)\r
+          | _ :: _, _ :: _ ->\r
+              let ids' = id :: ids in\r
+              reversed_additional_dimensions' ids' dims args in\r
+      reversed_additional_dimensions' [] [] args in\r
+    let function_call ids rev_dims input_types output_types args =\r
+      let ndims = List.length rev_dims in\r
+      let rec expressions_of_named_arguments pos input_types =\r
+        let expression_of_default_argument id elt_type =\r
+          let elt_type' = evaluate elt_type in\r
+          let func =\r
+            let nat = FunctionArgument 0\r
+            and elt_nat = expr'.info.type_description in\r
+            resolved_expression None nat elt_nat in\r
+          let nat = FieldAccess (func, id)\r
+          and elt_nat = elt_type'.Types.element_nature in\r
+          resolved_expression None nat elt_nat\r
+        and expression_of_named_argument pos id elt_type =\r
+          let rec loop_variables = function\r
+            | 0 -> []\r
+            | ndims ->\r
+                let nat = LoopVariable (ndims - 1)\r
+                and elt_nat = (Types.integer_type Types.Constant) in\r
+                let loop_var = resolved_expression None nat elt_nat in\r
+                loop_var :: loop_variables (ndims - 1) in\r
+          let elt_type' = evaluate elt_type in\r
+          let elt_nat = elt_type'.Types.element_nature in\r
+          let nat = match List.mem id ids with\r
+            | false -> FunctionArgument pos\r
+            | true ->\r
+                let arg = List.assoc id args in\r
+                let nat = FunctionArgument pos\r
+                and elt_nat = arg.info.type_description in\r
+                let expr = resolved_expression None nat elt_nat in\r
+                IndexedAccess (expr, loop_variables ndims) in\r
+          resolved_expression None nat elt_nat in\r
+        match input_types with\r
+          | [] -> []\r
+          | (id, elt_type) :: input_types when not (List.mem_assoc id args) ->\r
+              let arg = expression_of_default_argument id elt_type in\r
+              arg :: expressions_of_named_arguments pos input_types\r
+          | (id, elt_type) :: input_types ->\r
+              let arg = expression_of_named_argument pos id elt_type in\r
+              arg :: expressions_of_named_arguments (pos + 1) input_types in\r
+      let ranges arg rev_dims =\r
+        let rec ranges' acc n rev_dims =\r
+          let range_of_dimension dim =\r
+            let range_to stop =\r
+              let nat = Range (one, one, stop)\r
+              and elt_nat = Types.integer_array_type Types.Constant dim in\r
+              resolved_expression None nat elt_nat in\r
+            match dim with\r
+              | Types.ConstantDimension i ->\r
+                  let stop =\r
+                    let nat = Integer i\r
+                    and elt_nat = (Types.integer_type Types.Constant) in\r
+                    resolved_expression None nat elt_nat in\r
+                  range_to stop\r
+              | Types.ParameterDimension ->\r
+                  let stop = size_function_call ctx None arg n in\r
+                  range_to stop\r
+              | Types.DiscreteDimension ->\r
+                  let stop = size_function_call ctx None arg n in\r
+                  range_to stop in\r
+          match rev_dims with\r
+            | [] -> acc\r
+            | dim :: rev_dims ->\r
+                let range = range_of_dimension dim in\r
+                ranges' (range :: acc) (Int32.succ n) rev_dims in\r
+        ranges' [] 1l rev_dims in\r
+      let rec sorted_arguments_of_named_arguments = function\r
+        | [] -> []\r
+        | (id, _) :: input_types when not (List.mem_assoc id args) ->\r
+            sorted_arguments_of_named_arguments input_types\r
+        | (id, _) :: input_types ->\r
+            let arg = List.assoc id args in\r
+            arg :: sorted_arguments_of_named_arguments input_types in\r
+      let wrap_function_invocation cpnt_type =\r
+        let add_dimensions cpnt_type =\r
+          let rec add_dimensions cl_spec = function\r
+            | [] -> cl_spec\r
+            | dim :: rev_dims ->\r
+                let cl_spec' = Types.ArrayType (dim, cl_spec) in\r
+                add_dimensions cl_spec' rev_dims in\r
+          let base_class = cpnt_type.Types.base_class in\r
+          { cpnt_type with\r
+            Types.base_class =\r
+              lazy (add_dimensions (evaluate base_class) rev_dims)\r
+          } in\r
+        let wrap_function_invocation' cpnt_type rev_dims =\r
+          let nat =\r
+            let exprs = expressions_of_named_arguments 1 input_types in\r
+            FunctionInvocation exprs\r
+          and elt_nat = Types.ComponentElement cpnt_type in\r
+          match ids with\r
+            | [] ->\r
+                resolved_expression syn nat elt_nat\r
+            | id :: _ ->\r
+                let cpnt_type' = add_dimensions cpnt_type in\r
+                let nat =\r
+                  let ranges =\r
+                    let arg = List.assoc id args in\r
+                    ranges arg rev_dims\r
+                  and expr = resolved_expression None nat elt_nat in\r
+                  VectorReduction (ranges, expr)\r
+                and elt_nat = Types.ComponentElement cpnt_type' in\r
+                resolved_expression None nat elt_nat in\r
+        wrap_function_invocation' cpnt_type rev_dims in\r
+      let component_type_of_output_types output_types =\r
+        let component_type_of_output_type cpnt_type (_, elt_type) =\r
+          let add_class_specifier cl_spec cl_spec' =\r
+            match cl_spec, cl_spec' with\r
+            | Types.TupleType [], _ -> cl_spec'\r
+            | (Types.TupleType cl_specs), _ ->\r
+                Types.TupleType (cl_spec' :: cl_specs)\r
+            | _, _ -> Types.TupleType [cl_spec'; cl_spec] in\r
+          let var = evaluate cpnt_type.Types.variability\r
+          and cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let elt_type' = evaluate elt_type in\r
+          match elt_type'.Types.element_nature with\r
+            | Types.ComponentElement cpnt_type' ->\r
+                let var' = evaluate cpnt_type'.Types.variability\r
+                and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+                {\r
+                  Types.flow = lazy false;\r
+                  Types.variability = lazy (Types.max_variability var var');\r
+                  Types.causality = lazy Types.Acausal;\r
+                  Types.base_class = lazy (add_class_specifier cl_spec cl_spec')\r
+                }\r
+            | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+              Types.PredefinedTypeElement _ ->\r
+                raise (CompilError\r
+                  {err_msg = ["_ClassElemFoundInExpr"];\r
+                   err_info = [];\r
+                   err_ctx = ctx}) (*error*) in\r
+        let cpnt_type =\r
+          {\r
+            Types.flow = lazy false;\r
+            Types.variability = lazy Types.Constant;\r
+            Types.causality = lazy Types.Acausal;\r
+            Types.base_class = lazy (Types.TupleType [])\r
+          } in\r
+        List.fold_left component_type_of_output_type cpnt_type output_types in\r
+      let args' = sorted_arguments_of_named_arguments input_types\r
+      and cpnt_type = component_type_of_output_types output_types in\r
+      let func_invoc = wrap_function_invocation cpnt_type in\r
+      let nat = FunctionCall (expr', args', func_invoc)\r
+      and elt_nat = func_invoc.info.type_description in\r
+      resolved_expression syn nat elt_nat in\r
+    let resolve_function_arguments' fun_args =\r
+      match fun_args.Syntax.nature with\r
+      | Syntax.Reduction _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_NotYetImplemented"; "_FuncArgumentReduction"];\r
+             err_info = [];\r
+             err_ctx = ctx})\r
+      | Syntax.ArgumentList args ->\r
+          let input_types, output_types, named_args =\r
+              resolve_function_argument_list ctx expr' named_elts args in\r
+          let ids, rev_dims =\r
+            reversed_additional_dimensions input_types named_args in\r
+          function_call ids rev_dims input_types output_types named_args in\r
+    match fun_args with\r
+      | None ->\r
+          let fun_args = { Syntax.nature = Syntax.ArgumentList [];\r
+                           Syntax.info = ctx.location } in\r
+          resolve_function_arguments' fun_args\r
+      | Some fun_args -> resolve_function_arguments' fun_args in\r
+  let resolve_class_function_call cl_type =\r
+    match evaluate cl_type.Types.kind with\r
+    | Types.Function ->\r
+        resolve_function_arguments cl_type.Types.named_elements\r
+    | Types.Class | Types.Model | Types.Block | Types.Record |\r
+      Types.ExpandableConnector | Types.Connector | Types.Package ->\r
+        raise (CompilError\r
+          {err_msg = ["function"; "_ElemExpected"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+  let resolve_function_call' cl_spec =\r
+    match evaluate cl_spec with\r
+    | Types.ClassType cl_type ->\r
+        resolve_class_function_call cl_type\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["function"; "_ElemExpected"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+  match expr'.info.type_description with\r
+  | Types.ClassElement cl_spec -> resolve_function_call' cl_spec\r
+  | Types.ComponentElement cpnt_type ->\r
+      let cl_spec = cpnt_type.Types.base_class in\r
+      resolve_function_call' cl_spec\r
+  | Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->\r
+      raise (CompilError\r
+        {err_msg = ["function"; "_ElemExpected"];\r
+         err_info = [];\r
+         err_ctx = ctx}) (*error*)\r
+\r
+and resolve_function_argument_list ctx expr' named_elts args =\r
+  let rec class_kind ctx =\r
+    let class_context' cl_spec = match cl_spec with\r
+      | Types.ClassType cl_type ->\r
+          Some (evaluate cl_type.Types.kind)\r
+      | _ -> None in\r
+    match ctx.context_nature with\r
+    | ClassContext cl_def ->\r
+        class_context' (evaluate cl_def.class_type)\r
+    | SubscriptContext (ctx, _, _, _) | ForContext (ctx, _, _) ->\r
+        class_kind ctx\r
+    | _ -> None in\r
+  let add_function_inout_argument ((id, elt_type) as named_elt) inouts =\r
+    let add_function_inout_argument' cpnt_type =\r
+      match inouts, evaluate cpnt_type.Types.causality with\r
+      | (ins, outs), Types.Input -> named_elt :: ins, outs\r
+      | (ins, outs), Types.Output -> ins, named_elt :: outs\r
+      | _, Types.Acausal -> inouts in\r
+    let elt_type' = evaluate elt_type in\r
+    match elt_type'.Types.element_nature with\r
+      | Types.ComponentElement cpnt_type when not elt_type'.Types.protected ->\r
+          add_function_inout_argument' cpnt_type\r
+      | _ -> inouts in\r
+  let add_argument id arg arg' elt_type acc =\r
+    let matchable_types cpnt_type cpnt_type' =\r
+      let cl_spec = evaluate cpnt_type.Types.base_class\r
+      and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+      let rec matchable_types' cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+        | Types.ArrayType (dim, cl_spec), _ ->\r
+            matchable_types' cl_spec cl_spec'\r
+        | _, Types.ArrayType (dim', cl_spec') ->\r
+            matchable_types' cl_spec cl_spec'\r
+        | _, _ ->\r
+            let type_compare = Types.compare_specifiers cl_spec cl_spec' in\r
+            (type_compare = Types.SameType) ||\r
+            (type_compare = Types.Supertype) in\r
+      matchable_types' cl_spec cl_spec' in\r
+    let matchable_variabilities cpnt_type cpnt_type' =\r
+      let var = evaluate cpnt_type.Types.variability\r
+      and var' = evaluate cpnt_type'.Types.variability in\r
+      Types.higher_variability var var' in\r
+    let elt_type = evaluate elt_type in\r
+    let cpnt_type = match elt_type.Types.element_nature with\r
+      | Types.ComponentElement cpnt_type -> cpnt_type\r
+      | _ -> assert false in\r
+    let arg' = apply_rhs_coercions cpnt_type arg' in\r
+    match arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type'\r
+        when not (matchable_types cpnt_type cpnt_type') ->\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info =\r
+             [("_ExpectedType", Types.string_of_component_type cpnt_type);\r
+              ("_TypeFound", Types.string_of_component_type cpnt_type')];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | Types.ComponentElement cpnt_type'\r
+        when not (matchable_variabilities cpnt_type cpnt_type') ->\r
+        let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        let var = Types.string_of_variability var\r
+        and var' = Types.string_of_variability var' in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgVariabilityMismatch"];\r
+           err_info = [("_ExpectedVariability", var);\r
+                       ("_VariabilityFound", var')];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | Types.ComponentElement cpnt_type' -> (id, arg') :: acc\r
+    | _ -> raise (CompilError\r
+        {err_msg = ["_ClassElemFoundInExpr"];\r
+         err_info = [];\r
+         err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in\r
+  let named_arguments_of_arguments input_types args =\r
+    let rec add_positional_arguments acc input_types args =\r
+      match input_types, args with\r
+      | [], [] -> acc\r
+      | [], _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_TooManyArgsInFuncCall"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, [] ->\r
+          raise (CompilError\r
+            {err_msg = ["_TooFewArgsInFuncCall"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | (id, elt_type) :: input_types,\r
+        { Syntax.nature = Syntax.Argument arg } :: args ->\r
+          let arg' = resolve_expression ctx arg in\r
+          let acc = add_argument id arg arg' elt_type acc in\r
+          add_positional_arguments acc input_types args\r
+      | _, { Syntax.nature = Syntax.NamedArgument _ } :: _ ->\r
+          add_named_arguments acc input_types args\r
+    and add_named_arguments acc input_types args =\r
+      match input_types, args with\r
+      | [], [] -> acc\r
+      | [], _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_TooManyArgsInFuncCall"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, [] ->\r
+          raise (CompilError\r
+            {err_msg = ["_TooFewArgsInFuncCall"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, { Syntax.nature = Syntax.Argument _ } :: _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_MixedPositAndNamedFuncArgPass"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, { Syntax.nature = Syntax.NamedArgument (id, _) } :: _\r
+          when List.mem_assoc id acc ->\r
+            raise (CompilError\r
+              {err_msg = ["_FuncCallWithDuplicateArg"; id];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*)\r
+      | _, { Syntax.nature = Syntax.NamedArgument (id, _) } :: _\r
+          when not (List.mem_assoc id input_types) ->\r
+            raise (CompilError\r
+              {err_msg = ["_NonInputFuncArgElem"; id];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*)\r
+      | _, { Syntax.nature = Syntax.NamedArgument (id, arg) } :: args ->\r
+          let arg' = resolve_expression ctx arg\r
+          and elt_type = List.assoc id input_types in\r
+          let acc = add_argument id arg arg' elt_type acc in\r
+          add_named_arguments acc input_types args in\r
+    add_positional_arguments [] input_types args in\r
+  let resolve_built_in_function_argument arg = match arg with\r
+    | { Syntax.nature = Syntax.Argument arg } ->\r
+        arg, (resolve_expression ctx arg)\r
+    | { Syntax.nature = Syntax.NamedArgument _; Syntax.info = info } ->\r
+        raise (CompilError\r
+          {err_msg = ["_CannotUseNamedArgWithBuiltInOper"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = info}}) (*error*) in\r
+  let rec built_in_function_named_arguments acc input_types args' =\r
+    match input_types, args' with\r
+    | [], [] -> acc\r
+    | [], _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_TooManyArgsInFuncCall"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | _, [] ->\r
+        raise (CompilError\r
+          {err_msg = ["_TooFewArgsInFuncCall"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | (id, elt_type) :: input_types, (arg, arg') :: args' ->\r
+        let acc = add_argument id arg arg' elt_type acc in\r
+        built_in_function_named_arguments acc input_types args' in\r
+  let built_in_function_inout_types ctx id (in_types, out_types) args' =\r
+    let argument_component_type (arg, arg') =\r
+      match arg'.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          cpnt_type\r
+      | _ -> raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in\r
+    let scalar_base_class_specifier (arg, arg') =\r
+      let rec scalar_base_class_specifier' cl_spec = match cl_spec with\r
+        | Types.ArrayType (dim, cl_spec) -> scalar_base_class_specifier' cl_spec\r
+        | _ -> cl_spec in\r
+      let cpnt_type = argument_component_type (arg, arg') in\r
+      let cl_spec = evaluate cpnt_type.Types.base_class in\r
+      scalar_base_class_specifier' cl_spec in\r
+    let argument_base_type bt (arg, arg') =\r
+      let cl_spec = scalar_base_class_specifier (arg, arg') in\r
+      match cl_spec with\r
+      | Types.PredefinedType predef when predef.Types.base_type = bt -> true\r
+      | _ -> false in\r
+    let argument_base_types bt args =\r
+      List.for_all (argument_base_type bt) args in\r
+    let argument_variability var (arg, arg') =\r
+      let cpnt_type = argument_component_type (arg, arg') in\r
+      let var' = evaluate cpnt_type.Types.variability in\r
+      var = var' in\r
+    let neg f = function x -> not (f x) in\r
+    let ndims arg' =\r
+      let cpnt_type = component_type_of_expression ctx arg' in\r
+      let rec ndims' cl_spec =\r
+        match cl_spec with\r
+        | Types.ArrayType (dim, cl_spec) -> ndims' cl_spec + 1\r
+        | _ -> 0 in\r
+      ndims' (evaluate cpnt_type.Types.base_class) in\r
+    let numeric_base_type arg' =\r
+      let cl_spec = scalar_class_specifier ctx arg' in\r
+      (Types.compare_specifiers Types.integer_class_type cl_spec =\r
+         Types.SameType) ||\r
+      (Types.compare_specifiers Types.real_class_type cl_spec =\r
+         Types.SameType) in\r
+    let rec argument_types i args = match args with\r
+      | [] -> []\r
+      | (arg, arg') :: args ->\r
+          let cpnt_type = component_type_of_expression ctx arg'\r
+          and name = Printf.sprintf "@%d" i in\r
+          (name, cpnt_type) :: (argument_types (i + 1) args) in\r
+    let element_types input_types output_types =\r
+      let element_type inout (id, cpnt_type) =\r
+        (id,\r
+         lazy\r
+           {\r
+             Types.protected = false;\r
+             Types.final = true;\r
+             Types.replaceable = false;\r
+             Types.dynamic_scope = None;\r
+             Types.element_nature =\r
+               Types.ComponentElement\r
+                 { cpnt_type with Types.causality = lazy inout }\r
+           }) in\r
+     (List.map (element_type Types.Input) input_types),\r
+     (List.map (element_type Types.Output) output_types) in\r
+    match id, args' with\r
+    | ("der" | "initial" | "terminal" | "sample" | "pre" | "edge" | "change" |\r
+       "reinit" | "delay"), _ when (class_kind ctx) = Some Types.Function ->\r
+        raise (CompilError\r
+          {err_msg = [id; "_OperCannotBeUsedWithinFuncDef"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | ("pre" | "edge" | "change"), [arg, arg'] | "reinit", [(arg, arg'); _]\r
+        when not (expression_of_variable arg) ->\r
+        raise (CompilError\r
+          {err_msg = [id; "_OperArgMustBeAVar"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | ("ceil" | "floor" | "integer" | "der"), [arg, arg'] |\r
+      "reinit", [(arg, arg'); _] |\r
+      "smooth", [_; (arg, arg')]\r
+        when not (argument_base_type Types.RealType (arg, arg')) ->\r
+        let cl_spec = scalar_base_class_specifier (arg, arg') in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info =\r
+             [("_ExpectedType", "Real");\r
+              ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | "delay", _\r
+        when not (List.for_all (argument_base_type Types.RealType) args') ->\r
+        let (arg, arg') =\r
+          List.find (neg (argument_base_type Types.RealType)) args' in\r
+        let cl_spec = scalar_base_class_specifier (arg, arg') in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info =\r
+             [("_ExpectedType", "Real");\r
+              ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | "der", [arg, arg']\r
+        when not (argument_variability Types.Continuous (arg, arg')) ->\r
+        let cpnt_type = argument_component_type (arg, arg') in\r
+        let var = evaluate cpnt_type.Types.variability in\r
+        let var = Types.string_of_variability var in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgVariabilityMismatch"];\r
+           err_info = [("_ExpectedVariability", "Continuous");\r
+                       ("_VariabilityFound", var)];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | "delay", _ when List.length args' = 3 ->\r
+        let input_types =\r
+          [("@1", Types.real_component_type Types.Continuous);\r
+           ("@2", Types.real_component_type Types.Continuous);\r
+           ("@3", Types.real_component_type Types.Parameter)]\r
+        and output_types =\r
+          ["@4", Types.real_component_type Types.Continuous] in\r
+        element_types input_types output_types\r
+    | "abs", [arg, arg']\r
+        when argument_base_type Types.IntegerType (arg, arg') ->\r
+        let input_types = ["@1", Types.integer_component_type Types.Discrete]\r
+        and output_types =\r
+          ["@2", Types.integer_component_type Types.Discrete] in\r
+        element_types input_types output_types\r
+    | ("ones" | "zeros"), _\r
+      when not (argument_base_types Types.IntegerType args') ->\r
+        let (arg, arg') =\r
+          List.find (neg (argument_base_type Types.IntegerType)) args' in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | "fill", _ :: args'\r
+      when not (argument_base_types Types.IntegerType args') ->\r
+        let (arg, arg') =\r
+          List.find (neg (argument_base_type Types.IntegerType)) args' in\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | ("sum" | "product" | "max" | "min" | "scalar"), [arg, arg']\r
+      when ndims arg' = 0 ->\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | "diagonal", [arg, arg']\r
+      when ndims arg' <> 1 ->\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | ("scalar"), [arg, arg'] ->\r
+        let cpnt_type = component_type_of_expression ctx arg' in\r
+        let input_types = ["@1", cpnt_type]\r
+        and output_types =\r
+          ["@2", Types.scalar_component_type cpnt_type ] in\r
+        element_types input_types output_types\r
+    | ("sum" | "product" | "max" | "min" | "diagonal"), [arg, arg']\r
+      when not (numeric_base_type arg') ->\r
+        raise (CompilError\r
+          {err_msg = ["_ArgTypeMismatch"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)\r
+    | ("sum" | "product" | "max" | "min"), [arg, arg'] ->\r
+        let cpnt_type = component_type_of_expression ctx arg' in\r
+        let input_types = ["@1", cpnt_type]\r
+        and output_types =\r
+          ["@2", Types.scalar_component_type cpnt_type ] in\r
+        element_types input_types output_types\r
+    | ("ones" | "zeros"), _ :: _ ->\r
+        let input_types = argument_types 1 args'\r
+        and output_types =\r
+          let n = List.length args'\r
+          and dims =\r
+            List.map (function _ -> Types.ParameterDimension) args' in\r
+          let cpnt_type =\r
+            { \r
+              Types.flow = lazy false;\r
+              variability = lazy Types.Parameter;\r
+              Types.causality = lazy Types.Acausal;\r
+              base_class =\r
+                lazy(Types.add_dimensions dims Types.integer_class_type)\r
+            } in\r
+          [ Printf.sprintf "@%d" (n + 1), cpnt_type ] in\r
+        element_types input_types output_types\r
+    | "fill", (arg, arg') :: (_ :: _ as args) ->\r
+        let input_types = argument_types 1 args'\r
+        and output_types =\r
+          let n = List.length args\r
+          and dims =\r
+            List.map (function _ -> Types.ParameterDimension) args in\r
+          let cpnt_type = component_type_of_expression ctx arg' in\r
+          let lcl_spec = lazy\r
+            (Types.add_dimensions\r
+              dims \r
+              (evaluate cpnt_type.Types.base_class)) in\r
+          [ \r
+            Printf.sprintf "@%d" (n + 1),\r
+            { cpnt_type with Types.base_class = lcl_spec }\r
+          ] in\r
+        element_types input_types output_types\r
+    | "diagonal", [ arg, arg' ] ->\r
+        let cpnt_type = component_type_of_expression ctx arg' in\r
+        let input_types = [ "@1", cpnt_type ]\r
+        and output_types =\r
+          let dims = [ Types.ParameterDimension ] in\r
+          let lcl_spec = lazy\r
+            (Types.add_dimensions\r
+              dims\r
+              (evaluate cpnt_type.Types.base_class)) in\r
+          [ "@2", { cpnt_type with Types.base_class = lcl_spec } ] in\r
+        element_types input_types output_types\r
+    | ("div" | "mod" | "rem" | "max" | "min"), _\r
+        when List.for_all (argument_base_type Types.IntegerType) args' ->\r
+        let input_types =\r
+          [\r
+            "@1", Types.integer_component_type Types.Discrete;\r
+            "@2", Types.integer_component_type Types.Discrete\r
+          ]\r
+        and output_types =\r
+          ["@3", Types.integer_component_type Types.Discrete] in\r
+        element_types input_types output_types\r
+    | ("pre" | "change"), [arg, arg'] ->\r
+        let cpnt_type = argument_component_type (arg, arg') in\r
+        let input_types =\r
+          ["@1", { cpnt_type with Types.variability = lazy Types.Continuous }]\r
+        and output_types =\r
+          ["@2", { cpnt_type with Types.variability = lazy Types.Discrete }] in\r
+        element_types input_types output_types\r
+    | _, _ -> in_types, out_types in\r
+  match expr'.nature with\r
+  | PredefinedIdentifier id ->\r
+      let args' = List.map resolve_built_in_function_argument args in\r
+      let input_types, output_types =\r
+        let inout_types =\r
+          List.fold_right add_function_inout_argument named_elts ([], []) in\r
+        built_in_function_inout_types ctx id inout_types args' in\r
+      let named_args =\r
+        built_in_function_named_arguments [] input_types args' in\r
+      input_types, output_types, named_args\r
+  | _ ->\r
+      let input_types, output_types =\r
+        List.fold_right add_function_inout_argument named_elts ([], []) in\r
+      let named_args = named_arguments_of_arguments input_types args in\r
+      input_types, output_types, named_args\r
+\r
+and resolve_identifier ctx expr id =\r
+  let rec resolve_predefined_identifier ctx expr id = match id with\r
+    | "Boolean" ->\r
+        let nat = PredefinedIdentifier "Boolean"\r
+        and elt_nat = Types.ClassElement (lazy (Types.boolean_class_type)) in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "Integer" ->\r
+        let nat = PredefinedIdentifier "Integer"\r
+        and elt_nat = Types.ClassElement (lazy (Types.integer_class_type)) in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "Real" ->\r
+        let nat = PredefinedIdentifier "Real"\r
+        and elt_nat = Types.ClassElement (lazy (Types.real_class_type)) in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "String" ->\r
+        let nat = PredefinedIdentifier "String"\r
+        and elt_nat = Types.ClassElement (lazy (Types.string_class_type)) in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "reinit" ->\r
+        let nat = PredefinedIdentifier "reinit"\r
+        and elt_nat =\r
+          let inputs =\r
+            ["@1", Types.real_component_type Types.Continuous;\r
+             "@2", Types.real_component_type Types.Continuous]\r
+          and outputs = [] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "time" ->\r
+        let nat = PredefinedIdentifier "time"\r
+        and elt_nat = Types.real_type Types.Continuous in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "pre" | "change" ->\r
+        let nat = PredefinedIdentifier "pre"\r
+        and elt_nat =\r
+          let inputs = ["@1", Types.real_component_type Types.Continuous]\r
+          and outputs = ["@2", Types.real_component_type Types.Discrete] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "edge" ->\r
+        let nat = PredefinedIdentifier "edge"\r
+        and elt_nat =\r
+          let inputs = ["@1", Types.boolean_component_type Types.Discrete]\r
+          and outputs = ["@2", Types.boolean_component_type Types.Discrete] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "initial" ->\r
+        let nat = PredefinedIdentifier "initial"\r
+        and elt_nat =\r
+          let inputs = []\r
+          and outputs = [] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "terminal" ->\r
+        let nat = PredefinedIdentifier "terminal"\r
+        and elt_nat =\r
+          let inputs = []\r
+          and outputs = [] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "sample" ->\r
+        let nat = PredefinedIdentifier "sample"\r
+        and elt_nat =\r
+          let inputs = [("@1", Types.real_component_type Types.Parameter);\r
+                        ("@2", Types.real_component_type Types.Parameter)]\r
+          and outputs = ["@3", Types.boolean_component_type Types.Parameter] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "delay" ->\r
+        let nat = PredefinedIdentifier "delay"\r
+        and elt_nat =\r
+          let inputs = [("@1", Types.real_component_type Types.Continuous);\r
+                        ("@2", Types.real_component_type Types.Parameter)]\r
+          and outputs = ["@3", Types.real_component_type Types.Continuous] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "assert" ->\r
+        let nat = PredefinedIdentifier "assert"\r
+        and elt_nat =\r
+          let inputs = [("@1", Types.boolean_component_type Types.Discrete);\r
+                        ("@2", Types.string_component_type Types.Discrete)]\r
+          and outputs = [] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "terminate" ->\r
+        let nat = PredefinedIdentifier "terminate"\r
+        and elt_nat =\r
+          let inputs = [("@1", Types.string_component_type Types.Discrete)]\r
+          and outputs = [] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "abs" | "cos" | "sin" | "tan" | "exp" | "log" | "sqrt" |\r
+      "asin" | "acos" | "atan" | "sinh" | "cosh" | "tanh" | "asinh" |\r
+      "acosh" | "atanh" | "log10" | "ceil" | "floor" | "der" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs = ["@1", Types.real_component_type Types.Continuous]\r
+          and outputs = ["@2", Types.real_component_type Types.Continuous] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "sign" | "integer" | "ones" | "zeros" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs = ["@1", Types.real_component_type Types.Continuous]\r
+          and outputs = ["@2", Types.integer_component_type Types.Discrete] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "max" | "min" | "div" | "mod" | "rem" | "fill" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs =\r
+            [\r
+              "@1", Types.real_component_type Types.Continuous;\r
+              "@2", Types.real_component_type Types.Continuous\r
+            ]\r
+          and outputs = ["@3", Types.real_component_type Types.Continuous] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "smooth" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs =\r
+            [\r
+              "@1", Types.integer_component_type Types.Discrete;\r
+              "@2", Types.real_component_type Types.Continuous\r
+            ]\r
+          and outputs = ["@3", Types.real_component_type Types.Continuous] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "identity" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs = [ "@1", Types.integer_component_type Types.Parameter ]\r
+          and outputs =\r
+            let dims =\r
+              [Types.ParameterDimension; Types.ParameterDimension] in\r
+            [ \r
+              "@2",\r
+              Types.integer_array_component_type Types.Parameter dims\r
+            ] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "diagonal" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs =\r
+            let dim = [ Types.ParameterDimension ] in\r
+            [ "@1", Types.integer_array_component_type Types.Parameter dim ]\r
+          and outputs =\r
+            let dims =\r
+              [Types.ParameterDimension; Types.ParameterDimension] in\r
+            [ \r
+              "@2",\r
+              Types.integer_array_component_type Types.Parameter dims\r
+            ] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | "sum" | "product" | "scalar" ->\r
+        let nat = PredefinedIdentifier id\r
+        and elt_nat =\r
+          let inputs =\r
+            let dim = [ Types.DiscreteDimension ] in\r
+              [ "@1", Types.integer_array_component_type Types.Discrete dim ]\r
+          and outputs = ["@2", Types.integer_component_type Types.Discrete] in\r
+          Types.function_type inputs outputs in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | _ -> raise (CompilError\r
+        {err_msg = ["_UnknownIdentifier"; id];\r
+         err_info = [];\r
+         err_ctx = ctx})\r
+  and search_in_toplevel dic =\r
+    try\r
+      let elt_desc = List.assoc id (evaluate dic) in\r
+      let elt_type = evaluate elt_desc.element_type in\r
+      match elt_type.Types.dynamic_scope with\r
+        | None | Some Types.Inner ->\r
+            let nat = ToplevelIdentifier id in\r
+            resolved_expression (Some expr) nat elt_type.Types.element_nature\r
+        | Some Types.Outer | Some Types.InnerOuter ->\r
+            raise (CompilError\r
+              {err_msg = ["_NoInnerDeclForOuterElem"; id];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*)\r
+    with Not_found -> resolve_predefined_identifier ctx expr id\r
+  and search_in_class level cl_def = match evaluate cl_def.class_type with\r
+    | Types.ClassType cl_type -> search_in_class_type level cl_def cl_type\r
+    | Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |\r
+      Types.TupleType _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_NoInnerDeclForOuterElem"; id];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+  and search_in_class_type level cl_def cl_type =\r
+    try\r
+      let elt_type = evaluate (List.assoc id cl_type.Types.named_elements) in\r
+      match elt_type.Types.dynamic_scope with\r
+          | None | Some Types.Inner ->\r
+              let nat = LocalIdentifier (level, id) in\r
+              resolved_expression (Some expr) nat elt_type.Types.element_nature\r
+          | Some Types.Outer | Some Types.InnerOuter ->\r
+              let nat = DynamicIdentifier (level, id) in\r
+              resolved_expression (Some expr) nat elt_type.Types.element_nature\r
+    with Not_found -> search_in_parent level cl_def\r
+  and search_in_parent level cl_def = match cl_def.enclosing_class with\r
+    | _ when cl_def.encapsulated -> search_in_toplevel ctx.toplevel\r
+    | Some cl_def -> search_in_class (level + 1) cl_def\r
+    | None -> search_in_toplevel ctx.toplevel\r
+  and search_in_for_loop_variables level ctx = match ctx.context_nature with\r
+    | ToplevelContext -> search_in_toplevel ctx.toplevel\r
+    | ClassContext cl_def -> search_in_class 0 cl_def\r
+    | SubscriptContext (ctx', _, _, _) ->\r
+        search_in_for_loop_variables level ctx'\r
+    | ForContext (_, id', elt_nat) when id' = id ->\r
+        let nat = LoopVariable level in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | ForContext (ctx', _, _) ->\r
+        search_in_for_loop_variables (level + 1) ctx' in\r
+  search_in_for_loop_variables 0 ctx\r
+\r
+(*and resolve_if ctx expr alts expr' =\r
+  let expres' = resolve_expression ctx expr' in\r
+  let elt_nat' = expres'.info.type_description in\r
+  let rec resolve_alternative (cond, expr) =\r
+    resolve_condition cond,\r
+    resolve_alternative_expression expr\r
+  and resolve_condition cond =\r
+    let ctx = {ctx with location = cond.Syntax.info} in\r
+    let cond' = resolve_expression ctx cond in\r
+    let condition cpnt_type =\r
+      let cl_spec = evaluate cpnt_type.Types.base_class in\r
+      match cl_spec with\r
+        | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cond'\r
+        | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+          Types.ArrayType _ | Types.TupleType _ -> \r
+            raise (CompilError\r
+              {err_msg = ["_NonBooleanIfCondExpr"];\r
+               err_info =\r
+                 [("_ExprKind", "...if A then...");\r
+                  ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+               err_ctx = ctx}) (*error*) in\r
+    match cond'.info.type_description with\r
+      | Types.ComponentElement cpnt_type -> condition cpnt_type\r
+      | _ -> raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = cond.Syntax.info}}) (*error*)\r
+  and resolve_alternative_expression expr =\r
+    let ctx = {ctx with location = expr.Syntax.info} in\r
+    let expres = resolve_expression ctx expr in\r
+    let elt_nat = expres.info.type_description in\r
+    let display_error elt_nat elt_nat' = match elt_nat, elt_nat' with\r
+      | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+          raise (CompilError\r
+            {err_msg = ["_TypeConflictsInIfAlternExprs"];\r
+             err_info =\r
+               [("_TypeOfThenBranche",\r
+                 Types.string_of_component_type cpnt_type);\r
+                ("_TypeOfElseBranche",\r
+                 Types.string_of_component_type cpnt_type')];\r
+             err_ctx = ctx}) (*error*)\r
+      | Types.ComponentElement cpnt_type, _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info =\r
+               [("_TypeOfThenBranche",\r
+                 Types.string_of_component_type cpnt_type);\r
+                ("_TypeOfElseBranche", "_ClassElement")];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, Types.ComponentElement cpnt_type' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info =\r
+               [("_TypeOfThenBranche", "_ClassElement");\r
+                ("_TypeOfElseBranche",\r
+                 Types.string_of_component_type cpnt_type')];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info =\r
+               [("_TypeOfThenBranche", "_ClassElement");\r
+                ("_TypeOfElseBranche", "_ClassElement")];\r
+             err_ctx = ctx}) (*error*) in\r
+    match Types.compare_element_natures elt_nat elt_nat' with\r
+    | Types.NotRelated -> display_error elt_nat elt_nat'\r
+    | _ -> expres in\r
+  let alts = List.map resolve_alternative alts in\r
+  let nat = If (alts, expres') in\r
+  resolved_expression (Some expr) nat elt_nat'*)\r
+\r
+and resolve_if ctx expr alts expr' =\r
+  let resolve_data_expression ctx expr =\r
+    let expr' = resolve_expression ctx expr in\r
+    match expr'.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> expr'\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in\r
+  let resolve_condition cond =\r
+    let ctx = {ctx with location = cond.Syntax.info} in\r
+    let cond' = resolve_data_expression ctx cond in\r
+    let condition cpnt_type =\r
+      match evaluate cpnt_type.Types.base_class with\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cond'\r
+      | cl_spec -> \r
+          raise (CompilError\r
+            {err_msg = ["_NonBooleanIfCondExpr"];\r
+             err_info =\r
+               [("_ExprKind", "...if A then...");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    match cond'.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> condition cpnt_type\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_DataElemExpected"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+  let resolve_alternatives (alts, expr') (cond, expr) =\r
+    let ctx = {ctx with location = expr.Syntax.info} in\r
+    let cond' = resolve_condition cond\r
+    and expr = resolve_data_expression ctx expr in\r
+    let exprs = apply_binary_coercions [ expr'; expr] in\r
+    let expr' = List.nth exprs 0\r
+    and expr = List.nth exprs 1 in\r
+    let elt_nat = expr.info.type_description\r
+    and elt_nat' = expr'.info.type_description in\r
+    match Types.compare_element_natures elt_nat elt_nat' with\r
+    | Types.SameType ->\r
+        (alts @ [cond', expr]), expr'\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_TypeConflictsInIfAlternExprs"];\r
+           err_info =\r
+             [("_TypeOfThenBranche",\r
+               Types.string_of_element_nature elt_nat);\r
+              ("_TypeOfElseBranche",\r
+               Types.string_of_element_nature elt_nat')];\r
+           err_ctx = ctx}) (*error*) in\r
+  let expr' = resolve_data_expression ctx expr' in\r
+  let alts, expr' = List.fold_left resolve_alternatives ([], expr') alts in\r
+  let nat = If (alts, expr') in\r
+  resolved_expression (Some expr) nat expr'.info.type_description\r
+\r
+and resolve_indexed_access ctx expr expr' subs =\r
+  let expres' = resolve_expression ctx expr' in\r
+  let rec resolve_component_indexed_access cl_spec subs =\r
+    match cl_spec, subs with\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _), [] -> cl_spec\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.TupleType _), _ :: _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_CannotSubscriptANonArrayTypeElem"];\r
+             err_info =\r
+               [("_ExpectedType", "_ArrayType");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*)\r
+      | Types.ArrayType (_, cl_spec'), sub :: subs' ->\r
+          let cl_spec' = resolve_component_indexed_access cl_spec' subs' in\r
+          subarray_access sub cl_spec'\r
+  and subarray_access sub cl_spec =\r
+    let subarray_access' = function\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType } -> cl_spec\r
+      | Types.ArrayType\r
+          (dim, Types.PredefinedType { Types.base_type = Types.IntegerType }) ->\r
+          Types.ArrayType (dim, cl_spec)\r
+      | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+        Types.ArrayType _ | Types.TupleType _ -> assert false (*error*) in\r
+    match sub.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let cl_spec' = evaluate cpnt_type.Types.base_class in\r
+          subarray_access' cl_spec'\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ -> assert false (*error*) in\r
+  match expres'.info.type_description with\r
+    | Types.ComponentElement cpnt_type ->\r
+        let cl_spec = evaluate cpnt_type.Types.base_class in\r
+        let subs' = resolve_subscripts ctx expres' cl_spec subs in\r
+        let cpnt_type' = \r
+          { cpnt_type with\r
+            Types.base_class =\r
+              lazy (resolve_component_indexed_access cl_spec subs')\r
+          } in\r
+        let info =\r
+          {\r
+            syntax = Some expr;\r
+            type_description = Types.ComponentElement cpnt_type'\r
+          } in\r
+        { nature = IndexedAccess (expres', subs'); info = info }\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_integer ctx expr s =\r
+  let nat =\r
+    try\r
+      Integer (Int32.of_string s)\r
+    with\r
+    | _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidInteger"; s];\r
+           err_info = [];\r
+           err_ctx = ctx}) in\r
+  resolved_expression (Some expr) nat (Types.integer_type Types.Constant)\r
+\r
+and resolve_matrix_construction ctx expr exprss =\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented"; "_MatrixExpr"];\r
+     err_info = [];\r
+     err_ctx = ctx})\r
+\r
+and resolve_no_event ctx expr expr' =\r
+  let expr' = resolve_expression ctx expr' in\r
+  match expr'.info.type_description with\r
+  | Types.ComponentElement cpnt_type ->\r
+      let nat = NoEvent expr'\r
+      and flow = lazy (evaluate cpnt_type.Types.flow)\r
+      and var = lazy Types.Continuous\r
+      and inout = cpnt_type.Types.causality\r
+      and cl_spec = cpnt_type.Types.base_class in\r
+      let cpnt_type =\r
+        component_element flow var inout cl_spec in\r
+      let elt_nat = Types.ComponentElement cpnt_type in\r
+      resolved_expression (Some expr) nat elt_nat\r
+  | _ ->\r
+      raise (CompilError\r
+        {err_msg = ["_ClassElemFoundInExpr"];\r
+         err_info = [];\r
+         err_ctx = ctx}) (*error*)\r
+\r
+and resolve_range ctx expr start step stop =\r
+  let integer_range var start' step' stop' =\r
+    let integer_range' =\r
+      match start'.nature, step'.nature, stop'.nature with\r
+      | _, _, _ when Types.higher_variability var Types.Discrete ->\r
+          let var = Types.string_of_variability var in\r
+          raise (CompilError\r
+            {err_msg = ["_InvalidVarOfRangeExpr"];\r
+             err_info = [("_Expr", Syntax.string_of_range start step stop);\r
+                         ("_ExpectedVariability", "parameter");\r
+                         ("_VariabilityFound", var)];\r
+             err_ctx = ctx}) \r
+      | Integer i, Integer p, Integer j when p = Int32.zero ->\r
+          raise (CompilError\r
+            {err_msg = ["_RangeStepValueCannotBeNull"];\r
+             err_info = [("_Expr", Syntax.string_of_range start step stop)];\r
+             err_ctx = ctx})\r
+      | Integer i, Integer p, Integer j ->\r
+          let dim = Int32.div (Int32.succ (Int32.sub j i)) p in\r
+          Types.integer_array_type var (Types.ConstantDimension dim)\r
+      | (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |\r
+         LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _),\r
+        (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |\r
+         LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _),\r
+        (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |\r
+         LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _) ->\r
+          Types.integer_array_type var Types.ParameterDimension\r
+      | _, _, _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_NotYetImplemented"; "_NonIntegerRangeExpr"];\r
+             err_info = [("_Expr", Syntax.string_of_range start step stop)];\r
+             err_ctx = ctx}) in\r
+    let nat = Range (start', step', stop') in\r
+    let elt_nat = integer_range' in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  let start' = resolve_expression ctx start\r
+  and step' = match step with\r
+    | None -> one\r
+    | Some expr -> resolve_expression ctx expr\r
+  and stop' = resolve_expression ctx stop in\r
+  let resolve_range' var start_cl_spec step_cl_spec stop_cl_spec =\r
+    match start_cl_spec, step_cl_spec, stop_cl_spec with\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          integer_range var start' step' stop'\r
+      (*| Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        _ -> assert false*)\r
+      | _ -> raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_NonIntegerRangeExpr"];\r
+           err_info = [("_Expr", Syntax.string_of_range start step stop)];\r
+           err_ctx = ctx}) in\r
+  let start_elt_nat = start'.info.type_description\r
+  and step_elt_nat = step'.info.type_description\r
+  and stop_elt_nat = stop'.info.type_description in\r
+  match start_elt_nat, step_elt_nat, stop_elt_nat with\r
+    | Types.ComponentElement start_cpnt_type,\r
+      Types.ComponentElement step_cpnt_type,\r
+      Types.ComponentElement stop_cpnt_type ->\r
+        let start_cl_spec = evaluate start_cpnt_type.Types.base_class\r
+        and step_cl_spec = evaluate step_cpnt_type.Types.base_class\r
+        and stop_cl_spec = evaluate stop_cpnt_type.Types.base_class\r
+        and start_var = evaluate start_cpnt_type.Types.variability\r
+        and step_var = evaluate step_cpnt_type.Types.variability\r
+        and stop_var = evaluate stop_cpnt_type.Types.variability in\r
+        let var =\r
+          let var' = Types.max_variability step_var stop_var in\r
+          Types.max_variability start_var var' in\r
+        resolve_range' var start_cl_spec step_cl_spec stop_cl_spec\r
+    | _ -> raise (CompilError\r
+        {err_msg = ["_InvalidTypeInRangeExpr"];\r
+         err_info = [("_Expr", Syntax.string_of_range start step stop)];\r
+         err_ctx = ctx}) (*error*)\r
+\r
+and resolve_real ctx expr s =\r
+  let nat = Real (float_of_string s) in\r
+  resolved_expression (Some expr) nat (Types.real_type Types.Constant)\r
+\r
+and resolve_string ctx expr s =\r
+  resolved_expression (Some expr) (String s) (Types.string_type Types.Constant)\r
+\r
+and resolve_true ctx expr =\r
+  resolved_expression (Some expr) True (Types.boolean_type Types.Constant)\r
+\r
+and resolve_tuple ctx expr exprs =\r
+  let max_element_variability var expr expr' =\r
+    match expr'.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let var' = evaluate cpnt_type.Types.variability in\r
+          Types.max_variability var var'\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+  and class_specifier expr expr' =\r
+    match expr'.info.type_description with\r
+      | Types.ComponentElement cpnt_type -> evaluate cpnt_type.Types.base_class\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*) in\r
+  let exprs' = List.map (resolve_expression ctx) exprs in\r
+  let flow = lazy false\r
+  and var =\r
+    lazy (List.fold_left2 max_element_variability Types.Constant exprs exprs')\r
+  and inout = lazy Types.Acausal\r
+  and cl_spec = lazy (Types.TupleType (List.map2 class_specifier exprs exprs')) in\r
+  {\r
+    nature = Tuple exprs';\r
+    info =\r
+      {\r
+        syntax = Some expr;\r
+        type_description =\r
+          Types.ComponentElement (component_element flow var inout cl_spec)\r
+      }\r
+  }\r
+\r
+and resolve_unuary_operation ctx expr kind arg =\r
+  let arg' = resolve_expression ctx arg in\r
+  match kind.Syntax.nature with\r
+    | Syntax.UnaryMinus -> resolve_unary_minus ctx expr arg'\r
+    | Syntax.Not -> resolve_not ctx expr arg'\r
+    | Syntax.UnaryPlus ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_UnaryOperPLUS"];\r
+           err_info = [];\r
+           err_ctx = ctx})\r
+\r
+and resolve_vector ctx expr vec_elts = match vec_elts.Syntax.nature with\r
+  | Syntax.VectorReduction (expr', for_inds) ->\r
+      resolve_vector_reduction ctx expr expr' for_inds\r
+  | Syntax.VectorElements exprs -> resolve_vector_elements ctx expr exprs\r
+\r
+and resolve_vector_reduction ctx expr expr' for_inds =\r
+  let vector_reduction_type acc expr expr' =\r
+    let add_dimension elt_nat cl_spec =\r
+      let add_dimension' cl_spec' = match cl_spec' with\r
+        | Types.ArrayType (dim, _) -> Types.ArrayType (dim, cl_spec)\r
+        | Types.PredefinedType _ | Types.ClassType _ |\r
+          Types.ComponentType _ | Types.TupleType _ -> \r
+            raise (CompilError\r
+              {err_msg = ["_InvalidTypeInRangeExpr"];\r
+               err_info =\r
+                 [("_ExpectedType", "_ArrayType");\r
+                  ("_TypeFound",\r
+                   Types.string_of_class_specifier cl_spec')];\r
+               err_ctx = ctx}) (*error*) in\r
+      match elt_nat with\r
+        | Types.ComponentElement cpnt_type ->\r
+            let cl_spec' = evaluate cpnt_type.Types.base_class in\r
+            add_dimension' cl_spec'\r
+        | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+          Types.PredefinedTypeElement _ ->\r
+            raise (CompilError\r
+              {err_msg = ["_ClassElemFoundInExpr"];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*) in\r
+    let rec vector_reduction_type' acc cl_spec = match acc with\r
+      | [] -> cl_spec\r
+      | range :: acc ->\r
+          let elt_nat = range.info.type_description in\r
+          let cl_spec' = add_dimension elt_nat cl_spec in\r
+          vector_reduction_type' acc cl_spec' in\r
+    match expr'.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let cpnt_type' =\r
+            { cpnt_type with\r
+              Types.base_class = lazy (vector_reduction_type' acc cl_spec)\r
+            } in\r
+          Types.ComponentElement cpnt_type'\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+  and range_element_type range range' =\r
+    let sub_dimension cl_spec = match cl_spec with\r
+      | Types.ArrayType (dim, cl_spec) -> cl_spec\r
+      | Types.PredefinedType _ | Types.ClassType _ |\r
+        Types.ComponentType _ | Types.TupleType _ -> \r
+          raise (CompilError\r
+            {err_msg = ["_InvalidTypeInRangeExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "_ArrayType");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    match range'.info.type_description with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let cl_spec = evaluate cpnt_type.Types.base_class in\r
+          let cpnt_type' =\r
+            { cpnt_type with\r
+              Types.base_class = lazy (sub_dimension cl_spec)\r
+            } in\r
+          Types.ComponentElement cpnt_type'\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*) in\r
+  let rec resolve_vector_reduction' acc ctx = function\r
+    | [] ->\r
+        let expres' = resolve_expression ctx expr' in\r
+        let nat = VectorReduction (List.rev acc, expres')\r
+        and elt_nat = vector_reduction_type acc expr' expres' in\r
+        resolved_expression (Some expr) nat elt_nat\r
+    | (_, None) :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_NotYetImplemented"; "_ImplicitIterRange"];\r
+           err_info = [("_Expr", Syntax.string_of_for_inds for_inds)];\r
+           err_ctx = ctx})\r
+    | (id, Some range) :: for_inds ->\r
+        let range' = resolve_expression ctx range in\r
+        let elt_nat = range_element_type range range' in\r
+        let ctx' =\r
+          { ctx with\r
+            context_nature = ForContext (ctx, id, elt_nat)\r
+          } in\r
+        resolve_vector_reduction' (range' :: acc) ctx' for_inds in\r
+  resolve_vector_reduction' [] ctx for_inds\r
+\r
+and resolve_vector_elements ctx expr exprs =\r
+  let max_variability var cpnt_type =\r
+    let var' = evaluate cpnt_type.Types.variability in\r
+    Types.max_variability var var' in\r
+  let type_of_elements cpnt_types =\r
+    let rec type_of_elements' cl_spec = function\r
+      | [] -> cl_spec\r
+      | cpnt_type :: cpnt_types ->\r
+          let cl_spec' = evaluate cpnt_type.Types.base_class in\r
+          type_of_elements' (update cl_spec cl_spec') cpnt_types\r
+    and update cl_spec cl_spec' =\r
+      match Types.compare_specifiers cl_spec cl_spec' with\r
+      | Types.SameType | Types.Supertype -> cl_spec\r
+      | Types.Subtype -> cl_spec'\r
+      | _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_TypeConflictsInVectorExpr"];\r
+             err_info =\r
+               [("_MismatchingTypes",\r
+                 Types.string_of_class_specifier cl_spec ^ ", " ^\r
+                 Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) in\r
+    match cpnt_types with\r
+      | [] -> assert false (*error*)\r
+      | cpnt_type :: cpnt_types ->\r
+          let cl_spec' = evaluate cpnt_type.Types.base_class in\r
+          type_of_elements' cl_spec' cpnt_types in\r
+  let exprs' = List.map (resolve_expression ctx) exprs in\r
+  let exprs' = apply_binary_coercions exprs' in\r
+  let cpnt_types = List.map (component_type_of_expression ctx) exprs' in\r
+  let var = lazy (List.fold_left max_variability Types.Constant cpnt_types) in\r
+  let cl_spec = type_of_elements cpnt_types in\r
+  let dim = Types.ConstantDimension (Int32.of_int (List.length exprs')) in\r
+  let cl_spec' = lazy (Types.ArrayType (dim, cl_spec)) in\r
+  let cpnt_type =\r
+    {\r
+      Types.flow = lazy false;\r
+            variability = var;\r
+            causality = lazy Types.Acausal;\r
+            base_class = cl_spec'\r
+    } in\r
+  let nat = Vector exprs'\r
+  and elt_nat = Types.ComponentElement cpnt_type in\r
+  resolved_expression (Some expr) nat elt_nat\r
+\r
+and resolve_and ctx expr arg arg' =\r
+  let resolve_and' cpnt_type cpnt_type' =\r
+    let rec and_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType },\r
+        Types.PredefinedType { Types.base_type = Types.BooleanType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.BooleanType; attributes = [] }\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType },\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["and"; "_OperAppliedToNonBoolExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "Boolean");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*)\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["and"; "_OperAppliedToNonBoolExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "Boolean");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (\r
+        let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (\r
+        let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        and_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (And, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_and' cpnt_type cpnt_type'\r
+    | Types.ComponentElement _,\r
+      (Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+       Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+    | (Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+       Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_or ctx expr arg arg' =\r
+  let resolve_or' cpnt_type cpnt_type' =\r
+    let rec or_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType },\r
+        Types.PredefinedType { Types.base_type = Types.BooleanType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.BooleanType; attributes = [] }\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType },\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["or"; "_OperAppliedToNonBoolExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "Boolean");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*)\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["or"; "_OperAppliedToNonBoolExpr"];\r
+             err_info =\r
+               [("_ExpectedType", "Boolean");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        or_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Or, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_or' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_addition ctx expr arg arg' =\r
+  let resolve_addition' cpnt_type cpnt_type' =\r
+    let rec addition_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.ArrayType (Types.ConstantDimension n, _),\r
+        Types.ArrayType (Types.ConstantDimension n', _) when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimMustAgreeToPerform"; "_Addition"];\r
+             err_info =\r
+               [("_ExprKind", "A + B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*)\r
+      | Types.ArrayType (Types.ConstantDimension _, cl_spec),\r
+        Types.ArrayType (dim, cl_spec') |\r
+        Types.ArrayType (dim, cl_spec),\r
+        Types.ArrayType (Types.ConstantDimension _, cl_spec') ->\r
+          Types.ArrayType (dim, addition_type cl_spec cl_spec')\r
+      | Types.ArrayType (Types.ParameterDimension, cl_spec),\r
+        Types.ArrayType (dim, cl_spec') |\r
+        Types.ArrayType (dim, cl_spec),\r
+        Types.ArrayType (Types.ParameterDimension, cl_spec') ->\r
+          Types.ArrayType (dim, addition_type cl_spec cl_spec')\r
+      | Types.ArrayType (Types.DiscreteDimension, cl_spec),\r
+        Types.ArrayType (Types.DiscreteDimension, cl_spec') ->\r
+          Types.ArrayType\r
+            (Types.DiscreteDimension, addition_type cl_spec cl_spec')\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType; attributes = [] }\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | Types.PredefinedType _, Types.ArrayType _ \r
+      | Types.ArrayType _, Types.PredefinedType _ -> \r
+          raise (CompilError\r
+            {err_msg = ["+"; "_OperBetweenScalarAndArray"];\r
+             err_info =\r
+               [("_ExprKind", "A + B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*)\r
+      | _, _ -> \r
+          raise (CompilError\r
+            {err_msg = ["+"; "_OperAppliedToNonNumericExpr"];\r
+             err_info =\r
+               [("_ExprKind", "A + B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        addition_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Plus, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_addition' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+            {err_msg = ["_ClassElemFoundInExpr"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+\r
+and resolve_comparison ctx expr kind arg arg' =\r
+  let resolve_comparison' cpnt_type cpnt_type' =\r
+    let rec comparison_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.IntegerType | Types.RealType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.IntegerType | Types.RealType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.BooleanType; attributes = [] }\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_TypeInconsistWithComparOper"];\r
+             err_info =\r
+               [("_ExprKind", "A" ^ (string_of_bin_oper_kind kind) ^ "B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*) in\r
+    (*let var =\r
+      let var = evaluate cpnt_type.Types.variability\r
+      and var' = evaluate cpnt_type'.Types.variability in\r
+       Types.max_variability var var'*)\r
+    let var = Types.Discrete\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        comparison_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (kind, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) (lazy var) (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_comparison' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_division ctx expr arg arg' =\r
+  let resolve_division' cpnt_type cpnt_type' =\r
+    let rec division_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.ArrayType (dim, cl_spec),\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.IntegerType | Types.RealType } ->\r
+          Types.ArrayType (dim, division_type cl_spec cl_spec')\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["_TypeInconsistentWithDivOper"];\r
+             err_info =\r
+               [("_ExprKind", "A / B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        division_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Divide, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_division' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and resolve_multiplication ctx expr arg arg' =\r
+  let resolve_multiplication' cpnt_type cpnt_type' =\r
+    let rec multiplication_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.ArrayType (_, Types.ArrayType (Types.ConstantDimension n, _)),\r
+        Types.ArrayType (Types.ConstantDimension n', Types.ArrayType _)\r
+        when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimsNonCompatibleWithMult"];\r
+             err_info =\r
+               [("_ExprKind", "A * B");\r
+                ("_TypeOfA", Types.string_of_component_type cpnt_type);\r
+                ("_TypeOfB", Types.string_of_component_type cpnt_type')];\r
+             err_ctx = ctx})  (*error*)\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (_, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType })),\r
+        Types.ArrayType\r
+          (_, Types.ArrayType\r
+            (dim', Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType })) ->\r
+          Types.ArrayType\r
+            (dim, Types.ArrayType\r
+              (dim', Types.PredefinedType\r
+                { Types.base_type = Types.IntegerType; attributes = [] }))\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (_, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType | Types.RealType })),\r
+        Types.ArrayType\r
+          (_, Types.ArrayType\r
+            (dim', Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType | Types.RealType })) ->\r
+          Types.ArrayType\r
+            (dim, Types.ArrayType\r
+              (dim', Types.PredefinedType\r
+                { Types.base_type = Types.RealType; attributes = [] }))\r
+      | Types.ArrayType (_, Types.ArrayType (Types.ConstantDimension n, _)),\r
+        Types.ArrayType (Types.ConstantDimension n', _)\r
+        when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimsNonCompatibleWithMult"];\r
+             err_info =\r
+               [("_ExprKind", "A * B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx})  (*error*)\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (_, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType })),\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType }) ->\r
+          Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType; attributes = [] })\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (_, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType | Types.RealType })),\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType | Types.RealType }) ->\r
+          Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.RealType; attributes = [] })\r
+      | Types.ArrayType (Types.ConstantDimension n, _),\r
+        Types.ArrayType (Types.ConstantDimension n', Types.ArrayType _)\r
+        when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimsNonCompatibleWithMult"];\r
+             err_info =\r
+               [("_ExprKind", "A * B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx})  (*error*)\r
+      | Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType }),\r
+        Types.ArrayType\r
+          (_, Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType })) ->\r
+          Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType; attributes = [] })\r
+      | Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType | Types.RealType }),\r
+        Types.ArrayType\r
+          (_, Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType | Types.RealType })) ->\r
+          Types.ArrayType\r
+            (dim, Types.PredefinedType\r
+              { Types.base_type = Types.RealType; attributes = [] })\r
+      | Types.ArrayType (Types.ConstantDimension n, _),\r
+        Types.ArrayType (Types.ConstantDimension n', _)\r
+        when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_ArrayDimsNonCompatibleWithMult"];\r
+             err_info =\r
+               [("_ExprKind", "A * B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx})  (*error*)\r
+      | Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType }),\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType }) ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType; attributes = [] }\r
+      | Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType | Types.RealType }),\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType | Types.RealType }) ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.IntegerType | Types.RealType },\r
+        Types.ArrayType (dim, cl_spec') ->\r
+          Types.ArrayType (dim, multiplication_type cl_spec cl_spec')\r
+      | Types.ArrayType (dim, cl_spec),\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.IntegerType | Types.RealType } ->\r
+          Types.ArrayType (dim, multiplication_type cl_spec cl_spec')\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType; attributes = [] }\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["*"; "_OperAppliedToNonNumericExpr"];\r
+             err_info =\r
+               [("_ExprKind", "A * B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx})  (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        multiplication_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Times, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match  arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_multiplication' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx})  (*error*)\r
+\r
+and resolve_power ctx expr arg arg' =\r
+  let resolve_power' cpnt_type cpnt_type' =\r
+    let rec power_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.ArrayType\r
+          (Types.ConstantDimension n, Types.ArrayType\r
+            (Types.ConstantDimension n', _)),\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType }\r
+        when n <> n' ->\r
+          raise (CompilError\r
+            {err_msg = ["_PowerOperOnNonSquareArray"];\r
+             err_info =\r
+               [("_ExprKind", "A ^ B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*)\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (dim', Types.PredefinedType\r
+              { Types.base_type = Types.IntegerType })),\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.ArrayType\r
+            (dim, Types.ArrayType\r
+              (dim', Types.PredefinedType\r
+                { Types.base_type = Types.RealType; attributes = [] }))\r
+      | Types.ArrayType\r
+          (dim, Types.ArrayType\r
+            (dim', Types.PredefinedType { Types.base_type = Types.RealType })),\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.ArrayType\r
+            (dim, Types.ArrayType\r
+              (dim', Types.PredefinedType\r
+                { Types.base_type = Types.RealType; attributes = [] }))\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["^"; "_OperAppliedToNonNumericExpr"];\r
+             err_info =\r
+               [("_ExprKind", "A ^ B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        power_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Power, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_power' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx})  (*error*)\r
+\r
+and resolve_subtraction ctx expr arg arg' =\r
+  let resolve_subtraction' cpnt_type cpnt_type' =\r
+    let rec subtraction_type cl_spec cl_spec' = match cl_spec, cl_spec' with\r
+      | Types.ArrayType (Types.ConstantDimension n, _),\r
+        Types.ArrayType (Types.ConstantDimension n', _) when n <> n' ->\r
+          raise (CompilError\r
+          {err_msg = ["_ArrayDimMustAgreeToPerform"; "_Subtraction"];\r
+           err_info =\r
+             [("_ExprKind", "A - B");\r
+              ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+              ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+           err_ctx = ctx})  (*error*)\r
+      | Types.ArrayType (Types.ConstantDimension _, cl_spec),\r
+        Types.ArrayType (dim, cl_spec') |\r
+        Types.ArrayType (dim, cl_spec),\r
+        Types.ArrayType (Types.ConstantDimension _, cl_spec') ->\r
+          Types.ArrayType (dim, subtraction_type cl_spec cl_spec')\r
+      | Types.ArrayType (Types.ParameterDimension, cl_spec),\r
+        Types.ArrayType (dim, cl_spec') |\r
+        Types.ArrayType (dim, cl_spec),\r
+        Types.ArrayType (Types.ParameterDimension, cl_spec') ->\r
+          Types.ArrayType (dim, subtraction_type cl_spec cl_spec')\r
+      | Types.ArrayType (Types.DiscreteDimension, cl_spec),\r
+        Types.ArrayType (Types.DiscreteDimension, cl_spec') ->\r
+          Types.ArrayType\r
+            (Types.DiscreteDimension, subtraction_type cl_spec cl_spec')\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.IntegerType; attributes = [] }\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType },\r
+        Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } ->\r
+          Types.PredefinedType\r
+            { Types.base_type = Types.RealType; attributes = [] }\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _),\r
+        (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.ArrayType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["-"; "_OperAppliedToNonNumericExpr"];\r
+             err_info =\r
+               [("_ExprKind", "A - B");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec);\r
+                ("_TypeOfB", Types.string_of_class_specifier cl_spec')];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var =\r
+      lazy (let var = evaluate cpnt_type.Types.variability\r
+        and var' = evaluate cpnt_type'.Types.variability in\r
+        Types.max_variability var var')\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class\r
+        and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+        subtraction_type cl_spec cl_spec') in\r
+    let nat = BinaryOperation (Minus, arg, arg') in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description, arg'.info.type_description with\r
+    | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->\r
+        resolve_subtraction' cpnt_type cpnt_type'\r
+    | (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),\r
+      (Types.ComponentElement _ | Types.ClassElement _ |\r
+       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx})  (*error*)\r
+\r
+and resolve_unary_minus ctx expr arg =\r
+  let resolve_unary_minus' cpnt_type =\r
+    let rec unary_minus_type cl_spec = match cl_spec with\r
+      | Types.ArrayType (dim, cl_spec) ->\r
+          Types.ArrayType (dim, unary_minus_type cl_spec)\r
+      | Types.PredefinedType\r
+          { Types.base_type = Types.RealType | Types.IntegerType } -> cl_spec\r
+      | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+         Types.TupleType _) -> \r
+          raise (CompilError\r
+            {err_msg = ["-"; "_OperAppliedToNonNumericExpr"];\r
+             err_info =\r
+               [("_ExprKind", "- A");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx})  (*error*) in\r
+    let var = cpnt_type.Types.variability\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class in\r
+        unary_minus_type cl_spec) in\r
+    let nat = UnaryOperation (UnaryMinus, arg) in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> resolve_unary_minus' cpnt_type\r
+    | Types.ClassElement _ |\r
+      Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx})  (*error*)\r
+\r
+and resolve_not ctx expr arg =\r
+  let resolve_not' cpnt_type =\r
+    let rec not_type cl_spec = match cl_spec with\r
+      | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cl_spec\r
+      | (Types.PredefinedType _ | Types.ArrayType _ | Types.ClassType _ |\r
+        Types.ComponentType _ | Types.TupleType _) ->\r
+          raise (CompilError\r
+            {err_msg = ["not"; "_OperAppliedToNonBoolExpr"];\r
+             err_info =\r
+               [("_ExprKind", "not A");\r
+                ("_TypeOfA", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+    let var = cpnt_type.Types.variability\r
+    and inout = Types.Acausal\r
+    and cl_spec =\r
+      lazy (let cl_spec = evaluate cpnt_type.Types.base_class in\r
+        not_type cl_spec) in\r
+    let nat = UnaryOperation (Not, arg) in\r
+    let elt_nat =\r
+      let cpnt_type =\r
+        component_element (lazy false) var (lazy inout) cl_spec in\r
+      Types.ComponentElement cpnt_type in\r
+    resolved_expression (Some expr) nat elt_nat in\r
+  match arg.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> resolve_not' cpnt_type\r
+    | Types.ClassElement _ |\r
+      Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and component_element flow var inout cl_spec =\r
+  {\r
+    Types.flow = flow;\r
+          variability = var;\r
+          causality = inout;\r
+          base_class = cl_spec\r
+  }\r
+\r
+and element_nature_class ctx = function\r
+  | Types.ClassElement cl_spec -> evaluate cl_spec\r
+  | Types.ComponentElement cpnt_type -> evaluate cpnt_type.Types.base_class\r
+  | Types.PredefinedTypeElement predef -> Types.PredefinedType predef\r
+  | Types.ComponentTypeElement _ -> assert false (*error*)\r
+\r
+and element_field_type_nature ctx flow var inout cl_spec id =\r
+  let add_dimension dim = function\r
+    | Types.ComponentElement cpnt_type ->\r
+        let cpnt_type' =\r
+          { cpnt_type with\r
+            Types.base_class =\r
+              lazy (Types.ArrayType (dim, evaluate cpnt_type.Types.base_class))\r
+          } in\r
+        Types.ComponentElement cpnt_type'\r
+    | Types.ClassElement _\r
+    | Types.ComponentTypeElement _\r
+    | Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_InvalidClassElemModif"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+  let find_predefined_local_identifier predef id =\r
+    match predef.Types.base_type with\r
+      | Types.BooleanType when id = "start" -> Types.boolean_type Types.Parameter\r
+      | Types.IntegerType when id = "start" ->\r
+          Types.integer_type Types.Parameter\r
+      | Types.RealType when id = "start" ->\r
+          Types.real_type Types.Parameter\r
+      | Types.StringType when id = "start" -> Types.string_type Types.Parameter\r
+      | Types.EnumerationType enum_lits when id = "start" ->\r
+          Types.enumeration_type Types.Parameter enum_lits\r
+      | _ when id = "fixed" -> Types.boolean_type Types.Constant\r
+      | Types.IntegerType when id = "nominal" ->\r
+          Types.integer_type Types.Constant\r
+      | Types.RealType when id = "nominal" ->\r
+          Types.real_type Types.Constant\r
+      | _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_NotYetImplemented"; "_PredefinedTypeAttribModif"; id];\r
+             err_info = [];\r
+             err_ctx = ctx})\r
+  and find_class_local_identifier flow var inout cl_type id =\r
+    let apply_prefixes elt_nat = match elt_nat with\r
+      | Types.ComponentElement cpnt_type ->\r
+          let flow' = lazy (flow || evaluate cpnt_type.Types.flow) in\r
+          Types.ComponentElement { cpnt_type with Types.flow = flow' }\r
+      | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+        Types.PredefinedTypeElement _ -> elt_nat in\r
+    try\r
+      let elt_type =\r
+        evaluate (List.assoc id cl_type.Types.named_elements) in\r
+      match elt_type.Types.dynamic_scope with\r
+        | None | Some Types.Inner | Some Types.InnerOuter\r
+          when not elt_type.Types.protected ->\r
+            apply_prefixes elt_type.Types.element_nature\r
+        | None | Some Types.Inner | Some Types.InnerOuter ->\r
+            raise (CompilError\r
+              {err_msg = ["_CannotAccessProtectElem"; id];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*)\r
+        | Some Types.Outer ->\r
+            raise (CompilError\r
+              {err_msg = ["_CannotAccessOuterElem"; id];\r
+               err_info = [];\r
+               err_ctx = ctx}) (*error*)\r
+    with Not_found ->\r
+        raise (CompilError\r
+          {err_msg = ["_UnknownIdentifier"; id];\r
+           err_info = [];\r
+           err_ctx = ctx }) (*error*) in\r
+  let rec find_local_identifier flow var inout = function\r
+    | Types.PredefinedType predef_type ->\r
+        find_predefined_local_identifier predef_type id\r
+    | Types.ClassType cl_type ->\r
+        find_class_local_identifier flow var inout cl_type id\r
+    | Types.ComponentType cpnt_type ->\r
+        let flow = flow || evaluate cpnt_type.Types.flow\r
+        and var =\r
+          Types.max_variability var (evaluate cpnt_type.Types.variability)\r
+        and inout = evaluate cpnt_type.Types.causality\r
+        and base_class = evaluate cpnt_type.Types.base_class in\r
+        find_local_identifier flow var inout base_class\r
+    | Types.ArrayType (dim, cl_spec) ->\r
+        add_dimension dim (find_local_identifier flow var inout cl_spec)\r
+    | Types.TupleType _ -> assert false (*error*) in\r
+  find_local_identifier flow var inout cl_spec\r
+\r
+and scalar_element_nature elt_nat =\r
+  let rec scalar_element_nature' cl_spec = match cl_spec with\r
+    | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+      Types.TupleType _ -> cl_spec\r
+    | Types.ArrayType (_, cl_spec) -> scalar_element_nature' cl_spec in\r
+  match elt_nat with\r
+    | Types.ComponentElement cpnt_type ->\r
+        let base_class' =\r
+          lazy (scalar_element_nature' (evaluate cpnt_type.Types.base_class)) in\r
+        Types.ComponentElement { cpnt_type with Types.base_class = base_class' }\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ -> elt_nat\r
+\r
+and resolve_lhs_expression ctx expr =\r
+  raise (CompilError\r
+    {err_msg = ["_NotYetImplemented";\r
+                "_ExternalCallWithLeftHandSideExpr"];\r
+     err_info = [];\r
+     err_ctx = ctx})\r
+\r
+and resolve_subscripts ctx expr cl_spec subs =\r
+  let rec resolve_subscripts' n cl_spec subs = match cl_spec, subs with\r
+    | _, [] -> []\r
+    | Types.ArrayType (dim, cl_spec'), sub :: subs' ->\r
+        let sub' = resolve_subscript ctx expr n dim sub in\r
+        sub' :: resolve_subscripts' (Int32.add n 1l) cl_spec' subs'\r
+    | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+       Types.TupleType _), _ :: _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_CannotSubscriptANonArrayTypeElem"];\r
+           err_info =\r
+             [("_ExpectedType", "_ArrayType");\r
+              ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+           err_ctx = ctx}) (*error*) in\r
+  match subs.Syntax.nature with\r
+    | Syntax.Subscripts subs' -> resolve_subscripts' 1l cl_spec subs'\r
+\r
+and resolve_subscript ctx expr n dim sub = match sub.Syntax.nature with\r
+  | Syntax.Colon -> resolve_colon ctx expr n dim\r
+  | Syntax.Subscript expr' ->\r
+      let ctx' =\r
+      { ctx with\r
+        context_nature = SubscriptContext (ctx, expr, n, dim);\r
+        location = expr'.Syntax.info } in\r
+      resolve_subscript_expression ctx' expr'\r
+\r
+and resolve_colon ctx expr n dim =\r
+  let range var stop =\r
+    let nat = Range (one, one, stop)\r
+    and elt_nat = Types.integer_array_type var dim in\r
+    resolved_expression None nat elt_nat in\r
+  match dim with\r
+    | Types.ConstantDimension n ->\r
+        let stop =\r
+          let nat = Integer n\r
+          and elt_nat = Types.integer_type Types.Constant in\r
+          resolved_expression None nat elt_nat in\r
+        range Types.Constant stop\r
+    | Types.ParameterDimension ->\r
+        let stop = size_function_call ctx None expr n in\r
+        range Types.Parameter stop\r
+    | Types.DiscreteDimension ->\r
+        let stop = size_function_call ctx None expr n in\r
+        range Types.Discrete stop\r
+\r
+and resolve_subscript_expression ctx expr =\r
+  let expr' = resolve_expression ctx expr in\r
+  let resolve_subscript_expression' cpnt_type =\r
+    let cl_spec = evaluate cpnt_type.Types.base_class in\r
+    match cl_spec with\r
+      | Types.PredefinedType { Types.base_type = Types.IntegerType } |\r
+        Types.ArrayType\r
+          (_, Types.PredefinedType { Types.base_type = Types.IntegerType }) ->\r
+          expr'\r
+      | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |\r
+        Types.ArrayType _ | Types.TupleType _ ->\r
+          raise (CompilError\r
+            {err_msg = ["_NonIntegerArraySubscript"];\r
+             err_info =\r
+               [("_ExpectedType", "Integer");\r
+                ("_TypeFound", Types.string_of_class_specifier cl_spec)];\r
+             err_ctx = ctx}) (*error*) in\r
+  match expr'.info.type_description with\r
+    | Types.ComponentElement cpnt_type ->\r
+        resolve_subscript_expression' cpnt_type\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and size_function_call ctx syn arg n =\r
+  let size_function_call' cpnt_type =\r
+    let cpnt_type' =\r
+      { cpnt_type with\r
+        Types.base_class = lazy (Types.integer_class_type)\r
+      } in\r
+    let size =\r
+      let nat = PredefinedIdentifier "size"\r
+      and elt_nat =\r
+        Types.function_type\r
+          [("@1", cpnt_type);\r
+           ("@2", Types.integer_component_type Types.Constant)]\r
+          ["@3", cpnt_type'] in\r
+      resolved_expression None nat elt_nat in\r
+    let elt_nat = Types.ComponentElement cpnt_type' in\r
+    let num =\r
+      let nat = Integer n\r
+      and elt_nat = Types.integer_type Types.Constant in\r
+      resolved_expression None nat elt_nat\r
+    and expr =\r
+      let args =\r
+        let arg1 =\r
+          let nat = FunctionArgument 1\r
+          and elt_nat = arg.info.type_description in\r
+          resolved_expression None nat elt_nat\r
+        and arg2 =\r
+          let nat = FunctionArgument 2\r
+          and elt_nat = Types.integer_type Types.Constant in\r
+          resolved_expression None nat elt_nat in\r
+        [arg1; arg2] in\r
+      let nat = FunctionInvocation args in\r
+      resolved_expression None nat elt_nat in\r
+    let nat = FunctionCall (size, [arg; num], expr) in\r
+    resolved_expression syn nat elt_nat in\r
+  match arg.info.type_description with\r
+    | Types.ComponentElement cpnt_type -> size_function_call' cpnt_type\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ ->\r
+        raise (CompilError\r
+          {err_msg = ["_ClassElemFoundInExpr"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and element_type ctx protect final repl dyn_scope elt_desc =\r
+  {\r
+    Types.protected = protect;\r
+          final = bool_of_final final;\r
+          replaceable = bool_of_replaceable repl;\r
+          dynamic_scope = dynamic_scope_of_dynamic_scope dyn_scope;\r
+          element_nature = element_nature_type ctx elt_desc\r
+  }\r
+\r
+and bool_of_replaceable = function\r
+  | None -> false\r
+  | Some Syntax.Replaceable -> true\r
+\r
+and dynamic_scope_of_dynamic_scope = function\r
+  | None -> None\r
+  | Some Syntax.Inner -> Some Types.Inner\r
+  | Some Syntax.Outer -> Some Types.Outer\r
+  | Some Syntax.InnerOuter -> Some Types.InnerOuter\r
+\r
+and element_nature_type ctx elt_desc =\r
+  let elt_nat = match elt_desc.element_nature with\r
+    | Component cpnt_desc -> Types.ComponentElement (evaluate cpnt_desc.component_type)\r
+    | Class cl_def -> Types.ClassElement cl_def.class_type\r
+    | ComponentType cpnt_type_desc ->\r
+        Types.ComponentTypeElement (evaluate cpnt_type_desc.described_type)\r
+    | PredefinedType predef -> Types.PredefinedTypeElement predef in\r
+  elt_nat\r
+\r
+and class_specifier_type ctx part kind cl_def cl_spec =\r
+  let class_kind kind cl_type =\r
+    let check_class () =\r
+      if has_inouts cl_type then\r
+        raise (CompilError\r
+          {err_msg = ["_CannotUseCausPrefixInGenClass";\r
+                      class_specifier_name cl_spec];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+      else kind\r
+    and check_model () = kind\r
+    and check_block () =\r
+      raise (CompilError\r
+        {err_msg = ["_NotYetImplemented"; "_BlockElem"];\r
+         err_info = [];\r
+         err_ctx = ctx})\r
+    and check_record () = kind\r
+    and check_expandable_connector () =\r
+      raise (CompilError\r
+        {err_msg = ["_NotYetImplemented"; "_ExpandableConnector"];\r
+         err_info = [];\r
+         err_ctx = ctx})\r
+    and check_connector () = kind\r
+    and check_package () = kind\r
+    and check_function () = kind in\r
+  match kind with\r
+    | Types.Class -> check_class ()\r
+    | Types.Model -> check_model ()\r
+    | Types.Block -> check_block ()\r
+    | Types.Record -> check_record ()\r
+    | Types.ExpandableConnector -> check_expandable_connector ()\r
+    | Types.Connector -> check_connector ()\r
+    | Types.Package -> check_package ()\r
+    | Types.Function -> check_function () in\r
+  let rec cl_type =\r
+    {\r
+       Types.partial = bool_of_partial part;\r
+            kind = lazy (class_kind kind cl_type);\r
+            named_elements = class_type_elements ctx kind cl_def\r
+    } in\r
+  Types.ClassType cl_type\r
+\r
+and bool_of_partial = function\r
+  | None -> false\r
+  | Some Syntax.Partial -> true\r
+\r
+and class_type_elements ctx kind cl_def = match evaluate cl_def.description with\r
+  | LongDescription long_desc -> long_description_type_elements ctx kind long_desc\r
+  | ShortDescription short_desc -> short_description_type_elements ctx kind short_desc\r
+\r
+and short_description_type_elements ctx kind short_desc =\r
+  let cl_type = evaluate short_desc.modified_class_type in\r
+  let kind' = evaluate cl_type.Types.kind in\r
+  match kind, kind' with\r
+    | Types.Class, Types.Class |\r
+      Types.Model, Types.Model |\r
+      Types.Block, Types.Block |\r
+      Types.Record, Types.Record |\r
+      Types.ExpandableConnector, Types.ExpandableConnector |\r
+      Types.Connector, Types.Connector |\r
+      Types.Package, Types.Package |\r
+      Types.Function, Types.Function -> cl_type.Types.named_elements\r
+    | (Types.Class | Types.Model | Types.Block | Types.Record |\r
+      Types.ExpandableConnector | Types.Connector | Types.Package | Types.Function),\r
+      (Types.Class | Types.Model | Types.Block | Types.Record |\r
+      Types.ExpandableConnector | Types.Connector | Types.Package | Types.Function) ->\r
+        raise (CompilError\r
+          {err_msg = ["_InheritFromDiffClassKindsNotAllowed"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*)\r
+\r
+and long_description_type_elements ctx kind long_desc =\r
+  let type_element (id, elt_desc) = id, elt_desc.element_type in\r
+  let local_elts = List.map type_element long_desc.named_elements in\r
+  let add_extensions kinds exts =\r
+    let add_named_element protected named_elt named_elts =\r
+      let element_type elt_type =\r
+        let elt_type' = evaluate elt_type in\r
+        { elt_type' with Types.protected =\r
+            elt_type'.Types.protected || protected } in\r
+      match named_elt with\r
+      | id, _ when List.mem_assoc id named_elts ->\r
+          raise (CompilError\r
+            {err_msg = [id; "_AlreadyDeclaredInParentClass"];\r
+             err_info = [];\r
+             err_ctx = ctx}) (*error*)\r
+      | id, elt_type -> (id, lazy (element_type elt_type)) :: named_elts in\r
+    let add_extension_contribution (visibility, modif_cl) named_elts =\r
+      let protected = bool_of_visibility visibility\r
+      and cl_type = evaluate modif_cl.modified_class_type in\r
+      let named_elts' = cl_type.Types.named_elements in\r
+      if List.mem (evaluate cl_type.Types.kind) kinds then\r
+        List.fold_right (add_named_element protected) named_elts' named_elts\r
+      else\r
+        raise (CompilError\r
+          {err_msg = ["_InheritFromDiffClassKindsNotAllowed"];\r
+           err_info = [];\r
+           err_ctx = ctx}) (*error*) in\r
+    List.fold_right add_extension_contribution exts local_elts in\r
+  match kind, long_desc.extensions with\r
+  | Types.Function, [] -> local_elts\r
+  | Types.Function, _ :: _ ->\r
+      raise (CompilError\r
+        {err_msg = ["_InheritFromFunctionNotAllowed"];\r
+         err_info = [];\r
+         err_ctx = ctx}) (*error*)\r
+  | (Types.Class | Types.Model | Types.Block | Types.Record | Types.Connector | Types.Package),\r
+    exts -> add_extensions [kind] exts\r
+  | Types.ExpandableConnector, exts ->\r
+      add_extensions [kind; Types.Connector] exts\r
+\r
+and bool_of_visibility = function\r
+  | Public -> false\r
+  | Protected -> true\r
+\r
+and has_inouts cl_type =\r
+  let is_inout_component cpnt_type =\r
+    match evaluate cpnt_type.Types.causality with\r
+      | Types.Input | Types.Output -> true\r
+      | Types.Acausal -> false in\r
+  let is_inout = function\r
+    | Types.ComponentElement cpnt_type -> is_inout_component cpnt_type\r
+    | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+      Types.PredefinedTypeElement _ -> false\r
+  and element_nature (_, elt_type) = (evaluate elt_type).Types.element_nature in\r
+  List.exists\r
+    (function named_elt -> is_inout (element_nature named_elt))\r
+    cl_type.Types.named_elements\r
+\r
+and component_type_of_expression ctx expr =\r
+  match expr.info.type_description with\r
+  | Types.ComponentElement cpnt_type -> cpnt_type\r
+  | Types.ClassElement _ | Types.ComponentTypeElement _ |\r
+    Types.PredefinedTypeElement _ ->\r
+      raise (CompilError\r
+        {err_msg = ["_ClassElemFoundInExpr"];\r
+         err_info = [];\r
+         err_ctx = ctx}) (*error*)\r
+\r
+and scalar_class_specifier ctx expr =\r
+  let rec scalar_class_specifier' cl_spec = match cl_spec with\r
+    | Types.ArrayType (dim, cl_spec) ->\r
+        scalar_class_specifier' cl_spec\r
+    | _ -> cl_spec in\r
+  let cpnt_type = component_type_of_expression ctx expr in\r
+  let cl_spec = evaluate cpnt_type.Types.base_class in\r
+  scalar_class_specifier' cl_spec\r
+\r
+and expression_of_variable expr =\r
+  let vector_variables vec_elts = match vec_elts.Syntax.nature with\r
+    | Syntax.VectorReduction _ -> false\r
+    | Syntax.VectorElements exprs ->\r
+        List.for_all expression_of_variable exprs in\r
+  match expr.Syntax.nature with\r
+  | Syntax.Identifier _ -> true\r
+  | Syntax.FieldAccess (expr', _) -> expression_of_variable expr'\r
+  | Syntax.IndexedAccess (expr', subs) ->\r
+      expression_of_variable expr'\r
+  | Syntax.MatrixConstruction exprss ->\r
+      List.for_all (List.for_all expression_of_variable) exprss\r
+  | Syntax.Tuple exprs ->\r
+      List.for_all expression_of_variable exprs\r
+  | Syntax.Vector vec_elts -> vector_variables vec_elts\r
+  | _ -> false\r
+\r
+and string_of_bin_oper_kind kind = match kind with\r
+  | And -> " and "\r
+  | Divide -> " / "\r
+  | EqualEqual -> " == "\r
+  | GreaterEqual -> " >= "\r
+  | Greater -> " > "\r
+  | LessEqual -> " <= "\r
+  | Less -> " < "\r
+  | Times -> " * "\r
+  | NotEqual -> " <> "\r
+  | Or -> " or "\r
+  | Plus -> " + "\r
+  | Power -> " ^ "\r
+  | Minus -> " - "\r
+\r
+and string_of_un_oper_kind kind = match kind with\r
+  | Not -> " not "\r
+  | UnaryMinus -> "- "\r
+  | UnaryPlus -> "+ "\r
+\r
+and apply_binary_coercions exprs =\r
+  let base_type expr =\r
+    let rec base_type' cl_spec = match cl_spec with\r
+      | Types.ArrayType (_, cl_spec) -> base_type' cl_spec\r
+      | Types.PredefinedType pt -> Some pt.Types.base_type\r
+      | _ -> None in\r
+    match expr.info.type_description with\r
+    | Types.ComponentElement cpnt_type ->\r
+        let cl_spec = evaluate cpnt_type.Types.base_class in\r
+        base_type' cl_spec\r
+    | _ -> None\r
+  and real_type bt = match bt with\r
+    | Some Types.RealType -> true\r
+    | _ -> false\r
+  and integer_type bt = match bt with\r
+    | Some Types.IntegerType -> true\r
+    | _ -> false in\r
+  match List.map base_type exprs with\r
+  | [] | [ _ ] -> exprs\r
+  | bts when (List.exists real_type bts) &&\r
+    (List.exists integer_type bts) ->\r
+      let cpnt_type = Types.real_component_type Types.Continuous in\r
+      List.map (apply_rhs_coercions cpnt_type) exprs\r
+  | _ -> exprs\r
+\r
+and apply_rhs_coercions cpnt_type expr =\r
+  let apply_real_of_integer cpnt_type cpnt_type' =\r
+    let rec apply_real_of_integer' cl_spec cl_spec' =\r
+      match cl_spec, cl_spec' with\r
+      | Types.ArrayType (dim, cl_spec), _ ->\r
+          apply_real_of_integer' cl_spec cl_spec'\r
+      | _, Types.ArrayType (dim', cl_spec') ->\r
+          let coer, cl_spec' = apply_real_of_integer' cl_spec cl_spec' in\r
+          coer, Types.ArrayType (dim', cl_spec')\r
+      | Types.PredefinedType { Types.base_type = Types.RealType },\r
+        Types.PredefinedType { Types.base_type = Types.IntegerType } ->\r
+          Some RealOfInteger, Types.real_class_type\r
+      | _, _ -> None, cl_spec' in\r
+    let cl_spec = evaluate cpnt_type.Types.base_class\r
+    and cl_spec' = evaluate cpnt_type'.Types.base_class in\r
+    match apply_real_of_integer' cl_spec cl_spec' with\r
+    | Some RealOfInteger, cl_spec' ->\r
+        let cpnt_type' =\r
+          {\r
+            cpnt_type' with\r
+            Types.base_class = lazy cl_spec'\r
+          }\r
+        and nat' = Coercion (RealOfInteger, expr) in\r
+        let elt_nat' = Types.ComponentElement cpnt_type' in\r
+        resolved_expression expr.info.syntax nat' elt_nat'\r
+    | _ -> expr in\r
+  match expr.info.type_description with\r
+  | Types.ComponentElement cpnt_type' ->\r
+      apply_real_of_integer cpnt_type cpnt_type'\r
+  | _ -> expr\r
+\r
+(* for debug *)\r
+and string_of_expression expr = match expr.nature with\r
+  | BinaryOperation (bin_oper_kind, expr, expr') ->\r
+      Printf.sprintf "BinaryOperation(_, %s, %s)"\r
+        (string_of_expression expr)\r
+        (string_of_expression expr')\r
+  | DynamicIdentifier (i, s) -> "DynamicIdentifier"\r
+  | False -> "False"\r
+  | FieldAccess (expr, s) -> "FieldAccess"\r
+  | FunctionArgument i -> "FunctionArgument"\r
+  | FunctionCall (expr, exprs, expr') ->\r
+      Printf.sprintf "FunctionCall(%s, {%s}, %s)"\r
+        (string_of_expression expr)\r
+        (String.concat "," (List.map string_of_expression exprs))\r
+        (string_of_expression expr') \r
+  | FunctionInvocation exprs -> "FunctionInvocation"\r
+  | If (alts, expr) -> "If"\r
+  | IndexedAccess (expr, exprs) -> "IndexedAccess"\r
+  | Integer i ->\r
+      Printf.sprintf "Integer(%d)" (Int32.to_int i)\r
+  | LocalIdentifier (i, s) ->\r
+      Printf.sprintf "LocalIdentifier(%d, %s)" i s\r
+  | LoopVariable i -> "LoopVariable"\r
+  | NoEvent expr -> "NoEvent"\r
+  | PredefinedIdentifier s ->\r
+      Printf.sprintf "PredefinedIdentifier(%s)" s\r
+  | Range (start, step, stop) ->\r
+      Printf.sprintf "Range(%s, %s, %s)"\r
+        (string_of_expression start)\r
+        (string_of_expression step)\r
+        (string_of_expression stop)\r
+  | Real f -> "Real"\r
+  | String s -> "String"\r
+  | ToplevelIdentifier s -> "ToplevelIdentifier"\r
+  | True -> "True"\r
+  | Tuple exprs -> "Tuple"\r
+  | UnaryOperation (un_oper_kind, expr) -> "UnaryOperation"\r
+  | Vector exprs -> "Vector"\r
+  | VectorReduction (exprs, expr) -> "VectorReduction"\r
+  | Coercion _ -> "Coercion"\r
diff --git a/scilab/modules/scicos/src/translator/compilation/types.ml b/scilab/modules/scicos/src/translator/compilation/types.ml
new file mode 100644 (file)
index 0000000..c6d07aa
--- /dev/null
@@ -0,0 +1,630 @@
+(*\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
diff --git a/scilab/modules/scicos/src/translator/exceptionHandling/.depend b/scilab/modules/scicos/src/translator/exceptionHandling/.depend
new file mode 100644 (file)
index 0000000..01ef257
--- /dev/null
@@ -0,0 +1,12 @@
+errorDico.cmo: ../parsing/parser.cmo ../compilation/nameResolve.cmo \
+    ../instantiation/instantiation.cmo 
+errorDico.cmx: ../parsing/parser.cmx ../compilation/nameResolve.cmx \
+    ../instantiation/instantiation.cmx 
+msgDico.cmo: 
+msgDico.cmx: 
+exceptHandler.cmo: ../parsing/parser.cmo ../compilation/nameResolve.cmo \
+    msgDico.cmo ../parsing/linenum.cmo ../instantiation/instantiation.cmo \
+    errorDico.cmo 
+exceptHandler.cmx: ../parsing/parser.cmx ../compilation/nameResolve.cmx \
+    msgDico.cmx ../parsing/linenum.cmx ../instantiation/instantiation.cmx \
+    errorDico.cmx 
diff --git a/scilab/modules/scicos/src/translator/exceptionHandling/errorDico.ml b/scilab/modules/scicos/src/translator/exceptionHandling/errorDico.ml
new file mode 100644 (file)
index 0000000..8baa806
--- /dev/null
@@ -0,0 +1,158 @@
+(*\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
+(* Compilation error dictionary\r
+  @author D. TALBI \r
+  @since 05/02/2007\r
+  *)\r
+\r
+type error_description =\r
+  {\r
+    err_msg: string list;\r
+    err_info: (string * string) list;\r
+    err_ctx: err_ctx\r
+  }\r
+\r
+and err_ctx =\r
+  {\r
+    path: Instantiation.path;\r
+    location: Parser.location;\r
+    instance_nature: Instantiation.instance_nature\r
+  }\r
+\r
+exception GenericError of error_description\r
+\r
+(* list of compilation errors*)\r
+let ccodes = [\r
+  ("_UnknownIdentifier", "0001");\r
+  ("_EnumTypeDefWithDuplicLit", "0002");\r
+  ("_EncapsulatedCannotBeAppliedTo", "0003");\r
+  ("_InvalidTypeDef", "0004");\r
+  ("_UnspecifiedEnumLits", "0005");\r
+  ("_NotYetImplemented", "0006");\r
+  ("_UnsupportedFeature", "0007"); (*to be documented*)\r
+  ("_TypeConflictsInAssign", "0008"); (*to be documented*)\r
+  ("_OperBetweenScalarAndArray", "0009");\r
+  ("_ArrayDimMustAgreeToPerform", "0010");\r
+  ("_FuncCallWithDuplicateArg", "0011");\r
+  ("_TooManyArgsInFuncCall", "0012");\r
+  ("_MixedPositAndNamedFuncArgPass", "0013");\r
+  ("_TypeInconsistWithComparOper", "0014");\r
+  ("_EquTermsNotOfTheSameType", "0015");\r
+  ("_NonInputFuncArgElem", "0016");\r
+  ("_OperAppliedToNonNumericExpr", "0017");\r
+  ("_ArrayDimsNonCompatibleWithMult", "0018");\r
+  ("_PowerOperOnNonSquareArray", "0019");\r
+  ("_NonBooleanIfCondExpr", "0020");\r
+  ("_TypeConflictsInIfAlternExprs", "0021");\r
+  ("_OperAppliedToNonBoolExpr", "0022");\r
+  ("_TypeInconsistentWithDivOper", "0023");\r
+  ("_ElemExpected", "0024");\r
+  ("_FinalElemModifNotAllowed", "0025");\r
+  ("_TypeConflictsInVectorExpr", "0026");\r
+  ("_EachAppliedToNonArrayElem", "0027");\r
+  ("_InvalidExprInElemModif", "0028");\r
+  ("_ClassElemFoundInExpr", "0029");\r
+  ("_ArrayDimMismatchInEqu", "0030");\r
+  ("_InvalidKeyWordEndInExpr", "0031");\r
+  ("_InvalidTypeInRangeExpr", "0032");\r
+  ("_InvalidExtensionDef", "0033");\r
+  ("_InvalidUseOfEnumKeyword", "0034");\r
+  ("_UseOfTypePrefixInShortClassDef", "0035");\r
+  ("_UseOfSubsInShortClassDef", "0036");\r
+  ("_NonEmptyFuncCallUsedAsAnEqu", "0037");\r
+  ("_DuplicatedModifOfElem", "0038");\r
+  ("_InvalidClassElemModif", "0039");\r
+  ("_CannotAccessProtectElem", "0040");\r
+  ("_CannotAccessOuterElem", "0041");\r
+  ("_CannotSubscriptANonArrayTypeElem", "0042");\r
+  ("_NonIntegerArraySubscript", "0043");\r
+  ("_RangeStepValueCannotBeNull", "0044");\r
+  ("_CannotInheritFrom", "0045");\r
+  ("_AlreadyDeclaredInParentClass", "0046");\r
+  ("_InheritFromDiffClassKindsNotAllowed", "0047");\r
+  ("_InheritFromFunctionNotAllowed", "0048");\r
+  ("_InvalidAnnOfInvFunc", "0049");\r
+  ("_CannotUseCausPrefixInGenClass", "0050");\r
+  ("_InvalidTypeOfArgInConnectStat", "0051");\r
+  ("_CannotConnectFlowAndNonFlowComp", "0052");\r
+  ("_InvalidTypeOfWhenCond", "0053");\r
+  ("_InstanceUsedInConnection", "0054");\r
+  ("_WhenClausesCannotBeNested", "0055");\r
+  ("_InvalidWhenEquation", "0056");\r
+  ("_WhenConditionMustBeDiscrete", "0057");\r
+  ("_ArgTypeMismatch", "0058");\r
+  ("_VariabilityConflicts", "0059"); (*to be documented*)\r
+  ("_CannotUseNamedArgWithBuiltInOper", "0060");\r
+  ("_OperArgMustBeAVar", "0061");\r
+  ("_ArgVariabilityMismatch", "0062");\r
+  ("_EquNotAllowedInTheDefOf", "0063");\r
+  ("_OperCannotBeUsedWithinFuncDef", "0064");\r
+  ("_ArgDimMismatchInVectCall", "0065");\r
+  ("_ArgDimMismatch", "0066");\r
+  ("_TooFewArgsInFuncCall", "0067");\r
+  ("_LHSOfDiscreteEquMustBeAVar", "0068");\r
+  ("_InvalidVarOfRangeExpr", "0069");\r
+  ("_InvalidExternalFuncName", "0070"); (*to be documented*)\r
+  ("_InvalidArgOfExternalCall", "0071"); (*to be documented*)\r
+  ("_DuplicateDeclarationOfElement", "0072"); (* to be documented *)\r
+  ("_InvalidArgOfOper", "0096"); (*to be documented*)\r
+  ("_InvalidInteger", "0097") (*to be documented*)\r
+  ]\r
+\r
+(* list of instantiation errors*)\r
+let icodes = [\r
+  ("_NotYetImplemented", "1000");\r
+  ("_ZeroRaisedToTheZeroPower", "1001");\r
+  ("_MissingDeclEquForFixedId", "1002");\r
+  ("_RealExponentOfNegativeNumber", "1003");\r
+  ("_ZeroRaisedToNegativePower", "1004");\r
+  ("_CannotAccessToPredefTypeAttrib", "1005"); (*to be documented*)\r
+  ("_InvalidCondEquation", "1006"); (*to be documented*)\r
+  ("_IndexOutOfBound", "1007"); (*to be documented*)\r
+  ("_DivisionByZero", "1008") (*to be documented*)\r
+  ]\r
+\r
+(* list of generic errors*)\r
+let gcodes = [\r
+  ("_NotYetImplemented", "2000")\r
+  ]\r
+\r
+(* list of syntactic errors*)\r
+let scodes = [\r
+  ("_Unclosed", "3000");\r
+  ("_InvalidMatrixConstruct", "3001");\r
+  ("_InvalidArrayConstruct", "3002");\r
+  ("_SyntaxError", "3003");\r
+  ("_IllegalCharacter", "3004")\r
+  ]\r
+\r
+let getCode exn msg =\r
+  try\r
+    match exn with\r
+      | NameResolve.CompilError _ -> List.assoc msg ccodes\r
+      | Instantiation.InstantError _ -> List.assoc msg icodes\r
+      | GenericError _ -> List.assoc msg gcodes\r
+      | Parser.SyntacticError _ -> List.assoc msg scodes\r
+      | _ -> ""\r
+  with\r
+    exn -> ""\r
diff --git a/scilab/modules/scicos/src/translator/exceptionHandling/exceptHandler.ml b/scilab/modules/scicos/src/translator/exceptionHandling/exceptHandler.ml
new file mode 100644 (file)
index 0000000..7697cfe
--- /dev/null
@@ -0,0 +1,203 @@
+(*
+ *  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.
+ *
+ *)
+
+(* Exception handler module *)
+
+open Parser
+
+type execution_step =
+  | NameResolution
+  | Instantiation of Instantiation.instance_nature
+  | CodeGeneration of Instantiation.instance_nature
+  | SyntacticAnalysis
+
+let display s =
+  print_string (MsgDico.translate s)
+
+let print_offset =
+  function s ->
+      Printf.printf "\n";
+      for i = 1 to 3 do print_string s done;
+      Printf.printf " "
+
+let display_header exn err_msg =
+  let display_code exn err_msg =
+    let rec display_code' err_msg =
+      match err_msg with
+        | [] -> ()
+        | s :: err_msg when s.[0] = '_' -> display (ErrorDico.getCode exn s)
+        | _ :: err_msg -> display_code' err_msg in
+    Printf.printf "\n";
+    display "_ERROR";
+    Printf.printf " ";
+    display_code' err_msg;
+    Printf.printf ":" in
+  let display_message err_msg =
+    let display_elem s =
+      match s with
+        | "" -> ()
+        | s when s.[0] = '_' -> display s; Printf.printf " "
+        | s ->
+            Printf.printf "\"";
+            print_string s;
+            Printf.printf "\" " in
+    let rec display_message' err_msg =
+      match err_msg with
+        | [] -> ()
+        | s :: err_msg ->
+            display_elem s;
+            display_message' err_msg in
+    print_offset("-");
+    display_message' err_msg in
+  display_code exn err_msg;
+  display_message err_msg
+  
+let display_info err_info =
+  let display_value sn sv =
+    match sv with
+      | "" -> ()
+      | s when s.[0] = '_' -> display s
+      | s when sn = "_ExprKind" -> Printf.printf "\"%s\"" s
+      | s -> print_string s in
+  let rec display_info' err_info =
+    match err_info with
+      | [] -> ()
+      | (sn, sv) :: err_info ->
+          print_offset("-");
+          display sn;
+          Printf.printf ": ";
+          display_value sn sv;
+          display_info' err_info in
+  Printf.printf "\n";
+  display_info' err_info
+
+(*let string_of_path path =
+  let rec string_of_path' elem path = match elem, path with
+    | None, []
+    | Some (Instantiation.Name _), [] -> ""
+    | Some (Instantiation.Index _), [] -> "]"
+    | None, (Instantiation.Name s) :: path ->
+        s ^ (string_of_path' (Some (Instantiation.Name s)) path)
+    | Some (Instantiation.Name _), (Instantiation.Name s) :: path ->
+        "." ^ s ^ (string_of_path' (Some (Instantiation.Name s)) path)
+    | Some (Instantiation.Index _), (Instantiation.Name s) :: path ->
+        "]." ^ s ^ (string_of_path' (Some (Instantiation.Name s)) path)
+    | Some (Instantiation.Index _), (Instantiation.Index i) :: path ->
+        ", " ^ (string_of_int i) ^
+        (string_of_path' (Some (Instantiation.Index i)) path)
+    | _, (Instantiation.Index i) :: path ->
+        "[" ^ (string_of_int i) ^
+        (string_of_path' (Some (Instantiation.Index i)) path) in
+  string_of_path' None path*)
+
+let last path =
+  let rec last' id path = match path with
+    | [] -> id
+    | (Instantiation.Name id) :: path -> last' id path
+    | (Instantiation.Index _) :: path -> last' id path in
+  last' "" path
+
+let loc_info loc =
+  match loc.filename with
+    | Parser.CommandLine ->
+        [("_Source", "_CommandLine");
+         ("_CharacterPosition", string_of_int (loc.Parser.start + 1))]
+    | Parser.LibraryFile lib_file ->
+        let linenum, linebeg =
+          Linenum.for_position lib_file loc.Parser.start in
+        [("_Source", lib_file);
+         ("_LineNumber", string_of_int linenum);
+         ("_ColumnNumber", string_of_int (loc.Parser.start - linebeg + 1))]
+
+let class_name_info instance_nature = match instance_nature with
+  | Instantiation.ClassElement -> []
+  | Instantiation.ComponentElement s -> [("_ClassName", s)]
+
+let exec_step_info step opath =
+  let string_of_step = match step with
+    | NameResolution -> "_NameResolution"
+    | Instantiation Instantiation.ClassElement ->
+        "_InstantiationOfClass"
+    | Instantiation Instantiation.ComponentElement _ ->
+        "_InstantiationOfComponent"
+    | CodeGeneration Instantiation.ClassElement ->
+        "_CodeGenerationForClass"
+    | CodeGeneration Instantiation.ComponentElement _ ->
+        "_CodeGenerationForComponent"
+    | SyntacticAnalysis -> "_SyntacticAnalysis" in
+  let path_info = match opath with
+    | None -> ""
+    | Some path -> " \"" ^ (last path) ^ "\"" in
+  [("_ExecutionStep", (MsgDico.translate string_of_step) ^ path_info)]
+
+(* This function is'nt called if all exception types are correctly handled. *)
+let handle_unhandledException exn =
+  Printf.printf "\nUnhandled exception: %s\n" (Printexc.to_string exn)
+
+let handle exn =
+  let handle' =
+    match exn with
+      | NameResolve.CompilError { NameResolve.err_msg = err_msg;
+                                  NameResolve.err_info = err_info;
+                                  NameResolve.err_ctx = ctx } ->
+          display_header exn err_msg;
+          display_info (exec_step_info NameResolution None);
+          display_info
+            (loc_info ctx.NameResolve.location);
+          display_info err_info;
+          Printf.printf "\n"
+      | Instantiation.InstantError { Instantiation.err_msg = err_msg;
+                                     Instantiation.err_info = err_info;
+                                     Instantiation.err_ctx = ctx } ->
+          display_header exn err_msg;
+          let opath = (Some ctx.Instantiation.path)
+          and step = Instantiation ctx.Instantiation.instance_nature in
+          display_info (exec_step_info step opath);
+          display_info
+            ((class_name_info ctx.Instantiation.instance_nature) @
+            (loc_info ctx.Instantiation.location));
+          display_info err_info;
+          Printf.printf "\n"
+      | ErrorDico.GenericError { ErrorDico.err_msg = err_msg;
+                                 ErrorDico.err_info = err_info;
+                                 ErrorDico.err_ctx = ctx } ->
+          display_header exn err_msg;
+          let step = CodeGeneration ctx.ErrorDico.instance_nature in
+          display_info (exec_step_info step (Some ctx.ErrorDico.path));
+          display_info
+            ((class_name_info ctx.ErrorDico.instance_nature) @
+            (loc_info ctx.ErrorDico.location));
+          display_info err_info;
+          Printf.printf "\n"
+      | Parser.SyntacticError { Parser.err_msg = err_msg;
+                                Parser.err_info = err_info;
+                                Parser.err_ctx = ctx } ->
+          display_header exn err_msg;
+          display_info (exec_step_info SyntacticAnalysis None);
+          display_info
+            (loc_info ctx.Parser.location);
+          display_info err_info;
+          Printf.printf "\n"
+      | _ -> 
+          handle_unhandledException exn in
+  handle'
+
diff --git a/scilab/modules/scicos/src/translator/exceptionHandling/msgDico.ml b/scilab/modules/scicos/src/translator/exceptionHandling/msgDico.ml
new file mode 100644 (file)
index 0000000..7c9efb4
--- /dev/null
@@ -0,0 +1,462 @@
+(*\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
+(* Compilation message translation dictionary *)\r
+\r
+let msgs = [\r
+  ("_UnknownIdentifier",\r
+    [("ENG", "Unknown identifier")]);\r
+  ("_EnumTypeDefWithDuplicLit",\r
+    [("ENG", "Enumeration type definition with duplicated literal")]);\r
+  ("_NotYetImplemented",\r
+    [("ENG", "Use of not yet implemented feature:")]);\r
+  ("_EncapsulatedCannotBeAppliedTo",\r
+    [("ENG", "\"encapsulated\" keyword cannot be applied to")]);\r
+  ("_UnspecifiedEnumLits",\r
+    [("ENG", "Enumeration literals not specified")]);\r
+  ("_CommandLine",\r
+    [("ENG", "command line")]);\r
+  ("_CharacterPosition",\r
+    [("ENG", "Character position")]);\r
+  ("_LineNumber",\r
+    [("ENG", "Line number")]);\r
+  ("_ColumnNumber",\r
+    [("ENG", "Column number")]);\r
+  ("_Context",\r
+    [("ENG", "Context")]);\r
+  ("_UntranslatedText",\r
+    [("ENG", "Untranslated text")]);\r
+  ("_NonBooleanIfCondExpr",\r
+    [("ENG", "Non-Boolean \"if\" condition expression")]);\r
+  ("_TypeConflictsInIfAlternExprs",\r
+    [("ENG", "If alternative expressions must be of the same type")]);\r
+  ("_InvalidTypeInRangeExpr",\r
+    [("ENG", "Invalid type of element in range expression")]);\r
+  ("_NonIntegerRangeExpr",\r
+    [("ENG", "Non-integer range expression")]);\r
+  ("_TypeConflictsInVectorExpr",\r
+    [("ENG", "Elements of different types in vector expression")]);\r
+  ("_NonPredefTypeVectorExpr",\r
+    [("ENG", "Only vector expressions of predefined type elements are supported")]);\r
+  ("_ArrayDimMustAgreeToPerform",\r
+    [("ENG", "Array dimensions must agree to perform")]);\r
+  ("_ImplicitIterRange",\r
+    [("ENG", "Implicit iteration range")]);\r
+  ("_UnaryOperPLUS",\r
+    [("ENG", "Unary operator +")]);\r
+  ("_MatrixExpr",\r
+    [("ENG", "Matrix expression")]);\r
+  ("_BinaryOperDIFF",\r
+    [("ENG", "Binary operator <>")]);\r
+  ("_BinaryOperEQUEQU",\r
+    [("ENG", "Binary operator ==")]);\r
+  ("_TopLevelExpr",\r
+    [("ENG", "expression statement")]);\r
+  ("_TopLevelAlgorithm",\r
+    [("ENG", "algorithmic statement")]);\r
+  ("_WithinClause",\r
+    [("ENG", "within clause")]);\r
+  ("_ImportClause",\r
+    [("ENG", "import clause")]);\r
+  ("_InvalidTypeDef",\r
+    [("ENG", "Invalid \"type\" definition")]);\r
+  ("_ShortClassDef",\r
+    [("ENG", "Short class definition")]);\r
+  ("_ClassDefByExtension",\r
+    [("ENG", "Class definition by extension")]);\r
+  ("_InvalidUseOfEnumKeyword",\r
+    [("ENG", "Invalid use of \"enumeration\" keyword")]);\r
+  ("_ClassExtendsDef",\r
+    [("ENG", "Class definition by extension")]);\r
+  ("_OperAppliedToNonNumericExpr",\r
+    [("ENG", "operator applied to non numeric expression")]);\r
+  ("_PowerOperOnNonSquareArray",\r
+    [("ENG", "Cannot perform power operation on non square array")]);\r
+  ("_ArrayDimMustAgreeToPerform",\r
+    [("ENG", "Array dimensions must agree to perform")]);\r
+  ("_EachAppliedToNonArrayElem",\r
+    [("ENG", "Cannot apply \"each\" keyword to non-array type element")]);\r
+  ("_EquTermsNotOfTheSameType",\r
+    [("ENG", "Equation terms must be of the same type")]);\r
+  ("_ClassElemFoundInExpr",\r
+    [("ENG", "Component element expected, but class element found")]);\r
+  ("_InvalidExtensionDef",\r
+    [("ENG", "Invalid extension definition")]);\r
+  ("_VariablityConflictsInCompDef",\r
+    [("ENG", "Variability conflicts in component definition")]);\r
+  ("_CausalityConflictsInCompDef",\r
+    [("ENG", "Causality conflicts in component definition")]);\r
+  ("_TypeConflictsInAssign",\r
+    [("ENG", "Type conflicts in assignment expression")]);\r
+  ("_InvalidExprInElemModif",\r
+    [("ENG", "Invalid expression in element modification")]);\r
+  ("_FieldAccessInElemModifExpr",\r
+    [("ENG", "Field access in element modification expression")]);\r
+  ("_ElementRedeclaration",\r
+    [("ENG", "Element redeclaration")]);\r
+  ("_InvalidTypeOfClassSpec",\r
+    [("ENG", "Invalid type of class specifier")]);\r
+  ("_RedeclarePredefTypeAttrib",\r
+    [("ENG", "Redeclaration not allowed for predefined type attributes")]);\r
+  ("_InvalidClassElemModif",\r
+    [("ENG", "Invalid modification of class element")]);\r
+  ("_FinalElemModifNotAllowed",\r
+    [("ENG", "Cannot modify final element")]);\r
+  ("_InvalidElemModifDef",\r
+    [("ENG", "Invalid element modification definition")]);\r
+  ("_ArrayDimMismatchInEqu",\r
+    [("ENG", "Array dimensions do not agree in equation")]);\r
+  ("_ComponentTypeEqu",\r
+    [("ENG", "Component type equation")]);\r
+  ("_AlgoClause",\r
+    [("ENG", "Algorithm clause")]);\r
+  ("_InvalidKeyWordEndInExpr",\r
+    [("ENG", "Invalid use of expression \"end\"")]);\r
+  ("_InvalidTypeOfFuncValueInEqu",\r
+    [("ENG", "Invalid type of function value in equation")]);\r
+  ("_FuncArgumentReduction",\r
+    [("ENG", "Function argument reduction")]);\r
+  ("_TooManyArgsInFuncCall",\r
+    [("ENG", "Too many arguments in function call")]);\r
+  ("_FuncCallWithDuplicateArg",\r
+    [("ENG", "Function call with duplicate named argument")]);\r
+  ("_MixedPositAndNamedFuncArgPass",\r
+    [("ENG", "Mixed positional and named function argument passing not allowed")]);\r
+  ("_NonInputFuncArgElem",\r
+    [("ENG", "Function called with non input argument")]);\r
+  ("_NoInnerDeclForOuterElem",\r
+    [("ENG", "Missed inner declaration for outer element")]);\r
+  ("_BlockElem",\r
+    [("ENG", "Block element")]);\r
+  ("_ExpandableConnector",\r
+    [("ENG", "Expandable connector")]);\r
+  ("_PredefinedTypeAttribModif",\r
+    [("ENG", "Modification of predefined type attribute")]);\r
+  ("_UnsupportedFeature",\r
+    [("ENG", "Use of unsupported feature:")]); (*to be documented*)\r
+  ("_OperAppliedToNonBoolExpr",\r
+    [("ENG", "operator applied to non-Boolean expression")]);\r
+  ("_TypeDef",\r
+    [("ENG", "\"type\" definition")]);\r
+  ("_AddOper",\r
+    [("ENG", "addition operation")]);\r
+  ("_TypeInconsistWithComparOper",\r
+    [("ENG", "Type of operands inconsistent with comparison operation")]);\r
+  ("_OperBetweenScalarAndArray",\r
+    [("ENG", "operator between scalar and array type elements")]);\r
+  ("_Addition",\r
+    [("ENG", "addition")]);\r
+  ("_Subtraction",\r
+    [("ENG", "subtraction")]);\r
+  ("_TypeInconsistentWithDivOper",\r
+    [("ENG", "Type of operands inconsistent with division operation")]);\r
+  ("_ArrayDimsNonCompatibleWithMult",\r
+    [("ENG", "Arrays do not have compatible dimensions to be multiplied")]);\r
+  ("_ERROR",\r
+    [("ENG", "ERROR")]);\r
+  ("_ElemExpected",\r
+    [("ENG", "element expected")]);\r
+  ("_UseOfTypePrefixInShortClassDef",\r
+    [("ENG", "Use of type prefix not allowed in short class definition")]);\r
+  ("_UseOfSubsInShortClassDef",\r
+    [("ENG", "Use of subscripts not allowed in short class definition")]);\r
+  ("_NonEmptyFuncCallUsedAsAnEqu",\r
+    [("ENG", "Non-empty function call cannot be used as an equation")]);\r
+  ("_DuplicatedModifOfElem",\r
+    [("ENG", "Duplicated modification of element")]);\r
+  ("_ComponentTypeElemInstant",\r
+    [("ENG", "Component type element instantiation")]);\r
+  ("_PredefinedTypeElemInstant",\r
+    [("ENG", "Predefined type element instantiation")]);\r
+  ("_Component",\r
+    [("ENG", "Component")]);\r
+  ("_CannotAccessProtectElem",\r
+    [("ENG", "Cannot access protected element")]);\r
+  ("_CannotAccessOuterElem",\r
+    [("ENG", "Cannot access outer element")]);\r
+  ("_UnknownFunction",\r
+    [("ENG", "Unknown function")]);\r
+  ("_ZeroRaisedToTheZeroPower",\r
+    [("ENG", "Zero raised to the zero power")]);\r
+  ("_IntegerRaisedToIntegerPower",\r
+    [("ENG", "Integer raised to an integer power")]);\r
+  ("_RealRaisedToIntegerPower",\r
+    [("ENG", "Real raised to an integer power")]);\r
+  ("_VectorRaisedToIntegerPower",\r
+    [("ENG", "Vector raised to an integer power")]);\r
+  ("_NonIntegerArrayDim",\r
+    [("ENG", "Non-Integer array dimension")]);\r
+  ("_EnumType",\r
+    [("ENG", "Enumeration type")]);\r
+  ("_StringType",\r
+    [("ENG", "String type")]);\r
+  ("_BooleanType",\r
+    [("ENG", "Boolean type")]);\r
+  ("_BooleanOperator",\r
+    [("ENG", "Boolean operator")]);\r
+  ("_DynamicArrayType",\r
+    [("ENG", "Dynamic array type")]);\r
+  ("_StaticArrayType",\r
+    [("ENG", "Static array type")]);\r
+  ("_InstanceType",\r
+    [("ENG", "Instance type")]);\r
+  ("_ConditionalEqu",\r
+    [("ENG", "Conditional equation")]);\r
+  ("_FieldAccessExpr",\r
+    [("ENG", "Field access expression")]);\r
+  ("_IndexedAccessExpr",\r
+    [("ENG", "Indexed access expression")]);\r
+  ("_RangeExpr",\r
+    [("ENG", "Range expression")]);\r
+  ("_Expr",\r
+    [("ENG", "Expression")]);\r
+  ("_ExprOfType",\r
+    [("ENG", "Expression of type")]);\r
+  ("_TupleExpr",\r
+    [("ENG", "Tuple expression")]);\r
+  ("_VectorReduct",\r
+    [("ENG", "Vector reduction")]);\r
+  ("_LoopVar",\r
+    [("ENG", "Loop variable")]);\r
+  ("_PredefinedTypeClassRef",\r
+    [("ENG", "Predefined type class reference")]);\r
+  ("_NonExternalCallClassRef",\r
+    [("ENG", "Use of class reference in expression is allowed only for external function call")]);\r
+  ("_ExternalProcedureCall",\r
+    [("ENG", "External procedure call")]);\r
+  ("_ExternalCallToLanguage",\r
+    [("ENG", "External call to language")]);\r
+  ("_ExternalCallWithLeftHandSideExpr",\r
+    [("ENG", "External call with left hand side expression")]);\r
+  ("_AssignExprInElemModif",\r
+    [("ENG", "Assignment expression in element modification")]);\r
+  ("_CannotSubscriptANonArrayTypeElem",\r
+    [("ENG", "Cannot subscript a non array type element")]);\r
+  ("_NonIntegerArraySubscript",\r
+    [("ENG", "Non-Integer array subscript")]);\r
+  ("_RangeStepValueCannotBeNull",\r
+    [("ENG", "Range step value cannot be null")]);\r
+  ("_TypeOfA",\r
+    [("ENG", "Type of A")]);\r
+  ("_TypeOfB",\r
+    [("ENG", "Type of B")]);\r
+  ("_Source",\r
+    [("ENG", "Source")]);\r
+  ("_ClassName",\r
+    [("ENG", "Class name")]);\r
+  ("_FunctionCallExpr",\r
+    [("ENG", "Function call expression")]);\r
+  ("_VectorExpr",\r
+    [("ENG", "Vector expression")]);\r
+  ("_ExprKind",\r
+    [("ENG", "Expression kind")]);\r
+  ("_TypeOfThenBranche",\r
+    [("ENG", "Type of then branche")]);\r
+  ("_TypeOfElseBranche",\r
+    [("ENG", "Type of else branche")]);\r
+  ("_TypePrefix",\r
+    [("ENG", "Type prefix")]);\r
+  ("_ElemFound",\r
+    [("ENG", "Element found")]);\r
+  ("_TypeSpecifierVariability",\r
+    [("ENG", "Type specifier variability")]);\r
+  ("_TypeSpecifierCausality",\r
+    [("ENG", "Type specifier causality")]);\r
+  ("_TypeOfCondition",\r
+    [("ENG", "Type of \"condition\"")]);\r
+  ("_TypeFound",\r
+    [("ENG", "Type found")]);\r
+  ("_ComponentElement",\r
+    [("ENG", "Component element")]);\r
+  ("_ExpectedType",\r
+    [("ENG", "Expected type")]);\r
+  ("_ClassElement",\r
+    [("ENG", "Class element")]);\r
+  ("_ArrayType",\r
+    [("ENG", "Array type")]);\r
+  ("_ClassSpecifier",\r
+    [("ENG", "Class specifier")]);\r
+  ("_TypeOfFuncValue",\r
+    [("ENG", "Type of function value")]);\r
+  ("_TypeOfFunctionOutput",\r
+    [("ENG", "Type of function output")]);\r
+  ("_CannotInheritFrom",\r
+    [("ENG", "Cannot inherit from")]);\r
+  ("_ComponentTypeElement",\r
+    [("ENG", "Component type element")]);\r
+  ("_PredefinedTypeElement",\r
+    [("ENG", "Predefined type element")]);\r
+  ("_AlreadyDeclaredInParentClass",\r
+    [("ENG", "already declared in parent class")]);\r
+  ("_InheritFromDiffClassKindsNotAllowed",\r
+    [("ENG", "Inheritance from different class kinds not allowed")]);\r
+  ("_MismatchingTypes",\r
+    [("ENG", "Mismatching types")]);\r
+  ("_InheritFromFunctionNotAllowed",\r
+    [("ENG", "Inheritance from function not allowed")]);\r
+  ("_InvalidAnnOfInvFunc",\r
+    [("ENG", "Invalid annotation of inverse functions:")]);\r
+  ("_RedeclarationNotAllowed",\r
+    [("ENG", "Redeclaration not allowed")]);\r
+  ("_UseOfEachKeywordNotAllowed",\r
+    [("ENG", "Use of \"each\" keyword not allowed")]);\r
+  ("_UseOfFinalKeywordNotAllowed",\r
+    [("ENG", "Use of \"final\" keyword not allowed")]);\r
+  ("_UnspecifiedModification",\r
+    [("ENG", "Unspecified modification")]);\r
+  ("_InvalidModifExpr",\r
+    [("ENG", "Invalid modification expression")]);\r
+  ("_InvalidFuncCallExpr",\r
+    [("ENG", "Invalid function call expression")]);\r
+  ("_InvalidTypeOfFuncCallExpr",\r
+    [("ENG", "Invalid type of function call expression")]);\r
+  ("_ClassType",\r
+    [("ENG", "Class type")]);\r
+  ("_Function",\r
+    [("ENG", "Function")]);\r
+  ("_FuncArgReductionNotAllowed",\r
+    [("ENG", "Function argument reduction not allowed")]);\r
+  ("_CannotUseUnnamedFuncArg",\r
+    [("ENG", "Cannot use unnamed function argument")]);\r
+  ("_InvalidFuncArgModif",\r
+    [("ENG", "Invalid function argument modification")]);\r
+  ("_UnknownArgName",\r
+    [("ENG", "Unknown argument name")]);\r
+  ("_CannotUseCausPrefixInGenClass",\r
+    [("ENG", "Input or output component found in generic class")]);\r
+  ("_FuncDefInNonInstantiatedClass",\r
+    [("ENG", "Function defined in non instantiated class")]);\r
+  ("_InvalidTypeOfArgInConnectStat",\r
+    [("ENG", "Invalid type of argument in connect statement")]);\r
+  ("_CannotConnectFlowAndNonFlowComp",\r
+    [("ENG", "Cannot connect flow and non-flow components")]);\r
+  ("_InvalidTypeOfWhenCond",\r
+    [("ENG", "Invalid type of when condition")]);\r
+  ("_NameResolution",\r
+    [("ENG", "Name resolution")]);\r
+  ("_InstantiationOfComponent",\r
+    [("ENG", "Instantiation of component")]);\r
+  ("_CodeGenerationForComponent",\r
+    [("ENG", "Code generation for component")]);\r
+  ("_ExecutionStep",\r
+    [("ENG", "Execution step")]);\r
+  ("_MissingDeclEquForFixedId",\r
+    [("ENG", "Missing declaration equation for fixed identifier")]);\r
+  ("_ComponentFuncInvocation",\r
+    [("ENG", "Component function invocation")]);\r
+  ("_FuncWithManyOutputs",\r
+    [("ENG", "Function with many outputs")]);\r
+  ("_InstantiationOfClass",\r
+    ["ENG", "Instantiation of class"]);\r
+  ("_CodeGenerationForClass",\r
+    ["ENG", "Code generation for class"]);\r
+  ("_InstanceUsedInConnection",\r
+    [("ENG", "instance used in connection statement")]);\r
+  ("_Unclosed",\r
+    [("ENG", "Unclosed")]);\r
+  ("_InvalidMatrixConstruct",\r
+    [("ENG", "Invalid matrix construction")]);\r
+  ("_InvalidArrayConstruct",\r
+    [("ENG", "Invalid array construction")]);\r
+  ("_SyntaxError",\r
+    [("ENG", "Syntax error")]);\r
+  ("_SyntacticAnalysis",\r
+    [("ENG", "Syntactic analysis")]);\r
+  ("_PredefType",\r
+    [("ENG", "Predefined type")]);\r
+  ("_WhenClausesCannotBeNested",\r
+    [("ENG", "When clauses cannot be nested")]);\r
+  ("_InvalidWhenEquation",\r
+    [("ENG", "Invalid form of equation within when clause")]);\r
+  ("_WhenConditionMustBeDiscrete",\r
+    [("ENG", "When condition must be discrete-time expression")]);\r
+  ("_ArgTypeMismatch",\r
+    [("ENG", "Argument type mismatch")]);\r
+  ("_VariabilityOfA",\r
+    [("ENG", "Variability of A")]);\r
+  ("_VariabilityOfB",\r
+    [("ENG", "Variability of B")]);\r
+  ("_VariabilityConflicts",\r
+    [("ENG", "Variability conflicts")]);\r
+  ("_CannotUseNamedArgWithBuiltInOper",\r
+    [("ENG", "Cannot use named argument with a built-in operator or function")]);\r
+  ("_OperArgMustBeAVar",\r
+    [("ENG", "operator argument must be a variable")]);\r
+  ("_ArgVariabilityMismatch",\r
+    [("ENG", "Argument variability mismatch")]);\r
+  ("_ExpectedVariability",\r
+    [("ENG", "Expected variability")]);\r
+  ("_VariabilityFound",\r
+    [("ENG", "Variability found")]);\r
+  ("_EquNotAllowedInTheDefOf",\r
+    [("ENG", "Equations not allowed in the definition of")]);\r
+  ("_OperCannotBeUsedWithinFuncDef",\r
+    [("ENG", "operator cannot be used within function definition")]);\r
+  ("_ArgDimMismatchInVectCall",\r
+    [("ENG", "Arguments dimensions mismatch in vectorized function call")]);\r
+  ("_ArgDimMismatch",\r
+    [("ENG", "Argument dimension mismatch")]);\r
+  ("_TooFewArgsInFuncCall",\r
+    [("ENG", "Too few arguments in function call")]);\r
+  ("_LHSOfDiscreteEquMustBeAVar",\r
+    [("ENG", "Left hand side of discrete equation must be a variable")]);\r
+  ("_InvalidVarOfRangeExpr",\r
+    [("ENG", "Invalid variability of range expression")]);\r
+  ("_RealExponentOfNegativeNumber",\r
+    [("ENG", "Real exponentiation of negative number")]);\r
+  ("_ZeroRaisedToNegativePower",\r
+    [("ENG", "Zero raised to negative power")]);\r
+  ("_IllegalCharacter",\r
+    [("ENG", "Illegal character")]); (*to be documented*)\r
+  ("_InvalidExternalFuncName",\r
+    [("ENG", "Invalid external function name")]); (*to be documented*)\r
+  ("_LHSOfExternalCall",\r
+    [("ENG", "Left hand side of external call")]); (*to be documented*)\r
+  ("_InvalidArgOfExternalCall",\r
+    [("ENG", "Invalid argument of external call")]); (*to be documented*)\r
+  ("_CannotAccessToPredefTypeAttrib",\r
+    [("ENG", "Cannot access predefined type attribute")]);\r
+  ("_InvalidCondEquation",\r
+    [("ENG", "Invalid conditional equation")]);\r
+  ("_IndexOutOfBound",\r
+    [("ENG", "Index out of bound")]);\r
+  ("_DivisionByZero",\r
+    [("ENG", "Division by zero")]);\r
+  ("_PredefinedOperator",\r
+    [("ENG", "Predefined operator")]);\r
+  ("_InvalidArgOfOper",\r
+    [("ENG", "Invalid argument of operator")]);\r
+  ("_UnsupportedDerOperArg",\r
+    [("ENG", "Unsupported \"der\" operator argument")]);\r
+  ("_InvalidInteger",\r
+    [("ENG", "Invalid Integer representation")]);\r
+  ("_NonSupportedTypeOfFuncInOut",\r
+    [("ENG", "Non supported type of function input or output")]);\r
+  ("_DuplicateDeclarationOfElement",\r
+    [("ENG", "Duplicate declaration of element")]) (* to be documented *)\r
+  ]\r
+\r
+let translate msg =\r
+  try\r
+    List.assoc "ENG" (List.assoc msg msgs)\r
+  with\r
+    exn -> msg;\r
diff --git a/scilab/modules/scicos/src/translator/instantiation/.depend b/scilab/modules/scicos/src/translator/instantiation/.depend
new file mode 100644 (file)
index 0000000..9a7fa86
--- /dev/null
@@ -0,0 +1,4 @@
+instantiation.cmo: ../compilation/types.cmo ../parsing/syntax.cmo \
+    ../parsing/parser.cmo ../compilation/nameResolve.cmo 
+instantiation.cmx: ../compilation/types.cmx ../parsing/syntax.cmx \
+    ../parsing/parser.cmx ../compilation/nameResolve.cmx 
diff --git a/scilab/modules/scicos/src/translator/instantiation/instantiation.ml b/scilab/modules/scicos/src/translator/instantiation/instantiation.ml
new file mode 100644 (file)
index 0000000..038645b
--- /dev/null
@@ -0,0 +1,2531 @@
+(*\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
+type ('a, 'b) node =\r
+  {\r
+    nature: 'a;\r
+    info: 'b\r
+  }\r
+\r
+type instance =\r
+  {\r
+    enclosing_instance: instance option;\r
+    kind: Types.kind;\r
+    elements: instance_elements Lazy.t\r
+  }\r
+\r