2 * Translator from Modelica 2.x to flat Modelica
4 * Copyright (C) 2005 - 2007 Imagine S.A.
5 * For more information or commercial use please contact us at www.amesim.com
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.
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.
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.
23 (** The main functions are:
25 {- [ generate_code ]: main function
27 {- [ collect_function_definitions ]: Collect function definitions }
28 {- [ generate_component_description ]: Generate component descriptions
30 {- [ collect_component_elements ]: Returns a [ flat_instance ] containing all variables and equations
32 {- [ expand_equations ]: Generation of connect equations }
33 {- [ introduce_derivative_variables ]: Introduce derivative variables}
36 {- [ generate_dynamic_description ]: Generate the dynamic Model description
38 {- [ generate_flatten_instance ]: Dynamic model description as flat Modelica }
39 {- [ generate_flatten_XML ]: if the "-xml" option is activated }
42 {- [ generate_function_definitions ]: Generate function definitions in a file named filename_functions.mo }
43 {- [ generate_initial_description ]: Generate initialization description in a file named filename_init.xml,
44 and abstract relations in a file named filename_relations.xml.
46 {- [ generate_flatten_XML ]: Generates an XML description of initialization problem }
47 {- [ generate_relations ]: Generates an XML description of abstract relations and other informations }
56 open ErrorDico (* To have access to GenericError *)
60 variables: Instantiation.component_description list;
61 dynamic_equations: Instantiation.equation_desc list;
62 initial_equations: Instantiation.equation_desc list;
63 abstract_relations: abstract_relation list
66 and function_description =
68 inputs: (string * Types.class_specifier) list;
69 outputs: (string * Types.class_specifier) list
72 and abstract_relation =
73 | Rel of Instantiation.component_description list
75 and 'a tree = Leaf of (string * 'a) | Node of string * 'a tree list
82 initial_value: Instantiation.expression option;
83 (* nominal_value: Instantiation.expression option;
109 let evaluate t = Lazy.force t
111 (* Remove enclosing parenthesis *)
113 let n = String.length s in
115 match s.[0], s.[n - 1] with
116 | '(', ')' -> String.sub s 1 (n - 2)
121 (* function used to hide XML special characters *)
123 let encoded_s = ref "" in
124 let hide_special_character c = match c with
125 | '<' -> encoded_s := !encoded_s ^ "<"
126 | '>' -> encoded_s := !encoded_s ^ ">"
127 | '&' -> encoded_s := !encoded_s ^ "&"
128 | '\'' -> encoded_s := !encoded_s ^ "'"
129 | '\"' -> encoded_s := !encoded_s ^ """
130 | _ -> encoded_s := !encoded_s ^ (String.make 1 c) in
131 String.iter hide_special_character s;
135 (* Code generation functions *)
137 let rec generate_code xml init filename inst_defs =
139 List.fold_left collect_function_definitions [] inst_defs in
140 let add_instance_element acc (id, elt_desc) =
141 match evaluate elt_desc.Instantiation.element_nature with
142 | Instantiation.Class _ -> acc
143 | Instantiation.Component cpnt_desc -> (id, cpnt_desc) :: acc in
144 match List.fold_left add_instance_element [] inst_defs with
146 | [ id, cpnt_desc ] ->
147 generate_component_description xml init filename fun_defs id cpnt_desc
150 and collect_function_definitions fun_defs (id, elt_desc) =
151 match evaluate elt_desc.Instantiation.element_nature with
152 | Instantiation.Class cl_def ->
155 path = cl_def.Instantiation.class_path;
156 location = cl_def.Instantiation.class_location;
157 instance_nature = Instantiation.ClassElement
159 let cl_spec = cl_def.Instantiation.class_type in
161 collect_function_definitions_in_class_specifier ctx cl_spec
162 | Instantiation.Component cpnt_desc ->
165 path = cpnt_desc.Instantiation.component_path;
166 location = cpnt_desc.Instantiation.component_location;
168 Instantiation.ComponentElement cpnt_desc.Instantiation.class_name
171 collect_function_definitions_in_component ctx cpnt_desc
173 and collect_function_definitions_in_class_specifier ctx = function
174 | Types.PredefinedType _ | Types.ComponentType _ | Types.ArrayType _ |
175 Types.TupleType _ -> []
176 | Types.ClassType cl_type ->
177 collect_function_definition_in_class_type ctx cl_type
179 and collect_function_definition_in_class_type ctx cl_type =
180 let fun_defs = collect_inner_functions ctx cl_type in
181 collect_function ctx fun_defs cl_type
183 and collect_inner_functions ctx cl_type =
184 match evaluate cl_type.Types.kind with
185 | Types.Class | Types.Model | Types.Block | Types.Package |
187 let named_elts = cl_type.Types.named_elements in
189 (collect_function_definitions_in_type ctx)
192 | Types.Record | Types.ExpandableConnector | Types.Connector -> []
194 and collect_function_definitions_in_type ctx fun_defs (id, elt_type) =
195 let elt_type' = evaluate elt_type in
196 match elt_type'.Types.dynamic_scope, elt_type'.Types.element_nature with
197 | None, Types.ClassElement cl_spec ->
201 path = ctx.path @ [Instantiation.Name id]
203 let cl_spec' = evaluate cl_spec in
205 collect_function_definitions_in_class_specifier ctx' cl_spec' in
209 (Types.ComponentElement _ | Types.ComponentTypeElement _ |
210 Types.PredefinedTypeElement _) -> fun_defs
212 and collect_function ctx fun_defs cl_type =
213 match evaluate cl_type.Types.kind with
215 let named_elts = cl_type.Types.named_elements in
216 function_description_of_named_elements ctx named_elts :: fun_defs
217 | Types.Class | Types.Model | Types.Block | Types.Record |
218 Types.ExpandableConnector | Types.Connector| Types.Package -> fun_defs
220 and function_description_of_named_elements ctx named_elts =
221 let collect_input_or_output (id, elt_type) fun_desc =
222 let collect_input_or_output' cpnt_type =
223 match evaluate cpnt_type.Types.causality with
225 let cl_spec = evaluate cpnt_type.Types.base_class in
226 { fun_desc with inputs = (id, cl_spec) :: fun_desc.inputs }
228 let cl_spec = evaluate cpnt_type.Types.base_class in
229 { fun_desc with outputs = (id, cl_spec) :: fun_desc.outputs }
230 | Types.Acausal -> fun_desc in
231 let elt_type' = evaluate elt_type in
232 match elt_type'.Types.element_nature with
233 | Types.ComponentElement cpnt_type ->
234 collect_input_or_output' cpnt_type
235 | Types.ClassElement _ | Types.ComponentTypeElement _ |
236 Types.PredefinedTypeElement _ -> fun_desc in
237 let fun_desc = { inputs = []; outputs = [] } in
239 List.fold_right collect_input_or_output named_elts fun_desc
241 and collect_function_definitions_in_component ctx cpnt_desc =
242 match evaluate cpnt_desc.Instantiation.component_nature with
243 | Instantiation.DynamicArray cpnt_desc ->
245 { ctx with path = ctx.path @ [Instantiation.Index 0] } in
246 collect_function_definitions_in_component ctx' cpnt_desc
247 | Instantiation.Instance inst ->
248 let elts = evaluate inst.Instantiation.elements in
249 let named_elts = elts.Instantiation.named_elements in
250 List.fold_left collect_function_definitions [] named_elts
251 | Instantiation.PredefinedTypeInstance _ -> []
252 | Instantiation.StaticArray [||] -> []
253 | Instantiation.StaticArray cpnt_descs ->
255 { ctx with path = ctx.path @ [Instantiation.Index 0] } in
256 collect_function_definitions_in_component ctx' cpnt_descs.(0)
258 and generate_function_definition oc acc (ctx, fun_desc) =
259 let ext_name = Printf.sprintf "%s" (last_id ctx.path)
260 and name = string_of_path ctx.path in
261 match List.mem ext_name acc with
264 Printf.fprintf oc "function %s \"%s\"\n" ext_name name;
265 List.iter (generate_function_inout ctx oc "input") fun_desc.inputs;
266 List.iter (generate_function_inout ctx oc "output") fun_desc.outputs;
267 Printf.fprintf oc "external;\nend %s;\n" ext_name;
270 and generate_function_inout ctx oc inout (id, cl_spec) =
271 let generate_dimensions ndims =
272 let rec generate_dimensions' ndims =
275 | 1 -> Printf.fprintf oc ":"
276 | _ -> Printf.fprintf oc ":, "; generate_dimensions' (ndims - 1) in
280 Printf.fprintf oc "[";
281 generate_dimensions' ndims;
282 Printf.fprintf oc "]" in
283 let rec generate_function_inout' cl_spec ndims = match cl_spec with
284 | Types.PredefinedType { Types.base_type = Types.RealType } ->
285 Printf.fprintf oc "\t%s Real" inout;
286 generate_dimensions ndims;
287 Printf.fprintf oc " %s;\n" id
288 | Types.PredefinedType { Types.base_type = Types.IntegerType }
289 when ndims = 0 && inout = "input" ->
290 Printf.fprintf oc "\t%s Integer %s;\n" inout id
291 | Types.PredefinedType { Types.base_type = Types.StringType }
292 when ndims = 0 && inout = "input" ->
293 Printf.fprintf oc "\t%s String %s;\n" inout id
294 | Types.ArrayType (_, cl_spec) when inout = "input" ->
295 generate_function_inout' cl_spec (ndims + 1)
299 ["_NotYetImplemented"; "_NonSupportedTypeOfFuncInOut"; id];
302 generate_function_inout' cl_spec 0
304 and generate_component_description xml init filename fun_defs id cpnt_desc =
305 let chop_extension s = try Filename.chop_extension s with _ -> s in
306 let filename = match filename with
308 | Some s -> chop_extension s in
311 path = cpnt_desc.Instantiation.component_path;
312 location = cpnt_desc.Instantiation.component_location;
314 Instantiation.ComponentElement cpnt_desc.Instantiation.class_name
316 and flat_inst = collect_component_elements cpnt_desc in
317 generate_dynamic_description ctx xml filename fun_defs id flat_inst;
318 generate_function_definitions ctx filename fun_defs;
320 generate_initial_description ctx filename fun_defs id flat_inst
322 and generate_dynamic_description ctx xml filename fun_defs id flat_inst =
323 let vars = flat_inst.variables
324 and equs = flat_inst.dynamic_equations
325 and ext = if xml then ".xml" else ".mo" in
326 let oc = open_out (filename ^ ext) in
329 generate_flatten_XML ctx fun_defs oc id vars equs
331 generate_flatten_instance ctx fun_defs oc id vars equs;
333 with exn -> close_out oc; raise exn
335 and generate_initial_description ctx filename fun_defs id flat_inst =
336 let oc = open_out (filename ^ "_init.xml") in
338 let varss = List.map (function Rel r -> r) flat_inst.abstract_relations in
340 List.fold_left add_component flat_inst.variables (List.flatten varss)
341 and equs = flat_inst.initial_equations in
342 generate_flatten_XML ctx fun_defs oc id vars equs;
343 generate_relations filename vars flat_inst.abstract_relations;
345 with exn -> close_out oc; raise exn
347 and generate_function_definitions ctx filename fun_defs =
348 let generate_function_definitions' oc =
350 let _ = List.fold_left (generate_function_definition oc) [] fun_defs in
352 with exn -> close_out oc; raise exn in
356 let oc = open_out (filename ^ "_functions.mo") in
357 generate_function_definitions' oc
359 and collect_component_elements cpnt_desc =
361 {path = cpnt_desc.Instantiation.component_path;
362 location = cpnt_desc.Instantiation.component_location;
364 Instantiation.ComponentElement cpnt_desc.Instantiation.class_name} in
365 match evaluate cpnt_desc.Instantiation.component_nature with
366 | Instantiation.DynamicArray _ ->
368 { err_msg = ["_NotYetImplemented"; "_DynamicArrayType"];
371 | Instantiation.Instance inst -> collect_instance_elements ctx inst
372 | Instantiation.PredefinedTypeInstance _
373 when is_fixed_parameter cpnt_desc ->
376 dynamic_equations = [];
377 initial_equations = [];
378 abstract_relations = []
380 | Instantiation.PredefinedTypeInstance _ ->
381 let decl_equs = collect_declaration_equation cpnt_desc in
383 variables = [ cpnt_desc ];
384 dynamic_equations = decl_equs;
385 initial_equations = decl_equs;
386 abstract_relations = []
388 | Instantiation.StaticArray cpnt_descs ->
389 collect_array_elements cpnt_descs
391 and collect_instance_elements ctx inst =
392 let elts = evaluate inst.Instantiation.elements in
393 let named_elts = elts.Instantiation.named_elements
394 and unnamed_elts = elts.Instantiation.unnamed_elements in
395 let flat_inst = collect_instance_named_elements named_elts
396 and dyn_equs, init_equs =
397 List.fold_left (collect_equations ctx) ([], []) unnamed_elts in
398 let init_equs, rels =
400 (introduce_derivative_variables ctx)
402 (dyn_equs @ init_equs) in
404 dynamic_equations = flat_inst.dynamic_equations @ dyn_equs;
405 initial_equations = flat_inst.initial_equations @ init_equs;
406 abstract_relations = flat_inst.abstract_relations @ rels
409 and collect_instance_named_elements named_elts =
410 let collect_instance_named_elements' flat_inst (_, elt_desc) =
411 let elt_nat = evaluate elt_desc.Instantiation.element_nature in
413 | Instantiation.Class _ -> flat_inst
414 | Instantiation.Component cpnt_desc ->
415 let flat_inst' = collect_component_elements cpnt_desc in
417 variables = flat_inst.variables @ flat_inst'.variables;
419 flat_inst.dynamic_equations @ flat_inst'.dynamic_equations;
421 flat_inst.initial_equations @ flat_inst'.initial_equations;
423 flat_inst.abstract_relations @ flat_inst'.abstract_relations
428 dynamic_equations = [];
429 initial_equations = [];
430 abstract_relations = []
432 List.fold_left collect_instance_named_elements' flat_inst named_elts
434 and introduce_derivative_variables ctx (init_equs, rels) equ =
435 let rec introduce_derivative_variables' expr = match expr with
436 | Instantiation.BinaryOperation (oper_kind, expr1, expr2) ->
437 let expr1, cpnt_descs1 = introduce_derivative_variables' expr1
438 and expr2, cpnt_descs2 = introduce_derivative_variables' expr2 in
439 Instantiation.BinaryOperation (oper_kind, expr1, expr2),
440 cpnt_descs1 @ cpnt_descs2
441 | Instantiation.FunctionCall
442 (Instantiation.PredefinedIdentifier "der",
443 [ Instantiation.ComponentReference cpnt_desc ]) ->
444 let cpnt_desc' = component_derivative cpnt_desc in
445 Instantiation.ComponentReference cpnt_desc',
447 | Instantiation.FunctionCall
448 (Instantiation.PredefinedIdentifier "der", _) ->
450 { err_msg = ["_NotYetImplemented"; "_UnsupportedDerOperArg"];
452 err_ctx = ctx }) (*error*)
453 | Instantiation.If (alts, default) ->
455 let cond, cpnt_descs1 = introduce_derivative_variables' cond
456 and expr, cpnt_descs2 = introduce_derivative_variables' expr in
457 (cond, expr), cpnt_descs1 @ cpnt_descs2 in
458 let alts, cpnt_descss = List.split (List.map f alts) in
459 let default, cpnt_descs' = introduce_derivative_variables' default in
460 Instantiation.If (alts, default),
461 (List.flatten cpnt_descss) @ cpnt_descs'
462 | Instantiation.IndexedAccess (expr, exprs) ->
463 let expr, cpnt_descs = introduce_derivative_variables' expr in
464 Instantiation.IndexedAccess (expr, exprs),
466 | Instantiation.NoEvent expr ->
467 let expr, cpnt_descs = introduce_derivative_variables' expr in
468 Instantiation.NoEvent expr,
470 | Instantiation.UnaryOperation (oper_kind, expr) ->
471 let expr, cpnt_descs = introduce_derivative_variables' expr in
472 Instantiation.UnaryOperation (oper_kind, expr),
474 | Instantiation.VectorReduction (exprs, expr) ->
475 let expr, cpnt_descs = introduce_derivative_variables' expr in
476 Instantiation.VectorReduction (exprs, expr),
478 | Instantiation.Record record_elts ->
480 let expr, cpnt_descs = introduce_derivative_variables' expr in
481 (id, expr), cpnt_descs in
482 let record_elts, cpnt_descs = List.split (List.map f record_elts) in
483 Instantiation.Record record_elts,
484 List.flatten cpnt_descs
485 | Instantiation.Tuple exprs ->
486 let exprs' = List.map introduce_derivative_variables' exprs in
487 let exprs', cpnt_descs' = List.split exprs' in
488 Instantiation.Tuple exprs',
489 List.flatten cpnt_descs'
490 | Instantiation.Vector exprs ->
491 let exprs' = Array.map introduce_derivative_variables' exprs in
492 let exprs', cpnt_descs' = List.split (Array.to_list exprs') in
493 Instantiation.Vector (Array.of_list exprs'),
494 List.flatten cpnt_descs'
495 | Instantiation.FunctionCall (expr, exprs) ->
496 let exprs' = List.map introduce_derivative_variables' exprs in
497 let exprs', cpnt_descs' = List.split exprs' in
498 Instantiation.FunctionCall (expr, exprs'),
499 List.flatten cpnt_descs'
500 | Instantiation.ComponentReference cpnt_desc -> expr, [ cpnt_desc ]
503 | Instantiation.Equal (expr1, expr2) ->
504 let expr1, cpnt_descs1 = introduce_derivative_variables' expr1
505 and expr2, cpnt_descs2 = introduce_derivative_variables' expr2 in
507 List.fold_left add_component [] (cpnt_descs1 @ cpnt_descs2) in
508 (Instantiation.Equal (expr1, expr2)) :: init_equs,
509 (Rel cpnt_descs) :: rels
510 | Instantiation.ConnectFlows _ | Instantiation.ConditionalEquationE _ |
511 Instantiation.WhenClauseE _ -> init_equs, rels
513 and collect_equations ctx (dyn_equs, init_equs) unnamed_elt =
514 match unnamed_elt with
515 | Instantiation.EquationClause (NameResolve.Permanent, equs) ->
516 dyn_equs @ (expand_equations ctx (evaluate equs)), init_equs
517 | Instantiation.EquationClause (NameResolve.Initial, equs) ->
518 dyn_equs, init_equs @ (expand_equations ctx (evaluate equs))
519 | Instantiation.AlgorithmClause _ ->
521 { err_msg = ["_NotYetImplemented"; "_AlgorithmClause"];
523 err_ctx = ctx }) (*error*)
525 and expand_equations ctx equs =
526 let expand_equation equ = equ.Instantiation.nature in
527 let add_connection (expr, sign) (expr', sign') cnect_sets =
528 let contains_at_least_one_node_to_connect cnect_set =
529 List.mem_assoc expr cnect_set || List.mem_assoc expr' cnect_set in
530 let cnect_sets, cnect_sets' =
531 List.partition contains_at_least_one_node_to_connect cnect_sets in
532 match cnect_sets with
533 | [] -> [(expr, sign); (expr', sign')] :: cnect_sets'
534 | [cnect_set; cnect_set'] -> (cnect_set @ cnect_set') :: cnect_sets'
535 | [cnect_set] when List.mem_assoc expr cnect_set ->
536 ((expr', sign') :: cnect_set) :: cnect_sets'
537 | [cnect_set] -> ((expr, sign) :: cnect_set) :: cnect_sets'
538 | _ :: _ :: _ :: _ -> assert false in
539 let expand_connection cnect_sets = function
540 | Instantiation.ConnectFlows (sign, expr, sign', expr') ->
541 add_connection (expr, sign) (expr', sign') cnect_sets
542 | Instantiation.Equal _ | Instantiation.ConditionalEquationE _ |
543 Instantiation.WhenClauseE _ -> cnect_sets in
544 let generate_flow_equation cnect_set =
545 let to_expression (expr, sign) = match sign with
546 | NameResolve.Positive -> expr
547 | NameResolve.Negative ->
548 Instantiation.UnaryOperation (Instantiation.UnaryMinus, expr) in
549 let add_expressions expr expr' =
550 Instantiation.BinaryOperation (Instantiation.Plus, expr, expr') in
551 let exprs = List.map to_expression cnect_set in
552 let lhs = List.fold_left add_expressions (Instantiation.Real 0.) exprs in
553 Instantiation.Equal (lhs, Instantiation.Real 0.) in
554 let collect_equation equs equ = match equ with
555 | Instantiation.ConnectFlows _ -> equs
556 | Instantiation.Equal _ | Instantiation.ConditionalEquationE _ |
557 Instantiation.WhenClauseE _ -> equ :: equs in
558 let equ_descs = List.flatten (List.map expand_equation equs) in
559 let cnect_sets = List.fold_left expand_connection [] equ_descs
560 and equs = List.fold_left collect_equation [] equ_descs in
561 let equs' = List.map generate_flow_equation cnect_sets in
564 and collect_array_elements cpnt_descs =
565 let rec collect_array_elements' flat_inst i =
566 if i = Array.length cpnt_descs then flat_inst
568 let flat_inst' = collect_component_elements cpnt_descs.(i) in
571 variables = flat_inst.variables @ flat_inst'.variables;
573 flat_inst.dynamic_equations @ flat_inst'.dynamic_equations;
575 flat_inst.initial_equations @ flat_inst'.initial_equations;
577 flat_inst.abstract_relations @ flat_inst'.abstract_relations
579 collect_array_elements' flat_inst (i + 1) in
583 dynamic_equations = [];
584 initial_equations = [];
585 abstract_relations = []
587 collect_array_elements' flat_inst 0
589 and collect_declaration_equation cpnt_desc =
590 let var = cpnt_desc.Instantiation.variability
591 and equ = cpnt_desc.Instantiation.declaration_equation in
593 | (Types.Continuous | Types.Discrete), Some expr ->
594 let expr' = Instantiation.ComponentReference cpnt_desc in
595 [ Instantiation.Equal (expr', evaluate expr) ]
598 and generate_flatten_instance ctx fun_defs oc id vars equs =
599 Printf.fprintf oc "class %s\n" id;
600 List.iter (generate_variable_declaration ctx oc) vars;
601 Printf.fprintf oc "equation\n";
602 generate_equation_descriptions ctx fun_defs oc equs;
603 Printf.fprintf oc "end %s;\n" id
605 and generate_variable_declaration ctx oc cpnt_desc =
606 Printf.fprintf oc "\t";
607 generate_variable_variability oc cpnt_desc;
608 generate_variable_causality oc cpnt_desc;
609 generate_variable_type ctx oc cpnt_desc;
610 generate_variable_name oc cpnt_desc;
611 generate_variable_start_value ctx oc cpnt_desc;
612 generate_initialization ctx oc cpnt_desc;
613 generate_comment oc cpnt_desc;
614 Printf.fprintf oc ";\n"
616 and generate_variable_variability oc cpnt_desc =
617 match cpnt_desc.Instantiation.variability with
618 | Types.Constant -> Printf.fprintf oc "constant "
619 | Types.Parameter -> Printf.fprintf oc "parameter "
620 | Types.Discrete -> Printf.fprintf oc "discrete "
621 | Types.Continuous -> ()
623 and generate_variable_causality oc cpnt_desc =
624 let inout = cpnt_desc.Instantiation.causality in
626 | Types.Input -> Printf.fprintf oc "input "
627 | Types.Output -> Printf.fprintf oc "output "
628 | Types.Acausal -> ()
630 and generate_variable_type ctx oc cpnt_desc =
631 let generate_variable_type' predef =
632 let var = cpnt_desc.Instantiation.variability in
633 match predef.Instantiation.predefined_type, var with
634 | Instantiation.IntegerType, Types.Parameter ->
635 Printf.fprintf oc "Integer "
636 | Instantiation.IntegerType, _ ->
638 { err_msg = ["_NotYetImplemented"; "_IntegerType"];
640 err_ctx = ctx }) (*error*)
641 | Instantiation.RealType, _ -> Printf.fprintf oc "Real "
642 | Instantiation.BooleanType, _ ->
644 { err_msg = ["_NotYetImplemented"; "_BooleanType"];
646 err_ctx = ctx }) (*error*)
647 | Instantiation.StringType, Types.Parameter ->
648 Printf.fprintf oc "String "
649 | Instantiation.StringType, _ ->
651 { err_msg = ["_NotYetImplemented"; "_StringType"];
653 err_ctx = ctx }) (*error*)
654 | Instantiation.EnumerationType, _ ->
656 { err_msg = ["_NotYetImplemented"; "_EnumType"];
658 err_ctx = ctx }) (*error*) in
659 let var_type = evaluate cpnt_desc.Instantiation.component_nature in
661 | Instantiation.PredefinedTypeInstance predef ->
662 generate_variable_type' predef
663 | Instantiation.DynamicArray _ ->
665 { err_msg = ["_NotYetImplemented"; "_DynamicArrayType"];
667 err_ctx = ctx }) (*error*)
668 | Instantiation.Instance _ ->
670 { err_msg = ["_NotYetImplemented"; "_InstanceType"];
672 err_ctx = ctx }) (*error*)
673 | Instantiation.StaticArray _ ->
675 { err_msg = ["_NotYetImplemented"; "_StaticArrayType"];
677 err_ctx = ctx }) (*error*)
679 and generate_variable_name oc cpnt_desc =
680 let name = ident_of_path cpnt_desc.Instantiation.component_path in
681 Printf.fprintf oc "%s" name
683 and generate_variable_start_value ctx oc cpnt_desc =
684 let generate_start_value attrs =
686 let expr = evaluate (List.assoc "start" attrs) in
687 Printf.fprintf oc "(start=%s)"
688 (string_of_expression ctx [] expr)
689 with Not_found -> () in
690 let generate_variable_start_value' predef =
691 let attrs = predef.Instantiation.attributes in
692 generate_start_value attrs in
693 let var_type = evaluate cpnt_desc.Instantiation.component_nature in
695 | Instantiation.PredefinedTypeInstance predef ->
696 generate_variable_start_value' predef
697 | Instantiation.DynamicArray _ ->
699 { err_msg = ["_NotYetImplemented"; "_DynamicArrayType"];
701 err_ctx = ctx }) (*error*)
702 | Instantiation.Instance _ ->
704 { err_msg = ["_NotYetImplemented"; "_InstanceType"];
706 err_ctx = ctx }) (*error*)
707 | Instantiation.StaticArray _ ->
709 { err_msg = ["_NotYetImplemented"; "_StaticArrayType"];
711 err_ctx = ctx }) (*error*)
713 and string_of_path = function
715 | [Instantiation.Name id] -> id
716 | [Instantiation.Index i] -> Printf.sprintf "[%d]" (i + 1)
717 | Instantiation.Name id :: path ->
718 Printf.sprintf "%s.%s" id (string_of_path path)
719 | Instantiation.Index i :: path ->
720 Printf.sprintf "[%d].%s" (i + 1) (string_of_path path)
722 and ident_of_path path =
723 let rec ident_of_path' path =
726 | [Instantiation.Name id] -> unquoted id
727 | [Instantiation.Index i] -> Printf.sprintf "[%d]" (i + 1)
728 | Instantiation.Name id :: path ->
729 Printf.sprintf "%s.%s" (unquoted id) (ident_of_path' path)
730 | Instantiation.Index i :: path ->
731 Printf.sprintf "[%d].%s" (i + 1) (ident_of_path' path) in
734 | [Instantiation.Name id] -> assert false
735 | [Instantiation.Index i] -> assert false
736 | Instantiation.Name id :: path ->
737 Printf.sprintf "`%s`" (ident_of_path' path)
738 | Instantiation.Index i :: path -> assert false
741 let n = String.length id in
744 | '`' | '\'' -> String.sub id 1 (n - 2)
749 and generate_initialization ctx oc cpnt_desc =
750 let var = cpnt_desc.Instantiation.variability
751 and equ = cpnt_desc.Instantiation.declaration_equation in
753 | Types.Parameter, Some expr ->
754 Printf.fprintf oc " = %s"
755 (string_of_expression ctx [] (evaluate expr))
758 and generate_comment oc cpnt_desc =
759 Printf.fprintf oc " \"%s\"" cpnt_desc.Instantiation.comment
761 and generate_equation_descriptions ctx fun_defs oc equ_descs =
762 List.iter (generate_equation_description ctx fun_defs oc) equ_descs
764 and generate_equation_description ctx fun_defs oc equ_desc =
766 | Instantiation.Equal (expr, expr') ->
767 Printf.fprintf oc "%s" (string_of_equal ctx fun_defs expr expr')
768 | Instantiation.ConditionalEquationE _ -> assert false
769 | Instantiation.ConnectFlows _ -> assert false
770 | Instantiation.WhenClauseE alts ->
771 generate_when_clause ctx fun_defs oc alts
773 and string_of_equal ctx fun_defs expr expr' = match expr with
774 | Instantiation.Tuple [] ->
775 Printf.sprintf "\t%s;\n"
776 (string_of_expression ctx fun_defs expr')
778 Printf.sprintf "\t%s = %s;\n"
779 (string_of_expression ctx fun_defs expr)
780 (string_of_expression ctx fun_defs expr')
782 and generate_when_clause ctx fun_defs oc alts = match alts with
784 | [ (expr, equs) ] ->
785 Printf.fprintf oc "when %s then\n"
786 (string_of_expression ctx fun_defs expr);
787 List.iter (generate_when_equation ctx fun_defs oc) equs;
788 Printf.fprintf oc "end when;\n"
789 | (expr, equs) :: alts ->
790 Printf.fprintf oc "when %s then\n"
791 (string_of_expression ctx fun_defs expr);
792 List.iter (generate_when_equation ctx fun_defs oc) equs;
793 Printf.fprintf oc "else";
794 generate_when_clause ctx fun_defs oc alts
796 and generate_when_equation ctx fun_defs oc equ =
797 let equ' = equ.Instantiation.nature in
798 generate_equation_descriptions ctx fun_defs oc equ'
800 and string_of_expression ctx fun_defs = function
801 | Instantiation.BinaryOperation (bin_op, expr, expr') ->
802 string_of_binary_operation ctx fun_defs bin_op expr expr'
803 | Instantiation.ClassReference cl_def ->
804 string_of_class_reference fun_defs cl_def
805 | Instantiation.ComponentReference cpnt_desc ->
806 ident_of_path cpnt_desc.Instantiation.component_path
807 | Instantiation.EnumerationElement _ ->
809 { err_msg = [ "_NotYetImplemented";
813 err_ctx = ctx }) (*error*)
814 | Instantiation.False ->
816 { err_msg = ["_NotYetImplemented"; "_Expr"; "false"];
818 err_ctx = ctx }) (*error*)
819 | Instantiation.FieldAccess _ ->
821 { err_msg = ["_NotYetImplemented"; "_FieldAccessExpr"];
823 err_ctx = ctx }) (*error*)
824 | Instantiation.FunctionCall (expr, exprs) ->
825 string_of_function_call ctx fun_defs expr exprs
826 | Instantiation.If (alts, expr) ->
827 string_of_if ctx fun_defs alts expr
828 | Instantiation.IndexedAccess _ ->
830 { err_msg = ["_NotYetImplemented"; "_IndexedAccessExpr"];
832 err_ctx = ctx }) (*error*)
833 | Instantiation.Integer i when Int32.to_int i >= 0 ->
834 Printf.sprintf "%ld" i
835 | Instantiation.Integer i ->
836 let expr = Instantiation.Integer (Int32.neg i)
837 and un_op = Instantiation.UnaryMinus in
838 string_of_unary_operation ctx fun_defs un_op expr
839 | Instantiation.LoopVariable _ ->
841 { err_msg = ["_NotYetImplemented"; "_LoopVar"];
843 err_ctx = ctx }) (*error*)
844 | Instantiation.NoEvent expr -> string_of_no_event ctx fun_defs expr
845 | Instantiation.PredefinedIdentifier id -> Printf.sprintf "%s" id
846 | Instantiation.Range _ ->
848 { err_msg = ["_NotYetImplemented"; "_RangeExpr"];
850 err_ctx = ctx }) (*error*)
851 | Instantiation.Real f ->
852 Printf.sprintf "%s" (string_of_float f)
853 | Instantiation.Record _ ->
855 { err_msg = ["_NotYetImplemented"; "_ExprOfType"; "record"];
857 err_ctx = ctx }) (*error*)
858 | Instantiation.String s -> Printf.sprintf "\"%s\"" s
859 | Instantiation.True ->
861 { err_msg = ["_NotYetImplemented"; "_Expr"; "true"];
863 err_ctx = ctx }) (*error*)
864 | Instantiation.Tuple _ ->
866 { err_msg = ["_NotYetImplemented"; "_TupleExpr"];
868 err_ctx = ctx }) (*error*)
869 | Instantiation.UnaryOperation (un_op, expr) ->
870 string_of_unary_operation ctx fun_defs un_op expr
871 | Instantiation.Vector exprs ->
872 string_of_vector ctx fun_defs exprs
873 | Instantiation.VectorReduction _ ->
875 { err_msg = ["_NotYetImplemented"; "_VectorReduct"];
877 err_ctx = ctx }) (*error*)
879 and string_of_binary_operation ctx fun_defs bin_op expr expr' =
880 let string_of_binary_operation_kind = function
881 | Instantiation.And -> "and"
882 | Instantiation.Divide -> "/"
883 | Instantiation.EqualEqual -> "=="
884 | Instantiation.GreaterEqual -> ">="
885 | Instantiation.Greater -> ">"
886 | Instantiation.LessEqual -> "<="
887 | Instantiation.Less -> "<"
888 | Instantiation.Times -> "*"
889 | Instantiation.NotEqual -> "<>"
890 | Instantiation.Or -> "or"
891 | Instantiation.Plus -> "+"
892 | Instantiation.Power -> "^"
893 | Instantiation.Minus -> "-" in
894 Printf.sprintf "(%s %s %s)"
895 (string_of_expression ctx fun_defs expr)
896 (string_of_binary_operation_kind bin_op)
897 (string_of_expression ctx fun_defs expr')
899 and string_of_class_reference fun_defs cl_def =
900 let rec last = function
902 | [Instantiation.Name id] -> id
903 | [Instantiation.Index _] -> assert false
904 | _ :: path -> last path in
907 path = cl_def.Instantiation.class_path;
908 location = cl_def.Instantiation.class_location;
909 instance_nature = Instantiation.ClassElement
911 let string_of_external_call ext_call =
912 match ext_call.NameResolve.nature with
913 | NameResolve.PrimitiveCall "builtin" |
914 NameResolve.PrimitiveCall "C" -> last ctx.path
915 | NameResolve.PrimitiveCall lang ->
917 { err_msg = ["_NotYetImplemented";
918 "_ExternalCallToLanguage";
921 err_ctx = ctx }) (*error*)
922 | NameResolve.ExternalProcedureCall _ ->
924 { err_msg = ["_NotYetImplemented";
925 "_ExternalProcedureCall"];
927 err_ctx = ctx }) (*error*) in
928 let string_of_long_description long_desc =
929 match evaluate long_desc.NameResolve.external_call with
932 { err_msg = ["_NotYetImplemented";
933 "_NonExternalCallClassRef"];
935 err_ctx = ctx }) (*error*)
936 | Some ext_call -> string_of_external_call ext_call in
937 match cl_def.Instantiation.description with
938 | Instantiation.ClassDescription (_, cl_desc) ->
939 string_of_long_description cl_desc.Instantiation.long_description
940 | Instantiation.PredefinedType _ ->
942 { err_msg = ["_NotYetImplemented";
943 "_PredefinedTypeClassRef"];
945 err_ctx = ctx }) (*error*)
947 and string_of_function_call ctx fun_defs expr exprs =
948 Printf.sprintf "%s(%s)"
949 (string_of_expression ctx fun_defs expr)
950 (string_of_expressions ctx fun_defs exprs)
952 and string_of_expressions ctx fun_defs exprs =
953 String.concat ", " (List.map (string_of_expression ctx fun_defs) exprs)
955 and string_of_if ctx fun_defs alts expr =
956 let rec string_of_alternatives = function
957 | [] -> Printf.sprintf " %s" (string_of_expression ctx fun_defs expr)
958 | (expr, expr') :: alts ->
959 Printf.sprintf "(if %s then %s else%s)"
960 (string_of_expression ctx fun_defs expr)
961 (string_of_expression ctx fun_defs expr')
962 (string_of_alternatives alts) in
963 string_of_alternatives alts
965 and string_of_no_event ctx fun_defs expr =
966 Printf.sprintf "noEvent(%s)"
967 (string_of_expression ctx fun_defs expr)
969 and string_of_unary_operation ctx fun_defs un_op expr =
970 let string_of_unary_operation_kind = function
971 | Instantiation.Not -> "not"
972 | Instantiation.UnaryMinus -> "-" in
973 Printf.sprintf "(%s %s)"
974 (string_of_unary_operation_kind un_op)
975 (string_of_expression ctx fun_defs expr)
977 and string_of_vector ctx fun_defs exprs =
978 let exprs' = Array.to_list exprs in
979 Printf.sprintf "{ %s }"
980 (string_of_expressions ctx fun_defs exprs')
983 let rec last_id' id path = match path with
985 | (Instantiation.Name id) :: path -> last_id' id path
986 | (Instantiation.Index _) :: path -> last_id' id path in
989 and string_of_float f =
990 let add_parenthesis s =
991 if String.contains s '-' then Printf.sprintf "(%s)" s else s in
992 match Printf.sprintf "%.16g" f with
993 | s when (String.contains s '.') || (String.contains s 'e') ->
995 | s -> add_parenthesis (Printf.sprintf "%s." s)
997 and component_derivative cpnt_desc =
998 let derivative_path path =
999 let rec derivative_path' path =
1001 | [] -> assert false
1002 | (Instantiation.Name s) :: path ->
1003 (Instantiation.Name ("__der_" ^ s)) :: path
1004 | (Instantiation.Index i) :: path ->
1005 (Instantiation.Index i) :: (derivative_path' path) in
1006 List.rev (derivative_path' (List.rev path)) in
1007 let path = cpnt_desc.Instantiation.component_path in
1008 let id = unquoted (ident_of_path path) in
1009 let component_derivative_nature cpnt_desc =
1010 match evaluate cpnt_desc.Instantiation.component_nature with
1011 | Instantiation.PredefinedTypeInstance predef_type_inst ->
1012 let attribs = [ "start", lazy (Instantiation.Real 0.) ] in
1013 Instantiation.PredefinedTypeInstance
1014 { predef_type_inst with Instantiation.attributes = attribs }
1015 | cpnt_nat -> cpnt_nat in
1018 Instantiation.component_path = derivative_path path;
1019 Instantiation.component_nature =
1020 lazy (component_derivative_nature cpnt_desc);
1021 Instantiation.declaration_equation = None;
1022 Instantiation.comment = "Time derivative of " ^ id
1025 and add_component cpnt_descs cpnt_desc =
1026 let equal_components cpnt_desc cpnt_desc' =
1027 cpnt_desc.Instantiation.component_path =
1028 cpnt_desc'.Instantiation.component_path in
1029 match List.exists (equal_components cpnt_desc) cpnt_descs with
1030 | false -> cpnt_desc :: cpnt_descs
1031 | true -> cpnt_descs
1033 and is_fixed_parameter cpnt_desc =
1034 match cpnt_desc.Instantiation.variability with
1035 | Types.Constant -> true
1036 | Types.Parameter -> is_fixed cpnt_desc
1039 and is_fixed cpnt_desc =
1040 let var = cpnt_desc.Instantiation.variability
1041 and cpnt_nat = evaluate cpnt_desc.Instantiation.component_nature in
1042 let bool_of_fixed predef =
1043 match evaluate (List.assoc "fixed" predef.Instantiation.attributes) with
1044 | Instantiation.False -> false
1046 match var, cpnt_nat with
1047 | Types.Constant, _ -> true
1048 | _, Instantiation.PredefinedTypeInstance predef
1049 when List.mem_assoc "fixed" predef.Instantiation.attributes ->
1050 bool_of_fixed predef
1051 | Types.Parameter, _ -> true
1054 and defined_attribute cpnt_desc attrib_name =
1055 match evaluate cpnt_desc.Instantiation.component_nature with
1056 | Instantiation.PredefinedTypeInstance predef ->
1057 List.mem_assoc "fixed" predef.Instantiation.attributes
1060 and generate_relations filename vars rels =
1061 let add_indentifier_stats stats cpnt_desc =
1063 cpnt_desc.Instantiation.variability,
1064 cpnt_desc.Instantiation.causality,
1065 Lazy.force cpnt_desc.Instantiation.component_nature
1067 | Types.Parameter, _,
1068 Instantiation.PredefinedTypeInstance
1069 { Instantiation.predefined_type = Instantiation.IntegerType } ->
1070 { stats with nb_ipars = stats.nb_ipars + 1 }
1071 | Types.Parameter, _,
1072 Instantiation.PredefinedTypeInstance
1073 { Instantiation.predefined_type = Instantiation.RealType } ->
1074 { stats with nb_rpars = stats.nb_rpars + 1 }
1075 | Types.Parameter, _,
1076 Instantiation.PredefinedTypeInstance
1077 { Instantiation.predefined_type = Instantiation.StringType } ->
1078 { stats with nb_spars = stats.nb_spars + 1 }
1079 | Types.Discrete, _, _ -> { stats with nb_dvars = stats.nb_dvars + 1 }
1080 | Types.Continuous, Types.Input, _ ->
1081 { stats with nb_inps = stats.nb_inps + 1 }
1082 | Types.Continuous, Types.Output, _ ->
1084 nb_cvars = stats.nb_cvars + 1;
1085 nb_outps = stats.nb_outps + 1
1087 | Types.Continuous, Types.Acausal, _ ->
1088 { stats with nb_cvars = stats.nb_cvars + 1 }
1090 let variable_id cpnt_desc =
1091 let name = ident_of_path cpnt_desc.Instantiation.component_path in
1092 hide_spc (unquoted name) in
1093 let generate_identifier oc tabs cpnt_desc =
1094 let rec generate_tabs tabs =
1095 if tabs > 0 then begin
1096 Printf.fprintf oc "\t"; generate_tabs (tabs - 1)
1099 cpnt_desc.Instantiation.variability,
1100 cpnt_desc.Instantiation.causality
1102 | Types.Parameter, _ ->
1103 let id = variable_id cpnt_desc in
1105 Printf.fprintf oc "<parameter>%s</parameter>\n" id
1106 | Types.Constant, _ -> ()
1107 | _, (Types.Acausal | Types.Output) ->
1108 let id = variable_id cpnt_desc in
1110 Printf.fprintf oc "<implicit_variable>%s</implicit_variable>\n" id
1112 let id = variable_id cpnt_desc in
1114 Printf.fprintf oc "<input>%s</input>\n" id in
1115 let generate_relation oc rel =
1118 Printf.fprintf oc "\t\t<implicit_relation>\n";
1119 List.iter (generate_identifier oc 3) cpnt_descs;
1120 Printf.fprintf oc "\t\t</implicit_relation>\n" in
1121 let generate_output oc cpnt_desc =
1123 cpnt_desc.Instantiation.variability,
1124 cpnt_desc.Instantiation.causality
1126 | (Types.Parameter | Types.Constant), _ |
1127 _, (Types.Acausal | Types.Input) -> ()
1128 | _, Types.Output ->
1129 let id = variable_id cpnt_desc in
1132 \t\t\t<name>%s</name>\n\
1133 \t\t\t<dependencies>\n\
1134 \t\t\t\t<variable>%s</variable>\n\
1135 \t\t\t</dependencies>\n\
1139 let oc' = open_out (filename ^ "_relations.xml") in
1140 Printf.fprintf oc' "<model>\n";
1143 add_indentifier_stats
1156 \t\t<number_of_integer_parameters>%d</number_of_integer_parameters>\n\
1157 \t\t<number_of_real_parameters>%d</number_of_real_parameters>\n\
1158 \t\t<number_of_string_parameters>%d</number_of_string_parameters>\n\
1159 \t\t<number_of_discrete_variables>%d</number_of_discrete_variables>\n\
1160 \t\t<number_of_continuous_variables>%d</number_of_continuous_variables>\n\
1161 \t\t<number_of_continuous_unknowns>%d</number_of_continuous_unknowns>\n\
1162 \t\t<number_of_inputs>%d</number_of_inputs>\n\
1163 \t\t<number_of_outputs>%d</number_of_outputs>\n\
1173 Printf.fprintf oc' "\t<identifiers>\n";
1174 List.iter (generate_identifier oc' 2) vars;
1175 Printf.fprintf oc' "\t</identifiers>\n";
1176 Printf.fprintf oc' "\t<implicit_relations>\n";
1177 List.iter (generate_relation oc') rels;
1178 Printf.fprintf oc' "\t</implicit_relations>\n";
1179 Printf.fprintf oc' "\t<outputs>\n";
1180 List.iter (generate_output oc') vars;
1181 Printf.fprintf oc' "\t</outputs>\n";
1182 Printf.fprintf oc' "</model>\n";
1185 and generate_flatten_XML ctx fun_defs oc id vars equs =
1186 let print_when_clause equ =
1187 let string_of_equation equ =
1188 let string_of_equation' equ_desc = match equ_desc with
1189 | Instantiation.Equal (expr, expr') ->
1190 hide_spc (string_of_equal ctx fun_defs expr expr')
1191 | _ -> assert false in
1194 (List.map string_of_equation' equ.Instantiation.nature) in
1195 let rec string_of_when_clause alts = match alts with
1197 | [ (expr, equs) ] ->
1198 Printf.sprintf "when %s then\n %s end when;\n"
1199 (string_of_expression ctx fun_defs expr)
1200 (String.concat " " (List.map string_of_equation equs))
1201 | (expr, equs) :: alts ->
1202 Printf.sprintf "when %s then\n %s else %s"
1203 (string_of_expression ctx fun_defs expr)
1204 (String.concat " " (List.map string_of_equation equs))
1205 (string_of_when_clause alts) in
1207 | Instantiation.WhenClauseE alts ->
1208 Printf.fprintf oc "<when_clause value=\"%s\"/>\n"
1209 (string_of_when_clause alts)
1211 and print_equation equ = match equ with
1212 | Instantiation.Equal (expr, expr') ->
1213 Printf.fprintf oc "<equation value=\"%s\"/>\n"
1214 (hide_spc (string_of_equal ctx fun_defs expr expr'))
1216 let print_equations equs =
1217 Printf.fprintf oc "<equations>\n";
1218 List.iter print_equation equs;
1219 Printf.fprintf oc "</equations>\n"
1220 and print_when_clauses equs =
1221 Printf.fprintf oc " <when_clauses>\n";
1222 List.iter print_when_clause equs;
1223 Printf.fprintf oc " </when_clauses>\n" in
1224 Printf.fprintf oc "<model>\n";
1225 Printf.fprintf oc "<name>%s</name>\n" (hide_spc id);
1226 print_tree ctx fun_defs oc (build_tree vars);
1227 print_equations equs;
1228 print_when_clauses equs;
1229 Printf.fprintf oc "</model>\n"
1231 and build_tree vars =
1232 let is_output caus = match caus with
1233 | Types.Output -> true
1235 and variable_kind caus var = match caus, var with
1236 | Types.Input, _ -> Input
1237 | _, Types.Parameter -> Parameter
1238 | _, Types.Discrete -> DiscreteVariable
1240 and attribute_value name attrs =
1242 Some (evaluate (List.assoc name attrs))
1243 with Not_found -> None in
1244 let variable_initial_value cpnt_desc =
1245 let cpnt_nat = evaluate cpnt_desc.Instantiation.component_nature
1246 and var = cpnt_desc.Instantiation.variability
1247 and equ = cpnt_desc.Instantiation.declaration_equation in
1248 match cpnt_nat, var, equ with
1249 | Instantiation.PredefinedTypeInstance _, Types.Parameter, Some expr ->
1250 Some (evaluate expr)
1251 | Instantiation.PredefinedTypeInstance predef,
1252 (Types.Continuous | Types.Discrete),
1254 let attrs = predef.Instantiation.attributes in
1255 attribute_value "start" attrs
1257 and variable_nominal_value cpnt_desc =
1258 match evaluate cpnt_desc.Instantiation.component_nature with
1259 | Instantiation.PredefinedTypeInstance predef ->
1260 let attrs = predef.Instantiation.attributes in
1261 attribute_value "nominal" attrs
1263 and fixed cpnt_desc =
1264 match defined_attribute cpnt_desc "fixed" with
1266 | true -> Some (is_fixed cpnt_desc) in
1267 let terminal_element cpnt_desc =
1268 let caus = cpnt_desc.Instantiation.causality
1269 and var = cpnt_desc.Instantiation.variability in
1271 unquoted (ident_of_path cpnt_desc.Instantiation.component_path) in
1273 kind = variable_kind caus var;
1275 comment = cpnt_desc.Instantiation.comment;
1276 initial_value = variable_initial_value cpnt_desc;
1277 (* nominal_value = variable_nominal_value cpnt_desc;
1279 output = is_output caus;
1280 fixed = fixed cpnt_desc
1282 let t_elts = List.map terminal_element vars in
1284 (fun ts t_elt -> insert (split t_elt.id) t_elt ts)
1288 and print_tree ctx fun_defs oc ts =
1289 let string_of_kind = function
1291 | Parameter -> "fixed_parameter"
1292 | Variable -> "variable"
1293 | DiscreteVariable -> "discrete_variable" in
1294 let string_of_initial_value elt = match elt.initial_value with
1296 | Some expr -> string_of_expression ctx fun_defs expr in
1297 (* let string_of_nominal_value elt = match elt.nominal_value with
1299 | Some expr -> string_of_expression ctx fun_defs expr in *)
1300 let string_of_fixed elt = match elt.fixed with
1302 | Some true -> "true"
1303 | Some false -> "false" in
1304 let rec print_tree_element = function
1306 Printf.fprintf oc "<struct>\n";
1307 Printf.fprintf oc "<name>%s</name>\n" (hide_spc s);
1308 Printf.fprintf oc "<subnodes>\n";
1309 List.iter print_tree_element ts;
1310 Printf.fprintf oc "</subnodes>\n";
1311 Printf.fprintf oc "</struct>\n"
1313 Printf.fprintf oc "<terminal>\n";
1314 Printf.fprintf oc "<name>%s</name>\n" (hide_spc s);
1315 Printf.fprintf oc "<kind>%s</kind>\n" (string_of_kind elt.kind);
1316 Printf.fprintf oc "<id>%s</id>\n" (hide_spc elt.id);
1317 Printf.fprintf oc "<fixed value=\"%s\"/>\n" (string_of_fixed elt);
1318 Printf.fprintf oc "<initial_value value=\"%s\"/>\n"
1319 (hide_spc (unbraced (string_of_initial_value elt)));
1320 (* Printf.fprintf oc "<nominal_value value=\"%s\"/>\n"
1321 (hide_spc (unbraced (string_of_nominal_value elt)));
1323 Printf.fprintf oc "<comment value=\"%s\"/>\n" (hide_spc elt.comment);
1325 Printf.fprintf oc "<output/>\n";
1326 if elt.kind <> Parameter && elt.initial_value <> None then
1327 Printf.fprintf oc "<selected value=\"y\" />\n";
1328 Printf.fprintf oc "</terminal>\n"
1330 Printf.fprintf oc " <elements>\n";
1331 List.iter print_tree_element ts;
1332 Printf.fprintf oc " </elements>\n"
1334 and insert path x ts =
1335 let rec insert' s path' = function
1336 | [] -> [Node (s, insert path' x [])]
1337 | Node (s', ts'') :: ts' when s = s' -> Node (s', insert path' x ts'') :: ts'
1338 | t' :: ts' -> t' :: insert' s path' ts' in
1340 | [s] -> ts @ [Leaf (s, x)] (*the order of elements is important in Scicos*)
1341 | s :: path' -> insert' s path' ts
1342 | [] -> assert false
1345 let rec cut_on_dot' i =
1346 if i = String.length s then s, None
1347 else if s.[i] = '.' then String.sub s 0 i, Some (String.sub s (i + 1) (String.length s - i - 1))
1348 else cut_on_dot' (i + 1)
1352 let s, name_opt = cut_on_dot name in
1355 | Some name' -> s :: split name'