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