add translator & XML2modelica
[scilab.git] / scilab / modules / scicos / src / xml2modelica / modelicaCodeGenerator.ml
1 (*\r
2  *  XML to Modelica\r
3  *\r
4  *  Copyright (C) 2005 - 2007 Imagine S.A.\r
5  *  For more information or commercial use please contact us at www.amesim.com\r
6  *\r
7  *  This program is free software; you can redistribute it and/or\r
8  *  modify it under the terms of the GNU General Public License\r
9  *  as published by the Free Software Foundation; either version 2\r
10  *  of the License, or (at your option) any later version.\r
11  *\r
12  *  This program is distributed in the hope that it will be useful,\r
13  *  but WITHOUT ANY WARRANTY; without even the implied warranty of\r
14  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
15  *  GNU General Public License for more details.\r
16  *\r
17  *  You should have received a copy of the GNU General Public License\r
18  *  along with this program; if not, write to the Free Software\r
19  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.\r
20  *\r
21  *)\r
22 \r
23 open XMLTree\r
24 \r
25 let start_equations = ref []\r
26 \r
27 (* Decode XML special characters *)\r
28 let decode_spc s =\r
29   let token_fun = StringLexer.token\r
30   and lexbuf = Lexing.from_string s in\r
31   StringParser.parse token_fun lexbuf\r
32 \r
33 let generate_attributes oc attribs =\r
34   let rec modified_attributes attribs = match attribs with\r
35     | [] -> []\r
36     | (attrib, value) :: attribs when value = "" ->\r
37         modified_attributes attribs\r
38     | (attrib, value) :: attribs ->\r
39         (attrib, value) :: (modified_attributes attribs) in\r
40   let rec generate_attributes' attribs = match attribs with\r
41     | [] -> ()\r
42     | [ (attrib, value) ] ->\r
43         Printf.fprintf oc "%s = %s" attrib value\r
44     | (attrib, value) :: attribs ->\r
45         Printf.fprintf oc "%s = %s, " attrib value;\r
46         generate_attributes' attribs in\r
47   match modified_attributes attribs with\r
48   | [] -> ()\r
49   | attribs ->\r
50       Printf.fprintf oc "(";\r
51       generate_attributes' attribs;\r
52       Printf.fprintf oc ")"\r
53 \r
54 let generate_code init filename model =\r
55   let generate_type_specifier oc t = match t.kind, t.output with\r
56     | Input, _ -> Printf.fprintf oc "  input Real"\r
57     | (FixedParameter | Parameter), _ -> Printf.fprintf oc "  parameter Real"\r
58     | Variable, true -> Printf.fprintf oc "  output Real"\r
59     | DiscreteVariable, _ when init -> Printf.fprintf oc "  Real"\r
60     | DiscreteVariable, _ -> Printf.fprintf oc "  discrete Real"\r
61     | _ -> Printf.fprintf oc "  Real"\r
62   and generate_identifier oc t =\r
63     Printf.fprintf oc " `%s`" (decode_spc t.id)\r
64   and generate_comment oc t =\r
65     Printf.fprintf oc " \"%s\";\n" (decode_spc t.comment) in\r
66   let generate_start_attribute oc t = match t.kind with\r
67     | _ when t.initial_value = "" -> ()\r
68     | Variable | DiscreteVariable when t.fixed <> "true"  ->\r
69         generate_attributes oc [ "start", t.initial_value ]\r
70     | Variable | DiscreteVariable ->\r
71         let equ =\r
72           Printf.sprintf "`%s` = %s;" (decode_spc t.id) t.initial_value in\r
73         start_equations := equ :: !start_equations\r
74     | FixedParameter | Parameter when t.fixed <> "false"  ->\r
75         let equ =\r
76           Printf.sprintf "`%s` = %s;" (decode_spc t.id) t.initial_value in\r
77         start_equations := equ :: !start_equations\r
78     | FixedParameter | Parameter ->\r
79         Printf.fprintf oc " = %s" t.initial_value\r
80     | Input -> () in\r
81   let rec generate_sub_elements oc = function\r
82     | [] -> ()\r
83     | Struct s :: elts ->\r
84         generate_sub_elements oc s.subnodes;\r
85         generate_sub_elements oc elts\r
86     | Terminal t :: elts ->\r
87         generate_terminal oc t;\r
88         generate_sub_elements oc elts\r
89   and generate_terminal oc t =\r
90     generate_type_specifier oc t;\r
91     generate_identifier oc t;\r
92     generate_start_attribute oc t;\r
93     generate_comment oc t\r
94   and generate_sub_equations oc = function\r
95     | [] -> ()\r
96     | equ :: equs ->\r
97         Printf.fprintf oc "  %s\n" (decode_spc equ);\r
98         generate_sub_equations oc equs in\r
99   let oc = open_out filename in\r
100   start_equations := [];\r
101   Printf.fprintf oc\r
102     "class %s\n" (Filename.chop_suffix (Filename.basename filename) ".mo");\r
103   generate_sub_elements oc model.elements;\r
104   Printf.fprintf oc "equation\n";\r
105   generate_sub_equations oc\r
106     (!start_equations @ model.equations @ model.when_clauses);\r
107   Printf.fprintf oc\r
108     "end %s;\n" (Filename.chop_suffix (Filename.basename filename) ".mo");\r
109   close_out oc\r
110 \r