copy SCI/ocaml to SCI/scicos/src/modelica_compiler
Allan Cornet [Thu, 31 Jan 2008 14:33:47 +0000 (14:33 +0000)]
38 files changed:
scilab/modules/scicos/src/modelica_compiler/.depend [new file with mode: 0755]
scilab/modules/scicos/src/modelica_compiler/Makefile [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/Modelicac.vcproj [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/README.txt [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/ReadMe-Windows.txt [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/causalityGraph.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/causalityGraph.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/compilation.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/compilation.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/graphNodeSet.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/graphNodeSet.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/hungarianMethod.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/hungarianMethod.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/instantiation.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/instantiation.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/lexer.mll [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/linenum.mll [new file with mode: 0755]
scilab/modules/scicos/src/modelica_compiler/makefile.mak [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/optimization.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/optimization.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/parseTree.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/parseTree.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/parser.mly [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/precompilation.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/precompilation.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/scicosCodeGeneration.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/scicosCodeGeneration.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/scicosOptimizingCompiler.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/squareSparseMatrix.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/squareSparseMatrix.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/symbolicExpression.ml [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/symbolicExpression.mli [new file with mode: 0644]
scilab/modules/scicos/src/modelica_compiler/xMLCodeGeneration.ml [new file with mode: 0755]
scilab/modules/scicos/src/modelica_compiler/xMLCodeGeneration.mli [new file with mode: 0755]

diff --git a/scilab/modules/scicos/src/modelica_compiler/.depend b/scilab/modules/scicos/src/modelica_compiler/.depend
new file mode 100755 (executable)
index 0000000..2842b89
--- /dev/null
@@ -0,0 +1,46 @@
+parseTree.cmo: parseTree.cmi 
+parseTree.cmx: parseTree.cmi 
+parser.cmo: parseTree.cmi linenum.cmo 
+parser.cmx: parseTree.cmx linenum.cmx 
+lexer.cmo: parser.cmo 
+lexer.cmx: parser.cmx 
+precompilation.cmo: parseTree.cmi precompilation.cmi 
+precompilation.cmx: parseTree.cmx precompilation.cmi 
+compilation.cmo: precompilation.cmi parseTree.cmi compilation.cmi 
+compilation.cmx: precompilation.cmx parseTree.cmx compilation.cmi 
+instantiation.cmo: compilation.cmi instantiation.cmi 
+instantiation.cmx: compilation.cmx instantiation.cmi 
+graphNodeSet.cmo: graphNodeSet.cmi 
+graphNodeSet.cmx: graphNodeSet.cmi 
+symbolicExpression.cmo: graphNodeSet.cmi symbolicExpression.cmi 
+symbolicExpression.cmx: graphNodeSet.cmx symbolicExpression.cmi 
+squareSparseMatrix.cmo: squareSparseMatrix.cmi 
+squareSparseMatrix.cmx: squareSparseMatrix.cmi 
+bipartiteGraph.cmo: bipartiteGraph.cmi 
+bipartiteGraph.cmx: bipartiteGraph.cmi 
+hungarianMethod.cmo: hungarianMethod.cmi 
+hungarianMethod.cmx: hungarianMethod.cmi 
+causalityGraph.cmo: causalityGraph.cmi 
+causalityGraph.cmx: causalityGraph.cmi 
+optimization.cmo: symbolicExpression.cmi squareSparseMatrix.cmi \
+    instantiation.cmi hungarianMethod.cmi compilation.cmi causalityGraph.cmi \
+    bipartiteGraph.cmi optimization.cmi 
+optimization.cmx: symbolicExpression.cmx squareSparseMatrix.cmx \
+    instantiation.cmx hungarianMethod.cmx compilation.cmx causalityGraph.cmx \
+    bipartiteGraph.cmx optimization.cmi 
+xMLCodeGeneration.cmo: symbolicExpression.cmi optimization.cmi \
+    xMLCodeGeneration.cmi 
+xMLCodeGeneration.cmx: symbolicExpression.cmx optimization.cmx \
+    xMLCodeGeneration.cmi 
+optimizingCompiler.cmo: xMLCodeGeneration.cmi precompilation.cmi parser.cmo \
+    optimization.cmi lexer.cmo instantiation.cmi compilation.cmi \
+    optimizingCompiler.cmi 
+optimizingCompiler.cmx: xMLCodeGeneration.cmx precompilation.cmx parser.cmx \
+    optimization.cmx lexer.cmx instantiation.cmx compilation.cmx \
+    optimizingCompiler.cmi 
+scicosCodeGeneration.cmo: symbolicExpression.cmi optimization.cmi \
+    scicosCodeGeneration.cmi 
+scicosCodeGeneration.cmx: symbolicExpression.cmx optimization.cmx \
+    scicosCodeGeneration.cmi 
+scicosOptimizingCompiler.cmo: scicosCodeGeneration.cmi optimizingCompiler.cmi 
+scicosOptimizingCompiler.cmx: scicosCodeGeneration.cmx optimizingCompiler.cmx 
diff --git a/scilab/modules/scicos/src/modelica_compiler/Makefile b/scilab/modules/scicos/src/modelica_compiler/Makefile
new file mode 100644 (file)
index 0000000..a11fb90
--- /dev/null
@@ -0,0 +1,160 @@
+#  Scicos
+#
+#  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+# See the file ./license.txt
+
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+CAMLP4=camlp4
+RM=rm
+
+
+OCAMLFLAGS=
+OCAMLOPTFLAGS=
+LFLAGS=
+LIBS=nums.cma
+MLS=parseTree.ml linenum.ml parser.ml lexer.ml\
+       precompilation.ml compilation.ml instantiation.ml\
+       graphNodeSet.ml symbolicExpression.ml\
+       squareSparseMatrix.ml bipartiteGraph.ml hungarianMethod.ml\
+       causalityGraph.ml\
+       optimization.ml  xMLCodeGeneration.ml optimizingCompiler.ml\
+       scicosCodeGeneration.ml scicosOptimizingCompiler.ml
+MLIS=
+DOCS=parseTree.mli\
+       precompilation.mli compilation.mli instantiation.mli\
+       graphNodeSet.mli symbolicExpression.mli \
+       squareSparseMatrix.mli bipartiteGraph.mli hungarianMethod.mli \
+       causalityGraph.mli \
+       optimization.mli \
+       xMLCodeGeneration.mli \
+       optimizingCompiler.mli \
+       scicosCodeGeneration.mli 
+PLATFORM=$(shell uname -s)
+
+EXE=../bin/modelicac
+#TRANSLATOR=../../bin/translator
+
+
+.SUFFIXES: .ml .mli .cmo .cmi .cmx .mlp .mpi
+
+
+
+.mlp.cmo:
+       @$(CAMLP4) pa_o.cmo pa_op.cmo pr_o.cmo -impl $(<) > $(@:.cmo=.tmp)
+       @$(OCAMLC) $(OCAMLFLAGS) -c -impl $(@:.cmo=.tmp)
+       @$(RM) -f $(@:.cmo=.tmp)
+
+
+.mpi.cmi:
+       @$(CAMLP4) pa_o.cmo pa_op.cmo pr_o.cmo -intf $(<) > $(@:.cmi=.tmp)
+       @$(OCAMLC) $(OCAMLFLAGS) -c -intf $(@:.cmi=.tmp)
+       @$(RM) -f $(@:.cmi=.tmp)
+
+
+.mlp.cmx:
+       @$(CAMLP4) pa_o.cmo pa_op.cmo pr_o.cmo -impl $(<) > $(@:.cmx=.tmp)
+       @$(OCAMLOPT) $(OCAMLOPTFLAGS) -c -impl $(@:.cmx=.tmp)
+       @$(RM) -f $(@:.cmx=.tmp)
+
+
+.ml.cmo:
+       @$(OCAMLC) $(OCAMLFLAGS) -c $(<)
+
+
+.mli.cmi:
+       @$(OCAMLC) $(OCAMLFLAGS) -c $(<)
+
+
+.ml.cmx:
+       @$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $(<)
+
+
+%.ml %.mli: %.mly
+       @ocamlyacc $(<)
+       @$(RM) -f $(<:.mly=.mli)
+
+
+%.ml: %.mll
+       @ocamllex $(<)
+
+
+all : depend $(EXE)
+
+$(EXE): $(MLIS:.mli=.cmi) $(MLS:.ml=.cmx)
+       @$(OCAMLOPT) -o $(EXE) $(LFLAGS) $(LIBS:.cma=.cmxa) $(MLS:.ml=.cmx)
+
+bytecode: depend $(MLIS:.mli=.cmi) $(MLS:.ml=.cmo)
+       @$(OCAMLC) $(OCAMLFLAGS) -o $(EXE) $(LFLAGS) $(LIBS) $(MLS:.ml=.cmo)
+
+opt:
+       make all
+
+debug:  
+       make all OCAMLFLAGS="-g $(OCAMLFLAGS)" 
+
+prof:  
+       make all OCAMLFLAGS="-p $(OCAMLFLAGS)" 
+
+doc:    $(DOCS)
+       @mkdir -p doc
+       @$(OCAMLC) -c $(DOCS)
+       @ocamldoc -html -d doc $(DOCS)
+
+
+archive: $(DOCS) $(DOCS:.mli=.ml) scicosOptimizingCompiler.ml \
+linenum.mll lexer.mll parser.mly README.txt Makefile
+       @mkdir -p sources
+       @for f in $(DOCS) $(DOCS:.mli=.ml) scicosOptimizingCompiler.ml linenum.mll lexer.mll parser.mly README.txt Makefile;\
+       @do\
+               cp $$f sources/$$f;\
+       done
+       @tar cvf - sources | gzip > archive.tar.gz
+
+depend : .depend 
+
+.depend: $(MLS) $(MLIS)
+       @echo "regenerate .depend"
+       @touch .depend
+       @$(OCAMLDEP) $(MLS) $(MLIS) > .depend
+
+
+include .depend
+
+$(TRANSLATOR):
+       @cd modelica;$(MAKE) depend;$(MAKE);mv translation/translator $(TRANSLATOR)
+
+clean:
+       @$(RM) -f *.cmxa
+       @$(RM) -f *.cm[aiox]
+       @$(RM) -f *.tmp
+       @$(RM) -f *.obj
+       @$(RM) -f *.o
+       @$(RM) -f parser.mli
+       @$(RM) -f lexer.mli
+       @$(RM) -f parser.ml
+       @$(RM) -f lexer.ml
+       @$(RM) -f $(EXE)
+#      @cd modelica;$(MAKE) clean; 
+#      @$(RM) -f $(TRANSLATOR)
+
+distclean : clean
+       @$(RM) -rf doc $(EXE) 
+
+super_distclean : distclean
diff --git a/scilab/modules/scicos/src/modelica_compiler/Modelicac.vcproj b/scilab/modules/scicos/src/modelica_compiler/Modelicac.vcproj
new file mode 100644 (file)
index 0000000..e19a003
--- /dev/null
@@ -0,0 +1,149 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+       ProjectType="Visual C++"
+       Version="7.10"
+       Name="Modelicac"
+       ProjectGUID="{BB476641-07F4-488E-AA87-21795FFA8F4A}"
+       Keyword="MakeFileProj">
+       <Platforms>
+               <Platform
+                       Name="Win32"/>
+       </Platforms>
+       <Configurations>
+               <Configuration
+                       Name="Debug|Win32"
+                       OutputDirectory="Debug"
+                       IntermediateDirectory="Debug"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Release|Win32"
+                       OutputDirectory="Release"
+                       IntermediateDirectory="Release"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Debug with Atlas|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Release with Atlas|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="PIV_Release with Atlas|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Debug without Java|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Debug with Atlas without Java|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Release with Atlas without Java|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+               <Configuration
+                       Name="Release with Debug Information|Win32"
+                       OutputDirectory="$(ConfigurationName)"
+                       IntermediateDirectory="$(ConfigurationName)"
+                       ConfigurationType="0">
+                       <Tool
+                               Name="VCNMakeTool"
+                               BuildCommandLine="nmake /f makefile.mak all /a"
+                               ReBuildCommandLine="nmake /f makefile.mak all /a"
+                               CleanCommandLine="nmake /f makefile.mak clean /a"
+                               Output="Modelicac.exe"/>
+               </Configuration>
+       </Configurations>
+       <References>
+       </References>
+       <Files>
+               <Filter
+                       Name="Source Files"
+                       Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm;asmx"
+                       UniqueIdentifier="{4FC737F1-C7A5-4376-A066-2A32D752A2FF}">
+                       <File
+                               RelativePath=".\makefile.mak">
+                       </File>
+               </Filter>
+               <Filter
+                       Name="Header Files"
+                       Filter="h;hpp;hxx;hm;inl;inc;xsd"
+                       UniqueIdentifier="{93995380-89BD-4b04-88EB-625FBE52EBFB}">
+               </Filter>
+               <Filter
+                       Name="Resource Files"
+                       Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx"
+                       UniqueIdentifier="{67DA6AB6-F800-4c08-8B7A-83BB121AAD01}">
+               </Filter>
+               <File
+                       RelativePath=".\ReadMe-Windows.txt">
+               </File>
+       </Files>
+       <Globals>
+       </Globals>
+</VisualStudioProject>
diff --git a/scilab/modules/scicos/src/modelica_compiler/README.txt b/scilab/modules/scicos/src/modelica_compiler/README.txt
new file mode 100644 (file)
index 0000000..fc922ba
--- /dev/null
@@ -0,0 +1,175 @@
+1. Introduction
+===============
+
+This document describes the Modelica compiler Modelicac.
+Modelicac is a tool that compiles a subset of the Modelica 2.0 language (see
+section 4). This subset allows the description of continuous-time physical
+models that can be simulated under the Scicos environment.
+
+
+2. How to compile Modelicac
+===========================
+
+Be sure to have a recent Objective Caml (v.3.06 or later) properly installed
+on the machine.
+In the source directory, type:
+
+  make depend
+
+then:
+
+  make (to compile a bytecode version of Modelicac)
+or:
+  make opt (to compile a native-code version of Modelicac)
+
+Ocaml code HTML documentation can be automatically generated from module types
+by typing:
+
+ make doc
+
+This will create a directory named "doc" in the current directory. "index.html"
+is the entry point of the documentation.
+
+
+3. How to use Modelicac
+=======================
+
+Modelicac compiles Modelica files whose name ends by ".mo".
+The modelicac command, when invoked with the appropriate options, may produce:
+- A C file containing a function suitable to be called by the Scicos tool in
+  order to perform a model simulation;
+- A "*.moc" file which is the format of a precompiled Modelica class stored for
+  later instantiation.
+
+It is required that each "*.mo" file contains exactly one Modelica class
+(see section 4) and that the name of the class matches the name of the file that
+contains its definition.
+
+By default, Modelicac removes every variable that is not reinitialized in a
+"when" section and for which it can express its value with respect to the
+remaining variables of the system. It is possible to disable this option by
+specifying "-keep-all-variables" when calling Modelicac (see below).
+
+Usage
+-----
+
+modelicac [-c] [-o <outputfile>] <inputfile> [other options]
+
+-c: Compile only, do not instantiate. Modelicac produces a "*.moc" file when
+    invoked with that option.
+-o <outputfile>: Set output file name to <outputfile> (this option also works
+                 with -c option but is somewhat useless because of the class
+                 name restrictions given above).
+Other options include:
+-L <directory>: Add <directory> to the list of directories to be searched when
+                producing a C file (no effect when used with -c).
+-hpath <directory>: Specify a path to be added to #include directives in the
+                    generated C code.
+-keep-all-variables: Do not remove any variable from the initial system.
+-jac: Generate analytic jacobian matrix code.
+-no-parameter-removal: Do not remove any parameter
+-no-simplifs: Same as -keep-all-variables -no-parameter-removal
+-trace <filename>: Generate tracing information for external function calls
+                   into <filename>
+-xml: Generate an XML version of the model instead of target code
+
+Examples
+-------
+
++------------------------------------------------------------------------------+
+| Modelicac invokation         | Result                                        |
++------------------------------+-----------------------------------------------+
+| modelicac foo.mo             | Produces a file named "foo.c" containing a    |
+|                              | C function named "foo" to be called by Scicos.|
++------------------------------+-----------------------------------------------+
+| modelicac -c foo.mo          | Produces a file named "foo.moc" containing a  |
+|                              | precompiled class named "foo".                |
++------------------------------+-----------------------------------------------+
+| modelicac -o dir/bar.c       | Same as "modelicac foo.mo", but output file   |
+|  foo.mo                      | name is "bar.c" and the resulting file is     |
+|                              | located in directory "dir".                   |
++------------------------------+-----------------------------------------------+
+| modelicac -L dir1 -L dir2 ...| Same as "modelicac foo.mo", but if some       |
+| -L dirN foo.mo               | precompiled class "bar" needed by class "foo" |
+|                              | isn't found in the current directory (i.e.    |
+|                              | there is no file named "bar.moc" in the       |
+|                              | current directory), it is searched into       |
+|                              | "dir1", and, if not found, into "dir2", ...,  |
+|                              | "dirN" until a file named "bar.moc" is found. |
++------------------------------+-----------------------------------------------+
+
+
+3. The compiled Modelica subset
+===============================
+
+ The Modelicac compiler compiles a subset of the Modelica language that allows
+the description of some countinuous equational models. Each Modelica class is
+stored in its own file whose name is the name of the class followed by the "mo"
+extension.
+
+Restrictions on the declaration of a modelica class header
+----------------------------------------------------------
+ - only the keyword "class" is allowed to declare a Modelica class ("function"
+   is allowed to define functions, but in a very restrictive way, see below);
+ - "within" is not allowed ;
+ - a class cannot be "final" ;
+ - short class definitions (type declarations) are not allowed ;
+ - inheritance is not allowed ;
+ - "encapsulated" and "partial" classes are not allowed ;
+
+Restrictions on the declaration of the components of a class
+------------------------------------------------------------
+ - imports are not allowed ;
+ - inner classes are not allowed ;
+ - "inner", "outer" are not allowed ;
+ - "protected" component lists are not allowed ;
+ - "final" and "replaceable" are not allowed ;
+ - "external" is restricted (see "Restrictions on external function
+   definitions") ;
+ - "constant" is not allowed ;
+ - "input" and "output" may only be used to define I/O ports of the toplevel
+   class beeing compiled to C code (see example below) ;
+ - "algorithm" sections are not allowed ;
+ - arrays must contain numerical types.
+
+Restrictions on modifications
+-----------------------------
+ - modifications may only apply to base types, scalar or not ;
+ - selections of subarrays are not allowed (i.e. a[:].b = ...) ;
+ - "redeclare", "each" and "final" are not allowed.
+
+Restrictions on equations
+-------------------------
+ - equational "if" is not allowed in the specification of an equation.
+
+Restrictions on expressions
+-----------------------------
+ - "for" expressions must have an integer range (since algorithms are not
+   allowed) ;
+ - selection of subarrays is restricted to numerical arrays ;
+ - array concatenation (using "[" and "]") is not allowed.
+
+Restrictions on external function definitions (to be implemented)
+-----------------------------------------------------------------
+ Only functions taking zero or several Real scalars and returning exactly one
+Real scalar are supported.
+ External functions must be declared in a separate file (one file per function).
+This file contains the prototype of the corresponding C function with the same
+name. For example:
+
+function Blackbox
+  input Real u;
+  output Rea y;
+external;
+end Blackbox;
+
+ This function can be called from another modelica file using the following
+syntax (assuming Blackbox.mo to be defined in ./Foo/Bar):
+
+...Blackbox(42)...
+
+Modelicac assumes that both ./Foo/Bar/Blackbox.h and ./Foo/Bar/Blackbox.c exist
+(see "-hpath" option) and contain the C code corresponding to a C function with
+the following signature:
+
+double blackbox(double u);
diff --git a/scilab/modules/scicos/src/modelica_compiler/ReadMe-Windows.txt b/scilab/modules/scicos/src/modelica_compiler/ReadMe-Windows.txt
new file mode 100644 (file)
index 0000000..7740cbe
--- /dev/null
@@ -0,0 +1,5 @@
+Install OCaml from www.ocaml.org
+Edit Makefile.mak and modify first line with a correct path
+
+OCAMLPATH=C:\Program Files\Objective Caml
+
diff --git a/scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.ml b/scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.ml
new file mode 100644 (file)
index 0000000..3235933
--- /dev/null
@@ -0,0 +1,118 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+type t = Bipartite of node array * node array
+and node =
+  {
+    index : int;
+    side : side;
+    mutable solved : bool;
+    mutable mark : mark;
+    mutable edges : edge list;
+  }
+and side = Left | Right
+and mark = NoMark | Source | Mark of edge
+and edge = Edge of node * node * flow ref
+and flow = Empty | Full
+and result = Failed | Succeed
+
+let create size =
+    let create_node side i =
+          {
+            index = i;
+            side = side;
+            solved = false;
+            mark = NoMark;
+            edges = []
+          } in
+    let left_nodes = Array.init size (fun i -> create_node Left i)
+    and right_nodes = Array.init size (fun i -> create_node Right i)
+    in Bipartite (left_nodes, right_nodes)
+
+(* In a bipartite graph, left-side nodes can only be linked to right-side ones and vice-versa *)
+let link i j (Bipartite (left_nodes, right_nodes)) =
+    let node = left_nodes.(i)
+    and node' = right_nodes.(j) in
+    let edge = Edge (node, node', ref Empty)
+    in node.edges <- edge :: node.edges; node'.edges <- edge :: node'.edges
+
+(* Invariant: when an edge's flow is full, its source and destination nodes are solved *)
+let fill i j (Bipartite (left_nodes, right_nodes)) =
+    let node = left_nodes.(i)
+    and node' = right_nodes.(j) in
+    let Edge (node, node', flow) = List.find
+        (fun (Edge (_, node'', _)) -> node' == node'')
+        node.edges
+    in
+        if node.solved = true || node'.solved = true && !flow = Empty then invalid_arg "fill"
+        else flow := Full; node.solved <- true; node'.solved <- true
+
+let ford_and_fulkerson (Bipartite (left_nodes, right_nodes)) =
+    let rec first_mark i marked_left_nodes =
+        if i < 0 then mark_right_nodes [] marked_left_nodes
+        else match left_nodes.(i) with
+            | x when not x.solved -> x.mark <- Source; first_mark (i - 1) (x :: marked_left_nodes)
+            | _ -> first_mark (i - 1) marked_left_nodes
+    and mark_right_nodes marked_right_nodes = function
+        | [] -> mark_left_nodes [] marked_right_nodes
+        | x :: xs -> mark_right_nodes (add_right_nodes marked_right_nodes x.edges) xs
+    and add_right_nodes marked_right_nodes = function
+        | [] -> marked_right_nodes
+        | (Edge (_, node, flow) as x) :: xs when node.mark = NoMark && !flow = Empty ->
+            node.mark <- Mark x; add_right_nodes (node :: marked_right_nodes) xs
+        | _ :: xs -> add_right_nodes marked_right_nodes xs
+    and mark_left_nodes marked_left_nodes = function
+        | [] when marked_left_nodes = [] -> Failed
+        | [] -> mark_right_nodes [] marked_left_nodes
+        | x :: _ when not x.solved -> x.solved <- true; update_edges_from x; Succeed
+        | x :: xs -> mark_left_nodes (add_left_nodes marked_left_nodes x.edges) xs
+    and add_left_nodes marked_left_nodes = function
+        | [] -> marked_left_nodes
+        | (Edge (node, _, flow) as x) :: xs when node.mark = NoMark && !flow = Full ->
+            node.mark <- Mark x; add_left_nodes (node :: marked_left_nodes) xs
+        | _ :: xs -> add_left_nodes marked_left_nodes xs
+    and update_edges_from node = match node with
+        | { mark = Source } -> node.solved <- true
+        | { mark = Mark (Edge (node', node'', flow)) } when node == node' ->
+            flow := Empty; update_edges_from node''
+        | { mark = Mark (Edge (node', node'', flow)) } when node == node'' ->
+            flow := Full; update_edges_from node'
+        | _ -> assert false in
+    let erase_marks () =
+        Array.iter (fun node -> node.mark <- NoMark) left_nodes;
+        Array.iter (fun node -> node.mark <- NoMark) right_nodes;
+    and mark () = first_mark (Array.length left_nodes - 1) []
+    and return_pairs () =
+        let rec succ_from = function
+            | [] -> None
+            | Edge (_, node, flow) :: xs when !flow = Full -> Some node.index
+            | _ :: xs -> succ_from xs
+        in Array.fold_left
+            (fun (n, pairs) node ->
+                match succ_from node.edges with
+                    | Some index as res -> (n + 1, ((node.index, res) :: pairs))
+                    | None -> (n, ((node.index, None) :: pairs)))
+            (0, [])
+            left_nodes
+    in
+    erase_marks ();
+    while (mark () = Succeed) do erase_marks () done;
+    return_pairs ()
diff --git a/scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.mli b/scilab/modules/scicos/src/modelica_compiler/bipartiteGraph.mli
new file mode 100644 (file)
index 0000000..ec21987
--- /dev/null
@@ -0,0 +1,46 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module provides the necessary structures and functions to solve a
+simple assignment problem using the Ford and Fulkerson method. *)
+
+type t
+(** The type of the bipartite graphs. *)
+
+val create : int -> t
+(** [create size] creates a bipartite graph of size [size]. *)
+
+val link : int -> int -> t -> unit
+(** [link i j bg] links the [i]th left-side node of [bg] to the [j]th
+right-side node of [bg]. If [i] or [j] are outside \[0, size) where size
+is the size of [bg], Invalid_argument is raised. *)
+
+val fill : int -> int -> t -> unit
+(** [fill i j bg] fills the edge between the [i]th and the [j]th nodes. If
+the edge doesn't exists, Not_found is raised. If [i] or [j] are outside
+\[0, size) where size is the size of [bg], Invalid_argument is raised. *)
+
+val ford_and_fulkerson : t -> int * (int * int option) list
+(** [ford_and_fulkerson bg] performs the Ford and Fulkerson method over the
+bipartite graph [bg], returning a couple whose first element is the
+number of successful coupling an second one a list whose elements are of
+the form [(i, None)] if no right-side node could be associated to the
+[i]th left-side one and [(i, Some j)] in case of success. *)
diff --git a/scilab/modules/scicos/src/modelica_compiler/causalityGraph.ml b/scilab/modules/scicos/src/modelica_compiler/causalityGraph.ml
new file mode 100644 (file)
index 0000000..78d9cab
--- /dev/null
@@ -0,0 +1,120 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(* Imperative implementation by Esko Nuutila and Eljas Soisalon-Soininen in   *)
+(* ON FINDING THE STRONGLY CONNECTED COMPONENTS IN A DIRECTED GRAPH (1994)    *)
+
+type t = Graph of bool ref * nodes
+and nodes = node array
+and node =
+  {
+    contents : int;
+    mutable index : int;
+    mutable not_visited : bool;
+    mutable root : node;
+    mutable in_component : bool;
+    mutable next_nodes : node list
+  }
+
+let min node node' = if node.index < node'.index then node else node'
+let gt node node' = node.index > node'.index
+let empty stack = !stack = []
+let push elt stack = stack := elt :: !stack
+let pop stack = match !stack with
+    | [] -> failwith "top"
+    | node :: nodes -> stack := nodes; node
+let top stack = match !stack with
+    | [] -> failwith "top"
+    | node :: _ -> node
+
+let visit1 nodes =
+    let stack = ref []
+    and index = ref 0
+    and res_ref = ref [] in
+    let rec visit1' current_node =
+        current_node.index <- !index;
+        current_node.not_visited <- false;
+        current_node.root <- current_node;
+        current_node.in_component <- false;
+        index := !index + 1;
+        List.iter
+            (fun node ->
+                if node.not_visited then visit1' node;
+                if not node.in_component then current_node.root <- min node.root current_node.root)
+            current_node.next_nodes;
+        if current_node.root == current_node then begin
+            current_node.in_component <- true;
+            let comp_ref = ref [current_node.contents] in
+            while (not (empty stack) && gt (top stack) current_node) do
+                let node = pop stack in
+                node.in_component <- true;
+                comp_ref := node.contents :: !comp_ref
+            done;
+            res_ref := !comp_ref :: !res_ref
+        end else push current_node stack
+    in
+        Array.iter (fun node -> if node.not_visited then visit1' node) nodes;
+        !res_ref
+
+let erase_marks nodes =
+    Array.iter
+        (fun node ->
+            node.index <- 0;
+            node.not_visited <- true;
+            node.root <- node;
+            node.in_component <- false)
+        nodes
+
+let create size =
+    let nodes = Array.init size
+        (fun i ->
+            let rec node =
+              {
+                contents = i;
+                index = 0;
+                not_visited = true;
+                root = node;
+                in_component = false;
+                next_nodes = []
+              }
+            in node)
+    in Graph (ref true, nodes)
+
+let connect i j (Graph (_, nodes)) =
+    let node = nodes.(i)
+    and node' = nodes.(j)
+    in node.next_nodes <- node' :: node.next_nodes
+
+let strongly_connected_components (Graph (ready, nodes)) = match !ready with
+    | true -> ready := false; visit1 nodes
+    | false -> erase_marks nodes; ready := false; visit1 nodes
+
+let print_with print_fun (Graph (_, nodes)) =
+    Array.iter
+        (fun node ->
+            List.iter
+                (fun node' ->
+                    print_fun node.contents;
+                    print_string " --> ";
+                    print_fun node'.contents;
+                    print_newline ())
+                node.next_nodes)
+        nodes
diff --git a/scilab/modules/scicos/src/modelica_compiler/causalityGraph.mli b/scilab/modules/scicos/src/modelica_compiler/causalityGraph.mli
new file mode 100644 (file)
index 0000000..d884ecb
--- /dev/null
@@ -0,0 +1,19 @@
+(** This module provides a graph structure over which it is possible to apply\r
+an algorithm that finds the strongly connected components of this graph. *)\r
+\r
+type t\r
+(** The type of the graph used to perform the strongly connected component\r
+finding algorithm. *)\r
+\r
+val create: int -> t\r
+(** [create size] creates a graph with [size] unconnected nodes. *)\r
+\r
+val connect: int -> int -> t -> unit\r
+(** [connect i j g] connects the [i]th node to the [j]th one in g. *)\r
+\r
+val strongly_connected_components: t -> int list list\r
+(** [strongly_connected_components g] returns the stronly connected components\r
+of [g] as a list of index lists. *)\r
+\r
+val print_with: (int -> unit) -> t -> unit\r
+(** [print_with print_fun g] prints the connexions in [g] using [print_fun]. *)
\ No newline at end of file
diff --git a/scilab/modules/scicos/src/modelica_compiler/compilation.ml b/scilab/modules/scicos/src/modelica_compiler/compilation.ml
new file mode 100644 (file)
index 0000000..08d5c3c
--- /dev/null
@@ -0,0 +1,775 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+open Precompilation
+
+
+(* Misc *)
+
+let opt_map f = function
+  | Some x -> Some (f x)
+  | None -> None
+
+
+(* Exceptions *)
+
+exception InvalidModification
+exception TypeError
+
+
+(* Datatypes *)
+
+type compilation_context =
+  | ClassContext of compilation_context * compiled_class Lazy.t
+  | ForContext of compilation_context * string
+  | ModificationContext of compilation_context * compiled_class Lazy.t
+  | TopLevelContext
+
+and compiled_unit =
+  | CompiledClass of compiled_class Lazy.t
+  | CompiledFunction of compiled_class Lazy.t
+
+and compiled_class =
+  {
+    ccl_public_cpnts: (string * compiled_component Lazy.t) list Lazy.t;
+    ccl_initial_equs: compiled_equation list Lazy.t;
+    ccl_equs: compiled_equation list Lazy.t;
+  }
+
+and compiled_modification =
+  | CompiledModification of field * compiled_modification list *
+    compiled_expression option
+
+and field = string * compiled_subscript array
+
+and compiled_reference =
+  | ParameterReference of level * path
+  | VariableReference of level * path
+  | LoopVariableReference of level
+  | ClassReference of level * string list
+
+and path = field list
+
+and level = int
+
+and compiled_subscript =
+  | Indefinite
+  | Definite of compiled_expression
+
+and parameter =
+  | IntegerParameter of parameter_attributes
+  | RealParameter of parameter_attributes
+
+and parameter_attributes =
+  {
+    pat_dimensions: compiled_subscript array;
+    pat_comment: string;
+    pat_value: compiled_expression option
+  }
+
+and variable =
+  | DiscreteVariable of variable_attributes
+  | RealVariable of variable_attributes
+  | CompoundVariable of compiled_class Lazy.t * variable_attributes
+
+and variable_attributes =
+  {
+    vat_dimensions: compiled_subscript array;
+    vat_nature: nature;
+    vat_inout: inout;
+    vat_comment: string;
+    vat_modifications: compiled_modification list
+  }
+
+and compiled_component =
+  | Parameter of parameter
+  | Variable of variable
+
+and nature =
+  | Flow
+  | Potential
+
+and inout =
+  | Input
+  | Output
+  | Both
+
+and compiled_equation =
+  | CompiledEquality of compiled_expression * compiled_expression
+  | CompiledFlowConnection of compiled_expression * compiled_expression
+  | CompiledIf of (compiled_expression * compiled_equation list) list *
+    compiled_equation list
+  | CompiledFor of compiled_expression * compiled_expression *
+    compiled_expression * compiled_equation list
+  | CompiledWhen of (compiled_expression * compiled_when_expression list) list
+
+and compiled_when_expression =
+  | Reinit of compiled_reference * compiled_expression
+  | Assign of compiled_reference * compiled_expression
+
+and compiled_expression =
+  | Abs of compiled_expression
+  | Addition of compiled_expression * compiled_expression
+  | And of compiled_expression * compiled_expression
+  | Boolean of bool
+  | Cardinality of compiled_expression
+  | Cos of compiled_expression
+  | Der of compiled_expression
+  | Division of compiled_expression * compiled_expression
+  | Equals of compiled_expression * compiled_expression
+  | Exp of compiled_expression
+  | ExternalFunctionCall of string list * compiled_class Lazy.t *
+    compiled_expression list
+  | Floor of compiled_expression
+  | GreaterEqualThan of compiled_expression * compiled_expression
+  | GreaterThan of compiled_expression * compiled_expression
+  | If of (compiled_expression * compiled_expression) list * compiled_expression
+  | Integer of int32
+  | Log of compiled_expression
+  | Max of compiled_expression * compiled_expression
+  | Min of compiled_expression * compiled_expression
+  | Minus of compiled_expression
+  | Mod of compiled_expression * compiled_expression
+  | Multiplication of compiled_expression * compiled_expression
+  | NoEvent of compiled_expression
+  | Not of compiled_expression
+  | NotEquals of compiled_expression * compiled_expression
+  | Or of compiled_expression * compiled_expression
+  | Power of compiled_expression * compiled_expression
+  | Real of float
+  | Reference of compiled_reference
+  | Sin of compiled_expression
+  | Sqrt of compiled_expression
+  | String of string
+  | Subtraction of compiled_expression * compiled_expression
+  | Tan of compiled_expression
+  | Tanh of compiled_expression
+  | Time
+  | Vector of compiled_expression array
+
+
+(* Marshaling *)
+
+let paths = ref [""]
+(*current searching path (for marshaling) *)
+
+let read_class_file f =
+  let rec read_class_file' = function
+    | [] ->
+        let s = Filename.chop_extension f in
+        failwith ("read_class_file: Class " ^ s ^ " not found")
+    | s :: ss ->
+        try
+          let ic = open_in_bin (Filename.concat s f) in
+          let paths', cu =
+            (Marshal.from_channel ic : string list ref * compiled_unit)
+          in paths' := !paths;
+          (* **side effect**: Updating new path before evaluating lazy values *)
+          cu
+        with
+          | Sys_error _ -> read_class_file' ss
+  in read_class_file' !paths
+
+let write_class_file f cu =
+  let oc = open_out_bin f
+  and flags = [Marshal.Closures] in
+  Marshal.to_channel oc (paths, cu : string list ref * compiled_unit) flags
+
+let create_filename name ext =
+  let rec create_name prefix = function
+    | [] -> failwith "create_name: Empty name"
+    | [s] -> prefix, s
+    | s :: ss -> create_name (prefix @ [s]) ss
+  in
+  let prefix, base = create_name [] name in
+  List.fold_right Filename.concat prefix (base ^ ext)
+
+
+(* Compilation *)
+
+let rec compile_main_class pcl = match pcl.public_classes with
+  | [] -> failwith "compile_main_class: No main class declared"
+  | [(_, pcl)] ->
+      begin match pcl.class_kind with
+        | ParseTree.Function ->
+            CompiledFunction (compile_compound_class TopLevelContext pcl)
+        | ParseTree.Class ->
+            CompiledClass (compile_compound_class TopLevelContext pcl)
+        | _ ->
+            failwith
+              "compile_main_class: Only external functions and classes allowed"
+      end
+  | _ -> failwith "compile_main_class: More than one class declared at toplevel"
+
+and compile_compound_class ctx pcl =
+  let rec ctx' = ClassContext (ctx, lccl)
+  and defined_equs = lazy (compile_equation_clauses ctx' pcl.equs)
+  and lccl = lazy
+    {
+      ccl_public_cpnts = lazy (
+        List.map
+          (fun (id, cpnt) -> id, lazy (compile_component ctx' cpnt))
+          pcl.public_cpnts);
+      ccl_initial_equs = lazy (fst (Lazy.force defined_equs));
+      ccl_equs = lazy (snd (Lazy.force defined_equs));
+    }
+  in lccl
+
+and compile_equation_clauses ctx equ_clauses =
+  let rec compile_equation_clauses' init_equs equs = function
+    | [] -> init_equs, equs
+    | ParseTree.EquationClause (ParseTree.Initial, pt_equs) :: equ_clauses ->
+        let init_equs' =
+          List.fold_left
+            (fun init_equs pt_equ ->
+              (compile_equation_or_annotation ctx pt_equ) @ init_equs)
+            init_equs
+            pt_equs
+        in compile_equation_clauses' init_equs' equs equ_clauses
+    | ParseTree.EquationClause (ParseTree.NotInitial, pt_equs) :: equ_clauses ->
+        let equs' =
+          List.fold_left
+            (fun equs pt_equ ->
+              (compile_equation_or_annotation ctx pt_equ) @ equs)
+            equs
+            pt_equs
+        in compile_equation_clauses' init_equs equs' equ_clauses
+  in compile_equation_clauses' [] [] equ_clauses
+
+and compile_equation_or_annotation ctx = function
+  | ParseTree.Equation (equ, _) -> compile_equation ctx equ
+  | ParseTree.EquationAnnotation _ ->
+      failwith "compile_equation: Annotations not allowed"
+
+and compile_equation ctx = function
+  | ParseTree.Equality (expr, expr') ->
+      let cexpr = compile_expression ctx expr
+      and cexpr' = compile_expression ctx expr' in
+      [CompiledEquality (cexpr, cexpr')]
+  | ParseTree.ConnectClause (conn_ref, conn_ref') ->
+      let var = find_connector ctx conn_ref
+      and var' = find_connector ctx conn_ref' in
+      begin match var, var' with
+        | CompoundVariable (lccl, attrs), CompoundVariable (lccl', attrs') ->
+            compile_connection ctx conn_ref conn_ref' lccl attrs lccl' attrs'
+        | _ -> failwith "compile_equation: Invalid connection"
+      end
+  | ParseTree.WhenClauseE when_clauses ->
+      [CompiledWhen (List.map (compile_when_clause ctx) when_clauses)]
+  | ParseTree.ConditionalEquationE (if_clauses, equs) ->
+      let cif_clauses = List.map (compile_if_clause ctx) if_clauses
+      and cequs =
+        List.fold_left
+          (fun equs equ -> compile_equation ctx equ @ equs)
+          []
+          equs
+      in [CompiledIf (cif_clauses, cequs)]
+  | ParseTree.ForClauseE (for_indices, equs) ->
+      compile_for_clause ctx for_indices equs
+  | ParseTree.FunctionCallE _ ->
+      failwith "compile_equation: Unsupported equation type"
+
+and find_connector ctx conn_ref = match ctx, conn_ref with
+  | ClassContext (_, lccl), [(s, array_subscr)]
+    when List.mem_assoc s (Lazy.force (Lazy.force lccl).ccl_public_cpnts) ->
+      let ccl = Lazy.force lccl in
+      begin match
+        Lazy.force (List.assoc s (Lazy.force ccl.ccl_public_cpnts))
+      with
+        | Variable var -> var
+        | _ -> failwith "find_connector: Bad reference"
+      end
+  | ClassContext _, [(s, _)] ->
+      failwith ("find_connector: unknown identifier: " ^ s)
+  | ClassContext (_, lccl),
+    (s, array_subscr) :: ([(s', array_subscr')] as conn_ref')
+    when List.mem_assoc s (Lazy.force (Lazy.force lccl).ccl_public_cpnts) ->
+      let ccl = Lazy.force lccl in
+      begin match
+        Lazy.force (List.assoc s (Lazy.force ccl.ccl_public_cpnts))
+      with
+        | Variable (CompoundVariable (lccl', _)) ->
+            let ctx' = ClassContext (ctx, lccl') in
+            find_connector ctx' conn_ref'
+        | _ -> failwith "find_connector: Bad reference"
+      end
+  | ClassContext _, (s, _) :: _ ->
+      failwith ("find_connector: unknown identifier: " ^ s)
+  | ClassContext (_, lccl), [] -> failwith "find_connector: empty reference"
+  | ForContext (_, id), _ ->
+      failwith
+        ("find_connector: connector defined in a for loop on variable " ^ id)
+  | _ -> assert false
+
+and compile_connection ctx conn_ref conn_ref' lccl attrs lccl' attrs' =
+  let create_connection (s, lcpnt) = match Lazy.force lcpnt with
+    | Variable (RealVariable { vat_nature = Flow }) ->
+        let cref = compile_component_reference ctx (conn_ref @ [(s, [||])])
+        and cref' = compile_component_reference ctx (conn_ref' @ [(s, [||])])
+        in CompiledFlowConnection (Reference cref, Reference cref')
+    | Variable (RealVariable { vat_nature = Potential }) ->
+        let cref = compile_component_reference ctx (conn_ref @ [(s, [||])])
+        and cref' = compile_component_reference ctx (conn_ref' @ [(s, [||])])
+        in CompiledEquality (Reference cref, Reference cref')
+    | _ -> failwith "compile_connection: Invalid connector"
+  in List.map create_connection (Lazy.force (Lazy.force lccl).ccl_public_cpnts)
+  (*FIXME: check class equality *)
+
+and compile_if_clause ctx = function
+  | expr, equs ->
+      compile_expression ctx expr,
+      List.fold_left
+        (fun equs equ -> compile_equation ctx equ @ equs)
+        []
+        equs
+
+and compile_when_clause ctx = function
+  | expr, when_equs ->
+      compile_expression ctx expr,
+      List.map (compile_when_equation ctx) when_equs
+
+and compile_when_equation ctx = function
+  | ParseTree.FunctionCallE
+    ([("reinit", [||])],
+    Some (ParseTree.ArgList ([ParseTree.Reference cpnt_ref; expr] , None))) ->
+      Reinit (
+        compile_component_reference ctx cpnt_ref,
+        compile_expression ctx expr)
+  | ParseTree.Equality (ParseTree.Reference cpnt_ref, expr) ->
+      Assign (
+        compile_component_reference ctx cpnt_ref,
+        compile_expression ctx expr)
+  | _ -> failwith "compile_when_equation: Invalid equation"
+
+and compile_for_clause ctx for_indices equs = match for_indices with
+  | [] ->
+      List.fold_left
+        (fun equs equ -> compile_equation ctx equ @ equs)
+        []
+        equs
+  | ( s, Some (ParseTree.Range (expr, expr', None))) :: for_indices' ->
+      let cexpr = compile_expression ctx expr
+      and cexpr' = compile_expression ctx expr'
+      and ctx' = ForContext (ctx, s) in
+      let cfor = compile_for_clause ctx' for_indices' equs
+      in [CompiledFor (cexpr, cexpr', Integer (Int32.one), cfor)]
+  | ( s, Some (ParseTree.Range (expr, expr', Some expr''))) :: for_indices' ->
+      let cexpr = compile_expression ctx expr
+      and cexpr' = compile_expression ctx expr'
+      and cexpr'' = compile_expression ctx expr''
+      and ctx' = ForContext (ctx, s) in
+      let cfor = compile_for_clause ctx' for_indices' equs
+      in [CompiledFor (cexpr, cexpr', cexpr'', cfor)]
+  | _ -> failwith "compile_for_clause: Invalid range"
+
+and compile_expression ctx expr =
+  let rec compile_expression' = function
+    | ParseTree.Addition (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Addition (cexpr, cexpr')
+    | ParseTree.And (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        And (cexpr, cexpr')
+    | ParseTree.Division (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Division (cexpr, cexpr')
+    | ParseTree.End ->
+        failwith "compile_expression: end keyword not allowed"
+    | ParseTree.Equals (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Equals (cexpr, cexpr')
+    | ParseTree.ExpressionList [|expr|] ->
+        compile_expression' expr
+    | ParseTree.ExpressionList exprs ->
+        failwith "compile_expression: expression lists not allowed"
+    | ParseTree.False -> Boolean false
+    | ParseTree.FunctionCall
+      ([("noEvent", [||])], Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        NoEvent cexpr
+    | ParseTree.FunctionCall
+      ([("der", [||])], Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Der cexpr
+    | ParseTree.FunctionCall
+      ([("floor", [||])], Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Floor cexpr
+    | ParseTree.FunctionCall
+      ([("max", [||])],
+      Some (ParseTree.ArgList ([expr; expr'] , None))) ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Max (cexpr, cexpr')
+    | ParseTree.FunctionCall
+      ([("min", [||])],
+      Some (ParseTree.ArgList ([expr; expr'] , None))) ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Min (cexpr, cexpr')
+    | ParseTree.FunctionCall
+      ([("mod", [||])],
+      Some (ParseTree.ArgList ([expr; expr'] , None))) ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Mod (cexpr, cexpr')
+    | ParseTree.FunctionCall
+      ([("cardinality", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Cardinality cexpr
+    | ParseTree.FunctionCall
+      ([("abs", [||])], Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Abs cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("cos", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Cos cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("exp", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Exp cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("log", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Log cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("sin", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Sin cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("sqrt", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Sqrt cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("tan", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Tan cexpr
+    | ParseTree.FunctionCall
+      ([("Modelica", [||]); ("Math", [||]); ("tanh", [||])],
+      Some (ParseTree.ArgList ([expr] , None))) ->
+        let cexpr = compile_expression' expr in
+        Tanh cexpr
+    | ParseTree.FunctionCall (path, Some (ParseTree.ArgList (exprs , None))) ->
+        let cexprs = List.map compile_expression' exprs
+        and name, lccl = get_function_from path
+        in ExternalFunctionCall (name, lccl, cexprs)
+    | ParseTree.FunctionCall _ ->
+        failwith "compile_expression: invalid function call"
+    | ParseTree.GreaterEqualThan (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        GreaterEqualThan (cexpr, cexpr')
+    | ParseTree.GreaterThan (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        GreaterThan (cexpr, cexpr')
+    | ParseTree.If (assocs, expr) ->
+        compile_if assocs expr
+    | ParseTree.Integer s ->Integer (Int32.of_string s)
+    | ParseTree.LessEqualThan (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        GreaterEqualThan (cexpr', cexpr)
+    | ParseTree.LessThan (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        GreaterThan (cexpr', cexpr)
+    | ParseTree.ArrayConcatenation exprss ->
+        failwith "compile_expression: array concatenation not allowed"
+    | ParseTree.Minus expr -> Minus (compile_expression' expr)
+    | ParseTree.Multiplication (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Multiplication (cexpr, cexpr')
+    | ParseTree.Not expr -> Not (compile_expression' expr)
+    | ParseTree.NotEquals (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        NotEquals (cexpr, cexpr')
+    | ParseTree.Or (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Or (cexpr, cexpr')
+    | ParseTree.Plus expr -> compile_expression' expr
+    | ParseTree.Power (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Power (cexpr, cexpr')
+    | ParseTree.Range (expr, expr', expr_opt) ->
+        failwith "compile_expression: ranges not allowed"
+    | ParseTree.Real s -> Real (float_of_string s)
+    | ParseTree.Reference [("time", [||])] -> Time
+    | ParseTree.Reference cpnt_ref ->
+        Reference (compile_component_reference ctx cpnt_ref)
+    | ParseTree.String s -> String s
+    | ParseTree.Subtraction (expr, expr') ->
+        let cexpr = compile_expression' expr
+        and cexpr' = compile_expression' expr' in
+        Subtraction (cexpr, cexpr')
+    | ParseTree.True -> Boolean true
+    | ParseTree.VectorOrRecord (ParseTree.ArgList (exprs, None)) ->
+        Vector (Array.of_list (List.map compile_expression' exprs))
+    | ParseTree.VectorOrRecord (ParseTree.ArgList (_, Some _)) ->
+        failwith "compile_expression: for expressions not allowed"
+    | ParseTree.VectorOrRecord (ParseTree.NamedArgList _) ->
+        failwith "compile_expression: records not allowed"
+  and get_function_from path =
+    let name =
+      List.map
+        (function
+          | (s, [||]) -> s
+          | _ -> failwith "compile_expression: invalid function reference")
+        path
+    in
+    let f = create_filename name ".moc" in
+    let cu = read_class_file f in
+    match cu with
+      | CompiledFunction lccl -> name, lccl
+      | CompiledClass _ ->
+          failwith "compile_expression: invalid function reference"
+  and compile_if couples expr =
+    let cexpr = compile_expression' expr in
+    let ccouples =
+      List.fold_right
+        (fun couple ccouples ->
+          let cexpr, cexpr' = compile_couple couple in
+          (cexpr, cexpr') :: ccouples)
+        couples
+        []
+    in
+    If (ccouples, cexpr)
+  and compile_couple (expr, expr') =
+    let cexpr = compile_expression' expr
+    and cexpr' = compile_expression' expr' in
+    cexpr, cexpr'
+  in compile_expression' expr
+
+and compile_component_reference ctx cpnt_ref =
+  let rec compile_reference' ctx' level level' cpnt_ref = match ctx' with
+    | TopLevelContext -> raise Not_found
+    | ClassContext (ctx'', lccl) ->
+        compile_component_path ctx ctx' level cpnt_ref
+    | ModificationContext (ctx'', lccl) ->
+        begin try
+          compile_reference' ctx'' (level + 1) level' cpnt_ref
+        with
+          | Not_found ->
+              compile_component_path ctx ctx' level cpnt_ref
+        end
+    | ForContext (ctx'', id) ->
+        compile_loop_variable ctx'' level level' id cpnt_ref
+  and compile_loop_variable ctx'' level level' id = function
+    | [(id', [||])] when id' = id -> LoopVariableReference level'
+    | _ -> compile_reference' ctx'' level (level' + 1) cpnt_ref
+  in compile_reference' ctx 0 0 cpnt_ref
+
+and compile_component_path ctx ctx' level cpnt_ref =
+  let rec compile_component_path_in lccl = function
+    | [] -> failwith "compile_component_path: Invalid path"
+    | (id, array_subscrs) :: cpnt_ref ->
+        let cpnt = find_local_component_in lccl id in
+        let cs = compile_subscripts ctx array_subscrs in
+        (*FIXME: range case *)
+        let path = (id, cs) :: compile_path_rest cpnt_ref in
+        begin match cpnt with
+          | Parameter _ -> ParameterReference (level, path)
+          | Variable _ -> VariableReference (level, path)
+        end
+  and compile_path_rest = function
+    | [] -> []
+    | (id, array_subscrs) :: cpnt_ref ->
+        let cs = compile_subscripts ctx array_subscrs in
+        (*FIXME: range case *)
+        (id, cs) :: compile_path_rest cpnt_ref
+  in match ctx' with
+    | ClassContext (_, lccl) | ModificationContext (_, lccl) ->
+        compile_component_path_in lccl cpnt_ref
+    | TopLevelContext | ForContext _ ->
+        assert false (* Never applied to this kind of context *)
+
+and compile_subscripts ctx subscripts =
+  let rec compile_subscript = function
+    | ParseTree.All ->
+        failwith "compile_subscripts: ranges not allowed"
+    | ParseTree.Subscript expr ->
+        Definite (compile_expression ctx expr)
+  in Array.map compile_subscript subscripts
+
+and compile_modifications ctx modifs =
+  List.rev_map (compile_modification ctx) modifs
+
+and compile_modification ctx modif =
+  try compile_component_modification ctx modif with
+    | Not_found ->
+        let s = match modif with
+          | Modification (cpnt_ref, _, _) ->
+              List.fold_left (fun acc (id, _) -> acc ^ "." ^ id) "" cpnt_ref
+        in failwith ("compile_modification: component not found: " ^ s)
+
+and find_local_component_in lccl id =
+  let public_cpnts = Lazy.force (Lazy.force lccl).ccl_public_cpnts in
+  try Lazy.force (List.assoc id public_cpnts) with
+    | Not_found -> failwith ("find_local_component_in: " ^ id ^ " not found")
+
+and find_local_component_class_in lccl id =
+  match find_local_component_in lccl id with
+    | Variable (CompoundVariable (lccl, _)) -> lccl
+    | _ -> failwith "find_local_component_class_in: base type"
+
+and is_base_type_parameter_of lccl id =
+  match find_local_component_in lccl id with
+    | Parameter (IntegerParameter _ | RealParameter _) -> true
+    | _ -> false
+
+and is_base_type_variable_of lccl id =
+  match find_local_component_in lccl id with
+    | Variable (DiscreteVariable _ | RealVariable _) -> true
+    | _ -> false
+
+and compile_component_modification ctx modif = match ctx, modif with
+  | ModificationContext (_, lccl),
+    Modification ([(id, subscrs)], [], Some expr)
+    when is_base_type_parameter_of lccl id ->
+      let cs = compile_subscripts ctx subscrs
+      and cexpr = compile_expression ctx expr in
+      CompiledModification ((id, cs), [], Some cexpr)
+  | ModificationContext (_, lccl),
+    Modification ((id, _) :: _, _, _)
+    when is_base_type_parameter_of lccl id ->
+      failwith "compile_component_modification: invalid parameter modification"
+  | ModificationContext (_, lccl),
+    Modification ([(id, subscrs)], modifs, None)
+    when is_base_type_variable_of lccl id ->
+      let cs = compile_subscripts ctx subscrs
+      and cmodifs = compile_base_type_variable_modifications ctx modifs in
+      CompiledModification ((id, cs), cmodifs, None)
+  | ModificationContext (_, lccl),
+    Modification ([(id, _)], _, _)
+    when is_base_type_variable_of lccl id ->
+      failwith "compile_component_modification: invalid variable modification"
+  | ModificationContext (_, lccl),
+    Modification ([_], _, _) ->
+      failwith "compile_component_modification: invalid component modification"
+  | ModificationContext (_, lccl),
+    Modification ((id, subscrs) :: cpnt_ref, modifs, expr_opt) ->
+      let cs = compile_subscripts ctx subscrs
+      and cexpr_opt = opt_map (compile_expression ctx) expr_opt
+      and ctx' =
+        ModificationContext (ctx, find_local_component_class_in lccl id)
+      and modif = Modification (cpnt_ref, modifs, None) in
+      let cmodif = compile_modification ctx' modif in
+      CompiledModification ((id, cs), [cmodif], cexpr_opt)
+  | (TopLevelContext | ClassContext _), _ ->
+      assert false (* Never applied to this kind of context *)
+  | _ -> raise InvalidModification
+
+and compile_base_type_variable_modifications ctx = function
+  | [] -> []
+  | Modification ([("start", [||])], [], Some expr) :: modifs ->
+      let cexpr = compile_expression ctx expr in
+      CompiledModification (("start", [||]), [], Some cexpr) ::
+      compile_base_type_variable_modifications ctx modifs
+  | _ ->
+      failwith "compile_base_type_variable_modifications: invalid modification"
+
+and compile_component ctx pcpnt = match pcpnt.variability with
+  | Some ParseTree.Parameter -> Parameter (compile_parameter ctx pcpnt)
+  | Some ParseTree.Discrete | None -> Variable (compile_variable ctx pcpnt)
+  | _ -> failwith "compile_component: only variables and parameters allowed"
+
+and compile_parameter ctx pcpnt =
+  let attrs =
+    {
+      pat_dimensions = compile_subscripts ctx pcpnt.subscripts;
+      pat_comment = compile_comment pcpnt.comment;
+      pat_value =
+        opt_map (compile_expression ctx) (snd pcpnt.modification)
+    }
+  in match pcpnt.class_name with
+    | ["Integer"] -> IntegerParameter attrs
+    | ["Real"] -> RealParameter attrs
+    | _ -> failwith "compile_parameter: only base types allowed"
+
+and compile_variable ctx pcpnt =
+  let cmodifs = match pcpnt.class_name, snd pcpnt.modification with
+    | ["Integer"], None | ["Real"], None ->
+        compile_base_type_variable_modifications ctx (fst pcpnt.modification)
+    | name, None ->
+        let f = create_filename name ".moc" in
+        let cu = read_class_file f in
+        begin match cu with
+          | CompiledClass lccl ->
+              let ctx' = ModificationContext (ctx, lccl) in
+              compile_modifications ctx' (fst pcpnt.modification)
+          | CompiledFunction _ ->
+              failwith "compile_variable: functions not allowed as variables"
+        end
+    | _, Some _ ->
+        failwith
+          "compile_variable: equations not allowed in variable declarations"
+  in
+  let attrs =
+    {
+      vat_dimensions = compile_subscripts ctx pcpnt.subscripts;
+      vat_nature = compile_nature pcpnt.flow;
+      vat_inout = compile_inout pcpnt.inout;
+      vat_comment = compile_comment pcpnt.comment;
+      vat_modifications = cmodifs
+    }
+  in match pcpnt.class_name, pcpnt.variability with
+    | ["Real"], Some ParseTree.Discrete -> DiscreteVariable attrs
+    | ["Real"], None -> RealVariable attrs
+    | name, None ->
+        let f = create_filename name ".moc" in
+        let cu = read_class_file f in
+        begin match cu with
+          | CompiledClass lccl -> CompoundVariable (lccl, attrs)
+          | CompiledFunction _ ->
+              failwith "compile_variable: functions not allowed as variables"
+        end
+    | _ -> failwith "compile_variable: invalid variable declaration"
+
+and compile_nature = function
+  | Some ParseTree.Flow -> Flow
+  | None -> Potential
+
+and compile_inout = function
+  | Some ParseTree.Input -> Input
+  | Some ParseTree.Output -> Output
+  | None -> Both
+
+and compile_comment = function
+  | ParseTree.Comment (ParseTree.StringComment ss, None) ->
+      List.fold_left ( ^ ) "" ss
+  | ParseTree.Comment (_, Some _) ->
+      failwith "compile_comment: Annotations not allowed"
diff --git a/scilab/modules/scicos/src/modelica_compiler/compilation.mli b/scilab/modules/scicos/src/modelica_compiler/compilation.mli
new file mode 100644 (file)
index 0000000..1309d77
--- /dev/null
@@ -0,0 +1,156 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module performs the compilation of a subset of the Modelica language.
+*)
+
+exception InvalidModification
+exception TypeError
+
+type compiled_unit =
+    CompiledClass of compiled_class Lazy.t
+  | CompiledFunction of compiled_class Lazy.t
+(** The type of a compiled Modelica class *)
+
+and compiled_class = {
+  ccl_public_cpnts : (string * compiled_component Lazy.t) list Lazy.t;
+  ccl_initial_equs : compiled_equation list Lazy.t;
+  ccl_equs : compiled_equation list Lazy.t;
+}
+
+and compiled_modification =
+    CompiledModification of field * compiled_modification list *
+      compiled_expression option
+
+and field = string * compiled_subscript array
+
+and compiled_reference =
+    ParameterReference of level * path
+  | VariableReference of level * path
+  | LoopVariableReference of level
+  | ClassReference of level * string list
+
+and path = field list
+
+and level = int
+
+and compiled_subscript = Indefinite | Definite of compiled_expression
+
+and parameter =
+    IntegerParameter of parameter_attributes
+  | RealParameter of parameter_attributes
+
+and parameter_attributes = {
+  pat_dimensions : compiled_subscript array;
+  pat_comment : string;
+  pat_value : compiled_expression option;
+}
+
+and variable =
+    DiscreteVariable of variable_attributes
+  | RealVariable of variable_attributes
+  | CompoundVariable of compiled_class Lazy.t * variable_attributes
+
+and variable_attributes = {
+  vat_dimensions : compiled_subscript array;
+  vat_nature : nature;
+  vat_inout : inout;
+  vat_comment : string;
+  vat_modifications : compiled_modification list;
+}
+
+and compiled_component = Parameter of parameter | Variable of variable
+
+and nature = Flow | Potential
+
+and inout = Input | Output | Both
+
+and compiled_equation =
+    CompiledEquality of compiled_expression * compiled_expression
+  | CompiledFlowConnection of compiled_expression * compiled_expression
+  | CompiledIf of (compiled_expression * compiled_equation list) list *
+      compiled_equation list
+  | CompiledFor of compiled_expression * compiled_expression *
+      compiled_expression * compiled_equation list
+  | CompiledWhen of (compiled_expression * compiled_when_expression list) list
+
+and compiled_when_expression =
+  | Reinit of compiled_reference * compiled_expression
+  | Assign of compiled_reference * compiled_expression
+
+and compiled_expression =
+  | Abs of compiled_expression
+  | Addition of compiled_expression * compiled_expression
+  | And of compiled_expression * compiled_expression
+  | Boolean of bool
+  | Cardinality of compiled_expression
+  | Cos of compiled_expression
+  | Der of compiled_expression
+  | Division of compiled_expression * compiled_expression
+  | Equals of compiled_expression * compiled_expression
+  | Exp of compiled_expression
+  | ExternalFunctionCall of string list * compiled_class Lazy.t *
+    compiled_expression list
+  | Floor of compiled_expression
+  | GreaterEqualThan of compiled_expression * compiled_expression
+  | GreaterThan of compiled_expression * compiled_expression
+  | If of (compiled_expression * compiled_expression) list * compiled_expression
+  | Integer of int32
+  | Log of compiled_expression
+  | Max of compiled_expression * compiled_expression
+  | Min of compiled_expression * compiled_expression
+  | Minus of compiled_expression
+  | Mod of compiled_expression * compiled_expression
+  | Multiplication of compiled_expression * compiled_expression
+  | NoEvent of compiled_expression
+  | Not of compiled_expression
+  | NotEquals of compiled_expression * compiled_expression
+  | Or of compiled_expression * compiled_expression
+  | Power of compiled_expression * compiled_expression
+  | Real of float
+  | Reference of compiled_reference
+  | Sin of compiled_expression
+  | Sqrt of compiled_expression
+  | String of string
+  | Subtraction of compiled_expression * compiled_expression
+  | Tan of compiled_expression
+  | Tanh of compiled_expression
+  | Time
+  | Vector of compiled_expression array
+
+val paths : string list ref
+(** Global variable used to store the paths where to find compiled Modelica
+classes. *)
+
+val read_class_file : string -> compiled_unit
+(** [read_class_file name] finds then loads the compiled class named [name].
+A compiled Modelica class named "Class" is usually stored in a file named
+"Class.moc". The search is performed in the file system using
+{!Compilation.path}. *)
+
+val write_class_file : string -> compiled_unit -> unit
+(** [write_class_file name cu] stores the compiled Modelica class [cu] in a file
+named [name]. See {!Compilation.read_class_file} for more information about file
+naming conventions. *)
+
+val compile_main_class : Precompilation.precompiled_class -> compiled_unit
+(** [compile_main_class pcl] yields the compiled Modelica class associated to
+[pcl]. *)
diff --git a/scilab/modules/scicos/src/modelica_compiler/graphNodeSet.ml b/scilab/modules/scicos/src/modelica_compiler/graphNodeSet.ml
new file mode 100644 (file)
index 0000000..4155122
--- /dev/null
@@ -0,0 +1,136 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(* Functorial interface *)
+
+let hash_param = Hashtbl.hash_param
+
+let hash x = hash_param 10 100 x
+
+module type HashableType =
+  sig
+    type t
+    val hash: t -> int
+  end
+
+module type S =
+  sig
+    type elt
+    type 'a t
+    val create:
+      int -> ('a -> elt -> bool) -> ('a -> int) -> ('a -> int -> elt) -> 'a t
+    val find_or_add: 'a -> 'a t -> elt
+    val iter: (elt -> unit) -> 'a t -> unit
+  end
+
+module Make(H: HashableType): (S with type elt = H.t) =
+  struct
+
+    type elt = H.t
+
+    type 'a t =
+      {
+        equal : 'a -> elt -> bool;        (* equality function      *)
+        hash : 'a -> int;                 (* hash function          *)
+        create : 'a -> int -> elt;        (* creation function      *)
+        mutable max_len : int;            (* max length of a bucket *)
+        mutable data : elt Weak.t array   (* the buckets            *)
+      }
+
+    let create initial_size equalfun hashfun createfun =
+      let s = if initial_size < 1 then 1 else initial_size in
+      let s = if s > Sys.max_array_length then Sys.max_array_length else s in
+      {
+        equal = equalfun;
+        hash = hashfun;
+        create = createfun;
+        max_len = 3;
+        data = Array.init s (function n -> Weak.create 3)
+      }
+
+    let rec insert_from buckt some_elt n =
+      if n < 0 then failwith "Insertion error" else
+      match Weak.get buckt n with
+        | None -> Weak.set buckt n some_elt
+        | _ -> insert_from buckt some_elt (n - 1)
+
+    let resize s =
+      let odata = s.data in
+      let osize = Array.length odata in
+      let nsize = min (2 * osize + 1) Sys.max_array_length in
+      begin
+        s.max_len <- 2 * s.max_len;
+        let ndata = Array.init nsize (function n -> Weak.create s.max_len) in
+        let insert_bucket buckt =
+          for i = 0 to Weak.length buckt - 1 do
+            match Weak.get buckt i with
+                | None -> ()
+                | Some elt as some_elt ->
+                    insert_from
+                      ndata.((H.hash elt land max_int) mod nsize)
+                      some_elt
+                      (s.max_len - 1)
+          done
+        in
+          for i = 0 to osize - 1 do
+              insert_bucket odata.(i)
+          done;
+          s.data <- ndata;
+      end
+
+    let rec bucket_too_long n bucket =
+      if n < 0 then true else
+      match Weak.get bucket n with
+        | None -> false
+        | _ -> bucket_too_long (n - 1) bucket
+
+    let find_or_add elt_as_atoms s =
+      let equalfun = s.equal
+      and hash = s.hash elt_as_atoms land max_int
+      and createfun = s.create in
+      let rec add' bucket n option_pos =
+        if n < 0 then match option_pos with
+          | None ->
+              resize s;
+              add' s.data.(hash mod (Array.length s.data)) (s.max_len - 1) None
+          | Some pos ->
+              let elt = createfun elt_as_atoms hash in
+                Weak.set bucket pos (Some elt); elt
+        else match Weak.get bucket n with
+          | None ->
+              begin match option_pos with
+                | None -> add' bucket (n - 1) (Some n)
+                | _ -> add' bucket (n - 1) option_pos
+              end
+          | Some elt when equalfun elt_as_atoms elt -> elt
+          | _ -> add' bucket (n - 1) option_pos
+      in add' s.data.(hash mod (Array.length s.data)) (s.max_len - 1) None
+
+    let iter f s =
+      let iter_bucket bucket =
+        for i = 0 to Weak.length bucket - 1 do
+          match Weak.get bucket i with
+            | None -> ()
+            | Some elt -> f elt
+        done
+      in Array.iter iter_bucket s.data
+
+  end
diff --git a/scilab/modules/scicos/src/modelica_compiler/graphNodeSet.mli b/scilab/modules/scicos/src/modelica_compiler/graphNodeSet.mli
new file mode 100644 (file)
index 0000000..d8fc00a
--- /dev/null
@@ -0,0 +1,75 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module provides a structure that allow object sharing in order to
+create DAGs. Weak pointers are used to avoid keeping into the collection
+some objects that are no longer used elsewhere. *)
+
+(** Functorial interface *)
+
+module type HashableType =
+  sig
+    type t
+    val hash: t -> int
+  end
+    (** A hashable type is a type provided with one function whose purpose is to
+       get an integer value that represents the hash code of objects, i.e. an
+       integer associated. *)
+
+module type S =
+  sig
+    type elt
+    (** The type of the elements in the weak collection. *)
+    type 'a t
+    (** The type of the weak collection. *)
+    val create:
+      int -> ('a -> elt -> bool) -> ('a -> int) -> ('a -> int -> elt) -> 'a t
+    (** The parameters of create are:
+           - the initial size of the collection;
+           - an equality function that does does create a new object but rather
+             uses some atoms;
+           - a hash function that computes the value from the atoms (without
+             creating a new object);
+           - a constructor that creates a new object, given the necessary atoms
+             plus a hash value. *)
+    val find_or_add: 'a -> 'a t -> elt
+    (** find_or_add either returns an existing object whose atoms are the same
+         as the ones given as the first argument, either builds a new object and
+         insert it into the collection before returning it. *)
+    val iter: (elt -> unit) -> 'a t -> unit
+    (** iter applies its first argument to every argument of the collection. *)
+  end
+
+module Make:
+  functor (H: HashableType) ->
+    sig
+      type elt = H.t
+      and 'a t
+      val create:
+        int -> ('a -> elt -> bool) -> ('a -> int) -> ('a -> int -> elt) -> 'a t
+      val find_or_add: 'a -> 'a t -> elt
+      val iter: (elt -> unit) -> 'a t -> unit
+    end
+
+val hash_param: int -> int -> 'a -> int
+(** See {!Hashtbl.hash_param}. *)
+val hash: 'a -> int
+(** See {!Hashtbl.hash}. *)
diff --git a/scilab/modules/scicos/src/modelica_compiler/hungarianMethod.ml b/scilab/modules/scicos/src/modelica_compiler/hungarianMethod.ml
new file mode 100644 (file)
index 0000000..69982ed
--- /dev/null
@@ -0,0 +1,249 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+
+module type MatrixElement =
+  sig
+    type t
+    val zero: t
+    val infinity: t
+    val equal: t -> t -> bool
+    val compare: t -> t -> int
+    val add: t -> t -> t
+    val sub: t -> t -> t
+  end
+
+module type Matrix =
+  sig
+    type elt
+    type t
+    val init: int -> elt -> (int -> int -> elt) -> t
+    val iterij: (int -> int -> elt -> unit) -> t -> unit
+    val row_storage_iterj: int -> (int -> elt -> unit) -> t -> unit
+    val update_row_storage: int -> (int -> elt -> elt) -> t -> unit
+    val column_storage_iteri: int -> (int -> elt -> unit) -> t -> unit
+    val update_column_storage: int -> (int -> elt -> elt) -> t -> unit
+  end
+
+module type BipartiteGraph =
+  sig
+    type t
+    val create: int -> t
+    val link: int -> int -> t -> unit
+    val ford_and_fulkerson: t -> int * (int * int option) list
+  end
+
+module type S =
+  sig
+    type elt
+    type t
+    val init: int -> (int -> int -> elt) -> t
+    val perform: t -> (int * int option) list
+    val print_with: (elt -> unit) -> t -> unit
+  end
+
+module Make
+  (E: MatrixElement)
+  (M: Matrix with type elt = E.t)
+  (B: BipartiteGraph):
+    (S with type elt = E.t) =
+
+  struct
+
+    type elt = E.t
+
+    type t =
+      {
+        size: int;
+        row_marks: bool array;
+        column_marks: bool array;
+        framed_zeros: int array;
+        matrix: M.t;
+        graph: B.t
+      }
+
+    let init size f =
+      let matrix =
+        M.init size E.infinity f
+      in
+        {
+          size = size;
+          row_marks = Array.make size false;
+          column_marks = Array.make size false;
+          framed_zeros = Array.make size (-1);
+          (* -1 ensures is_framed_zero to work properly *)
+          matrix = matrix;
+          graph = B.create size
+        }
+
+    let minimum elt elt' = if E.compare elt elt' < 0 then elt else elt'
+
+    let perform strct =
+      let min_row i =
+        let min = ref E.infinity in
+        M.row_storage_iterj
+          i
+          (fun _ elt -> min := minimum !min elt)
+          strct.matrix;
+        !min
+      and min_column j =
+        let min = ref E.infinity in
+        M.column_storage_iteri
+          j
+          (fun _ elt -> min := minimum !min elt)
+          strct.matrix;
+        !min
+      and sub_row i elt =
+        M.update_row_storage i (fun _ elt' -> E.sub elt' elt) strct.matrix
+      and sub_column j elt =
+        M.update_column_storage j (fun _ elt' -> E.sub elt' elt) strct.matrix
+      and is_framed_zero i j = strct.framed_zeros.(j) = i
+      and is_marked_row i = strct.row_marks.(i)
+      and is_marked_column j = strct.column_marks.(j)
+      and mark_row i = strct.row_marks.(i) <- true
+      and mark_column j = strct.column_marks.(j) <- true
+      and size = strct.size in
+      let init_data () =
+        for i = 0 to size - 1 do
+          sub_row i (min_row i)
+        done;
+        for j = 0 to size - 1 do
+          sub_column j (min_column j)
+        done;
+        for i = 0 to size - 1 do
+          M.row_storage_iterj
+            i
+            (fun j elt ->
+              if E.compare elt E.zero = 0 then B.link i j strct.graph)
+            strct.matrix
+        done
+      and element_to_subtract () =
+        let min = ref E.infinity in
+        for i = 0 to size - 1 do
+          if is_marked_row i then
+            M.row_storage_iterj
+              i
+              (fun j elt ->
+                if not (is_marked_column j) then min := minimum !min elt)
+              strct.matrix
+        done;
+        !min
+      in
+      let update_matrix_and_graph elt =
+        for i = 0 to size - 1 do
+          if is_marked_row i then
+            M.update_row_storage
+              i
+              (fun j elt' ->
+                  if is_marked_column j then elt'
+                  else
+                    let elt'' = E.sub elt' elt in
+                    if E.compare elt'' E.zero = 0 then B.link i j strct.graph;
+                    elt'')
+              strct.matrix
+          else
+            M.update_row_storage
+              i
+              (fun j elt' ->
+                  if is_marked_column j then E.add elt' elt
+                  else elt')
+              strct.matrix
+        done
+      in
+      let rec first_mark () = match B.ford_and_fulkerson strct.graph with
+        | size', pairs when size' = size ->
+            List.map
+              (fun (i, opt) -> match opt with
+                | Some j -> i, Some j
+                | None -> assert false)
+              pairs
+        | _, pairs ->
+            let marked_rows =
+              List.fold_left
+                (fun marked_rows (i, opt) -> match opt with
+                  | None -> mark_row i; i :: marked_rows (* side effect *)
+                  | Some j ->
+                      strct.framed_zeros.(j) <- i;
+                      marked_rows) (* side effect *)
+                []
+                pairs
+            in second_mark marked_rows
+      and second_mark marked_rows =
+        let marked_columns_ref = ref [] in
+        List.iter
+          (fun i ->
+            M.row_storage_iterj
+              i
+              (fun j elt ->
+                if not (is_marked_column j) then
+                  if E.compare elt E.zero = 0 && not (is_framed_zero i j) then
+                    begin
+                      mark_column j; (* side effect *)
+                      marked_columns_ref := j :: !marked_columns_ref
+                      (* side effect *)
+                    end)
+              strct.matrix)
+          marked_rows;
+        third_mark !marked_columns_ref
+      and third_mark marked_columns =
+        let marked_rows =
+          List.fold_left
+            (fun marked_rows j -> match strct.framed_zeros.(j) with
+              | i when i >= 0 && not (is_marked_row i) ->
+                  mark_row i; i :: marked_rows (* side effect *)
+              | _ -> marked_rows)
+            []
+            marked_columns
+        in match marked_rows with
+          | [] -> update_data ()
+          | _ -> second_mark marked_rows
+      and update_data () =
+        let elt = element_to_subtract () in
+        match E.compare elt E.infinity with
+          | 0 ->
+              let res_ref = ref [] in
+              Array.iteri
+                  (fun i elt -> match elt with
+                      | -1 -> res_ref := (i, None) :: !res_ref
+                      | j -> res_ref := (i, Some j) :: !res_ref)
+                  strct.framed_zeros;
+              !res_ref
+          | _ ->
+              update_matrix_and_graph elt;
+              for i = 0 to size - 1 do
+                strct.row_marks.(i) <- false;
+                strct.column_marks.(i) <- false
+              done;
+              first_mark ()
+      in init_data (); first_mark ()
+
+    let print_with print_fun strct =
+      M.iterij
+        (fun i j elt ->
+          print_int i;
+          print_string ", ";
+          print_int j;
+          print_string " -> ";
+          print_fun elt;
+          print_newline ())
+        strct.matrix
+
+  end
diff --git a/scilab/modules/scicos/src/modelica_compiler/hungarianMethod.mli b/scilab/modules/scicos/src/modelica_compiler/hungarianMethod.mli
new file mode 100644 (file)
index 0000000..18f1181
--- /dev/null
@@ -0,0 +1,158 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This modules provides structures and functions that performs the
+causality analysis using the Hungarian Method. *)
+
+(** The module type that specifies the interface of a suitable module
+providing matrix elements. The following properties must be verified by
+the elements in order to get correct results:
+[compare x y] must have the following behavior:
+
+{v
+\ y  | +Inf |   y'
+x \  |      |
+-----+------+-----------
++Inf |  0   |   z>0
+-----+------+-----------
+ x'  | z<0  | 0, if x'=y'
+     |      | z<0, if x'<y'
+     |      | z>0, if x'>y'
+v}
+
+[x = y] is [true] iff [compare x y] returns [0].
+
+[add x y] must have the following behavior:
+
+{v
+\ y  | +Inf |   y'
+x \  |      |
+-----+------+-----------
++Inf | +Inf |  +Inf
+-----+------+-----------
+ x'  | +Inf | z=x'+y'
+v}
+
+[sub x y] must have the following behavior:
+
+{v
+\ y  | +Inf |   y'
+x \  |      |
+-----+------+-----------
++Inf |  ?   |  +Inf
+-----+------+-----------
+ x'  |  ?   | z=x'-y'
+v}
+
+*)
+module type MatrixElement =
+  sig
+    type t
+    (** the type of the matrix elements *)
+    val zero: t (** the object of type t representing 0 *)
+    val infinity: t (** the object of type t representing +Inf *)
+    val equal: t -> t -> bool
+    val compare: t -> t -> int
+    val add: t -> t -> t
+    val sub: t -> t -> t
+  end
+
+module type Matrix =
+  sig
+    type elt
+    (** the type of the elements of the matrix *)
+    type t
+    (** the type of the sparse matrices        *)
+    val init: int -> elt -> (int -> int -> elt) -> t
+    (** [init size default f] creates a square sparse matrix of
+    [size]*[size] elements whose default element is [default] and whose
+    initial elements are given by [f] ([f i j] returns the element to be
+    placed at ([i], [j])). *)
+    val iterij: (int -> int -> elt -> unit) -> t -> unit
+    (** [iterij f mtrx] behaves like [iter f mtrx] except that f receives
+    the row index as first argument, the column index as second argument
+    and the current element as third argument. *)
+    val row_storage_iterj: int -> (int -> elt -> unit) -> t -> unit
+    (** [row_storage_iterj i f mtrx] is a restriction of
+    [row_iterj i f mtrx] to the elements effectively stored into the matrix,
+    in an unspecified order. Provided for efficiency. *)
+    val update_row_storage: int -> (int -> elt -> elt) -> t -> unit
+    (** [update_row_storage i f mtrx] replaces the elements effectively
+    stored into [mtrx] at row [i] by the results of [f] applyied to the
+    current column index as first argument and the current element as
+    second argument, in an unspecified order. Provided for efficiency. *)
+    val column_storage_iteri: int -> (int -> elt -> unit) -> t -> unit
+    (** [column_storage_iteri j f mtrx] is a restriction of
+    [column_iteri j f mtrx] to the elements effectively stored into the
+    matrix, in an unspecified order. Provided for efficiency. *)
+    val update_column_storage: int -> (int -> elt -> elt) -> t -> unit
+    (** [update_column_storage j f mtrx] replaces the elements effectively
+    stored into [mtrx] at column [j] by the results of [f] applyied to the
+    current row index as first argument and the current element as
+    second argument, in an unspecified order. Provided for efficiency. *)
+  end
+
+module type BipartiteGraph =
+  sig
+    type t
+    (** The type of the bipartite graphs. *)
+
+    val create : int -> t
+    (** [create size] creates a bipartite graph of size [size]. *)
+
+    val link : int -> int -> t -> unit
+    (** [link i j bg] links the [i]th left-side node of [bg] to the [j]th
+    right-side node of [bg]. If [i] or [j] are outside \[0, size) where size
+    is the size of [bg], Invalid_argument is raised. *)
+
+    val ford_and_fulkerson : t -> int * (int * int option) list
+    (** [ford_and_fulkerson bg] performs the Ford and Fulkerson method over the
+    bipartite graph [bg], returning a couple whose first element is the
+    number of successful coupling an second one a list whose elements are of
+    the form [(i, None)] if no right-side node could be associated to the
+    [i]th left-side one and [(i, Some j)] in case of success. *)
+  end
+
+module type S =
+  sig
+    type elt
+    (** the type of the objects manipulated by the method *)
+    type t
+     (** the type of the structure used to hold the data   *)
+    val init: int -> (int -> int -> elt) -> t
+    (** [init size fun] returns a structure on which it is possible
+    to perform the Hungarian Method. [size] is the size of the square matrix
+    used to perform the method. Given a pair of ints [(i, j)], [fun i j]
+    returns the weight associated with [(i, j)]. *)
+    val perform: t -> (int * int option) list
+    (** [perform struct] effectively performs the Hungarian Method, given
+    [struct] created using [init]. *)
+    val print_with: (elt -> unit) -> t -> unit
+    (** [print_with print_fun mtrx] prints the matrix used to perform the
+    Hungarian Method. [print_fun] is the function that prints matrix elements.
+    *)
+  end
+
+module Make
+  (E: MatrixElement)
+  (M: Matrix with type elt = E.t)
+  (B: BipartiteGraph):
+    (S with type elt = E.t)
diff --git a/scilab/modules/scicos/src/modelica_compiler/instantiation.ml b/scilab/modules/scicos/src/modelica_compiler/instantiation.ml
new file mode 100644 (file)
index 0000000..315ab14
--- /dev/null
@@ -0,0 +1,2352 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+
+(* Datatypes *)
+
+type instantiated_class =
+  {
+    icl_components: (string * instantiated_component Lazy.t) list Lazy.t;
+    icl_init_equs: equation list Lazy.t;
+    icl_equs: equation list Lazy.t
+  }
+
+and instantiated_component =
+  | InstantiatedParameter of instantiated_parameter
+  | InstantiatedVariable of instantiated_variable
+
+and instantiated_parameter =
+  | InstantiatedIntegerParameter of string * parameter_kind * typed_expression
+  | InstantiatedRealParameter of string * parameter_kind * typed_expression
+
+and parameter_kind =
+  | Main
+  | Sub
+
+and instantiated_variable =
+  | InstantiatedDiscreteVariable of string * Compilation.inout *
+    typed_expression
+  | InstantiatedRealVariable of string * Compilation.inout *
+    Compilation.nature * typed_expression
+  | InstantiatedCompoundVariable of string * typed_expression
+
+and equation =
+  | Equation of typed_expression * typed_expression
+  | ConditionalEquation of (typed_expression * equation list) list *
+    equation list
+  | FlowConnection of typed_expression * typed_expression
+  | When of when_clause_type
+
+and when_clause_type =
+  (typed_expression * typed_when_expression list) list
+
+and typed_when_expression =
+  | Reinit of typed_expression * typed_expression
+  | Assign of typed_expression * typed_expression
+
+and typed_expression =
+  {
+    tex_type: expression_type;
+    tex_expression: expression option
+  }
+
+and expression_type =
+  | BooleanType of int array
+  | CartesianProduct of expression_type list
+  | CompoundType of int array
+  | IntegerType of int array
+  | RealType of int array
+  | StringType of int array
+
+and expression =
+  | Abs of typed_expression
+  | Addition of typed_expression * typed_expression
+  | And of typed_expression * typed_expression
+  | Boolean of bool
+  | Cardinality of typed_expression
+  | CompoundElement of instantiated_class
+  | Cos of typed_expression
+  | Der of typed_expression
+  | Division of typed_expression * typed_expression
+  | Equals of typed_expression * typed_expression
+  | Exp of typed_expression
+  | ExternalFunctionCall of string list * typed_expression list
+  | Floor of typed_expression
+  | GreaterEqualThan of typed_expression * typed_expression
+  | GreaterThan of typed_expression * typed_expression
+  | If of (typed_expression * typed_expression) list * typed_expression
+  | Integer of int32
+  | Log of typed_expression
+  | Max of typed_expression * typed_expression
+  | Min of typed_expression * typed_expression
+  | Mod of typed_expression * typed_expression
+  | Minus of typed_expression
+  | Multiplication of typed_expression * typed_expression
+  | NoEvent of typed_expression
+  | Not of typed_expression
+  | NotEquals of typed_expression * typed_expression
+  | Or of typed_expression * typed_expression
+  | ParameterValue of int * reference
+  | Power of typed_expression * typed_expression
+  | Real of float
+  | Sin of typed_expression
+  | Sqrt of typed_expression
+  | String of string
+  | Subtraction of typed_expression * typed_expression
+  | Tan of typed_expression
+  | Tanh of typed_expression
+  | Time
+  | VariableStart of int * reference
+  | VariableValue of int * reference
+  | Vector of typed_expression array
+
+and reference = (string * int array) list
+
+and instantiation_context =
+  | ToplevelContext
+  | ClassContext of instantiation_context * instantiated_class Lazy.t
+  | ForContext of instantiation_context * int
+
+and modification =
+  | Modification of (string * int array) * modification list * typed_expression option
+
+
+(* Misc *)
+
+let string_of_expression  iexpr =
+  let rec string_of_expression' iexpr = match iexpr.tex_expression with
+    | None -> "???"
+    | Some expr -> string_of_expression'' expr
+  and string_of_expression'' = function
+    | Abs iexpr -> "(abs " ^ string_of_expression' iexpr ^ ")"
+    | Addition (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " + " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | And (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " and " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Boolean false -> "false"
+    | Boolean true -> "true"
+    | Cos iexpr -> "(cos " ^ string_of_expression' iexpr ^ ")"
+    | Der _ -> "(der <var>)"
+    | Division (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " / " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Equals (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " == " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Exp iexpr -> "(exp " ^ string_of_expression' iexpr ^ ")"
+    | ExternalFunctionCall (name, iexprs) -> "<funcall>"
+    | GreaterEqualThan (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " >= " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | GreaterThan (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " > " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | If (iif_exprs, iexpr) -> string_of_if iif_exprs iexpr
+    | Integer i -> Int32.to_string i
+    | Log iexpr -> "(log " ^ string_of_expression' iexpr ^ ")"
+    | Max (iexpr, iexpr') ->
+        "(max " ^
+        string_of_expression' iexpr ^
+        ", " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Min (iexpr, iexpr') ->
+        "(min " ^
+        string_of_expression' iexpr ^
+        ", " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Minus iexpr -> "(- " ^ string_of_expression' iexpr ^ ")"
+    | Multiplication (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " * " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | NoEvent iexpr -> "(noEvent " ^ string_of_expression' iexpr ^ ")"
+    | Not iexpr -> "(not " ^ string_of_expression' iexpr ^ ")"
+    | NotEquals (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " <> " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Or (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " or " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | ParameterValue (_, iref) -> string_of_reference iref
+    | Power (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " ^ " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Real f -> string_of_float f
+    | Sin iexpr -> "(sin " ^ string_of_expression' iexpr ^ ")"
+    | Sqrt iexpr -> "(sqrt " ^ string_of_expression' iexpr ^ ")"
+    | String s -> s
+    | Subtraction (iexpr, iexpr') ->
+        "(" ^
+        string_of_expression' iexpr ^
+        " - " ^
+        string_of_expression' iexpr' ^
+        ")"
+    | Tan iexpr -> "(tan " ^ string_of_expression' iexpr ^ ")"
+    | Tanh iexpr -> "(tanh " ^ string_of_expression' iexpr ^ ")"
+    | Time -> "time"
+    | VariableStart (_, iref) -> string_of_reference iref
+    | VariableValue (_, iref) -> string_of_reference iref
+    | Vector iexprs ->
+        Array.fold_left
+          (fun acc iexpr -> acc ^ string_of_expression' iexpr ^ ", ")
+          "{"
+          iexprs ^ "}"
+    | _ -> failwith "string_of_expression: bad expression"
+  and string_of_if iif_exprs iexpr = match iif_exprs with
+    | [] -> string_of_expression' iexpr
+    | (iexpr', iexpr'') :: iif_exprs' ->
+        "(if " ^
+        string_of_expression' iexpr' ^
+        " then " ^
+        string_of_expression' iexpr'' ^
+        " else " ^
+        string_of_if iif_exprs' iexpr ^
+        ")"
+  and string_of_reference = function
+    | [] -> ""
+    | (id, _) :: iref -> id ^ "[]" ^ string_of_reference iref
+  in string_of_expression' iexpr
+
+let separate_parameters_from_variables cpnts =
+  let rec partition pars vars = function
+    | [] -> List.rev pars, List.rev vars
+    | Compilation.Parameter par :: cpnts ->
+        partition (par :: pars) vars cpnts
+    | Compilation.Variable var :: cpnts ->
+        partition pars (var :: vars) cpnts
+  in partition [] [] cpnts
+
+let separate_inputs_from_others vars =
+  let rec partition inputs others = function
+    | [] -> List.rev inputs, List.rev others
+    | ((Compilation.DiscreteVariable attrs | Compilation.RealVariable attrs)
+      as var) :: vars when attrs.Compilation.vat_inout = Compilation.Input ->
+        partition (var :: inputs) others vars
+    | var :: vars -> partition inputs (var :: others) vars
+  in partition [] [] vars
+
+let separate_outputs_from_others vars =
+  let rec partition outputs others = function
+    | [] -> List.rev outputs, List.rev others
+    | ((Compilation.DiscreteVariable attrs | Compilation.RealVariable attrs)
+      as var) :: vars when attrs.Compilation.vat_inout = Compilation.Output ->
+        partition (var :: outputs) others vars
+    | var :: vars -> partition outputs (var :: others) vars
+  in partition [] [] vars
+
+
+(* Instantiation *)
+
+let rec instantiate_main_class ctx modifs ccl =
+  let rec ctx' = ClassContext (ctx, licl)
+  and licl = lazy(
+    {
+      icl_components = lazy(
+        instantiate_main_components
+          ctx'
+          modifs
+          ccl.Compilation.ccl_public_cpnts);
+      icl_init_equs = lazy(
+        instantiate_equations ctx' ccl.Compilation.ccl_initial_equs);
+      icl_equs = lazy(
+        instantiate_equations ctx' ccl.Compilation.ccl_equs)
+    })
+  in
+    {
+      tex_type = CompoundType [||];
+      tex_expression = Some (CompoundElement (Lazy.force licl))
+    }
+
+and instantiate_main_components ctx modifs lccpnts =
+  let rec instantiate_main_component modifs' ccpnt = match ccpnt with
+      | Compilation.Parameter param ->
+          InstantiatedParameter (instantiate_main_parameter ctx modifs' param)
+      | Compilation.Variable var ->
+          InstantiatedVariable (instantiate_variable ctx modifs' var)
+  in
+  List.map
+    (fun (s, lccpnt) ->
+      let modifs' = List.fold_left (filter_modification_of s) [] modifs in
+      s, lazy (instantiate_main_component modifs' (Lazy.force lccpnt)))
+    (Lazy.force lccpnts)
+
+and instantiate_main_parameter ctx modifs = function
+  | Compilation.IntegerParameter attrs ->
+      let default =
+        {
+          tex_type = IntegerType [||];
+          tex_expression = Some (Integer Int32.zero)
+        }
+      and make comment ivalue =
+        InstantiatedIntegerParameter (comment, Main, ivalue)
+      in initialize_parameter ctx default modifs attrs make
+  | Compilation.RealParameter attrs ->
+      let default =
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Real 0.0)
+        }
+      and make comment ivalue =
+        InstantiatedRealParameter (comment, Main, ivalue)
+      in initialize_parameter ctx default modifs attrs make
+
+and instantiate_class ctx modifs ccl =
+  let rec ctx' = ClassContext (ctx, licl)
+  and licl = lazy(
+    {
+      icl_components = lazy(
+        instantiate_components ctx' modifs ccl.Compilation.ccl_public_cpnts);
+      icl_init_equs = lazy(
+        instantiate_equations ctx' ccl.Compilation.ccl_initial_equs);
+      icl_equs = lazy(
+        instantiate_equations ctx' ccl.Compilation.ccl_equs)
+    })
+  in
+    {
+      tex_type = CompoundType [||];
+      tex_expression = Some (CompoundElement (Lazy.force licl))
+    }
+
+and instantiate_components ctx modifs lccpnts =
+  let rec instantiate_component modifs' ccpnt = match ccpnt with
+      | Compilation.Parameter (param) ->
+          InstantiatedParameter (instantiate_parameter ctx modifs' param)
+      | Compilation.Variable (var) ->
+          InstantiatedVariable (instantiate_variable ctx modifs' var)
+  in
+  List.map
+    (fun (s, lccpnt) ->
+      let modifs' = List.fold_left (filter_modification_of s) [] modifs in
+      s, lazy (instantiate_component modifs' (Lazy.force lccpnt)))
+    (Lazy.force lccpnts)
+
+and filter_modification_of s modifs = function
+  | Compilation.CompiledModification ((s', [||]), modifs', None) when s = s' ->
+      modifs' @ modifs
+  | Compilation.CompiledModification ((s', [||]), modifs', Some cexpr)
+    when s = s' ->
+      Compilation.CompiledModification (("start", [||]), [], Some cexpr) ::
+      (modifs' @ modifs)
+  | _ -> modifs
+
+and instantiate_parameter ctx modifs = function
+  | Compilation.IntegerParameter attrs ->
+      let default =
+        {
+          tex_type = IntegerType [||];
+          tex_expression = Some (Integer Int32.zero)
+        }
+      and make comment ivalue =
+        InstantiatedIntegerParameter (comment, Sub, ivalue)
+      in initialize_parameter ctx default modifs attrs make
+  | Compilation.RealParameter attrs ->
+      let default =
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Real 0.0)
+        }
+      and make comment ivalue =
+        InstantiatedRealParameter (comment, Sub, ivalue)
+      in initialize_parameter ctx default modifs attrs make
+
+and initialize_parameter ctx default modifs attrs make =
+  let comment = attrs.Compilation.pat_comment
+  and cdims = attrs.Compilation.pat_dimensions
+  and value_opt = attrs.Compilation.pat_value in
+  let dims = Array.map (compute_subscript ctx) cdims in
+  let ivalue = calculate_initial_value ctx dims default modifs value_opt in
+  make comment ivalue
+
+
+and calculate_initial_value ctx dims default modifs value_opt =
+  match modifs, value_opt with
+    | [], None -> create_array dims default
+    | [], Some cexpr ->
+        let iexpr = instantiate_expression ctx cexpr in
+        begin match iexpr.tex_type, default.tex_type with
+          | (IntegerType dims', IntegerType _ |
+            (RealType dims' | IntegerType dims'), RealType _)
+            when dims' = dims -> iexpr
+          | _ ->
+              failwith
+                ("calculate_initial_value: type error: " ^
+                string_of_expression iexpr)
+        end
+    | [Compilation.CompiledModification (("start", [||]), [], Some cexpr)], _ ->
+        let iexpr = instantiate_expression ctx cexpr in
+        begin match iexpr.tex_type, default.tex_type with
+          | (IntegerType dims', IntegerType _ |
+            (RealType dims' | IntegerType dims'), RealType _)
+            when dims' = dims -> iexpr
+          | _ ->
+              failwith
+                ("calculate_initial_value: type error: " ^
+                string_of_expression iexpr)
+        end
+    | _ -> failwith "calculate_initial_value: invalid modification"
+
+and instantiate_variable ctx modifs = function
+    | Compilation.DiscreteVariable attrs ->
+      let default =
+        {
+          tex_type = RealType [||];
+          tex_expression = None
+        }
+      and make comment inout flow ivalue =
+        InstantiatedDiscreteVariable (comment, inout, ivalue)
+      in initialize_base_type_variable ctx default modifs attrs make
+    | Compilation.RealVariable attrs ->
+      let default =
+        {
+          tex_type = RealType [||];
+          tex_expression = None
+        }
+      and make comment inout flow ivalue =
+        InstantiatedRealVariable (comment, inout, flow, ivalue)
+      in initialize_base_type_variable ctx default modifs attrs make
+    | Compilation.CompoundVariable (lccl, attrs) ->
+        initialize_compound_variable ctx modifs lccl attrs
+
+and initialize_compound_variable ctx modifs lccl attrs =
+  let comment = attrs.Compilation.vat_comment
+  and cdims = attrs.Compilation.vat_dimensions
+  and modifs' = attrs.Compilation.vat_modifications in
+  let dims = Array.map (compute_subscript ctx) cdims in
+  let ivalue = init_array dims ctx modifs modifs' (Lazy.force lccl) in
+  InstantiatedCompoundVariable (comment, ivalue)
+
+and init_array dims ctx modifs modifs' ccl =
+  let preprocess_modification = function
+    | Compilation.CompiledModification ((_, cs), modifs, None) ->
+        Array.to_list (Array.map (compute_subscript ctx) cs), modifs
+    | _ -> failwith "init_array: invalid modification" in
+  let rec filter_pmodifs i = function
+    | (i' :: _, _) as pmodif :: pmodifs' when i = i' ->
+        pmodif :: filter_pmodifs i pmodifs'
+    | (_ :: _, _) :: pmodifs' -> filter_pmodifs i pmodifs'
+    | _ -> failwith "init_array: type error"
+  and create_array i pmodifs =
+    if i = Array.length dims then
+      begin match pmodifs with
+        | [] -> instantiate_class ctx modifs' ccl
+        | [([], modifs)] ->
+            instantiate_class ctx (merge_modifications modifs modifs') ccl
+        | _ -> failwith "init_array: invalid modification"
+      end
+    else
+      let iexpr_array = Array.init dims.(i) (init_array' pmodifs i) in
+        {
+          tex_type = compute_array_type iexpr_array;
+          tex_expression = Some (Vector iexpr_array)
+        }
+  and init_array' pmodifs n i =
+    let pmodifs' = filter_pmodifs i pmodifs in
+    create_array (n + 1) pmodifs'
+  in create_array 0 (List.map preprocess_modification modifs)
+
+and merge_modifications modifs modifs' =
+  let rec add_modif_to modifs modif = match modifs, modif with
+    | Compilation.CompiledModification (field, inners, cexpr_opt) as modif' ::
+      modifs',
+      Compilation.CompiledModification (field', inners', cexpr_opt')
+      when field = field' ->
+        let inners'' = merge_modifications inners inners'
+        and cexpr_opt'' = merge_optional_values cexpr_opt cexpr_opt' in
+        Compilation.CompiledModification (field, inners'', cexpr_opt'') ::
+        modifs'
+    | modif' :: modifs', _ -> modif' :: add_modif_to modifs' modif
+    | [], _ -> [modif]
+  and merge_optional_values cexpr_opt cexpr_opt' =
+    match cexpr_opt, cexpr_opt' with
+      | None, None -> None
+      | Some cexpr, (Some _ | None) -> cexpr_opt
+      | None, Some cexpr' -> cexpr_opt
+  in List.fold_left add_modif_to modifs modifs'
+
+and initialize_base_type_variable ctx default modifs attrs make =
+  let comment = attrs.Compilation.vat_comment
+  and inout = attrs.Compilation.vat_inout
+  and flow = attrs.Compilation.vat_nature
+  and cdims = attrs.Compilation.vat_dimensions
+  and value_opt = match attrs.Compilation.vat_modifications with
+    | [Compilation.CompiledModification (("value", [||]), [], cexpr_opt)] |
+      [Compilation.CompiledModification (("start", [||]), [], cexpr_opt)] ->
+        cexpr_opt
+    | [] -> None
+    | _ -> failwith "initialize_variable: invalid modification"
+  in
+  let dims = Array.map (compute_subscript ctx) cdims in
+  let ivalue = calculate_initial_value ctx dims default modifs value_opt in
+  make comment inout flow ivalue
+
+and create_array dims default =
+  let rec create_array' i value =
+    if i < 0 then value
+    else
+      let iexpr_array = Array.make dims.(i) value in
+      let value' =
+        {
+          tex_type = compute_array_type iexpr_array;
+          tex_expression = Some (Vector iexpr_array)
+        }
+      in create_array' (i - 1) value'
+  in create_array' (Array.length dims - 1) default
+
+and instantiate_equations ctx lequs =
+  List.fold_left (instantiate_equation ctx) [] (Lazy.force lequs)
+
+and instantiate_equation ctx equs = function
+  | Compilation.CompiledEquality (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType dims, BooleanType dims' |
+          IntegerType dims, IntegerType dims' |
+          (RealType dims | IntegerType dims), RealType dims' |
+          RealType dims, IntegerType dims' |
+          StringType dims, StringType dims'
+          when dims = dims' -> Equation (iexpr, iexpr') :: equs
+        | _ ->
+          let s = string_of_expression iexpr
+          and s' = string_of_expression iexpr' in
+            failwith
+              ("instanciate_equation: type error in equality between " ^
+              s ^ " and " ^ s')
+      end
+  | Compilation.CompiledFlowConnection (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | RealType dims, RealType dims' when dims = dims' ->
+            FlowConnection (iexpr, iexpr') :: equs
+        | _ -> failwith "instanciate_equation: type error in connection"
+      end
+  | Compilation.CompiledIf (cif_clauses, cequs) ->
+      let iif_clauses =
+        List.map
+          (fun (cexpr, cequs) ->
+            let iexpr = instantiate_expression ctx cexpr
+            and iequs = List.fold_left (instantiate_equation ctx) [] cequs in
+            match iexpr.tex_type with
+              | BooleanType [||] -> iexpr, iequs
+              | _ -> failwith "instanciate_equation: type error in if")
+          cif_clauses
+      and iequs = List.fold_left (instantiate_equation ctx) [] cequs in
+      ConditionalEquation (iif_clauses, iequs) :: equs
+  | Compilation.CompiledFor (cexpr, cexpr', cexpr'', cequs) ->
+      begin match
+        evaluate_integer_expression ctx cexpr,
+        evaluate_integer_expression ctx cexpr',
+        evaluate_integer_expression ctx cexpr''
+      with
+        | Integer i, Integer i', Integer i'' ->
+            let start = Int32.to_int i
+            and stop = Int32.to_int i'
+            and step = Int32.to_int i''
+            in expand_for_equation ctx start stop step cequs @ equs
+        | _ -> failwith "instanciate_equation: type error in for"
+      end
+  | Compilation.CompiledWhen cwhen_clauses ->
+      let iwhen_clauses =
+        List.map
+          (fun (cexpr, cequs) ->
+            let iexpr = instantiate_expression ctx cexpr
+            and iequs = instantiate_when_equations ctx cequs in
+            match iexpr.tex_type with
+              | BooleanType [||] -> iexpr, iequs
+              | _ -> failwith "instanciate_equation: type error in when")
+          cwhen_clauses
+      in When iwhen_clauses :: equs
+
+and evaluate_integer_expression ctx = function
+  | Compilation.Addition (cexpr, cexpr') ->
+      begin match
+        evaluate_integer_expression ctx cexpr,
+        evaluate_integer_expression ctx cexpr'
+      with
+        | Integer i, Integer i' -> Integer (Int32.add i i')
+        | _ -> failwith "evaluate_integer_expression: not an integer expression"
+      end
+  | Compilation.Division (cexpr, cexpr') ->
+      begin match
+        evaluate_integer_expression ctx cexpr,
+        evaluate_integer_expression ctx cexpr'
+      with
+        | Integer i, Integer i' -> Integer (Int32.div i i')
+        | _ -> failwith "evaluate_integer_expression: not an integer expression"
+      end
+  | Compilation.Integer i -> Integer i
+  | Compilation.Minus cexpr ->
+      begin match evaluate_integer_expression ctx cexpr with
+        | Integer i -> Integer (Int32.sub Int32.zero i)
+        | _ -> failwith "evaluate_integer_expression: not an integer expression"
+      end
+  | Compilation.Multiplication (cexpr, cexpr') ->
+      begin match
+        evaluate_integer_expression ctx cexpr,
+        evaluate_integer_expression ctx cexpr'
+      with
+        | Integer i, Integer i' -> Integer (Int32.mul i i')
+        | _ -> failwith "evaluate_integer_expression: not an integer expression"
+      end
+  | Compilation.Reference (Compilation.LoopVariableReference level) ->
+      get_loop_variable_value ctx level
+  | Compilation.Subtraction (cexpr, cexpr') ->
+      begin match
+        evaluate_integer_expression ctx cexpr,
+        evaluate_integer_expression ctx cexpr'
+      with
+        | Integer i, Integer i' -> Integer (Int32.sub i i')
+        | _ -> failwith "evaluate_integer_expression: not an integer expression"
+      end
+  | _ -> failwith "evaluate_integer_expression: unallowed expression"
+
+and instantiate_when_equations ctx cequs =
+  let instantiate_when_equation = function
+    | Compilation.Reinit (Compilation.VariableReference (level, path), cexpr) ->
+      let iexpr = get_component_reference ctx level path
+      and iexpr' = instantiate_expression ctx cexpr in
+      begin match iexpr, iexpr'.tex_type with
+        | { tex_type = RealType dims; tex_expression = Some (VariableValue _) },
+          (RealType dims' | IntegerType dims') when dims = dims' ->
+            Reinit (iexpr, iexpr')
+        | _ -> failwith "instantiate_when_equations: type error in reinit"
+      end
+    | Compilation.Assign (Compilation.VariableReference (level, path), cexpr) ->
+      let iexpr = get_component_reference ctx level path
+      and iexpr' = instantiate_expression ctx cexpr in
+      begin match iexpr, iexpr'.tex_type with
+        | { tex_type = RealType dims; tex_expression = Some (VariableValue _) },
+          (RealType dims' | IntegerType dims') when dims = dims' ->
+            Assign (iexpr, iexpr')
+        | _ -> failwith "instantiate_when_equations: type error in assignment"
+      end
+    | _ -> failwith "instantiate_when_equations: type error"
+  in List.rev_map instantiate_when_equation cequs
+
+and instantiate_expression ctx = function
+  | Compilation.Abs cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Abs iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on abs"
+      end
+  | Compilation.Addition (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType dims, IntegerType dims' when dims = dims' ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Addition (iexpr, iexpr'))
+            }
+        | (IntegerType dims | RealType dims),
+          (IntegerType dims' | RealType dims') when dims = dims' ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Addition (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on +"
+      end
+  | Compilation.And (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType dims, BooleanType dims' when dims = dims' ->
+            {
+              tex_type = BooleanType dims;
+              tex_expression = Some (And (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on and"
+      end
+  | Compilation.Boolean b ->
+      {
+        tex_type = BooleanType [||];
+        tex_expression = Some (Boolean b)
+      }
+  | Compilation.Cardinality cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | CompoundType dims ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Cardinality iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on cardinality"
+      end
+  | Compilation.Cos cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Cos iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on cos"
+      end
+  | Compilation.Der cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Der iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on der"
+      end
+  | Compilation.Division (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType dims, IntegerType [||] ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Division (iexpr, iexpr'))
+            }
+        | (IntegerType dims | RealType dims),
+          (IntegerType [||] | RealType [||]) ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Division (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on division"
+      end
+  | Compilation.Equals (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType [||], BooleanType [||] |
+          IntegerType [||], IntegerType [||] |
+          RealType [||], RealType [||] |
+          StringType [||], StringType [||] ->
+            {
+              tex_type = BooleanType [||];
+              tex_expression = Some (Equals (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on equals"
+      end
+  | Compilation.ExternalFunctionCall (name, lccl, cexprs) ->
+      let iexprs = List.map (instantiate_expression ctx) cexprs in
+      let tex_type = check_function_type ctx lccl iexprs in
+      {
+        tex_type = tex_type;
+        tex_expression = Some (ExternalFunctionCall (name, iexprs))
+      }
+  | Compilation.Exp cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Exp iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on exp"
+      end
+  | Compilation.Floor cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | IntegerType dims ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Floor iexpr)
+            }
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Floor iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on floor"
+      end
+  | Compilation.GreaterEqualThan (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType [||], BooleanType [||] |
+          IntegerType [||], IntegerType [||] |
+          (IntegerType [||] | RealType [||]), RealType [||] |
+          RealType [||], IntegerType [||] |
+          StringType [||], StringType [||] ->
+            {
+              tex_type = BooleanType [||];
+              tex_expression = Some (GreaterEqualThan (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on >="
+      end
+  | Compilation.GreaterThan (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType [||], BooleanType [||] |
+          IntegerType [||], IntegerType [||] |
+          (IntegerType [||] | RealType [||]), RealType [||] |
+          RealType [||], IntegerType [||] |
+          StringType [||], StringType [||] ->
+            {
+              tex_type = BooleanType [||];
+              tex_expression = Some (GreaterThan (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on >"
+      end
+  | Compilation.If (alts, default) ->
+      let idefault = instantiate_expression ctx default in
+      let tex_type, ialts =
+        instantiate_if_alternatives ctx idefault.tex_type alts
+      in
+        {
+          tex_type = tex_type;
+          tex_expression = Some (If (ialts, idefault))
+        }
+  | Compilation.Integer i ->
+      {
+        tex_type = IntegerType [||];
+        tex_expression = Some (Integer i)
+      }
+  | Compilation.Log cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Log iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on log"
+      end
+  | Compilation.Max (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType [||], IntegerType [||] ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Max (iexpr, iexpr'))
+            }
+        | (IntegerType [||] | RealType [||]), RealType [||] |
+          RealType [||], IntegerType [||] ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Max (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on max"
+      end
+  | Compilation.Min (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType [||], IntegerType [||] ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Min (iexpr, iexpr'))
+            }
+        | (IntegerType [||] | RealType [||]), RealType [||] |
+          RealType [||], IntegerType [||] ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Min (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on min"
+      end
+  | Compilation.Mod (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType [||], IntegerType [||] ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Mod (iexpr, iexpr'))
+            }
+        | (IntegerType [||] | RealType [||]), RealType [||] |
+          RealType [||], IntegerType [||] ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Mod (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on mod"
+      end
+  | Compilation.Minus cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | IntegerType dims ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Minus iexpr)
+            }
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Minus iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on unary -"
+      end
+  | Compilation.Multiplication (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType [||], IntegerType [||] ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | (IntegerType [||] | RealType [||]),
+          (IntegerType [||] | RealType [||]) ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | IntegerType [|n|], IntegerType [|n'|] when n = n' ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | (IntegerType [|n|] | RealType [|n|]),
+          (IntegerType [|n'|] | RealType [|n'|]) when n = n' ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | IntegerType [|n|], IntegerType [|n'; m|] when n = n' ->
+            {
+              tex_type = IntegerType [|m|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | (IntegerType [|n|] | RealType [|n|]),
+          (IntegerType [|n'; m|] | RealType [|n'; m|]) when n = n' ->
+            {
+              tex_type = RealType [|m|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | IntegerType [|n; m|], IntegerType [|m'|] when m = m' ->
+            {
+              tex_type = IntegerType [|n|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | (IntegerType [|n; m|] | RealType [|n; m|]),
+          (IntegerType [|m'|] | RealType [|m'|]) when m = m' ->
+            {
+              tex_type = RealType [|n|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | IntegerType [|n; m|], IntegerType [|m'; p|] when m = m' ->
+            {
+              tex_type = IntegerType [|n; p|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | (IntegerType [|n; m|] | RealType [|n; m|]),
+          (IntegerType [|m'; p|] | RealType [|m'; p|]) when m = m' ->
+            {
+              tex_type = RealType [|n; p|];
+              tex_expression = Some (Multiplication (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on *"
+      end
+  | Compilation.NoEvent cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      {
+        tex_type = iexpr.tex_type;
+        tex_expression = Some (NoEvent iexpr)
+      }
+  | Compilation.Not cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | BooleanType dims ->
+            {
+              tex_type = BooleanType dims;
+              tex_expression = Some (Not iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on not"
+      end
+  | Compilation.NotEquals (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType [||], BooleanType [||] |
+          IntegerType [||], IntegerType [||] |
+          StringType [||], StringType [||] ->
+            {
+              tex_type = BooleanType [||];
+              tex_expression = Some (NotEquals (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on <>"
+      end
+  | Compilation.Or (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | BooleanType dims, BooleanType dims' when dims = dims' ->
+            {
+              tex_type = BooleanType dims;
+              tex_expression = Some (Or (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on or"
+      end
+  | Compilation.Power (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType [|m; n|], IntegerType [||] when m = n ->
+            {
+              tex_type = IntegerType [|m; m|];
+              tex_expression = Some (Power (iexpr, iexpr'))
+            }
+        | RealType [|m; n|], IntegerType [||] when m = n ->
+            {
+              tex_type = RealType [|m; m|];
+              tex_expression = Some (Power (iexpr, iexpr'))
+            }
+        | IntegerType [||], IntegerType [||] ->
+            {
+              tex_type = IntegerType [||];
+              tex_expression = Some (Power (iexpr, iexpr'))
+            }
+        | IntegerType [||], RealType [||] ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Power (iexpr, iexpr'))
+            }
+        | RealType [||], (IntegerType [||] | RealType [||]) ->
+            {
+              tex_type = RealType [||];
+              tex_expression = Some (Power (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on ^"
+      end
+  | Compilation.Real f ->
+      {
+        tex_type = RealType [||];
+        tex_expression = Some (Real f)
+      }
+  | Compilation.Reference (Compilation.ParameterReference (level, path)) |
+    Compilation.Reference (Compilation.VariableReference (level, path)) ->
+      get_component_reference ctx level path
+  | Compilation.Reference (Compilation.LoopVariableReference level) ->
+      {
+        tex_type = IntegerType [||];
+        tex_expression = Some (get_loop_variable_value ctx level)
+      }
+  | Compilation.Reference (Compilation.ClassReference (level, strings)) ->
+      failwith "instantiate_expression: class references not allowed"
+  | Compilation.Sin cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Sin iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on sin"
+      end
+  | Compilation.Sqrt cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Sqrt iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on sqrt"
+      end
+  | Compilation.String s ->
+      {
+        tex_type = StringType [||];
+        tex_expression = Some (String s)
+      }
+  | Compilation.Subtraction (cexpr, cexpr') ->
+      let iexpr = instantiate_expression ctx cexpr
+      and iexpr' = instantiate_expression ctx cexpr' in
+      begin match iexpr.tex_type, iexpr'.tex_type with
+        | IntegerType dims, IntegerType dims' when dims = dims' ->
+            {
+              tex_type = IntegerType dims;
+              tex_expression = Some (Subtraction (iexpr, iexpr'))
+            }
+        | (IntegerType dims | RealType dims),
+          (IntegerType dims' | RealType dims') when dims = dims' ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Subtraction (iexpr, iexpr'))
+            }
+        | _ -> failwith "instantiate_expression: type error on -"
+      end
+  | Compilation.Tan cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Tan iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on tan"
+      end
+  | Compilation.Tanh cexpr ->
+      let iexpr = instantiate_expression ctx cexpr in
+      begin match iexpr.tex_type with
+        | RealType dims ->
+            {
+              tex_type = RealType dims;
+              tex_expression = Some (Tanh iexpr)
+            }
+        | _ -> failwith "instantiate_expression: type error on tanh"
+      end
+  | Compilation.Time ->
+      {
+        tex_type = RealType [||];
+        tex_expression = Some Time
+      }
+  | Compilation.Vector cexprs ->
+      let iexprs = Array.map (instantiate_expression ctx) cexprs in
+      {
+        tex_type = compute_array_type iexprs;
+        tex_expression = Some (Vector iexprs)
+      }
+
+and check_function_type ctx lccl iexprs =
+  let compare_input_types iexpr tex_type =
+    iexpr.tex_type = tex_type ||
+    match iexpr.tex_type, tex_type with
+      | IntegerType dims, RealType dims' when dims = dims' -> true
+      | _ -> false
+  and extract_type = function
+    | Compilation.DiscreteVariable { Compilation.vat_dimensions = cdims } ->
+        let dims = Array.map (compute_subscript ctx) cdims in
+        RealType dims
+    | Compilation.RealVariable { Compilation.vat_dimensions = cdims } ->
+        let dims = Array.map (compute_subscript ctx) cdims in
+        RealType dims
+    | _ -> assert false
+  in
+  let ccpnts = Lazy.force ((Lazy.force lccl).Compilation.ccl_public_cpnts) in
+  let cpnts = List.map (fun (_, lcpnt) -> Lazy.force lcpnt) ccpnts in
+  let pars, vars = separate_parameters_from_variables cpnts in
+  let inputs, others = separate_inputs_from_others vars in
+  let outputs, others = separate_outputs_from_others others in
+  match pars, others with
+    | [], [] ->
+        let input_types = List.map extract_type inputs in
+        begin try
+          if List.for_all2 compare_input_types iexprs input_types then
+            begin match List.map extract_type outputs with
+              | [] -> failwith "check_function_type: no return value"
+              | [t] -> t
+              | ts -> CartesianProduct ts
+            end
+          else failwith "check_function_type: type error"
+        with _ -> failwith "check_function_type: type error"
+        end
+    | _ -> failwith "check_function_type: invalid function declaration"
+
+and instantiate_if_alternatives ctx tex_type alts =
+  let rec instantiate_if_alternative (cexpr, cexpr') (tex_type, ialts) =
+    let iexpr = instantiate_expression ctx cexpr
+    and iexpr' = instantiate_expression ctx cexpr' in
+    begin match iexpr.tex_type, iexpr'.tex_type, tex_type with
+      | BooleanType [||], IntegerType dims, IntegerType dims'
+        when dims = dims' ->
+          tex_type, (iexpr, iexpr') :: ialts
+      | BooleanType [||], (IntegerType dims | RealType dims), RealType dims'
+        when dims = dims' ->
+          RealType dims, (iexpr, iexpr') :: ialts
+      | BooleanType [||], RealType dims, IntegerType dims'
+        when dims = dims' ->
+          RealType dims, (iexpr, iexpr') :: ialts
+      | BooleanType [||], BooleanType dims, BooleanType dims'
+        when dims = dims' ->
+          tex_type, (iexpr, iexpr') :: ialts
+      | BooleanType [||], StringType dims, StringType dims'
+        when dims = dims' ->
+          tex_type, (iexpr, iexpr') :: ialts
+      | _ -> failwith "instantiate_if_alternative: type error"
+    end
+  in List.fold_right instantiate_if_alternative alts (tex_type, [])
+
+and compute_array_type iexpr_array =
+  let rec resize_dims dims n =
+    Array.init
+      (Array.length dims + 1)
+      (fun i -> if i = 0 then n else dims.(i - 1))
+  and type_checks tex_type i =
+    i = Array.length iexpr_array ||
+    iexpr_array.(i).tex_type = tex_type &&
+    type_checks tex_type (i + 1)
+  in
+    let n = Array.length iexpr_array in
+    if n = 0 then
+      failwith "compute_array_type: empty literal array"
+    else if type_checks iexpr_array.(0).tex_type 1 then
+      begin match iexpr_array.(0).tex_type with
+        | BooleanType dims -> BooleanType (resize_dims dims n)
+        | CompoundType dims -> CompoundType (resize_dims dims n)
+        | IntegerType dims -> IntegerType (resize_dims dims n)
+        | RealType dims -> RealType (resize_dims dims n)
+        | StringType dims -> StringType (resize_dims dims n)
+        | CartesianProduct _ -> assert false
+      end
+    else failwith "compute_array_type: type error"
+
+and expand_for_equation ctx start stop step cequs =
+  let rec expand_for_equation' i iequs =
+    if i > stop then iequs
+    else
+      let iequs' = List.fold_left (expand_equation i) iequs cequs in
+      expand_for_equation' (i + step) iequs'
+  and expand_equation i equ =
+    let ctx' = ForContext (ctx, i) in
+    instantiate_equation ctx' equ
+  in
+    if start >= 0 && stop >= 0 && start <= stop && step > 0 then
+      expand_for_equation' start []
+    else
+      failwith "expand_for_equation: bad indexes"
+
+and get_component_reference ctx level path =
+  let icl = find_component_level ctx level in
+  find_instantiated_component ctx icl level path
+
+and get_loop_variable_value ctx level = match ctx, level with
+  | ForContext (ctx', i), 0 -> Integer (Int32.of_int i)
+  | ForContext (ctx', i), n -> get_loop_variable_value ctx' (level - 1)
+  | _ -> failwith "get_loop_variable_value: compilation error"
+
+and find_component_level ctx level = match ctx, level with
+  | ToplevelContext, _ -> failwith "find_component_level: compilation error"
+  | ClassContext (ctx', licl), 0 -> Lazy.force licl
+  | ClassContext (ctx', _), n -> find_component_level ctx' (level - 1)
+  | ForContext (ctx', _), _ -> find_component_level ctx' level
+
+and find_instantiated_component ctx icl level = function
+  | (s, cs) :: path when List.mem_assoc s (Lazy.force icl.icl_components) ->
+      begin match Lazy.force (List.assoc s (Lazy.force icl.icl_components)) with
+        | InstantiatedParameter ipar ->
+            search_into_parameter ctx s cs level path ipar
+        | InstantiatedVariable ivar ->
+            search_into_variable ctx s cs level path ivar
+      end
+  | (s, cs) :: _ ->
+      failwith ("find_instantiated_component: identifier not found: " ^ s)
+  | _ -> assert false
+
+and search_into_parameter ctx s cs level path ipar =
+  let ics = Array.map (compute_subscript ctx) cs in
+  match path, ipar with
+  | ([] | [("value", [||])] | [("start", [||])]),
+    InstantiatedIntegerParameter (_, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = IntegerType dims;
+        tex_expression = Some (ParameterValue (level, [(s, ics)]))
+      }
+  | ([] | [("value", [||])] | [("start", [||])]),
+    InstantiatedRealParameter (_, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = RealType dims;
+        tex_expression = Some (ParameterValue (level, [(s, ics)]))
+      }
+  | (s, cs) :: _, _ -> failwith ("find_parameter: parameter not found: " ^ s)
+
+and search_into_variable ctx s cs level path ivar =
+  let ics = Array.map (compute_subscript ctx) cs in
+  match path, ivar with
+  | ([] | [("value", [||])]), InstantiatedDiscreteVariable (_, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = RealType dims;
+        tex_expression = Some (VariableValue (level, [(s, ics)]))
+      }
+  | ([] | [("value", [||])]), InstantiatedRealVariable (_, _, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = RealType dims;
+        tex_expression = Some (VariableValue (level, [(s, ics)]))
+      }
+  | [("start", [||])], InstantiatedDiscreteVariable (_, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = RealType dims;
+        tex_expression = Some (VariableStart (level, [(s, ics)]))
+      }
+  | [("start", [||])], InstantiatedRealVariable (_, _, _, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = RealType dims;
+        tex_expression = Some (VariableStart (level, [(s, ics)]))
+      }
+  | _ :: _ as path', InstantiatedCompoundVariable (_, iexpr) ->
+      search_into_compound_variable ctx s ics level path' iexpr
+  | [], InstantiatedCompoundVariable (_, iexpr) ->
+      let dims = find_subvector_dims ics iexpr in
+      {
+        tex_type = CompoundType dims;
+        tex_expression = Some (VariableValue (level, [(s, ics)]))
+      }
+  | (s, _) :: _, _ -> failwith ("find_variable: variable not found: " ^ s)
+
+and search_into_compound_variable ctx s ics level path iexpr =
+  let iexpr' = get_compound_subvector ics iexpr in
+  match iexpr'.tex_type, iexpr'.tex_expression with
+    | CompoundType [||], Some (CompoundElement icl) ->
+        begin match find_instantiated_component ctx icl level path with
+          | { tex_type = tex_type;
+              tex_expression = Some (VariableStart (level, iref)) } ->
+              {
+                tex_type = tex_type;
+                tex_expression = Some (VariableStart (level, ((s, ics) :: iref)))
+              }
+          | { tex_type = tex_type;
+              tex_expression = Some (VariableValue (level, iref)) } ->
+              {
+                tex_type = tex_type;
+                tex_expression = Some (VariableValue (level, ((s, ics) :: iref)))
+              }
+          | { tex_type = tex_type;
+              tex_expression = Some (ParameterValue (level, iref)) } ->
+              {
+                tex_type = tex_type;
+                tex_expression = Some (ParameterValue (level, ((s, ics) :: iref)))
+              }
+          | _ -> failwith "search_into_compound_variable: compilation error"
+        end
+    | CompoundType dims, Some (Vector iexprs) when Array.length dims > 0 ->
+        (* FIXME: Not yet implemented *)
+        failwith "search_into_compound_variable: compilation error"
+    | _ -> failwith "search_into_compound_variable: compilation error"
+
+and compute_subscript ctx = function
+  | Compilation.Indefinite ->
+      failwith "compute_subscript: invalid subscript"
+  | Compilation.Definite cexpr ->
+      begin match evaluate_integer_expression ctx cexpr with
+        | Integer i when Int32.to_int i >= 0 -> Int32.to_int i
+        | _ -> failwith "compute_subscript: type error"
+      end
+
+and find_subvector_dims ics = function
+  | { tex_type = RealType dims } | { tex_type = IntegerType dims } |
+    { tex_type = CompoundType dims } | { tex_type = StringType dims } |
+    { tex_type = BooleanType dims }
+    when no_out_of_bounds_access ics dims ->
+      Array.sub dims (Array.length ics) (Array.length dims - Array.length ics)
+  | _ -> failwith "find_subvector_dims: type error"
+
+and get_compound_subvector ics iexpr =
+  let rec get_compound_subvector' i iexpr =
+    if i = Array.length ics then iexpr
+    else begin match iexpr with
+      | { tex_expression = Some (Vector iexprs) }
+        when Array.length iexprs > ics.(i) ->
+          get_compound_subvector' (i + 1) iexprs.(i)
+      | _ -> failwith "get_compound_subvector: type error"
+    end
+  in get_compound_subvector' 0 iexpr
+
+and no_out_of_bounds_access ics dims =
+  let rec no_out_of_bounds_access' i =
+    i < 0 || ics.(i) <= dims.(i) && no_out_of_bounds_access' (i - 1)
+  in
+    Array.length ics <= Array.length dims &&
+    no_out_of_bounds_access' (Array.length ics - 1)
+
+
+(* Flattening *)
+
+let map2 f a a' =
+  if Array.length a <> Array.length a' then invalid_arg "map2"
+  else Array.mapi (fun i x -> f x a'.(i)) a
+
+let rec array_map op iexpr = match iexpr with
+  | { tex_expression = Some (Vector iexprs) } ->
+      let tex_expr = Vector (Array.map (array_map op) iexprs) in
+      { iexpr with tex_expression = Some tex_expr }
+  | _ -> { iexpr with tex_expression = Some (op iexpr) }
+
+let rec array_map2 op iexpr iexpr' = match iexpr, iexpr' with
+  | { tex_expression = Some (Vector iexprs) }, { tex_expression = Some (Vector iexprs') } ->
+      let tex_expr = Vector (map2 (array_map2 op) iexprs iexprs') in
+      { iexpr with tex_expression = Some tex_expr }
+  | _ -> { iexpr with tex_expression = Some (op iexpr iexpr') }
+
+let rec list_of_array = function
+  | { tex_expression = Some (Vector iexprs) } ->
+      List.flatten (Array.to_list (Array.map list_of_array iexprs))
+  | iexpr -> [iexpr]
+
+let rec expand_class = function
+  | { tex_type = CompoundType [||]; tex_expression = Some (CompoundElement icl) } ->
+      let icpnts, iinit_equs, iequs = flatten_instantiated_class "" icl in
+      let flows = collect_flows icpnts
+      and ss = collect_connected_components iequs in
+      icpnts,
+      iinit_equs,
+      evaluate_cardinalities ss (perform_connections flows iequs)
+  | _ -> assert false
+
+and flatten_instantiated_class path icl =
+  let icpnts, iinit_equs, iequs =
+    flatten_components path icl.icl_components
+  in
+  let iinit_equs =
+    flatten_equations
+      (update_equations path (Lazy.force icl.icl_init_equs) @ iinit_equs)
+  and iequs =
+    flatten_equations
+      (update_equations path (Lazy.force icl.icl_equs) @ iequs)
+  in icpnts, iinit_equs, iequs
+
+and collect_flows icpnts =
+  let collect_flow flows = function
+    | s, InstantiatedVariable
+      (InstantiatedRealVariable (_, _, Compilation.Flow, _)) ->
+        [{
+          tex_type = RealType [||];
+          tex_expression = Some (VariableValue (0, [(s, [||])]))
+        }] :: flows
+    | _ -> flows
+  in List.fold_left collect_flow [] icpnts
+
+and flatten_components path icpnts =
+  let rec flatten_component icpnts iinit_equs iequs s = function
+    | InstantiatedParameter ipar ->
+        flatten_parameter icpnts s ipar, iinit_equs, iequs
+    | InstantiatedVariable ivar ->
+        flatten_variable icpnts iinit_equs iequs s ivar
+  and flatten_parameter icpnts s = function
+    | InstantiatedIntegerParameter (cmt, kind,
+      ({ tex_type = IntegerType dims } as iexpr)) ->
+        let make iexpr =
+          InstantiatedParameter
+            (InstantiatedIntegerParameter (cmt, kind, iexpr))
+        in
+        let ipars = flatten_component_tree make path s iexpr in
+        icpnts @ ipars
+    | InstantiatedRealParameter (cmt, kind,
+      ({ tex_type = (IntegerType dims | RealType dims) } as iexpr)) ->
+        let make iexpr =
+          InstantiatedParameter (InstantiatedRealParameter (cmt, kind, iexpr))
+        in
+        let ipars = flatten_component_tree make path s iexpr in
+        icpnts @ ipars
+    | _ -> failwith "flatten_parameter: type error"
+  and flatten_variable icpnts iinit_equs iequs s = function
+    | InstantiatedDiscreteVariable (cmt, inout,
+      ({ tex_type = (IntegerType dims | RealType dims) } as iexpr)) ->
+        let make iexpr =
+          InstantiatedVariable (
+            InstantiatedDiscreteVariable (cmt, inout, iexpr))
+        in
+        let ivars = flatten_component_tree make path s iexpr in
+        icpnts @ ivars, iinit_equs, iequs
+    | InstantiatedRealVariable (cmt, inout, flow,
+      ({ tex_type = (IntegerType dims | RealType dims) } as iexpr)) ->
+        let make iexpr =
+          InstantiatedVariable
+            (InstantiatedRealVariable (cmt, inout, flow, iexpr))
+        in
+        let ivars = flatten_component_tree make path s iexpr in
+        icpnts @ ivars, iinit_equs, iequs
+    | InstantiatedCompoundVariable (cmt,
+      ({ tex_type = CompoundType dims } as iexpr)) ->
+        let make iexpr =
+          InstantiatedVariable (InstantiatedCompoundVariable (cmt, iexpr)) in
+        let ivars = flatten_component_tree make path s iexpr in
+        let icpnts', iinit_equs', iequs' = explode_compound_components ivars in
+        icpnts @ icpnts', iinit_equs @ iinit_equs', iequs @ iequs'
+    | _ -> failwith "flatten_variable: type error"
+  and flatten_components' icpnts iinit_equs iequs = function
+    | [] -> icpnts, iinit_equs, iequs
+    | (s, icpnt) :: icpnts'' ->
+        let icpnts', iinit_equs', iequs' =
+          flatten_component icpnts iinit_equs iequs s (Lazy.force icpnt)
+        in flatten_components' icpnts' iinit_equs' iequs' icpnts''
+  in flatten_components' [] [] [] (Lazy.force icpnts)
+
+and flatten_component_tree make path s iexpr =
+  let rec flatten_component_tree' path = function
+    | { tex_expression = Some (Vector iexprs) } ->
+        flatten_subcomponents path iexprs 1
+    | iexpr ->
+        let iexpr' = update_typed_expression path iexpr in
+        [(path ^ "]", make iexpr')]
+  and flatten_subcomponents path iexprs i =
+    if i > Array.length iexprs then []
+    else
+      let path' = match iexprs.(i - 1) with
+        | { tex_expression = Some (Vector iexprs) } ->
+          path ^ string_of_int i ^ "]["
+        | _ -> path ^ string_of_int i
+      in
+        (flatten_component_tree' path' iexprs.(i - 1)) @
+        flatten_subcomponents path iexprs (i + 1)
+  in match iexpr with
+    | { tex_expression = Some (Vector _) } ->
+        if path = "" then flatten_component_tree' (s ^ "[") iexpr
+        else flatten_component_tree' (path ^ "." ^ s ^ "[") iexpr
+    | _ ->
+        let iexpr' = update_typed_expression path iexpr in
+        if path = "" then [(s, make iexpr')]
+        else [(path ^ "." ^ s, make iexpr')]
+
+and explode_compound_components ivars =
+  let rec explode_compound_component icpnts iinit_equs iequs = function
+    | path, InstantiatedVariable (InstantiatedCompoundVariable (cmt,
+      { tex_expression = Some (CompoundElement icl) })) ->
+        let icpnts', iinit_equs', iequs' =
+          flatten_instantiated_class path icl
+        in icpnts @ icpnts', iinit_equs @ iinit_equs', iequs @ iequs'
+    | _ -> failwith "explode_compound_component: Not a compound component"
+  and explode_compound_components' icpnts iinit_equs iequs = function
+    | [] -> icpnts, iinit_equs, iequs
+    | ivar :: ivars ->
+        let icpnts', iinit_equs', iequs' =
+          explode_compound_component icpnts iinit_equs iequs ivar
+        in explode_compound_components' icpnts' iinit_equs' iequs' ivars
+  in explode_compound_components' [] [] [] ivars
+
+and update_equations path iequs =
+  List.rev_map (update_equation path) iequs
+
+and update_equation path = function
+  | Equation (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Equation (iexpr, iexpr')
+  | ConditionalEquation (iif_clauses, iequs) ->
+      let iif_clauses = update_if_clauses path iif_clauses
+      and iequs = update_equations path iequs in
+       ConditionalEquation (iif_clauses, iequs)
+  | FlowConnection (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      FlowConnection (iexpr, iexpr')
+  | When iwhen_clauses ->
+      let iwhen_clauses = update_when_clauses path iwhen_clauses in
+      When iwhen_clauses
+
+and update_if_clauses path iif_clauses =
+  let rec update_if_clause (iexpr, iequs) =
+    let iexpr = update_typed_expression path iexpr
+    and iequs = update_equations path iequs in
+    iexpr, iequs
+  in List.map update_if_clause iif_clauses
+
+and update_when_clauses path iwhen_clauses =
+  let rec update_when_clause (iexpr, iwhen_equs) =
+    let iexpr' = update_typed_expression path iexpr
+    and iwhen_equs' =
+      List.map
+        (function
+          | Reinit (iexpr, iexpr') ->
+              let iexpr = update_typed_expression path iexpr
+              and iexpr' = update_typed_expression path iexpr' in
+              Reinit (iexpr, iexpr')
+          | Assign (iexpr, iexpr') ->
+              let iexpr = update_typed_expression path iexpr
+              and iexpr' = update_typed_expression path iexpr' in
+              Assign (iexpr, iexpr'))
+        iwhen_equs in
+    (iexpr', iwhen_equs')
+  in List.map update_when_clause iwhen_clauses
+
+and update_typed_expression path iexpr =
+  { iexpr with tex_expression =
+      update_expression path iexpr.tex_expression
+  }
+
+and update_expression path = function
+  | None -> None
+  | Some expr -> Some (update_expression' path expr)
+
+and update_expression' path = function
+  | Abs iexpr -> Abs (update_typed_expression path iexpr)
+  | Addition (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Addition (iexpr, iexpr')
+  | And (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      And (iexpr, iexpr')
+  | Boolean _ as iexpr -> iexpr
+  | Cardinality iexpr -> Cardinality (update_typed_expression path iexpr)
+  | CompoundElement _ as iexpr -> iexpr
+  | Cos iexpr -> Cos (update_typed_expression path iexpr)
+  | Der iexpr -> Der (update_typed_expression path iexpr)
+  | Division (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Division (iexpr, iexpr')
+  | Equals (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Equals (iexpr, iexpr')
+  | Exp iexpr -> Exp (update_typed_expression path iexpr)
+  | ExternalFunctionCall (name, iexprs) ->
+      let iexprs = List.map (update_typed_expression path) iexprs in
+      ExternalFunctionCall (name, iexprs)
+  | Floor iexpr -> Floor (update_typed_expression path iexpr)
+  | GreaterEqualThan (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      GreaterEqualThan (iexpr, iexpr')
+  | GreaterThan (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      GreaterThan (iexpr, iexpr')
+  | If (iif_exprs, iexpr) ->
+      If (
+        List.map
+          (fun (iexpr, iexpr') ->
+            let iexpr = update_typed_expression path iexpr
+            and iexpr' = update_typed_expression path iexpr' in
+            iexpr, iexpr')
+          iif_exprs,
+        update_typed_expression path iexpr)
+  | Integer _ as iexpr -> iexpr
+  | Log iexpr -> Log (update_typed_expression path iexpr)
+  | Max (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Max (iexpr, iexpr')
+  | Min (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Min (iexpr, iexpr')
+  | Mod (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Mod (iexpr, iexpr')
+  | Minus iexpr -> Minus (update_typed_expression path iexpr)
+  | Multiplication (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Multiplication (iexpr, iexpr')
+  | NoEvent iexpr -> NoEvent (update_typed_expression path iexpr)
+  | Not iexpr -> Not (update_typed_expression path iexpr)
+  | NotEquals (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      NotEquals (iexpr, iexpr')
+  | Or (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Or (iexpr, iexpr')
+  | ParameterValue (level, iref) ->
+      ParameterValue (level, update_reference level path iref)
+  | Power (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Power (iexpr, iexpr')
+  | Real _ as iexpr -> iexpr
+  | Sin iexpr -> Sin (update_typed_expression path iexpr)
+  | Sqrt iexpr -> Sqrt (update_typed_expression path iexpr)
+  | String _ as iexpr -> iexpr
+  | Subtraction (iexpr, iexpr') ->
+      let iexpr = update_typed_expression path iexpr
+      and iexpr' = update_typed_expression path iexpr' in
+      Subtraction (iexpr, iexpr')
+  | Tan iexpr -> Tan (update_typed_expression path iexpr)
+  | Tanh iexpr -> Tanh (update_typed_expression path iexpr)
+  | Time -> Time
+  | VariableStart (level, iref) ->
+      VariableStart (level, update_reference level path iref)
+  | VariableValue (level, iref) ->
+      VariableValue (level, update_reference level path iref)
+  | Vector iexprs ->
+      Vector (Array.map (update_typed_expression path) iexprs)
+
+and update_reference level path =
+  let rec to_string = function
+    | [] -> ""
+    | [i] -> string_of_int i
+    | i :: is -> string_of_int i ^ "][" ^ to_string is
+  in function
+    | [(s, [||])] ->
+        let path' = update_path level path in
+        if path' = "" then [(s, [||])] else [(path' ^ "." ^ s, [||])]
+    | [(s, ics)] ->
+        let path' = update_path level path in
+        if path' = "" then
+          [(s ^ "[" ^ to_string (Array.to_list ics) ^ "]", [||])]
+        else
+          [(path' ^ "." ^ s ^ "[" ^ to_string (Array.to_list ics) ^ "]", [||])]
+    | (s, [||]) :: iref ->
+        let path' = update_path level path in
+        if path' = "" then update_reference level s iref
+        else update_reference level (path' ^ "." ^ s) iref
+    | (s, ics) :: iref ->
+        let path' = update_path level path in
+        if path' = "" then
+          update_reference
+            level
+            (s ^ "[" ^ to_string (Array.to_list ics) ^ "]")
+            iref
+        else
+          update_reference
+            level
+            (path' ^ "." ^ s ^ "[" ^ to_string (Array.to_list ics) ^ "]")
+            iref
+    | [] -> assert false
+
+and update_path level path = match level with
+  | 0 -> path
+  | n ->
+      let path' =
+        try String.sub path 0 (String.rindex path '.') with
+          | Not_found -> ""
+      in
+      update_path (n - 1) path'
+
+and flatten_equations iequs =
+  List.flatten (List.rev_map flatten_equation iequs)
+
+and flatten_equation = function
+  | Equation (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      List.map2
+        (fun iexpr iexpr' -> Equation (iexpr, iexpr'))
+        (list_of_array iexpr)
+        (list_of_array iexpr')
+  | ConditionalEquation (iif_clauses, iequs) ->
+      let iif_clauses = flatten_if_clauses iif_clauses
+      and iequs = flatten_equations iequs in
+      [ConditionalEquation (iif_clauses, iequs)]
+  | FlowConnection (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      List.map2
+        (fun iexpr iexpr' -> FlowConnection (iexpr, iexpr'))
+        (list_of_array iexpr)
+        (list_of_array iexpr')
+  | When iwhen_clauses ->
+      let iwhen_clauses = flatten_when_clauses iwhen_clauses in
+      [When iwhen_clauses]
+
+and flatten_if_clauses iif_clauses =
+  let rec flatten_if_clause (iexpr, iequs) =
+    let iexpr = flatten_typed_expression iexpr
+    and iequs = flatten_equations iequs in
+    iexpr, iequs
+  in List.map flatten_if_clause iif_clauses
+
+and flatten_when_clauses iwhen_clauses =
+  let rec flatten_when_clause (iexpr, iwhen_equs) =
+    let iexpr' = flatten_typed_expression iexpr
+    and iwhen_equs' =
+      List.map
+        (function
+          | Reinit (iexpr, iexpr') ->
+              let iexpr = flatten_typed_expression iexpr
+              and iexpr' = flatten_typed_expression iexpr' in
+              Reinit (iexpr, iexpr')
+          | Assign (iexpr, iexpr') ->
+              let iexpr = flatten_typed_expression iexpr
+              and iexpr' = flatten_typed_expression iexpr' in
+              Assign (iexpr, iexpr'))
+        iwhen_equs in
+    (iexpr', iwhen_equs')
+  in List.map flatten_when_clause iwhen_clauses
+
+and flatten_typed_expression iexpr'' = match iexpr''.tex_expression with
+  | None -> iexpr''
+  | Some expr -> flatten_typed_expression' iexpr'' expr
+
+and flatten_typed_expression' iexpr'' = function
+  | Abs iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Abs iexpr) iexpr
+  | Addition (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      array_map2 (fun iexpr iexpr' -> Addition (iexpr, iexpr')) iexpr iexpr'
+  | And (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      array_map2 (fun iexpr iexpr' -> And (iexpr, iexpr')) iexpr iexpr'
+  | Boolean _ -> iexpr''
+  | Cardinality iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Cardinality iexpr) iexpr
+  | CompoundElement _ -> iexpr''
+  | Cos iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Cos iexpr) iexpr
+  | Der iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Der iexpr) iexpr
+  | Division (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      let iexpr = array_map (fun iexpr -> Division (iexpr, iexpr')) iexpr in
+      { iexpr with tex_type = iexpr''.tex_type }
+  | Equals (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (Equals (iexpr, iexpr')) }
+  | Exp iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Exp iexpr) iexpr
+  | ExternalFunctionCall (name, [iexpr]) ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> ExternalFunctionCall (name, [iexpr])) iexpr
+  | ExternalFunctionCall (name, iexprs) ->
+      let iexprs = List.map flatten_typed_expression iexprs in
+      { iexpr'' with tex_expression = Some (ExternalFunctionCall (name, iexprs)) }
+  | Floor iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Floor iexpr) iexpr
+  | GreaterEqualThan (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (GreaterEqualThan (iexpr, iexpr')) }
+  | GreaterThan (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (GreaterThan (iexpr, iexpr')) }
+  | If (iif_exprs, iexpr) -> (*FIXME: Matrix case*)
+      { iexpr'' with tex_expression = Some (If (
+        List.map
+          (fun (iexpr, iexpr') ->
+            let iexpr = flatten_typed_expression iexpr
+            and iexpr' = flatten_typed_expression iexpr' in
+            iexpr, iexpr')
+          iif_exprs,
+        flatten_typed_expression iexpr)) }
+  | Integer _ -> iexpr''
+  | Log iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Log iexpr) iexpr
+  | Max (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (Max (iexpr, iexpr')) }
+  | Min (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (Min (iexpr, iexpr')) }
+  | Mod (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (Mod (iexpr, iexpr')) }
+  | Minus iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Minus iexpr) iexpr
+  | Multiplication (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      flatten_multiplication iexpr iexpr' iexpr''
+  | NoEvent iexpr ->
+      { iexpr'' with tex_expression = Some (NoEvent (flatten_typed_expression iexpr)) }
+  | Not iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Not iexpr) iexpr
+  | NotEquals (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (NotEquals (iexpr, iexpr')) }
+  | Or (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      array_map2 (fun iexpr iexpr' -> Or (iexpr, iexpr')) iexpr iexpr'
+  | ParameterValue (level, iref) ->
+      let make iref = ParameterValue (level, iref) in
+      expand_identifier iexpr''.tex_type make level iref
+  | Power (iexpr, iexpr') -> (*FIXME: Matrix case*)
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      { iexpr'' with tex_expression = Some (Power (iexpr, iexpr')) }
+  | Real _ -> iexpr''
+  | Sin iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Sin iexpr) iexpr
+  | Sqrt iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Sqrt iexpr) iexpr
+  | String _ -> iexpr''
+  | Subtraction (iexpr, iexpr') ->
+      let iexpr = flatten_typed_expression iexpr
+      and iexpr' = flatten_typed_expression iexpr' in
+      array_map2 (fun iexpr iexpr' -> Subtraction (iexpr, iexpr')) iexpr iexpr'
+  | Tan iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Tan iexpr) iexpr
+  | Tanh iexpr ->
+      let iexpr = flatten_typed_expression iexpr in
+      array_map (fun iexpr -> Tanh iexpr) iexpr
+  | Time -> iexpr''
+  | VariableStart (level, iref) ->
+      let make iref = VariableStart (level, iref) in
+      expand_identifier iexpr''.tex_type make level iref
+  | VariableValue (level, iref) ->
+      let make iref = VariableValue (level, iref) in
+      expand_identifier iexpr''.tex_type make level iref
+  | Vector _ -> iexpr''
+
+and flatten_multiplication iexpr iexpr' iexpr'' =
+  let extract_subvector = function
+    | { tex_expression = Some (Vector iexprs) } -> iexprs
+    | _ -> assert false
+  and transpose_matrix = function
+    | {
+        tex_type = (RealType [|m; n|] | IntegerType [|m; n|]);
+        tex_expression = Some (Vector iexprs)
+      } ->
+        {
+          tex_type = RealType [||]; (* Doesn't matter *)
+          tex_expression = Some (Vector (
+            Array.init n (fun i ->
+              {
+                tex_type = RealType [||]; (* Doesn't matter *)
+                tex_expression = Some (Vector (
+                  Array.init m (fun j ->
+                    match iexprs.(j) with
+                      | { tex_expression = Some (Vector iexprs') } ->
+                          iexprs'.(i)
+                      | _ -> assert false)))
+              })))
+        }
+    | _ -> assert false
+  in
+  let rec flatten_vector_by_vector_product iexprs iexprs' =
+    let rec flatten_vector_by_vector_product' acc i =
+      if i = Array.length iexprs then acc
+      else
+        let iexpr =
+          {
+            tex_type = RealType [||]; (* Doesn't matter *)
+            tex_expression = Some (Multiplication (iexprs.(i), iexprs'.(i)))
+          }
+        in
+        let acc' =
+          {
+            tex_type = RealType [||]; (* Doesn't matter *)
+            tex_expression = Some (Addition (acc, iexpr))
+          }
+        in flatten_vector_by_vector_product' acc' (i + 1)
+    in
+    let acc =
+      {
+        tex_type = RealType [||]; (* Doesn't matter *)
+        tex_expression = Some (Multiplication (iexprs.(0), iexprs'.(0)))
+      }
+    in flatten_vector_by_vector_product' acc 1 (* FIXME: empty vectors *)
+  and flatten_vector_by_matrix_product iexpr iexpr' =
+    let iexpr' = transpose_matrix iexpr' in
+    match iexpr.tex_expression, iexpr'.tex_expression with
+      | Some (Vector iexprs), Some (Vector iexprs') ->
+          {
+            tex_type = RealType [||]; (* Doesn't matter *)
+            tex_expression =
+              Some (Vector (Array.map
+                (fun iexpr' ->
+                  let iexprs' = extract_subvector iexpr' in
+                  flatten_vector_by_vector_product iexprs iexprs')
+                iexprs'))
+          }
+      | _ -> assert false
+  and flatten_matrix_by_vector_product iexpr iexpr' =
+    match iexpr.tex_expression, iexpr'.tex_expression with
+      | Some (Vector iexprs), Some (Vector iexprs') ->
+          {
+            tex_type = RealType [||]; (* Doesn't matter *)
+            tex_expression =
+              Some (Vector (Array.map
+                (fun iexpr ->
+                  let iexprs = extract_subvector iexpr in
+                  flatten_vector_by_vector_product iexprs iexprs')
+                iexprs))
+          }
+      | _ -> assert false
+  and flatten_matrix_by_matrix_product iexpr iexpr' =
+    match iexpr'.tex_expression with
+      | Some (Vector iexprs') ->
+          let iexpr = transpose_matrix iexpr in
+          {
+            tex_type = RealType [||]; (* Doesn't matter *)
+            tex_expression =
+              Some (Vector (Array.map
+                (fun iexpr' -> flatten_matrix_by_vector_product iexpr iexpr')
+                iexprs'))
+          }
+      | _ -> assert false
+  in match iexpr.tex_type, iexpr'.tex_type with
+  | (IntegerType [||] | RealType [||]), (IntegerType [||] | RealType [||]) ->
+      { iexpr'' with tex_expression = Some (Multiplication (iexpr, iexpr')) }
+  | (IntegerType [||] | RealType [||]), _ ->
+      let iexpr =
+        array_map (fun iexpr' -> Multiplication (iexpr, iexpr')) iexpr'
+      in { iexpr with tex_type = iexpr''.tex_type }
+  | (IntegerType [|n|] | RealType [|n|]),
+    (IntegerType [|n'|] | RealType [|n'|]) ->
+      begin
+        match iexpr.tex_expression, iexpr'.tex_expression with
+        | Some (Vector iexprs), Some (Vector iexprs') ->
+            flatten_vector_by_vector_product iexprs iexprs'
+        | _ -> assert false
+      end
+  | (IntegerType [|n|] | RealType [|n|]),
+    (IntegerType [|n'; m'|] | RealType [|n'; m'|]) ->
+      flatten_vector_by_matrix_product iexpr iexpr'
+  | (IntegerType [|n; m|] | RealType [|n; m|]),
+    (IntegerType [|m'|] | RealType [|m'|]) ->
+      flatten_matrix_by_vector_product iexpr iexpr'
+  | (IntegerType [|n; m|] | RealType [|n; m|]),
+    (IntegerType [|m'; p'|] | RealType [|m'; p'|]) ->
+      flatten_matrix_by_matrix_product iexpr iexpr'
+  | _ -> assert false
+
+and expand_identifier tex_type make level iref =
+  let get_dims = function
+    | BooleanType dims | CompoundType dims | IntegerType dims | RealType dims |
+      StringType dims -> dims
+    | CartesianProduct _ -> assert false
+  and base_type tex_type dims = match tex_type with
+    | BooleanType _ -> BooleanType dims
+    | CompoundType _ -> CompoundType dims
+    | IntegerType _ -> IntegerType dims
+    | RealType _ -> RealType dims
+    | StringType _ -> StringType dims
+    | CartesianProduct _ -> assert false
+  in
+  let dims = get_dims tex_type in
+  let rec expand_identifier' name n =
+    if n = Array.length dims then
+      {
+        tex_type = base_type tex_type [||];
+        tex_expression = Some (make [(name, [||])])
+      }
+    else
+      let iexprs = Array.init dims.(n) (create_subcomponent name n) in
+      {
+        tex_type =
+          base_type tex_type (Array.sub dims n (Array.length dims - n));
+        tex_expression = Some (Vector iexprs)
+      }
+  and create_subcomponent name n i =
+    let name' = name ^ "[" ^ string_of_int (i + 1) ^ "]" in
+    expand_identifier' name' (n + 1)
+  in match iref with
+    | [(name, [||])] -> expand_identifier' name 0
+    | _ -> failwith "expand_identifier: bad reference"
+
+and perform_connections flows iequs =
+  let rec remove_set_containing iexpr = function
+    | [] -> failwith "remove_set_containing"
+    | iexprs :: iexprss when List.mem iexpr iexprs ->
+        iexprs, iexprss
+    | iexprs :: iexprss ->
+        let iexprs', iexprss' = remove_set_containing iexpr iexprss in
+        iexprs', iexprs :: iexprss'
+  and merge_connections flows others = function
+    | [] -> others @ (List.rev_map sum_to_zero flows)
+    | FlowConnection (iexpr, iexpr') :: iequs' ->
+        let iexprs, flows = remove_set_containing iexpr flows in
+        let iexprs', flows = remove_set_containing iexpr' flows in
+        let flows' = (iexprs @ iexprs') :: flows in
+        merge_connections flows' others iequs'
+    | iequ :: iequs' -> merge_connections flows (iequ :: others) iequs'
+  and sum_to_zero = function
+    | iexpr :: iexprs ->
+        let sum =
+          List.fold_left
+            (fun acc iexpr ->
+              {
+                tex_type = iexpr.tex_type;
+                tex_expression = Some (Addition (acc, iexpr))
+              })
+            iexpr
+            iexprs
+        and zero = { tex_type = RealType [||]; tex_expression = Some (Real 0.0) }
+        in Equation (sum, zero)
+    | [] -> failwith "perform_connections: invalid connection"
+  in merge_connections flows [] iequs
+
+and collect_connected_components =
+  let truncate_identifier = function
+    | VariableValue (_, [(s, [||])]) ->
+        let i = String.rindex s '.' in
+        String.sub s 0 i
+    | _ -> failwith "truncate_identifier: flattened reference expected"
+  in function
+    | [] -> []
+    | FlowConnection ({ tex_expression = Some iexpr }, { tex_expression = Some iexpr' })
+      :: iequs ->
+        let s = truncate_identifier iexpr
+        and s' = truncate_identifier iexpr' in
+        s :: s' :: collect_connected_components iequs
+    | _ :: iequs -> collect_connected_components iequs
+
+and evaluate_cardinalities ss iequs =
+  let rec evaluate_cardinalities_in_equation = function
+    | Equation (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        Equation (iexpr, iexpr')
+    | ConditionalEquation (iif_clauses, iequs) ->
+        failwith
+          "evaluate_cardinalities_in_equation: conditional equations not\
+          allowed."
+    | iequ -> iequ
+  and evaluate_cardinalities_in_expression iexpr'' = match iexpr''.tex_expression with
+    | None -> iexpr''
+    | Some expr -> evaluate_cardinalities_in_expression' iexpr'' expr
+  and evaluate_cardinalities_in_expression' iexpr'' = function
+    | Addition (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Addition (iexpr, iexpr'))
+        }
+    | And (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (And (iexpr, iexpr'))
+        }
+    | Division (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Division (iexpr, iexpr'))
+        }
+    | Equals (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Equals (iexpr, iexpr'))
+        }
+    | GreaterEqualThan (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (GreaterEqualThan (iexpr, iexpr'))
+        }
+    | GreaterThan (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (GreaterThan (iexpr, iexpr'))
+        }
+    | Max (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Max (iexpr, iexpr'))
+        }
+    | Min (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Min (iexpr, iexpr'))
+        }
+    | Mod (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Mod (iexpr, iexpr'))
+        }
+    | Multiplication (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Multiplication (iexpr, iexpr'))
+        }
+    | NotEquals (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (NotEquals (iexpr, iexpr'))
+        }
+    | Or (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Or (iexpr, iexpr'))
+        }
+    | Power (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Power (iexpr, iexpr'))
+        }
+    | Subtraction (iexpr, iexpr') ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr
+        and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Subtraction (iexpr, iexpr'))
+        }
+    | Boolean _ | CompoundElement _ | Integer _ | Real _ | String _ |
+      Time | Vector _ | ParameterValue _ | VariableStart _ |
+      VariableValue _-> iexpr''
+    | Cardinality { tex_expression = Some (VariableValue (_, [(s, [||])])) } ->
+        {
+          tex_type = IntegerType [||];
+          tex_expression =
+            Some (Integer (
+              List.fold_left
+                (fun acc s' -> if s = s' then Int32.add acc Int32.one else acc)
+                Int32.zero
+                ss))
+        }
+    | Cardinality _ ->
+        failwith "evaluate_cardinalities_in_expression: wrong call to cardinality ()."
+    | Abs iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Abs iexpr)
+        }
+    | Cos iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Cos iexpr)
+        }
+    | Der iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Der iexpr)
+        }
+    | Exp iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Exp iexpr)
+        }
+    | Floor iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Floor iexpr)
+        }
+    | Log iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Log iexpr)
+        }
+    | Minus iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Minus iexpr)
+        }
+    | NoEvent iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (NoEvent iexpr)
+        }
+    | Not iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Not iexpr)
+        }
+    | Sin iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Sin iexpr)
+        }
+    | Sqrt iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Sqrt iexpr)
+        }
+    | Tan iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Tan iexpr)
+        }
+    | Tanh iexpr ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        {
+          tex_type = RealType [||];
+          tex_expression = Some (Tanh iexpr)
+        }
+    | ExternalFunctionCall (name, [iexpr]) ->
+        let iexpr = evaluate_cardinalities_in_expression iexpr in
+        { iexpr'' with tex_expression = Some (ExternalFunctionCall (name, [iexpr])) }
+    | ExternalFunctionCall (name, iexprs) ->
+        let iexprs = List.map evaluate_cardinalities_in_expression iexprs in
+        { iexpr'' with tex_expression = Some (ExternalFunctionCall (name, iexprs)) }
+    | If (iif_exprs, iexpr) ->
+        { iexpr'' with tex_expression = Some (If (
+          List.map
+            (fun (iexpr, iexpr') ->
+              let iexpr = evaluate_cardinalities_in_expression iexpr
+              and iexpr' = evaluate_cardinalities_in_expression iexpr' in
+              iexpr, iexpr')
+            iif_exprs,
+          evaluate_cardinalities_in_expression iexpr)) }
+  in List.rev_map evaluate_cardinalities_in_equation iequs
diff --git a/scilab/modules/scicos/src/modelica_compiler/instantiation.mli b/scilab/modules/scicos/src/modelica_compiler/instantiation.mli
new file mode 100644 (file)
index 0000000..6a248f6
--- /dev/null
@@ -0,0 +1,151 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module provides the functions that yield instances of compiled
+Modelica classes.*)
+
+
+(** The type of a Modelica instantiated class. *)
+type instantiated_class = {
+  icl_components: (string * instantiated_component Lazy.t) list Lazy.t;
+  icl_init_equs: equation list Lazy.t;
+  icl_equs: equation list Lazy.t;
+}
+
+and instantiated_component =
+    InstantiatedParameter of instantiated_parameter
+  | InstantiatedVariable of instantiated_variable
+
+and instantiated_parameter =
+    InstantiatedIntegerParameter of string * parameter_kind *
+      typed_expression
+  | InstantiatedRealParameter of string * parameter_kind * typed_expression
+
+and parameter_kind = Main | Sub
+
+and instantiated_variable =
+    InstantiatedDiscreteVariable of string * Compilation.inout *
+      typed_expression
+  | InstantiatedRealVariable of string * Compilation.inout *
+      Compilation.nature * typed_expression
+  | InstantiatedCompoundVariable of string * typed_expression
+
+and equation =
+    Equation of typed_expression * typed_expression
+  | ConditionalEquation of (typed_expression * equation list) list *
+      equation list
+  | FlowConnection of typed_expression * typed_expression
+  | When of when_clause_type
+
+and when_clause_type =
+  (typed_expression * typed_when_expression list) list
+
+and typed_when_expression =
+  | Reinit of typed_expression * typed_expression
+  | Assign of typed_expression * typed_expression
+
+and typed_expression = {
+  tex_type: expression_type;
+  tex_expression: expression option;
+}
+
+and expression_type =
+    BooleanType of int array
+  | CartesianProduct of expression_type list
+  | CompoundType of int array
+  | IntegerType of int array
+  | RealType of int array
+  | StringType of int array
+
+and expression =
+    Abs of typed_expression
+  | Addition of typed_expression * typed_expression
+  | And of typed_expression * typed_expression
+  | Boolean of bool
+  | Cardinality of typed_expression
+  | CompoundElement of instantiated_class
+  | Cos of typed_expression
+  | Der of typed_expression
+  | Division of typed_expression * typed_expression
+  | Equals of typed_expression * typed_expression
+  | Exp of typed_expression
+  | ExternalFunctionCall of string list * typed_expression list
+  | Floor of typed_expression
+  | GreaterEqualThan of typed_expression * typed_expression
+  | GreaterThan of typed_expression * typed_expression
+  | If of (typed_expression * typed_expression) list * typed_expression
+  | Integer of int32
+  | Log of typed_expression
+  | Max of typed_expression * typed_expression
+  | Min of typed_expression * typed_expression
+  | Mod of typed_expression * typed_expression
+  | Minus of typed_expression
+  | Multiplication of typed_expression * typed_expression
+  | NoEvent of typed_expression
+  | Not of typed_expression
+  | NotEquals of typed_expression * typed_expression
+  | Or of typed_expression * typed_expression
+  | ParameterValue of int * reference
+  | Power of typed_expression * typed_expression
+  | Real of float
+  | Sin of typed_expression
+  | Sqrt of typed_expression
+  | String of string
+  | Subtraction of typed_expression * typed_expression
+  | Tan of typed_expression
+  | Tanh of typed_expression
+  | Time
+  | VariableStart of int * reference
+  | VariableValue of int * reference
+  | Vector of typed_expression array
+
+and reference = (string * int array) list
+
+(** The type of an instantiation context. *)
+type instantiation_context =
+  | ToplevelContext (** The default instantiation context *)
+  | ClassContext of instantiation_context * instantiated_class Lazy.t
+  | ForContext of instantiation_context * int
+
+(** The type of an instantiated modification. *)
+type modification =
+    Modification of (string * int array) * modification list *
+      typed_expression option
+
+val string_of_expression: typed_expression -> string
+(** [string_of_expression iexpr] yields a string containing an implementation
+dependent representation of the typed expression [iexpr] (for debugging
+purposes).*)
+
+val instantiate_main_class:
+  instantiation_context ->
+  Compilation.compiled_modification list ->
+  Compilation.compiled_class -> typed_expression
+(** [instantiate_main_class ctx modifs ccl] returns an instance of the model
+given in [ccl] under context [ctx] and modifications [modifs] (usually, [ctx] is
+[ToplevelContext] and [modifs] is [[]]. *)
+
+val expand_class :
+  typed_expression ->
+  (string * instantiated_component) list * equation list * equation list
+(** [expand_class iexpr] returns a list of instantiated components and two lists
+ of instantiated equations (initial and dynamic ones) given an instance of a
+ Modelica model [iexpr]. *)
diff --git a/scilab/modules/scicos/src/modelica_compiler/lexer.mll b/scilab/modules/scicos/src/modelica_compiler/lexer.mll
new file mode 100644 (file)
index 0000000..90b2c3e
--- /dev/null
@@ -0,0 +1,160 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+{
+open Parser
+
+exception Eof
+
+let check_reserved = function
+    | "algorithm" -> ALGORITHM
+    | "and" -> AND
+    | "annotation" -> ANNOTATION
+    | "assert" -> ASSERT
+    | "block" -> BLOCK
+    | "class" -> CLASS
+    | "connect" -> CONNECT
+    | "connector" -> CLASS
+    | "constant" -> CONSTANT
+    | "discrete" -> DISCRETE
+    | "else" -> ELSE
+    | "elseif" -> ELSEIF
+    | "elsewhen" -> ELSEWHEN
+    | "encapsulated" -> ENCAPSULATED
+    | "end" -> END
+    | "equation" -> EQUATION
+    | "extends" -> EXTENDS
+    | "external" -> EXTERNAL
+    | "false" -> FALSE
+    | "final" -> FINAL
+    | "flow" -> FLOW
+    | "for" -> FOR
+    | "function" -> FUNCTION
+    | "if" -> IF
+    | "import" -> IMPORT
+    | "in" -> IN
+    | "inner" -> INNER
+    | "input" -> INPUT
+    | "loop" -> LOOP
+    | "model" -> CLASS
+    | "not" -> NOT
+    | "or" -> OR
+    | "outer" -> OUTER
+    | "output" -> OUTPUT
+    | "package" -> PACKAGE
+    | "parameter" -> PARAMETER
+    | "partial" -> PARTIAL
+    | "protected" -> PROTECTED
+    | "public" -> PUBLIC
+    | "record" -> RECORD
+    | "redeclare" -> REDECLARE
+    | "replaceable" -> REPLACEABLE
+    | "terminate" -> TERMINATE
+    | "then" -> THEN
+    | "true" -> TRUE
+    | "type" -> TYPE
+    | "when" -> WHEN
+    | "while" -> WHILE
+    | "within" -> WITHIN
+    | s -> IDENT s
+
+}
+
+let blank = [' ' '\t' '\r']
+let digit = ['0'-'9']
+let nondigit = ['_' 'A'-'Z' 'a'-'z']
+let nondigit2 =  ['_' 'A'-'Z' 'a'-'z' '[' ']' '.']
+let schar = [^'\"' '\\']
+let sescape = "\\\'" | "\\\"" | "\\?" | "\\\\" | "\\a" | "\\b" | "\\f" |
+              "\\n" | "\\r" | "\\t" | "\\v"
+
+let unsigned_integer = digit+
+
+let unsigned_number =
+  unsigned_integer ('.' unsigned_integer?)?
+    (('e' | 'E')('+' | '-')? unsigned_integer)?
+
+rule token = parse
+
+    | blank
+                { token lexbuf }
+
+    | ['\n']
+                { token lexbuf }
+
+
+    | "/*" ( [^ '*'] | '*'+ [^ '*' '/'] )* '*'+ '/'
+                { let lxm = Lexing.lexeme lexbuf in
+                  token lexbuf }
+
+    | "//" [^ '\n']* '\n'
+                { let lxm = Lexing.lexeme lexbuf in
+                  token lexbuf }
+
+    | unsigned_integer
+                { let lxm = Lexing.lexeme lexbuf in
+                    UNSIGNED_INTEGER lxm }
+
+    | unsigned_number
+                { let lxm = Lexing.lexeme lexbuf in
+                    UNSIGNED_NUMBER lxm }
+
+    | nondigit (nondigit | digit)*
+                { let lxm = Lexing.lexeme lexbuf in
+                    check_reserved lxm }
+
+    | '`' (nondigit2 | digit)+ '`'
+                { let lxm = Lexing.lexeme lexbuf in
+                    IDENT (String.sub lxm 1 (String.length lxm - 2)) }
+
+    | '\"' (schar | sescape)* '\"'
+                { let lxm = Lexing.lexeme lexbuf in
+                    STRING (String.sub lxm 1 (String.length lxm - 2)) }
+
+    | '('           { LP }
+    | ')'           { RP }
+    | '['           { LSB }
+    | ']'           { RSB }
+    | '{'           { LCB }
+    | '}'           { RCB }
+
+    | '.'           { DOT }
+    | ','           { CM }
+    | ';'           { SC }
+    | ':'           { CL }
+
+    | '+'           { PLUS }
+    | '-'           { MINUS }
+    | '*'           { STAR }
+    | '/'           { SLASH }
+    | '^'           { EXP }
+
+    | '='           { EQ }
+    | ":="          { COLEQ }
+
+    | '<'           { LT }
+    | '>'           { GT }
+    | "<="          { LE }
+    | ">="          { GE }
+    | "=="          { EE }
+    | "<>"          { NE }
+
+    | eof           { EOF }
diff --git a/scilab/modules/scicos/src/modelica_compiler/linenum.mll b/scilab/modules/scicos/src/modelica_compiler/linenum.mll
new file mode 100755 (executable)
index 0000000..2efb40e
--- /dev/null
@@ -0,0 +1,53 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+{
+
+let linenum = ref 0
+let linebeg = ref 0
+
+}
+
+rule skip_line = parse
+  | [^ '\n' '\r']* ('\n' | '\r' | "\r\n")
+      { incr linenum;
+        linebeg := Lexing.lexeme_start lexbuf;
+        Lexing.lexeme_end lexbuf }
+  | [^ '\n' '\r']* eof
+      { incr linenum;
+        linebeg := Lexing.lexeme_start lexbuf;
+        raise End_of_file }
+
+{
+
+let for_position file loc =
+  let ic = open_in_bin file in
+  let lb = Lexing.from_channel ic in
+  linenum := 1;
+  linebeg := 0;
+  begin try
+    while skip_line lb <= loc do () done
+  with End_of_file -> ()
+  end;
+  close_in ic;
+  (!linenum - 1, !linebeg)
+
+}
diff --git a/scilab/modules/scicos/src/modelica_compiler/makefile.mak b/scilab/modules/scicos/src/modelica_compiler/makefile.mak
new file mode 100644 (file)
index 0000000..b18fd5f
--- /dev/null
@@ -0,0 +1,160 @@
+#  Scicos
+#
+#  Copyright (C) INRIA - scilab
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+# See the file ./license.txt
+
+
+OCAMLPATH=C:\Program Files\Objective Caml
+OCAMLPATHBIN=$(OCAMLPATH)\bin
+OCAMLPATHLIB=$(OCAMLPATH)\lib
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+CAMLP4=camlp4
+OCAMLYACC=ocamlyacc
+OCAMLLEX=ocamllex
+RM=del
+EXEC=modelicac.exe
+#TRANSLATOR=translator.exe
+
+MLS=parseTree.ml linenum.ml parser.ml lexer.ml\
+       precompilation.ml compilation.ml instantiation.ml\
+       graphNodeSet.ml symbolicExpression.ml\
+       squareSparseMatrix.ml bipartiteGraph.ml hungarianMethod.ml\
+       causalityGraph.ml\
+       optimization.ml xMLCodeGeneration.ml optimizingCompiler.ml\
+       scicosCodeGeneration.ml scicosOptimizingCompiler.ml
+
+    
+CMACMO=linenum.cmo nums.cma parseTree.cmo parser.cmo \
+       lexer.cmo precompilation.cmo compilation.cmo \
+       instantiation.cmo graphNodeSet.cmo symbolicExpression.cmo \
+       squareSparseMatrix.cmo bipartiteGraph.cmo hungarianMethod.cmo \
+       causalityGraph.cmo optimization.cmo scicosCodeGeneration.cmo \
+       xMLCodeGeneration.cmo optimizingCompiler.cmo
+
+CMXACMX=linenum.cmx nums.cmxa parseTree.cmx parser.cmx \
+       lexer.cmx precompilation.cmx compilation.cmx \
+       instantiation.cmx graphNodeSet.cmx symbolicExpression.cmx \
+       squareSparseMatrix.cmx bipartiteGraph.cmx hungarianMethod.cmx \
+       causalityGraph.cmx optimization.cmx scicosCodeGeneration.cmx \
+       xMLCodeGeneration.cmx optimizingCompiler.cmx    
+
+all:: step1 step2 step3 step4 step5 step6
+
+translator:
+       @cd modelica;$(MAKE) depend;$(MAKE);copy translation\$(TRANSLATOR) ..\..\bin\$(TRANSLATOR)      
+
+
+step1: 
+  @"$(OCAMLPATHBIN)\$(OCAMLLEX)" linenum.mll
+       @"$(OCAMLPATHBIN)\$(OCAMLYACC)" parser.mly
+       @$(RM) parser.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLLEX)" lexer.mll
+       
+
+step2:
+       @"$(OCAMLPATHBIN)\$(OCAMLDEP)" $(MLS)
+
+step3: 
+  @"$(OCAMLPATHBIN)\$(OCAMLC)" -c linenum.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c parseTree.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c parseTree.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c parser.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c lexer.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c precompilation.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c precompilation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c compilation.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c compilation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c instantiation.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c instantiation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c graphNodeSet.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c graphNodeSet.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c symbolicExpression.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c symbolicExpression.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c squareSparseMatrix.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c squareSparseMatrix.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c bipartiteGraph.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c bipartiteGraph.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c hungarianMethod.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c hungarianMethod.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c causalityGraph.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c causalityGraph.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c optimization.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c optimization.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c xMLCodeGeneration.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c xMLCodeGeneration.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c optimizingCompiler.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c optimizingCompiler.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c scicosCodeGeneration.mli
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c scicosCodeGeneration.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -c scicosOptimizingCompiler.ml
+       
+step4:
+       @"$(OCAMLPATHBIN)\$(OCAMLC)" -o $(EXEC) $(CMACMO) scicosOptimizingCompiler.ml
+       
+step5:
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c linenum.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c parseTree.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c parser.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c lexer.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c precompilation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c compilation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c instantiation.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c graphNodeSet.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c symbolicExpression.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c squareSparseMatrix.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c bipartiteGraph.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c hungarianMethod.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c causalityGraph.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c optimization.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c xMLCodeGeneration.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c scicosCodeGeneration.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c optimizingCompiler.ml
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -c scicosOptimizingCompiler.ml
+
+       
+step6:
+       @"$(OCAMLPATHBIN)\$(OCAMLOPT)" -o $(EXEC) $(CMXACMX) scicosOptimizingCompiler.ml
+       @copy  $(EXEC) ..\bin\$(EXEC)   
+       
+       
+clean::
+       -$(RM)  *.cmi
+       -$(RM)  *.cmo
+       -$(RM)  *.cmx
+       -$(RM)  *.obj
+       -$(RM)  parser.ml
+       -$(RM)  lexer.ml
+       -$(RM)  linenum.ml
+       -$(RM)  *.exe
+       -$(RM)  ..\bin\$(EXEC)
+#      @cd modelica;$(MAKE) clean; 
+#      -$(RM)  ..\bin\$(TRANSLATOR)
+
+
+distclean::
+       -$(RM)  *.cmi
+       -$(RM)  *.cmo
+       -$(RM)  *.cmx
+       -$(RM)  *.obj
+       -$(RM)  parser.ml
+       -$(RM)  lexer.ml
+       -$(RM)  linenum.ml
+       -$(RM)  *.exe
+
diff --git a/scilab/modules/scicos/src/modelica_compiler/optimization.ml b/scilab/modules/scicos/src/modelica_compiler/optimization.ml
new file mode 100644 (file)
index 0000000..c288a9c
--- /dev/null
@@ -0,0 +1,1280 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+open SymbolicExpression
+
+
+exception Can't_perform_inversion
+
+let union xs ys =
+  List.fold_left (fun xs y -> if List.memq y xs then xs else y :: xs) xs ys
+
+module StringMap = Map.Make (struct type t = string let compare = compare end)
+
+let map_length map = StringMap.fold (fun _ _ acc -> acc + 1) map 0
+
+module IntegerElement =
+  struct
+    type t = Infinity | Int of int
+    let zero = Int 0
+    let infinity = Infinity
+    let equal = ( = )
+    let compare x y = match x, y with
+      | Int i, Int i' -> compare i i'
+      | Int _, Infinity -> -1
+      | Infinity, Int _ -> 1
+      | Infinity, Infinity -> 0
+    let add x y = match x, y with
+      | Int i, Int i' -> Int (i + i')
+      | _, Infinity | Infinity, _ -> Infinity
+    let sub x y = match x, y with
+      | Int i, Int i' -> Int (i - i')
+      | Infinity, Int _ -> Infinity
+      | _, Infinity -> assert false
+  end
+
+module IntegerHungarianMethod =
+  HungarianMethod.Make
+    (IntegerElement)
+    (SquareSparseMatrix.Make (IntegerElement))
+    (BipartiteGraph)
+
+type identifier_maps =
+  {
+    parameters_map: parameter StringMap.t Lazy.t;
+    inputs_map: input StringMap.t Lazy.t;
+    discrete_variables_map: variable StringMap.t Lazy.t;
+    variables_map: variable StringMap.t Lazy.t
+  }
+
+and parameter =
+  {
+    parameter_kind: Instantiation.parameter_kind;
+    parameter_id: int;
+    parameter_comment: string;
+    parameter_start: t Lazy.t
+  }
+
+and input =
+  {
+    input_id: int;
+    input_name: string;
+    input_comment: string;
+  }
+
+and variable =
+  {
+    variable_id: int;
+    variable_comment: string;
+    variable_start: t Lazy.t option
+  }
+
+and model =
+  {
+    mutable inputs: string array;
+    mutable parameters: parameter_description array;
+    mutable discrete_variables: discrete_variable_description array;
+    mutable variables: variable_description array;
+    mutable equations: equation_description array;
+    mutable reinitializable_variables: t list;
+    mutable when_clauses: (t * when_expression list) list;
+    mutable io_dependency: bool;
+    mutable external_functions: (string list * int) list;
+    trace: string option
+  }
+
+and parameter_description =
+  {
+    mutable main: bool;
+    mutable p_name: string;
+    mutable p_comment: string;
+    mutable value: t
+  }
+
+and discrete_variable_description =
+  {
+    mutable d_output: int option;
+    mutable d_v_name: string;
+    mutable d_v_comment: string;
+    mutable d_start_value: t option
+  }
+
+and variable_description =
+  {
+    mutable output: int option;
+    mutable state: bool;
+    mutable v_name: string;
+    mutable v_comment: string;
+    mutable start_value: t option
+  }
+
+and equation_description =
+  {
+    mutable solved: bool;
+    mutable inner_variables: t list;
+    mutable inner_derivatives: t list;
+    mutable assignable_variables: t list;
+    mutable expression: t
+  }
+
+and when_expression =
+  | Assign of t * t
+  | Reinit of t * t
+
+
+let scaling_factor = Num.power_num (Num.Int 10) (Num.Int 16)
+
+let num_of_float f =
+  let num_of_positive_float f =
+    let m, e = frexp f in
+    let sm = string_of_float m in
+    let s = String.make 16 '0' in
+    String.blit sm 2 s 0 (String.length sm - 2);
+    let e' = Num.power_num (Num.Int 2) (Num.num_of_int e) in
+    Num.div_num (Num.mult_num (Num.num_of_string s) e') scaling_factor
+  in
+  if f = 0.0 then Num.Int 0
+  else if f < 0.0 then
+    let num = num_of_positive_float (abs_float f) in
+    Num.minus_num num
+  else num_of_positive_float f
+
+let string_of_reference = function
+  | [(name, [||])] -> name
+  | _ -> failwith "string_of_reference: bad reference"
+
+let is_main_parameter id parameters_map =
+  let parameter = StringMap.find id parameters_map in
+  match parameter.parameter_kind with
+    | Instantiation.Main -> true
+    | Instantiation.Sub -> false
+
+let get_parameter_start id parameters_map =
+  let parameter = StringMap.find id parameters_map in
+  Lazy.force parameter.parameter_start
+
+let get_start_value id variables_map =
+  let variable = StringMap.find id variables_map in
+  match variable.variable_start with
+    | None -> zero
+    | Some lexpr -> Lazy.force lexpr
+
+let rec symbolic_expression_of_expression inl_par maps iexpr =
+  let rec symbolic_expression_of_expression' iexpr =
+    match iexpr.Instantiation.tex_expression with
+      | None -> assert false
+      | Some expr -> symbolic_expression_of_expression'' expr
+  and symbolic_expression_of_expression'' = function
+      | Instantiation.Abs iexpr ->
+          let expr = symbolic_expression_of_expression' iexpr in
+          symbolic_if
+            (symbolic_gt expr zero)
+            expr
+            (symbolic_minus expr)
+      | Instantiation.Addition (iexpr, iexpr') ->
+          symbolic_add
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.And (iexpr, iexpr') ->
+          symbolic_and
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Boolean false -> false_value
+      | Instantiation.Boolean true -> true_value
+      | Instantiation.Cardinality _ ->
+          invalid_arg "symbolic_expression_of_expression'"
+      | Instantiation.CompoundElement _ ->
+          invalid_arg "symbolic_expression_of_expression'"
+      | Instantiation.Cos iexpr ->
+          symbolic_cos (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Der iexpr ->
+          symbolic_derivative (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Division (iexpr, iexpr') ->
+          symbolic_div
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Equals (iexpr, iexpr') ->
+          symbolic_eq
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Exp iexpr ->
+          symbolic_exp (symbolic_expression_of_expression' iexpr)
+      | Instantiation.ExternalFunctionCall (path, iexprs) ->
+          symbolic_blackBox
+            (function_name_of path)
+            (List.map symbolic_expression_of_expression' iexprs)
+      | Instantiation.Floor iexpr ->
+          symbolic_floor (symbolic_expression_of_expression' iexpr)
+      | Instantiation.GreaterEqualThan (iexpr, iexpr') ->
+          symbolic_ge
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.GreaterThan (iexpr, iexpr') ->
+          symbolic_gt
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.If (iif_exprs, iexpr) ->
+          List.fold_right
+            (fun (iexpr, iexpr') expr ->
+              symbolic_if
+                (symbolic_expression_of_expression' iexpr)
+                (symbolic_expression_of_expression' iexpr')
+                expr)
+            iif_exprs
+            (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Integer i ->
+          let i1 = Int32.to_int (Int32.shift_right i 16)
+          and i2 = Int32.to_int (Int32.logand i (Int32.of_int 0xffff)) in
+          let num =
+            Num.add_num
+              (Num.mult_num (Num.num_of_int i1) (Num.num_of_int 65536))
+              (Num.num_of_int i2)
+          in create_number num
+      | Instantiation.Log iexpr ->
+          symbolic_log (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Max (iexpr, iexpr') ->
+          symbolic_max
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Min (iexpr, iexpr') ->
+          symbolic_min
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Minus iexpr ->
+          symbolic_minus (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Mod (iexpr, iexpr') ->
+          let expr = symbolic_expression_of_expression' iexpr
+          and expr' = symbolic_expression_of_expression' iexpr'
+          in
+          symbolic_sub
+            expr
+            (symbolic_mult (symbolic_floor (symbolic_div expr expr')) expr')
+      | Instantiation.Multiplication (iexpr, iexpr') ->
+          symbolic_mult
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.NoEvent iexpr ->
+          create_blackBox "noEvent" [symbolic_expression_of_expression' iexpr]
+      | Instantiation.Not iexpr ->
+          symbolic_not (symbolic_expression_of_expression' iexpr)
+      | Instantiation.NotEquals (iexpr, iexpr') ->
+          symbolic_neq
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Or (iexpr, iexpr') ->
+          symbolic_or
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.ParameterValue (_, iref) when inl_par ->
+          let id = string_of_reference iref in
+          if is_main_parameter id (Lazy.force maps.parameters_map) then
+            create_parameter
+              (StringMap.find id (Lazy.force maps.parameters_map)).parameter_id
+          else
+            get_parameter_start id (Lazy.force maps.parameters_map)
+      | Instantiation.ParameterValue (_, iref) ->
+          let id = string_of_reference iref in
+            create_parameter
+              (StringMap.find id (Lazy.force maps.parameters_map)).parameter_id
+      | Instantiation.Power (iexpr, iexpr') ->
+          symbolic_power
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Real f -> create_number (num_of_float f)
+      | Instantiation.Sin iexpr ->
+          symbolic_sin (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Sqrt iexpr ->
+          symbolic_sqrt (symbolic_expression_of_expression' iexpr)
+      | Instantiation.String s -> create_constant s
+      | Instantiation.Subtraction (iexpr, iexpr') ->
+          symbolic_sub
+            (symbolic_expression_of_expression' iexpr)
+            (symbolic_expression_of_expression' iexpr')
+      | Instantiation.Tan iexpr ->
+          symbolic_tan (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Tanh iexpr ->
+          symbolic_tanh (symbolic_expression_of_expression' iexpr)
+      | Instantiation.Time -> time
+      | Instantiation.VariableStart (_, iref) ->
+          let id = string_of_reference iref in
+          begin try get_start_value id (Lazy.force maps.variables_map) with
+            | Not_found ->
+                get_start_value id (Lazy.force maps.discrete_variables_map)
+          end
+      | Instantiation.VariableValue (_, iref) -> create_variable_value iref
+      | Instantiation.Vector iexprs ->
+          invalid_arg "symbolic_expression_of_expression'"
+  and create_variable_value iref =
+    let id = string_of_reference iref in
+    try
+      create_variable
+        (StringMap.find id (Lazy.force maps.variables_map)).variable_id
+    with
+      | _ ->
+          try
+            let dvar =
+              StringMap.find id (Lazy.force maps.discrete_variables_map)
+            in create_discrete_variable dvar.variable_id
+          with
+            | _ ->
+                try
+                  let inp = StringMap.find id (Lazy.force maps.inputs_map) in
+                  create_discrete_variable (-1 - (inp.input_id))
+                  (* Use of strictly negative values to be able to distinguish
+                     inputs from other discrete variables. *)
+                with
+                  | _ -> assert false
+  and function_name_of = function
+    | [] -> assert false
+    | [s] -> s
+    | s :: ss -> function_name_of ss
+  in symbolic_expression_of_expression' iexpr
+
+let collect_external_function_names iequs =
+  let rec add_if_not_in (name, arity) = function
+    | [] -> [name, arity]
+    | ((name', _) :: _) as names when name = name' -> names
+    | name'_arity :: names -> name'_arity :: add_if_not_in (name, arity) names
+  in
+  let rec collect_in_equations funcalls = function
+    | [] -> funcalls
+    | Instantiation.Equation (iexpr, iexpr') :: iequs' ->
+        let funcalls = collect_in_expressions funcalls iexpr in
+        let funcalls = collect_in_expressions funcalls iexpr' in
+        collect_in_equations funcalls iequs'
+    | Instantiation.ConditionalEquation (iif_equs, iequs) :: iequs' ->
+        let funcalls = collect_in_if_clauses funcalls iif_equs in
+        let funcalls = collect_in_equations funcalls iequs in
+        collect_in_equations funcalls iequs'
+    | Instantiation.When iwhen_clauses :: iequs' ->
+        let funcalls = collect_in_when_clauses funcalls iwhen_clauses in
+        collect_in_equations funcalls iequs'
+    | Instantiation.FlowConnection _ :: _-> assert false
+  and collect_in_if_clauses funcalls = function
+    | [] -> funcalls
+    | (iexpr, iequs) :: iif_equs ->
+        let funcalls = collect_in_expressions funcalls iexpr in
+        let funcalls = collect_in_equations funcalls iequs in
+        collect_in_if_clauses funcalls iif_equs
+  and collect_in_when_clauses funcalls = function
+    | [] -> funcalls
+    | (iexpr, iwhen_equs) :: iwhen_clauses ->
+        let funcalls = collect_in_expressions funcalls iexpr in
+        let funcalls =
+          List.fold_left
+            (fun
+              funcalls
+              (Instantiation.Reinit (iexpr, iexpr') |
+              Instantiation.Assign (iexpr, iexpr')) ->
+              let funcalls =
+                collect_in_expressions funcalls iexpr
+              in collect_in_expressions funcalls iexpr')
+            funcalls
+            iwhen_equs
+        in collect_in_when_clauses funcalls iwhen_clauses
+  and collect_in_expressions funcalls iexpr =
+    match iexpr.Instantiation.tex_expression with
+      | None -> funcalls
+      | Some expr -> collect_in_expressions' funcalls expr
+  and collect_in_expressions' funcalls = function
+      | Instantiation.Addition (iexpr, iexpr') |
+        Instantiation.And (iexpr, iexpr') |
+        Instantiation.Division (iexpr, iexpr') |
+        Instantiation.Equals (iexpr, iexpr') |
+        Instantiation.GreaterEqualThan (iexpr, iexpr') |
+        Instantiation.GreaterThan (iexpr, iexpr') |
+        Instantiation.Max (iexpr, iexpr') | Instantiation.Min (iexpr, iexpr') |
+        Instantiation.Mod (iexpr, iexpr') |
+        Instantiation.Multiplication (iexpr, iexpr') |
+        Instantiation.NotEquals (iexpr, iexpr') |
+        Instantiation.Or (iexpr, iexpr') | Instantiation.Power (iexpr, iexpr') |
+        Instantiation.Subtraction (iexpr, iexpr') ->
+          let funcalls = collect_in_expressions funcalls iexpr in
+          collect_in_expressions funcalls iexpr'
+      | Instantiation.ExternalFunctionCall (name, iexprs) ->
+          let funcalls = add_if_not_in (name, List.length iexprs) funcalls in
+          List.fold_left collect_in_expressions funcalls iexprs
+      | Instantiation.If (iif_exprs, iexpr) ->
+          let funcalls =
+            List.fold_left
+              (fun funcalls (iexpr, iexpr') ->
+                let funcalls = collect_in_expressions funcalls iexpr in
+                collect_in_expressions funcalls iexpr')
+              funcalls
+              iif_exprs
+          in collect_in_expressions funcalls iexpr
+      | Instantiation.Minus iexpr | Instantiation.NoEvent iexpr |
+        Instantiation.Not iexpr | Instantiation.Abs iexpr |
+        Instantiation.Cos iexpr | Instantiation.Exp iexpr |
+        Instantiation.Floor iexpr | Instantiation.Log iexpr |
+        Instantiation.Sin iexpr | Instantiation.Sqrt iexpr |
+        Instantiation.Tan iexpr | Instantiation.Tanh iexpr ->
+          collect_in_expressions funcalls iexpr
+      | Instantiation.ParameterValue _ | Instantiation.Real _ |
+        Instantiation.String _ | Instantiation.Time |
+        Instantiation.VariableStart _ | Instantiation.VariableValue _ |
+        Instantiation.Boolean _ | Instantiation.Der _ | Instantiation.Integer _ ->
+          funcalls
+      | Instantiation.Cardinality _ | Instantiation.CompoundElement _ |
+        Instantiation.Vector _ -> assert false
+  in collect_in_equations [] iequs
+
+let separate_parameters_from_variables icpnts =
+  let is_parameter = function
+    | _, Instantiation.InstantiatedParameter _ -> true
+    | _, Instantiation.InstantiatedVariable _ -> false
+  in List.partition is_parameter icpnts
+
+let separate_inputs_from_others icpnts =
+  let is_input = function
+    | Instantiation.InstantiatedDiscreteVariable (_, Compilation.Input, _) |
+      Instantiation.InstantiatedRealVariable (_, Compilation.Input, _, _) ->
+        true
+    | Instantiation.InstantiatedDiscreteVariable _ |
+      Instantiation.InstantiatedRealVariable _ |
+      Instantiation.InstantiatedCompoundVariable _ -> false
+  in
+  let filter_variable = function
+    | _, Instantiation.InstantiatedParameter _ -> false
+    | _, Instantiation.InstantiatedVariable ivar -> is_input ivar
+  in List.partition filter_variable icpnts
+
+let separate_discrete_variables_from_others icpnts =
+  let is_discrete = function
+    | Instantiation.InstantiatedDiscreteVariable _ -> true
+    | Instantiation.InstantiatedRealVariable _ |
+      Instantiation.InstantiatedCompoundVariable _ -> false
+  in
+  let filter_variable = function
+    | _, Instantiation.InstantiatedParameter _ -> false
+    | _, Instantiation.InstantiatedVariable ivar -> is_discrete ivar
+  in List.partition filter_variable icpnts
+
+let separate_outputs_from_others icpnts =
+  let is_output = function
+    | Instantiation.InstantiatedDiscreteVariable (_, Compilation.Output, _) |
+      Instantiation.InstantiatedRealVariable (_, Compilation.Output, _, _) ->
+        true
+    | Instantiation.InstantiatedDiscreteVariable _ |
+      Instantiation.InstantiatedRealVariable _ |
+      Instantiation.InstantiatedCompoundVariable _ -> false
+  in
+  let filter_variable = function
+    | _, Instantiation.InstantiatedParameter _ -> false
+    | _, Instantiation.InstantiatedVariable ivar -> is_output ivar
+  in List.partition filter_variable icpnts
+
+let create_dictionary get_contents maps icpnts =
+  let rec add_entries i map = function
+    | [] -> map
+    | (s, icpnt) :: icpnts ->
+        add_entries
+          (i + 1)
+          (StringMap.add s (get_contents maps s i icpnt) map)
+          icpnts
+  in add_entries 0 StringMap.empty icpnts
+
+let separate_whens_from_equations iequs =
+  let rec separate_whens_from_equations' whens equations = function
+    | [] -> whens, equations
+    | (Instantiation.Equation _ as iequ) :: iequs' ->
+        separate_whens_from_equations' whens (iequ :: equations) iequs'
+    | Instantiation.When iwhen_clauses :: iequs' ->
+        separate_whens_from_equations' (whens @ iwhen_clauses) equations iequs'
+    | Instantiation.ConditionalEquation _ :: _ |
+      Instantiation.FlowConnection _ :: _ -> assert false
+  in separate_whens_from_equations' [] [] iequs
+
+let symbolic_equation inl_par maps = function
+  | Instantiation.Equation (iexpr, iexpr') ->
+      let expr =
+        symbolic_sub
+          (symbolic_expression_of_expression inl_par maps iexpr)
+          (symbolic_expression_of_expression inl_par maps iexpr')
+      in
+      {
+        solved = false;
+        inner_variables = variables_of expr;
+        inner_derivatives = derivatives_of expr;
+        assignable_variables = assignable_variables_of expr;
+        expression = expr
+      }
+  | _ -> assert false
+
+let symbolic_surfaces inl_par maps when_clauses =
+  List.map
+    (fun (iexpr, surfaces) ->
+      symbolic_expression_of_expression inl_par maps iexpr,
+      List.map
+        (function
+          | Instantiation.Reinit (iexpr, iexpr') ->
+            let var = symbolic_expression_of_expression inl_par maps iexpr in
+            begin match nature var with
+              | Variable i ->
+                  Reinit (var, symbolic_expression_of_expression inl_par maps iexpr')
+              | _ -> assert false
+            end
+          | Instantiation.Assign (iexpr, iexpr') ->
+            let var = symbolic_expression_of_expression inl_par maps iexpr in
+            begin match nature var with
+              | DiscreteVariable i ->
+                  Assign (var, symbolic_expression_of_expression inl_par maps iexpr')
+              | _ -> assert false
+            end)
+        surfaces)
+    when_clauses
+
+let propagate_noEvent expr =
+  (* such that 'noEvent' only appears in conditions *)
+  let rec propagate_noEvent' no_event expr = match nature expr with
+    | And exprs' ->
+        create_and (sort (List.map (propagate_noEvent' no_event) exprs'))
+    | ArcCosine expr' -> create_arcCosine (propagate_noEvent' no_event expr')
+    | ArcHyperbolicCosine expr' ->
+        create_arcHyperbolicCosine (propagate_noEvent' no_event expr')
+    | ArcHyperbolicSine expr' ->
+        create_arcHyperbolicSine (propagate_noEvent' no_event expr')
+    | ArcHyperbolicTangent expr' ->
+        create_arcHyperbolicTangent (propagate_noEvent' no_event expr')
+    | ArcSine expr' -> create_arcSine (propagate_noEvent' no_event expr')
+    | ArcTangent expr' -> create_arcTangent (propagate_noEvent' no_event expr')
+    | Cosine expr' -> create_cosine (propagate_noEvent' no_event expr')
+    | Derivative (expr', num) ->
+        create_derivative (propagate_noEvent' no_event expr') num
+    | Equality (expr', expr'') ->
+        create_equality
+          (propagate_noEvent' no_event expr')
+          (propagate_noEvent' no_event expr'')
+    | Exponential expr' ->
+        create_exponential (propagate_noEvent' no_event expr')
+    | Floor expr' -> create_floor (propagate_noEvent' no_event expr')
+    | Greater (expr', expr'') ->
+        create_greater
+          (propagate_noEvent' no_event expr')
+          (propagate_noEvent' no_event expr'')
+    | HyperbolicCosine expr' ->
+        create_hyperbolicCosine (propagate_noEvent' no_event expr')
+    | HyperbolicSine expr' ->
+        create_hyperbolicSine (propagate_noEvent' no_event expr')
+    | HyperbolicTangent expr' ->
+        create_hyperbolicTangent (propagate_noEvent' no_event expr')
+    | Logarithm expr' -> create_logarithm (propagate_noEvent' no_event expr')
+    | RationalPower (expr', num) ->
+        create_rationalPower (propagate_noEvent' no_event expr') num
+    | Sign expr' -> create_sign (propagate_noEvent' no_event expr')
+    | Sine expr' -> create_sine (propagate_noEvent' no_event expr')
+    | Tangent expr' -> create_tangent (propagate_noEvent' no_event expr')
+    | Addition exprs' ->
+        create_addition (sort (List.map (propagate_noEvent' no_event) exprs'))
+    | BlackBox ("noEvent", [expr']) -> propagate_noEvent' true expr'
+    | BlackBox (name, exprs') ->
+        create_blackBox name (List.map (propagate_noEvent' no_event) exprs')
+    | Multiplication exprs' ->
+        create_multiplication
+          (sort (List.map (propagate_noEvent' no_event) exprs'))
+    | Not expr' -> create_not (propagate_noEvent' no_event expr')
+    | Or exprs' ->
+        create_or (sort (List.map (propagate_noEvent' no_event) exprs'))
+    | PartialDerivative (expr', expr'') ->
+        create_partialDerivative
+          (propagate_noEvent' no_event expr')
+          (propagate_noEvent' no_event expr'')
+    | If (expr', expr'', expr''') ->
+        propagate_noEvent_into_if no_event expr' expr'' expr'''
+    | BooleanValue _ | Constant _ | DiscreteVariable _ | Number _ |
+      Parameter _ | TimeVariable | Variable _ -> expr
+  and propagate_noEvent_into_if no_event expr expr' expr'' =
+    let cond =
+      if no_event then create_blackBox "noEvent" [propagate_noEvent' false expr]
+      else begin match nature expr with
+        | BlackBox ("noEvent", [expr']) ->
+            create_blackBox "noEvent" [propagate_noEvent' false expr]
+        | _ -> propagate_noEvent' false expr
+      end
+    in
+    create_if
+      cond
+      (propagate_noEvent' no_event expr')
+      (propagate_noEvent' no_event expr'')
+  in propagate_noEvent' false expr
+
+let create_model' trace inl_par iexpr =
+  let lazy_symbolic_expression_of_expression maps iexpr = match iexpr.Instantiation.tex_expression with
+    | None -> None
+    | Some _ -> Some (lazy (symbolic_expression_of_expression inl_par maps iexpr))
+  in
+  let get_parameter_info maps s i = function
+    | Instantiation.InstantiatedParameter (
+        Instantiation.InstantiatedIntegerParameter (s', kind, iexpr)) |
+      Instantiation.InstantiatedParameter (
+        Instantiation.InstantiatedRealParameter (s', kind, iexpr)) ->
+        {
+          parameter_kind = kind;
+          parameter_id = i;
+          parameter_comment = s';
+          parameter_start = lazy (symbolic_expression_of_expression inl_par maps iexpr)
+        }
+    | _ -> assert false
+  and get_input_info maps s i = function
+    | Instantiation.InstantiatedVariable (
+        Instantiation.InstantiatedDiscreteVariable (s', _, _)) |
+      Instantiation.InstantiatedVariable (
+        Instantiation.InstantiatedRealVariable (s', _, _, _)) ->
+        {
+          input_id = i;
+          input_name = s;
+          input_comment = s'
+        }
+    | _ -> assert false
+  and get_variable_info maps s i = function
+    | Instantiation.InstantiatedVariable (
+        Instantiation.InstantiatedDiscreteVariable (s', _, iexpr)) |
+      Instantiation.InstantiatedVariable (
+        Instantiation.InstantiatedRealVariable (s', _, _, iexpr)) ->
+        {
+          variable_id = i;
+          variable_comment = s';
+          variable_start = lazy_symbolic_expression_of_expression maps iexpr
+        }
+    | _ -> assert false
+  in
+  let derived_variables ders =
+    List.fold_left
+      (fun vars der ->
+        match nature der with
+          | Derivative (expr, num) when num = Num.Int 1 ->
+              begin match nature expr with
+                | Variable _ -> expr :: vars
+                | _ -> assert false
+              end
+          | _ -> assert false)
+      []
+      ders
+  in
+  let icpnts, iinit_equs, iequs = Instantiation.expand_class iexpr in
+  let parameters, variables = separate_parameters_from_variables icpnts in
+  let inputs, non_inputs = separate_inputs_from_others variables in
+  let discrete_variables, others =
+    separate_discrete_variables_from_others non_inputs
+  in
+  let outputs, _ = separate_outputs_from_others non_inputs in
+  let function_names =
+    collect_external_function_names iequs @
+    collect_external_function_names iinit_equs
+  in
+  let rec maps =
+    {
+      parameters_map =
+        lazy (create_dictionary get_parameter_info maps parameters);
+      inputs_map =
+        lazy (create_dictionary get_input_info maps inputs);
+      discrete_variables_map =
+       lazy (create_dictionary get_variable_info maps discrete_variables);
+      variables_map =
+        lazy (create_dictionary get_variable_info maps others)
+    }
+  in
+  let when_clauses, equations = separate_whens_from_equations iequs in
+  let nb_parameters = map_length (Lazy.force maps.parameters_map)
+  and nb_inputs = map_length (Lazy.force maps.inputs_map)
+  and nb_discrete_vars = map_length (Lazy.force maps.discrete_variables_map)
+  and nb_vars = map_length (Lazy.force maps.variables_map)
+  and nb_equs = List.length equations in
+  if nb_equs <> nb_vars then
+    failwith
+      ("The number of equations doesn't match the number of variables: " ^
+      string_of_int nb_equs ^ " equations and " ^ string_of_int nb_vars ^
+      " variables.")
+  else
+    let parameters_array =
+      Array.init
+        nb_parameters
+        (fun _ ->
+          {
+            main = false;
+            p_name = "";
+            p_comment = "";
+            value = zero
+          })
+    and inputs_array = Array.make nb_inputs ""
+    and discrete_variables_array =
+      Array.init
+        nb_discrete_vars
+        (fun _ ->
+          {
+            d_output = None;
+            d_v_name = "";
+            d_v_comment = "";
+            d_start_value = Some zero
+          })
+    and variables_array =
+      Array.init
+        nb_vars
+        (fun _ ->
+          {
+            output = None;
+            state = true;
+            v_name = "";
+            v_comment = "";
+            start_value = Some zero
+          })
+    and equations_array =
+      Array.init
+        nb_equs
+        (fun _ ->
+          {
+            solved = false;
+            inner_variables = [];
+            inner_derivatives = [];
+            assignable_variables = [];
+            expression = zero
+          })
+    in
+    let output_index s outputs =
+      let rec output_index' i = function
+        | [] -> None
+        | (s', _) :: _ when s' = s -> Some i
+        | _ :: outputs' -> output_index' (i + 1) outputs'
+      in output_index' 0 outputs
+    in
+    let _ =
+      List.fold_left
+        (fun i equ ->
+          assert (i < Array.length equations_array);
+          equations_array.(i) <- symbolic_equation inl_par maps equ; i + 1)
+        0
+        equations
+    in ();
+    let derived_variables =
+      Array.fold_left
+        (fun vars equation ->
+          union vars (derived_variables equation.inner_derivatives))
+        []
+        equations_array
+    in
+    StringMap.iter
+      (fun s param ->
+        assert (param.parameter_id < Array.length parameters_array);
+        let parameter = parameters_array.(param.parameter_id) in
+        parameter.main <- param.parameter_kind = Instantiation.Main;
+        parameter.p_name <- s;
+        parameter.p_comment <- param.parameter_comment;
+        parameter.value <- Lazy.force param.parameter_start)
+      (Lazy.force maps.parameters_map);
+    StringMap.iter
+      (fun _ inp ->
+        assert (inp.input_id < Array.length inputs_array);
+        inputs_array.(inp.input_id) <- inp.input_name)
+      (Lazy.force maps.inputs_map);
+    StringMap.iter
+      (fun s dvar ->
+        assert (dvar.variable_id < Array.length discrete_variables_array);
+        let variable = discrete_variables_array.(dvar.variable_id) in
+        variable.d_output <- output_index s outputs;
+        variable.d_v_name <- s;
+        variable.d_v_comment <- dvar.variable_comment;
+        variable.d_start_value <-
+          match dvar.variable_start with
+            | None -> None
+            | Some lexpr -> Some (Lazy.force lexpr))
+      (Lazy.force maps.discrete_variables_map);
+    StringMap.iter
+      (fun s var ->
+        assert (var.variable_id < Array.length variables_array);
+        let variable = variables_array.(var.variable_id) in
+        variable.output <- output_index s outputs;
+        variable.state <-
+          List.memq (create_variable var.variable_id) derived_variables;
+        variable.v_name <- s;
+        variable.v_comment <- var.variable_comment;
+        variable.start_value <-
+          match var.variable_start with
+            | None -> None
+            | Some lexpr -> Some (Lazy.force lexpr))
+      (Lazy.force maps.variables_map);
+    let when_clauses_list = symbolic_surfaces inl_par maps when_clauses in
+    let reinitializable_variables =
+      let add_non_discrete_variables vars = function
+        | Reinit (var, _) when not (List.memq var vars) -> var :: vars
+        | _ -> vars
+      in
+      List.fold_left
+        (fun vars (_, when_expr) ->
+          List.fold_left add_non_discrete_variables vars when_expr)
+        []
+        when_clauses_list
+    in
+    Array.iter
+      (fun equation ->
+        equation.expression <- propagate_noEvent equation.expression)
+      equations_array;
+    {
+      parameters = parameters_array;
+      inputs = inputs_array;
+      discrete_variables = discrete_variables_array;
+      variables = variables_array;
+      equations = equations_array;
+      reinitializable_variables = reinitializable_variables;
+      when_clauses = when_clauses_list;
+      io_dependency = false;
+      external_functions = function_names;
+      trace = trace
+    }
+
+let create_model_with_parameters trace iexpr = create_model' trace false iexpr
+
+let create_model trace iexpr = create_model' trace true iexpr
+
+let print_model oc model =
+  Printf.fprintf
+    oc
+    "Number of variables before simplifications: %d\n"
+    (Array.length model.variables);
+  Printf.fprintf
+    oc
+    "Number of variables after simplifications: %d\n"
+    (Array.fold_left
+      (fun n equation -> if equation.solved then n else n + 1)
+      0
+      model.equations);
+  Printf.fprintf
+    oc
+    "Direct input/ouput dependency: %s\n"
+    (if model.io_dependency then "yes" else "no");
+  Array.iteri
+    (fun i variable ->
+      Printf.fprintf
+        oc
+        "variable (%d) (%s): %s %s variable (%ssolved)\n"
+        i
+        variable.v_name
+        (if variable.output <> None then "output" else "intermediate")
+        (if variable.state then "state" else "algebraic")
+        (if model.equations.(i).solved then "" else "not "))
+    model.variables;
+  Array.iteri
+    (fun i equation ->
+      Printf.fprintf oc "equation(%d): " i;
+      if equation.solved then output oc (create_variable i)
+      else Printf.fprintf oc "0";
+      Printf.fprintf oc " = ";
+      output oc equation.expression;
+      Printf.fprintf oc "\n")
+    model.equations
+
+let create_index_array a p =
+  let size = Array.length a in
+  let indexes = Array.make size (-1) in
+  let j = ref 0 in
+  Array.iteri (fun i x -> if p x then begin indexes.(i) <- !j; incr j end) a;
+  indexes
+
+let final_index_of_variables model =
+  create_index_array model.equations (fun equation -> not equation.solved)
+
+let permute_equations model assocs =
+  let equations = Array.copy model.equations in
+  List.iter
+    (function
+      | i, Some j -> equations.(i) <- model.equations.(j)
+      | _, None -> assert false)
+    assocs;
+  model.equations <- equations
+
+let perform_then_propagate_inversion model i =
+  let update_clauses var expr' clauses =
+    List.map
+      (fun (expr, updates) ->
+        replace var expr' expr,
+        List.map
+          (function
+            | Assign (expr1, expr2) ->
+                Assign (expr1, replace var expr' expr2)
+            | Reinit (expr1, expr2) ->
+                Reinit (expr1, replace var expr' expr2))
+          updates)
+      clauses
+  in
+  let var = create_variable i
+  and equation = model.equations.(i) in
+  let expr = equation.expression in
+  try match invert_if_possible_with_respect_to var expr zero with
+    | None -> ()
+    | Some expr' ->
+        if not (List.memq var model.reinitializable_variables) then begin
+          equation.expression <- expr';
+          equation.solved <- true;
+          let additional_variables = variables_of expr' in
+          Array.iteri
+            (fun j equation ->
+              if i <> j && List.memq var equation.inner_variables then begin
+                equation.expression <- replace var expr' equation.expression;
+                equation.inner_variables <-
+                  union equation.inner_variables additional_variables
+              end)
+            model.equations;
+          model.when_clauses <- update_clauses var expr' model.when_clauses
+        end;
+  with Invalid_argument _ -> raise Can't_perform_inversion
+
+let compute_io_dependency model =
+  let rec compute_io_dependency' i =
+    if not (i = Array.length model.variables) then
+      if
+        model.variables.(i).output <> None &&
+        exists
+          (fun node -> match nature node with
+            | DiscreteVariable i when i < 0 -> true
+            | _ -> false)
+          model.equations.(i).expression
+      then
+        model.io_dependency <- true
+      else
+        compute_io_dependency' (i + 1)
+  in compute_io_dependency' 0
+
+let perform_hungarian_method model =
+  let size =
+    Array.fold_left
+      (fun acc equation -> if equation.solved then acc else acc + 1)
+      0
+      model.equations
+  in
+  let () =
+    Array.iter
+      (fun equation ->
+        if not equation.solved then begin
+          equation.inner_variables <- variables_of equation.expression;
+          equation.inner_derivatives <- derivatives_of equation.expression;
+          equation.assignable_variables <-
+            assignable_variables_of equation.expression
+        end)
+      model.equations
+  in
+  let table = Array.make size 0 in
+  let i = ref 0 in
+  for j = 0 to Array.length model.equations - 1 do
+    if not model.equations.(j).solved then begin
+      table.(!i) <- j; incr i
+    end
+  done;
+  let weight i j =
+    let m = table.(i)
+    and n = table.(j) in
+    let var = create_variable m in
+    if not (List.memq var model.equations.(n).assignable_variables) then
+      IntegerElement.Infinity
+    else if model.variables.(m).start_value <> None then
+      IntegerElement.Int (size * size + 1)
+      (* The user wants to see the variable in the generated code *)
+    else match inversion_difficulty var model.equations.(n).expression zero with
+        | 0 -> IntegerElement.zero
+        | 1 -> IntegerElement.Int 1
+        | 2 -> IntegerElement.Int (size + 1)
+        | _ -> IntegerElement.Infinity
+  in
+  let strct = IntegerHungarianMethod.init size weight in
+  let assocs = IntegerHungarianMethod.perform strct in
+  let assocs' =
+    List.map
+      (function
+        | i, Some j -> table.(i), Some table.(j)
+        | _, None ->
+            failwith "perform_hungarian_method: jacobian is structurally singular")
+      assocs
+  in
+  assert (
+    let rec check_results1 = function
+      | [] -> true
+      | (_, x) :: xs when List.exists (fun (_, y) -> x = y) xs -> false
+      | _ :: xs -> check_results1 xs
+    in check_results1 assocs');
+  assert (
+    let check_results2 = function
+      | (i, Some j) :: assocs ->
+          let var = create_variable i in
+          List.memq var model.equations.(j).inner_variables
+      | _ -> true
+    in check_results2 assocs');
+  assocs'
+
+let eliminate_trivial_relations max_simplifs model =
+  let max_simplifs_ref = ref max_simplifs in
+  let choose_variable i j =
+    let sti = model.variables.(i).state
+    and stj = model.variables.(j).state in
+    match sti, stj with
+      | true, false -> i
+      | false, true -> j
+      | _ ->
+          let svi = model.variables.(i).start_value
+          and svj = model.variables.(j).start_value in
+          begin match svi, svj with
+            | _, None -> i
+            | _ -> j
+          end
+  in
+  let permute_equations i j =
+    let equation = model.equations.(i) in
+    model.equations.(i) <- model.equations.(j);
+    model.equations.(j) <- equation
+  in
+  let update_variable_attributes i j =
+    let svi = model.variables.(i).start_value
+    and svj = model.variables.(j).start_value in
+    let sti = model.variables.(i).state
+    and stj = model.variables.(j).state in
+    let state = sti || stj in
+    model.variables.(i).state <- state;
+    model.variables.(j).state <- state;
+    match sti, stj with
+      | true, false -> model.variables.(j).start_value <- svi
+      | false, true -> model.variables.(i).start_value <- svj
+      | _ ->
+          begin match svi, svj with
+            | _, None -> model.variables.(j).start_value <- svi
+            | _ -> model.variables.(i).start_value <- svj
+          end
+  in
+  let simplify_trivial_relation n =
+    match nature model.equations.(n).expression with
+      | Addition [node; node'] when !max_simplifs_ref >= 0 ->
+          begin match nature node, nature node' with
+            | Variable i, Number _ | Number _, Variable i ->
+                permute_equations i n;
+                perform_then_propagate_inversion model i;
+                decr max_simplifs_ref
+            | Variable i, Multiplication [node; node'] |
+              Multiplication [node; node'], Variable i ->
+                begin match nature node, nature node' with
+                  | Number (Num.Int (-1)), Variable j |
+                    Variable j, Number (Num.Int (-1)) ->
+                      let k = choose_variable i j in
+                      update_variable_attributes i j;
+                      permute_equations k n;
+                      perform_then_propagate_inversion model k;
+                      decr max_simplifs_ref
+                  | _ -> ()
+                end
+            | _ -> ()
+          end
+      | _ -> ()
+  in
+  for i = 0 to Array.length model.equations - 1 do
+    simplify_trivial_relation i
+  done;
+  !max_simplifs_ref
+
+let eliminate_explicit_variables max_simplifs model =
+  let rec eliminate_explicit_variables' simplifs =
+    let assocs = perform_hungarian_method model in
+    permute_equations model assocs;
+    let bad_variable_choice, success, simplifs =
+      List.fold_left
+        (fun (bad_variable_choice, success, simplifs) assoc ->
+          match assoc with
+            | (_, None) -> assert false
+            | i, Some j when simplifs >= 0 ->
+                begin try
+                  if not model.variables.(i).state then
+                    perform_then_propagate_inversion model i;
+                  bad_variable_choice, model.equations.(i).solved, simplifs - 1
+                with
+                  | Can't_perform_inversion -> true, success, simplifs
+                end
+            | _ -> bad_variable_choice, success, simplifs)
+        (false, false, simplifs)
+        assocs
+    in
+    if bad_variable_choice || success then
+      eliminate_explicit_variables' simplifs
+  in eliminate_explicit_variables' max_simplifs
+
+let rec is_greater_equal expr = match nature expr with
+  | BlackBox ("noEvent", [expr']) -> is_greater_equal expr'
+  | Or [expr1; expr2] ->
+      begin match nature expr1, nature expr2 with
+        | Equality (expr11, expr12), Greater (expr21, expr22)
+          when expr11 == expr21 && expr12 == expr22 ||
+          expr11 == expr22 && expr12 == expr21 -> true
+        | Greater (expr11, expr12), Equality (expr21, expr22)
+          when expr11 == expr21 && expr12 == expr22 ||
+          expr11 == expr22 && expr12 == expr21 -> true
+        | _ -> false
+      end
+  | _ -> false
+
+let rec rewrite_conditions_in no_event expr =
+  let rec rewrite_if no_event expr expr' expr'' =
+    let no_event_if_necessary expr =
+      if no_event then create_blackBox "noEvent" [expr] else expr
+    in match nature expr with
+    | BlackBox ("noEvent", [expr1]) when nature expr1 = BooleanValue true ->
+        rewrite_conditions_in no_event expr'
+    | BlackBox ("noEvent", [expr1]) when nature expr1 = BooleanValue false ->
+        rewrite_conditions_in no_event expr''
+    | BlackBox ("noEvent", [expr1]) ->
+        create_if
+          (create_blackBox "noEvent" [rewrite_conditions_in true expr1])
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | Equality (expr1, expr2) ->
+        create_if
+          (no_event_if_necessary
+            (create_equality
+              (rewrite_conditions_in no_event expr1)
+              (rewrite_conditions_in no_event expr2)))
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | Greater (expr1, expr2) ->
+        create_if
+          (no_event_if_necessary
+            (create_greater
+              (rewrite_conditions_in no_event expr1)
+              (rewrite_conditions_in no_event expr2)))
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | And [] -> rewrite_conditions_in no_event expr'
+    | And [expr] ->
+        create_if
+          (no_event_if_necessary expr)
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | And (expr :: exprs) ->
+        rewrite_if no_event expr (create_if (create_and exprs) expr' expr'') expr''
+    | Or [] -> rewrite_conditions_in no_event expr''
+    | Or [expr] ->
+        create_if
+          (no_event_if_necessary expr)
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | Or [expr1; expr2] when is_greater_equal expr ->
+        begin match nature expr1, nature expr2 with
+          | Greater (expr1, expr2), _ | _, Greater (expr1, expr2) ->
+              let expr1' = rewrite_conditions_in no_event expr1
+              and expr2' = rewrite_conditions_in no_event expr2 in
+              create_if
+                (no_event_if_necessary
+                  (create_or
+                    [create_greater expr1' expr2'; create_equality expr1' expr2']))
+                (rewrite_conditions_in no_event expr')
+                (rewrite_conditions_in no_event expr'')
+          | _ -> assert false
+        end
+    | Or (expr :: exprs) ->
+        rewrite_if no_event expr expr' (create_if (create_or exprs) expr' expr'')
+    | Not expr ->
+        create_if
+          (no_event_if_necessary expr)
+          (rewrite_conditions_in no_event expr'')
+          (rewrite_conditions_in no_event expr')
+    | _ -> assert false
+  in match nature expr with
+    | ArcCosine expr' -> create_arcCosine (rewrite_conditions_in no_event expr')
+    | ArcHyperbolicCosine expr' ->
+        create_arcHyperbolicCosine (rewrite_conditions_in no_event expr')
+    | ArcHyperbolicSine expr' ->
+        create_arcHyperbolicSine (rewrite_conditions_in no_event expr')
+    | ArcHyperbolicTangent expr' ->
+        create_arcHyperbolicTangent (rewrite_conditions_in no_event expr')
+    | ArcSine expr' -> create_arcSine (rewrite_conditions_in no_event expr')
+    | ArcTangent expr' -> create_arcTangent (rewrite_conditions_in no_event expr')
+    | Cosine expr' -> create_cosine (rewrite_conditions_in no_event expr')
+    | Derivative (expr', num) ->
+        create_derivative (rewrite_conditions_in no_event expr') num
+    | Exponential expr' -> create_exponential (rewrite_conditions_in no_event expr')
+    | Floor expr' -> create_floor (rewrite_conditions_in no_event expr')
+    | HyperbolicCosine expr' ->
+        create_hyperbolicCosine (rewrite_conditions_in no_event expr')
+    | HyperbolicSine expr' ->
+        create_hyperbolicSine (rewrite_conditions_in no_event expr')
+    | HyperbolicTangent expr' ->
+        create_hyperbolicTangent (rewrite_conditions_in no_event expr')
+    | Logarithm expr' -> create_logarithm (rewrite_conditions_in no_event expr')
+    | Not expr' -> create_not (rewrite_conditions_in no_event expr')    
+    | RationalPower (expr', num) ->
+        create_rationalPower (rewrite_conditions_in no_event expr') num
+    | Sign expr' -> create_sign (rewrite_conditions_in no_event expr')
+    | Sine expr' -> create_sine (rewrite_conditions_in no_event expr')
+    | Tangent expr' -> create_tangent (rewrite_conditions_in no_event expr')
+    | Equality (expr1, expr2) ->
+        create_equality
+          (rewrite_conditions_in no_event expr1)
+          (rewrite_conditions_in no_event expr2)
+    | Greater (expr1, expr2) ->
+        create_greater
+          (rewrite_conditions_in no_event expr1)
+          (rewrite_conditions_in no_event expr2)
+    | Addition exprs' ->
+        create_addition (sort (List.map (rewrite_conditions_in no_event) exprs'))
+    | And exprs' ->
+        create_and (sort (List.map (rewrite_conditions_in no_event) exprs'))
+    | BlackBox ("noEvent", [expr']) -> rewrite_conditions_in true expr'
+    | BlackBox (name, exprs') ->
+        create_blackBox name (List.map (rewrite_conditions_in no_event) exprs')
+    | Multiplication exprs' ->
+        create_multiplication (sort (List.map (rewrite_conditions_in no_event) exprs'))
+    | Or exprs' ->
+        create_or (sort (List.map (rewrite_conditions_in no_event) exprs'))
+    | PartialDerivative (expr', expr'') ->
+        create_partialDerivative
+          (rewrite_conditions_in no_event expr')
+          (rewrite_conditions_in no_event expr'')
+    | If (expr', expr'', expr''') -> rewrite_if no_event expr' expr'' expr'''
+    | Constant _ | DiscreteVariable _ | Number _ | Parameter _ | TimeVariable |
+      Variable _ -> expr
+    | _ -> assert false
+
+let perform_simplifications max_simplifs model =
+  Array.iter
+    (fun equation ->
+      equation.expression <- rewrite_conditions_in false equation.expression)
+    model.equations;
+  eliminate_explicit_variables max_simplifs model;
+  compute_io_dependency model
+
+let compute_structural_index model =
+  failwith "compute_structural_index: not yet implemented"
+
+let find_submodels model =
+  let final_index_of_variables = final_index_of_variables model in
+  let size =
+    Array.fold_left
+      (fun acc i -> if i >= 0 then acc + 1 else acc)
+      0
+      final_index_of_variables
+  in
+  let graph = CausalityGraph.create size in
+  Array.iteri
+    (fun i equation ->
+      if not equation.solved then
+        List.iter
+          (fun expr ->
+            match nature expr with
+              | Variable j ->
+                  if not model.equations.(j).solved then
+                    let i' = final_index_of_variables.(i)
+                    and j' = final_index_of_variables.(j) in
+                    CausalityGraph.connect i' j' graph
+              | _ -> assert false)
+          equation.inner_variables)
+    model.equations;
+  CausalityGraph.strongly_connected_components graph
diff --git a/scilab/modules/scicos/src/modelica_compiler/optimization.mli b/scilab/modules/scicos/src/modelica_compiler/optimization.mli
new file mode 100644 (file)
index 0000000..015347e
--- /dev/null
@@ -0,0 +1,146 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module contains functions that perform symbolic and topologic
+simplifications over an instantiated Modelica model. *)
+
+(** The type of the records used to store information about parameters. *)
+type parameter_description = {
+  mutable main : bool; (** If a parameter is a "main" one, it is not inlined. *)
+  mutable p_name : string; (** The parameter's user name *)
+  mutable p_comment : string; (** The comment associated to the parameter. *)
+  mutable value : SymbolicExpression.t;
+}
+
+(** The type of the records used to store information about discrete variables.
+*)
+type discrete_variable_description =
+  {
+    mutable d_output: int option; (** The index of the variable in the output
+      vector *)
+    mutable d_v_name: string; (** The discrete variable's user name *)
+    mutable d_v_comment: string; (** The comment associated to the discrete
+      variable. *)
+    mutable d_start_value: SymbolicExpression.t option
+  }
+
+(** The type of the records used to store information about variables. *)
+type variable_description = {
+  mutable output : int option; (** The index of the variable in the output
+    vector *)
+  mutable state : bool; (** [true] = state variable, [false] = algebraic
+    variable *)
+  mutable v_name : string; (** The variable's user name *)
+  mutable v_comment : string; (** The comment associated to the variable. *)
+  mutable start_value : SymbolicExpression.t option;
+}
+
+(** The type of the records used to store information about equations. *)
+type equation_description = {
+  mutable solved : bool; (** [true] = the equation has been inverted with
+    respect to its associated variable (see model type) and thus does no longer
+    appear in the set of equations submitted to the numeric solver. *)
+  mutable inner_variables : SymbolicExpression.t list; (** The variables that
+    appear in the equation. *)
+  mutable inner_derivatives : SymbolicExpression.t list; (** The derivatives
+    that appear in the equation. *)
+  mutable assignable_variables : SymbolicExpression.t list; (** The variables
+    it is possible to invert the equation with respect to. *)
+  mutable expression : SymbolicExpression.t; (** If the equation has been
+    solved, this expression tells how it is possible to obtain the associated
+    variable's value from the set of unknown variables. Otherwise, this
+    expression is the right side hand of the residual equation submitted to the
+    numerical solver. *)
+}
+
+(** The type of a model on which it is possible to perform various optimizations
+passes. *)
+type model = {
+  mutable inputs : string array; (** inputs.(i) contains the user name of the
+    associated input. *)
+  mutable parameters : parameter_description array;
+  mutable discrete_variables : discrete_variable_description array;
+  mutable variables : variable_description array;
+  mutable equations : equation_description array;
+  mutable reinitializable_variables : SymbolicExpression.t list; (** The list of
+    the variables that may be reinitialized during the numerical simulation.
+    These variables are not eliminated during the symbolic simplification
+    passes. *)
+  mutable when_clauses :
+    (SymbolicExpression.t * when_expression list) list; (** The list of the when
+      clauses. Each clause is stored as a condition along with its associated
+      reinitializations. *)
+  mutable io_dependency : bool; (** [true] = there is a direct dependency
+    between inputs and outputs in the model. *)
+  mutable external_functions : (string list * int) list; (** The list of the paths
+    where to find external function bodies and their respective arity. *)
+  trace: string option (** The file where optional tracing information of
+    external function calls is generated *)
+}
+
+and when_expression =
+  | Assign of SymbolicExpression.t * SymbolicExpression.t
+  | Reinit of SymbolicExpression.t * SymbolicExpression.t
+
+val create_model_with_parameters: string option ->
+  Instantiation.typed_expression -> model
+(** [create_model trace iexpr] builds a model given the instantiated Modelica
+model [iexpr]. [trace], if not [None], indicates a filename where tracing
+information of external functions calls can be generated.
+The generated model includes all the parameters present in the original
+specification (i.e., no parameter inlining is performed).
+The resulting data structure can be used to perform various
+optimization passes over it. *)
+
+val create_model: string option -> Instantiation.typed_expression -> model
+(** [create_model trace iexpr] builds a model given the instantiated Modelica
+model [iexpr]. The resulting data structure can be used to perform various
+optimization passes over it. [trace], if not [None], indicates a filename
+where tracing information of external functions calls can be generated. *)
+
+val eliminate_trivial_relations: int -> model -> int
+(** [eliminate_trivial_relations max_simplifs model] eliminates at most
+[max_simplifs] trivial relations from the model (i.e. relations involving linear
+relations between at most two variables). Returns the number of remaining
+simplifications that was allowed. *)
+
+val perform_simplifications: int -> model -> unit
+(** [perform_simplifications max_simplifs model] simplifies [model] by making the
+appropriate substitutions in order to eliminate at most [max_simplifs] auxiliary
+variables from the model. *)
+
+val compute_structural_index: model -> int
+(** [compute_structural_index model] computes the structural index of the DAE
+system. *)
+
+val find_submodels: model -> int list list
+(** [find_submodels model] splits [model] in dependent submodels such that there
+is no cyclic dependency between them. The result is given as a list of index
+lists (each index corresponding to a variable index). *)
+
+val print_model: out_channel -> model -> unit
+(** [print_model oc model] prints [model] in an implementation-dependent format
+to [oc]. *)
+
+val is_greater_equal: SymbolicExpression.t -> bool
+(** [is_greater_equal expr] returns [true] if [expr] denotes a greater or equal
+construct, regardless "noEvents" encapsulations. This function is exported by
+Optimization as a utility for convenience. *)
diff --git a/scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.ml b/scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.ml
new file mode 100644 (file)
index 0000000..4ba86eb
--- /dev/null
@@ -0,0 +1,202 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+module type CODEGENERATOR =
+  sig
+    val generate_code: string -> string -> string -> Optimization.model -> bool
+      -> unit
+  end
+
+module type S =
+  sig
+    val sccs_id: string
+    val version: string
+    val run: unit -> unit
+  end
+
+module Make(G: CODEGENERATOR): S =
+  struct
+
+    let sccs_id =
+      "@(#)Modelicac - Copyright (C) 2003-2004 TNI-Valiosys, 2005 Imagine"
+
+    let version = "1.7.3"
+
+    let path = ref ""
+
+    let no_parameter_removal = ref false
+
+    let keep_variables = ref false
+
+    let compile_only = ref false
+
+    let with_jac = ref false
+
+    let trace = ref None
+
+    let gen_xml = ref false
+
+    let directories = ref [""]
+
+    let output = ref ""
+
+    let input = ref ""
+
+    let max_simplifs = ref max_int
+
+    let add_lib_path s =
+      directories := !directories @ [s]
+
+    let trace_filename s =
+      trace := Some s
+
+    let check_filename () =
+      if Filename.check_suffix !input "mo" then ()
+      else failwith "check_filename: Filename suffix must be 'mo'"
+
+    let set_path s =
+      if !path <> "" then failwith "set_path: More than one path specified";
+      path := Filename.dirname s
+
+    let set_output s =
+      if !output <> "" then failwith "set_output: More than one output specified";
+      output := s
+
+    let set_input s =
+      if !input <> "" then failwith "set_input: More than one input specified";
+      input := s
+
+    let set_max_simplifs i =
+      max_simplifs := i
+
+    let set_no_simplifs () =
+      no_parameter_removal := true;
+      keep_variables := true
+
+    let construct_output_filename () =
+      if !output = "" then begin
+        output := Filename.chop_suffix !input "mo";
+        if !compile_only then
+          output := !output ^ "moc"
+      end;
+      !output
+
+    let parse_args () =
+      Arg.parse
+        [("-L", Arg.String add_lib_path,
+          "<directory>  Add <directory> to the list of directories to be searched \
+          while linking");
+        ("-c", Arg.Set compile_only, "compile only (do not instantiate)");
+        ("-o", Arg.String set_output,
+          "<outputfile>  Set output file name to <outputfile>");
+        ("-hpath", Arg.String set_path,
+          "<path>  Specify a path to be added to #include directives");
+        ("-keep-all-variables", Arg.Set keep_variables,
+          "Don\'t remove alias variables");
+        ("-no-parameter-removal", Arg.Set no_parameter_removal,
+          "Do not remove any parameter");
+        ("-no-simplifs", Arg.Unit set_no_simplifs,
+          "Same as -keep-all-variables -no-parameter-removal");
+        ("-max-simplifs", Arg.Int set_max_simplifs,
+          "<passes> Max number of simplifications");
+        ("-jac", Arg.Set with_jac, "Generate symbolic jacobian matrix");
+        ("-trace", Arg.String trace_filename,
+          "<filename> Generate tracing information for external function calls into \
+          <filename>");
+        ("-xml", Arg.Set gen_xml,
+          "Generate an XML version of the model instead of target code")]
+        set_input
+        ("usage: modelicac [-c] [-o <outputfile>] <inputfile> [other options]")
+
+    let run () =
+      parse_args ();
+      check_filename ();
+      let ic = open_in !input in
+      Printf.printf "Input file name = %s\n" !input; flush stdout;
+      let lexbuf = Lexing.from_channel ic in
+      Printf.printf "Parsing..."; flush stdout;
+      let tree = Parser.parse !input Lexer.token lexbuf in
+      Printf.printf " OK\nPrecompiling..."; flush stdout;
+      let root = Precompilation.precompile tree in
+      Printf.printf " OK\nCompiling..."; flush stdout;
+      Compilation.paths := !directories;
+      let cu = Compilation.compile_main_class root in
+      let filename = construct_output_filename () in
+      if !compile_only then begin
+        Printf.printf " OK\nSaving..."; flush stdout;
+        Compilation.write_class_file filename cu
+      end else begin match cu with
+        | Compilation.CompiledClass lccl ->
+            let fun_name = Filename.chop_extension (Filename.basename filename)
+            and ccl = Lazy.force lccl in
+            Printf.printf " OK\nInstantiating..."; flush stdout;
+            let iexpr =
+              Instantiation.instantiate_main_class
+                Instantiation.ToplevelContext
+                []
+                ccl
+            in
+            let model =
+              if !no_parameter_removal then
+                Optimization.create_model_with_parameters !trace iexpr
+              else Optimization.create_model !trace iexpr in
+            Printf.printf
+              " OK\n%d variable(s) in model.\n"
+              (Array.length model.Optimization.variables);
+            if not !keep_variables then begin
+              Printf.printf "Removing trivial relations..."; flush stdout;
+              max_simplifs :=
+                Optimization.eliminate_trivial_relations !max_simplifs model;
+              Printf.printf
+                " OK\n%d variable(s) remaining."
+                (Array.fold_left
+                  (fun n variable ->
+                    if not variable.Optimization.solved then n + 1 else n)
+                  0
+                  model.Optimization.equations); flush stdout;
+              Printf.printf "\nOptimizing remaining equations..."; flush stdout;
+              Optimization.perform_simplifications !max_simplifs model;
+              Printf.printf
+                " OK\n%d variable(s) remaining."
+                (Array.fold_left
+                  (fun n variable ->
+                    if not variable.Optimization.solved then n + 1 else n)
+                  0
+                  model.Optimization.equations); flush stdout;
+              Printf.printf "\nFinding subsystems...\n"; flush stdout;
+              let compnts = Optimization.find_submodels model in
+              Printf.printf "%d subsystem(s) found.\n" (List.length compnts);
+              flush stdout;
+              List.iter
+                (fun compnt ->
+                  Printf.printf "size = %d\n" (List.length compnt); flush stdout)
+                compnts;
+            end;
+            Printf.printf "Generating code..."; flush stdout;
+            if !gen_xml then XMLCodeGeneration.generate_XML filename fun_name model
+            else G.generate_code !path filename fun_name model !with_jac
+        | Compilation.CompiledFunction _ ->
+            failwith "Attempt to generate code for a function"
+      end;
+      Printf.printf " OK\nOutput file name = %s\n" !output; flush stdout;
+      Printf.printf "Terminated.\n"; flush stdout
+
+  end
diff --git a/scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.mli b/scilab/modules/scicos/src/modelica_compiler/optimizingCompiler.mli
new file mode 100644 (file)
index 0000000..04d5e7f
--- /dev/null
@@ -0,0 +1,53 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module provides the required interface an implementation needs to
+conform to in order to create a new code generator. *)
+
+module type CODEGENERATOR =
+  sig
+    val generate_code: string -> string -> string -> Optimization.model -> bool
+      -> unit
+    (** [generate_code path filename fun_name model jac] generates the code that
+    allows the numeric simulation of [model]. [path] is the path to the external
+    functions referenced in [model]. [filename] is the name of the file where
+    the code is generated. [fun_name] is the name of the entry point in the
+    generated code. [jac] is a flag for which true value indicates that a
+    symbolic jacobian is requested.*)
+  end
+
+module type S =
+  sig
+    val sccs_id: string
+    (** Description of the executable *)
+    val version: string
+    (** The version of the compiler instance. *)
+    val run: unit -> unit
+    (** [run ()] invokes the compiler's unique entry point. *)
+  end
+
+module Make:
+  functor (G: CODEGENERATOR) ->
+    sig
+      val sccs_id: string
+      val version: string
+      val run: unit -> unit
+    end
diff --git a/scilab/modules/scicos/src/modelica_compiler/parseTree.ml b/scilab/modules/scicos/src/modelica_compiler/parseTree.ml
new file mode 100644 (file)
index 0000000..a4e700c
--- /dev/null
@@ -0,0 +1,272 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+
+(* To be extended like:
+type 'a node =
+  {
+    location : location option ;
+    value : 'a
+  }
+
+and type t =
+  | StoredDefinition of within node * definition node list
+...
+and so on. Hence, location information will be added to the parse tree
+to generate accurate error messages. *)
+
+type t =
+  | StoredDefinition of within * definition list
+
+and within =
+  | Within of name option
+  | NotWithin
+
+and definition =
+  | Definition of final * class_definition
+
+and final =
+  | Final
+  | NotFinal
+
+and class_definition =
+  | ClassDefinition of class_kind * ident * encapsulated * partial *
+      class_specifier
+
+and class_kind =
+  | Class
+  | Model
+  | Record
+  | Connector
+  | Type
+  | Package
+  | Function
+
+and encapsulated =
+  | Encapsulated
+  | NotEncapsulated
+
+and partial =
+  | Partial
+  | NotPartial
+
+and class_specifier =
+  | Specifier of string_comment * composition * ident
+  | ShortSpecifier of base_prefix * name * array_subscripts *
+      class_modification option * comment
+  | Enumeration of enumeration_literal list * comment
+
+and base_prefix = type_prefix
+
+and enumeration_literal =
+  | EnumerationLiteral of ident * comment
+
+and composition =
+  | Composition of element list * other_elements list * externalll option
+
+and element =
+  | AnnotationElement of annotation
+  | ImportClause of import_clause
+  | ExtendsClause of extends_clause
+  | ClassDefinitionElement of class_definition * final * dynamic_scope
+  | ComponentClauseElement of component_clause * final * dynamic_scope
+  | ReplaceableClassDefinition of class_definition *
+      (constraining_clause * comment) option * final * dynamic_scope
+  | ReplaceableComponentClause of component_clause *
+      (constraining_clause * comment) option * final * dynamic_scope
+
+and dynamic_scope =
+  | Inner
+  | Outer
+  | NoDynamicScope
+
+and extends_clause = name * class_modification option
+
+and constraining_clause = extends_clause
+
+and other_elements =
+  | Public of element list
+  | Protected of element list
+  | EquationClauseElement of equation_clause
+  | AlgorithmClauseElement of algorithm_clause
+
+and externalll =
+  | External of string option * external_function_call option *
+      annotation option
+
+and external_function_call =
+  | ExternalFunctionCall of component_reference option * ident *
+      expression list
+
+and import_clause =
+  | NewIdentifier of ident * name * comment
+  | Identifier of name * comment
+  | AllIdentifiers of name * comment
+
+and component_clause =
+  | ComponentClause of type_prefix * type_specifier *
+      array_subscripts * component_declaration list
+
+and type_prefix =
+  | TypePrefix of flow option * variability option * inout option
+
+and flow =
+  | Flow
+
+and variability =
+  | Discrete
+  | Parameter
+  | Constant
+
+and inout =
+  | Input
+  | Output
+
+and type_specifier = name
+
+and component_declaration =
+  | ComponentDeclaration of declaration * comment
+
+and declaration = ident * array_subscripts * modification option
+
+and modification =
+  | Modification of class_modification * expression option
+  | Eq of expression
+  | ColEq of expression
+
+and class_modification =
+  | ClassModification of argument list
+
+and argument =
+  | ElementModification of each * final * component_reference *
+      modification * string_comment
+  | ElementRedeclaration of each * final * redeclaration
+
+and each =
+  | Each
+  | NotEach
+
+and redeclaration =
+  | Redeclaration of replaceable * redeclared_element *
+      (constraining_clause * comment) option
+
+and replaceable =
+  | Replaceable
+  | NotReplaceable
+
+and redeclared_element =
+  | RedeclaredClassDefinition of class_definition
+  | RedeclaredComponentClause of type_prefix * type_specifier *
+      component_declaration
+
+and equation_clause =
+  | EquationClause of initial * equation_or_annotation list
+
+and equation_or_annotation =
+  | Equation of equation * comment
+  | EquationAnnotation of annotation
+
+and algorithm_clause =
+  | AlgorithmClause of initial * algorithm_or_annotation list
+
+and algorithm_or_annotation =
+  | Algorithm of algorithm * comment
+  | AlgorithmAnnotation of annotation
+
+and initial =
+  | Initial
+  | NotInitial
+
+and equation =
+  | Equality of (* simple *) expression * expression
+  | ConditionalEquationE of (expression * equation list) list * equation list
+  | ForClauseE of for_indices * equation list
+  | ConnectClause of component_reference * component_reference
+  | WhenClauseE of (expression * equation list) list
+  | FunctionCallE of component_reference * function_arguments option
+
+and algorithm =
+  | Assignment of component_reference * expression
+  | FunctionCallA of component_reference * function_arguments option
+  | MultipleAssignment of expression list * component_reference *
+      function_arguments option
+  | ConditionalEquationA of (expression * algorithm list) list * algorithm list
+  | ForClauseA of for_indices * algorithm list
+  | WhileClause of expression * algorithm list
+  | WhenClauseA of (expression * algorithm list) list
+
+and for_indices = (ident * expression option) list
+
+and expression =
+  | Addition of expression * expression
+  | And of expression * expression
+  | Division of expression * expression
+  | End
+  | Equals of expression * expression
+  | ExpressionList of expression array
+  | False
+  | FunctionCall of component_reference * function_arguments option
+  | GreaterEqualThan of expression * expression
+  | GreaterThan of expression * expression
+  | If of (expression * expression) list * expression
+  | Integer of string
+  | LessEqualThan of expression * expression
+  | LessThan of expression * expression
+  | ArrayConcatenation of expression list list
+  | Minus of expression
+  | Multiplication of expression * expression
+  | Not of expression
+  | NotEquals of expression * expression
+  | Or of expression * expression
+  | Plus of expression
+  | Power of expression * expression
+  | Range of expression * expression * expression option
+  | Real of string
+  | Reference of component_reference
+  | String of string
+  | Subtraction of expression * expression
+  | True
+  | VectorOrRecord of function_arguments
+
+and ident = string
+
+and name = ident list
+
+and component_reference = (ident * array_subscripts) list
+
+and function_arguments =
+  | ArgList of expression list * for_indices option
+  | NamedArgList of (ident * expression) list * for_indices option
+
+and array_subscripts = array_subscript array
+
+and array_subscript =
+  | All
+  | Subscript of expression
+
+and comment =
+  | Comment of string_comment * annotation option
+
+and string_comment =
+  | StringComment of string list
+
+and annotation =
+  | Annotation of class_modification
diff --git a/scilab/modules/scicos/src/modelica_compiler/parseTree.mli b/scilab/modules/scicos/src/modelica_compiler/parseTree.mli
new file mode 100644 (file)
index 0000000..0cb1328
--- /dev/null
@@ -0,0 +1,176 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module defines the data structures necessary to hold parse trees built
+by the parser (see Parser module) *)
+
+type t = StoredDefinition of within * definition list
+and within = Within of name option | NotWithin
+and definition = Definition of final * class_definition
+and final = Final | NotFinal
+and class_definition =
+    ClassDefinition of class_kind * ident * encapsulated * partial *
+      class_specifier
+and class_kind =
+    Class
+  | Model
+  | Record
+  | Connector
+  | Type
+  | Package
+  | Function
+and encapsulated = Encapsulated | NotEncapsulated
+and partial = Partial | NotPartial
+and class_specifier =
+    Specifier of string_comment * composition * ident
+  | ShortSpecifier of base_prefix * name * array_subscripts *
+      class_modification option * comment
+  | Enumeration of enumeration_literal list * comment
+and base_prefix = type_prefix
+and enumeration_literal = EnumerationLiteral of ident * comment
+and composition =
+    Composition of element list * other_elements list * externalll option
+and element =
+    AnnotationElement of annotation
+  | ImportClause of import_clause
+  | ExtendsClause of extends_clause
+  | ClassDefinitionElement of class_definition * final * dynamic_scope
+  | ComponentClauseElement of component_clause * final * dynamic_scope
+  | ReplaceableClassDefinition of class_definition *
+      (constraining_clause * comment) option * final * dynamic_scope
+  | ReplaceableComponentClause of component_clause *
+      (constraining_clause * comment) option * final * dynamic_scope
+and dynamic_scope = Inner | Outer | NoDynamicScope
+and extends_clause = name * class_modification option
+and constraining_clause = extends_clause
+and other_elements =
+    Public of element list
+  | Protected of element list
+  | EquationClauseElement of equation_clause
+  | AlgorithmClauseElement of algorithm_clause
+and externalll =
+    External of string option * external_function_call option *
+      annotation option
+and external_function_call =
+    ExternalFunctionCall of component_reference option * ident *
+      expression list
+and import_clause =
+    NewIdentifier of ident * name * comment
+  | Identifier of name * comment
+  | AllIdentifiers of name * comment
+and component_clause =
+    ComponentClause of type_prefix * type_specifier * array_subscripts *
+      component_declaration list
+and type_prefix =
+    TypePrefix of flow option * variability option * inout option
+and flow = Flow
+and variability = Discrete | Parameter | Constant
+and inout = Input | Output
+and type_specifier = name
+and component_declaration = ComponentDeclaration of declaration * comment
+and declaration = ident * array_subscripts * modification option
+and modification =
+    Modification of class_modification * expression option
+  | Eq of expression
+  | ColEq of expression
+and class_modification = ClassModification of argument list
+and argument =
+    ElementModification of each * final * component_reference *
+      modification * string_comment
+  | ElementRedeclaration of each * final * redeclaration
+and each = Each | NotEach
+and redeclaration =
+    Redeclaration of replaceable * redeclared_element *
+      (constraining_clause * comment) option
+and replaceable = Replaceable | NotReplaceable
+and redeclared_element =
+    RedeclaredClassDefinition of class_definition
+  | RedeclaredComponentClause of type_prefix * type_specifier *
+      component_declaration
+and equation_clause = EquationClause of initial * equation_or_annotation list
+and equation_or_annotation =
+    Equation of equation * comment
+  | EquationAnnotation of annotation
+and algorithm_clause =
+    AlgorithmClause of initial * algorithm_or_annotation list
+and algorithm_or_annotation =
+    Algorithm of algorithm * comment
+  | AlgorithmAnnotation of annotation
+and initial = Initial | NotInitial
+and equation =
+    Equality of expression * expression
+  | ConditionalEquationE of (expression * equation list) list * equation list
+  | ForClauseE of for_indices * equation list
+  | ConnectClause of component_reference * component_reference
+  | WhenClauseE of (expression * equation list) list
+  | FunctionCallE of component_reference * function_arguments option
+and algorithm =
+    Assignment of component_reference * expression
+  | FunctionCallA of component_reference * function_arguments option
+  | MultipleAssignment of expression list * component_reference *
+      function_arguments option
+  | ConditionalEquationA of (expression * algorithm list) list *
+      algorithm list
+  | ForClauseA of for_indices * algorithm list
+  | WhileClause of expression * algorithm list
+  | WhenClauseA of (expression * algorithm list) list
+and for_indices = (ident * expression option) list
+and expression =
+    Addition of expression * expression
+  | And of expression * expression
+  | Division of expression * expression
+  | End
+  | Equals of expression * expression
+  | ExpressionList of expression array
+  | False
+  | FunctionCall of component_reference * function_arguments option
+  | GreaterEqualThan of expression * expression
+  | GreaterThan of expression * expression
+  | If of (expression * expression) list * expression
+  | Integer of string
+  | LessEqualThan of expression * expression
+  | LessThan of expression * expression
+  | ArrayConcatenation of expression list list
+  | Minus of expression
+  | Multiplication of expression * expression
+  | Not of expression
+  | NotEquals of expression * expression
+  | Or of expression * expression
+  | Plus of expression
+  | Power of expression * expression
+  | Range of expression * expression * expression option
+  | Real of string
+  | Reference of component_reference
+  | String of string
+  | Subtraction of expression * expression
+  | True
+  | VectorOrRecord of function_arguments
+and ident = string
+and name = ident list
+and component_reference = (ident * array_subscripts) list
+and function_arguments =
+    ArgList of expression list * for_indices option
+  | NamedArgList of (ident * expression) list * for_indices option
+and array_subscripts = array_subscript array
+and array_subscript = All | Subscript of expression
+and comment = Comment of string_comment * annotation option
+and string_comment = StringComment of string list
+and annotation = Annotation of class_modification
diff --git a/scilab/modules/scicos/src/modelica_compiler/parser.mly b/scilab/modules/scicos/src/modelica_compiler/parser.mly
new file mode 100644 (file)
index 0000000..e2d1866
--- /dev/null
@@ -0,0 +1,669 @@
+/*  Scicos
+*
+*  Copyright (C) INRIA - S. FURIC
+*
+* This program is free software; you can redistribute it and/or modify
+* it under the terms of the GNU General Public License as published by
+* the Free Software Foundation; either version 2 of the License, or
+* (at your option) any later version.
+*
+* This program is distributed in the hope that it will be useful,
+* but WITHOUT ANY WARRANTY; without even the implied warranty of
+* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+* GNU General Public License for more details.
+*
+* You should have received a copy of the GNU General Public License
+* along with this program; if not, write to the Free Software
+* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*
+* See the file ./license.txt
+*/
+
+/*
+ * Parser
+ * Grammar for the Modelica language v.2.0
+ * V 1.0
+ * S. FURIC
+ */
+
+%{
+
+open ParseTree
+
+%}
+
+/*names*/
+%token <string> IDENT
+
+/*literals*/
+%token <string> UNSIGNED_INTEGER UNSIGNED_NUMBER STRING
+
+/*keywords*/
+%token ALGORITHM AND ANNOTATION ASSERT BLOCK CLASS CONNECT CONNECTOR CONSTANT
+%token DISCRETE EACH ELSE ELSEIF ELSEWHEN ENCAPSULATED END ENUMERATION EQUATION
+%token EXTENDS EXTERNAL FALSE FINAL FLOW FOR FUNCTION IF IMPORT IN INITIAL
+%token INNER INPUT LOOP MODEL NOT OR OUTER OUTPUT PACKAGE PARAMETER PARTIAL
+%token PROTECTED PUBLIC RECORD REDECLARE REPLACEABLE TERMINATE THEN TRUE TYPE
+%token WHEN WHILE WITHIN
+
+/*symbols*/
+%token LP RP LSB RSB LCB RCB  /*  ( ) [ ] { }  */
+%token DOT CM SC CL /*  . , ; :  */
+%token PLUS MINUS STAR SLASH EXP /*  + - * / ^  */
+%token EQ COLEQ /*  = :=  */
+%token LT GT LE GE EE NE /*  < > <= >= == <>  */
+
+/*end of file*/
+%token EOF
+
+%type <ParseTree.t> stored_definition_eof
+%start stored_definition_eof
+
+%%
+
+/*(0.0)*/
+stored_definition_eof
+    : stored_definition EOF                                     { $1 }
+    ;
+
+/*(2.2.1)*/
+stored_definition
+    : class_definitions                                         { StoredDefinition (NotWithin, List.rev $1) }
+    | WITHIN SC class_definitions                               { StoredDefinition (Within None, List.rev $3) }
+    | WITHIN name SC class_definitions                          { StoredDefinition (Within (Some $2), List.rev $4) }
+    ;
+
+class_definitions
+    :                                                           { [] }
+    | class_definitions class_definition SC                     { Definition (NotFinal, $2) :: $1 }
+    | class_definitions FINAL class_definition SC               { Definition (Final, $3) :: $1 }
+    ;
+
+/*(2.2.2)*/
+class_definition
+    : encapsulated_option partial_option CLASS
+      IDENT class_specifier                                     { ClassDefinition (Class, $4, $1, $2, $5) }
+    | encapsulated_option partial_option MODEL
+      IDENT class_specifier                                     { ClassDefinition (Model, $4, $1, $2, $5) }
+    | encapsulated_option partial_option RECORD
+      IDENT class_specifier                                     { ClassDefinition (Record, $4, $1, $2, $5) }
+    | encapsulated_option partial_option CONNECTOR
+      IDENT class_specifier                                     { ClassDefinition (Connector, $4, $1, $2, $5) }
+    | encapsulated_option partial_option TYPE
+      IDENT class_specifier                                     { ClassDefinition (Type, $4, $1, $2, $5) }
+    | encapsulated_option partial_option PACKAGE
+      IDENT class_specifier                                     { ClassDefinition (Package, $4, $1, $2, $5) }
+    | encapsulated_option partial_option FUNCTION
+      IDENT class_specifier                                     { ClassDefinition (Function, $4, $1, $2, $5) }
+    ;
+
+encapsulated_option
+    :                                                           { NotEncapsulated }
+    | ENCAPSULATED                                              { Encapsulated }
+    ;
+
+partial_option
+    :                                                           { NotPartial }
+    | PARTIAL                                                   { Partial }
+    ;
+
+class_specifier
+    : string_comment composition END IDENT                      { Specifier ($1, $2, $4) }
+    | EQ base_prefix name array_subscripts_option class_modification_option
+      comment                                                   { ShortSpecifier ($2, $3, $4, $5, $6) }
+    | EQ ENUMERATION LP enum_list_option RP comment             { Enumeration ($4, $6) }
+    ;
+
+base_prefix
+    : type_prefix                                               { $1 }
+    ;
+
+enum_list_option
+    :                                                           { [] }
+    | enum_list                                                 { List.rev $1 }
+    ;
+
+enum_list
+    : enumeration_literal                                       { [$1] }
+    | enum_list SC enumeration_literal                          { $3 :: $1 }
+    ;
+
+enumeration_literal
+    : IDENT comment                                             { EnumerationLiteral ($1, $2) }
+    ;
+
+composition
+    : element_list other_lists external_option                  { Composition ($1, List.rev $2, $3) }
+    ;
+
+other_lists
+    :                                                           { [] }
+    | other_lists PUBLIC element_list                           { Public $3 :: $1 }
+    | other_lists PROTECTED element_list                        { Protected $3 :: $1 }
+    | other_lists equation_clause                               { EquationClauseElement $2 :: $1 }
+    | other_lists algorithm_clause                              { AlgorithmClauseElement $2 :: $1 }
+    ;
+
+external_option
+    :                                                           { None }
+    | EXTERNAL language_specification_option
+               external_function_call_option SC annotation_option
+                                                                { Some (External ($2, $3, $5)) }
+    ;
+
+annotation_option
+    :                                                           { None }
+    | annotation SC                                             { Some $1 }
+    ;
+
+language_specification_option
+    :                                                           { None }
+    | STRING                                                    { Some $1 }
+    ;
+
+external_function_call_option
+    :                                                           { None }
+    | IDENT LP expressions RP                                   { Some (ExternalFunctionCall (None, $1, $3)) }
+    | component_reference EQ IDENT LP expressions RP            { Some (ExternalFunctionCall (Some $1, $3, $5)) }
+    ;
+
+
+expressions
+    :                                                           { [] }
+    | expression CM expressions                                 { $1 :: $3 }
+    ;
+
+array_subscripts_option
+    :                                                           { [||] }
+    | array_subscripts                                          { Array.of_list $1 }
+    ;
+
+class_modification_option
+    :                                                           { None }
+    | class_modification                                        { Some $1 }
+    ;
+
+element_list
+    :                                                           { [] }
+    | element_list IMPORT import_clause SC                      { ImportClause $3 :: $1 }
+    | element_list EXTENDS extends_clause SC                    { ExtendsClause $3 :: $1 }
+    | element_list final_option dynamic_scope_option
+        class_definition SC                                     { ClassDefinitionElement ($4, $2, $3) :: $1 }
+    | element_list final_option dynamic_scope_option
+        component_clause SC                                     { ComponentClauseElement ($4, $2, $3) :: $1 }
+    | element_list final_option dynamic_scope_option
+        REPLACEABLE class_definition
+        constraining_clause_option SC                           { ReplaceableClassDefinition ($5, $6, $2, $3) :: $1 }
+    | element_list final_option dynamic_scope_option
+        REPLACEABLE component_clause
+        constraining_clause_option SC                           { ReplaceableComponentClause ($5, $6, $2, $3) :: $1 }
+    | element_list annotation SC                                { AnnotationElement $2 :: $1 }
+    ;
+
+final_option
+    :                                                           { NotFinal }
+    | FINAL                                                     { Final }
+    ;
+
+dynamic_scope_option
+    :                                                           { NoDynamicScope }
+    | INNER                                                     { Inner }
+    | OUTER                                                     { Outer }
+    ;
+
+import_clause
+    : IDENT EQ name comment                                     { NewIdentifier ($1, $3, $4) }
+    | name comment                                              { Identifier ($1, $2) }
+    | name DOT STAR comment                                     { AllIdentifiers ($1, $4) }
+    ;
+
+constraining_clause_option
+    :                                                           { None }
+    | constraining_clause comment                               { Some ($1, $2) }
+    ;
+
+/*(2.2.3)*/
+extends_clause
+    : name class_modification_option                            { ($1, $2) }
+    ;
+
+constraining_clause
+    : extends_clause                                            { $1 }
+    ;
+
+/*(2.2.4)*/
+component_clause
+    : type_prefix type_specifier array_subscripts_option
+        component_list                                          { ComponentClause ($1, $2, $3, List.rev $4) }
+    ;
+
+type_prefix
+    : flow_option variability_option inout_option               { TypePrefix ($1, $2, $3) }
+    ;
+
+flow_option
+    :                                                           { None }
+    | FLOW                                                      { Some Flow }
+    ;
+
+variability_option
+    :                                                           { None }
+    | DISCRETE                                                  { Some Discrete }
+    | PARAMETER                                                 { Some Parameter }
+    | CONSTANT                                                  { Some Constant }
+    ;
+
+inout_option
+    :                                                           { None }
+    | INPUT                                                     { Some Input }
+    | OUTPUT                                                    { Some Output }
+    ;
+
+type_specifier
+    : name                                                      { $1 }
+    ;
+
+component_list
+    : component_declaration                                     { [$1] }
+    | component_list CM component_declaration                   { $3 :: $1 }
+    ;
+
+component_declaration
+    : declaration comment                                       { ComponentDeclaration ($1, $2) }
+    ;
+
+declaration
+    : IDENT array_subscripts_option modification_option         { ($1, $2, $3) }
+    ;
+
+modification_option
+    :                                                           { None }
+    | modification                                              { Some $1 }
+    ;
+
+/*(2.2.5)*/
+modification
+    : class_modification EQ expression                          { Modification ($1, Some $3) }
+    | class_modification                                        { Modification ($1, None) }
+    | EQ expression                                             { Eq $2 }
+    | COLEQ expression                                          { ColEq $2 }
+    ;
+
+class_modification
+    : LP argument_list RP                                       { ClassModification (List.rev $2) }
+    ;
+
+argument_list
+    : argument                                                  { [$1] }
+    | argument CM argument_list                                 { $1 :: $3 }
+    ;
+
+argument
+    : element_modification                                      { $1 }
+    | element_redeclaration                                     { $1 }
+    ;
+
+element_modification
+    : component_reference modification string_comment           { ElementModification (NotEach, NotFinal,$1, $2, $3) }
+    | EACH component_reference modification string_comment      { ElementModification (Each, NotFinal,$2, $3, $4) }
+    | FINAL component_reference modification string_comment     { ElementModification (NotEach, Final,$2, $3, $4) }
+    | EACH FINAL
+      component_reference modification string_comment           { ElementModification (Each, Final,$3, $4, $5) }
+    ;
+
+element_redeclaration
+    : REDECLARE  class_definition_or_component_clause1          { ElementRedeclaration (NotEach, NotFinal, $2) }
+    | REDECLARE EACH class_definition_or_component_clause1      { ElementRedeclaration (Each, NotFinal, $3) }
+    | REDECLARE FINAL class_definition_or_component_clause1     { ElementRedeclaration (NotEach, Final, $3) }
+    | REDECLARE EACH FINAL
+      class_definition_or_component_clause1                     { ElementRedeclaration (Each, Final, $4) }
+    ;
+
+class_definition_or_component_clause1
+    : class_definition                                          { Redeclaration (NotReplaceable, RedeclaredClassDefinition $1, None) }
+    | type_prefix type_specifier component_declaration          { Redeclaration (NotReplaceable, RedeclaredComponentClause ($1, $2, $3), None) }
+    | REPLACEABLE class_definition constraining_clause_option   { Redeclaration (Replaceable, RedeclaredClassDefinition $2, $3) }
+    | REPLACEABLE type_prefix type_specifier
+      component_declaration constraining_clause_option          { Redeclaration (Replaceable, RedeclaredComponentClause ($2, $3, $4), $5) }
+    ;
+
+/*(2.2.6)*/
+equation_clause
+    : INITIAL EQUATION equations                                { EquationClause (Initial, List.rev $3) }
+    | EQUATION equations                                        { EquationClause (NotInitial, List.rev $2) }
+    ;
+
+equations
+    :                                                           { [] }
+    | equations equation comment SC                             { Equation ($2, $3) :: $1 }
+    | equations annotation SC                                   { EquationAnnotation $2 :: $1 }
+    ;
+
+algorithm_clause
+    : INITIAL ALGORITHM algorithms                              { AlgorithmClause (Initial, List.rev $3) }
+    | ALGORITHM algorithms                                      { AlgorithmClause (NotInitial, List.rev $2) }
+    ;
+
+algorithms
+    :                                                           { [] }
+    | algorithms algorithm comment SC                           { Algorithm ($2, $3) :: $1 }
+    | algorithms annotation SC                                  { AlgorithmAnnotation $2 :: $1 }
+    ;
+
+equation
+    : simple_expression EQ expression                           { Equality ($1, $3) }
+    | conditional_equation_e                                    { $1 }
+    | for_clause_e                                              { $1 }
+    | connect_clause                                            { $1 }
+    | when_clause_e                                             { $1 }
+    | component_reference LP RP                                 { FunctionCallE ($1, None) }
+    | component_reference LP function_arguments RP              { FunctionCallE ($1, Some $3) }
+    ;
+
+algorithm
+    : component_reference COLEQ expression                      { Assignment ($1, $3) }
+    | component_reference LP RP                                 { FunctionCallA ($1, None) }
+    | component_reference LP function_arguments RP              { FunctionCallA ($1, Some $3) }
+    | LP expression_list RP COLEQ
+      component_reference LP RP                                 { MultipleAssignment ($2, $5, None) }
+    | LP expression_list RP COLEQ
+      component_reference LP function_arguments RP              { MultipleAssignment ($2, $5, Some $7) }
+    | conditional_equation_a                                    { $1 }
+    | for_clause_a                                              { $1 }
+    | while_clause                                              { $1 }
+    | when_clause_a                                             { $1 }
+    ;
+
+conditional_equation_e
+    : IF expression THEN
+        equations_e
+      else_if_expressions_e
+      else_option_e
+      END IF                                                    { ConditionalEquationE (($2, (List.rev $4)) :: $5, $6) }
+    ;
+
+else_if_expressions_e
+    :                                                           { [] }
+    | ELSEIF expression THEN
+        equations_e
+      else_if_expressions_e                                     { ($2, (List.rev $4)) :: $5 }
+    ;
+
+else_option_e
+    :                                                           { [] }
+    | ELSE equations_e                                          { List.rev $2 }
+    ;
+
+equations_e
+    : equation SC                                               { [$1] }
+    | equations_e equation SC                                   { $2 :: $1 }
+    ;
+
+conditional_equation_a
+    : IF expression THEN
+        algorithms_a
+      else_if_expressions_a
+      else_option_a
+      END IF                                                    { ConditionalEquationA (($2, (List.rev $4)) :: $5, $6) }
+    ;
+
+else_if_expressions_a
+    :                                                           { [] }
+    | ELSEIF expression THEN
+        algorithms_a
+      else_if_expressions_a                                     { ($2, (List.rev $4)) :: $5 }
+    ;
+
+else_option_a
+    :                                                           { [] }
+    | ELSE algorithms_a                                         { List.rev $2 }
+    ;
+
+algorithms_a
+    : algorithm SC                                              { [$1] }
+    | algorithms_a algorithm SC                                 { $2 :: $1 }
+    ;
+
+for_clause_e
+    : FOR for_indices LOOP
+        equations_e
+      END FOR                                                   { ForClauseE ($2, List.rev $4) }
+    ;
+
+for_clause_a
+    : FOR for_indices LOOP
+        algorithms_a
+      END FOR                                                   { ForClauseA ($2, List.rev $4) }
+    ;
+
+for_indices
+    : for_index                                                 { [$1] }
+    | for_index CM for_indices                                  { $1 :: $3 }
+    ;
+
+for_index
+    : IDENT in_expression_option                                { ($1, $2) }
+    ;
+
+in_expression_option
+    :                                                           { None }
+    | IN expression                                             { Some $2 }
+    ;
+
+while_clause
+    : WHILE expression LOOP
+        algorithms_a
+      END WHILE                                                 { WhileClause ($2, List.rev $4) }
+    ;
+
+when_clause_e
+    : WHEN expression THEN
+        equations_e
+      else_when_expressions_e
+      END WHEN                                                  { WhenClauseE (($2, $4) :: $5) }
+    ;
+
+when_clause_a
+    : WHEN expression THEN
+        algorithms_a
+      else_when_expressions_a
+      END WHEN                                                  { WhenClauseA (($2, $4) :: $5) }
+    ;
+
+else_when_expressions_e
+    :                                                           { [] }
+    | ELSEWHEN expression THEN
+        equations_e
+      else_when_expressions_e                                   { ($2, $4) :: $5 }
+    ;
+
+else_when_expressions_a
+    :                                                           { [] }
+    | ELSEWHEN expression THEN
+        algorithms_a
+      else_when_expressions_a                                   { ($2, $4) :: $5 }
+    ;
+
+connect_clause
+    : CONNECT LP connector_ref CM connector_ref RP              { ConnectClause ($3, $5) }
+    ;
+
+connector_ref
+    : IDENT array_subscripts_option                             { [($1, $2)] }
+    | IDENT array_subscripts_option
+        DOT IDENT array_subscripts_option                       { [($1, $2); ($4, $5)] }
+    ;
+
+/*(2.2.7)*/
+expression
+    : simple_expression                                         { $1 }
+    | IF expression THEN expression
+      elseifs_option
+      ELSE expression                                           { If (($2, $4) :: $5, $7) }
+    ;
+
+elseifs_option
+    :                                                           { [] }
+    | ELSEIF expression THEN expression
+      elseifs_option                                            { ($2, $4) :: $5 }
+    ;
+
+simple_expression
+    : logical_expression                                        { $1 }
+    | logical_expression CL logical_expression                  { Range ($1, $3, None) }
+    | logical_expression
+        CL logical_expression CL logical_expression             { Range ($1, $3, Some $5) }
+    ;
+
+logical_expression
+    : logical_term                                              { $1 }
+    | logical_expression OR logical_term                        { Or ($1, $3) }
+    ;
+
+logical_term
+    : logical_factor                                            { $1 }
+    | logical_term AND logical_factor                           { And ($1, $3) }
+    ;
+
+logical_factor
+    : relation                                                  { $1 }
+    | NOT relation                                              { Not $2 }
+    ;
+
+relation
+    : arithmetic_expression                                     { $1 }
+    | arithmetic_expression LT arithmetic_expression            { LessThan ($1, $3) }
+    | arithmetic_expression GT arithmetic_expression            { GreaterThan ($1, $3) }
+    | arithmetic_expression LE arithmetic_expression            { LessEqualThan ($1, $3) }
+    | arithmetic_expression GE arithmetic_expression            { GreaterEqualThan ($1, $3) }
+    | arithmetic_expression EE arithmetic_expression            { Equals ($1, $3) }
+    | arithmetic_expression NE arithmetic_expression            { NotEquals ($1, $3) }
+    ;
+
+arithmetic_expression
+    : signed_term                                               { $1 }
+    | arithmetic_expression PLUS term                           { Addition ($1, $3) }
+    | arithmetic_expression MINUS term                          { Subtraction ($1, $3) }
+    ;
+
+signed_term
+    : term                                                      { $1 }
+    | PLUS term                                                 { Plus $2 }
+    | MINUS term                                                { Minus $2 }
+    ;
+
+term
+    : factor                                                    { $1 }
+    | term STAR factor                                          { Multiplication ($1, $3) }
+    | term SLASH factor                                         { Division ($1, $3) }
+    ;
+
+factor
+    : primary                                                   { $1 }
+    | primary EXP primary                                       { Power ($1, $3) }
+    ;
+
+primary
+    : UNSIGNED_INTEGER                                          { Integer $1 }
+    | UNSIGNED_NUMBER                                           { Real $1 }
+    | STRING                                                    { String $1 }
+    | FALSE                                                     { False }
+    | TRUE                                                      { True }
+    | component_reference                                       { Reference $1 }
+    | component_reference LP RP                                 { FunctionCall ($1, None) }
+    | component_reference LP function_arguments RP              { FunctionCall ($1, Some $3) }
+    | LP expression_list RP                                     { ExpressionList (Array.of_list $2) }
+    | LSB expression_lists RSB                                  { ArrayConcatenation $2 }
+    | LCB function_arguments RCB                                { VectorOrRecord $2 }
+    ;
+
+expression_lists
+    : expression_list                                           { [$1] }
+    | expression_list SC expression_lists                       { $1 :: $3 }
+    ;
+
+name
+    : IDENT                                                     { [$1] }
+    | name DOT IDENT                                            { $1 @ [$3] }
+    ;
+
+component_reference
+    : IDENT array_subscripts_option                             { [$1, $2] }
+    | IDENT array_subscripts_option DOT component_reference     { ($1, $2) :: $4 }
+    ;
+
+function_arguments
+    : expression FOR for_indices                                { ArgList ([$1], Some $3) }
+    | expression CM expression_list FOR for_indices             { ArgList ($1 :: $3, Some $5) }
+    | expression                                                { ArgList ([$1], None) }
+    | expression CM expression_list                             { ArgList ($1 :: $3, None) }
+    | named_arguments FOR for_indices                           { NamedArgList ($1, Some $3) }
+    | named_arguments                                           { NamedArgList ($1, None) }
+    ;
+
+named_arguments
+    : named_argument                                            { [$1] }
+    | named_argument CM named_arguments                         { $1 :: $3 }
+    ;
+
+named_argument
+    : IDENT EQ expression                                       { ($1, $3) }
+    ;
+
+expression_list
+    : expression                                                { [$1] }
+    | expression CM expression_list                             { $1 :: $3 }
+    ;
+
+array_subscripts
+    : LSB subscripts RSB                                        { $2 }
+    ;
+
+subscripts
+    : subscript                                                 { [$1] }
+    | subscript CM subscripts                                   { $1 :: $3 }
+    ;
+
+subscript
+    : CL                                                        { All }
+    | expression                                                { Subscript $1 }
+    ;
+
+comment
+    : string_comment                                            { Comment ($1, None) }
+    | string_comment annotation                                 { Comment ($1, Some $2) }
+    ;
+
+string_comment
+    :                                                           { StringComment [] }
+    | strings                                                   { StringComment (List.rev $1) }
+    ;
+
+strings
+    : STRING                                                    { [$1] }
+    | strings PLUS STRING                                       { $3 :: $1 }
+    ;
+
+annotation
+    : ANNOTATION class_modification                             { Annotation $2 }
+    ;
+
+%%
+
+let parse filename token_fun lexbuf =
+  try stored_definition_eof token_fun lexbuf with
+    | Parsing.Parse_error ->
+        let linenum, linebeg =
+          Linenum.for_position filename (Lexing.lexeme_start lexbuf)
+        and linenum', linebeg' =
+          Linenum.for_position filename (Lexing.lexeme_end lexbuf)
+        in
+        let first_char = Lexing.lexeme_start lexbuf - linebeg
+        and first_char' = Lexing.lexeme_end lexbuf - linebeg'
+        in
+        Printf.eprintf
+          "Syntax error at line %d, characters %d to %d\n"
+          linenum
+          first_char 
+          ((Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf) + first_char);
+        raise Parsing.Parse_error
diff --git a/scilab/modules/scicos/src/modelica_compiler/precompilation.ml b/scilab/modules/scicos/src/modelica_compiler/precompilation.ml
new file mode 100644 (file)
index 0000000..513852c
--- /dev/null
@@ -0,0 +1,217 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+
+(* Precompilation *)
+
+type precompiled_class =
+  {
+    class_kind: ParseTree.class_kind;
+    mutable extensions: extension list;
+    mutable public_classes: (string * precompiled_class) list;
+    mutable protected_classes: (string * precompiled_class) list;
+    mutable public_cpnts: (string * precompiled_component) list;
+    mutable protected_cpnts: (string * precompiled_component) list;
+    mutable equs: ParseTree.equation_clause list;
+    mutable algs: ParseTree.algorithm_clause list;
+    mutable class_comment: ParseTree.string_comment
+  }
+
+and extension = string list * modification list
+
+and modification =
+  | Modification of (string * ParseTree.array_subscripts) list *
+    modification list * ParseTree.expression option
+
+and precompiled_component =
+  {
+    class_name: string list;
+    subscripts: ParseTree.array_subscripts;
+    flow: ParseTree.flow option;
+    variability: ParseTree.variability option;
+    inout: ParseTree.inout option;
+    modification: modification list * ParseTree.expression option;
+    comment: ParseTree.comment
+  }
+
+let create_precompiled_class kind parent_opt =
+  let empty_comment = ParseTree.StringComment [] in
+  {
+    class_kind = kind;
+    extensions = [];
+    public_classes = [];
+    protected_classes = [];
+    public_cpnts = [];
+    protected_cpnts = [];
+    equs = [];
+    algs = [];
+    class_comment = empty_comment
+  }
+
+let rec precompile = function
+  | ParseTree.StoredDefinition (ParseTree.NotWithin, defs) ->
+      let root = create_precompiled_class ParseTree.Package None in
+      root.public_classes <- precompile_class_definitions root defs;
+      root
+  | ParseTree.StoredDefinition (ParseTree.Within _, _) ->
+      failwith "within not allowed"
+
+and precompile_class_definitions parent defs =
+  List.fold_left (precompile_class_definition parent) [] defs
+
+and precompile_class_definition parent map = function
+  | ParseTree.Definition (ParseTree.NotFinal, class_def) ->
+      precompile_not_final_class_definition parent map class_def
+  | ParseTree.Definition (ParseTree.Final, _) ->
+      failwith "final class definitions not allowed"
+
+and precompile_not_final_class_definition parent map = function
+  | ParseTree.ClassDefinition (ParseTree.Class, id,
+    ParseTree.NotEncapsulated, ParseTree.NotPartial, class_spec) ->
+      let cl = create_precompiled_class ParseTree.Class (Some parent) in
+      precompile_class_specifier_into cl id class_spec;
+      (id, cl) :: map
+  | ParseTree.ClassDefinition (ParseTree.Function, id,
+    ParseTree.NotEncapsulated, ParseTree.NotPartial, class_spec) ->
+      let cl = create_precompiled_class ParseTree.Function (Some parent) in
+      precompile_class_specifier_into cl id class_spec;
+      (id, cl) :: map
+  | _ -> failwith "precompile_class_definition: Unsupported class definition"
+
+and precompile_class_specifier_into cl id = function
+  | ParseTree.Specifier (cmt, compo, id') when id = id' ->
+      cl.class_comment <- cmt;
+      precompile_composition_into cl compo
+  | ParseTree.Specifier _ -> failwith "Wrong class definition"
+  | ParseTree.ShortSpecifier _ ->
+      failwith "Short class definitions not allowed"
+  | ParseTree.Enumeration _ -> failwith "Enumeration definitions not allowed"
+
+and precompile_composition_into cl = function
+  | ParseTree.Composition (elts, other_elts_list, None) ->
+      precompile_public_elements_into cl elts;
+      precompile_other_elements_into cl other_elts_list
+  | ParseTree.Composition (elts, other_elts_list,
+    Some (ParseTree.External (None, None, None))) ->
+      precompile_public_elements_into cl elts;
+      precompile_other_elements_into cl other_elts_list
+  | ParseTree.Composition (_, _, Some _) ->
+      failwith "precompile_composition_into: invalid external function call"
+
+and precompile_public_elements_into cl elts =
+  List.iter (precompile_public_element_into cl) elts
+
+and precompile_public_element_into cl = function
+  | ParseTree.AnnotationElement _ -> failwith "Annotations not allowed"
+  | ParseTree.ImportClause _ -> failwith "Import statements not allowed"
+  | ParseTree.ExtendsClause (name, None) ->
+      cl.extensions <- (name, []) :: cl.extensions
+  | ParseTree.ExtendsClause (name, Some class_modif) ->
+      let modifs = precompile_class_modification class_modif in
+      cl.extensions <- (name, modifs) :: cl.extensions
+  | ParseTree.ClassDefinitionElement (class_def, ParseTree.NotFinal,
+    ParseTree.NoDynamicScope) ->
+      let map =
+        precompile_not_final_class_definition cl cl.public_classes class_def
+      in
+      cl.public_classes <- map
+  | ParseTree.ClassDefinitionElement (_, ParseTree.Final, _) ->
+      failwith "Final class definitions not allowed"
+  | ParseTree.ClassDefinitionElement (_, _,
+    (ParseTree.Inner | ParseTree.Outer)) ->
+      failwith "Dynamic scope not allowed"
+  | ParseTree.ComponentClauseElement (cpnt_clause, ParseTree.NotFinal,
+    ParseTree.NoDynamicScope) ->
+      precompile_public_component_clause_into cl cpnt_clause
+  | ParseTree.ComponentClauseElement (_, ParseTree.Final, _) ->
+      failwith "Final component definitions not allowed"
+  | ParseTree.ComponentClauseElement (_, _,
+    (ParseTree.Inner | ParseTree.Outer)) ->
+      failwith "Dynamic scope not allowed"
+  | ParseTree.ReplaceableClassDefinition _ ->
+      failwith "Replaceable classes not allowed"
+  | ParseTree.ReplaceableComponentClause _ ->
+      failwith "Replaceable components not allowed"
+
+and precompile_other_elements_into cl elts =
+  List.iter (precompile_other_element_into cl) elts
+
+and precompile_other_element_into cl = function
+  | ParseTree.Public elt_list ->
+      precompile_public_elements_into cl elt_list
+  | ParseTree.Protected element_list ->
+      failwith "Protected elements not allowed"
+  | ParseTree.EquationClauseElement equ_clause ->
+      cl.equs <- equ_clause :: cl.equs
+  | ParseTree.AlgorithmClauseElement alg_clause ->
+      cl.algs <- alg_clause :: cl.algs
+
+and precompile_public_component_clause_into cl = function
+  | ParseTree.ComponentClause (type_prefix, type_spec,
+    array_subscrs, cpnt_decl_list) ->
+      let flow, var_opt, inout_opt = precompile_type_prefix type_prefix in
+      let precompile_component_declaration = function
+        | ParseTree.ComponentDeclaration ((id, subscrs, modif_opt), comment) ->
+            let subscripts =
+              Array.append subscrs array_subscrs
+            in
+            id,
+            {
+              class_name = type_spec;
+              subscripts = subscripts;
+              flow = flow;
+              variability = var_opt;
+              inout = inout_opt;
+              modification = precompile_modification modif_opt;
+              comment = comment
+            }
+      in
+      cl.public_cpnts <-
+        List.fold_right
+          (fun cpnt_decl cpnts ->
+            precompile_component_declaration cpnt_decl :: cpnts)
+          cpnt_decl_list
+          cl.public_cpnts
+
+and precompile_type_prefix = function
+  | ParseTree.TypePrefix (flow, var_opt, inout_opt) ->
+      flow, var_opt, inout_opt
+
+and precompile_modification = function
+  | Some (ParseTree.Modification (class_modif, expr_opt)) ->
+      precompile_class_modification class_modif, expr_opt
+  | Some (ParseTree.Eq expr) | Some (ParseTree.ColEq expr) -> [], Some expr
+  | None -> [], None
+
+and precompile_class_modification = function
+  | ParseTree.ClassModification args ->
+      List.map precompile_argument args
+
+and precompile_argument = function
+  | ParseTree.ElementModification (ParseTree.NotEach, ParseTree.NotFinal,
+    cpnt_ref, ParseTree.Modification (class_modif, expr_opt), _) ->
+      let modifs = precompile_class_modification class_modif in
+      Modification (cpnt_ref, modifs, expr_opt)
+  | ParseTree.ElementModification (ParseTree.NotEach, ParseTree.NotFinal,
+    cpnt_ref, ParseTree.Eq expr, _) |
+    ParseTree.ElementModification (ParseTree.NotEach, ParseTree.NotFinal,
+    cpnt_ref, ParseTree.ColEq expr, _) -> Modification (cpnt_ref, [], Some expr)
+  | _ -> failwith "Unsupported modification"
diff --git a/scilab/modules/scicos/src/modelica_compiler/precompilation.mli b/scilab/modules/scicos/src/modelica_compiler/precompilation.mli
new file mode 100644 (file)
index 0000000..86ca9c1
--- /dev/null
@@ -0,0 +1,56 @@
+(* ceci est un premier commentaire *)
+(*  Scicos *)
+(* *)
+(*  Copyright (C) INRIA - METALAU Project <scicos@inria.fr> *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation; either version 2 of the License, or *)
+(* (at your option) any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the *)
+(* GNU General Public License for more details. *)
+(* *) 
+(* You should have received a copy of the GNU General Public License *)
+(* along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+(*  *)
+(* See the file ./license.txt *)
+
+(** This module eases the compilation phase by sorting elements of the parse
+tree obtained by calling the parsing functions. *)
+
+(** The type of a preprocessed parse tree element. *)
+type precompiled_class = {
+  class_kind : ParseTree.class_kind;
+  mutable extensions : extension list;
+  mutable public_classes : (string * precompiled_class) list;
+  mutable protected_classes : (string * precompiled_class) list;
+  mutable public_cpnts : (string * precompiled_component) list;
+  mutable protected_cpnts : (string * precompiled_component) list;
+  mutable equs : ParseTree.equation_clause list;
+  mutable algs : ParseTree.algorithm_clause list;
+  mutable class_comment : ParseTree.string_comment;
+}
+
+and extension = string list * modification list
+
+and modification =
+    Modification of (string * ParseTree.array_subscripts) list *
+      modification list * ParseTree.expression option
+
+and precompiled_component = {
+  class_name : string list;
+  subscripts : ParseTree.array_subscripts;
+  flow : ParseTree.flow option;
+  variability : ParseTree.variability option;
+  inout : ParseTree.inout option;
+  modification : modification list * ParseTree.expression option;
+  comment : ParseTree.comment;
+}
+
+(** [precompile tree] yields a precompiled class given a parse tree. Only one
+class description is allowed per parse tree. *)
+val precompile : ParseTree.t -> precompiled_class
diff