end of line
[scilab.git] / scilab / modules / scicos / src / translator / compilation / nameResolve.ml
1 (*
2  *  Translator from Modelica 2.x to flat Modelica
3  *
4  *  Copyright (C) 2005 - 2007 Imagine S.A.
5  *  For more information or commercial use please contact us at www.amesim.com
6  *
7  *  This program is free software; you can redistribute it and/or
8  *  modify it under the terms of the GNU General Public License
9  *  as published by the Free Software Foundation; either version 2
10  *  of the License, or (at your option) any later version.
11  *
12  *  This program is distributed in the hope that it will be useful,
13  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  *  GNU General Public License for more details.
16  *
17  *  You should have received a copy of the GNU General Public License
18  *  along with this program; if not, write to the Free Software
19  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
20  *
21  *)
22
23 (** Resolution of types for Modelica elements from the abstract syntax tree.
24 The main functions are:
25 {ul
26 {- [ resolve_toplevel ]: Main function. Resolve a list of top level syntax element}
27 {- [ resolve_variable_definition ]: Resolution of a variable definition}
28 {- [ resolve_class_definition ]: Resolution of a class definition}
29 {- [ resolve_modification ]: Resolution of modifications}
30 {- [ resolve_expression ]: Resolution of syntax expressions
31   {ul
32   {- [ resolve_binary_operation ]: Resolve binary operation expression }
33   {- [ resolve_unuary_operation ]: Resolve unary operation }
34   {- [ resolve_identifier ]: scoping algorithm and resolution of identifiers}
35   {- [ apply_binary_coercions, apply_rhs_coercions ]: Adding of Real to Integer implicit coercions}
36   {- [ resolve_function_call ]: Resolution of a function call expression }
37   {- [ resolve_field_access ]: Resolve field access }
38   {- [ resolve_if ]: Resolve [ if ] expression }
39   {- [ resolve_indexed_access ]: Resolve indexed access }
40   {- [ resolve_vector ]: Resolve vector expression }
41   {- [ resolve_range ]: resolve range expression }
42   }
43 }
44 {- [ resolve_equation ]: Resolution of an equation
45   {ul
46   {- [ resolve_equal ]: Resolution of a simple equation of the form [ expr1 = expr2 ] }
47   {- [ resolve_conditional_equation_e ]: Resolution of conditional equations }
48   {- [ resolve_for_clause_e ]: Resolution of for equations }
49   {- [ resolve_connect_clause ]: resolution of connect equations }
50   {- [ resolve_when_clause_e ]: resolution of when equations}
51   {- [ equations ]: resolution of array, record and for equations
52   }
53 }
54 }
55 *)
56
57 (* The type [ node ] is used to attach syntax information to resolved elements *)
58 type ('a, 'b) node =
59   {
60     nature: 'a;
61     info: 'b
62   }
63
64 (* Type of resolved elements *)
65
66 and element_description =
67   {
68     element_type: Types.element_type Lazy.t;
69     redeclare: bool;
70     element_nature: element_nature;
71     element_location: Parser.location
72   }
73
74 and element_nature =
75   | Component of component_description
76   | Class of class_definition
77   | ComponentType of component_type_description
78   | PredefinedType of Types.predefined_type
79
80 and component_description =
81   {
82     component_type: Types.component_type Lazy.t;
83     type_specifier: expression Lazy.t;
84     dimensions: dimension list Lazy.t;
85     modification: modification option Lazy.t;
86     comment: string
87   }
88
89 and dimension =
90   | Colon
91   | Expression of expression
92
93 and class_definition =
94   {
95     class_type: Types.class_specifier Lazy.t;
96     enclosing_class: class_definition option;
97     encapsulated: bool;
98     description: class_description Lazy.t;
99   }
100
101 and class_description =
102   | LongDescription of long_description
103   | ShortDescription of modified_class
104
105 and long_description =
106   {
107     class_annotations: (annotation list) Lazy.t;
108     imports: import_description list;
109     extensions: (visibility * modified_class) list;
110     named_elements: named_element list;
111     unnamed_elements: equation_or_algorithm_clause list Lazy.t;
112     external_call: external_call option Lazy.t
113   }
114
115 and annotation =
116   | InverseFunction of inverse_function Lazy.t
117   | UnknownAnnotation of (Parser.location Syntax.class_modification) Lazy.t
118
119 and inverse_function =
120   {
121     function_class: expression;
122     arguments: (string * string) list
123   }
124
125 and import_description = unit
126
127 and visibility = Public | Protected
128
129 and named_element = string * element_description
130
131 and modified_class =
132   {
133     modified_class_type: Types.class_type Lazy.t;
134     base_class: expression Lazy.t;
135     class_modification: class_modification Lazy.t
136   }
137
138 and component_type_description =
139   {
140     described_type: Types.component_type Lazy.t;
141     base_type: expression Lazy.t;
142     type_dimensions: dimension list Lazy.t;
143     type_modification: class_modification Lazy.t
144   }
145
146 and external_call = (external_call_desc, Parser.location Syntax.externalll) node
147
148 and external_call_desc =
149   | PrimitiveCall of string
150   | ExternalProcedureCall of language *
151       expression option (* rhs *) * string * expression list
152
153 and language = C | FORTRAN
154
155 and modification =
156   | Modification of class_modification * expression Lazy.t option
157   | Assignment of expression Lazy.t
158   | Equality of expression Lazy.t
159
160 and class_modification = modification_argument list
161
162 and modification_argument =
163   {
164     each: bool;
165     final: bool;
166     target: string;
167     action: modification_action option
168   }
169
170 and modification_action =
171   | ElementModification of modification
172   | ElementRedeclaration of element_description
173
174 (* Type of equations and algorithms *)
175
176 and equation_or_algorithm_clause =
177   | EquationClause of validity * equation list
178   | AlgorithmClause of validity * algorithm list
179
180 and validity = Initial | Permanent
181
182 and equation = (equation_desc, Parser.location Syntax.equation option) node
183
184 and equation_desc =
185   | Equal of expression * expression
186   | ConditionalEquationE of (expression * equation list) list * equation list
187   | ForClauseE of expression list (* ranges *) * equation list
188   | ConnectFlows of sign * expression * sign * expression
189   | WhenClauseE of (expression * equation list) list
190
191 and sign = Positive | Negative
192
193 and algorithm = (algorithm_desc, Parser.location Syntax.algorithm option) node
194
195 and algorithm_desc =
196   | Assign of expression * expression
197   | FunctionCallA of expression * expression list
198   | MultipleAssign of expression list * expression * expression list
199   | Break
200   | Return
201   | ConditionalEquationA of (expression * algorithm list) list *
202       algorithm list
203   | ForClauseA of expression list (* ranges *) * algorithm list
204   | WhileClause of expression * algorithm list
205   | WhenClauseA of (expression * algorithm list) list
206
207 (* Type of expressions *)
208
209 and expression = (expression_desc, expression_information) node
210
211 (* Type of a resolved expression:
212 - [ syntax ]: expression syntax (this information is optional, some expressions
213   are dynamicaly created during typing analysis)
214 - [ type_description ]: expression type *)
215 and expression_information =
216   {
217     syntax: Parser.location Syntax.expression option;
218     type_description: Types.element_nature
219   }
220
221 and expression_desc =
222   | BinaryOperation of binary_operator_kind * expression * expression
223   | DynamicIdentifier of int (** number of nested classes to skip *) *
224       string (** name to be searched for at instanciation time *)
225   | False
226   | FieldAccess of expression * string
227   | FunctionArgument of int (** the position of the argument in the call *)
228   | FunctionCall of expression (** function *) *
229       expression list (** arguments *) *
230       expression (** the expression involving the function call *)
231       (** creation of a dynamic function context *)
232   | FunctionInvocation of expression list
233       (** invocation of the current function in context *)
234   | If of (expression (** condition *) * expression) list *
235       expression (** default *)
236   | IndexedAccess of expression * expression list (* subscripts *)
237   | Integer of int32
238   | LocalIdentifier of int (** number of nested classes to skip *) *
239       string (** key in the dictionary of the defining class *)
240   | LoopVariable of int (** number of nested for loops to skip *)
241   | NoEvent of expression
242   | PredefinedIdentifier of string (** predefined identifier *)
243   | Range of expression * expression * expression
244   | Real of float
245   | String of string
246   | ToplevelIdentifier of string (** key in the toplevel dictionary *)
247   | True
248   | Tuple of expression list
249   | UnaryOperation of unary_operator_kind * expression
250   | Vector of expression list
251   | VectorReduction of expression list (** nested ranges *) * expression
252   | Coercion of coercion_kind * expression
253
254 and coercion_kind =
255   | RealOfInteger (** Implicit conversion of Integer to Real *)
256
257 and unary_operator_kind =
258   | Not
259   | UnaryMinus
260   | UnaryPlus
261
262 and binary_operator_kind =
263   | And
264   | Divide
265   | EqualEqual
266   | GreaterEqual
267   | Greater
268   | LessEqual
269   | Less
270   | Times
271   | NotEqual
272   | Or
273   | Plus
274   | Power
275   | Minus
276
277 (* Context types. Contexts are used to resolve identifiers in expressions *)
278
279 type context =
280   {
281     toplevel: (string * element_description) list Lazy.t;
282     context_nature: context_nature;
283     location: Parser.location
284   }
285
286 and context_nature =
287   | ToplevelContext
288   | ClassContext of class_definition
289   | SubscriptContext of
290       context * expression (* evaluating to an array *) *
291       int32 (* dimension index *) * Types.dimension
292   | ForContext of context * string * Types.element_nature
293
294 (* Type Errors detected during compilation *)
295
296 type error_description =
297   {
298     err_msg: string list;
299     err_info: (string * string) list;
300     err_ctx: context
301   }
302
303 exception CompilError of error_description
304
305 (* Utilities *)
306
307 let evaluate x = Lazy.force x
308
309 let resolve_elements add_element elts other_elts =
310   let resolve_other_elements other_elt acc = match other_elt.Syntax.nature with
311     | Syntax.Public elts -> List.fold_right (add_element Public) elts acc
312     | Syntax.Protected elts -> List.fold_right (add_element Protected) elts acc
313     | Syntax.EquationClause _ | Syntax.AlgorithmClause _ -> acc in
314   List.fold_right
315     (add_element Public)
316     elts
317     (List.fold_right resolve_other_elements other_elts [])
318
319 let resolved_expression syntax nat elt_nat =
320   {
321     nature = nat;
322     info = { syntax = syntax; type_description = elt_nat }
323   }
324
325 let one =
326   let nat = Integer 1l
327   and elt_nat = Types.integer_type Types.Constant in
328   resolved_expression None nat elt_nat
329
330
331 (* Name resolution functions *)
332
333 let rec resolve_toplevel dic nodes =
334   let add_element ctx acc (id, elt_desc) =
335     match List.mem_assoc id acc with
336     | true ->
337         let ctx = { ctx with location = elt_desc.element_location } in
338         raise (CompilError
339           {err_msg = ["_DuplicateDeclarationOfElement"; id];
340            err_info = [];
341            err_ctx = ctx}) (*error*)
342     | false -> acc @ [ (id, elt_desc) ] in
343   let rec ctx =
344     {
345       toplevel =
346         lazy (List.fold_left (add_element ctx) dic (evaluate elt_descs));
347       context_nature = ToplevelContext;
348       location =
349         {
350           Parser.start = 0;
351                   Parser.enddd = 0;
352           Parser.filename = Parser.CommandLine
353         }
354     }
355   and elt_descs = lazy (resolve_toplevel_nodes ctx nodes) in
356   evaluate ctx.toplevel
357
358 and resolve_toplevel_nodes ctx nodes =
359   let rec resolve_toplevel_nodes' nodes' =
360     match nodes' with
361       | [] -> []
362       | node :: nodes' ->
363           (resolve_toplevel_statements ctx node) @
364           (resolve_toplevel_nodes' nodes') in
365   let collect_toplevel_defs (cl_defs, nodes) node =
366     match node.Syntax.nature with
367       | Syntax.ClassDefinitions cl_defs' -> cl_defs' @ cl_defs, nodes
368       | _ -> cl_defs, [node] @ nodes in
369   let cl_defs, nodes = List.fold_left collect_toplevel_defs ([], []) nodes in
370   let node = {Syntax.nature = Syntax.ClassDefinitions cl_defs;
371               Syntax.info = ctx.location} in
372   (resolve_toplevel_statements ctx node) @
373   resolve_toplevel_nodes' nodes
374
375 and resolve_toplevel_statements ctx node = match node.Syntax.nature with
376   | Syntax.ClassDefinitions cl_defs -> resolve_class_definitions ctx cl_defs
377   | Syntax.Expression expr -> raise (CompilError
378       {err_msg = ["_NotYetImplemented"; "_TopLevelExpr"];
379        err_info = [];
380        err_ctx = {ctx with location = expr.Syntax.info}})
381   | Syntax.VariablesDefinitions (expr, subs, cpnt_decls) ->
382       resole_variables_definitions ctx expr subs cpnt_decls
383   | Syntax.Command algo -> raise (CompilError
384       {err_msg = ["_NotYetImplemented"; "_TopLevelAlgorithm"];
385        err_info = [];
386        err_ctx = {ctx with location = algo.Syntax.info}})
387   | Syntax.Within path -> raise (CompilError
388       {err_msg = ["_NotYetImplemented"; "_WithinClause"];
389        err_info = [("_Expr", Syntax.string_of_toplevel_element node)];
390        err_ctx = {ctx with location = node.Syntax.info}})
391   | Syntax.Import imprt -> raise (CompilError
392       {err_msg = ["_NotYetImplemented"; "_ImportClause"];
393        err_info = [("_Expr", Syntax.string_of_toplevel_element node)];
394        err_ctx = {ctx with location = imprt.Syntax.info}})
395
396 and resole_variables_definitions ctx expr subs cpnt_decls =
397   let type_spec = lazy (resolve_expression ctx expr)
398   and dims = lazy (resolve_dimensions ctx subs) in
399   List.map (resolve_variable_definition ctx type_spec dims expr) cpnt_decls
400
401 and resolve_variable_definition ctx type_spec dims expr cpnt_decl =
402   let type_pref = false, None, Types.Acausal in
403   let id, elt_nat, elt_loc =
404     resolve_component_declaration ctx type_pref type_spec dims expr cpnt_decl in
405   let rec elt_desc =
406     {
407       element_type =
408         lazy (element_type ctx false None None None elt_desc);
409       redeclare = false;
410       element_nature = elt_nat;
411       element_location = elt_loc
412     } in
413   id, elt_desc
414
415 and resolve_class_definitions ctx cl_defs =
416   List.map (resolve_class_definition ctx) cl_defs
417
418 and resolve_class_definition ctx cl_def = match cl_def.Syntax.nature with
419   | Syntax.ClassDefinition (final, def) ->
420       let loc = (match def.Syntax.nature with
421         | Syntax.Definition (_, _, _, cl_spec) -> cl_spec.Syntax.info) in
422       let rec elt_desc =
423         {
424           element_type = lazy (element_type ctx false final None None elt_desc);
425           redeclare = false;
426           element_nature = resolve_definition ctx def;
427           element_location = loc
428         } in
429       let s = class_definition_name def in
430       s, elt_desc
431
432 and class_definition_name def = match def.Syntax.nature with
433   | Syntax.Definition (_, _, _, cl_spec) -> class_specifier_name cl_spec
434
435 and class_specifier_name cl_spec = match cl_spec.Syntax.nature with
436   | Syntax.LongSpecifier (id, _, _) |
437     Syntax.ShortSpecifier (id, _, _, _, _, _) |
438     Syntax.EnumerationSpecifier (id, _, _) |
439     Syntax.ExtensionSpecifier (id, _, _, _) -> id
440
441 and resolve_definition ctx def =
442   let ctx = {ctx with location = def.Syntax.info} in 
443   match def.Syntax.nature with
444     | Syntax.Definition (encap, part, kind, cl_spec) ->
445         resolve_specification ctx encap part kind cl_spec
446
447 and resolve_specification ctx encap part kind cl_spec =
448   let encap' = bool_of_encapsulated encap in
449   match kind with
450     | Syntax.Class ->
451         resolve_class_specification ctx encap' part Types.Class cl_spec
452     | Syntax.Model ->
453         resolve_class_specification ctx encap' part Types.Model cl_spec
454     | Syntax.Block ->
455         resolve_class_specification ctx encap' part Types.Block cl_spec
456     | Syntax.Record ->
457         resolve_class_specification ctx encap' part Types.Record cl_spec
458     | Syntax.ExpandableConnector ->
459         resolve_class_specification
460           ctx
461           encap'
462           part
463           Types.ExpandableConnector
464           cl_spec
465     | Syntax.Connector ->
466         resolve_class_specification ctx encap' part Types.Connector cl_spec
467     | Syntax.Type when encap' ->
468         raise (CompilError
469           {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_TypeDef"];
470            err_info = [];
471            err_ctx = ctx}) (*error*)
472     | Syntax.Type -> resolve_type_specification ctx cl_spec
473     | Syntax.Package ->
474         resolve_class_specification ctx encap' part Types.Package cl_spec
475     | Syntax.Function ->
476         resolve_class_specification ctx encap' part Types.Function cl_spec
477
478 and resolve_type_specification ctx cl_spec =
479   let ctx = {ctx with location = cl_spec.Syntax.info} in
480   match cl_spec.Syntax.nature with
481     | Syntax.LongSpecifier _ ->
482         raise (CompilError
483           {err_msg = ["_InvalidTypeDef"];
484            err_info = [];
485            err_ctx = ctx}) (*error*)
486     | Syntax.ExtensionSpecifier _ ->
487         raise (CompilError
488           {err_msg = ["_InvalidTypeDef"];
489            err_info = [];
490            err_ctx = ctx}) (*error*)
491     | Syntax.ShortSpecifier (_, base_pref, cl_spec, subs, cl_modif, _) ->
492         let cpnt_type =
493           resolve_type_composition ctx base_pref cl_spec subs cl_modif in
494         ComponentType cpnt_type
495     | Syntax.EnumerationSpecifier (idt, enum_comp, _) ->
496         let enum_type = resolve_enumeration_composition ctx enum_comp in
497         PredefinedType enum_type
498
499 and resolve_type_composition ctx base_pref cl_spec subs cl_modif =
500   let base_pref' = type_prefix base_pref
501   and base_type = lazy (resolve_expression ctx cl_spec)
502   and dims = lazy (resolve_dimensions ctx subs) in
503   let cpnt_type = lazy (component_type ctx base_pref' base_type dims) in
504   let cl_modif' = lazy (resolve_type_modification ctx cpnt_type cl_modif) in
505   {
506     described_type = lazy (modified_described_type ctx cpnt_type cl_modif');
507     base_type = base_type;
508     type_dimensions = dims;
509     type_modification = cl_modif'
510   }
511
512 and resolve_enumeration_composition ctx enum_comp =
513   let resolve_enumeration_literal enum_lit ids =
514     match enum_lit.Syntax.nature with
515       | Syntax.EnumerationLiteral (id, _) when List.mem id ids ->
516           raise (CompilError
517             {err_msg = ["_EnumTypeDefWithDuplicLit"; id];
518              err_info = [];
519              err_ctx = {ctx with location = enum_lit.Syntax.info}}) (*error*)
520       | Syntax.EnumerationLiteral (id, _) -> id :: ids in
521   match enum_comp.Syntax.nature with
522     | Syntax.EnumList (Some enum_lits) ->
523         let elts = List.fold_right resolve_enumeration_literal enum_lits [] in
524         {
525           Types.base_type = Types.EnumerationType elts;
526                 attributes = ["start", false]
527         }
528     | Syntax.EnumList None ->
529         raise (CompilError
530           {err_msg = ["_UnspecifiedEnumLits"];
531            err_info = [];
532            err_ctx = {ctx with location = enum_comp.Syntax.info}}) (*error*)
533     | Syntax.EnumColon ->
534         raise (CompilError
535           {err_msg = ["_UnspecifiedEnumLits"];
536            err_info = [];
537            err_ctx = {ctx with location = enum_comp.Syntax.info}}) (*error*)
538
539 and resolve_class_specification ctx encap part kind cl_spec =
540   let ctx = {ctx with location = cl_spec.Syntax.info} in
541   let resolve_specifier encap' cl_def =
542     let ctx' = {ctx with context_nature = ClassContext cl_def} in
543     resolve_class_specifier ctx ctx' encap cl_spec in
544   let rec cl_def =
545     {
546       class_type = lazy (class_specifier_type ctx part kind cl_def cl_spec);
547       enclosing_class = enclosing_class ctx;
548       encapsulated = encap;
549       description = lazy (resolve_specifier encap cl_def)
550     } in
551   Class cl_def
552
553 and enclosing_class ctx = match ctx.context_nature with
554   | ToplevelContext -> None
555   | ClassContext cl_def -> Some cl_def
556   | SubscriptContext (ctx, _, _, _) |
557     ForContext (ctx, _, _) -> enclosing_class ctx
558
559 and bool_of_encapsulated = function
560   | None -> false
561   | Some Syntax.Encapsulated -> true
562
563 and resolve_class_specifier ctx ctx' encap cl_spec =
564   let ctx = {ctx with location = cl_spec.Syntax.info}
565   and ctx' = {ctx' with location = cl_spec.Syntax.info} in
566   match cl_spec.Syntax.nature with
567     | Syntax.LongSpecifier (_, _, comp) ->
568         LongDescription (resolve_composition ctx ctx' comp)
569     | Syntax.ShortSpecifier _ when encap ->
570         raise (CompilError
571           {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_ShortClassDef"];
572            err_info = [];
573            err_ctx = ctx}) (*error*)
574     | Syntax.ShortSpecifier (_, base_pref, cl_spec, subs, cl_modif, _) ->
575         let short_desc =
576           resolve_short_specifier ctx base_pref cl_spec subs cl_modif in
577         ShortDescription short_desc
578     | Syntax.ExtensionSpecifier _ when encap ->
579         raise (CompilError
580           {err_msg = ["_EncapsulatedCannotBeAppliedTo"; "_ClassDefByExtension"];
581            err_info = [];
582            err_ctx = ctx}) (*error*)
583     | Syntax.ExtensionSpecifier (id , cl_modif, _, comp) ->
584         let long_desc =
585           resolve_extension_composition ctx ctx' id cl_modif comp in
586         LongDescription long_desc
587     | Syntax.EnumerationSpecifier _ ->
588         raise (CompilError
589           {err_msg = ["_InvalidUseOfEnumKeyword"];
590            err_info = [];
591            err_ctx = ctx}) (*error*)
592
593 and resolve_short_specifier ctx base_pref cl_spec subs cl_modif =
594   let ctx = {ctx with location = cl_spec.Syntax.info} in
595   match base_pref.Syntax.nature, subs with
596     | Syntax.TypePrefix (None, None, None), None ->
597         resolve_modified_class ctx ctx cl_spec cl_modif
598     | (Syntax.TypePrefix (Some _, _, _) | Syntax.TypePrefix (_, Some _, _) |
599        Syntax.TypePrefix (_, _, Some _)), _ ->
600         raise (CompilError
601           {err_msg = ["_UseOfTypePrefixInShortClassDef"];
602            err_info =
603              [("_TypePrefix", Syntax.string_of_base_prefix base_pref)];
604            err_ctx = {ctx with location = base_pref.Syntax.info}}) (*error*)
605     | Syntax.TypePrefix (None, None, None), Some subs ->
606         raise (CompilError
607           {err_msg = ["_UseOfSubsInShortClassDef"];
608            err_info = [];
609            err_ctx = {ctx with location = subs.Syntax.info}}) (*error*)
610
611 and resolve_extension_composition ctx ctx' id cl_modif comp =
612   raise (CompilError
613     {err_msg = ["_NotYetImplemented"; "_ClassExtendsDef"];
614      err_info = [];
615      err_ctx = ctx})
616
617 and resolve_composition ctx ctx' comp = match comp.Syntax.nature with
618   | Syntax.Composition (elts, other_elts, extern) ->
619       {
620         class_annotations = lazy (resolve_class_annotations ctx' elts other_elts);
621         imports = resolve_imports ctx' elts other_elts;
622         extensions = resolve_extensions ctx ctx' elts other_elts;
623         named_elements = resolve_named_elements ctx' elts other_elts;
624         unnamed_elements = lazy (resolve_unnamed_elements ctx' other_elts);
625         external_call = lazy (resolve_external_call ctx' extern)
626       }
627
628 and resolve_external_call ctx extern =
629   let resolve_external_call' extern' = match extern'.Syntax.nature with
630     | Syntax.External (Some id, None, _, _) ->
631         { nature = PrimitiveCall id; info = extern' }
632     | Syntax.External (Some lang, Some extern_call, _, _) ->
633         raise (CompilError
634           {err_msg = ["_NotYetImplemented"; "_ExternalProcedureCall"];
635            err_info = [];
636            err_ctx =
637               {ctx with location = extern'.Syntax.info}}) (*error*)
638     | Syntax.External (None, _, _, _) ->
639         { nature = PrimitiveCall "C"; info = extern' } in
640         (*raise (CompilError
641           {err_msg = ["_UnspecifiedExtCallLang"];
642            err_info = [];
643            err_ctx =
644               {ctx with location = extern'.Syntax.info}}) (*error*) in*)
645   match extern with
646     | None -> None
647     | Some extern' -> Some (resolve_external_call' extern')
648
649 and resolve_class_annotations ctx elts other_elts =
650   let add_class_annotation vis elt anns = match vis, elt.Syntax.nature with
651     | _, Syntax.ClassAnnotation ann ->
652         begin match resolve_class_annotation ctx ann with
653           | [] -> anns
654           | anns' -> anns' @ anns
655         end
656     | _, (Syntax.ImportClause _ | Syntax.ExtendsClause _ |
657       Syntax.ElementDefinition _) -> anns in
658   resolve_elements add_class_annotation elts other_elts
659
660 and resolve_imports ctx elts other_elts =
661   let add_import vis elt imps = match vis, elt.Syntax.nature with
662     | _, Syntax.ImportClause (imp_clause, _) ->
663         resolve_import_clause ctx imp_clause :: imps
664     | _, (Syntax.ClassAnnotation _ | Syntax.ExtendsClause _ |
665       Syntax.ElementDefinition _) -> imps in
666   resolve_elements add_import elts other_elts
667
668 and resolve_extensions ctx ctx' elts other_elts =
669   let add_extension vis elt exts = match vis, elt.Syntax.nature with
670     | Public, Syntax.ExtendsClause (ext_clause, _) ->
671         (Public, resolve_extends_clause ctx ctx' ext_clause) :: exts
672     | Protected, Syntax.ExtendsClause (ext_clause, _) ->
673         (Protected, resolve_extends_clause ctx ctx' ext_clause) :: exts
674     | _, (Syntax.ClassAnnotation _ | Syntax.ImportClause _ |
675       Syntax.ElementDefinition _) -> exts in
676   resolve_elements add_extension elts other_elts
677
678 and resolve_named_elements ctx elts other_elts =
679   let add_named_element (id, elt_desc) elts =
680     match List.mem_assoc id elts with
681     | true ->
682         raise (CompilError
683           {err_msg = ["_DuplicateDeclarationOfElement"; id];
684            err_info = [];
685            err_ctx = ctx}) (*error*)
686     | false -> (id, elt_desc) :: elts in
687   let add_named_elements vis elt elts = match vis, elt.Syntax.nature with
688     | Public,
689       Syntax.ElementDefinition (redecl, final, dyn_scope, elt_def, _) ->
690         let elts' =
691           resolve_element_definition ctx false redecl final dyn_scope elt_def in
692         List.fold_right add_named_element elts' elts
693     | Protected,
694       Syntax.ElementDefinition (redecl, final, dyn_scope, elt_def, _) ->
695         let elts' =
696           resolve_element_definition ctx true redecl final dyn_scope elt_def in
697         List.fold_right add_named_element elts' elts
698     | _, (Syntax.ClassAnnotation _ | Syntax.ImportClause _ |
699       Syntax.ExtendsClause _) -> elts in
700   resolve_elements add_named_elements elts other_elts
701
702 and resolve_class_annotation ctx ann =
703   let rec resolve_class_annotation' cl_modif =
704     let add_annotation_information arg acc = match arg.Syntax.nature with
705       | Syntax.ElementModification (
706           None,
707           None,
708           { Syntax.nature = Syntax.Identifier "Imagine" },
709           Some
710             {
711               Syntax.nature =
712                 Syntax.Modification (
713                   {
714                     Syntax.nature =
715                       Syntax.ClassModification
716                         [
717                           {
718                             Syntax.nature =
719                               Syntax.ElementModification (
720                                 None,
721                                 None,
722                                 {
723                                   Syntax.nature = Syntax.Identifier "AMESim"
724                                 },
725                                 Some
726                                   {
727                                     Syntax.nature =
728                                       Syntax.Modification (cl_modif, None)
729                                   },
730                                 [])
731                           }
732                         ]
733                   },
734                   None)
735             },
736           []) -> add_amesim_annotations ctx cl_modif acc
737       | Syntax.ElementModification _ | Syntax.ElementRedeclaration _ ->
738           (UnknownAnnotation (lazy cl_modif)) :: acc in
739     match cl_modif.Syntax.nature with
740     | Syntax.ClassModification args ->
741         List.fold_right add_annotation_information args [] in
742   match ann.Syntax.nature with
743   | Syntax.Annotation cl_modif -> resolve_class_annotation' cl_modif
744
745 and add_amesim_annotations ctx cl_modif acc =
746   let add_inverse_declarations cl_modif =
747     let add_inverse_declaration arg acc =
748       let add_inverse_declaration' expr modif =
749         match expr.Syntax.nature, modif.Syntax.nature with
750         | Syntax.IndexedAccess (
751             { Syntax.nature = Syntax.Identifier "inverse" }, _),
752           Syntax.Eq
753             {
754               Syntax.nature =
755                 Syntax.FunctionCall (expr, Some fun_args)
756             } -> (resolve_inverse_declaration ctx expr fun_args) :: acc
757         | _ ->
758             raise (CompilError
759               {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidModifExpr"];
760                err_info = [];
761                err_ctx =
762                  {ctx with location = expr.Syntax.info}}) (*error*) in
763       match arg.Syntax.nature with
764       | Syntax.ElementModification (Some _, _, _, _, _) ->
765           raise (CompilError
766             {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfEachKeywordNotAllowed"];
767              err_info = [];
768              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
769       | Syntax.ElementModification (None, Some _, _, _, _) ->
770           raise (CompilError
771             {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfFinalKeywordNotAllowed"];
772              err_info = [];
773              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
774       | Syntax.ElementModification (None, None, _, None, _) ->
775           raise (CompilError
776             {err_msg = ["_InvalidAnnOfInvFunc"; "_UnspecifiedModification"];
777              err_info = [];
778              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
779       | Syntax.ElementModification (None, None, expr, Some modif, _) ->
780           add_inverse_declaration' expr modif
781       | Syntax.ElementRedeclaration _ ->
782           raise (CompilError
783             {err_msg = ["_InvalidAnnOfInvFunc"; "_RedeclarationNotAllowed"];
784              err_info = [];
785              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in
786     match cl_modif.Syntax.nature with
787     | Syntax.ClassModification args ->
788         List.fold_right add_inverse_declaration args acc in
789   match cl_modif.Syntax.nature with
790   | Syntax.ClassModification
791       [
792         {
793           Syntax.nature =
794             Syntax.ElementModification (
795               None,
796               None,
797               {
798                 Syntax.nature = Syntax.Identifier "InverseFunctions"
799               },
800               Some
801                 {
802                   Syntax.nature =
803                     Syntax.Modification (cl_modif, None)
804                 },
805                 [])
806         }
807       ] -> add_inverse_declarations cl_modif
808   | Syntax.ClassModification _ -> acc
809
810 and resolve_inverse_declaration ctx expr fun_args =
811   let inverse_function_arguments expr' fun_args =
812     let map_function_arguments named_args =
813       let map_function_argument arg =
814         match arg.Syntax.nature with
815         | Syntax.NamedArgument (id, expr)
816           when List.mem_assoc id named_args ->
817             let expr' = resolve_expression ctx expr in
818             begin match expr'.nature with
819               | LocalIdentifier (0, id') -> id, id'
820               | _ ->
821                   raise (CompilError
822                     {err_msg = ["_InvalidAnnOfInvFunc";
823                                 "_InvalidFuncArgModif"];
824                      err_info = [];
825                      err_ctx =
826                         {ctx with
827                           location = expr.Syntax.info}}) (*error*)
828             end
829         | Syntax.NamedArgument (id, expr) ->
830             raise (CompilError
831               {err_msg = ["_InvalidAnnOfInvFunc";
832                           "_UnknownArgName"; id];
833                err_info = [];
834                err_ctx =
835                  {ctx with location = arg.Syntax.info}}) (*error*)
836         | Syntax.Argument _ ->
837             raise (CompilError
838               {err_msg = ["_InvalidAnnOfInvFunc";
839                           "_CannotUseUnnamedFuncArg"];
840                err_info = [];
841                err_ctx =
842                  {ctx with location = arg.Syntax.info}}) (*error*) in
843       match fun_args.Syntax.nature with
844       | Syntax.ArgumentList args -> List.map map_function_argument args
845       | Syntax.Reduction _ ->
846           raise (CompilError
847             {err_msg = ["_InvalidAnnOfInvFunc";
848                         "_FuncArgReductionNotAllowed"];
849              err_info = [];
850              err_ctx =
851                {ctx with location = fun_args.Syntax.info}}) (*error*) in
852     let inverse_function_arguments' cl_type =
853       match cl_type.Types.partial, evaluate cl_type.Types.kind with
854       | true, _ ->
855           raise (CompilError
856             {err_msg = ["_InvalidAnnOfInvFunc";
857                         "_UseOfPartialClassElement"];
858              err_info = [("_ElementFound",
859                           Syntax.string_of_expression expr)];
860              err_ctx =
861                {ctx with location = expr.Syntax.info}}) (*error*)
862       | false, Types.Function ->
863           map_function_arguments cl_type.Types.named_elements
864       | _, kind ->
865           raise (CompilError
866             {err_msg = ["_InvalidAnnOfInvFunc";
867                         "_InvalidTypeOfFuncCallExpr"];
868              err_info = [("_ExpectedType", "_Function");
869                          ("_TypeFound", Types.string_of_kind kind)];
870              err_ctx =
871                {ctx with location = expr.Syntax.info}}) (*error*) in
872     let elt_nat = expr'.info.type_description in
873     match elt_nat with
874     | Types.ClassElement cl_spec ->
875         let cl_spec = evaluate cl_spec in
876         begin match cl_spec with
877           | Types.ClassType cl_type ->
878               inverse_function_arguments' cl_type
879           | _ ->
880               raise (CompilError
881                 {err_msg = ["_InvalidAnnOfInvFunc";
882                             "_InvalidTypeOfFuncCallExpr"];
883                  err_info =
884                    [("_ExpectedType", "_ClassType");
885                     ("_TypeFound",
886                      Types.string_of_class_specifier cl_spec)];
887                  err_ctx =
888                    {ctx with location = expr.Syntax.info}}) (*error*)
889         end
890     | Types.ComponentTypeElement _ ->
891         raise (CompilError
892           {err_msg = ["_InvalidAnnOfInvFunc";
893                       "_InvalidTypeOfFuncCallExpr"];
894            err_info = [("_ExpectedType", "_ClassElement");
895                        ("_TypeFound", "_ComponentTypeElement")];
896            err_ctx =
897              {ctx with location = expr.Syntax.info}}) (*error*)
898     | Types.PredefinedTypeElement _ ->
899         raise (CompilError
900           {err_msg = ["_InvalidAnnOfInvFunc";
901                       "_InvalidTypeOfFuncCallExpr"];
902            err_info = [("_ExpectedType", "_ClassElement");
903                        ("_TypeFound", "_PredefinedTypeElement")];
904            err_ctx =
905              {ctx with location = expr.Syntax.info}}) (*error*)
906     | Types.ComponentElement _ ->
907         raise (CompilError
908           {err_msg = ["_InvalidAnnOfInvFunc";
909                       "_InvalidTypeOfFuncCallExpr"];
910            err_info = [("_ExpectedType", "_ClassElement");
911                        ("_TypeFound", "_ComponentElement")];
912            err_ctx =
913              {ctx with location = expr.Syntax.info}}) (*error*) in
914   let expr' = resolve_expression ctx expr in
915   match expr'.nature with
916   | ToplevelIdentifier _ | LocalIdentifier _ ->
917       InverseFunction
918         (lazy
919           {
920             function_class = expr';
921             arguments = inverse_function_arguments expr' fun_args
922           })
923   | _ ->
924       raise (CompilError
925         {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidFuncCallExpr"];
926          err_info = [];
927          err_ctx =
928            {ctx with location = expr.Syntax.info}}) (*error*)
929
930 (*and resolve_inverse_function_annotation ctx ann =
931   let rec resolve_class_annotation' cl_modif =
932     let resolve_inverse_declaration expr fun_args =
933       let inverse_function_arguments expr' fun_args =
934         let map_function_arguments named_args =
935           let map_function_argument arg =
936             match arg.Syntax.nature with
937               | Syntax.NamedArgument (id, expr)
938                 when List.mem_assoc id named_args ->
939                   let expr' = resolve_expression ctx expr in
940                   begin match expr'.nature with
941                     | LocalIdentifier (0, id') -> id, id'
942                     | _ ->
943                         raise (CompilError
944                           {err_msg = ["_InvalidAnnOfInvFunc";
945                                       "_InvalidFuncArgModif"];
946                            err_info = [];
947                            err_ctx =
948                               {ctx with
949                                 location = expr.Syntax.info}}) (*error*)
950                   end
951               | Syntax.NamedArgument (id, expr) ->
952                   raise (CompilError
953                     {err_msg = ["_InvalidAnnOfInvFunc";
954                                 "_UnknownArgName"; id];
955                      err_info = [];
956                      err_ctx =
957                        {ctx with location = arg.Syntax.info}}) (*error*)
958               | Syntax.Argument _ ->
959                   raise (CompilError
960                     {err_msg = ["_InvalidAnnOfInvFunc";
961                                 "_CannotUseUnnamedFuncArg"];
962                      err_info = [];
963                      err_ctx =
964                         {ctx with location = arg.Syntax.info}}) (*error*) in
965           match fun_args.Syntax.nature with
966             | Syntax.ArgumentList args -> List.map map_function_argument args
967             | Syntax.Reduction _ ->
968                 raise (CompilError
969                   {err_msg = ["_InvalidAnnOfInvFunc";
970                               "_FuncArgReductionNotAllowed"];
971                    err_info = [];
972                    err_ctx =
973                       {ctx with location = fun_args.Syntax.info}}) (*error*) in
974         let inverse_function_arguments' cl_type =
975           match cl_type.Types.partial, evaluate cl_type.Types.kind with
976             | true, _ ->
977                 raise (CompilError
978                   {err_msg = ["_InvalidAnnOfInvFunc";
979                               "_UseOfPartialClassElement"];
980                    err_info = [("_ElementFound",
981                                 Syntax.string_of_expression expr)];
982                    err_ctx =
983                       {ctx with location = expr.Syntax.info}}) (*error*)
984             | false, Types.Function ->
985                 map_function_arguments cl_type.Types.named_elements
986             | _, kind ->
987                 raise (CompilError
988                   {err_msg = ["_InvalidAnnOfInvFunc";
989                               "_InvalidTypeOfFuncCallExpr"];
990                    err_info = [("_ExpectedType", "_Function");
991                                ("_TypeFound", Types.string_of_kind kind)];
992                    err_ctx =
993                      {ctx with location = expr.Syntax.info}}) (*error*) in
994         let elt_nat = expr'.info.type_description in
995         match elt_nat with
996           | Types.ClassElement cl_spec ->
997               let cl_spec = evaluate cl_spec in
998               begin match cl_spec with
999                 | Types.ClassType cl_type ->
1000                     inverse_function_arguments' cl_type
1001                 | _ ->
1002                     raise (CompilError
1003                       {err_msg = ["_InvalidAnnOfInvFunc";
1004                                   "_InvalidTypeOfFuncCallExpr"];
1005                        err_info =
1006                          [("_ExpectedType", "_ClassType");
1007                           ("_TypeFound",
1008                            Types.string_of_class_specifier cl_spec)];
1009                        err_ctx =
1010                          {ctx with location = expr.Syntax.info}}) (*error*)
1011               end
1012           | Types.ComponentTypeElement _ ->
1013               raise (CompilError
1014                 {err_msg = ["_InvalidAnnOfInvFunc";
1015                             "_InvalidTypeOfFuncCallExpr"];
1016                  err_info = [("_ExpectedType", "_ClassElement");
1017                              ("_TypeFound", "_ComponentTypeElement")];
1018                  err_ctx =
1019                    {ctx with location = expr.Syntax.info}}) (*error*)
1020           | Types.PredefinedTypeElement _ ->
1021               raise (CompilError
1022                 {err_msg = ["_InvalidAnnOfInvFunc";
1023                             "_InvalidTypeOfFuncCallExpr"];
1024                  err_info = [("_ExpectedType", "_ClassElement");
1025                              ("_TypeFound", "_PredefinedTypeElement")];
1026                  err_ctx =
1027                    {ctx with location = expr.Syntax.info}}) (*error*)
1028           | Types.ComponentElement _ ->
1029               raise (CompilError
1030                 {err_msg = ["_InvalidAnnOfInvFunc";
1031                             "_InvalidTypeOfFuncCallExpr"];
1032                  err_info = [("_ExpectedType", "_ClassElement");
1033                              ("_TypeFound", "_ComponentElement")];
1034                  err_ctx =
1035                    {ctx with location = expr.Syntax.info}}) (*error*) in
1036       let expr' = resolve_expression ctx expr in
1037       match expr'.nature with
1038         | ToplevelIdentifier _ | LocalIdentifier _ ->
1039             {
1040               function_class = expr';
1041               arguments =
1042                 inverse_function_arguments expr' fun_args
1043             }
1044         | _ ->
1045             raise (CompilError
1046               {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidFuncCallExpr"];
1047                err_info = [];
1048                err_ctx =
1049                  {ctx with location = expr.Syntax.info}}) (*error*) in
1050     let add_inverse_declaration arg acc =
1051       let add_inverse_declaration' expr modif =
1052         match expr.Syntax.nature, modif.Syntax.nature with
1053         | Syntax.IndexedAccess (
1054             { Syntax.nature = Syntax.Identifier "inverse" }, _),
1055           Syntax.Eq
1056             {
1057               Syntax.nature =
1058                 Syntax.FunctionCall (expr, Some fun_args)
1059             } -> lazy (resolve_inverse_declaration expr fun_args) :: acc
1060         | _ ->
1061             raise (CompilError
1062               {err_msg = ["_InvalidAnnOfInvFunc"; "_InvalidModifExpr"];
1063                err_info = [];
1064                err_ctx =
1065                  {ctx with location = expr.Syntax.info}}) (*error*) in
1066       match arg.Syntax.nature with
1067       | Syntax.ElementModification (Some _, _, _, _, _) ->
1068           raise (CompilError
1069             {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfEachKeywordNotAllowed"];
1070              err_info = [];
1071              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
1072       | Syntax.ElementModification (None, Some _, _, _, _) ->
1073           raise (CompilError
1074             {err_msg = ["_InvalidAnnOfInvFunc"; "_UseOfFinalKeywordNotAllowed"];
1075              err_info = [];
1076              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
1077       | Syntax.ElementModification (None, None, _, None, _) ->
1078           raise (CompilError
1079             {err_msg = ["_InvalidAnnOfInvFunc"; "_UnspecifiedModification"];
1080              err_info = [];
1081              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
1082       | Syntax.ElementModification (None, None, expr, Some modif, _) ->
1083           add_inverse_declaration' expr modif
1084       | Syntax.ElementRedeclaration _ ->
1085           raise (CompilError
1086             {err_msg = ["_InvalidAnnOfInvFunc"; "_RedeclarationNotAllowed"];
1087              err_info = [];
1088              err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in
1089     let add_inverse_declarations cl_modif acc =
1090       let add_inverse_declarations' cl_modif = 
1091         match cl_modif.Syntax.nature with
1092         | Syntax.ClassModification args ->
1093             List.fold_right add_inverse_declaration args acc in
1094       match cl_modif.Syntax.nature with
1095       | Syntax.ClassModification
1096           [
1097             {
1098               Syntax.nature =
1099                 Syntax.ElementModification (
1100                   None,
1101                   None,
1102                   {
1103                     Syntax.nature = Syntax.Identifier "InverseFunctions"
1104                   },
1105                   Some
1106                     {
1107                       Syntax.nature =
1108                         Syntax.Modification (cl_modif, None)
1109                     },
1110                     [])
1111             }
1112           ] -> add_inverse_declarations' cl_modif
1113       | Syntax.ClassModification _ -> acc in
1114     let add_annotation_information arg acc = match arg.Syntax.nature with
1115       | Syntax.ElementModification (
1116           None,
1117           None,
1118           { Syntax.nature = Syntax.Identifier "Imagine" },
1119           Some
1120             {
1121               Syntax.nature =
1122                 Syntax.Modification (
1123                   {
1124                     Syntax.nature =
1125                       Syntax.ClassModification
1126                         [
1127                           {
1128                             Syntax.nature =
1129                               Syntax.ElementModification (
1130                                 None,
1131                                 None,
1132                                 {
1133                                   Syntax.nature = Syntax.Identifier "AMESim"
1134                                 },
1135                                 Some
1136                                   {
1137                                     Syntax.nature =
1138                                       Syntax.Modification (cl_modif, None)
1139                                   },
1140                                 [])
1141                           }
1142                         ]
1143                   },
1144                   None)
1145             },
1146           []) -> add_inverse_declarations cl_modif acc
1147       | Syntax.ElementModification _ | Syntax.ElementRedeclaration _ -> acc in
1148     match cl_modif.Syntax.nature with
1149     | Syntax.ClassModification args ->
1150         List.fold_right add_annotation_information args [] in
1151   match ann.Syntax.nature with
1152   | Syntax.Annotation cl_modif -> resolve_class_annotation' cl_modif*)
1153
1154 and resolve_import_clause ctx imp_clause =
1155   let ctx = {ctx with location = imp_clause.Syntax.info} in
1156   raise (CompilError
1157     {err_msg = ["_NotYetImplemented"; "_ImportClause"];
1158      err_info = [("_Expr", Syntax.string_of_import imp_clause)];
1159      err_ctx = ctx})
1160
1161 and resolve_extends_clause ctx ctx' ext_clause =
1162   match ext_clause.Syntax.nature with
1163     | Syntax.Extends (cl_spec, cl_modif, _) ->
1164         resolve_extension ctx ctx' cl_spec cl_modif
1165
1166 and resolve_extension ctx ctx' cl_spec cl_modif =
1167   let ctx' = {ctx' with location = cl_spec.Syntax.info} in
1168   let base_class = lazy (resolve_extension_expression ctx cl_spec) in
1169   let cl_spec' = lazy (base_class_type ctx' cl_spec base_class) in
1170   let cl_modif' =
1171     lazy (resolve_class_modification_option ctx' cl_spec' cl_modif) in
1172   {
1173     modified_class_type = lazy (modified_class_type ctx' cl_spec' cl_modif');
1174     base_class = base_class;
1175     class_modification = cl_modif'
1176   }
1177
1178 and resolve_extension_expression ctx cl_spec =
1179   let rec modify_resolved_expression expr = match expr.nature with
1180     | LocalIdentifier (level, id) ->
1181         { expr with nature = LocalIdentifier (level + 1, id) }
1182     | FieldAccess (expr', id) ->
1183         { expr with
1184           nature = FieldAccess (modify_resolved_expression expr', id)
1185         }
1186     | IndexedAccess (expr', exprs') ->
1187         let exprs' = List.map modify_resolved_expression exprs' in
1188         { expr with
1189           nature = IndexedAccess (modify_resolved_expression expr', exprs')
1190         }
1191     | ToplevelIdentifier _ -> expr
1192     | _ ->
1193         raise (CompilError
1194           {err_msg = ["_InvalidExtensionDef"];
1195            err_info = [];
1196            err_ctx = ctx}) (*error*) in
1197   match ctx.context_nature with
1198     | ToplevelContext | ClassContext _ ->
1199         let base_class = resolve_expression ctx cl_spec in
1200         modify_resolved_expression base_class
1201     | SubscriptContext _ | ForContext _ ->
1202         raise (CompilError
1203           {err_msg = ["_InvalidExtensionDef"];
1204            err_info = [];
1205            err_ctx = ctx}) (*error*)
1206
1207 and resolve_modified_class ctx ctx' cl_spec cl_modif =
1208   let ctx' = {ctx' with location = cl_spec.Syntax.info} in
1209   let base_class = lazy (resolve_expression ctx cl_spec) in
1210   let cl_spec' = lazy (base_class_type ctx' cl_spec base_class) in
1211   let cl_modif' =
1212     lazy (resolve_class_modification_option ctx' cl_spec' cl_modif) in
1213   {
1214     modified_class_type = lazy (modified_class_type ctx' cl_spec' cl_modif');
1215     base_class = base_class;
1216     class_modification = cl_modif'
1217   }
1218
1219 and resolve_element_definition ctx protect redecl final dyn_scope elt_def =
1220   let repl = replaceable_attribute elt_def in
1221   let element_description (id, elt_nat, elt_loc) =
1222     let rec elt_desc =
1223       {
1224         element_type =
1225           lazy (element_type ctx protect final repl dyn_scope elt_desc);
1226         redeclare = bool_of_redeclare redecl;
1227         element_nature = elt_nat;
1228         element_location = elt_loc
1229       } in
1230     id, elt_desc in
1231   List.map element_description (declared_elements ctx elt_def)
1232
1233 and replaceable_attribute elt_def = match elt_def.Syntax.nature with
1234   | Syntax.ClassDefinitionElement (repl, _, _) |
1235     Syntax.ComponentClauseElement (repl, _, _) -> repl
1236
1237 and bool_of_redeclare = function
1238   | None -> false
1239   | Some Syntax.Redeclare -> true
1240
1241 and resolve_type_constraint ctx elt_def = match elt_def.Syntax.nature with
1242   | Syntax.ClassDefinitionElement (_, _, []) |
1243     Syntax.ComponentClauseElement (_, _, []) -> None
1244   | Syntax.ClassDefinitionElement (_, _, _ :: _) |
1245     Syntax.ComponentClauseElement (_, _, _ :: _) -> assert false
1246
1247 and declared_elements ctx elt_def = match elt_def.Syntax.nature with
1248   | Syntax.ClassDefinitionElement (_, def, _) ->
1249       let s = class_definition_name def
1250       and elt_nat = resolve_definition ctx def
1251       and loc = match def.Syntax.nature with
1252         | Syntax.Definition (encap, part, kind, cl_spec) ->
1253             cl_spec.Syntax.info in
1254       [s, elt_nat, loc]
1255   | Syntax.ComponentClauseElement (_, cpnt_cl, _) ->
1256       resolve_component_clause ctx cpnt_cl
1257
1258 and resolve_component_clause ctx cpnt_cl = match cpnt_cl.Syntax.nature with
1259   | Syntax.ComponentClause (type_pref, type_spec, subs, cpnt_decls) ->
1260       let type_pref' = type_prefix type_pref
1261       and type_spec' = lazy (resolve_expression ctx type_spec)
1262       and dims = lazy (resolve_dimensions ctx subs) in
1263       List.map
1264         (resolve_component_declaration ctx type_pref' type_spec' dims type_spec)
1265         cpnt_decls
1266
1267 and type_prefix type_pref =
1268   let bool_of_flow = function
1269     | None -> false
1270     | Some Syntax.Flow -> true
1271   and variability_of_variability = function
1272     | None -> None
1273     | Some Syntax.Constant -> Some Types.Constant
1274     | Some Syntax.Parameter -> Some Types.Parameter
1275     | Some Syntax.Discrete -> Some Types.Discrete
1276   and causality_of_inout = function
1277     | None -> Types.Acausal
1278     | Some Syntax.Input -> Types.Input
1279     | Some Syntax.Output -> Types.Output in
1280   match type_pref.Syntax.nature with
1281     | Syntax.TypePrefix (flow, var, inout) ->
1282         bool_of_flow flow,
1283         variability_of_variability var,
1284         causality_of_inout inout
1285
1286 and resolve_component_declaration
1287   ctx type_pref type_spec' dims type_spec cpnt_decl =
1288     let build_comment_string cmt = match cmt.Syntax.nature with
1289       | Syntax.Comment (ss, _) -> List.fold_right ( ^ ) ss "" in
1290     match cpnt_decl.Syntax.nature with
1291       | Syntax.ComponentDeclaration (decl, cmt) ->
1292           let cmt' = build_comment_string cmt in
1293           resolve_declaration ctx type_pref type_spec' dims decl cmt' type_spec
1294
1295 and resolve_declaration ctx type_pref type_spec' dims decl cmt type_spec =
1296   let ctx = {ctx with location = decl.Syntax.info} in
1297   match decl.Syntax.nature with
1298     | Syntax.Declaration (id, subs, modif) ->
1299         let dims = lazy ((resolve_dimensions ctx subs) @ (evaluate dims)) in
1300         let cpnt_type = lazy (component_type ctx type_pref type_spec' dims) in
1301         let modif' =
1302           lazy (resolve_component_modification ctx cpnt_type modif) in
1303         let cpnt_desc =
1304           {
1305             component_type =
1306               lazy (modified_component_type ctx (evaluate cpnt_type) modif');
1307             type_specifier = type_spec';
1308             dimensions = dims;
1309             modification = modif';
1310             comment = cmt;
1311           } in
1312         (id, Component cpnt_desc, decl.Syntax.info)
1313
1314 and resolve_dimensions ctx subs =
1315   let resolve_dimension sub = match sub.Syntax.nature with
1316     | Syntax.Colon -> Colon
1317     | Syntax.Subscript expr ->
1318         Expression (resolve_subscript_expression ctx expr) in
1319   let resolve_dimensions' = function
1320     | None -> []
1321     | Some { Syntax.nature = Syntax.Subscripts subs_elts } ->
1322         List.map resolve_dimension subs_elts in
1323   resolve_dimensions' subs
1324
1325 and base_class_type ctx cl_spec base_class =
1326   match (evaluate base_class).info.type_description with
1327     | Types.ClassElement cl_spec -> evaluate cl_spec
1328     | Types.ComponentTypeElement _ ->
1329         raise (CompilError
1330           {err_msg = ["_CannotInheritFrom"; "_ComponentTypeElement"];
1331            err_info =
1332              [("_ElemFound", Syntax.string_of_expression cl_spec)];
1333            err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)
1334     | Types.PredefinedTypeElement _ ->
1335         raise (CompilError
1336           {err_msg = ["_CannotInheritFrom"; "_PredefinedTypeElement"];
1337            err_info =
1338              [("_ElemFound", Syntax.string_of_expression cl_spec)];
1339            err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)
1340     | Types.ComponentElement _ ->
1341         raise (CompilError
1342           {err_msg = ["_CannotInheritFrom"; "_ComponentElement"];
1343            err_info = [];
1344            err_ctx = {ctx with location = cl_spec.Syntax.info}}) (*error*)
1345
1346 and component_type ctx (flow, var, inout) base_type dims =
1347   let base_type = evaluate base_type in
1348   let lower_variability var var' = match var, var' with
1349     | Some Types.Constant,
1350       (Types.Constant | Types.Parameter | Types.Discrete | Types.Continuous) ->
1351         Types.Constant
1352     | Some Types.Parameter,
1353       (Types.Parameter | Types.Discrete | Types.Continuous) -> Types.Parameter
1354     | Some Types.Discrete, (Types.Discrete | Types.Continuous) -> Types.Discrete
1355     | Some Types.Continuous, Types.Continuous -> Types.Continuous
1356     | None, _ -> var'
1357     | Some var, (Types.Constant | Types.Parameter | Types.Discrete) ->
1358         raise (CompilError
1359           {err_msg = ["_VariablityConflictsInCompDef"];
1360            err_info =
1361              [("_TypePrefix", Types.string_of_variability var);
1362               ("_TypeSpecifierVariability", Types.string_of_variability var')];
1363            err_ctx = ctx}) (*error*)
1364   and propagate_causality inout inout' = match inout, inout' with
1365     | Types.Acausal, (Types.Acausal | Types.Input | Types.Output) -> inout'
1366     | (Types.Input | Types.Output), Types.Acausal -> inout
1367     | Types.Input, Types.Input | Types.Output, Types.Output -> inout
1368     | Types.Input, Types.Output | Types.Output, Types.Input ->
1369         raise (CompilError
1370           {err_msg = ["_CausalityConflictsInCompDef"];
1371            err_info = [("_TypePrefix", Types.string_of_causality inout);
1372                        ("_TypeSpecifierCausality",
1373                         Types.string_of_causality inout')];
1374            err_ctx = ctx}) (*error*) in
1375   let predefined_type_variability predef = match predef with
1376     | { Types.base_type = Types.RealType } -> Types.Continuous
1377     | _ -> Types.Discrete in
1378   let rec class_specifier_variability cl_spec = match cl_spec with
1379     | Types.PredefinedType predef -> predefined_type_variability predef
1380     | Types.ClassType cl_type -> Types.Continuous
1381     | Types.ComponentType cpnt_type -> evaluate cpnt_type.Types.variability
1382     | Types.ArrayType (dim, cl_spec) -> class_specifier_variability cl_spec
1383     | Types.TupleType cl_specs -> assert false in
1384   match base_type.info.type_description with
1385     | Types.ComponentElement _ ->
1386         raise (CompilError
1387           {err_msg = ["class"; "_ElemExpected"];
1388            err_info = [("TypeFound", "_ComponentElement")];
1389            err_ctx = ctx}) (*error*)
1390     | Types.ClassElement cl_spec ->
1391         let cl_spec = evaluate cl_spec in
1392         let var' = class_specifier_variability cl_spec in
1393         let var' = lazy (lower_variability var var')
1394         and base_class = lazy (add_dimensions dims cl_spec) in
1395         component_element (lazy flow) var' (lazy inout) base_class
1396     | Types.ComponentTypeElement cpnt_type ->
1397         let flow' = lazy (flow || evaluate cpnt_type.Types.flow)
1398         and var' =
1399           lazy (lower_variability var (evaluate cpnt_type.Types.variability))
1400         and inout' =
1401           lazy (propagate_causality inout (evaluate cpnt_type.Types.causality))
1402         and base_class =
1403           lazy (add_dimensions dims (Types.ComponentType cpnt_type)) in
1404         component_element flow' var' inout' base_class
1405     | Types.PredefinedTypeElement predef ->
1406         let var' = predefined_type_variability predef in
1407         let var' = lazy (lower_variability var var')
1408         and base_class =
1409           lazy (add_dimensions dims (Types.PredefinedType predef)) in
1410         component_element (lazy flow) var' (lazy inout) base_class
1411
1412 and add_dimensions dims cl_spec =
1413   let add_dimension dim cl_spec = match dim with
1414     | Expression { nature = Integer i } ->
1415         Types.ArrayType (Types.ConstantDimension i, cl_spec)
1416     | Expression _ -> Types.ArrayType (Types.ParameterDimension, cl_spec)
1417     | Colon -> Types.ArrayType (Types.DiscreteDimension, cl_spec) in
1418   List.fold_right add_dimension (evaluate dims) cl_spec
1419
1420 and modified_described_type ctx cpnt_type cl_modif =
1421   let cpnt_type' = evaluate cpnt_type in
1422   let cl_spec = cpnt_type'.Types.base_class in
1423   { cpnt_type' with
1424     Types.base_class =
1425       lazy (modify_class_specifier ctx (evaluate cl_modif) cl_spec)
1426   }
1427
1428 and modified_class_type ctx cl_spec cl_modif =
1429   let cl_spec' = modify_class_specifier ctx (evaluate cl_modif) cl_spec in
1430   match cl_spec' with
1431     | Types.ClassType cl_type -> cl_type
1432     | Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |
1433       Types.TupleType _ ->
1434         raise (CompilError
1435           {err_msg = ["class"; "_ElemExpected"];
1436            err_info = [("TypeFound",
1437                         Types.string_of_class_specifier cl_spec')];
1438            err_ctx = ctx}) (*error*)
1439
1440 and modified_component_type ctx cpnt_type modif =
1441   let modified_component_type' = function
1442     | Modification (cl_modif, _) -> modify_component_type ctx cl_modif cpnt_type
1443     | Assignment _ | Equality _ -> cpnt_type in
1444   match evaluate modif with
1445     | None -> cpnt_type
1446     | Some modif' -> modified_component_type' modif'
1447
1448 (* We can abstract dimensions away since they have been already checked at *)
1449 (* modification resolution time.                                           *)
1450 and modify_class_specifier ctx cl_modif cl_spec =
1451   let rec modify_class_specifier' cl_spec' = match cl_spec' with
1452     | Types.PredefinedType predef ->
1453         Types.PredefinedType (modify_predefined_type ctx cl_modif predef)
1454     | Types.ClassType cl_type ->
1455         Types.ClassType (modify_class_type ctx cl_modif cl_type)
1456     | Types.ComponentType cpnt_type ->
1457         Types.ComponentType (modify_component_type ctx cl_modif cpnt_type)
1458     | Types.ArrayType (dim, cl_spec) ->
1459         Types.ArrayType (dim, modify_class_specifier' cl_spec)
1460     | Types.TupleType _ ->
1461         raise (CompilError
1462           {err_msg = ["_InvalidTypeOfClassSpec"];
1463            err_info = [("_TypeFound",
1464                         Types.string_of_class_specifier cl_spec')];
1465            err_ctx = ctx}) (*error*) in
1466   modify_class_specifier' (evaluate cl_spec)
1467
1468 and modify_predefined_type ctx cl_modif predef =
1469   { predef with
1470     Types.attributes =
1471       modify_predefined_attributes ctx cl_modif predef.Types.attributes
1472   }
1473
1474 and modify_predefined_attributes ctx cl_modif attrs =
1475   let apply_modifications ((id, final) as attr) = function
1476     | [] -> attr
1477     | [_] when final -> assert false (*error*)
1478     | [final', (Assignment _ | Equality _)] -> id, final'
1479     | _ :: _ -> assert false (*error*) in
1480   let modify_attribute ((id, _) as attr) =
1481     let modifs, elt_descs = partition_modifications cl_modif id in
1482     match modifs, elt_descs with
1483       | [], [] -> attr
1484       | _ :: _, [] -> apply_modifications attr modifs
1485       | [], _ :: _
1486       | _ :: _, _ :: _ ->
1487           raise (CompilError
1488             {err_msg = ["_RedeclarePredefTypeAttrib"; id];
1489              err_info = [];
1490              err_ctx = ctx}) (*error*) in
1491   List.map modify_attribute attrs
1492
1493 and modify_class_type ctx cl_modif cl_type =
1494   let modify_named_element (id, elt_type) =
1495     id, lazy (modify_element ctx cl_modif id (evaluate elt_type)) in
1496   { cl_type with
1497     Types.named_elements =
1498       List.map modify_named_element cl_type.Types.named_elements
1499   }
1500
1501 and modify_element ctx cl_modif id elt_type =
1502   let modifs, elt_descs = partition_modifications cl_modif id in
1503   match modifs, elt_descs with
1504     | [], [] -> elt_type
1505     | _ :: _, [] -> apply_element_modifications ctx modifs elt_type id
1506     | [], [elt_desc] -> apply_element_redeclaration ctx elt_desc elt_type
1507     | [], _ :: _ :: _ ->
1508         raise (CompilError
1509           {err_msg = ["_InvalidElemModifDef"];
1510            err_info = [];
1511            err_ctx = ctx}) (*error*)
1512     | _ :: _, _ :: _ ->
1513         raise (CompilError
1514           {err_msg = ["_InvalidElemModifDef"];
1515            err_info = [];
1516            err_ctx = ctx}) (*error*)
1517
1518 and partition_modifications cl_modif id =
1519   let add_element_modification modif_arg modifs = match modif_arg.action with
1520     | Some (ElementModification modif) -> (modif_arg.final, modif) :: modifs
1521     | None | Some (ElementRedeclaration _) -> modifs
1522   and add_element_redeclaration modif_arg elt_descs =
1523     match modif_arg.action with
1524       | None | Some (ElementModification _) -> elt_descs
1525       | Some (ElementRedeclaration elt_desc) ->
1526           (modif_arg.final, elt_desc) :: elt_descs in
1527   let is_current_element_modification modif_arg = modif_arg.target = id in
1528   let cl_modif' = List.filter is_current_element_modification cl_modif in
1529   let modifs = List.fold_right add_element_modification cl_modif' []
1530   and elt_descs = List.fold_right add_element_redeclaration cl_modif' [] in
1531   modifs, elt_descs
1532
1533 and apply_element_redeclaration ctx elt_desc elt_type =
1534   raise (CompilError
1535     {err_msg = ["_NotYetImplemented"; "_ElementRedeclaration"];
1536      err_info = [];
1537      err_ctx = ctx})
1538
1539 and apply_element_modifications ctx modifs elt_type id =
1540   let add_modification_arguments (final, modif) cl_modifs = match modif with
1541     | Modification (cl_modif, _) -> (final, cl_modif) :: cl_modifs
1542     | Assignment _ | Equality _ -> cl_modifs
1543   and add_value_modification (final, modif) val_modifs = match modif with
1544     | Modification (_, Some _) | Assignment _ | Equality _ ->
1545         final :: val_modifs
1546     | Modification (_, None) -> val_modifs in
1547   let cl_modifs = List.fold_right add_modification_arguments modifs []
1548   and val_modifs = List.fold_right add_value_modification modifs [] in
1549   let elt_type' = modify_element_type ctx cl_modifs elt_type id in
1550   modify_element_value ctx val_modifs elt_type' id
1551
1552 and modify_element_type ctx cl_modifs elt_type id =
1553   let propagate_final_attribute final modif_arg cl_modif =
1554     { modif_arg with final = final } :: cl_modif in
1555   let merge_modifications (final, cl_modif) cl_modif' =
1556     List.fold_right (propagate_final_attribute final) cl_modif cl_modif' in
1557   let cl_modif = List.fold_right merge_modifications cl_modifs [] in
1558   { elt_type with
1559     Types.element_nature = modify_element_nature ctx cl_modif elt_type id
1560   }
1561
1562 and modify_element_nature ctx cl_modif elt_type id =
1563   match elt_type.Types.element_nature with
1564     | _ when elt_type.Types.final ->
1565         raise (CompilError
1566           {err_msg = ["_FinalElemModifNotAllowed"; id];
1567            err_info = [];
1568            err_ctx = ctx}) (*error*)
1569     | Types.ComponentElement cpnt_type ->
1570         Types.ComponentElement (modify_component_type ctx cl_modif cpnt_type)
1571     | Types.ClassElement cl_spec ->
1572         let cl_spec' = lazy (modify_class_specifier ctx cl_modif cl_spec) in
1573         Types.ClassElement cl_spec'
1574     | Types.ComponentTypeElement cpnt_type ->
1575         let cpnt_type' = modify_component_type ctx cl_modif cpnt_type in
1576         Types.ComponentTypeElement cpnt_type'
1577     | Types.PredefinedTypeElement predef ->
1578         Types.PredefinedTypeElement (modify_predefined_type ctx cl_modif predef)
1579
1580 and modify_element_value ctx val_modifs elt_type id =
1581   match val_modifs with
1582     | [] -> elt_type
1583     | [_] when elt_type.Types.final ->
1584         raise (CompilError
1585           {err_msg = ["_FinalElemModifNotAllowed"; id];
1586            err_info = [];
1587            err_ctx = ctx}) (*error*)
1588     | [final] -> { elt_type with Types.final = final }
1589     | _ :: _ :: _ ->
1590         raise (CompilError
1591           {err_msg = ["_DuplicatedModifOfElem"; id];
1592            err_info = [];
1593            err_ctx = ctx}) (*error*)
1594
1595 and modify_component_type ctx cl_modif cpnt_type =
1596   { cpnt_type with
1597     Types.base_class =
1598       lazy (modify_class_specifier ctx cl_modif cpnt_type.Types.base_class)
1599   }
1600
1601 and resolve_type_modification ctx cpnt_type cl_modif =
1602   let cl_spec = (evaluate cpnt_type).Types.base_class in
1603   resolve_class_modification_option ctx cl_spec cl_modif
1604
1605 and resolve_component_modification ctx cpnt_type = function
1606   | None -> None
1607   | Some modif' ->
1608       let elt_nat = Types.ComponentElement (evaluate cpnt_type) in
1609       Some (resolve_modification ctx elt_nat modif')
1610
1611 and resolve_class_modification_option ctx cl_spec = function
1612   | None -> []
1613   | Some cl_modif -> resolve_class_modification ctx cl_spec cl_modif
1614
1615 and resolve_modification ctx elt_nat modif =
1616   let ctx = {ctx with location = modif.Syntax.info} in
1617   match elt_nat, modif.Syntax.nature with
1618     | Types.ComponentElement cpnt_type, Syntax.Modification (cl_modif, expr) |
1619       Types.ComponentTypeElement cpnt_type,
1620       Syntax.Modification (cl_modif, (None as expr)) ->
1621         resolve_component_type_modification ctx cpnt_type cl_modif expr
1622     | Types.ComponentTypeElement _, Syntax.Modification (_, Some _) ->
1623         raise (CompilError
1624           {err_msg = ["_InvalidClassElemModif"];
1625            err_info = [];
1626            err_ctx = ctx}) (*error*)
1627     | Types.ClassElement cl_spec, Syntax.Modification (cl_modif, None) ->
1628         let cl_modif' = resolve_class_modification ctx cl_spec cl_modif in
1629         Modification (cl_modif', None)
1630     | Types.ClassElement _, Syntax.Modification (_, Some _) ->
1631         raise (CompilError
1632           {err_msg = ["_InvalidClassElemModif"];
1633            err_info = [];
1634            err_ctx = ctx}) (*error*)
1635     | (Types.PredefinedTypeElement _),
1636       (Syntax.Modification _ | Syntax.Eq _ | Syntax.ColEq _) ->
1637         raise (CompilError
1638           {err_msg = ["_InvalidClassElemModif"];
1639            err_info = [];
1640            err_ctx = ctx}) (*error*)
1641     | Types.ComponentElement cpnt_type, Syntax.Eq expr ->
1642         let expr' = lazy (resolve_modification_equation ctx cpnt_type expr) in
1643         Equality expr'
1644     | Types.ComponentElement cpnt_type, Syntax.ColEq expr ->
1645         let expr' = lazy (resolve_modification_algorithm ctx cpnt_type expr) in
1646         Assignment expr'
1647     | (Types.ClassElement _ | Types.ComponentTypeElement _),
1648       (Syntax.Eq _ | Syntax.ColEq _) ->
1649         raise (CompilError
1650           {err_msg = ["_InvalidClassElemModif"];
1651            err_info = [];
1652            err_ctx = ctx}) (*error*)
1653
1654 and resolve_component_type_modification ctx cpnt_type cl_modif expr =
1655   let ctx = {ctx with location = cl_modif.Syntax.info} in
1656   let cl_spec = cpnt_type.Types.base_class in
1657   let cl_modif' = resolve_class_modification ctx cl_spec cl_modif in
1658   let cpnt_type' = modify_component_type ctx cl_modif' cpnt_type in
1659   let expr' = resolve_value_modification_option ctx cpnt_type' expr in
1660   Modification (cl_modif', expr')
1661
1662 and resolve_value_modification_option ctx cpnt_type = function
1663   | None -> None
1664   | Some expr -> Some (lazy (resolve_modification_equation ctx cpnt_type expr))
1665
1666 and resolve_modification_equation ctx cpnt_type expr =
1667   let ctx = {ctx with location = expr.Syntax.info} in
1668   let resolve_modification_equation' cpnt_type' expr' =
1669     let var = evaluate cpnt_type.Types.variability
1670     and var' = evaluate cpnt_type'.Types.variability in
1671     match Types.compare_component_types cpnt_type cpnt_type' with
1672     | Types.SameType
1673       when Types.higher_variability var var' -> expr'
1674     | Types.SameType ->
1675         let var = Types.string_of_variability var
1676         and var' = Types.string_of_variability var' in
1677         raise (CompilError
1678           {err_msg = ["_VariabilityConflicts"];
1679            err_info = [("_ExprKind", "A = B");
1680                        ("_VariabilityOfA", var);
1681                        ("_VariabilityOfB", var')];
1682            err_ctx = ctx}) (*error*)
1683     | _ ->
1684               let type_A = Types.string_of_component_type cpnt_type
1685               and type_B = Types.string_of_component_type cpnt_type' in
1686               raise (CompilError
1687                 {err_msg = [ "_EquTermsNotOfTheSameType"];
1688                  err_info = [("_ExprKind", "A = B");
1689                              ("_TypeOfA", type_A);
1690                              ("_TypeOfB", type_B)];
1691            err_ctx = ctx}) (*error*) in
1692   let expr' = resolve_expression ctx expr in
1693   let expr' = apply_rhs_coercions cpnt_type expr' in
1694   match expr'.info.type_description with
1695   | Types.ComponentElement cpnt_type' ->
1696       resolve_modification_equation' cpnt_type' expr'
1697     | Types.ClassElement _ | Types.ComponentTypeElement _ |
1698       Types.PredefinedTypeElement _ ->
1699         raise (CompilError
1700           {err_msg = ["_ClassElemFoundInExpr"];
1701            err_info = [];
1702            err_ctx = ctx}) (*error*)
1703
1704 and resolve_modification_algorithm ctx cpnt_type expr =
1705   let ctx = {ctx with location = expr.Syntax.info} in
1706   let resolve_modification_algorithm' cpnt_type' expr' =
1707           let var = evaluate cpnt_type.Types.variability
1708           and var' = evaluate cpnt_type'.Types.variability in
1709           match Types.compare_component_types cpnt_type cpnt_type' with
1710     | Types.SameType
1711               when Types.higher_variability var var' -> expr'
1712     | Types.SameType ->
1713               let var = Types.string_of_variability var
1714               and var' = Types.string_of_variability var' in
1715               raise (CompilError
1716           {err_msg = ["_VariabilityConflicts"];
1717                  err_info = [("_ExprKind", "A := B");
1718                              ("_VariabilityOfA", var);
1719                              ("_VariabilityOfB", var')];
1720                  err_ctx = ctx}) (*error*)
1721     | _ ->
1722               let type_A = Types.string_of_component_type cpnt_type
1723               and type_B = Types.string_of_component_type cpnt_type' in
1724               raise (CompilError
1725           {err_msg = [ "_TypeConflictsInAssign"];
1726                  err_info = [("_ExprKind", "A := B");
1727                              ("_TypeOfA", type_A);
1728                              ("_TypeOfB", type_B)];
1729            err_ctx = ctx}) (*error*) in
1730   let expr' = resolve_expression ctx expr in
1731   let expr' = apply_rhs_coercions cpnt_type expr' in
1732   match expr'.info.type_description with
1733   | Types.ComponentElement cpnt_type' ->
1734       resolve_modification_algorithm' cpnt_type' expr'
1735     | Types.ClassElement _ | Types.ComponentTypeElement _ |
1736       Types.PredefinedTypeElement _ ->
1737         raise (CompilError
1738           {err_msg = ["_ClassElemFoundInExpr"];
1739            err_info = [];
1740            err_ctx = ctx}) (*error*)
1741
1742 and resolve_class_modification ctx cl_spec cl_modif =
1743   match cl_modif.Syntax.nature with
1744     | Syntax.ClassModification args ->
1745         List.map (resolve_modification_argument ctx cl_spec) args
1746
1747 and resolve_modification_argument ctx cl_spec arg =
1748   let ctx = {ctx with location = arg.Syntax.info} in
1749   let apply_each each =
1750     let rec drop_dimensions cl_spec = match cl_spec with
1751       | Types.ArrayType (_, cl_spec') -> drop_dimensions cl_spec'
1752       | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
1753         Types.TupleType _ -> cl_spec in
1754     let cl_spec' = evaluate cl_spec in
1755     match cl_spec' with
1756       | Types.ArrayType _ when each -> drop_dimensions cl_spec'
1757       | Types.PredefinedType _
1758       | Types.ClassType _
1759       | Types.ComponentType _
1760       | Types.TupleType _ when each ->
1761           raise (CompilError
1762             {err_msg = ["_EachAppliedToNonArrayElem"];
1763              err_info = [];
1764              err_ctx = ctx}) (*error*)
1765       | Types.ArrayType _ | Types.PredefinedType _ | Types.ClassType _ |
1766         Types.ComponentType _ | Types.TupleType _ -> cl_spec' in
1767   match arg.Syntax.nature with
1768     | Syntax.ElementModification (each, final, expr, modif, _) ->
1769         let each' = bool_of_each each
1770         and final' = bool_of_final final in
1771         let cl_spec' = apply_each each' in
1772         resolve_element_modification ctx cl_spec' each' final' expr modif
1773     | Syntax.ElementRedeclaration (each, final, elt_def) ->
1774         let each' = bool_of_each each
1775         and final' = bool_of_final final in
1776         let cl_spec' = apply_each each' in
1777         resolve_element_redeclaration ctx cl_spec' each' final' elt_def
1778
1779 and bool_of_each = function
1780   | None -> false
1781   | Some Syntax.Each -> true
1782
1783 and bool_of_final = function
1784   | None -> false
1785   | Some Syntax.Final -> true
1786
1787 and resolve_element_modification ctx cl_spec each final expr modif =
1788   let ctx = {ctx with location = expr.Syntax.info} in
1789   let rec path_of_expression path expr = match expr.Syntax.nature with
1790     | Syntax.Identifier id ->
1791         modification_arguments_of_path cl_spec each final id (List.rev path)
1792     | Syntax.FieldAccess (expr, id) -> path_of_expression (id :: path) expr
1793     | _ ->
1794         raise (CompilError
1795           {err_msg = ["_InvalidExprInElemModif"];
1796            err_info = [];
1797            err_ctx = ctx}) (*error*)
1798   and modification_arguments_of_path cl_spec each final id path =
1799     let flow = false
1800     and var = Types.Continuous
1801     and inout = Types.Acausal in
1802     let elt_nat = element_field_type_nature ctx flow var inout cl_spec id in
1803     {
1804       each = each;
1805       final = final;
1806       target = id;
1807       action = resolve_modification_action ctx modif elt_nat path
1808     }
1809   and resolve_modification_action ctx modif elt_nat = function
1810     | [] -> resolve_modification_option ctx elt_nat modif
1811     | id :: path ->
1812         raise (CompilError
1813           {err_msg = ["_NotYetImplemented"; "_FieldAccessInElemModifExpr"];
1814            err_info = [];
1815            err_ctx = ctx})
1816   and resolve_modification_option ctx elt_nat = function
1817     | None -> None
1818     | Some modif ->
1819         Some (ElementModification (resolve_modification ctx elt_nat modif)) in
1820   path_of_expression [] expr
1821
1822 and resolve_element_redeclaration ctx cl_spec each final elt_def =
1823   let ctx = {ctx with location = elt_def.Syntax.info} in
1824   raise (CompilError
1825     {err_msg = ["_NotYetImplemented"; "_ElementRedeclaration"];
1826      err_info = [];
1827      err_ctx = ctx})
1828
1829 and resolve_unnamed_elements ctx other_elts =
1830   let class_kind =
1831     let class_context' cl_spec = match cl_spec with
1832       | Types.ClassType cl_type ->
1833           Some (evaluate cl_type.Types.kind)
1834       | _ -> None in
1835     match ctx.context_nature with
1836     | ClassContext cl_def ->
1837         class_context' (evaluate cl_def.class_type)
1838     | _ -> None in
1839   let add_equation_or_algorithm_clause other_elt acc =
1840     match other_elt.Syntax.nature, class_kind with
1841       | (Syntax.EquationClause _), Some kind
1842         when List.mem kind [Types.Function; Types.Record; Types.Connector] ->
1843           raise (CompilError
1844             {err_msg = ["_EquNotAllowedInTheDefOf"; Types.string_of_kind kind];
1845              err_info = [];
1846              err_ctx = ctx}) (*error*)
1847       | Syntax.EquationClause (init, equ_defs), _ ->
1848           let init' = bool_of_initial init
1849           and equ_defs' = resolve_equation_definitions ctx equ_defs in
1850           EquationClause (init', equ_defs') :: acc
1851       | Syntax.AlgorithmClause (init, algo_defs), _ ->
1852           let init' = bool_of_initial init
1853           and algo_defs' = resolve_algorithm_definitions ctx algo_defs in
1854           AlgorithmClause (init', algo_defs') :: acc
1855       | (Syntax.Public _ | Syntax.Protected _), _ -> acc in
1856   List.fold_right add_equation_or_algorithm_clause other_elts []
1857
1858 and bool_of_initial = function
1859   | None -> Permanent
1860   | Some Syntax.Initial -> Initial
1861
1862 and resolve_equation_definitions ctx equ_defs =
1863   let resolve_equation_definition equ_def = match equ_def.Syntax.nature with
1864     | Syntax.Equation (equ, _, _) -> resolve_equation ctx equ in
1865   List.flatten (List.map resolve_equation_definition equ_defs)
1866
1867 and resolve_algorithm_definitions ctx algo_defs =
1868   let resolve_algorithm_definition algo_def = match algo_def.Syntax.nature with
1869     | Syntax.Algorithm (algo, _, _) -> resolve_algorithm ctx algo in
1870   List.map resolve_algorithm_definition algo_defs
1871
1872 and resolve_equation ctx equ =
1873   let ctx = {ctx with location = equ.Syntax.info} in
1874   match equ.Syntax.nature with
1875     | Syntax.Equal (expr, expr') -> resolve_equal ctx equ expr expr'
1876     | Syntax.ConditionalEquationE (alts, default) ->
1877         resolve_conditional_equation_e ctx equ alts default
1878     | Syntax.ForClauseE (for_inds, equs) ->
1879         resolve_for_clause_e ctx equ for_inds equs
1880     | Syntax.ConnectClause (expr, expr') ->
1881         resolve_connect_clause ctx equ expr expr'
1882     | Syntax.WhenClauseE alts ->
1883         resolve_when_clause_e ctx equ alts
1884     | Syntax.FunctionCallE (expr, fun_args) ->
1885         resolve_functional_call_e ctx equ expr fun_args
1886
1887 and resolve_equal ctx equ expres expres' =
1888   let resolve_equal' cpnt_type expr cpnt_type' expr' =
1889     let resolved_equation syn expr expr' =
1890       {
1891         nature = Equal (expr, expr');
1892         info = syn
1893       } in
1894     let var = evaluate cpnt_type.Types.variability
1895     and var' = evaluate cpnt_type'.Types.variability in
1896     match var, var' with
1897     | Types.Continuous, _ | _, Types.Continuous ->
1898         equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr'
1899     | Types.Discrete, _ | _, Types.Discrete
1900       when expression_of_variable expres ->
1901         equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr'
1902     | Types.Discrete, _ | _, Types.Discrete ->
1903         raise (CompilError
1904           {err_msg = ["_LHSOfDiscreteEquMustBeAVar"];
1905            err_info = [];
1906            err_ctx = {ctx with location = expres.Syntax.info}}) (*error*)
1907     | _ ->
1908         equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' in
1909   let expr = resolve_expression ctx expres
1910   and expr' = resolve_expression ctx expres' in
1911   let exprs = apply_binary_coercions [ expr; expr' ] in
1912   let expr = List.nth exprs 0
1913   and expr' = List.nth exprs 1 in
1914   let elt_nat = expr.info.type_description
1915   and elt_nat' = expr'.info.type_description in
1916   match elt_nat, elt_nat' with
1917     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
1918         resolve_equal' cpnt_type expr cpnt_type' expr'
1919     | (Types.ClassElement _ | Types.ComponentTypeElement _ |
1920       Types.PredefinedTypeElement _), _ ->
1921         let ctx = {ctx with location = expres.Syntax.info} in
1922         raise (CompilError
1923           {err_msg = ["_ClassElemFoundInExpr"];
1924            err_info = [];
1925            err_ctx = ctx}) (*error*)
1926     | _, (Types.ClassElement _ | Types.ComponentTypeElement _ |
1927       Types.PredefinedTypeElement _) ->
1928         let ctx = {ctx with location = expres'.Syntax.info} in
1929         raise (CompilError
1930           {err_msg = ["_ClassElemFoundInExpr"];
1931            err_info = [];
1932            err_ctx = ctx}) (*error*)
1933
1934 and resolve_conditional_equation_e ctx equ alts default =
1935   let resolve_alternative (expr, equs) =
1936     let ctx = {ctx with location = expr.Syntax.info} in
1937     let expr' = resolve_expression ctx expr in
1938     let resolve_alternative' cpnt_type =
1939       let cl_spec = evaluate cpnt_type.Types.base_class in
1940       match cl_spec with
1941         | Types.PredefinedType { Types.base_type = Types.BooleanType } ->
1942             let equs' = List.flatten (List.map (resolve_equation ctx) equs) in
1943             expr', equs'
1944         | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
1945           Types.ArrayType _ | Types.TupleType _ ->
1946             raise (CompilError
1947               {err_msg = ["_NonBooleanIfCondExpr"];
1948                err_info =
1949                  [("_ExprKind", "...if A then...");
1950                   ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
1951                err_ctx = ctx}) (*error*) in
1952     match expr'.info.type_description with
1953       | Types.ComponentElement cpnt_type -> resolve_alternative' cpnt_type
1954       | Types.ClassElement _ | Types.ComponentTypeElement _ |
1955         Types.PredefinedTypeElement _ ->
1956           raise (CompilError
1957             {err_msg = ["_ClassElemFoundInExpr"];
1958              err_info = [];
1959              err_ctx = ctx}) (*error*) in
1960   let alts' = List.map resolve_alternative alts in
1961   let default' = match default with
1962     | None -> []
1963     | Some equs -> List.flatten (List.map (resolve_equation ctx) equs) in
1964   [{
1965     nature = ConditionalEquationE (alts', default');
1966     info = Some equ
1967   }]
1968
1969 and resolve_for_clause_e ctx equ for_inds equs =
1970   let range_element_type expr range =
1971     let ctx = {ctx with location = expr.Syntax.info} in
1972     let sub_dimension cl_spec = match cl_spec with
1973       | Types.ArrayType (dim, cl_spec) -> cl_spec
1974       | Types.PredefinedType _ | Types.ClassType _ |
1975         Types.ComponentType _ | Types.TupleType _ ->
1976           raise (CompilError
1977             {err_msg = ["_InvalidTypeInRangeExpr"];
1978              err_info =
1979                [("_ExpectedType", "Integer");
1980                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
1981              err_ctx = ctx}) (*error*) in
1982     match range.info.type_description with
1983       | Types.ComponentElement cpnt_type ->
1984           let cl_spec = evaluate cpnt_type.Types.base_class in
1985           let cpnt_type' =
1986             { cpnt_type with
1987               Types.base_class = lazy (sub_dimension cl_spec)
1988             } in
1989           Types.ComponentElement cpnt_type'
1990       | Types.ClassElement _ | Types.ComponentTypeElement _ |
1991         Types.PredefinedTypeElement _ ->
1992           raise (CompilError
1993             {err_msg = ["_ClassElemFoundInExpr"];
1994              err_info = [];
1995              err_ctx = ctx}) (*error*) in
1996   let rec resolve_for_clause_e' acc ctx = function
1997     | [] ->
1998         let equs' = List.flatten (List.map (resolve_equation ctx) equs) in
1999         [{
2000           nature = ForClauseE (List.rev acc, equs');
2001           info = Some equ
2002         }]
2003     | (_, None) :: _ ->
2004         raise (CompilError
2005           {err_msg = ["_NotYetImplemented"; "_ImplicitIterRange"];
2006            err_info = [];
2007            err_ctx = ctx})
2008     | (id, Some expr) :: for_inds ->
2009         let range = resolve_expression ctx expr in
2010         let elt_nat = range_element_type expr range in
2011         let ctx' =
2012           { ctx with
2013             context_nature = ForContext (ctx, id, elt_nat)
2014           } in
2015         resolve_for_clause_e' (range :: acc) ctx' for_inds in
2016   resolve_for_clause_e' [] ctx for_inds
2017
2018 and resolve_connect_clause ctx equ expres expres' =
2019   let expr = resolve_expression ctx expres
2020   and expr' = resolve_expression ctx expres' in
2021   let resolve_connect_clause' cpnt_typ cpnt_typ' =
2022     let rec class_type_of_class_specifier cl_spec = match cl_spec with
2023       | Types.ClassType cl_type -> cl_type
2024       | Types.ComponentType cpnt_type ->
2025           let cl_spec = evaluate cpnt_type.Types.base_class in
2026           class_type_of_class_specifier cl_spec
2027       | Types.ArrayType (_, cl_spec) -> class_type_of_class_specifier cl_spec
2028       | Types.PredefinedType _ | Types.TupleType _ ->
2029           raise (CompilError
2030               {err_msg = ["_InvalidTypeOfArgInConnectStat"];
2031                err_info =
2032                  [("_ExprKind", "connect(A, B)");
2033                   ("_TypeOfA", Types.string_of_component_type cpnt_typ);
2034                   ("_TypeOfB", Types.string_of_component_type cpnt_typ')];
2035                err_ctx = ctx}) (*error*) in
2036     let connector_sign expr =
2037       let is_connector_type expr =
2038         let is_connector_type' cpnt_type =
2039           let cl_spec = evaluate cpnt_type.Types.base_class in
2040           let cl_type = class_type_of_class_specifier cl_spec in
2041           match evaluate cl_type.Types.kind with
2042             | Types.Connector | Types.ExpandableConnector -> true
2043             | Types.Class | Types.Model | Types.Block -> false
2044             | Types.Record ->
2045                 raise (CompilError
2046                   {err_msg =
2047                      ["record"; "_InstanceUsedInConnection"];
2048                    err_info = [];
2049                    err_ctx = ctx}) (*error*)
2050             | Types.Package ->
2051                 raise (CompilError
2052                   {err_msg =
2053                      ["package"; "_InstanceUsedInConnection"];
2054                    err_info = [];
2055                    err_ctx = ctx}) (*error*)
2056             | Types.Function ->
2057                 raise (CompilError
2058                   {err_msg =
2059                      ["function"; "_InstanceUsedInConnection"];
2060                    err_info = [];
2061                    err_ctx = ctx}) (*error*) in
2062         match expr.info.type_description with
2063           | Types.ComponentElement cpnt_type ->
2064               is_connector_type' cpnt_type
2065           | _ ->
2066               raise (CompilError
2067                 {err_msg = ["_ClassElemFoundInExpr"];
2068                  err_info = [];
2069                  err_ctx = ctx}) (*error*) in
2070       let is_connectable expr =
2071         let is_connectable' cpnt_type =
2072           let cl_spec = evaluate cpnt_type.Types.base_class in
2073           let cl_type = class_type_of_class_specifier cl_spec in
2074           match evaluate cl_type.Types.kind with
2075             | Types.Class | Types.Model | Types.Block -> true
2076             | Types.Connector | Types.ExpandableConnector -> false
2077             | Types.Record ->
2078                 raise (CompilError
2079                   {err_msg =
2080                      ["record"; "_InstanceUsedInConnection"];
2081                    err_info = [];
2082                    err_ctx = ctx}) (*error*)
2083             | Types.Package ->
2084                 raise (CompilError
2085                   {err_msg =
2086                      ["package"; "_InstanceUsedInConnection"];
2087                    err_info = [];
2088                    err_ctx = ctx}) (*error*)
2089             | Types.Function ->
2090                 raise (CompilError
2091                   {err_msg =
2092                      ["function"; "_InstanceUsedInConnection"];
2093                    err_info = [];
2094                    err_ctx = ctx}) (*error*) in
2095         match expr.info.type_description with
2096           | Types.ComponentElement cpnt_type ->
2097               is_connectable' cpnt_type
2098           | _ ->
2099               raise (CompilError
2100                 {err_msg = ["_ClassElemFoundInExpr"];
2101                  err_info = [];
2102                  err_ctx = ctx}) (*error*) in
2103       let rec connector_sign' expr = match expr.nature with
2104         | LocalIdentifier (0, _) when is_connector_type expr -> Some Negative
2105         | LocalIdentifier (0, _) when is_connectable expr -> Some Positive
2106         | (FieldAccess (expr', _) | IndexedAccess (expr', _))
2107           when is_connector_type expr -> connector_sign' expr'
2108         | (FieldAccess (expr', _) | IndexedAccess (expr', _))
2109           when is_connectable expr' -> connector_sign' expr'
2110         | _ ->
2111             raise (CompilError
2112               {err_msg = ["_InvalidTypeOfArgInConnectStat"];
2113                err_info =
2114                  [("_ExprKind", "connect(A, B)");
2115                   ("_TypeOfA", Types.string_of_component_type cpnt_typ);
2116                   ("_TypeOfB", Types.string_of_component_type cpnt_typ')];
2117                err_ctx = ctx}) (*error*) in
2118       match expr.nature with
2119         | _ when not (is_connector_type expr) ->
2120             raise (CompilError
2121               {err_msg = ["_InvalidTypeOfArgInConnectStat"];
2122                err_info =
2123                  [("_ExprKind", "connect(A, B)");
2124                   ("_TypeOfA", Types.string_of_component_type cpnt_typ);
2125                   ("_TypeOfB", Types.string_of_component_type cpnt_typ')];
2126                err_ctx = ctx}) (*error*)
2127         | LocalIdentifier (0, _) -> Some Negative
2128         | _ -> connector_sign' expr in
2129     let connect sign cpnt_type sign' cpnt_type' =
2130       let resolved_equation syn expr expr' =
2131         let elt_nat = expr.info.type_description
2132         and elt_nat' = expr'.info.type_description in
2133         let flow, _, _ = type_prefixes_of_element_nature elt_nat
2134         and flow', _, _ = type_prefixes_of_element_nature elt_nat' in
2135         match flow, flow' with
2136           | false, false ->
2137               {
2138                 nature = Equal (expr, expr');
2139                 info = syn
2140               }
2141           | true, true ->
2142               {
2143                 nature = ConnectFlows (sign, expr, sign', expr');
2144                 info = syn
2145               }
2146           | false, true ->
2147               raise (CompilError
2148                 {err_msg = ["_CannotConnectFlowAndNonFlowComp"];
2149                  err_info =
2150                    [("_ExprKind", "connect(A, B)");
2151                     ("_TypeOfA", "non-flow connector");
2152                     ("_TypeOfB", "flow connector")];
2153                  err_ctx = ctx}) (*error*)
2154           | true, false ->
2155               raise (CompilError
2156                 {err_msg = ["_CannotConnectFlowAndNonFlowComp"];
2157                  err_info =
2158                    [("_ExprKind", "connect(A, B)");
2159                     ("_TypeOfA", "flow connector");
2160                     ("_TypeOfB", "non-flow connector")];
2161                  err_ctx = ctx}) (*error*) in
2162       equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' in
2163     match connector_sign expr, connector_sign expr' with
2164       | Some sign, Some sign' -> connect sign cpnt_typ sign' cpnt_typ'
2165       | None, Some _ -> assert false
2166       | Some _, None -> assert false
2167       | None, None -> assert false in
2168   let elt_nat = expr.info.type_description
2169   and elt_nat' = expr'.info.type_description in
2170   match elt_nat, elt_nat' with
2171     | Types.ComponentElement cpnt_typ, Types.ComponentElement cpnt_typ' ->
2172         resolve_connect_clause' cpnt_typ cpnt_typ'
2173     | _, _ ->
2174         raise (CompilError
2175             {err_msg = ["_InvalidTypeOfArgInConnectStat"];
2176              err_info =
2177                [("_ExprKind", "connect(A, B)");
2178                 ("_TypeOfA", Types.string_of_element_nature elt_nat);
2179                 ("_TypeOfB", Types.string_of_element_nature elt_nat')];
2180              err_ctx = ctx}) (*error*)
2181
2182 and resolve_when_clause_e ctx equ alts =
2183   let resolve_alternative (expr, equs) =
2184     let expr' = resolve_expression ctx expr in
2185     let rec check_equation equ =
2186       let check_equal expr expr' =
2187         match expr.Syntax.nature, expr'.Syntax.nature with
2188         | _, _ when expression_of_variable expr -> true
2189         | Syntax.Tuple exprs, Syntax.FunctionCall _
2190             when List.for_all expression_of_variable exprs -> true
2191         | _, _ -> raise (CompilError
2192             {err_msg = ["_InvalidWhenEquation"];
2193              err_info = [];
2194              err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in
2195       let check_alternative (expr, equs) =
2196         List.for_all check_equation equs in
2197       let check_function_call_e expr fun_args =
2198         match expr.Syntax.nature with
2199         | Syntax.Identifier "assert" |
2200           Syntax.Identifier "terminate" |
2201           Syntax.Identifier "reinit" -> true
2202         | _ ->
2203             raise (CompilError
2204               {err_msg = ["_InvalidWhenEquation"];
2205                err_info = [];
2206                err_ctx = {ctx with location = expr.Syntax.info}}) in
2207       match equ.Syntax.nature with
2208       | Syntax.Equal (expr, expr') -> check_equal expr expr'
2209       | Syntax.ConditionalEquationE (alts, None) ->
2210           List.for_all check_alternative alts
2211       | Syntax.ConditionalEquationE (alts, Some equs) ->
2212           (List.for_all check_alternative alts) &&
2213           (List.for_all check_equation equs)
2214       | Syntax.ForClauseE (for_inds, equs) ->
2215           List.for_all check_equation equs
2216       | Syntax.ConnectClause (expr, expr') ->
2217           raise (CompilError
2218             {err_msg = ["_InvalidWhenEquation"];
2219              err_info = [];
2220              err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)
2221       | Syntax.WhenClauseE alts ->
2222           raise (CompilError
2223             {err_msg = ["_WhenClausesCannotBeNested"];
2224              err_info = [];
2225              err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)
2226       | Syntax.FunctionCallE (expr, fun_args) ->
2227           check_function_call_e expr fun_args in
2228     let resolve_alternative' cpnt_type =
2229       let cl_spec = evaluate cpnt_type.Types.base_class in
2230       match cl_spec with
2231       | Types.ArrayType (Types.DiscreteDimension, _) ->
2232           raise (CompilError
2233             {err_msg = ["_InvalidTypeOfWhenCond"];
2234              err_info =
2235                [("_ExprKind", "...when A then...");
2236                 ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
2237              err_ctx = {ctx with location = expr.Syntax.info}}) (*error*)
2238       | Types.PredefinedType { Types.base_type = Types.BooleanType } |
2239         Types.ArrayType
2240           (_, Types.PredefinedType { Types.base_type = Types.BooleanType })
2241               when List.for_all check_equation equs ->
2242               let equs' = List.flatten (List.map (resolve_equation ctx) equs) in
2243               expr', equs'
2244       | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
2245         Types.ArrayType _ | Types.TupleType _ ->
2246           raise (CompilError
2247             {err_msg = ["_InvalidTypeOfWhenCond"];
2248              err_info =
2249                [("_ExprKind", "...when A then...");
2250                 ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
2251              err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in
2252     match expr'.info.type_description with
2253     | Types.ComponentElement cpnt_type
2254         when (evaluate cpnt_type.Types.variability) <> Types.Continuous ->
2255           resolve_alternative' cpnt_type
2256     | Types.ComponentElement cpnt_type ->
2257         raise (CompilError
2258           {err_msg = ["_WhenConditionMustBeDiscrete"];
2259            err_info = [];
2260            err_ctx = {ctx with location = expr.Syntax.info}}) (*error*)
2261     | Types.ClassElement _ | Types.ComponentTypeElement _ |
2262       Types.PredefinedTypeElement _ ->
2263         raise (CompilError
2264           {err_msg = ["_ClassElemFoundInExpr"];
2265            err_info = [];
2266            err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in
2267   let alts' = List.map resolve_alternative alts in
2268   [{
2269     nature = WhenClauseE alts';
2270     info = Some equ
2271   }]
2272
2273 and resolve_functional_call_e ctx equ expr fun_args =
2274   let ctx = {ctx with location = equ.Syntax.info} in
2275   let res =
2276     let nat = Tuple []
2277     and elt_nat = Types.empty_tuple_type Types.Constant in
2278     resolved_expression None nat elt_nat in
2279   let fun_call = resolve_function_call ctx None expr fun_args in
2280   let resolve_functional_call_e cpnt_type =
2281     let cl_spec = evaluate cpnt_type.Types.base_class in
2282     match cl_spec with
2283       | Types.TupleType [] ->
2284           [{
2285             nature = Equal (res, fun_call);
2286             info = Some equ
2287           }]
2288       | _ ->
2289           raise (CompilError
2290             {err_msg = ["_NonEmptyFuncCallUsedAsAnEqu"];
2291              err_info =
2292                [("_TypeOfFuncValue", Types.string_of_class_specifier cl_spec)];
2293              err_ctx = ctx}) (*error*) in
2294   match fun_call.info.type_description with
2295     | Types.ComponentElement cpnt_type -> resolve_functional_call_e cpnt_type
2296     | Types.ClassElement _ | Types.ComponentTypeElement _ |
2297       Types.PredefinedTypeElement _ ->
2298         raise (CompilError
2299           {err_msg = ["_ClassElemFoundInExpr"];
2300            err_info = [];
2301            err_ctx = ctx}) (*error*)
2302
2303 and equations ctx equ resolved_equation cpnt_type expr cpnt_type' expr' =
2304   let equivalent_types predef predef' =
2305     match Types.compare_predefined_types predef predef',
2306           Types.compare_predefined_types predef' predef with
2307     | _, Types.NotRelated | Types.NotRelated, _ -> false
2308     | _ -> true in
2309   let rec equations' i subs cl_spec expr cl_spec' expr' =
2310     match cl_spec, cl_spec' with
2311       | Types.PredefinedType predef, Types.PredefinedType predef'
2312           when equivalent_types predef predef' ->
2313             [equation subs expr expr']
2314       | Types.ComponentType cpnt_type, Types.ComponentType cpnt_type' ->
2315           raise (CompilError
2316             {err_msg = ["_NotYetImplemented"; "_ComponentTypeEqu"];
2317              err_info = [];
2318              err_ctx = ctx})
2319       | Types.ClassType cl_type, Types.ClassType cl_type' ->
2320           record_equations subs cl_type expr cl_type' expr'
2321       | Types.ArrayType (dim, cl_spec), Types.ArrayType (dim', cl_spec') ->
2322           [for_equation i subs dim cl_spec expr dim' cl_spec' expr']
2323       | Types.TupleType cl_specs, Types.TupleType cl_specs' ->
2324           [{
2325             nature = Equal (expr, expr');
2326             info = Some equ
2327           }]
2328       | (Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |
2329          Types.TupleType _ | Types.ClassType _),
2330         (Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |
2331          Types.TupleType _ | Types.ClassType _) ->
2332           raise (CompilError
2333             {err_msg = ["_EquTermsNotOfTheSameType"];
2334              err_info =
2335                [("_ExprKind", "A = B");
2336                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
2337                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
2338              err_ctx = {ctx with location = equ.Syntax.info}}) (*error*)
2339   and for_equation i subs dim cl_spec expr dim' cl_spec' expr' =
2340     match dim, dim' with
2341       | Types.ConstantDimension n, Types.ConstantDimension n' when n <> n' ->
2342           let type_A = Types.string_of_component_type cpnt_type
2343           and type_B = Types.string_of_component_type cpnt_type' in
2344           raise (CompilError
2345             {err_msg = ["_ArrayDimMismatchInEqu"];
2346              err_info = [("_ExprKind", "A = B");
2347                          ("_TypeOfA", type_A);
2348                          ("_TypeOfB", type_B)];
2349              err_ctx = ctx}) (*error*)
2350       | (Types.ConstantDimension _ | Types.ParameterDimension),
2351         (Types.ConstantDimension _ | Types.ParameterDimension) ->
2352           let range = resolve_colon ctx expr (Int32.of_int i) dim in
2353           let subs =
2354             let nat = LoopVariable (i - 1)
2355             and elt_nat = Types.integer_type Types.Constant in
2356             resolved_expression None nat elt_nat :: subs in
2357           let equs = equations' (i + 1) subs cl_spec expr cl_spec' expr' in
2358           {
2359             nature = ForClauseE ([range], equs);
2360             info = Some equ
2361           }
2362       | (Types.ConstantDimension _ | Types.ParameterDimension |
2363          Types.DiscreteDimension),
2364         (Types.ConstantDimension _ | Types.ParameterDimension |
2365          Types.DiscreteDimension) ->
2366           let type_A = Types.string_of_component_type cpnt_type
2367           and type_B = Types.string_of_component_type cpnt_type' in
2368           raise (CompilError
2369             {err_msg = ["_ArrayDimMismatchInEqu"];
2370              err_info = [("_ExprKind", "A = B");
2371                          ("_TypeOfA", type_A);
2372                          ("_TypeOfB", type_B)];
2373              err_ctx = ctx}) (*error*)
2374   and record_equations subs cl_type expr cl_type' expr' =
2375     let named_elts = cl_type.Types.named_elements
2376     and named_elts' = cl_type'.Types.named_elements in
2377     let record_equations' expr expr' =
2378       let class_spec_of_element_type elt_type =
2379         let elt_type' = evaluate elt_type in
2380         element_nature_class ctx elt_type'.Types.element_nature in
2381       let record_equation (id, elt_type) =
2382         let elt_type' =
2383           try
2384             List.assoc id named_elts'
2385           with _ ->
2386             raise (CompilError
2387               {err_msg = ["_EquTermsNotOfTheSameType"];
2388                err_info =
2389                  [("_ExprKind", "A = B");
2390                   ("_TypeOfA", Types.string_of_component_type cpnt_type);
2391                   ("_TypeOfB", Types.string_of_component_type cpnt_type')];
2392                err_ctx = {ctx with location = equ.Syntax.info}}) (*error*) in
2393         let cl_spec = class_spec_of_element_type elt_type
2394         and cl_spec' = class_spec_of_element_type elt_type' in
2395         let expr =
2396           let nat = FieldAccess (expr, id)
2397           and flow, var, inout =
2398             type_prefixes_of_element_nature expr.info.type_description
2399           and cl_spec = element_nature_class ctx expr.info.type_description in
2400           let elt_nat =
2401             element_field_type_nature ctx flow var inout cl_spec id in
2402           resolved_expression None nat elt_nat
2403         and expr' =
2404           let nat = FieldAccess (expr', id)
2405           and flow, var, inout =
2406             type_prefixes_of_element_nature expr'.info.type_description
2407           and cl_spec = element_nature_class ctx expr'.info.type_description in
2408           let elt_nat =
2409             element_field_type_nature ctx flow var inout cl_spec id in
2410           resolved_expression None nat elt_nat in
2411         equations' 1 [] cl_spec expr cl_spec' expr' in
2412       List.flatten (List.map record_equation named_elts) in
2413     match subs with
2414       | [] -> record_equations' expr expr'
2415       | subs ->
2416           let expr =
2417             let elt_nat = expr.info.type_description in
2418             let nat = IndexedAccess (expr, subs)
2419             and elt_nat' = scalar_element_nature elt_nat in
2420             resolved_expression None nat elt_nat'
2421           and expr' =
2422             let elt_nat = expr'.info.type_description in
2423             let nat = IndexedAccess (expr', subs)
2424             and elt_nat' = scalar_element_nature elt_nat in
2425             resolved_expression None nat elt_nat' in
2426           record_equations' expr expr'
2427   and equation subs expr expr' = match subs with
2428     | [] -> resolved_equation (Some equ) expr expr'
2429     | subs ->
2430         let expr =
2431           let elt_nat = expr.info.type_description in
2432           let nat = IndexedAccess (expr, subs)
2433           and elt_nat' = scalar_element_nature elt_nat in
2434           resolved_expression None nat elt_nat'
2435         and expr' =
2436           let elt_nat = expr'.info.type_description in
2437           let nat = IndexedAccess (expr', subs)
2438           and elt_nat' = scalar_element_nature elt_nat in
2439           resolved_expression None nat elt_nat' in
2440         resolved_equation None expr expr' in
2441   let cl_spec = evaluate cpnt_type.Types.base_class
2442   and cl_spec' = evaluate cpnt_type'.Types.base_class in
2443   equations' 1 [] cl_spec expr cl_spec' expr'
2444
2445 and resolve_algorithm ctx algo =
2446   let ctx = {ctx with location = algo.Syntax.info} in
2447   match algo.Syntax.nature with
2448     | Syntax.Assign _ |
2449       Syntax.FunctionCallA _ |
2450       Syntax.MultipleAssign _ |
2451       Syntax.Break |
2452       Syntax.Return |
2453       Syntax.ConditionalEquationA _ |
2454       Syntax.ForClauseA _ |
2455       Syntax.WhileClause _ |
2456       Syntax.WhenClauseA _ ->
2457         raise (CompilError
2458           {err_msg = ["_NotYetImplemented"; "_AlgoClause"];
2459            err_info = [];
2460            err_ctx = ctx})
2461
2462 and resolve_expression ctx expr =
2463   let ctx = {ctx with location = expr.Syntax.info} in
2464   match expr.Syntax.nature with
2465     | Syntax.BinaryOperation (kind, arg1, arg2) ->
2466         resolve_binary_operation ctx expr kind arg1 arg2
2467     | Syntax.End -> resolve_end ctx expr
2468     | Syntax.False -> resolve_false ctx expr
2469     | Syntax.FieldAccess (expr', id) -> resolve_field_access ctx expr expr' id
2470     | Syntax.FunctionCall (expr', fun_args) ->
2471         resolve_function_call ctx (Some expr) expr' fun_args
2472     | Syntax.Identifier id -> resolve_identifier ctx expr id
2473     | Syntax.If (alts, expr') -> resolve_if ctx expr alts expr'
2474     | Syntax.IndexedAccess (expr', subs) ->
2475         resolve_indexed_access ctx expr expr' subs
2476     | Syntax.Integer s -> resolve_integer ctx expr s
2477     | Syntax.MatrixConstruction exprss ->
2478         resolve_matrix_construction ctx expr exprss
2479     | Syntax.NoEvent expr' ->
2480         resolve_no_event ctx expr expr'
2481     | Syntax.Range (start, step, stop) ->
2482         resolve_range ctx expr start step stop
2483     | Syntax.Real s -> resolve_real ctx expr s
2484     | Syntax.String s -> resolve_string ctx expr s
2485     | Syntax.True -> resolve_true ctx expr
2486     | Syntax.Tuple exprs -> resolve_tuple ctx expr exprs
2487     | Syntax.UnaryOperation (kind, arg) ->
2488         resolve_unuary_operation ctx expr kind arg
2489     | Syntax.Vector vec_elts -> resolve_vector ctx expr vec_elts
2490
2491 and resolve_binary_operation ctx expr kind arg1 arg2 =
2492   let arg1' = resolve_expression ctx arg1
2493   and arg2' = resolve_expression ctx arg2 in
2494   let args' = apply_binary_coercions [ arg1'; arg2' ] in
2495   let arg1' = List.nth args' 0
2496   and arg2' = List.nth args' 1 in
2497   match kind.Syntax.nature with
2498     | Syntax.Plus -> resolve_addition ctx expr arg1' arg2'
2499     | Syntax.And -> resolve_and ctx expr arg1' arg2'
2500     | Syntax.Divide -> resolve_division ctx expr arg1' arg2'
2501     | Syntax.EqualEqual -> raise (CompilError
2502         {err_msg = ["_NotYetImplemented"; "_BinaryOperEQUEQU"];
2503          err_info = [];
2504          err_ctx = ctx})
2505     | Syntax.GreaterEqual ->
2506         resolve_comparison ctx expr GreaterEqual arg1' arg2'
2507     | Syntax.Greater -> resolve_comparison ctx expr Greater arg1' arg2'
2508     | Syntax.LessEqual -> resolve_comparison ctx expr LessEqual arg1' arg2'
2509     | Syntax.Less -> resolve_comparison ctx expr Less arg1' arg2'
2510     | Syntax.Times -> resolve_multiplication ctx expr arg1' arg2'
2511     | Syntax.NotEqual -> raise (CompilError
2512         {err_msg = ["_NotYetImplemented"; "_BinaryOperDIFF"];
2513          err_info = [];
2514          err_ctx = ctx})
2515     | Syntax.Or -> resolve_or ctx expr arg1' arg2'
2516     | Syntax.Power -> resolve_power ctx expr arg1' arg2'
2517     | Syntax.Minus -> resolve_subtraction ctx expr arg1' arg2'
2518
2519 and resolve_end ctx expr =
2520   let ctx = {ctx with location = expr.Syntax.info} in
2521   match ctx.context_nature with
2522     | SubscriptContext (_, _, _, Types.ConstantDimension n) ->
2523         let nat = Integer n
2524         and elt_nat = Types.integer_type Types.Constant in
2525         resolved_expression (Some expr) nat elt_nat
2526     | SubscriptContext (_, expr', n, Types.ParameterDimension) ->
2527         size_function_call ctx (Some expr) expr' n
2528     | SubscriptContext (_, expr', n, Types.DiscreteDimension) ->
2529         size_function_call ctx (Some expr) expr' n
2530     | ForContext (ctx', _, _) -> resolve_end ctx' expr
2531     | ToplevelContext | ClassContext _ ->
2532         raise (CompilError
2533           {err_msg = ["_InvalidKeyWordEndInExpr"];
2534            err_info = [];
2535            err_ctx = ctx}) (*error*)
2536
2537 and resolve_false ctx expr =
2538   resolved_expression (Some expr) False (Types.boolean_type Types.Constant)
2539
2540 and resolve_field_access ctx expr expr' id =
2541   let expr' = resolve_expression ctx expr' in
2542   let resolve_field_access' expr' id =
2543   let nat = FieldAccess (expr', id)
2544   and flow, var, inout =
2545     type_prefixes_of_element_nature expr'.info.type_description
2546   and cl_spec = element_nature_class ctx expr'.info.type_description in
2547   let elt_nat = element_field_type_nature ctx flow var inout cl_spec id in
2548     resolved_expression (Some expr) nat elt_nat in
2549   let is_package cl_spec = match evaluate cl_spec with
2550     | Types.ClassType cl_type
2551       when evaluate cl_type.Types.kind = Types.Package -> true
2552     | _ -> false in
2553   match expr'.info.type_description with
2554   | Types.ComponentElement _  ->
2555       resolve_field_access' expr' id
2556   | Types.ClassElement cl_spec when is_package cl_spec ->
2557       resolve_field_access' expr' id
2558   | _ ->
2559       raise (CompilError
2560         {err_msg = ["component or package"; "_ElemExpected"];
2561          err_info = [];
2562          err_ctx = { ctx with location = expr.Syntax.info }}) (*error*)
2563
2564 and type_prefixes_of_element_nature = function
2565   | Types.ComponentElement cpnt_type ->
2566       evaluate cpnt_type.Types.flow,
2567       evaluate cpnt_type.Types.variability,
2568       evaluate cpnt_type.Types.causality
2569   | Types.ClassElement _ | Types.ComponentTypeElement _ |
2570     Types.PredefinedTypeElement _ ->
2571       false, Types.Constant, Types.Acausal
2572
2573 and resolve_function_call ctx syn expr fun_args =
2574   let ctx = {ctx with location = expr.Syntax.info} in
2575   let expr' = resolve_expression ctx expr in
2576   let resolve_function_arguments named_elts =
2577     let reversed_additional_dimensions input_types args =
2578       let additional_named_element_dimensions id arg =
2579         let rec subtract_dimensions fun_dims arg_dims =
2580           match fun_dims, arg_dims with
2581             | [], _ ->  arg_dims
2582             | _, [] ->
2583                 raise (CompilError
2584                   {err_msg = ["_ArgDimMismatch"];
2585                    err_info = [];
2586                    err_ctx = ctx}) (*error*)
2587             | Types.ConstantDimension i :: _, Types.ConstantDimension i' :: _
2588               when i <> i' ->
2589                 raise (CompilError
2590                   {err_msg = ["_ArgDimMismatch"];
2591                    err_info = [];
2592                    err_ctx = ctx}) (*error*)
2593             | _ :: fun_dims, _ :: arg_dims ->
2594                 subtract_dimensions fun_dims arg_dims in
2595         let elt_type = List.assoc id input_types in
2596         let elt_type' = evaluate elt_type in
2597         let fun_dims =
2598           Types.reversed_element_dimensions elt_type'.Types.element_nature
2599         and arg_dims =
2600           Types.reversed_element_dimensions arg.info.type_description in
2601         subtract_dimensions fun_dims arg_dims in
2602       let rec reversed_additional_dimensions' ids dims args =
2603         match args with
2604           | [] -> ids, dims
2605           | (id, arg) :: args ->
2606               let dims' = additional_named_element_dimensions id arg in
2607               update_additional_dimensions ids dims id dims' args
2608       and update_additional_dimensions ids dims id dims' args =
2609         match dims, dims' with
2610           | _, [] -> reversed_additional_dimensions' ids dims args
2611           | [], _ :: _ ->
2612               let ids' = id :: ids in
2613               reversed_additional_dimensions' ids' dims' args
2614           | _ :: _, _ :: _ when dims <> dims' ->
2615               raise (CompilError
2616                 {err_msg = ["_ArgDimMismatchInVectCall"];
2617                  err_info = [];
2618                  err_ctx = ctx}) (*error*)
2619           | _ :: _, _ :: _ ->
2620               let ids' = id :: ids in
2621               reversed_additional_dimensions' ids' dims args in
2622       reversed_additional_dimensions' [] [] args in
2623     let function_call ids rev_dims input_types output_types args =
2624       let ndims = List.length rev_dims in
2625       let rec expressions_of_named_arguments pos input_types =
2626         let expression_of_default_argument id elt_type =
2627           let elt_type' = evaluate elt_type in
2628           let func =
2629             let nat = FunctionArgument 0
2630             and elt_nat = expr'.info.type_description in
2631             resolved_expression None nat elt_nat in
2632           let nat = FieldAccess (func, id)
2633           and elt_nat = elt_type'.Types.element_nature in
2634           resolved_expression None nat elt_nat
2635         and expression_of_named_argument pos id elt_type =
2636           let rec loop_variables = function
2637             | 0 -> []
2638             | ndims ->
2639                 let nat = LoopVariable (ndims - 1)
2640                 and elt_nat = (Types.integer_type Types.Constant) in
2641                 let loop_var = resolved_expression None nat elt_nat in
2642                 loop_var :: loop_variables (ndims - 1) in
2643           let elt_type' = evaluate elt_type in
2644           let elt_nat = elt_type'.Types.element_nature in
2645           let nat = match List.mem id ids with
2646             | false -> FunctionArgument pos
2647             | true ->
2648                 let arg = List.assoc id args in
2649                 let nat = FunctionArgument pos
2650                 and elt_nat = arg.info.type_description in
2651                 let expr = resolved_expression None nat elt_nat in
2652                 IndexedAccess (expr, loop_variables ndims) in
2653           resolved_expression None nat elt_nat in
2654         match input_types with
2655           | [] -> []
2656           | (id, elt_type) :: input_types when not (List.mem_assoc id args) ->
2657               let arg = expression_of_default_argument id elt_type in
2658               arg :: expressions_of_named_arguments pos input_types
2659           | (id, elt_type) :: input_types ->
2660               let arg = expression_of_named_argument pos id elt_type in
2661               arg :: expressions_of_named_arguments (pos + 1) input_types in
2662       let ranges arg rev_dims =
2663         let rec ranges' acc n rev_dims =
2664           let range_of_dimension dim =
2665             let range_to stop =
2666               let nat = Range (one, one, stop)
2667               and elt_nat = Types.integer_array_type Types.Constant dim in
2668               resolved_expression None nat elt_nat in
2669             match dim with
2670               | Types.ConstantDimension i ->
2671                   let stop =
2672                     let nat = Integer i
2673                     and elt_nat = (Types.integer_type Types.Constant) in
2674                     resolved_expression None nat elt_nat in
2675                   range_to stop
2676               | Types.ParameterDimension ->
2677                   let stop = size_function_call ctx None arg n in
2678                   range_to stop
2679               | Types.DiscreteDimension ->
2680                   let stop = size_function_call ctx None arg n in
2681                   range_to stop in
2682           match rev_dims with
2683             | [] -> acc
2684             | dim :: rev_dims ->
2685                 let range = range_of_dimension dim in
2686                 ranges' (range :: acc) (Int32.succ n) rev_dims in
2687         ranges' [] 1l rev_dims in
2688       let rec sorted_arguments_of_named_arguments = function
2689         | [] -> []
2690         | (id, _) :: input_types when not (List.mem_assoc id args) ->
2691             sorted_arguments_of_named_arguments input_types
2692         | (id, _) :: input_types ->
2693             let arg = List.assoc id args in
2694             arg :: sorted_arguments_of_named_arguments input_types in
2695       let wrap_function_invocation cpnt_type =
2696         let add_dimensions cpnt_type =
2697           let rec add_dimensions cl_spec = function
2698             | [] -> cl_spec
2699             | dim :: rev_dims ->
2700                 let cl_spec' = Types.ArrayType (dim, cl_spec) in
2701                 add_dimensions cl_spec' rev_dims in
2702           let base_class = cpnt_type.Types.base_class in
2703           { cpnt_type with
2704             Types.base_class =
2705               lazy (add_dimensions (evaluate base_class) rev_dims)
2706           } in
2707         let wrap_function_invocation' cpnt_type rev_dims =
2708           let nat =
2709             let exprs = expressions_of_named_arguments 1 input_types in
2710             FunctionInvocation exprs
2711           and elt_nat = Types.ComponentElement cpnt_type in
2712           match ids with
2713             | [] ->
2714                 resolved_expression syn nat elt_nat
2715             | id :: _ ->
2716                 let cpnt_type' = add_dimensions cpnt_type in
2717                 let nat =
2718                   let ranges =
2719                     let arg = List.assoc id args in
2720                     ranges arg rev_dims
2721                   and expr = resolved_expression None nat elt_nat in
2722                   VectorReduction (ranges, expr)
2723                 and elt_nat = Types.ComponentElement cpnt_type' in
2724                 resolved_expression None nat elt_nat in
2725         wrap_function_invocation' cpnt_type rev_dims in
2726       let component_type_of_output_types output_types =
2727         let component_type_of_output_type cpnt_type (_, elt_type) =
2728           let add_class_specifier cl_spec cl_spec' =
2729             match cl_spec, cl_spec' with
2730             | Types.TupleType [], _ -> cl_spec'
2731             | (Types.TupleType cl_specs), _ ->
2732                 Types.TupleType (cl_spec' :: cl_specs)
2733             | _, _ -> Types.TupleType [cl_spec'; cl_spec] in
2734           let var = evaluate cpnt_type.Types.variability
2735           and cl_spec = evaluate cpnt_type.Types.base_class in
2736           let elt_type' = evaluate elt_type in
2737           match elt_type'.Types.element_nature with
2738             | Types.ComponentElement cpnt_type' ->
2739                 let var' = evaluate cpnt_type'.Types.variability
2740                 and cl_spec' = evaluate cpnt_type'.Types.base_class in
2741                 {
2742                   Types.flow = lazy false;
2743                   Types.variability = lazy (Types.max_variability var var');
2744                   Types.causality = lazy Types.Acausal;
2745                   Types.base_class = lazy (add_class_specifier cl_spec cl_spec')
2746                 }
2747             | Types.ClassElement _ | Types.ComponentTypeElement _ |
2748               Types.PredefinedTypeElement _ ->
2749                 raise (CompilError
2750                   {err_msg = ["_ClassElemFoundInExpr"];
2751                    err_info = [];
2752                    err_ctx = ctx}) (*error*) in
2753         let cpnt_type =
2754           {
2755             Types.flow = lazy false;
2756             Types.variability = lazy Types.Constant;
2757             Types.causality = lazy Types.Acausal;
2758             Types.base_class = lazy (Types.TupleType [])
2759           } in
2760         List.fold_left component_type_of_output_type cpnt_type output_types in
2761       let args' = sorted_arguments_of_named_arguments input_types
2762       and cpnt_type = component_type_of_output_types output_types in
2763       let func_invoc = wrap_function_invocation cpnt_type in
2764       let nat = FunctionCall (expr', args', func_invoc)
2765       and elt_nat = func_invoc.info.type_description in
2766       resolved_expression syn nat elt_nat in
2767     let resolve_function_arguments' fun_args =
2768       match fun_args.Syntax.nature with
2769       | Syntax.Reduction _ ->
2770           raise (CompilError
2771             {err_msg = ["_NotYetImplemented"; "_FuncArgumentReduction"];
2772              err_info = [];
2773              err_ctx = ctx})
2774       | Syntax.ArgumentList args ->
2775           let input_types, output_types, named_args =
2776               resolve_function_argument_list ctx expr' named_elts args in
2777           let ids, rev_dims =
2778             reversed_additional_dimensions input_types named_args in
2779           function_call ids rev_dims input_types output_types named_args in
2780     match fun_args with
2781       | None ->
2782           let fun_args = { Syntax.nature = Syntax.ArgumentList [];
2783                            Syntax.info = ctx.location } in
2784           resolve_function_arguments' fun_args
2785       | Some fun_args -> resolve_function_arguments' fun_args in
2786   let resolve_class_function_call cl_type =
2787     match evaluate cl_type.Types.kind with
2788     | Types.Function ->
2789         resolve_function_arguments cl_type.Types.named_elements
2790     | Types.Class | Types.Model | Types.Block | Types.Record |
2791       Types.ExpandableConnector | Types.Connector | Types.Package ->
2792         raise (CompilError
2793           {err_msg = ["function"; "_ElemExpected"];
2794            err_info = [];
2795            err_ctx = ctx}) (*error*) in
2796   let resolve_function_call' cl_spec =
2797     match evaluate cl_spec with
2798     | Types.ClassType cl_type ->
2799         resolve_class_function_call cl_type
2800     | _ ->
2801         raise (CompilError
2802           {err_msg = ["function"; "_ElemExpected"];
2803            err_info = [];
2804            err_ctx = ctx}) (*error*) in
2805   match expr'.info.type_description with
2806   | Types.ClassElement cl_spec -> resolve_function_call' cl_spec
2807   | Types.ComponentElement cpnt_type ->
2808       let cl_spec = cpnt_type.Types.base_class in
2809       resolve_function_call' cl_spec
2810   | Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->
2811       raise (CompilError
2812         {err_msg = ["function"; "_ElemExpected"];
2813          err_info = [];
2814          err_ctx = ctx}) (*error*)
2815
2816 and resolve_function_argument_list ctx expr' named_elts args =
2817   let rec class_kind ctx =
2818     let class_context' cl_spec = match cl_spec with
2819       | Types.ClassType cl_type ->
2820           Some (evaluate cl_type.Types.kind)
2821       | _ -> None in
2822     match ctx.context_nature with
2823     | ClassContext cl_def ->
2824         class_context' (evaluate cl_def.class_type)
2825     | SubscriptContext (ctx, _, _, _) | ForContext (ctx, _, _) ->
2826         class_kind ctx
2827     | _ -> None in
2828   let add_function_inout_argument ((id, elt_type) as named_elt) inouts =
2829     let add_function_inout_argument' cpnt_type =
2830       match inouts, evaluate cpnt_type.Types.causality with
2831       | (ins, outs), Types.Input -> named_elt :: ins, outs
2832       | (ins, outs), Types.Output -> ins, named_elt :: outs
2833       | _, Types.Acausal -> inouts in
2834     let elt_type' = evaluate elt_type in
2835     match elt_type'.Types.element_nature with
2836       | Types.ComponentElement cpnt_type when not elt_type'.Types.protected ->
2837           add_function_inout_argument' cpnt_type
2838       | _ -> inouts in
2839   let add_argument id arg arg' elt_type acc =
2840     let matchable_types cpnt_type cpnt_type' =
2841       let cl_spec = evaluate cpnt_type.Types.base_class
2842       and cl_spec' = evaluate cpnt_type'.Types.base_class in
2843       let rec matchable_types' cl_spec cl_spec' = match cl_spec, cl_spec' with
2844         | Types.ArrayType (dim, cl_spec), _ ->
2845             matchable_types' cl_spec cl_spec'
2846         | _, Types.ArrayType (dim', cl_spec') ->
2847             matchable_types' cl_spec cl_spec'
2848         | _, _ ->
2849             let type_compare = Types.compare_specifiers cl_spec cl_spec' in
2850             (type_compare = Types.SameType) ||
2851             (type_compare = Types.Supertype) in
2852       matchable_types' cl_spec cl_spec' in
2853     let matchable_variabilities cpnt_type cpnt_type' =
2854       let var = evaluate cpnt_type.Types.variability
2855       and var' = evaluate cpnt_type'.Types.variability in
2856       Types.higher_variability var var' in
2857     let elt_type = evaluate elt_type in
2858     let cpnt_type = match elt_type.Types.element_nature with
2859       | Types.ComponentElement cpnt_type -> cpnt_type
2860       | _ -> assert false in
2861     let arg' = apply_rhs_coercions cpnt_type arg' in
2862     match arg'.info.type_description with
2863     | Types.ComponentElement cpnt_type'
2864         when not (matchable_types cpnt_type cpnt_type') ->
2865         raise (CompilError
2866           {err_msg = ["_ArgTypeMismatch"];
2867            err_info =
2868              [("_ExpectedType", Types.string_of_component_type cpnt_type);
2869               ("_TypeFound", Types.string_of_component_type cpnt_type')];
2870            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
2871     | Types.ComponentElement cpnt_type'
2872         when not (matchable_variabilities cpnt_type cpnt_type') ->
2873         let var = evaluate cpnt_type.Types.variability
2874         and var' = evaluate cpnt_type'.Types.variability in
2875         let var = Types.string_of_variability var
2876         and var' = Types.string_of_variability var' in
2877         raise (CompilError
2878           {err_msg = ["_ArgVariabilityMismatch"];
2879            err_info = [("_ExpectedVariability", var);
2880                        ("_VariabilityFound", var')];
2881            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
2882     | Types.ComponentElement cpnt_type' -> (id, arg') :: acc
2883     | _ -> raise (CompilError
2884         {err_msg = ["_ClassElemFoundInExpr"];
2885          err_info = [];
2886          err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in
2887   let named_arguments_of_arguments input_types args =
2888     let rec add_positional_arguments acc input_types args =
2889       match input_types, args with
2890       | [], [] -> acc
2891       | [], _ ->
2892           raise (CompilError
2893             {err_msg = ["_TooManyArgsInFuncCall"];
2894              err_info = [];
2895              err_ctx = ctx}) (*error*)
2896       | _, [] ->
2897           raise (CompilError
2898             {err_msg = ["_TooFewArgsInFuncCall"];
2899              err_info = [];
2900              err_ctx = ctx}) (*error*)
2901       | (id, elt_type) :: input_types,
2902         { Syntax.nature = Syntax.Argument arg } :: args ->
2903           let arg' = resolve_expression ctx arg in
2904           let acc = add_argument id arg arg' elt_type acc in
2905           add_positional_arguments acc input_types args
2906       | _, { Syntax.nature = Syntax.NamedArgument _ } :: _ ->
2907           add_named_arguments acc input_types args
2908     and add_named_arguments acc input_types args =
2909       match input_types, args with
2910       | [], [] -> acc
2911       | [], _ ->
2912           raise (CompilError
2913             {err_msg = ["_TooManyArgsInFuncCall"];
2914              err_info = [];
2915              err_ctx = ctx}) (*error*)
2916       | _, [] ->
2917           raise (CompilError
2918             {err_msg = ["_TooFewArgsInFuncCall"];
2919              err_info = [];
2920              err_ctx = ctx}) (*error*)
2921       | _, { Syntax.nature = Syntax.Argument _ } :: _ ->
2922           raise (CompilError
2923             {err_msg = ["_MixedPositAndNamedFuncArgPass"];
2924              err_info = [];
2925              err_ctx = ctx}) (*error*)
2926       | _, { Syntax.nature = Syntax.NamedArgument (id, _) } :: _
2927           when List.mem_assoc id acc ->
2928             raise (CompilError
2929               {err_msg = ["_FuncCallWithDuplicateArg"; id];
2930                err_info = [];
2931                err_ctx = ctx}) (*error*)
2932       | _, { Syntax.nature = Syntax.NamedArgument (id, _) } :: _
2933           when not (List.mem_assoc id input_types) ->
2934             raise (CompilError
2935               {err_msg = ["_NonInputFuncArgElem"; id];
2936                err_info = [];
2937                err_ctx = ctx}) (*error*)
2938       | _, { Syntax.nature = Syntax.NamedArgument (id, arg) } :: args ->
2939           let arg' = resolve_expression ctx arg
2940           and elt_type = List.assoc id input_types in
2941           let acc = add_argument id arg arg' elt_type acc in
2942           add_named_arguments acc input_types args in
2943     add_positional_arguments [] input_types args in
2944   let resolve_built_in_function_argument arg = match arg with
2945     | { Syntax.nature = Syntax.Argument arg } ->
2946         arg, (resolve_expression ctx arg)
2947     | { Syntax.nature = Syntax.NamedArgument _; Syntax.info = info } ->
2948         raise (CompilError
2949           {err_msg = ["_CannotUseNamedArgWithBuiltInOper"];
2950            err_info = [];
2951            err_ctx = {ctx with location = info}}) (*error*) in
2952   let rec built_in_function_named_arguments acc input_types args' =
2953     match input_types, args' with
2954     | [], [] -> acc
2955     | [], _ ->
2956         raise (CompilError
2957           {err_msg = ["_TooManyArgsInFuncCall"];
2958            err_info = [];
2959            err_ctx = ctx}) (*error*)
2960     | _, [] ->
2961         raise (CompilError
2962           {err_msg = ["_TooFewArgsInFuncCall"];
2963            err_info = [];
2964            err_ctx = ctx}) (*error*)
2965     | (id, elt_type) :: input_types, (arg, arg') :: args' ->
2966         let acc = add_argument id arg arg' elt_type acc in
2967         built_in_function_named_arguments acc input_types args' in
2968   let built_in_function_inout_types ctx id (in_types, out_types) args' =
2969     let argument_component_type (arg, arg') =
2970       match arg'.info.type_description with
2971       | Types.ComponentElement cpnt_type ->
2972           cpnt_type
2973       | _ -> raise (CompilError
2974           {err_msg = ["_ClassElemFoundInExpr"];
2975            err_info = [];
2976            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*) in
2977     let scalar_base_class_specifier (arg, arg') =
2978       let rec scalar_base_class_specifier' cl_spec = match cl_spec with
2979         | Types.ArrayType (dim, cl_spec) -> scalar_base_class_specifier' cl_spec
2980         | _ -> cl_spec in
2981       let cpnt_type = argument_component_type (arg, arg') in
2982       let cl_spec = evaluate cpnt_type.Types.base_class in
2983       scalar_base_class_specifier' cl_spec in
2984     let argument_base_type bt (arg, arg') =
2985       let cl_spec = scalar_base_class_specifier (arg, arg') in
2986       match cl_spec with
2987       | Types.PredefinedType predef when predef.Types.base_type = bt -> true
2988       | _ -> false in
2989     let argument_base_types bt args =
2990       List.for_all (argument_base_type bt) args in
2991     let argument_variability var (arg, arg') =
2992       let cpnt_type = argument_component_type (arg, arg') in
2993       let var' = evaluate cpnt_type.Types.variability in
2994       var = var' in
2995     let neg f = function x -> not (f x) in
2996     let ndims arg' =
2997       let cpnt_type = component_type_of_expression ctx arg' in
2998       let rec ndims' cl_spec =
2999         match cl_spec with
3000         | Types.ArrayType (dim, cl_spec) -> ndims' cl_spec + 1
3001         | _ -> 0 in
3002       ndims' (evaluate cpnt_type.Types.base_class) in
3003     let numeric_base_type arg' =
3004       let cl_spec = scalar_class_specifier ctx arg' in
3005       (Types.compare_specifiers Types.integer_class_type cl_spec =
3006          Types.SameType) ||
3007       (Types.compare_specifiers Types.real_class_type cl_spec =
3008          Types.SameType) in
3009     let rec argument_types i args = match args with
3010       | [] -> []
3011       | (arg, arg') :: args ->
3012           let cpnt_type = component_type_of_expression ctx arg'
3013           and name = Printf.sprintf "@%d" i in
3014           (name, cpnt_type) :: (argument_types (i + 1) args) in
3015     let element_types input_types output_types =
3016       let element_type inout (id, cpnt_type) =
3017         (id,
3018          lazy
3019            {
3020              Types.protected = false;
3021              Types.final = true;
3022              Types.replaceable = false;
3023              Types.dynamic_scope = None;
3024              Types.element_nature =
3025                Types.ComponentElement
3026                  { cpnt_type with Types.causality = lazy inout }
3027            }) in
3028      (List.map (element_type Types.Input) input_types),
3029      (List.map (element_type Types.Output) output_types) in
3030     match id, args' with
3031     | ("der" | "initial" | "terminal" | "sample" | "pre" | "edge" | "change" |
3032        "reinit" | "delay"), _ when (class_kind ctx) = Some Types.Function ->
3033         raise (CompilError
3034           {err_msg = [id; "_OperCannotBeUsedWithinFuncDef"];
3035            err_info = [];
3036            err_ctx = ctx}) (*error*)
3037     | ("pre" | "edge" | "change"), [arg, arg'] | "reinit", [(arg, arg'); _]
3038         when not (expression_of_variable arg) ->
3039         raise (CompilError
3040           {err_msg = [id; "_OperArgMustBeAVar"];
3041            err_info = [];
3042            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3043     | ("ceil" | "floor" | "integer" | "der"), [arg, arg'] |
3044       "reinit", [(arg, arg'); _] |
3045       "smooth", [_; (arg, arg')]
3046         when not (argument_base_type Types.RealType (arg, arg')) ->
3047         let cl_spec = scalar_base_class_specifier (arg, arg') in
3048         raise (CompilError
3049           {err_msg = ["_ArgTypeMismatch"];
3050            err_info =
3051              [("_ExpectedType", "Real");
3052               ("_TypeFound", Types.string_of_class_specifier cl_spec)];
3053            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3054     | "delay", _
3055         when not (List.for_all (argument_base_type Types.RealType) args') ->
3056         let (arg, arg') =
3057           List.find (neg (argument_base_type Types.RealType)) args' in
3058         let cl_spec = scalar_base_class_specifier (arg, arg') in
3059         raise (CompilError
3060           {err_msg = ["_ArgTypeMismatch"];
3061            err_info =
3062              [("_ExpectedType", "Real");
3063               ("_TypeFound", Types.string_of_class_specifier cl_spec)];
3064            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3065     | "der", [arg, arg']
3066         when not (argument_variability Types.Continuous (arg, arg')) ->
3067         let cpnt_type = argument_component_type (arg, arg') in
3068         let var = evaluate cpnt_type.Types.variability in
3069         let var = Types.string_of_variability var in
3070         raise (CompilError
3071           {err_msg = ["_ArgVariabilityMismatch"];
3072            err_info = [("_ExpectedVariability", "Continuous");
3073                        ("_VariabilityFound", var)];
3074            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3075     | "delay", _ when List.length args' = 3 ->
3076         let input_types =
3077           [("@1", Types.real_component_type Types.Continuous);
3078            ("@2", Types.real_component_type Types.Continuous);
3079            ("@3", Types.real_component_type Types.Parameter)]
3080         and output_types =
3081           ["@4", Types.real_component_type Types.Continuous] in
3082         element_types input_types output_types
3083     | "abs", [arg, arg']
3084         when argument_base_type Types.IntegerType (arg, arg') ->
3085         let input_types = ["@1", Types.integer_component_type Types.Discrete]
3086         and output_types =
3087           ["@2", Types.integer_component_type Types.Discrete] in
3088         element_types input_types output_types
3089     | ("ones" | "zeros"), _
3090       when not (argument_base_types Types.IntegerType args') ->
3091         let (arg, arg') =
3092           List.find (neg (argument_base_type Types.IntegerType)) args' in
3093         raise (CompilError
3094           {err_msg = ["_ArgTypeMismatch"];
3095            err_info = [];
3096            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3097     | "fill", _ :: args'
3098       when not (argument_base_types Types.IntegerType args') ->
3099         let (arg, arg') =
3100           List.find (neg (argument_base_type Types.IntegerType)) args' in
3101         raise (CompilError
3102           {err_msg = ["_ArgTypeMismatch"];
3103            err_info = [];
3104            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3105     | ("sum" | "product" | "max" | "min" | "scalar"), [arg, arg']
3106       when ndims arg' = 0 ->
3107         raise (CompilError
3108           {err_msg = ["_ArgTypeMismatch"];
3109            err_info = [];
3110            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3111     | "diagonal", [arg, arg']
3112       when ndims arg' <> 1 ->
3113         raise (CompilError
3114           {err_msg = ["_ArgTypeMismatch"];
3115            err_info = [];
3116            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3117     | ("scalar"), [arg, arg'] ->
3118         let cpnt_type = component_type_of_expression ctx arg' in
3119         let input_types = ["@1", cpnt_type]
3120         and output_types =
3121           ["@2", Types.scalar_component_type cpnt_type ] in
3122         element_types input_types output_types
3123     | ("sum" | "product" | "max" | "min" | "diagonal"), [arg, arg']
3124       when not (numeric_base_type arg') ->
3125         raise (CompilError
3126           {err_msg = ["_ArgTypeMismatch"];
3127            err_info = [];
3128            err_ctx = {ctx with location = arg.Syntax.info}}) (*error*)
3129     | ("sum" | "product" | "max" | "min"), [arg, arg'] ->
3130         let cpnt_type = component_type_of_expression ctx arg' in
3131         let input_types = ["@1", cpnt_type]
3132         and output_types =
3133           ["@2", Types.scalar_component_type cpnt_type ] in
3134         element_types input_types output_types
3135     | ("ones" | "zeros"), _ :: _ ->
3136         let input_types = argument_types 1 args'
3137         and output_types =
3138           let n = List.length args'
3139           and dims =
3140             List.map (function _ -> Types.ParameterDimension) args' in
3141           let cpnt_type =
3142             { 
3143               Types.flow = lazy false;
3144               variability = lazy Types.Parameter;
3145               Types.causality = lazy Types.Acausal;
3146               base_class =
3147                 lazy(Types.add_dimensions dims Types.integer_class_type)
3148             } in
3149           [ Printf.sprintf "@%d" (n + 1), cpnt_type ] in
3150         element_types input_types output_types
3151     | "fill", (arg, arg') :: (_ :: _ as args) ->
3152         let input_types = argument_types 1 args'
3153         and output_types =
3154           let n = List.length args
3155           and dims =
3156             List.map (function _ -> Types.ParameterDimension) args in
3157           let cpnt_type = component_type_of_expression ctx arg' in
3158           let lcl_spec = lazy
3159             (Types.add_dimensions
3160               dims 
3161               (evaluate cpnt_type.Types.base_class)) in
3162           [ 
3163             Printf.sprintf "@%d" (n + 1),
3164             { cpnt_type with Types.base_class = lcl_spec }
3165           ] in
3166         element_types input_types output_types
3167     | "diagonal", [ arg, arg' ] ->
3168         let cpnt_type = component_type_of_expression ctx arg' in
3169         let input_types = [ "@1", cpnt_type ]
3170         and output_types =
3171           let dims = [ Types.ParameterDimension ] in
3172           let lcl_spec = lazy
3173             (Types.add_dimensions
3174               dims
3175               (evaluate cpnt_type.Types.base_class)) in
3176           [ "@2", { cpnt_type with Types.base_class = lcl_spec } ] in
3177         element_types input_types output_types
3178     | ("div" | "mod" | "rem" | "max" | "min"), _
3179         when List.for_all (argument_base_type Types.IntegerType) args' ->
3180         let input_types =
3181           [
3182             "@1", Types.integer_component_type Types.Discrete;
3183             "@2", Types.integer_component_type Types.Discrete
3184           ]
3185         and output_types =
3186           ["@3", Types.integer_component_type Types.Discrete] in
3187         element_types input_types output_types
3188     | ("pre" | "change"), [arg, arg'] ->
3189         let cpnt_type = argument_component_type (arg, arg') in
3190         let input_types =
3191           ["@1", { cpnt_type with Types.variability = lazy Types.Continuous }]
3192         and output_types =
3193           ["@2", { cpnt_type with Types.variability = lazy Types.Discrete }] in
3194         element_types input_types output_types
3195     | _, _ -> in_types, out_types in
3196   match expr'.nature with
3197   | PredefinedIdentifier id ->
3198       let args' = List.map resolve_built_in_function_argument args in
3199       let input_types, output_types =
3200         let inout_types =
3201           List.fold_right add_function_inout_argument named_elts ([], []) in
3202         built_in_function_inout_types ctx id inout_types args' in
3203       let named_args =
3204         built_in_function_named_arguments [] input_types args' in
3205       input_types, output_types, named_args
3206   | _ ->
3207       let input_types, output_types =
3208         List.fold_right add_function_inout_argument named_elts ([], []) in
3209       let named_args = named_arguments_of_arguments input_types args in
3210       input_types, output_types, named_args
3211
3212 and resolve_identifier ctx expr id =
3213   let rec resolve_predefined_identifier ctx expr id = match id with
3214     | "Boolean" ->
3215         let nat = PredefinedIdentifier "Boolean"
3216         and elt_nat = Types.ClassElement (lazy (Types.boolean_class_type)) in
3217         resolved_expression (Some expr) nat elt_nat
3218     | "Integer" ->
3219         let nat = PredefinedIdentifier "Integer"
3220         and elt_nat = Types.ClassElement (lazy (Types.integer_class_type)) in
3221         resolved_expression (Some expr) nat elt_nat
3222     | "Real" ->
3223         let nat = PredefinedIdentifier "Real"
3224         and elt_nat = Types.ClassElement (lazy (Types.real_class_type)) in
3225         resolved_expression (Some expr) nat elt_nat
3226     | "String" ->
3227         let nat = PredefinedIdentifier "String"
3228         and elt_nat = Types.ClassElement (lazy (Types.string_class_type)) in
3229         resolved_expression (Some expr) nat elt_nat
3230     | "reinit" ->
3231         let nat = PredefinedIdentifier "reinit"
3232         and elt_nat =
3233           let inputs =
3234             ["@1", Types.real_component_type Types.Continuous;
3235              "@2", Types.real_component_type Types.Continuous]
3236           and outputs = [] in
3237           Types.function_type inputs outputs in
3238         resolved_expression (Some expr) nat elt_nat
3239     | "time" ->
3240         let nat = PredefinedIdentifier "time"
3241         and elt_nat = Types.real_type Types.Continuous in
3242         resolved_expression (Some expr) nat elt_nat
3243     | "pre" | "change" ->
3244         let nat = PredefinedIdentifier "pre"
3245         and elt_nat =
3246           let inputs = ["@1", Types.real_component_type Types.Continuous]
3247           and outputs = ["@2", Types.real_component_type Types.Discrete] in
3248           Types.function_type inputs outputs in
3249         resolved_expression (Some expr) nat elt_nat
3250     | "edge" ->
3251         let nat = PredefinedIdentifier "edge"
3252         and elt_nat =
3253           let inputs = ["@1", Types.boolean_component_type Types.Discrete]
3254           and outputs = ["@2", Types.boolean_component_type Types.Discrete] in
3255           Types.function_type inputs outputs in
3256         resolved_expression (Some expr) nat elt_nat
3257     | "initial" ->
3258         let nat = PredefinedIdentifier "initial"
3259         and elt_nat =
3260           let inputs = []
3261           and outputs = [] in
3262           Types.function_type inputs outputs in
3263         resolved_expression (Some expr) nat elt_nat
3264     | "terminal" ->
3265         let nat = PredefinedIdentifier "terminal"
3266         and elt_nat =
3267           let inputs = []
3268           and outputs = [] in
3269           Types.function_type inputs outputs in
3270         resolved_expression (Some expr) nat elt_nat
3271     | "sample" ->
3272         let nat = PredefinedIdentifier "sample"
3273         and elt_nat =
3274           let inputs = [("@1", Types.real_component_type Types.Parameter);
3275                         ("@2", Types.real_component_type Types.Parameter)]
3276           and outputs = ["@3", Types.boolean_component_type Types.Parameter] in
3277           Types.function_type inputs outputs in
3278         resolved_expression (Some expr) nat elt_nat
3279     | "delay" ->
3280         let nat = PredefinedIdentifier "delay"
3281         and elt_nat =
3282           let inputs = [("@1", Types.real_component_type Types.Continuous);
3283                         ("@2", Types.real_component_type Types.Parameter)]
3284           and outputs = ["@3", Types.real_component_type Types.Continuous] in
3285           Types.function_type inputs outputs in
3286         resolved_expression (Some expr) nat elt_nat
3287     | "assert" ->
3288         let nat = PredefinedIdentifier "assert"
3289         and elt_nat =
3290           let inputs = [("@1", Types.boolean_component_type Types.Discrete);
3291                         ("@2", Types.string_component_type Types.Discrete)]
3292           and outputs = [] in
3293           Types.function_type inputs outputs in
3294         resolved_expression (Some expr) nat elt_nat
3295     | "terminate" ->
3296         let nat = PredefinedIdentifier "terminate"
3297         and elt_nat =
3298           let inputs = [("@1", Types.string_component_type Types.Discrete)]
3299           and outputs = [] in
3300           Types.function_type inputs outputs in
3301         resolved_expression (Some expr) nat elt_nat
3302     | "abs" | "cos" | "sin" | "tan" | "exp" | "log" | "sqrt" |
3303       "asin" | "acos" | "atan" | "sinh" | "cosh" | "tanh" | "asinh" |
3304       "acosh" | "atanh" | "log10" | "ceil" | "floor" | "der" ->
3305         let nat = PredefinedIdentifier id
3306         and elt_nat =
3307           let inputs = ["@1", Types.real_component_type Types.Continuous]
3308           and outputs = ["@2", Types.real_component_type Types.Continuous] in
3309           Types.function_type inputs outputs in
3310         resolved_expression (Some expr) nat elt_nat
3311     | "sign" | "integer" | "ones" | "zeros" ->
3312         let nat = PredefinedIdentifier id
3313         and elt_nat =
3314           let inputs = ["@1", Types.real_component_type Types.Continuous]
3315           and outputs = ["@2", Types.integer_component_type Types.Discrete] in
3316           Types.function_type inputs outputs in
3317         resolved_expression (Some expr) nat elt_nat
3318     | "max" | "min" | "div" | "mod" | "rem" | "fill" ->
3319         let nat = PredefinedIdentifier id
3320         and elt_nat =
3321           let inputs =
3322             [
3323               "@1", Types.real_component_type Types.Continuous;
3324               "@2", Types.real_component_type Types.Continuous
3325             ]
3326           and outputs = ["@3", Types.real_component_type Types.Continuous] in
3327           Types.function_type inputs outputs in
3328         resolved_expression (Some expr) nat elt_nat
3329     | "smooth" ->
3330         let nat = PredefinedIdentifier id
3331         and elt_nat =
3332           let inputs =
3333             [
3334               "@1", Types.integer_component_type Types.Discrete;
3335               "@2", Types.real_component_type Types.Continuous
3336             ]
3337           and outputs = ["@3", Types.real_component_type Types.Continuous] in
3338           Types.function_type inputs outputs in
3339         resolved_expression (Some expr) nat elt_nat
3340     | "identity" ->
3341         let nat = PredefinedIdentifier id
3342         and elt_nat =
3343           let inputs = [ "@1", Types.integer_component_type Types.Parameter ]
3344           and outputs =
3345             let dims =
3346               [Types.ParameterDimension; Types.ParameterDimension] in
3347             [ 
3348               "@2",
3349               Types.integer_array_component_type Types.Parameter dims
3350             ] in
3351           Types.function_type inputs outputs in
3352         resolved_expression (Some expr) nat elt_nat
3353     | "diagonal" ->
3354         let nat = PredefinedIdentifier id
3355         and elt_nat =
3356           let inputs =
3357             let dim = [ Types.ParameterDimension ] in
3358             [ "@1", Types.integer_array_component_type Types.Parameter dim ]
3359           and outputs =
3360             let dims =
3361               [Types.ParameterDimension; Types.ParameterDimension] in
3362             [ 
3363               "@2",
3364               Types.integer_array_component_type Types.Parameter dims
3365             ] in
3366           Types.function_type inputs outputs in
3367         resolved_expression (Some expr) nat elt_nat
3368     | "sum" | "product" | "scalar" ->
3369         let nat = PredefinedIdentifier id
3370         and elt_nat =
3371           let inputs =
3372             let dim = [ Types.DiscreteDimension ] in
3373               [ "@1", Types.integer_array_component_type Types.Discrete dim ]
3374           and outputs = ["@2", Types.integer_component_type Types.Discrete] in
3375           Types.function_type inputs outputs in
3376         resolved_expression (Some expr) nat elt_nat
3377     | _ -> raise (CompilError
3378         {err_msg = ["_UnknownIdentifier"; id];
3379          err_info = [];
3380          err_ctx = ctx})
3381   and search_in_toplevel dic =
3382     try
3383       let elt_desc = List.assoc id (evaluate dic) in
3384       let elt_type = evaluate elt_desc.element_type in
3385       match elt_type.Types.dynamic_scope with
3386         | None | Some Types.Inner ->
3387             let nat = ToplevelIdentifier id in
3388             resolved_expression (Some expr) nat elt_type.Types.element_nature
3389         | Some Types.Outer | Some Types.InnerOuter ->
3390             raise (CompilError
3391               {err_msg = ["_NoInnerDeclForOuterElem"; id];
3392                err_info = [];
3393                err_ctx = ctx}) (*error*)
3394     with Not_found -> resolve_predefined_identifier ctx expr id
3395   and search_in_class level cl_def = match evaluate cl_def.class_type with
3396     | Types.ClassType cl_type -> search_in_class_type level cl_def cl_type
3397     | Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |
3398       Types.TupleType _ ->
3399         raise (CompilError
3400           {err_msg = ["_NoInnerDeclForOuterElem"; id];
3401            err_info = [];
3402            err_ctx = ctx}) (*error*)
3403   and search_in_class_type level cl_def cl_type =
3404     try
3405       let elt_type = evaluate (List.assoc id cl_type.Types.named_elements) in
3406       match elt_type.Types.dynamic_scope with
3407           | None | Some Types.Inner ->
3408               let nat = LocalIdentifier (level, id) in
3409               resolved_expression (Some expr) nat elt_type.Types.element_nature
3410           | Some Types.Outer | Some Types.InnerOuter ->
3411               let nat = DynamicIdentifier (level, id) in
3412               resolved_expression (Some expr) nat elt_type.Types.element_nature
3413     with Not_found -> search_in_parent level cl_def
3414   and search_in_parent level cl_def = match cl_def.enclosing_class with
3415     | _ when cl_def.encapsulated -> search_in_toplevel ctx.toplevel
3416     | Some cl_def -> search_in_class (level + 1) cl_def
3417     | None -> search_in_toplevel ctx.toplevel
3418   and search_in_for_loop_variables level ctx = match ctx.context_nature with
3419     | ToplevelContext -> search_in_toplevel ctx.toplevel
3420     | ClassContext cl_def -> search_in_class 0 cl_def
3421     | SubscriptContext (ctx', _, _, _) ->
3422         search_in_for_loop_variables level ctx'
3423     | ForContext (_, id', elt_nat) when id' = id ->
3424         let nat = LoopVariable level in
3425         resolved_expression (Some expr) nat elt_nat
3426     | ForContext (ctx', _, _) ->
3427         search_in_for_loop_variables (level + 1) ctx' in
3428   search_in_for_loop_variables 0 ctx
3429
3430 (*and resolve_if ctx expr alts expr' =
3431   let expres' = resolve_expression ctx expr' in
3432   let elt_nat' = expres'.info.type_description in
3433   let rec resolve_alternative (cond, expr) =
3434     resolve_condition cond,
3435     resolve_alternative_expression expr
3436   and resolve_condition cond =
3437     let ctx = {ctx with location = cond.Syntax.info} in
3438     let cond' = resolve_expression ctx cond in
3439     let condition cpnt_type =
3440       let cl_spec = evaluate cpnt_type.Types.base_class in
3441       match cl_spec with
3442         | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cond'
3443         | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3444           Types.ArrayType _ | Types.TupleType _ -> 
3445             raise (CompilError
3446               {err_msg = ["_NonBooleanIfCondExpr"];
3447                err_info =
3448                  [("_ExprKind", "...if A then...");
3449                   ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
3450                err_ctx = ctx}) (*error*) in
3451     match cond'.info.type_description with
3452       | Types.ComponentElement cpnt_type -> condition cpnt_type
3453       | _ -> raise (CompilError
3454           {err_msg = ["_ClassElemFoundInExpr"];
3455            err_info = [];
3456            err_ctx = {ctx with location = cond.Syntax.info}}) (*error*)
3457   and resolve_alternative_expression expr =
3458     let ctx = {ctx with location = expr.Syntax.info} in
3459     let expres = resolve_expression ctx expr in
3460     let elt_nat = expres.info.type_description in
3461     let display_error elt_nat elt_nat' = match elt_nat, elt_nat' with
3462       | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
3463           raise (CompilError
3464             {err_msg = ["_TypeConflictsInIfAlternExprs"];
3465              err_info =
3466                [("_TypeOfThenBranche",
3467                  Types.string_of_component_type cpnt_type);
3468                 ("_TypeOfElseBranche",
3469                  Types.string_of_component_type cpnt_type')];
3470              err_ctx = ctx}) (*error*)
3471       | Types.ComponentElement cpnt_type, _ ->
3472           raise (CompilError
3473             {err_msg = ["_ClassElemFoundInExpr"];
3474              err_info =
3475                [("_TypeOfThenBranche",
3476                  Types.string_of_component_type cpnt_type);
3477                 ("_TypeOfElseBranche", "_ClassElement")];
3478              err_ctx = ctx}) (*error*)
3479       | _, Types.ComponentElement cpnt_type' ->
3480           raise (CompilError
3481             {err_msg = ["_ClassElemFoundInExpr"];
3482              err_info =
3483                [("_TypeOfThenBranche", "_ClassElement");
3484                 ("_TypeOfElseBranche",
3485                  Types.string_of_component_type cpnt_type')];
3486              err_ctx = ctx}) (*error*)
3487       | _, _ ->
3488           raise (CompilError
3489             {err_msg = ["_ClassElemFoundInExpr"];
3490              err_info =
3491                [("_TypeOfThenBranche", "_ClassElement");
3492                 ("_TypeOfElseBranche", "_ClassElement")];
3493              err_ctx = ctx}) (*error*) in
3494     match Types.compare_element_natures elt_nat elt_nat' with
3495     | Types.NotRelated -> display_error elt_nat elt_nat'
3496     | _ -> expres in
3497   let alts = List.map resolve_alternative alts in
3498   let nat = If (alts, expres') in
3499   resolved_expression (Some expr) nat elt_nat'*)
3500
3501 and resolve_if ctx expr alts expr' =
3502   let resolve_data_expression ctx expr =
3503     let expr' = resolve_expression ctx expr in
3504     match expr'.info.type_description with
3505     | Types.ComponentElement cpnt_type -> expr'
3506     | _ ->
3507         raise (CompilError
3508           {err_msg = ["_ClassElemFoundInExpr"];
3509            err_info = [];
3510            err_ctx = {ctx with location = expr.Syntax.info}}) (*error*) in
3511   let resolve_condition cond =
3512     let ctx = {ctx with location = cond.Syntax.info} in
3513     let cond' = resolve_data_expression ctx cond in
3514     let condition cpnt_type =
3515       match evaluate cpnt_type.Types.base_class with
3516       | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cond'
3517       | cl_spec -> 
3518           raise (CompilError
3519             {err_msg = ["_NonBooleanIfCondExpr"];
3520              err_info =
3521                [("_ExprKind", "...if A then...");
3522                 ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
3523              err_ctx = ctx}) (*error*) in
3524     match cond'.info.type_description with
3525     | Types.ComponentElement cpnt_type -> condition cpnt_type
3526     | _ ->
3527         raise (CompilError
3528           {err_msg = ["_DataElemExpected"];
3529            err_info = [];
3530            err_ctx = ctx}) (*error*) in
3531   let resolve_alternatives (alts, expr') (cond, expr) =
3532     let ctx = {ctx with location = expr.Syntax.info} in
3533     let cond' = resolve_condition cond
3534     and expr = resolve_data_expression ctx expr in
3535     let exprs = apply_binary_coercions [ expr'; expr] in
3536     let expr' = List.nth exprs 0
3537     and expr = List.nth exprs 1 in
3538     let elt_nat = expr.info.type_description
3539     and elt_nat' = expr'.info.type_description in
3540     match Types.compare_element_natures elt_nat elt_nat' with
3541     | Types.SameType ->
3542         (alts @ [cond', expr]), expr'
3543     | _ ->
3544         raise (CompilError
3545           {err_msg = ["_TypeConflictsInIfAlternExprs"];
3546            err_info =
3547              [("_TypeOfThenBranche",
3548                Types.string_of_element_nature elt_nat);
3549               ("_TypeOfElseBranche",
3550                Types.string_of_element_nature elt_nat')];
3551            err_ctx = ctx}) (*error*) in
3552   let expr' = resolve_data_expression ctx expr' in
3553   let alts, expr' = List.fold_left resolve_alternatives ([], expr') alts in
3554   let nat = If (alts, expr') in
3555   resolved_expression (Some expr) nat expr'.info.type_description
3556
3557 and resolve_indexed_access ctx expr expr' subs =
3558   let expres' = resolve_expression ctx expr' in
3559   let rec resolve_component_indexed_access cl_spec subs =
3560     match cl_spec, subs with
3561       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3562          Types.ArrayType _ | Types.TupleType _), [] -> cl_spec
3563       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3564          Types.TupleType _), _ :: _ ->
3565           raise (CompilError
3566             {err_msg = ["_CannotSubscriptANonArrayTypeElem"];
3567              err_info =
3568                [("_ExpectedType", "_ArrayType");
3569                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
3570              err_ctx = ctx}) (*error*)
3571       | Types.ArrayType (_, cl_spec'), sub :: subs' ->
3572           let cl_spec' = resolve_component_indexed_access cl_spec' subs' in
3573           subarray_access sub cl_spec'
3574   and subarray_access sub cl_spec =
3575     let subarray_access' = function
3576       | Types.PredefinedType { Types.base_type = Types.IntegerType } -> cl_spec
3577       | Types.ArrayType
3578           (dim, Types.PredefinedType { Types.base_type = Types.IntegerType }) ->
3579           Types.ArrayType (dim, cl_spec)
3580       | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3581         Types.ArrayType _ | Types.TupleType _ -> assert false (*error*) in
3582     match sub.info.type_description with
3583       | Types.ComponentElement cpnt_type ->
3584           let cl_spec' = evaluate cpnt_type.Types.base_class in
3585           subarray_access' cl_spec'
3586       | Types.ClassElement _ | Types.ComponentTypeElement _ |
3587         Types.PredefinedTypeElement _ -> assert false (*error*) in
3588   match expres'.info.type_description with
3589     | Types.ComponentElement cpnt_type ->
3590         let cl_spec = evaluate cpnt_type.Types.base_class in
3591         let subs' = resolve_subscripts ctx expres' cl_spec subs in
3592         let cpnt_type' = 
3593           { cpnt_type with
3594             Types.base_class =
3595               lazy (resolve_component_indexed_access cl_spec subs')
3596           } in
3597         let info =
3598           {
3599             syntax = Some expr;
3600             type_description = Types.ComponentElement cpnt_type'
3601           } in
3602         { nature = IndexedAccess (expres', subs'); info = info }
3603     | Types.ClassElement _ | Types.ComponentTypeElement _ |
3604       Types.PredefinedTypeElement _ ->
3605         raise (CompilError
3606           {err_msg = ["_ClassElemFoundInExpr"];
3607            err_info = [];
3608            err_ctx = ctx}) (*error*)
3609
3610 and resolve_integer ctx expr s =
3611   let nat =
3612     try
3613       Integer (Int32.of_string s)
3614     with
3615     | _ ->
3616         raise (CompilError
3617           {err_msg = ["_InvalidInteger"; s];
3618            err_info = [];
3619            err_ctx = ctx}) in
3620   resolved_expression (Some expr) nat (Types.integer_type Types.Constant)
3621
3622 and resolve_matrix_construction ctx expr exprss =
3623   raise (CompilError
3624     {err_msg = ["_NotYetImplemented"; "_MatrixExpr"];
3625      err_info = [];
3626      err_ctx = ctx})
3627
3628 and resolve_no_event ctx expr expr' =
3629   let expr' = resolve_expression ctx expr' in
3630   match expr'.info.type_description with
3631   | Types.ComponentElement cpnt_type ->
3632       let nat = NoEvent expr'
3633       and flow = lazy (evaluate cpnt_type.Types.flow)
3634       and var = lazy Types.Continuous
3635       and inout = cpnt_type.Types.causality
3636       and cl_spec = cpnt_type.Types.base_class in
3637       let cpnt_type =
3638         component_element flow var inout cl_spec in
3639       let elt_nat = Types.ComponentElement cpnt_type in
3640       resolved_expression (Some expr) nat elt_nat
3641   | _ ->
3642       raise (CompilError
3643         {err_msg = ["_ClassElemFoundInExpr"];
3644          err_info = [];
3645          err_ctx = ctx}) (*error*)
3646
3647 and resolve_range ctx expr start step stop =
3648   let integer_range var start' step' stop' =
3649     let integer_range' =
3650       match start'.nature, step'.nature, stop'.nature with
3651       | _, _, _ when Types.higher_variability var Types.Discrete ->
3652           let var = Types.string_of_variability var in
3653           raise (CompilError
3654             {err_msg = ["_InvalidVarOfRangeExpr"];
3655              err_info = [("_Expr", Syntax.string_of_range start step stop);
3656                          ("_ExpectedVariability", "parameter");
3657                          ("_VariabilityFound", var)];
3658              err_ctx = ctx}) 
3659       | Integer i, Integer p, Integer j when p = Int32.zero ->
3660           raise (CompilError
3661             {err_msg = ["_RangeStepValueCannotBeNull"];
3662              err_info = [("_Expr", Syntax.string_of_range start step stop)];
3663              err_ctx = ctx})
3664       | Integer i, Integer p, Integer j ->
3665           let dim = Int32.div (Int32.succ (Int32.sub j i)) p in
3666           Types.integer_array_type var (Types.ConstantDimension dim)
3667       | (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |
3668          LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _),
3669         (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |
3670          LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _),
3671         (Integer _ | DynamicIdentifier _ | LocalIdentifier _ |
3672          LoopVariable _ | PredefinedIdentifier _ | ToplevelIdentifier _) ->
3673           Types.integer_array_type var Types.ParameterDimension
3674       | _, _, _ ->
3675           raise (CompilError
3676             {err_msg = ["_NotYetImplemented"; "_NonIntegerRangeExpr"];
3677              err_info = [("_Expr", Syntax.string_of_range start step stop)];
3678              err_ctx = ctx}) in
3679     let nat = Range (start', step', stop') in
3680     let elt_nat = integer_range' in
3681     resolved_expression (Some expr) nat elt_nat in
3682   let start' = resolve_expression ctx start
3683   and step' = match step with
3684     | None -> one
3685     | Some expr -> resolve_expression ctx expr
3686   and stop' = resolve_expression ctx stop in
3687   let resolve_range' var start_cl_spec step_cl_spec stop_cl_spec =
3688     match start_cl_spec, step_cl_spec, stop_cl_spec with
3689       | Types.PredefinedType { Types.base_type = Types.IntegerType },
3690         Types.PredefinedType { Types.base_type = Types.IntegerType },
3691         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
3692           integer_range var start' step' stop'
3693       (*| Types.PredefinedType { Types.base_type = Types.IntegerType },
3694         Types.PredefinedType { Types.base_type = Types.IntegerType },
3695         _ -> assert false*)
3696       | _ -> raise (CompilError
3697           {err_msg = ["_NotYetImplemented"; "_NonIntegerRangeExpr"];
3698            err_info = [("_Expr", Syntax.string_of_range start step stop)];
3699            err_ctx = ctx}) in
3700   let start_elt_nat = start'.info.type_description
3701   and step_elt_nat = step'.info.type_description
3702   and stop_elt_nat = stop'.info.type_description in
3703   match start_elt_nat, step_elt_nat, stop_elt_nat with
3704     | Types.ComponentElement start_cpnt_type,
3705       Types.ComponentElement step_cpnt_type,
3706       Types.ComponentElement stop_cpnt_type ->
3707         let start_cl_spec = evaluate start_cpnt_type.Types.base_class
3708         and step_cl_spec = evaluate step_cpnt_type.Types.base_class
3709         and stop_cl_spec = evaluate stop_cpnt_type.Types.base_class
3710         and start_var = evaluate start_cpnt_type.Types.variability
3711         and step_var = evaluate step_cpnt_type.Types.variability
3712         and stop_var = evaluate stop_cpnt_type.Types.variability in
3713         let var =
3714           let var' = Types.max_variability step_var stop_var in
3715           Types.max_variability start_var var' in
3716         resolve_range' var start_cl_spec step_cl_spec stop_cl_spec
3717     | _ -> raise (CompilError
3718         {err_msg = ["_InvalidTypeInRangeExpr"];
3719          err_info = [("_Expr", Syntax.string_of_range start step stop)];
3720          err_ctx = ctx}) (*error*)
3721
3722 and resolve_real ctx expr s =
3723   let nat = Real (float_of_string s) in
3724   resolved_expression (Some expr) nat (Types.real_type Types.Constant)
3725
3726 and resolve_string ctx expr s =
3727   resolved_expression (Some expr) (String s) (Types.string_type Types.Constant)
3728
3729 and resolve_true ctx expr =
3730   resolved_expression (Some expr) True (Types.boolean_type Types.Constant)
3731
3732 and resolve_tuple ctx expr exprs =
3733   let max_element_variability var expr expr' =
3734     match expr'.info.type_description with
3735       | Types.ComponentElement cpnt_type ->
3736           let var' = evaluate cpnt_type.Types.variability in
3737           Types.max_variability var var'
3738       | Types.ClassElement _ | Types.ComponentTypeElement _ |
3739         Types.PredefinedTypeElement _ ->
3740           raise (CompilError
3741             {err_msg = ["_ClassElemFoundInExpr"];
3742              err_info = [];
3743              err_ctx = ctx}) (*error*)
3744   and class_specifier expr expr' =
3745     match expr'.info.type_description with
3746       | Types.ComponentElement cpnt_type -> evaluate cpnt_type.Types.base_class
3747       | Types.ClassElement _ | Types.ComponentTypeElement _ |
3748         Types.PredefinedTypeElement _ ->
3749           raise (CompilError
3750             {err_msg = ["_ClassElemFoundInExpr"];
3751              err_info = [];
3752              err_ctx = ctx}) (*error*) in
3753   let exprs' = List.map (resolve_expression ctx) exprs in
3754   let flow = lazy false
3755   and var =
3756     lazy (List.fold_left2 max_element_variability Types.Constant exprs exprs')
3757   and inout = lazy Types.Acausal
3758   and cl_spec = lazy (Types.TupleType (List.map2 class_specifier exprs exprs')) in
3759   {
3760     nature = Tuple exprs';
3761     info =
3762       {
3763         syntax = Some expr;
3764         type_description =
3765           Types.ComponentElement (component_element flow var inout cl_spec)
3766       }
3767   }
3768
3769 and resolve_unuary_operation ctx expr kind arg =
3770   let arg' = resolve_expression ctx arg in
3771   match kind.Syntax.nature with
3772     | Syntax.UnaryMinus -> resolve_unary_minus ctx expr arg'
3773     | Syntax.Not -> resolve_not ctx expr arg'
3774     | Syntax.UnaryPlus ->
3775         raise (CompilError
3776           {err_msg = ["_NotYetImplemented"; "_UnaryOperPLUS"];
3777            err_info = [];
3778            err_ctx = ctx})
3779
3780 and resolve_vector ctx expr vec_elts = match vec_elts.Syntax.nature with
3781   | Syntax.VectorReduction (expr', for_inds) ->
3782       resolve_vector_reduction ctx expr expr' for_inds
3783   | Syntax.VectorElements exprs -> resolve_vector_elements ctx expr exprs
3784
3785 and resolve_vector_reduction ctx expr expr' for_inds =
3786   let vector_reduction_type acc expr expr' =
3787     let add_dimension elt_nat cl_spec =
3788       let add_dimension' cl_spec' = match cl_spec' with
3789         | Types.ArrayType (dim, _) -> Types.ArrayType (dim, cl_spec)
3790         | Types.PredefinedType _ | Types.ClassType _ |
3791           Types.ComponentType _ | Types.TupleType _ -> 
3792             raise (CompilError
3793               {err_msg = ["_InvalidTypeInRangeExpr"];
3794                err_info =
3795                  [("_ExpectedType", "_ArrayType");
3796                   ("_TypeFound",
3797                    Types.string_of_class_specifier cl_spec')];
3798                err_ctx = ctx}) (*error*) in
3799       match elt_nat with
3800         | Types.ComponentElement cpnt_type ->
3801             let cl_spec' = evaluate cpnt_type.Types.base_class in
3802             add_dimension' cl_spec'
3803         | Types.ClassElement _ | Types.ComponentTypeElement _ |
3804           Types.PredefinedTypeElement _ ->
3805             raise (CompilError
3806               {err_msg = ["_ClassElemFoundInExpr"];
3807                err_info = [];
3808                err_ctx = ctx}) (*error*) in
3809     let rec vector_reduction_type' acc cl_spec = match acc with
3810       | [] -> cl_spec
3811       | range :: acc ->
3812           let elt_nat = range.info.type_description in
3813           let cl_spec' = add_dimension elt_nat cl_spec in
3814           vector_reduction_type' acc cl_spec' in
3815     match expr'.info.type_description with
3816       | Types.ComponentElement cpnt_type ->
3817           let cl_spec = evaluate cpnt_type.Types.base_class in
3818           let cpnt_type' =
3819             { cpnt_type with
3820               Types.base_class = lazy (vector_reduction_type' acc cl_spec)
3821             } in
3822           Types.ComponentElement cpnt_type'
3823       | Types.ClassElement _ | Types.ComponentTypeElement _ |
3824         Types.PredefinedTypeElement _ ->
3825           raise (CompilError
3826             {err_msg = ["_ClassElemFoundInExpr"];
3827              err_info = [];
3828              err_ctx = ctx}) (*error*)
3829   and range_element_type range range' =
3830     let sub_dimension cl_spec = match cl_spec with
3831       | Types.ArrayType (dim, cl_spec) -> cl_spec
3832       | Types.PredefinedType _ | Types.ClassType _ |
3833         Types.ComponentType _ | Types.TupleType _ -> 
3834           raise (CompilError
3835             {err_msg = ["_InvalidTypeInRangeExpr"];
3836              err_info =
3837                [("_ExpectedType", "_ArrayType");
3838                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
3839              err_ctx = ctx}) (*error*) in
3840     match range'.info.type_description with
3841       | Types.ComponentElement cpnt_type ->
3842           let cl_spec = evaluate cpnt_type.Types.base_class in
3843           let cpnt_type' =
3844             { cpnt_type with
3845               Types.base_class = lazy (sub_dimension cl_spec)
3846             } in
3847           Types.ComponentElement cpnt_type'
3848       | Types.ClassElement _ | Types.ComponentTypeElement _ |
3849         Types.PredefinedTypeElement _ ->
3850           raise (CompilError
3851             {err_msg = ["_ClassElemFoundInExpr"];
3852              err_info = [];
3853              err_ctx = ctx}) (*error*) in
3854   let rec resolve_vector_reduction' acc ctx = function
3855     | [] ->
3856         let expres' = resolve_expression ctx expr' in
3857         let nat = VectorReduction (List.rev acc, expres')
3858         and elt_nat = vector_reduction_type acc expr' expres' in
3859         resolved_expression (Some expr) nat elt_nat
3860     | (_, None) :: _ ->
3861         raise (CompilError
3862           {err_msg = ["_NotYetImplemented"; "_ImplicitIterRange"];
3863            err_info = [("_Expr", Syntax.string_of_for_inds for_inds)];
3864            err_ctx = ctx})
3865     | (id, Some range) :: for_inds ->
3866         let range' = resolve_expression ctx range in
3867         let elt_nat = range_element_type range range' in
3868         let ctx' =
3869           { ctx with
3870             context_nature = ForContext (ctx, id, elt_nat)
3871           } in
3872         resolve_vector_reduction' (range' :: acc) ctx' for_inds in
3873   resolve_vector_reduction' [] ctx for_inds
3874
3875 and resolve_vector_elements ctx expr exprs =
3876   let max_variability var cpnt_type =
3877     let var' = evaluate cpnt_type.Types.variability in
3878     Types.max_variability var var' in
3879   let type_of_elements cpnt_types =
3880     let rec type_of_elements' cl_spec = function
3881       | [] -> cl_spec
3882       | cpnt_type :: cpnt_types ->
3883           let cl_spec' = evaluate cpnt_type.Types.base_class in
3884           type_of_elements' (update cl_spec cl_spec') cpnt_types
3885     and update cl_spec cl_spec' =
3886       match Types.compare_specifiers cl_spec cl_spec' with
3887       | Types.SameType | Types.Supertype -> cl_spec
3888       | Types.Subtype -> cl_spec'
3889       | _ ->
3890           raise (CompilError
3891             {err_msg = ["_TypeConflictsInVectorExpr"];
3892              err_info =
3893                [("_MismatchingTypes",
3894                  Types.string_of_class_specifier cl_spec ^ ", " ^
3895                  Types.string_of_class_specifier cl_spec')];
3896              err_ctx = ctx}) in
3897     match cpnt_types with
3898       | [] -> assert false (*error*)
3899       | cpnt_type :: cpnt_types ->
3900           let cl_spec' = evaluate cpnt_type.Types.base_class in
3901           type_of_elements' cl_spec' cpnt_types in
3902   let exprs' = List.map (resolve_expression ctx) exprs in
3903   let exprs' = apply_binary_coercions exprs' in
3904   let cpnt_types = List.map (component_type_of_expression ctx) exprs' in
3905   let var = lazy (List.fold_left max_variability Types.Constant cpnt_types) in
3906   let cl_spec = type_of_elements cpnt_types in
3907   let dim = Types.ConstantDimension (Int32.of_int (List.length exprs')) in
3908   let cl_spec' = lazy (Types.ArrayType (dim, cl_spec)) in
3909   let cpnt_type =
3910     {
3911       Types.flow = lazy false;
3912             variability = var;
3913             causality = lazy Types.Acausal;
3914             base_class = cl_spec'
3915     } in
3916   let nat = Vector exprs'
3917   and elt_nat = Types.ComponentElement cpnt_type in
3918   resolved_expression (Some expr) nat elt_nat
3919
3920 and resolve_and ctx expr arg arg' =
3921   let resolve_and' cpnt_type cpnt_type' =
3922     let rec and_type cl_spec cl_spec' = match cl_spec, cl_spec' with
3923       | Types.PredefinedType { Types.base_type = Types.BooleanType },
3924         Types.PredefinedType { Types.base_type = Types.BooleanType } ->
3925           Types.PredefinedType
3926             { Types.base_type = Types.BooleanType; attributes = [] }
3927       | Types.PredefinedType { Types.base_type = Types.BooleanType },
3928         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3929          Types.ArrayType _ | Types.TupleType _) ->
3930           raise (CompilError
3931             {err_msg = ["and"; "_OperAppliedToNonBoolExpr"];
3932              err_info =
3933                [("_ExpectedType", "Boolean");
3934                 ("_TypeFound", Types.string_of_class_specifier cl_spec')];
3935              err_ctx = ctx}) (*error*)
3936       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3937          Types.ArrayType _ | Types.TupleType _),
3938         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3939          Types.ArrayType _ | Types.TupleType _) ->
3940           raise (CompilError
3941             {err_msg = ["and"; "_OperAppliedToNonBoolExpr"];
3942              err_info =
3943                [("_ExpectedType", "Boolean");
3944                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
3945              err_ctx = ctx}) (*error*) in
3946     let var =
3947       lazy (
3948         let var = evaluate cpnt_type.Types.variability
3949         and var' = evaluate cpnt_type'.Types.variability in
3950         Types.max_variability var var')
3951     and inout = Types.Acausal
3952     and cl_spec =
3953       lazy (
3954         let cl_spec = evaluate cpnt_type.Types.base_class
3955         and cl_spec' = evaluate cpnt_type'.Types.base_class in
3956         and_type cl_spec cl_spec') in
3957     let nat = BinaryOperation (And, arg, arg') in
3958     let elt_nat =
3959       let cpnt_type =
3960         component_element (lazy false) var (lazy inout) cl_spec in
3961       Types.ComponentElement cpnt_type in
3962     resolved_expression (Some expr) nat elt_nat in
3963   match arg.info.type_description, arg'.info.type_description with
3964     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
3965         resolve_and' cpnt_type cpnt_type'
3966     | Types.ComponentElement _,
3967       (Types.ClassElement _ | Types.ComponentTypeElement _ |
3968        Types.PredefinedTypeElement _) ->
3969         raise (CompilError
3970           {err_msg = ["_ClassElemFoundInExpr"];
3971            err_info = [];
3972            err_ctx = ctx}) (*error*)
3973     | (Types.ClassElement _ | Types.ComponentTypeElement _ |
3974        Types.PredefinedTypeElement _),
3975       (Types.ComponentElement _ | Types.ClassElement _ |
3976        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
3977         raise (CompilError
3978           {err_msg = ["_ClassElemFoundInExpr"];
3979            err_info = [];
3980            err_ctx = ctx}) (*error*)
3981
3982 and resolve_or ctx expr arg arg' =
3983   let resolve_or' cpnt_type cpnt_type' =
3984     let rec or_type cl_spec cl_spec' = match cl_spec, cl_spec' with
3985       | Types.PredefinedType { Types.base_type = Types.BooleanType },
3986         Types.PredefinedType { Types.base_type = Types.BooleanType } ->
3987           Types.PredefinedType
3988             { Types.base_type = Types.BooleanType; attributes = [] }
3989       | Types.PredefinedType { Types.base_type = Types.BooleanType },
3990         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3991          Types.ArrayType _ | Types.TupleType _) ->
3992           raise (CompilError
3993             {err_msg = ["or"; "_OperAppliedToNonBoolExpr"];
3994              err_info =
3995                [("_ExpectedType", "Boolean");
3996                 ("_TypeFound", Types.string_of_class_specifier cl_spec')];
3997              err_ctx = ctx}) (*error*)
3998       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
3999          Types.ArrayType _ | Types.TupleType _),
4000         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4001          Types.ArrayType _ | Types.TupleType _) ->
4002           raise (CompilError
4003             {err_msg = ["or"; "_OperAppliedToNonBoolExpr"];
4004              err_info =
4005                [("_ExpectedType", "Boolean");
4006                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
4007              err_ctx = ctx}) (*error*) in
4008     let var =
4009       lazy (let var = evaluate cpnt_type.Types.variability
4010         and var' = evaluate cpnt_type'.Types.variability in
4011         Types.max_variability var var')
4012     and inout = Types.Acausal
4013     and cl_spec =
4014       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4015         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4016         or_type cl_spec cl_spec') in
4017     let nat = BinaryOperation (Or, arg, arg') in
4018     let elt_nat =
4019       let cpnt_type =
4020         component_element (lazy false) var (lazy inout) cl_spec in
4021       Types.ComponentElement cpnt_type in
4022     resolved_expression (Some expr) nat elt_nat in
4023   match arg.info.type_description, arg'.info.type_description with
4024     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4025         resolve_or' cpnt_type cpnt_type'
4026     | (Types.ComponentElement _ | Types.ClassElement _ |
4027        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4028       (Types.ComponentElement _ | Types.ClassElement _ |
4029        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4030         raise (CompilError
4031           {err_msg = ["_ClassElemFoundInExpr"];
4032            err_info = [];
4033            err_ctx = ctx}) (*error*)
4034
4035 and resolve_addition ctx expr arg arg' =
4036   let resolve_addition' cpnt_type cpnt_type' =
4037     let rec addition_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4038       | Types.ArrayType (Types.ConstantDimension n, _),
4039         Types.ArrayType (Types.ConstantDimension n', _) when n <> n' ->
4040           raise (CompilError
4041             {err_msg = ["_ArrayDimMustAgreeToPerform"; "_Addition"];
4042              err_info =
4043                [("_ExprKind", "A + B");
4044                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4045                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4046              err_ctx = ctx}) (*error*)
4047       | Types.ArrayType (Types.ConstantDimension _, cl_spec),
4048         Types.ArrayType (dim, cl_spec') |
4049         Types.ArrayType (dim, cl_spec),
4050         Types.ArrayType (Types.ConstantDimension _, cl_spec') ->
4051           Types.ArrayType (dim, addition_type cl_spec cl_spec')
4052       | Types.ArrayType (Types.ParameterDimension, cl_spec),
4053         Types.ArrayType (dim, cl_spec') |
4054         Types.ArrayType (dim, cl_spec),
4055         Types.ArrayType (Types.ParameterDimension, cl_spec') ->
4056           Types.ArrayType (dim, addition_type cl_spec cl_spec')
4057       | Types.ArrayType (Types.DiscreteDimension, cl_spec),
4058         Types.ArrayType (Types.DiscreteDimension, cl_spec') ->
4059           Types.ArrayType
4060             (Types.DiscreteDimension, addition_type cl_spec cl_spec')
4061       | Types.PredefinedType { Types.base_type = Types.IntegerType },
4062         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4063           Types.PredefinedType
4064             { Types.base_type = Types.IntegerType; attributes = [] }
4065       | Types.PredefinedType
4066           { Types.base_type = Types.RealType | Types.IntegerType },
4067         Types.PredefinedType
4068           { Types.base_type = Types.RealType | Types.IntegerType } ->
4069           Types.PredefinedType
4070             { Types.base_type = Types.RealType; attributes = [] }
4071       | Types.PredefinedType _, Types.ArrayType _ 
4072       | Types.ArrayType _, Types.PredefinedType _ -> 
4073           raise (CompilError
4074             {err_msg = ["+"; "_OperBetweenScalarAndArray"];
4075              err_info =
4076                [("_ExprKind", "A + B");
4077                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4078                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4079              err_ctx = ctx}) (*error*)
4080       | _, _ -> 
4081           raise (CompilError
4082             {err_msg = ["+"; "_OperAppliedToNonNumericExpr"];
4083              err_info =
4084                [("_ExprKind", "A + B");
4085                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4086                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4087              err_ctx = ctx}) (*error*) in
4088     let var =
4089       lazy (let var = evaluate cpnt_type.Types.variability
4090         and var' = evaluate cpnt_type'.Types.variability in
4091         Types.max_variability var var')
4092     and inout = Types.Acausal
4093     and cl_spec =
4094       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4095         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4096         addition_type cl_spec cl_spec') in
4097     let nat = BinaryOperation (Plus, arg, arg') in
4098     let elt_nat =
4099       let cpnt_type =
4100         component_element (lazy false) var (lazy inout) cl_spec in
4101       Types.ComponentElement cpnt_type in
4102     resolved_expression (Some expr) nat elt_nat in
4103   match arg.info.type_description, arg'.info.type_description with
4104     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4105         resolve_addition' cpnt_type cpnt_type'
4106     | (Types.ComponentElement _ | Types.ClassElement _ |
4107        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4108       (Types.ComponentElement _ | Types.ClassElement _ |
4109        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4110         raise (CompilError
4111             {err_msg = ["_ClassElemFoundInExpr"];
4112              err_info = [];
4113              err_ctx = ctx}) (*error*)
4114
4115 and resolve_comparison ctx expr kind arg arg' =
4116   let resolve_comparison' cpnt_type cpnt_type' =
4117     let rec comparison_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4118       | Types.PredefinedType
4119           { Types.base_type = Types.IntegerType | Types.RealType },
4120         Types.PredefinedType
4121           { Types.base_type = Types.IntegerType | Types.RealType } ->
4122           Types.PredefinedType
4123             { Types.base_type = Types.BooleanType; attributes = [] }
4124       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4125          Types.ArrayType _ | Types.TupleType _),
4126         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4127          Types.ArrayType _ | Types.TupleType _) ->
4128           raise (CompilError
4129             {err_msg = ["_TypeInconsistWithComparOper"];
4130              err_info =
4131                [("_ExprKind", "A" ^ (string_of_bin_oper_kind kind) ^ "B");
4132                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4133                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4134              err_ctx = ctx}) (*error*) in
4135     (*let var =
4136       let var = evaluate cpnt_type.Types.variability
4137       and var' = evaluate cpnt_type'.Types.variability in
4138         Types.max_variability var var'*)
4139     let var = Types.Discrete
4140     and inout = Types.Acausal
4141     and cl_spec =
4142       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4143         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4144         comparison_type cl_spec cl_spec') in
4145     let nat = BinaryOperation (kind, arg, arg') in
4146     let elt_nat =
4147       let cpnt_type =
4148         component_element (lazy false) (lazy var) (lazy inout) cl_spec in
4149       Types.ComponentElement cpnt_type in
4150     resolved_expression (Some expr) nat elt_nat in
4151   match arg.info.type_description, arg'.info.type_description with
4152     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4153         resolve_comparison' cpnt_type cpnt_type'
4154     | (Types.ComponentElement _ | Types.ClassElement _ |
4155        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4156       (Types.ComponentElement _ | Types.ClassElement _ |
4157        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4158         raise (CompilError
4159           {err_msg = ["_ClassElemFoundInExpr"];
4160            err_info = [];
4161            err_ctx = ctx}) (*error*)
4162
4163 and resolve_division ctx expr arg arg' =
4164   let resolve_division' cpnt_type cpnt_type' =
4165     let rec division_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4166       | Types.ArrayType (dim, cl_spec),
4167         Types.PredefinedType
4168           { Types.base_type = Types.IntegerType | Types.RealType } ->
4169           Types.ArrayType (dim, division_type cl_spec cl_spec')
4170       | Types.PredefinedType
4171           { Types.base_type = Types.RealType | Types.IntegerType },
4172         Types.PredefinedType
4173           { Types.base_type = Types.RealType | Types.IntegerType } ->
4174           Types.PredefinedType
4175             { Types.base_type = Types.RealType; attributes = [] }
4176       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4177          Types.ArrayType _ | Types.TupleType _),
4178         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4179          Types.ArrayType _ | Types.TupleType _) ->
4180           raise (CompilError
4181             {err_msg = ["_TypeInconsistentWithDivOper"];
4182              err_info =
4183                [("_ExprKind", "A / B");
4184                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4185                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4186              err_ctx = ctx}) (*error*) in
4187     let var =
4188       lazy (let var = evaluate cpnt_type.Types.variability
4189         and var' = evaluate cpnt_type'.Types.variability in
4190         Types.max_variability var var')
4191     and inout = Types.Acausal
4192     and cl_spec =
4193       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4194         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4195         division_type cl_spec cl_spec') in
4196     let nat = BinaryOperation (Divide, arg, arg') in
4197     let elt_nat =
4198       let cpnt_type =
4199         component_element (lazy false) var (lazy inout) cl_spec in
4200       Types.ComponentElement cpnt_type in
4201     resolved_expression (Some expr) nat elt_nat in
4202   match arg.info.type_description, arg'.info.type_description with
4203     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4204         resolve_division' cpnt_type cpnt_type'
4205     | (Types.ComponentElement _ | Types.ClassElement _ |
4206        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4207       (Types.ComponentElement _ | Types.ClassElement _ |
4208        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4209         raise (CompilError
4210           {err_msg = ["_ClassElemFoundInExpr"];
4211            err_info = [];
4212            err_ctx = ctx}) (*error*)
4213
4214 and resolve_multiplication ctx expr arg arg' =
4215   let resolve_multiplication' cpnt_type cpnt_type' =
4216     let rec multiplication_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4217       | Types.ArrayType (_, Types.ArrayType (Types.ConstantDimension n, _)),
4218         Types.ArrayType (Types.ConstantDimension n', Types.ArrayType _)
4219         when n <> n' ->
4220           raise (CompilError
4221             {err_msg = ["_ArrayDimsNonCompatibleWithMult"];
4222              err_info =
4223                [("_ExprKind", "A * B");
4224                 ("_TypeOfA", Types.string_of_component_type cpnt_type);
4225                 ("_TypeOfB", Types.string_of_component_type cpnt_type')];
4226              err_ctx = ctx})  (*error*)
4227       | Types.ArrayType
4228           (dim, Types.ArrayType
4229             (_, Types.PredefinedType
4230               { Types.base_type = Types.IntegerType })),
4231         Types.ArrayType
4232           (_, Types.ArrayType
4233             (dim', Types.PredefinedType
4234               { Types.base_type = Types.IntegerType })) ->
4235           Types.ArrayType
4236             (dim, Types.ArrayType
4237               (dim', Types.PredefinedType
4238                 { Types.base_type = Types.IntegerType; attributes = [] }))
4239       | Types.ArrayType
4240           (dim, Types.ArrayType
4241             (_, Types.PredefinedType
4242               { Types.base_type = Types.IntegerType | Types.RealType })),
4243         Types.ArrayType
4244           (_, Types.ArrayType
4245             (dim', Types.PredefinedType
4246               { Types.base_type = Types.IntegerType | Types.RealType })) ->
4247           Types.ArrayType
4248             (dim, Types.ArrayType
4249               (dim', Types.PredefinedType
4250                 { Types.base_type = Types.RealType; attributes = [] }))
4251       | Types.ArrayType (_, Types.ArrayType (Types.ConstantDimension n, _)),
4252         Types.ArrayType (Types.ConstantDimension n', _)
4253         when n <> n' ->
4254           raise (CompilError
4255             {err_msg = ["_ArrayDimsNonCompatibleWithMult"];
4256              err_info =
4257                [("_ExprKind", "A * B");
4258                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4259                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4260              err_ctx = ctx})  (*error*)
4261       | Types.ArrayType
4262           (dim, Types.ArrayType
4263             (_, Types.PredefinedType
4264               { Types.base_type = Types.IntegerType })),
4265         Types.ArrayType
4266           (_, Types.PredefinedType
4267             { Types.base_type = Types.IntegerType }) ->
4268           Types.ArrayType
4269             (dim, Types.PredefinedType
4270               { Types.base_type = Types.IntegerType; attributes = [] })
4271       | Types.ArrayType
4272           (dim, Types.ArrayType
4273             (_, Types.PredefinedType
4274               { Types.base_type = Types.IntegerType | Types.RealType })),
4275         Types.ArrayType
4276           (_, Types.PredefinedType
4277             { Types.base_type = Types.IntegerType | Types.RealType }) ->
4278           Types.ArrayType
4279             (dim, Types.PredefinedType
4280               { Types.base_type = Types.RealType; attributes = [] })
4281       | Types.ArrayType (Types.ConstantDimension n, _),
4282         Types.ArrayType (Types.ConstantDimension n', Types.ArrayType _)
4283         when n <> n' ->
4284           raise (CompilError
4285             {err_msg = ["_ArrayDimsNonCompatibleWithMult"];
4286              err_info =
4287                [("_ExprKind", "A * B");
4288                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4289                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4290              err_ctx = ctx})  (*error*)
4291       | Types.ArrayType
4292           (_, Types.PredefinedType
4293             { Types.base_type = Types.IntegerType }),
4294         Types.ArrayType
4295           (_, Types.ArrayType
4296             (dim, Types.PredefinedType
4297               { Types.base_type = Types.IntegerType })) ->
4298           Types.ArrayType
4299             (dim, Types.PredefinedType
4300               { Types.base_type = Types.IntegerType; attributes = [] })
4301       | Types.ArrayType
4302           (_, Types.PredefinedType
4303             { Types.base_type = Types.IntegerType | Types.RealType }),
4304         Types.ArrayType
4305           (_, Types.ArrayType
4306             (dim, Types.PredefinedType
4307               { Types.base_type = Types.IntegerType | Types.RealType })) ->
4308           Types.ArrayType
4309             (dim, Types.PredefinedType
4310               { Types.base_type = Types.RealType; attributes = [] })
4311       | Types.ArrayType (Types.ConstantDimension n, _),
4312         Types.ArrayType (Types.ConstantDimension n', _)
4313         when n <> n' ->
4314           raise (CompilError
4315             {err_msg = ["_ArrayDimsNonCompatibleWithMult"];
4316              err_info =
4317                [("_ExprKind", "A * B");
4318                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4319                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4320              err_ctx = ctx})  (*error*)
4321       | Types.ArrayType
4322           (_, Types.PredefinedType
4323             { Types.base_type = Types.IntegerType }),
4324         Types.ArrayType
4325           (_, Types.PredefinedType
4326             { Types.base_type = Types.IntegerType }) ->
4327           Types.PredefinedType
4328             { Types.base_type = Types.IntegerType; attributes = [] }
4329       | Types.ArrayType
4330           (_, Types.PredefinedType
4331             { Types.base_type = Types.IntegerType | Types.RealType }),
4332         Types.ArrayType
4333           (_, Types.PredefinedType
4334             { Types.base_type = Types.IntegerType | Types.RealType }) ->
4335           Types.PredefinedType
4336             { Types.base_type = Types.RealType; attributes = [] }
4337       | Types.PredefinedType
4338           { Types.base_type = Types.IntegerType | Types.RealType },
4339         Types.ArrayType (dim, cl_spec') ->
4340           Types.ArrayType (dim, multiplication_type cl_spec cl_spec')
4341       | Types.ArrayType (dim, cl_spec),
4342         Types.PredefinedType
4343           { Types.base_type = Types.IntegerType | Types.RealType } ->
4344           Types.ArrayType (dim, multiplication_type cl_spec cl_spec')
4345       | Types.PredefinedType { Types.base_type = Types.IntegerType },
4346         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4347           Types.PredefinedType
4348             { Types.base_type = Types.IntegerType; attributes = [] }
4349       | Types.PredefinedType
4350           { Types.base_type = Types.RealType | Types.IntegerType },
4351         Types.PredefinedType
4352           { Types.base_type = Types.RealType | Types.IntegerType } ->
4353           Types.PredefinedType
4354             { Types.base_type = Types.RealType; attributes = [] }
4355       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4356          Types.ArrayType _ | Types.TupleType _),
4357         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4358          Types.ArrayType _ | Types.TupleType _) ->
4359           raise (CompilError
4360             {err_msg = ["*"; "_OperAppliedToNonNumericExpr"];
4361              err_info =
4362                [("_ExprKind", "A * B");
4363                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4364                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4365              err_ctx = ctx})  (*error*) in
4366     let var =
4367       lazy (let var = evaluate cpnt_type.Types.variability
4368         and var' = evaluate cpnt_type'.Types.variability in
4369         Types.max_variability var var')
4370     and inout = Types.Acausal
4371     and cl_spec =
4372       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4373         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4374         multiplication_type cl_spec cl_spec') in
4375     let nat = BinaryOperation (Times, arg, arg') in
4376     let elt_nat =
4377       let cpnt_type =
4378         component_element (lazy false) var (lazy inout) cl_spec in
4379       Types.ComponentElement cpnt_type in
4380     resolved_expression (Some expr) nat elt_nat in
4381   match  arg.info.type_description, arg'.info.type_description with
4382     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4383         resolve_multiplication' cpnt_type cpnt_type'
4384     | (Types.ComponentElement _ | Types.ClassElement _ |
4385        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4386       (Types.ComponentElement _ | Types.ClassElement _ |
4387        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4388         raise (CompilError
4389           {err_msg = ["_ClassElemFoundInExpr"];
4390            err_info = [];
4391            err_ctx = ctx})  (*error*)
4392
4393 and resolve_power ctx expr arg arg' =
4394   let resolve_power' cpnt_type cpnt_type' =
4395     let rec power_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4396       | Types.ArrayType
4397           (Types.ConstantDimension n, Types.ArrayType
4398             (Types.ConstantDimension n', _)),
4399         Types.PredefinedType { Types.base_type = Types.IntegerType }
4400         when n <> n' ->
4401           raise (CompilError
4402             {err_msg = ["_PowerOperOnNonSquareArray"];
4403              err_info =
4404                [("_ExprKind", "A ^ B");
4405                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4406                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4407              err_ctx = ctx}) (*error*)
4408       | Types.ArrayType
4409           (dim, Types.ArrayType
4410             (dim', Types.PredefinedType
4411               { Types.base_type = Types.IntegerType })),
4412         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4413           Types.ArrayType
4414             (dim, Types.ArrayType
4415               (dim', Types.PredefinedType
4416                 { Types.base_type = Types.RealType; attributes = [] }))
4417       | Types.ArrayType
4418           (dim, Types.ArrayType
4419             (dim', Types.PredefinedType { Types.base_type = Types.RealType })),
4420         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4421           Types.ArrayType
4422             (dim, Types.ArrayType
4423               (dim', Types.PredefinedType
4424                 { Types.base_type = Types.RealType; attributes = [] }))
4425       | Types.PredefinedType { Types.base_type = Types.IntegerType },
4426         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4427           Types.PredefinedType
4428             { Types.base_type = Types.RealType; attributes = [] }
4429       | Types.PredefinedType
4430           { Types.base_type = Types.RealType | Types.IntegerType },
4431         Types.PredefinedType
4432           { Types.base_type = Types.RealType | Types.IntegerType } ->
4433           Types.PredefinedType
4434             { Types.base_type = Types.RealType; attributes = [] }
4435       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4436          Types.ArrayType _ | Types.TupleType _),
4437         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4438          Types.ArrayType _ | Types.TupleType _) ->
4439           raise (CompilError
4440             {err_msg = ["^"; "_OperAppliedToNonNumericExpr"];
4441              err_info =
4442                [("_ExprKind", "A ^ B");
4443                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4444                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4445              err_ctx = ctx}) (*error*) in
4446     let var =
4447       lazy (let var = evaluate cpnt_type.Types.variability
4448         and var' = evaluate cpnt_type'.Types.variability in
4449         Types.max_variability var var')
4450     and inout = Types.Acausal
4451     and cl_spec =
4452       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4453         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4454         power_type cl_spec cl_spec') in
4455     let nat = BinaryOperation (Power, arg, arg') in
4456     let elt_nat =
4457       let cpnt_type =
4458         component_element (lazy false) var (lazy inout) cl_spec in
4459       Types.ComponentElement cpnt_type in
4460     resolved_expression (Some expr) nat elt_nat in
4461   match arg.info.type_description, arg'.info.type_description with
4462     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4463         resolve_power' cpnt_type cpnt_type'
4464     | (Types.ComponentElement _ | Types.ClassElement _ |
4465        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4466       (Types.ComponentElement _ | Types.ClassElement _ |
4467        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4468         raise (CompilError
4469           {err_msg = ["_ClassElemFoundInExpr"];
4470            err_info = [];
4471            err_ctx = ctx})  (*error*)
4472
4473 and resolve_subtraction ctx expr arg arg' =
4474   let resolve_subtraction' cpnt_type cpnt_type' =
4475     let rec subtraction_type cl_spec cl_spec' = match cl_spec, cl_spec' with
4476       | Types.ArrayType (Types.ConstantDimension n, _),
4477         Types.ArrayType (Types.ConstantDimension n', _) when n <> n' ->
4478           raise (CompilError
4479           {err_msg = ["_ArrayDimMustAgreeToPerform"; "_Subtraction"];
4480            err_info =
4481              [("_ExprKind", "A - B");
4482               ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4483               ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4484            err_ctx = ctx})  (*error*)
4485       | Types.ArrayType (Types.ConstantDimension _, cl_spec),
4486         Types.ArrayType (dim, cl_spec') |
4487         Types.ArrayType (dim, cl_spec),
4488         Types.ArrayType (Types.ConstantDimension _, cl_spec') ->
4489           Types.ArrayType (dim, subtraction_type cl_spec cl_spec')
4490       | Types.ArrayType (Types.ParameterDimension, cl_spec),
4491         Types.ArrayType (dim, cl_spec') |
4492         Types.ArrayType (dim, cl_spec),
4493         Types.ArrayType (Types.ParameterDimension, cl_spec') ->
4494           Types.ArrayType (dim, subtraction_type cl_spec cl_spec')
4495       | Types.ArrayType (Types.DiscreteDimension, cl_spec),
4496         Types.ArrayType (Types.DiscreteDimension, cl_spec') ->
4497           Types.ArrayType
4498             (Types.DiscreteDimension, subtraction_type cl_spec cl_spec')
4499       | Types.PredefinedType { Types.base_type = Types.IntegerType },
4500         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
4501           Types.PredefinedType
4502             { Types.base_type = Types.IntegerType; attributes = [] }
4503       | Types.PredefinedType
4504           { Types.base_type = Types.RealType | Types.IntegerType },
4505         Types.PredefinedType
4506           { Types.base_type = Types.RealType | Types.IntegerType } ->
4507           Types.PredefinedType
4508             { Types.base_type = Types.RealType; attributes = [] }
4509       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4510          Types.ArrayType _ | Types.TupleType _),
4511         (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4512          Types.ArrayType _ | Types.TupleType _) ->
4513           raise (CompilError
4514             {err_msg = ["-"; "_OperAppliedToNonNumericExpr"];
4515              err_info =
4516                [("_ExprKind", "A - B");
4517                 ("_TypeOfA", Types.string_of_class_specifier cl_spec);
4518                 ("_TypeOfB", Types.string_of_class_specifier cl_spec')];
4519              err_ctx = ctx}) (*error*) in
4520     let var =
4521       lazy (let var = evaluate cpnt_type.Types.variability
4522         and var' = evaluate cpnt_type'.Types.variability in
4523         Types.max_variability var var')
4524     and inout = Types.Acausal
4525     and cl_spec =
4526       lazy (let cl_spec = evaluate cpnt_type.Types.base_class
4527         and cl_spec' = evaluate cpnt_type'.Types.base_class in
4528         subtraction_type cl_spec cl_spec') in
4529     let nat = BinaryOperation (Minus, arg, arg') in
4530     let elt_nat =
4531       let cpnt_type =
4532         component_element (lazy false) var (lazy inout) cl_spec in
4533       Types.ComponentElement cpnt_type in
4534     resolved_expression (Some expr) nat elt_nat in
4535   match arg.info.type_description, arg'.info.type_description with
4536     | Types.ComponentElement cpnt_type, Types.ComponentElement cpnt_type' ->
4537         resolve_subtraction' cpnt_type cpnt_type'
4538     | (Types.ComponentElement _ | Types.ClassElement _ |
4539        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _),
4540       (Types.ComponentElement _ | Types.ClassElement _ |
4541        Types.ComponentTypeElement _ | Types.PredefinedTypeElement _) ->
4542         raise (CompilError
4543           {err_msg = ["_ClassElemFoundInExpr"];
4544            err_info = [];
4545            err_ctx = ctx})  (*error*)
4546
4547 and resolve_unary_minus ctx expr arg =
4548   let resolve_unary_minus' cpnt_type =
4549     let rec unary_minus_type cl_spec = match cl_spec with
4550       | Types.ArrayType (dim, cl_spec) ->
4551           Types.ArrayType (dim, unary_minus_type cl_spec)
4552       | Types.PredefinedType
4553           { Types.base_type = Types.RealType | Types.IntegerType } -> cl_spec
4554       | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4555          Types.TupleType _) -> 
4556           raise (CompilError
4557             {err_msg = ["-"; "_OperAppliedToNonNumericExpr"];
4558              err_info =
4559                [("_ExprKind", "- A");
4560                 ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
4561              err_ctx = ctx})  (*error*) in
4562     let var = cpnt_type.Types.variability
4563     and inout = Types.Acausal
4564     and cl_spec =
4565       lazy (let cl_spec = evaluate cpnt_type.Types.base_class in
4566         unary_minus_type cl_spec) in
4567     let nat = UnaryOperation (UnaryMinus, arg) in
4568     let elt_nat =
4569       let cpnt_type =
4570         component_element (lazy false) var (lazy inout) cl_spec in
4571       Types.ComponentElement cpnt_type in
4572     resolved_expression (Some expr) nat elt_nat in
4573   match arg.info.type_description with
4574     | Types.ComponentElement cpnt_type -> resolve_unary_minus' cpnt_type
4575     | Types.ClassElement _ |
4576       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->
4577         raise (CompilError
4578           {err_msg = ["_ClassElemFoundInExpr"];
4579            err_info = [];
4580            err_ctx = ctx})  (*error*)
4581
4582 and resolve_not ctx expr arg =
4583   let resolve_not' cpnt_type =
4584     let rec not_type cl_spec = match cl_spec with
4585       | Types.PredefinedType { Types.base_type = Types.BooleanType } -> cl_spec
4586       | (Types.PredefinedType _ | Types.ArrayType _ | Types.ClassType _ |
4587         Types.ComponentType _ | Types.TupleType _) ->
4588           raise (CompilError
4589             {err_msg = ["not"; "_OperAppliedToNonBoolExpr"];
4590              err_info =
4591                [("_ExprKind", "not A");
4592                 ("_TypeOfA", Types.string_of_class_specifier cl_spec)];
4593              err_ctx = ctx}) (*error*) in
4594     let var = cpnt_type.Types.variability
4595     and inout = Types.Acausal
4596     and cl_spec =
4597       lazy (let cl_spec = evaluate cpnt_type.Types.base_class in
4598         not_type cl_spec) in
4599     let nat = UnaryOperation (Not, arg) in
4600     let elt_nat =
4601       let cpnt_type =
4602         component_element (lazy false) var (lazy inout) cl_spec in
4603       Types.ComponentElement cpnt_type in
4604     resolved_expression (Some expr) nat elt_nat in
4605   match arg.info.type_description with
4606     | Types.ComponentElement cpnt_type -> resolve_not' cpnt_type
4607     | Types.ClassElement _ |
4608       Types.ComponentTypeElement _ | Types.PredefinedTypeElement _ ->
4609         raise (CompilError
4610           {err_msg = ["_ClassElemFoundInExpr"];
4611            err_info = [];
4612            err_ctx = ctx}) (*error*)
4613
4614 and component_element flow var inout cl_spec =
4615   {
4616     Types.flow = flow;
4617           variability = var;
4618           causality = inout;
4619           base_class = cl_spec
4620   }
4621
4622 and element_nature_class ctx = function
4623   | Types.ClassElement cl_spec -> evaluate cl_spec
4624   | Types.ComponentElement cpnt_type -> evaluate cpnt_type.Types.base_class
4625   | Types.PredefinedTypeElement predef -> Types.PredefinedType predef
4626   | Types.ComponentTypeElement _ -> assert false (*error*)
4627
4628 and element_field_type_nature ctx flow var inout cl_spec id =
4629   let add_dimension dim = function
4630     | Types.ComponentElement cpnt_type ->
4631         let cpnt_type' =
4632           { cpnt_type with
4633             Types.base_class =
4634               lazy (Types.ArrayType (dim, evaluate cpnt_type.Types.base_class))
4635           } in
4636         Types.ComponentElement cpnt_type'
4637     | Types.ClassElement _
4638     | Types.ComponentTypeElement _
4639     | Types.PredefinedTypeElement _ ->
4640         raise (CompilError
4641           {err_msg = ["_InvalidClassElemModif"];
4642            err_info = [];
4643            err_ctx = ctx}) (*error*) in
4644   let find_predefined_local_identifier predef id =
4645     match predef.Types.base_type with
4646       | Types.BooleanType when id = "start" -> Types.boolean_type Types.Parameter
4647       | Types.IntegerType when id = "start" ->
4648           Types.integer_type Types.Parameter
4649       | Types.RealType when id = "start" ->
4650           Types.real_type Types.Parameter
4651       | Types.StringType when id = "start" -> Types.string_type Types.Parameter
4652       | Types.EnumerationType enum_lits when id = "start" ->
4653           Types.enumeration_type Types.Parameter enum_lits
4654       | _ when id = "fixed" -> Types.boolean_type Types.Constant
4655       | Types.IntegerType when id = "nominal" ->
4656           Types.integer_type Types.Constant
4657       | Types.RealType when id = "nominal" ->
4658           Types.real_type Types.Constant
4659       | _ ->
4660           raise (CompilError
4661             {err_msg = ["_NotYetImplemented"; "_PredefinedTypeAttribModif"; id];
4662              err_info = [];
4663              err_ctx = ctx})
4664   and find_class_local_identifier flow var inout cl_type id =
4665     let apply_prefixes elt_nat = match elt_nat with
4666       | Types.ComponentElement cpnt_type ->
4667           let flow' = lazy (flow || evaluate cpnt_type.Types.flow) in
4668           Types.ComponentElement { cpnt_type with Types.flow = flow' }
4669       | Types.ClassElement _ | Types.ComponentTypeElement _ |
4670         Types.PredefinedTypeElement _ -> elt_nat in
4671     try
4672       let elt_type =
4673         evaluate (List.assoc id cl_type.Types.named_elements) in
4674       match elt_type.Types.dynamic_scope with
4675         | None | Some Types.Inner | Some Types.InnerOuter
4676           when not elt_type.Types.protected ->
4677             apply_prefixes elt_type.Types.element_nature
4678         | None | Some Types.Inner | Some Types.InnerOuter ->
4679             raise (CompilError
4680               {err_msg = ["_CannotAccessProtectElem"; id];
4681                err_info = [];
4682                err_ctx = ctx}) (*error*)
4683         | Some Types.Outer ->
4684             raise (CompilError
4685               {err_msg = ["_CannotAccessOuterElem"; id];
4686                err_info = [];
4687                err_ctx = ctx}) (*error*)
4688     with Not_found ->
4689         raise (CompilError
4690           {err_msg = ["_UnknownIdentifier"; id];
4691            err_info = [];
4692            err_ctx = ctx }) (*error*) in
4693   let rec find_local_identifier flow var inout = function
4694     | Types.PredefinedType predef_type ->
4695         find_predefined_local_identifier predef_type id
4696     | Types.ClassType cl_type ->
4697         find_class_local_identifier flow var inout cl_type id
4698     | Types.ComponentType cpnt_type ->
4699         let flow = flow || evaluate cpnt_type.Types.flow
4700         and var =
4701           Types.max_variability var (evaluate cpnt_type.Types.variability)
4702         and inout = evaluate cpnt_type.Types.causality
4703         and base_class = evaluate cpnt_type.Types.base_class in
4704         find_local_identifier flow var inout base_class
4705     | Types.ArrayType (dim, cl_spec) ->
4706         add_dimension dim (find_local_identifier flow var inout cl_spec)
4707     | Types.TupleType _ -> assert false (*error*) in
4708   find_local_identifier flow var inout cl_spec
4709
4710 and scalar_element_nature elt_nat =
4711   let rec scalar_element_nature' cl_spec = match cl_spec with
4712     | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4713       Types.TupleType _ -> cl_spec
4714     | Types.ArrayType (_, cl_spec) -> scalar_element_nature' cl_spec in
4715   match elt_nat with
4716     | Types.ComponentElement cpnt_type ->
4717         let base_class' =
4718           lazy (scalar_element_nature' (evaluate cpnt_type.Types.base_class)) in
4719         Types.ComponentElement { cpnt_type with Types.base_class = base_class' }
4720     | Types.ClassElement _ | Types.ComponentTypeElement _ |
4721       Types.PredefinedTypeElement _ -> elt_nat
4722
4723 and resolve_lhs_expression ctx expr =
4724   raise (CompilError
4725     {err_msg = ["_NotYetImplemented";
4726                 "_ExternalCallWithLeftHandSideExpr"];
4727      err_info = [];
4728      err_ctx = ctx})
4729
4730 and resolve_subscripts ctx expr cl_spec subs =
4731   let rec resolve_subscripts' n cl_spec subs = match cl_spec, subs with
4732     | _, [] -> []
4733     | Types.ArrayType (dim, cl_spec'), sub :: subs' ->
4734         let sub' = resolve_subscript ctx expr n dim sub in
4735         sub' :: resolve_subscripts' (Int32.add n 1l) cl_spec' subs'
4736     | (Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4737        Types.TupleType _), _ :: _ ->
4738         raise (CompilError
4739           {err_msg = ["_CannotSubscriptANonArrayTypeElem"];
4740            err_info =
4741              [("_ExpectedType", "_ArrayType");
4742               ("_TypeFound", Types.string_of_class_specifier cl_spec)];
4743            err_ctx = ctx}) (*error*) in
4744   match subs.Syntax.nature with
4745     | Syntax.Subscripts subs' -> resolve_subscripts' 1l cl_spec subs'
4746
4747 and resolve_subscript ctx expr n dim sub = match sub.Syntax.nature with
4748   | Syntax.Colon -> resolve_colon ctx expr n dim
4749   | Syntax.Subscript expr' ->
4750       let ctx' =
4751       { ctx with
4752         context_nature = SubscriptContext (ctx, expr, n, dim);
4753         location = expr'.Syntax.info } in
4754       resolve_subscript_expression ctx' expr'
4755
4756 and resolve_colon ctx expr n dim =
4757   let range var stop =
4758     let nat = Range (one, one, stop)
4759     and elt_nat = Types.integer_array_type var dim in
4760     resolved_expression None nat elt_nat in
4761   match dim with
4762     | Types.ConstantDimension n ->
4763         let stop =
4764           let nat = Integer n
4765           and elt_nat = Types.integer_type Types.Constant in
4766           resolved_expression None nat elt_nat in
4767         range Types.Constant stop
4768     | Types.ParameterDimension ->
4769         let stop = size_function_call ctx None expr n in
4770         range Types.Parameter stop
4771     | Types.DiscreteDimension ->
4772         let stop = size_function_call ctx None expr n in
4773         range Types.Discrete stop
4774
4775 and resolve_subscript_expression ctx expr =
4776   let expr' = resolve_expression ctx expr in
4777   let resolve_subscript_expression' cpnt_type =
4778     let cl_spec = evaluate cpnt_type.Types.base_class in
4779     match cl_spec with
4780       | Types.PredefinedType { Types.base_type = Types.IntegerType } |
4781         Types.ArrayType
4782           (_, Types.PredefinedType { Types.base_type = Types.IntegerType }) ->
4783           expr'
4784       | Types.PredefinedType _ | Types.ClassType _ | Types.ComponentType _ |
4785         Types.ArrayType _ | Types.TupleType _ ->
4786           raise (CompilError
4787             {err_msg = ["_NonIntegerArraySubscript"];
4788              err_info =
4789                [("_ExpectedType", "Integer");
4790                 ("_TypeFound", Types.string_of_class_specifier cl_spec)];
4791              err_ctx = ctx}) (*error*) in
4792   match expr'.info.type_description with
4793     | Types.ComponentElement cpnt_type ->
4794         resolve_subscript_expression' cpnt_type
4795     | Types.ClassElement _ | Types.ComponentTypeElement _ |
4796       Types.PredefinedTypeElement _ ->
4797         raise (CompilError
4798           {err_msg = ["_ClassElemFoundInExpr"];
4799            err_info = [];
4800            err_ctx = ctx}) (*error*)
4801
4802 and size_function_call ctx syn arg n =
4803   let size_function_call' cpnt_type =
4804     let cpnt_type' =
4805       { cpnt_type with
4806         Types.base_class = lazy (Types.integer_class_type)
4807       } in
4808     let size =
4809       let nat = PredefinedIdentifier "size"
4810       and elt_nat =
4811         Types.function_type
4812           [("@1", cpnt_type);
4813            ("@2", Types.integer_component_type Types.Constant)]
4814           ["@3", cpnt_type'] in
4815       resolved_expression None nat elt_nat in
4816     let elt_nat = Types.ComponentElement cpnt_type' in
4817     let num =
4818       let nat = Integer n
4819       and elt_nat = Types.integer_type Types.Constant in
4820       resolved_expression None nat elt_nat
4821     and expr =
4822       let args =
4823         let arg1 =
4824           let nat = FunctionArgument 1
4825           and elt_nat = arg.info.type_description in
4826           resolved_expression None nat elt_nat
4827         and arg2 =
4828           let nat = FunctionArgument 2
4829           and elt_nat = Types.integer_type Types.Constant in
4830           resolved_expression None nat elt_nat in
4831         [arg1; arg2] in
4832       let nat = FunctionInvocation args in
4833       resolved_expression None nat elt_nat in
4834     let nat = FunctionCall (size, [arg; num], expr) in
4835     resolved_expression syn nat elt_nat in
4836   match arg.info.type_description with
4837     | Types.ComponentElement cpnt_type -> size_function_call' cpnt_type
4838     | Types.ClassElement _ | Types.ComponentTypeElement _ |
4839       Types.PredefinedTypeElement _ ->
4840         raise (CompilError
4841           {err_msg = ["_ClassElemFoundInExpr"];
4842            err_info = [];
4843            err_ctx = ctx}) (*error*)
4844
4845 and element_type ctx protect final repl dyn_scope elt_desc =
4846   {
4847     Types.protected = protect;
4848           final = bool_of_final final;
4849           replaceable = bool_of_replaceable repl;
4850           dynamic_scope = dynamic_scope_of_dynamic_scope dyn_scope;
4851           element_nature = element_nature_type ctx elt_desc
4852   }
4853
4854 and bool_of_replaceable = function
4855   | None -> false
4856   | Some Syntax.Replaceable -> true
4857
4858 and dynamic_scope_of_dynamic_scope = function
4859   | None -> None
4860   | Some Syntax.Inner -> Some Types.Inner
4861   | Some Syntax.Outer -> Some Types.Outer
4862   | Some Syntax.InnerOuter -> Some Types.InnerOuter
4863
4864 and element_nature_type ctx elt_desc =
4865   let elt_nat = match elt_desc.element_nature with
4866     | Component cpnt_desc -> Types.ComponentElement (evaluate cpnt_desc.component_type)
4867     | Class cl_def -> Types.ClassElement cl_def.class_type
4868     | ComponentType cpnt_type_desc ->
4869         Types.ComponentTypeElement (evaluate cpnt_type_desc.described_type)
4870     | PredefinedType predef -> Types.PredefinedTypeElement predef in
4871   elt_nat
4872
4873 and class_specifier_type ctx part kind cl_def cl_spec =
4874   let class_kind kind cl_type =
4875     let check_class () =
4876       if has_inouts cl_type then
4877         raise (CompilError
4878           {err_msg = ["_CannotUseCausPrefixInGenClass";
4879                       class_specifier_name cl_spec];
4880            err_info = [];
4881            err_ctx = ctx}) (*error*)
4882       else kind
4883     and check_model () = kind
4884     and check_block () =
4885       raise (CompilError
4886         {err_msg = ["_NotYetImplemented"; "_BlockElem"];
4887          err_info = [];
4888          err_ctx = ctx})
4889     and check_record () = kind
4890     and check_expandable_connector () =
4891       raise (CompilError
4892         {err_msg = ["_NotYetImplemented"; "_ExpandableConnector"];
4893          err_info = [];
4894          err_ctx = ctx})
4895     and check_connector () = kind
4896     and check_package () = kind
4897     and check_function () = kind in
4898   match kind with
4899     | Types.Class -> check_class ()
4900     | Types.Model -> check_model ()
4901     | Types.Block -> check_block ()
4902     | Types.Record -> check_record ()
4903     | Types.ExpandableConnector -> check_expandable_connector ()
4904     | Types.Connector -> check_connector ()
4905     | Types.Package -> check_package ()
4906     | Types.Function -> check_function () in
4907   let rec cl_type =
4908     {
4909        Types.partial = bool_of_partial part;
4910             kind = lazy (class_kind kind cl_type);
4911             named_elements = class_type_elements ctx kind cl_def
4912     } in
4913   Types.ClassType cl_type
4914
4915 and bool_of_partial = function
4916   | None -> false
4917   | Some Syntax.Partial -> true
4918
4919 and class_type_elements ctx kind cl_def = match evaluate cl_def.description with
4920   | LongDescription long_desc -> long_description_type_elements ctx kind long_desc
4921   | ShortDescription short_desc -> short_description_type_elements ctx kind short_desc
4922
4923 and short_description_type_elements ctx kind short_desc =
4924   let cl_type = evaluate short_desc.modified_class_type in
4925   let kind' = evaluate cl_type.Types.kind in
4926   match kind, kind' with
4927     | Types.Class, Types.Class |
4928       Types.Model, Types.Model |
4929       Types.Block, Types.Block |
4930       Types.Record, Types.Record |
4931       Types.ExpandableConnector, Types.ExpandableConnector |
4932       Types.Connector, Types.Connector |
4933       Types.Package, Types.Package |
4934       Types.Function, Types.Function -> cl_type.Types.named_elements
4935     | (Types.Class | Types.Model | Types.Block | Types.Record |
4936       Types.ExpandableConnector | Types.Connector | Types.Package | Types.Function),
4937       (Types.Class | Types.Model | Types.Block | Types.Record |
4938       Types.ExpandableConnector | Types.Connector | Types.Package | Types.Function) ->
4939         raise (CompilError
4940           {err_msg = ["_InheritFromDiffClassKindsNotAllowed"];
4941            err_info = [];
4942            err_ctx = ctx}) (*error*)
4943
4944 and long_description_type_elements ctx kind long_desc =
4945   let type_element (id, elt_desc) = id, elt_desc.element_type in
4946   let local_elts = List.map type_element long_desc.named_elements in
4947   let add_extensions kinds exts =
4948     let add_named_element protected named_elt named_elts =
4949       let element_type elt_type =
4950         let elt_type' = evaluate elt_type in
4951         { elt_type' with Types.protected =
4952             elt_type'.Types.protected || protected } in
4953       match named_elt with
4954       | id, _ when List.mem_assoc id named_elts ->
4955           raise (CompilError
4956             {err_msg = [id; "_AlreadyDeclaredInParentClass"];
4957              err_info = [];
4958              err_ctx = ctx}) (*error*)
4959       | id, elt_type -> (id, lazy (element_type elt_type)) :: named_elts in
4960     let add_extension_contribution (visibility, modif_cl) named_elts =
4961       let protected = bool_of_visibility visibility
4962       and cl_type = evaluate modif_cl.modified_class_type in
4963       let named_elts' = cl_type.Types.named_elements in
4964       if List.mem (evaluate cl_type.Types.kind) kinds then
4965         List.fold_right (add_named_element protected) named_elts' named_elts
4966       else
4967         raise (CompilError
4968           {err_msg = ["_InheritFromDiffClassKindsNotAllowed"];
4969            err_info = [];
4970            err_ctx = ctx}) (*error*) in
4971     List.fold_right add_extension_contribution exts local_elts in
4972   match kind, long_desc.extensions with
4973   | Types.Function, [] -> local_elts
4974   | Types.Function, _ :: _ ->
4975       raise (CompilError
4976         {err_msg = ["_InheritFromFunctionNotAllowed"];
4977          err_info = [];
4978          err_ctx = ctx}) (*error*)
4979   | (Types.Class | Types.Model | Types.Block | Types.Record | Types.Connector | Types.Package),
4980     exts -> add_extensions [kind] exts
4981   | Types.ExpandableConnector, exts ->
4982       add_extensions [kind; Types.Connector] exts
4983
4984 and bool_of_visibility = function
4985   | Public -> false
4986   | Protected -> true
4987
4988 and has_inouts cl_type =
4989   let is_inout_component cpnt_type =
4990     match evaluate cpnt_type.Types.causality with
4991       | Types.Input | Types.Output -> true
4992       | Types.Acausal -> false in
4993   let is_inout = function
4994     | Types.ComponentElement cpnt_type -> is_inout_component cpnt_type
4995     | Types.ClassElement _ | Types.ComponentTypeElement _ |
4996       Types.PredefinedTypeElement _ -> false
4997   and element_nature (_, elt_type) = (evaluate elt_type).Types.element_nature in
4998   List.exists
4999     (function named_elt -> is_inout (element_nature named_elt))
5000     cl_type.Types.named_elements
5001
5002 and component_type_of_expression ctx expr =
5003   match expr.info.type_description with
5004   | Types.ComponentElement cpnt_type -> cpnt_type
5005   | Types.ClassElement _ | Types.ComponentTypeElement _ |
5006     Types.PredefinedTypeElement _ ->
5007       raise (CompilError
5008         {err_msg = ["_ClassElemFoundInExpr"];
5009          err_info = [];
5010          err_ctx = ctx}) (*error*)
5011
5012 and scalar_class_specifier ctx expr =
5013   let rec scalar_class_specifier' cl_spec = match cl_spec with
5014     | Types.ArrayType (dim, cl_spec) ->
5015         scalar_class_specifier' cl_spec
5016     | _ -> cl_spec in
5017   let cpnt_type = component_type_of_expression ctx expr in
5018   let cl_spec = evaluate cpnt_type.Types.base_class in
5019   scalar_class_specifier' cl_spec
5020
5021 and expression_of_variable expr =
5022   let vector_variables vec_elts = match vec_elts.Syntax.nature with
5023     | Syntax.VectorReduction _ -> false
5024     | Syntax.VectorElements exprs ->
5025         List.for_all expression_of_variable exprs in
5026   match expr.Syntax.nature with
5027   | Syntax.Identifier _ -> true
5028   | Syntax.FieldAccess (expr', _) -> expression_of_variable expr'
5029   | Syntax.IndexedAccess (expr', subs) ->
5030       expression_of_variable expr'
5031   | Syntax.MatrixConstruction exprss ->
5032       List.for_all (List.for_all expression_of_variable) exprss
5033   | Syntax.Tuple exprs ->
5034       List.for_all expression_of_variable exprs
5035   | Syntax.Vector vec_elts -> vector_variables vec_elts
5036   | _ -> false
5037
5038 and string_of_bin_oper_kind kind = match kind with
5039   | And -> " and "
5040   | Divide -> " / "
5041   | EqualEqual -> " == "
5042   | GreaterEqual -> " >= "
5043   | Greater -> " > "
5044   | LessEqual -> " <= "
5045   | Less -> " < "
5046   | Times -> " * "
5047   | NotEqual -> " <> "
5048   | Or -> " or "
5049   | Plus -> " + "
5050   | Power -> " ^ "
5051   | Minus -> " - "
5052
5053 and string_of_un_oper_kind kind = match kind with
5054   | Not -> " not "
5055   | UnaryMinus -> "- "
5056   | UnaryPlus -> "+ "
5057
5058 and apply_binary_coercions exprs =
5059   let base_type expr =
5060     let rec base_type' cl_spec = match cl_spec with
5061       | Types.ArrayType (_, cl_spec) -> base_type' cl_spec
5062       | Types.PredefinedType pt -> Some pt.Types.base_type
5063       | _ -> None in
5064     match expr.info.type_description with
5065     | Types.ComponentElement cpnt_type ->
5066         let cl_spec = evaluate cpnt_type.Types.base_class in
5067         base_type' cl_spec
5068     | _ -> None
5069   and real_type bt = match bt with
5070     | Some Types.RealType -> true
5071     | _ -> false
5072   and integer_type bt = match bt with
5073     | Some Types.IntegerType -> true
5074     | _ -> false in
5075   match List.map base_type exprs with
5076   | [] | [ _ ] -> exprs
5077   | bts when (List.exists real_type bts) &&
5078     (List.exists integer_type bts) ->
5079       let cpnt_type = Types.real_component_type Types.Continuous in
5080       List.map (apply_rhs_coercions cpnt_type) exprs
5081   | _ -> exprs
5082
5083 and apply_rhs_coercions cpnt_type expr =
5084   let apply_real_of_integer cpnt_type cpnt_type' =
5085     let rec apply_real_of_integer' cl_spec cl_spec' =
5086       match cl_spec, cl_spec' with
5087       | Types.ArrayType (dim, cl_spec), _ ->
5088           apply_real_of_integer' cl_spec cl_spec'
5089       | _, Types.ArrayType (dim', cl_spec') ->
5090           let coer, cl_spec' = apply_real_of_integer' cl_spec cl_spec' in
5091           coer, Types.ArrayType (dim', cl_spec')
5092       | Types.PredefinedType { Types.base_type = Types.RealType },
5093         Types.PredefinedType { Types.base_type = Types.IntegerType } ->
5094           Some RealOfInteger, Types.real_class_type
5095       | _, _ -> None, cl_spec' in
5096     let cl_spec = evaluate cpnt_type.Types.base_class
5097     and cl_spec' = evaluate cpnt_type'.Types.base_class in
5098     match apply_real_of_integer' cl_spec cl_spec' with
5099     | Some RealOfInteger, cl_spec' ->
5100         let cpnt_type' =
5101           {
5102             cpnt_type' with
5103             Types.base_class = lazy cl_spec'
5104           }
5105         and nat' = Coercion (RealOfInteger, expr) in
5106         let elt_nat' = Types.ComponentElement cpnt_type' in
5107         resolved_expression expr.info.syntax nat' elt_nat'
5108     | _ -> expr in
5109   match expr.info.type_description with
5110   | Types.ComponentElement cpnt_type' ->
5111       apply_real_of_integer cpnt_type cpnt_type'
5112   | _ -> expr
5113
5114 (* for debug *)
5115 and string_of_expression expr = match expr.nature with
5116   | BinaryOperation (bin_oper_kind, expr, expr') ->
5117       Printf.sprintf "BinaryOperation(_, %s, %s)"
5118         (string_of_expression expr)
5119         (string_of_expression expr')
5120   | DynamicIdentifier (i, s) -> "DynamicIdentifier"
5121   | False -> "False"
5122   | FieldAccess (expr, s) -> "FieldAccess"
5123   | FunctionArgument i -> "FunctionArgument"
5124   | FunctionCall (expr, exprs, expr') ->
5125       Printf.sprintf "FunctionCall(%s, {%s}, %s)"
5126         (string_of_expression expr)
5127         (String.concat "," (List.map string_of_expression exprs))
5128         (string_of_expression expr') 
5129   | FunctionInvocation exprs -> "FunctionInvocation"
5130   | If (alts, expr) -> "If"
5131   | IndexedAccess (expr, exprs) -> "IndexedAccess"
5132   | Integer i ->
5133       Printf.sprintf "Integer(%d)" (Int32.to_int i)
5134   | LocalIdentifier (i, s) ->
5135       Printf.sprintf "LocalIdentifier(%d, %s)" i s
5136   | LoopVariable i -> "LoopVariable"
5137   | NoEvent expr -> "NoEvent"
5138   | PredefinedIdentifier s ->
5139       Printf.sprintf "PredefinedIdentifier(%s)" s
5140   | Range (start, step, stop) ->
5141       Printf.sprintf "Range(%s, %s, %s)"
5142         (string_of_expression start)
5143         (string_of_expression step)
5144         (string_of_expression stop)
5145   | Real f -> "Real"
5146   | String s -> "String"
5147   | ToplevelIdentifier s -> "ToplevelIdentifier"
5148   | True -> "True"
5149   | Tuple exprs -> "Tuple"
5150   | UnaryOperation (un_oper_kind, expr) -> "UnaryOperation"
5151   | Vector exprs -> "Vector"
5152   | VectorReduction (exprs, expr) -> "VectorReduction"
5153   | Coercion _ -> "Coercion"