[SCM] Lisaac library examples branch, master, updated. b0edf34ec1ea8999657a4c5e4b5c6fafd0cb5924
Xavier Oswald
xoswald at debian.org
Tue Jul 28 14:03:16 UTC 2009
The following commit has been merged in the master branch:
commit b0edf34ec1ea8999657a4c5e4b5c6fafd0cb5924
Author: Xavier Oswald <xoswald at debian.org>
Date: Tue Jul 28 16:02:15 2009 +0200
Add lisaac parser generating an UML->SVG diagram
diff --git a/uml/acces.li b/uml/acces.li
new file mode 100644
index 0000000..30f1fdc
--- /dev/null
+++ b/uml/acces.li
@@ -0,0 +1,21 @@
+Section Header
+ + name := ACCES;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ - parent_object:OBJECT:=OBJECT;
+
+Section Public
+
+ //renvoit une chaine de caract�rs d�crivant le type d'acc�s
+ + get_type :ABSTRACT_STRING<-
+ (
+ deferred;
+ "FALSE"
+ );
+ //renvoit le type d'acc�s au format UML (+,-,*)
+ + get_uml_type :STRING_CONSTANT<-
+ (
+ deferred;
+ "FALSE"
+ );
\ No newline at end of file
diff --git a/uml/any.li b/uml/any.li
new file mode 100644
index 0000000..63b3d5c
--- /dev/null
+++ b/uml/any.li
@@ -0,0 +1,400 @@
+///////////////////////////////////////////////////////////////////////////////
+// Lisaac Compiler //
+// //
+// LSIIT - ULP - CNRS - INRIA - FRANCE //
+// //
+// 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 3 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, see <http://www.gnu.org/licenses/>. //
+// //
+// http://isaacproject.u-strasbg.fr/ //
+///////////////////////////////////////////////////////////////////////////////
+Section Header
+
+ + name := ANY;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Common parent for compiler";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Public
+
+ //
+ // Invariant loop system.
+ //
+ - count_invariant:INTEGER;
+
+ - loop_list:LIST;
+ - loop_seq_index:INTEGER;
+ - loop_seq_call_local_and_loop:INTEGER;
+ - loop_seq_call_and_loop:INTEGER;
+ - loop_invariant:LOOP;
+
+ //
+
+ - late_binding_counter:INTEGER;
+
+ - null_counter:INTEGER;
+
+ - polymorphic_counter:INTEGER;
+
+ //
+ // Display debug tools.
+ //
+
+ + object_id:INTEGER <-
+ ( + result:INTEGER;
+ - object_counter:INTEGER;
+
+ result := object_counter;
+ object_counter := object_counter + 1;
+ object_id := result;
+ result
+ );
+
+ //
+ // Compiler Options.
+ //
+
+ - is_optimization:BOOLEAN;
+
+ - inline_level:INTEGER := 17;
+
+ - is_statistic:BOOLEAN;
+
+ - is_quiet_operation:BOOLEAN;
+
+ - debug_level_option:INTEGER;
+
+ - debug_with_code:BOOLEAN;
+
+ - verbose_level:INTEGER;
+ - is_verbose:BOOLEAN <- (verbose_level != 0);
+
+ - is_warning:BOOLEAN;
+
+ - is_all_warning:BOOLEAN;
+
+ - is_executing_pass:BOOLEAN;
+
+ //
+ // Other flags.
+ //
+
+ - is_copy_local:BOOLEAN;
+
+ - pass_count:INTEGER;
+
+ - modify_count:INTEGER;
+
+ - new_depend_pass <-
+ (
+ modify_count := modify_count + 1;
+ //(pass_count > 50).if {
+ // crash;
+ //};
+ );
+
+ - new_execute_pass <- new_depend_pass;
+
+ //
+ // Sequence counter.
+ //
+
+ - seq_inline:UINTEGER_32;
+
+ - seq_index :UINTEGER_32; // Global index sequence.
+ - seq_or_and :UINTEGER_32; // || or &&
+ - seq_call_and_loop :UINTEGER_32; // Call or loop (or function).
+ - seq_call_local_and_loop:UINTEGER_32; // Call sensitive or loop.
+ - seq_list:FAST_ARRAY[LIST] := FAST_ARRAY[LIST].create_with_capacity 64;
+
+ - is_seq_list l:LIST :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ j := seq_list.upper;
+ {(j >= seq_list.lower) && {! result}}.while_do {
+ result := seq_list.item j = l;
+ j := j - 1;
+ };
+ result
+ );
+
+ //
+ // Runtime.
+ //
+
+ - list_main:LIST;
+ - context_main:LOCAL;
+
+ - list_current:LIST;
+
+ - stack_local:FAST_ARRAY[LOCAL] := FAST_ARRAY[LOCAL].create_with_capacity 64;
+
+ - profil_slot:PROFIL_SLOT; // Principal slot.
+ - profil:PROFIL; // Sub-profil or (profil = profil_slot)
+
+ - display_stack_local <-
+ (
+ string_tmp.clear;
+ (stack_local.lower).to (stack_local.upper) do { j:INTEGER;
+ stack_local.item j.display string_tmp;
+ string_tmp.add_last '\n';
+ };
+ string_tmp.print;
+ );
+
+ //
+ // Output Buffer and service.
+ //
+
+ - var_size:FAST_ARRAY[FAST_ARRAY[LOCAL]] :=
+ ( + result:FAST_ARRAY[FAST_ARRAY[LOCAL]];
+
+ result := FAST_ARRAY[FAST_ARRAY[LOCAL]].create_with_capacity 4;
+ 0.to 3 do { j:INTEGER;
+ result.add_last (FAST_ARRAY[LOCAL].create_with_capacity 32);
+ };
+ result
+ );
+
+ - add_var_size v:LOCAL <-
+ ( + tab:FAST_ARRAY[LOCAL];
+ + j:INTEGER;
+ + t:TYPE_FULL;
+
+ ? {v.style = '+'};
+
+ (v.style != '+').if {
+ v.intern_name.print; " style [".print; v.style.print; "] ".print;
+ '\n'.print;
+ warning_error (v.position,"BUG ANY.add_var_size Error");
+ };
+ // BSBS: C'est pas top, avec des HASHED_SET ce serait mieux...
+ t := v.type;
+ tab := var_size.item (v.type.size);
+ j := tab.lower;
+ {(j <= tab.upper) && {tab.item j.type != t}}.while_do {
+ j := j + 1;
+ };
+ (j > tab.upper).if {
+ tab.add_last v;
+ } else {
+ {(j <= tab.upper) && {tab.item j != v} && {tab.item j.type = t}}.while_do {
+ j := j + 1;
+ };
+ ((j > tab.upper) || {tab.item j != v}).if {
+ tab.add v to j;
+ };
+ };
+ );
+
+ - output_decl:STRING := STRING.create 60000;
+ - output_glob:STRING := STRING.create 10000;
+ - output_code:STRING := STRING.create 4000000;
+
+ - title txt:STRING_CONSTANT in buf:STRING <-
+ (
+ buf.append "\n//";
+ 3.to 28 do { j:INTEGER;
+ buf.add_last '=';
+ };
+ buf.append "//\n// ";
+ buf.append txt;
+ (txt.count+5).to 28 do { j:INTEGER;
+ buf.add_last ' ';
+ };
+ buf.append " //\n//";
+ 3.to 28 do { j:INTEGER;
+ buf.add_last '=';
+ };
+ buf.append "//\n\n";
+ );
+
+
+ - indent:STRING := STRING.create 128;
+
+ - operator typ:ABSTRACT_STRING name op:ABSTRACT_STRING :STRING_CONSTANT <-
+ ( + c:CHARACTER;
+ string_tmp.copy typ;
+ (op.lower).to (op.upper) do { j:INTEGER;
+ c:=op.item j;
+ (c = '+').if {
+ string_tmp.append "_add";
+ }.elseif { c = '-' } then {
+ string_tmp.append "_sub";
+ }.elseif { c = '~' } then {
+ string_tmp.append "_logicnot";
+ }.elseif { c = '!' } then {
+ string_tmp.append "_not";
+ }.elseif { c = '/' } then {
+ string_tmp.append "_div";
+ }.elseif { c = '*' } then {
+ string_tmp.append "_mul";
+ }.elseif { c = '^' } then {
+ string_tmp.append "_xor";
+ }.elseif { c = '%' } then {
+ string_tmp.append "_mod";
+ }.elseif { c = '>' } then {
+ string_tmp.append "_greater";
+ }.elseif { c = '<' } then {
+ string_tmp.append "_less";
+ }.elseif { c = '=' } then {
+ string_tmp.append "_equal";
+ }.elseif { c = '\\' } then {
+ string_tmp.append "_notdiv";
+ }.elseif { c = '|' } then {
+ string_tmp.append "_or";
+ }.elseif { c = '&' } then {
+ string_tmp.append "_and";
+ }.elseif { c = '$' } then {
+ string_tmp.append "_dollar";
+ }.elseif { c = '#' } then {
+ string_tmp.append "_diese";
+ }.elseif { c = '@' } then {
+ string_tmp.append "_at";
+ }.elseif { c = '?' } then {
+ string_tmp.append "_ask";
+ };
+ };
+ ALIAS_STR.get string_tmp
+ );
+
+ //
+ // Error manager.
+ //
+
+ - syntax :INTEGER := 0;
+ - semantic:INTEGER := 1;
+ - warning :INTEGER := 2;
+ - message :INTEGER := 3;
+
+ - syntax_error (pos:POSITION,txt:ABSTRACT_STRING) <-
+ (
+ pos.put_error syntax text txt;
+ pos.put_position;
+ POSITION.send_error;
+ );
+
+ - semantic_error (pos:POSITION,txt:ABSTRACT_STRING) <-
+ (
+ pos.put_error semantic text txt;
+ pos.put_position;
+ POSITION.send_error;
+ );
+
+ - warning_error (pos:POSITION,txt:ABSTRACT_STRING) <-
+ (
+ pos.put_error warning text txt;
+ pos.put_position;
+ POSITION.send_error;
+ );
+
+ - message_error (pos:POSITION,txt:ABSTRACT_STRING) <-
+ (
+ is_verbose.if {
+ pos.put_error message text txt;
+ pos.put_position;
+ POSITION.send_error;
+ };
+ );
+
+ //
+ // String temporary.
+ //
+
+ - string_tmp:STRING := STRING.create 256;
+
+ - string_tmp2:STRING := STRING.create 256;
+
+ //
+ // Path directory and command front end.
+ //
+
+ - path_directory:LINKED_LIST[STRING_CONSTANT] :=
+ LINKED_LIST[STRING_CONSTANT].create;
+
+ - command_list :LINKED_LIST[STRING_CONSTANT] :=
+ LINKED_LIST[STRING_CONSTANT].create;
+
+ //
+ // Alias type.
+ //
+
+ - type_input :TYPE;
+ - type_integer :TYPE;
+ - type_real :TYPE;
+ - type_character :TYPE;
+ - type_block :TYPE;
+ - type_true :TYPE;
+ - type_false :TYPE;
+ - type_boolean :TYPE;
+ - type_integer_32 :TYPE;
+ - type_pointer :TYPE;
+ - type_string_constant :TYPE;
+ - type_n_a_character :TYPE;
+ - type_n_a_n_a_character:TYPE;
+
+ //
+ // Usage Variable.
+ //
+
+ - last_position:POSITION;
+
+ - default_value v:ITM_CODE to_slot nam:ABSTRACT_STRING in t:PROTOTYPE :ITM_CODE <-
+ ( + lst:ITM_LIST;
+ + s:ITM_SLOT;
+ + n:STRING_CONSTANT;
+ + sec:SECTION_;
+ + larg:FAST_ARRAY[ITM_ARGUMENT];
+ + a:ITM_CODE;
+ + result:ITM_CODE;
+
+ lst ?= v;
+ (lst != NULL).if {
+ // Add function for init.
+
+ string_tmp.copy "Create function ";
+ string_tmp.append nam;
+ warning_error (v.position,string_tmp);
+
+ string_tmp.copy "__init_";
+ string_tmp.append nam;
+ n := ALIAS_STR.get string_tmp;
+ sec := SECTION_.get_name (ALIAS_STR.section_private);
+ larg := FAST_ARRAY[ITM_ARGUMENT].create_with_capacity 1;
+ larg.add_last (
+ ITM_ARG.create (v.position)
+ name (ALIAS_STR.variable_self)
+ type (ITM_TYPE_SIMPLE.type_self)
+ );
+ s := ITM_SLOT.create (v.position) name n feature sec;
+ s.set_affect '<';
+ s.set_value v type t;
+ s.set_argument_list larg;
+ t.slot_list.fast_put s to (s.name);
+ a := ITM_PROTOTYPE.create (v.position) type (ITM_TYPE_SIMPLE.get name);
+ result := ITM_READ_ARG1.create (v.position) name n arg a;
+ } else {
+ // Direct value.
+ result := v;
+ };
+ result
+ );
+
diff --git a/uml/attribut.li b/uml/attribut.li
new file mode 100644
index 0000000..b3e2d35
--- /dev/null
+++ b/uml/attribut.li
@@ -0,0 +1,61 @@
+Section Header
+ + name := ATTRIBUT;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_object:OBJECT := OBJECT;
+
+Section Private
+
+ + nom:STRING;
+ + type_retour:STRING;
+ + type_acces:ACCES;
+
+Section Public
+
+ - make (n:STRING,type:STRING,acces:ACCES) <-
+ (
+ nom:=n;
+ type_retour:= type;
+ type_acces:=acces;
+ );
+ - get_type_retour :STRING<-
+ (
+ type_retour
+ );
+ - get_nom :STRING <-
+ (
+ nom
+ );
+ - get_type_acces :ACCES <-
+ (
+ type_acces
+ );
+
+ //renvoie l'attribut dans la bonne syntaxe pour UML
+ - get_uml_string :STRING <-
+ (
+ + buffer:STRING;
+ buffer:=STRING.create 256;
+ buffer.copy "";
+ buffer.append (type_acces.get_uml_type);
+ buffer.append nom;
+ buffer.append (":");
+ buffer.append type_retour;
+ buffer
+ );
+
+ - print <-
+ (
+ + buffer:STRING;
+
+ buffer:=STRING.create 256;
+ buffer.copy "";
+ buffer.append (type_acces.get_uml_type);
+ buffer.append nom;
+ buffer.append (":");
+ buffer.append type_retour;
+
+ buffer.print;
+ );
\ No newline at end of file
diff --git a/uml/ens_attributs.li b/uml/ens_attributs.li
new file mode 100644
index 0000000..a45cf20
--- /dev/null
+++ b/uml/ens_attributs.li
@@ -0,0 +1,83 @@
+/******* Prototype qui permet de stocker les diff�rents attributs de m�thode ou de fichier *******/
+Section Header
+ + name := ENS_ATTRIBUTS;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+
+Section Inherit
+
+ + parent_linked_list:Expanded LINKED_LIST[ATTRIBUT];
+
+Section Private
+
+ //longueur maximale d'un attribut, permet de savoir avec quelle largeur construire le rectangle dans le diagramme
+ + taille_max:INTEGER;
+ //nombre de lignes, c'est � dire le nombre d'attributs de l'ensemble, utile �galement pour la construction du rectangle
+ + nb_lignes:INTEGER;
+ //contient la descrition de tous les attributs au format UML
+ + buffer:STRING;
+
+Section Public
+
+ - make <-
+ (
+ taille_max:=0;
+ nb_lignes:=0;
+ buffer:=STRING.create 256;
+ );
+ - ajouter a:ATTRIBUT <-
+ (
+ add_last a;
+ );
+
+ //pour un ensemble d'attributs d'une m�thode, renvoit juste les types de retour des attributs
+ - get_types_retour :STRING <-
+ (
+ + buf:STRING;
+ buf:=STRING.create 10;
+ buf.copy "(";
+ (is_empty).if{
+ buf.append ")";
+ }else{
+ (lower).to (upper) do{ i:INTEGER;
+ buf.append ((item i).get_type_retour);
+ buf.append ",";
+ };
+ buf.copy (buf.substring 1 to (buf.count-1));
+ buf.append ")";
+ };
+ buf
+ );
+ //construit l'ensemble, en cherchant la taille maximal et le nombre de lignes
+ - build :STRING <-
+ (
+ taille_max:=0;
+ nb_lignes:=0;
+ buffer:=STRING.create 256;
+ buffer.copy "";
+ (lower).to (upper) do{ i:INTEGER;
+ + as:STRING;
+ + a:ATTRIBUT;
+ a:=item i;
+ as:=a.get_uml_string;
+ nb_lignes:=nb_lignes+1;
+ (as.count>taille_max).if{
+ taille_max:=as.count;
+ };
+ as.append "\n";
+ buffer.append as;
+ };
+ buffer
+ );
+ - get_uml_string :STRING <-
+ (
+ buffer
+ );
+ - get_taille_max :INTEGER <-
+ (
+ taille_max
+ );
+ - get_nb_lignes :INTEGER <-
+ (
+ nb_lignes
+ );
diff --git a/uml/ens_fichiers.li b/uml/ens_fichiers.li
new file mode 100644
index 0000000..ae67b24
--- /dev/null
+++ b/uml/ens_fichiers.li
@@ -0,0 +1,91 @@
+Section Header
+ + name := ENS_FICHIERS;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_linked_list: Expanded LINKED_LIST[FICHIER];
+
+Section Public
+
+ - ajouter f:FICHIER <-
+ (
+ add_last f ;
+ );
+
+ - ajouter_tous es:ENS_FICHIERS <-
+ (
+ append_collection es;
+ );
+
+ //supprime toutes les redondances de fichier dans l'ensemble
+ - clean <-
+ (
+ +i:INTEGER;
+ i:=lower;
+ {i<=upper}.while_do{
+ +f:FICHIER;
+ f:=item i;
+ (has_an_other_occurrence_of f).if{
+ remove i;
+ }else{
+ f.remove_parents Self;
+ i:=i+1;
+ };
+ };
+ );
+ //recherche si l'ensemble contient une autre occurrence d'un certain fichier
+ - has_an_other_occurrence_of f:FICHIER :BOOLEAN <-
+ (
+ +result:INTEGER;
+ result:=0;
+ (lower).to (upper) do{ i:INTEGER;
+ + f2:FICHIER;
+
+ f2:=item i;
+ ((f2.get_nom) == (f.get_nom)).if{
+ result:=result+1;
+ };
+ };
+ (result>1)
+ );
+ //permet de r�cup�rer tous les fichiers morts-vivants de l'ensemeble, par rapport � un fichier (g)
+ - get_morts_vivants (f,g:FICHIER) in m_v:ENS_PARENTS :ENS_PARENTS <-
+ (
+ + ep,res:ENS_PARENTS;
+ + i:INTEGER;
+
+ res:=ENS_PARENTS.create;
+ ep:=f.get_parents;
+ i:=ep.lower;
+ {i<=ep.upper}.while_do{
+ + k:INTEGER;
+ k:=lower;
+ {k<=upper}.while_do{
+ ((ep.item i)==(item k .get_nom)).if{
+ (m_v.has (item k .get_nom)).if_false{
+ m_v.ajouter (item k .get_nom);
+ ((item k .get_nom)==(g.get_nom)).if{
+ k:=upper+1;
+ i:=ep.upper;
+ }
+ else
+ {
+ get_morts_vivants ((item k),g) in m_v;
+ ((m_v.last)==(g.get_nom)).if{
+ res.add_last (m_v.first);
+ k:=upper+1;
+ i:=ep.upper;
+ };
+ };
+ }
+ else
+ {
+ k:=upper;
+ };
+ };
+ k:=k+1;
+ };
+ i:=i+1;
+ };
+ res
+ );
\ No newline at end of file
diff --git a/uml/ens_methodes.li b/uml/ens_methodes.li
new file mode 100644
index 0000000..1c86a12
--- /dev/null
+++ b/uml/ens_methodes.li
@@ -0,0 +1,59 @@
+/******* Prototype qui permet de stocker les diff�rentes m�thodes instanci�s d'un fichier *******/
+Section Header
+ + name:=ENS_METHODES;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_linked_list:Expanded LINKED_LIST[METHODE];
+
+Section Private
+ //longueur maximale d'une methode, permet de savoir avec quelle largeur construire le rectangle dans le diagramme
+ + taille_max:INTEGER;
+ //nombre de lignes, c'est � dire le nombre de m�thodes de l'ensemble, utile �galement pour la construction du rectangle
+ + nb_lignes:INTEGER;
+ //contient la descrition de toutes les m�thodes au format UML
+ + buffer:STRING;
+
+Section Public
+
+ - make <-
+ (
+ taille_max:=0;
+ nb_lignes:=0;
+ buffer:=STRING.create 256;
+ );
+ - ajouter m:METHODE <-
+ (
+ add_last m;
+ );
+ //construit l'ensemble, en cherchant la taille maximal et le nombre de lignes
+ + build <-
+ (
+ taille_max:=0;
+ nb_lignes:=0;
+ buffer:=STRING.create 256;
+ buffer.copy "";
+ (lower).to (upper) do{ i:INTEGER;
+ + buffer1:STRING;
+ + m:METHODE;
+ m:=item i;
+ buffer1:=m.get_uml_string;
+ taille_max:= taille_max.max(buffer1.count);
+ buffer1.append_character '\n';
+ buffer.append buffer1;
+ nb_lignes:=nb_lignes+1;
+ }
+ );
+ - get_uml_string :STRING <-
+ (
+ buffer
+ );
+ - get_taille_max :INTEGER <-
+ (
+ taille_max
+ );
+ - get_nb_lignes :INTEGER <-
+ (
+ nb_lignes
+ );
\ No newline at end of file
diff --git a/uml/ens_parents.li b/uml/ens_parents.li
new file mode 100644
index 0000000..55f3067
--- /dev/null
+++ b/uml/ens_parents.li
@@ -0,0 +1,36 @@
+/******* Prototype qui permet de stocker les diff�rents parents instanci�s d'un fichier *******/
+
+
+
+Section Header
+ + name := ENS_PARENTS;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_linked_list:Expanded LINKED_LIST[STRING];
+
+Section Public
+
+ + ajouter s:STRING <-
+ (
+ add_last s ;
+ );
+
+ + ajouter_tous ep:ENS_PARENTS <-
+ (
+ append_collection ep;
+ );
+ //cherche si l'ensemble contient d�j� le parent (fr)
+ + has fr:STRING :BOOLEAN <-
+ (
+ +result:BOOLEAN;
+ result:=FALSE;
+ (lower).to (upper) do{ i:INTEGER;
+ + g:STRING;
+ g:=item i;
+ (g==fr).if{
+ result:=TRUE;
+ };
+ };
+ result
+ );
\ No newline at end of file
diff --git a/uml/ens_rectangles.li b/uml/ens_rectangles.li
new file mode 100644
index 0000000..9216d32
--- /dev/null
+++ b/uml/ens_rectangles.li
@@ -0,0 +1,143 @@
+/******* Prototype qui permet de stocker les diff�rents rectangle instanci�s *******/
+
+
+
+Section Header
+ + name := ENS_RECTANGLES;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_linked_list:Expanded LINKED_LIST[FORME_RECTANGLE];
+
+
+Section Public
+ //AJOUTE UNE FORME_RECTANGLE A ENS_RECTANGLES
+ + ajouter f:FORME_RECTANGLE <-
+ (
+ add_last f ;
+ );
+ //AJOUTE UN ENS_RECTANGLE A UN ENS_RECTANGLES
+ + ajouter_tous er:SELF <-
+ (
+ append_collection er;
+ );
+ //RENVOIE LA TAILLE DE LA FEN�TRE SVG � CR�ER
+ + get_xy_max :FAST_ARRAY[INTEGER]<-
+ (
+ + xy_max:FAST_ARRAY[INTEGER];
+ + fr:FORME_RECTANGLE;
+
+ xy_max:=FAST_ARRAY[INTEGER].create 2;
+ xy_max.put 0 to 0;
+ xy_max.put 0 to 1;
+ (lower).to (upper) do{ i:INTEGER;
+ fr:=item i;
+ xy_max.put (((fr.get_x)+(fr.get_largeur)).max (xy_max.item 0)) to 0;
+ xy_max.put (((fr.get_y)+(fr.get_hauteur)).max (xy_max.item 1)) to 1;
+ };
+ xy_max.put ((xy_max.item 0)+20) to 0;
+ xy_max.put ((xy_max.item 1)+20) to 1;
+ xy_max
+ );
+ //RENVOI VRAI SI LA FORME_RECTANGLE DE NOM "fr" EST DANS ENS_RECTANGLES, FAUX SINON
+ + has fr:STRING :BOOLEAN <-
+ (
+ +result:BOOLEAN;
+ result:=FALSE;
+ (lower).to (upper) do{ i:INTEGER;
+ + g:FORME_RECTANGLE;
+
+ g:=item i;
+ ((g.get_nom) == fr).if{
+ result:=TRUE;
+ };
+ };
+ result
+ );
+ //RENVOI VRAI SI LES PARENTS DU FICHIER DE NOM "f" SONT TOUS DANS ENS_RECTANGLES, FAUX SINON
+ + has_all_parents f:FICHIER and ef:ENS_FICHIERS :INTEGER<-
+ (
+ +result:INTEGER;
+ //+ep,morts_vivants,tmp,parents:ENS_PARENTS;
+ +ep,tmp:ENS_PARENTS;
+ result:=1;
+ ep:=f.get_parents;
+
+ tmp:=ENS_PARENTS.create;
+ // parents:=ENS_PARENTS.create;
+ tmp.copy ep;
+
+ /*morts_vivants:=ef.get_morts_vivants (f,f) in parents;
+ (parents.has (f.get_nom)).if{
+ tmp.remove (tmp.index_of (parents.first) start 0);
+ result:=2;
+ };*/
+
+ (tmp.lower).to (tmp.upper) do{i:INTEGER;
+ (has (tmp.item i)).if_false{result:=0;};
+ };
+ result
+ );
+ //ENLEVE UN PARENT DE ENS_RECTANGLES
+ + remove_parent f:FORME_RECTANGLE <-
+ ( + idx:INTEGER;
+ idx := fast_index_of f start lower;
+ (valid_index idx).if {
+ remove idx;
+ };
+ );
+ //ENLEVE TOUS LES PARENTS QUI N' ONT PAS D' INFLUENCES POUR LES COLLISIONS ENTRE TRAITS ET RECTANGLES
+ + remove_not_influent_parents (x1,y1:INTEGER) with (x2,y2:INTEGER)<-
+ (
+ + i,x_pere,x_fils,y_fils,y_pere:INTEGER;
+ x_pere:=x2;
+ x_fils:=x1;
+ y_fils:=y1;
+ y_pere:=y2;
+
+ i:=lower;
+ {i<=upper}.while_do {
+ ( {y_pere >= ((item i .get_y)+(item i .get_hauteur))}||{y_fils <= (item i .get_y)}||{(x_pere.max (x_fils)) <= (item i .get_x)}||{(x_pere.min (x_fils)) >= ((item i .get_x) +(item i .get_largeur))}).if{
+ remove i;
+ }else{
+ i:=i+1;
+ };
+ };
+ );
+ //TRIE ENS_RECTANGLES PAR RAPPORT � LA DISTANCE ENTRE LE POINT "x,y" ET TOUS LES RECTANGLES
+ + bofferding (x,y:INTEGER) <-
+ (
+ + dist,i,j:INTEGER;
+
+ (count==0).if_false{
+
+ i:=lower;
+ dist:=item i .distance (x,y);
+
+ {i<upper}.while_do{
+
+ j:=i+1;
+ {j<=upper}.while_do{
+ + r2:FORME_RECTANGLE;
+ + d:INTEGER;
+ r2:=item j;
+ d:=r2.distance (x,y);
+ (d<dist).if{
+ dist:=d;
+ put (item i) to j;
+ put r2 to i;
+
+ };
+ j:=j+1;
+ };
+ i:=i+1;
+ };
+ };
+ );
+
+ - print <-
+ (
+ lower.to upper do{ i:INTEGER;
+ item i .print;
+ };
+ );
diff --git a/uml/fichier.li b/uml/fichier.li
new file mode 100644
index 0000000..ccf3a4a
--- /dev/null
+++ b/uml/fichier.li
@@ -0,0 +1,90 @@
+Section Header
+ + name := FICHIER;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_object:OBJECT := OBJECT;
+
+Section Private
+
+ + nom:STRING;
+ + methodes:ENS_METHODES;
+ + attributs:ENS_ATTRIBUTS;
+ + parents:ENS_PARENTS;
+
+Section Public
+
+ - make (n:STRING,meths:ENS_METHODES,atts:ENS_ATTRIBUTS,p:ENS_PARENTS) <-
+ (
+ nom:=n;
+ nom.to_upper;
+ methodes:=meths;
+ attributs:=atts;
+ parents:=p;
+ );
+ - get_nom :STRING <-
+ (
+ nom
+ );
+ - get_methodes :ENS_METHODES <-
+ (
+ methodes
+ );
+ + get_attributs :ENS_ATTRIBUTS <-
+ (
+ attributs
+ );
+ - get_parents :ENS_PARENTS <-
+ (
+ parents
+ );
+ //supprime un parent trouv� dans un fichier.li mais qui ne se trouve pas
+ //dans ensemble_fichier, autrement dit un parent qui n'existe pas dans le
+ //r�pertoire pass� en argument, mais qui se trouve dans la lib, par exemple
+ - remove_parents ef:ENS_FICHIERS <-
+ (
+ + isin:BOOLEAN;
+ +i:INTEGER;
+ i:=parents.lower;
+
+ {i<= (parents.upper)}.while_do{
+ +p:STRING;
+ isin:=FALSE;
+ p:=parents.item i;
+ (ef.lower).to (ef.upper)do{ j:INTEGER;
+ + f:FICHIER;
+ f:=ef.item j;
+ (p==(f.get_nom)).if{
+ isin:=TRUE;
+ };
+ };
+ isin.if_false{
+ parents.remove i;
+ }else{ i:=i+1; };
+ };
+ );
+ - print <-
+ (
+ + s:STRING;
+ s:=STRING.create 100;
+ s.copy nom;
+ s.append "\nparents:\n";
+ (parents.lower).to(parents.upper)do{i:INTEGER;
+ s.append "--";
+ s.append (parents.item i);
+ s.append "--";
+ s.append "\n";
+ };
+ s.append "\nmethodes:\n";
+ (methodes.lower).to(methodes.upper)do{i:INTEGER;
+ s.append (methodes.item i.get_uml_string);
+ s.append "\n";
+ };
+ s.append "\n";
+ "\n\n---------------------------nouveau proto-----------------------------\n\n".print;
+ s.print;
+ "\nattributs:\n".print;
+ (attributs.lower).to(attributs.upper)do{i:INTEGER;
+ attributs.item i.print;'\n'.print;
+ };
+ );
\ No newline at end of file
diff --git a/uml/forme_rectangle.li b/uml/forme_rectangle.li
new file mode 100644
index 0000000..972ee74
--- /dev/null
+++ b/uml/forme_rectangle.li
@@ -0,0 +1,136 @@
+
+Section Header
+ + name := FORME_RECTANGLE;
+ - author:="HILBERT Jerome (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gregoire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_fichier:FICHIER :=FICHIER;
+
+Section Private
+
+ + x:INTEGER;
+ + y:INTEGER;
+ + largeur:INTEGER;
+ + hauteur:INTEGER;
+
+ //ensemnble des parents du rectangle courant qui permet de savoir pour placer le rectangle par rapport � ses parents
+ + peres:ENS_RECTANGLES;
+ //utile pour la gestion des collisions
+ + nice_look_left:INTEGER;
+ //utile pour la gestion des collisions, permet d'�viter que des traits ne se superpose en contournant le rectangle
+ + nice_look_right:INTEGER;
+
+Section Public
+
+ - make_with_file f:FICHIER <-
+ (
+ parent_fichier:=f;
+ peres:=ENS_RECTANGLES.create;
+ get_attributs.build;
+ get_methodes.build;
+ hauteur:=get_hauteur_max;
+ largeur:=get_largeur_max;
+ nice_look_left:=10;
+ nice_look_right:=10;
+ );
+ //attributs des coordonn�es au rectangles
+ - set_coord (xx,yy:INTEGER) <-
+ (
+ x:=xx;
+ y:=yy;
+ );
+ //d�cale le rectangle horizontalement de d
+ - decal d:INTEGER <-
+ (
+ x:=x+d;
+ );
+ //ajoute un rectangle dans l'ensemble des parents du rectangles
+ - ajout_coord p:SELF <-
+ (
+ peres.add_last p;
+ );
+ - get_couples :ENS_RECTANGLES <-
+ (
+ peres
+ );
+ - get_x :INTEGER <-
+ (
+ x
+ );
+ - get_y :INTEGER <-
+ (
+ y
+ );
+ - get_largeur :INTEGER <-
+ (
+ (largeur*7)
+ );
+ - get_hauteur :INTEGER <-
+ (
+ (hauteur*12)
+ );
+ - get_text_attributs :STRING <-
+ (
+ get_attributs.get_uml_string
+ );
+ - get_text_methodes :STRING <-
+ (
+ get_methodes.get_uml_string
+ );
+ //recherche la largeur maximale en fonction du nom, des attributs et des m�thodes pour construire le rectangle � la bonne taille
+ - get_largeur_max :INTEGER <-
+ (
+ + size:INTEGER;
+ size:= get_nom.count*2;
+ (size<get_methodes.get_taille_max).if{
+ size:=get_methodes.get_taille_max;
+ };
+ (size<get_attributs.get_taille_max).if{
+ size:=get_attributs.get_taille_max;
+ };
+ size
+ );
+ //recherche la hauteur maximale en fonction du nombre d'attributs et de m�thodes
+ - get_hauteur_max :INTEGER <-
+ (
+ + size:INTEGER;
+ size:=2;
+ size:=size+get_attributs.get_nb_lignes+2;
+ size:=size+get_methodes.get_nb_lignes+2;
+ size
+ );
+ //renvoit la distance entre le centre du rectangle et le point (a,b)
+ - distance (a,b:INTEGER) :INTEGER<-
+ (
+ + xr,yr:INTEGER;
+ xr:=x+(largeur/2);
+ yr:=y+(hauteur/2);
+
+ ((((a-xr)*(a-xr))+((b-yr)*(b-yr))).sqrt)
+ );
+ - get_left :INTEGER <-
+ (
+ nice_look_left
+ );
+ - get_right :INTEGER <-
+ (
+ nice_look_right
+ );
+ //met � jour le d�calage � gauche pour �viter la superposition des traits qui contournent le rectangle
+ -update_left <-
+ (
+ (nice_look_left>2).if{
+ nice_look_left:=nice_look_left-2;
+ }else{
+ nice_look_left:=11;
+ };
+ );
+ //met � jour le d�calage � droite pour �viter la superposition des traits qui contournent le rectangle
+ -update_right <-
+ (
+ (nice_look_right>2).if{
+ nice_look_right:=nice_look_right-2;
+ }else{
+ nice_look_right:=11;
+ };
+ );
\ No newline at end of file
diff --git a/uml/launcher.li b/uml/launcher.li
new file mode 100644
index 0000000..e482166
--- /dev/null
+++ b/uml/launcher.li
@@ -0,0 +1,74 @@
+Section Header
+ + name :=LAUNCHER;
+ - author:="HILBERT Jerome (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gregoire(greg-jacquemin at hotmail.fr)";
+Section Inherit
+
+ -parent_object:OBJECT := OBJECT;
+
+Section Public
+
+ - main <-
+ (
+ + p:PARSE;
+ + reper:ENTRY;
+ + string_tmp:STRING;
+ + ensfichiers:ENS_FICHIERS;
+ + f:FICHIER;
+ + svg:SVG_CREATOR;
+ + simple:BOOLEAN;
+ + uniquement_public:BOOLEAN;
+
+ ({COMMAND_LINE.count < 3}||{(COMMAND_LINE.item 1)=="-help"}).if{
+ affichage_aide;
+ }else{
+ svg:=SVG_CREATOR.clone;
+ f:=FICHIER.clone;
+ string_tmp := STRING.create 255;
+ string_tmp.copy (COMMAND_LINE.item 1);
+ "Parsing du dossier: ".print;
+ string_tmp.print;
+ "\n".print;
+
+ reper := FILE_SYSTEM.get_entry string_tmp;
+ (reper=NULL).if{
+ "Dossier ".print;
+ string_tmp.print;
+ " inexistant!\n'".print;
+ die_with_code exit_failure_code;
+ };
+ string_tmp.copy (COMMAND_LINE.item 2);
+ p:=PARSE.clone;
+
+ simple:=FALSE;
+ uniquement_public:=FALSE;
+ ({COMMAND_LINE.count >=4}&&{(COMMAND_LINE.item 3)=="-simple"}).if{
+ simple:=TRUE;
+ };
+ (simple).if_false{
+ ({COMMAND_LINE.count >=4}&&{(COMMAND_LINE.item 3)=="-public"}).if{
+ uniquement_public:=TRUE;
+ };
+ };
+
+ ensfichiers:=p.parcours_dossier reper option simple ou uniquement_public;
+
+ (ensfichiers.lower).to (ensfichiers.upper) do{ i:INTEGER;
+ //ensfichiers.item i .print;
+ };
+ '\n'.print;
+
+ svg.make ensfichiers to string_tmp;
+ svg.parcours_fichiers;
+ };
+ );
+
+Section Private
+
+ - affichage_aide <-
+ (
+ " \n\nUTILISATION :\n\t1er argument :\trepertoire a parser\n\n\
+ \\t2ieme argument :destination source SVG\n\n\t[-simple|-public] :\t\
+ \diagramme sans methodes/attributs|avec uniquement les methodes/attributs\
+ \ public\n\n\n\n".print;
+ );
+
\ No newline at end of file
diff --git a/uml/lireetecrire.li b/uml/lireetecrire.li
new file mode 100644
index 0000000..2309eef
--- /dev/null
+++ b/uml/lireetecrire.li
@@ -0,0 +1,60 @@
+
+
+Section Header
+ + name := LIREETECRIRE;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_object:OBJECT := OBJECT;
+
+Section Private
+
+ //le fichier svg dans lequel on va �crire
+ + file:STD_FILE;
+
+Section Public
+
+ //lit un fichier et renvoit son contenu dans une chaine de caract�res
+ + lire e:ENTRY :STRING <-
+ (
+ + fichier:STD_FILE;
+ + text:STRING;
+
+ fichier ?= e;
+ ((fichier = NULL) || {! fichier.open}).if {
+ "File ".print;
+ e.name.print;
+ " not open!\n'".print;
+ die_with_code exit_failure_code;
+ };
+
+ text := STRING.create (fichier.size);
+ fichier.read text size (fichier.size);
+ fichier.close;
+ text
+ );
+ //ouvre le fichier SVG, s'il n'�xiste pas il sera cr��, sinon il sera vid�
+ + ouvrir_svg dest:STRING <-
+ (
+ + e:ENTRY;
+
+ e := FILE_SYSTEM.make_file dest;
+ file ?= e;
+ ((file = NULL) || {! file.open}).if {
+ "File ".print;
+ e.name.print;
+ " didn't open!\n'".print;
+ die_with_code exit_failure_code;
+ };
+ );
+ //�crit la chaine dans le fichier SVG
+ + ecrire_svg chaine:STRING<-
+ (
+ file.write chaine from 1 size (chaine.count);
+ );
+ //ferme le fichier SVG
+ + fermer_svg <-
+ (
+ file.close;
+ );
\ No newline at end of file
diff --git a/uml/methode.li b/uml/methode.li
new file mode 100644
index 0000000..9ee4dd5
--- /dev/null
+++ b/uml/methode.li
@@ -0,0 +1,53 @@
+Section Header
+ + name := METHODE;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ +parent_object:OBJECT :=OBJECT;
+
+Section Private
+
+ + nom:STRING;
+ + type_retour:STRING;
+ + attributs:ENS_ATTRIBUTS;
+ + type_acces:ACCES;
+
+Section Public
+
+ - make (nom1:STRING,type_ret:STRING,ens_attributs:ENS_ATTRIBUTS,acces:ACCES)<-
+ (
+ nom:=nom1;
+ type_retour:=type_ret;
+ attributs:=ens_attributs;
+ type_acces:=acces;
+ );
+ - get_nom :STRING <-
+ (
+ nom
+ );
+ - get_type_retour :STRING <-
+ (
+ type_retour
+ );
+ - get_attributs :ENS_ATTRIBUTS <-
+ (
+ attributs
+ );
+ - get_type_acces :ACCES <-
+ (
+ type_acces
+ );
+
+ //renvoie la m�thode dans la bonne syntaxe pour UML
+ - get_uml_string :STRING <-
+ (
+ + buffer:STRING;
+ buffer:=STRING.create 256;
+ buffer.copy (type_acces.get_uml_type);
+ buffer.append nom;
+ buffer.append (attributs.get_types_retour);
+ buffer.append ":";
+ buffer.append type_retour;
+ buffer
+ );
\ No newline at end of file
diff --git a/uml/parse.li b/uml/parse.li
new file mode 100644
index 0000000..1684797
--- /dev/null
+++ b/uml/parse.li
@@ -0,0 +1,46 @@
+Section Header
+ + name := PARSE;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_object:OBJECT := OBJECT;
+
+
+
+Section Public
+
+ //parcours un dossier et renvoit un ensemble de fichier qui contient la description de tous les fichiers lisaac trouv�s
+ + parcours_dossier dir:ENTRY option simple:BOOLEAN ou uniquement_public:BOOLEAN :ENS_FICHIERS<-
+ (
+ + direc:DIRECTORY;
+ + string_tmp:STRING;
+ + courant:ENTRY;
+ + parsing:PARSING;
+ + ensfichiers:ENS_FICHIERS;
+
+ ensfichiers:=ENS_FICHIERS.create;
+
+ parsing:=PARSING.clone;
+
+ direc ?= dir;
+ ((direc = NULL) || {! direc.open}).if {
+ "Directory not found.\n".print;
+ die_with_code 0;
+ };
+ (direc.lower).to (direc.upper) do { j:INTEGER;
+ courant := direc.item j;
+
+ (courant.is_directory).if{
+ ensfichiers.ajouter_tous (parcours_dossier courant option simple ou uniquement_public);
+ }else{
+ string_tmp:=courant.name.substring (courant.name.count-2) to (courant.name.count);
+ (string_tmp.compare(".li")==0).if{
+ ensfichiers.ajouter (parsing.parcours_fichier courant option simple ou uniquement_public);
+ }
+ };
+ };
+
+ ensfichiers
+ );
+
\ No newline at end of file
diff --git a/uml/parser_ben.li b/uml/parser_ben.li
new file mode 100644
index 0000000..c63eaae
--- /dev/null
+++ b/uml/parser_ben.li
@@ -0,0 +1,1989 @@
+///////////////////////////////////////////////////////////////////////////////
+// Lisaac Compiler //
+// //
+// LSIIT - ULP - CNRS - INRIA - FRANCE //
+// //
+// 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 3 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, see <http://www.gnu.org/licenses/>. //
+// //
+// http://isaacproject.u-strasbg.fr/ //
+///////////////////////////////////////////////////////////////////////////////
+Section Header
+
+ + name := PARSER_BEN;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parser for Lisaac language.";
+
+ // You can to get current grammar with `grep "//++" parser.li'
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ // add_method sec:STRING_CONSTANT style s:CHARACTER
+ // name l:FAST_ARRAY[ABSTRACT_STRING] argument a:FAST_ARRAY[ITM_ARGUMENT] result r:ITM_TYPE
+
+Section Private
+
+
+ //
+ // Source information.
+ //
+
+ - source : STRING;
+
+ - position : INTEGER;
+
+ - pos_cur : INTEGER;
+ - pos_line : INTEGER;
+ - pos_col : INTEGER;
+
+ - begin_position:INTEGER; // begin item position
+
+ - current_position:POSITION <-
+ ( + result:POSITION;
+ ? {pos_cur <= position};
+
+ {pos_cur = position}.until_do {
+ (source.item pos_cur = '\n').if {
+ pos_col := 0;
+ pos_line := pos_line + 1;
+ } else {
+ pos_col := pos_col + 1;
+ };
+ pos_cur := pos_cur + 1;
+ };
+ POSITION.create NULL line pos_line column pos_col
+ );
+
+ //
+ // AMBIGU Manager.
+ //
+
+ - old_position:INTEGER;
+ - old_pos_cur :INTEGER;
+ - old_pos_line:INTEGER;
+ - old_pos_col :INTEGER;
+ //
+ - old_short_derive:INTEGER;
+
+ - save_context <-
+ (
+ old_position := position;
+ old_pos_cur := pos_cur;
+ old_pos_line := pos_line;
+ old_pos_col := pos_col;
+ //
+ old_short_derive := short_derive;
+ );
+
+ - restore_context <-
+ (
+ position := old_position;
+ pos_cur := old_pos_cur;
+ pos_line := old_pos_line;
+ pos_col := old_pos_col;
+ );
+
+ //
+ // Syntax parser.
+ //
+
+ - last_character:CHARACTER <-
+ ( + result:CHARACTER;
+ (position > source.upper).if {
+ result := 0.to_character;
+ } else {
+ result := source.item position;
+ };
+ result
+ );
+
+ - last_integer : INTEGER_64;
+ - last_real : STRING_CONSTANT;
+ - last_string : STRING_CONSTANT;
+ - last_len_string : INTEGER;
+
+ - read_space:BOOLEAN <-
+ ( + posold,pos,pos2:INTEGER;
+ + key:STRING_CONSTANT;
+ + short_line:INTEGER;
+ + level_comment:INTEGER;
+
+ pos := position;
+ posold := -1;
+ {posold = position}.until_do {
+ posold := position;
+
+ // Skip spaces :
+ {(last_character = 0.to_character) || {last_character > ' '}}.until_do {
+ position := position + 1;
+ };
+
+ (position < source.upper).if {
+ // Skip C++ comment style :
+ ((last_character = '/') & (source.item (position + 1) = '/')).if {
+ position := position + 2;
+ pos2 := position;
+ {
+ (last_character = 0.to_character) ||
+ {last_character = '\n'}
+ }.until_do {
+ position := position + 1;
+ };
+ (key = NULL).if {
+ short key_comment_default token pos2 to position;
+ } else {
+ short key token pos2 to position;
+ };
+ };
+ };
+ (position < source.upper).if {
+ // Skip C comment style :
+ pos2 := position;
+ ((last_character = '/') && {source.item (position+1) = '*'}).if {
+ position := position + 2;
+ level_comment := 1;
+ {
+ (last_character = 0.to_character) || {level_comment = 0}
+ }.until_do {
+ ((last_character = '/') && {source.item (position+1) = '*'}).if {
+ level_comment := level_comment + 1;
+ position := position + 2;
+ }.elseif {
+ (last_character = '*') && {source.item (position+1) = '/'}
+ } then {
+ level_comment := level_comment - 1;
+ position := position + 2;
+ } else {
+ position := position+1;
+ };
+ };
+ (level_comment != 0).if {
+ position := pos2;
+ syntax_error (current_position,"End of comment not found !");
+ };
+ //position := position+2;
+ short (ALIAS_STR.short_comment) token pos2 to position;
+ };
+ };
+ };
+ // FALSE : Last character.
+ begin_position := position;
+ ((position != pos) | (last_character != 0.to_character))
+ );
+
+ - read_symbol st:ABSTRACT_STRING :BOOLEAN <-
+ ( + posold,j:INTEGER;
+ + result:BOOLEAN;
+ // On passe les espaces :
+ (! read_space).if {
+ result := FALSE;
+ } else {
+ posold := position;
+ j := st.lower;
+ {(last_character = 0.to_character) ||
+ {(j > st.upper) || {last_character != st.item j}}}.until_do {
+ j := j+1;
+ position := position+1;
+ };
+ (j > st.upper).if {
+ result := TRUE;
+ } else {
+ position := posold;
+ result := FALSE;
+ };
+ };
+ result
+ );
+
+ - read_character ch:CHARACTER :BOOLEAN <-
+ ( + result:BOOLEAN;
+ // On passe les espaces :
+ (! read_space).if {
+ result := FALSE;
+ } else {
+ (last_character = ch).if {
+ position := position + 1;
+ result := TRUE;
+ };
+ };
+ result
+ );
+
+ //-- affect -> ":=" | "<-" | "?="
+ - read_affect:BOOLEAN <-
+ ( + result:BOOLEAN;
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if {
+ last_string := ALIAS_STR.symbol_affect_immediate;
+ result := TRUE;
+ }.elseif {read_symbol (ALIAS_STR.symbol_affect_cast)} then {
+ last_string := ALIAS_STR.symbol_affect_cast;
+ result := TRUE;
+ }.elseif {read_symbol (ALIAS_STR.symbol_affect_code)} then {
+ last_string := ALIAS_STR.symbol_affect_code;
+ result := TRUE;
+ };
+ result
+ );
+
+ //-- style -> '-' | '+'
+ - read_style:CHARACTER <-
+ ( + result:CHARACTER;
+ read_character '-'.if {
+ result := '-';
+ short (ALIAS_STR.short_slot_style) token (position-1) to position;
+ }.elseif {read_character '+'} then {
+ result := '+';
+ short (ALIAS_STR.short_slot_style) token (position-1) to position;
+ } else {
+ result := ' ';
+ };
+ result
+ );
+
+ //-- identifier -> 'a'-'z' {'a'-'z' | '0'-'9' | '_'}
+ - read_identifier:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + posold,idx:INTEGER;
+
+ // On passe les espaces :
+ ((! read_space) || {! last_character.is_lower}).if {
+ result := FALSE;
+ } else {
+ posold := position;
+ string_tmp.clear;
+ {
+ (last_character = 0.to_character) ||
+ {
+ (! last_character.is_lower) &&
+ {! last_character.is_digit} &&
+ {last_character != '_'}
+ }
+ }.until_do {
+ string_tmp.add_last last_character;
+ position := position+1;
+ };
+ (! string_tmp.is_empty).if {
+ idx := string_tmp.first_substring_index "__";
+ (idx != 0).if {
+ position := posold+idx;
+ syntax_error (current_position,"Identifier is incorrect.");
+ };
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ };
+ };
+ result
+ );
+
+ - read_word st:STRING_CONSTANT :BOOLEAN <-
+ ( + posold,idx:INTEGER;
+ + result:BOOLEAN;
+ // On passe les espaces :
+ (! read_space).if {
+ result := FALSE;
+ } else {
+ posold := position;
+ idx := st.lower;
+ {(idx > st.upper) || {last_character != st.item idx}}.until_do {
+ position := position+1;
+ idx := idx+1;
+ };
+ (idx>st.upper).if {
+ last_string := st;
+ result := TRUE;
+ } else {
+ position := posold;
+ };
+ };
+ result
+ );
+
+ - read_this_keyword st:STRING_CONSTANT :BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ result := read_word st;
+ result
+ );
+
+ //-- keyword -> 'A'-'Z' 'a'-'z' {'a'-'z' | '0'-'9' | '_'}
+ - read_keyword:BOOLEAN <-
+ ( + result:BOOLEAN;
+ // On passe les espaces :
+ ((! read_space) || {! last_character.is_upper}).if {
+ result := FALSE;
+ } else {
+ string_tmp.clear;
+ string_tmp.add_last last_character;
+ position := position + 1;
+ (last_character.is_lower).if {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ {(last_character != 0.to_character) &&
+ {(last_character.is_lower) ||
+ {last_character.is_digit} ||
+ {last_character = '_'}}}.while_do {
+ string_tmp.add_last last_character;
+ position := position+1;
+ };
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ short (ALIAS_STR.short_keyword) token
+ (position-last_string.count) to position;
+ } else {
+ position := position - 1;
+ result := FALSE;
+ };
+ };
+ result
+ );
+
+ //-- cap_identifier -> 'A'-'Z' {'A'-'Z' | '0'-'9' | '_'}
+ - read_cap_identifier:BOOLEAN <-
+ ( + posold,idx:INTEGER;
+ + result:BOOLEAN;
+ // On passe les espaces :
+ ((! read_space) || {! last_character.is_upper}).if {
+ result := FALSE;
+ } else {
+ posold := position;
+ string_tmp.clear;
+ {
+ (last_character = 0.to_character) ||
+ {
+ (! last_character.is_upper) &&
+ {! last_character.is_digit} &&
+ {last_character != '_'}
+ }
+ }.until_do {
+ string_tmp.add_last last_character;
+ position := position+1;
+ };
+ (! string_tmp.is_empty).if {
+ idx := string_tmp.first_substring_index "__";
+ (idx != 0).if {
+ position := posold + idx;
+ syntax_error (current_position,"Identifier is incorrect.");
+ };
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ };
+ };
+ result
+ );
+
+ //-- integer -> number
+ //-- number -> {'0'-'9'} ['d']
+ //-- | '0'-'9' {'0'-'9' | 'A'-'F' | 'a'-'f'} 'h'
+ //-- | {'0'-'7'} 'o'
+ //-- | {'0' | '1'} 'b'
+ - read_integer:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + pos_old:INTEGER;
+
+ // On passe les espaces :
+ ((read_space) && {last_character.is_digit}).if {
+ result := TRUE;
+ string_tmp.clear;
+ string_tmp.add_last last_character;
+ pos_old := position;
+ position := position + 1;
+ {(last_character.is_hexadecimal_digit) || {last_character = '_'}}.while_do {
+ (last_character != '_').if {
+ string_tmp.add_last last_character;
+ };
+ position := position + 1;
+ };
+ (last_character = 'h').if {
+ last_integer := string_tmp.to_hexadecimal;
+ position := position+1;
+ } else {
+ (string_tmp.last > '9').if {
+ string_tmp.remove_last 1;
+ position := position - 1;
+ };
+ (last_character='o').if {
+ (! string_tmp.is_octal).if {
+ syntax_error (current_position,"Incorrect octal number.");
+ };
+ last_integer := string_tmp.to_octal;
+ position := position+1;
+ }.elseif {last_character='b'} then {
+ (! string_tmp.is_bit).if {
+ syntax_error (current_position,"Incorrect binary number.");
+ };
+ last_integer := string_tmp.to_binary;
+ position := position+1;
+ } else {
+ (last_character='d').if {
+ position := position+1;
+ };
+ (! string_tmp.is_integer).if {
+ syntax_error (current_position,"Incorrect decimal number.");
+ };
+ last_integer := string_tmp.to_integer;
+ };
+ };
+ };
+ (result).if {
+ short (ALIAS_STR.short_integer) token pos_old to position;
+ };
+ result
+ );
+
+ - read_real:BOOLEAN <-
+ //-- real -> '0'-'9' {'0'-'9'_} [ '.' {'0'-'9'} ] [ 'E' ['+'|'-'] '0'-'9' {'0'-'9'}
+ ( + result:BOOLEAN;
+ + pos_old:INTEGER;
+
+ // On passe les espaces :
+ ((read_space) && {last_character.is_digit}).if {
+ string_tmp.clear;
+ string_tmp.add_last last_character;
+ pos_old := position;
+ position := position + 1;
+ {(last_character.is_digit) || {last_character = '_'}}.while_do {
+ (last_character != '_').if {
+ string_tmp.add_last last_character;
+ };
+ position := position + 1;
+ };
+ (last_character = '.').if {
+ string_tmp.add_last '.';
+ position := position + 1;
+ (last_character.is_digit).if {
+ result := TRUE;
+ string_tmp.add_last last_character;
+ position := position + 1;
+ {last_character.is_digit}.while_do {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ };
+ (last_character = 'E').if {
+ result := TRUE;
+ string_tmp.add_last 'E';
+ position := position + 1;
+ ((last_character = '+') || {last_character = '-'}).if {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ (last_character.is_digit).if {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ {last_character.is_digit}.while_do {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ } else {
+ syntax_error (current_position,"Incorrect real number.");
+ };
+ };
+ };
+ (result).if {
+ last_real := ALIAS_STR.get string_tmp;
+ } else {
+ position := pos_old;
+ };
+ };
+ (result).if {
+ short (ALIAS_STR.short_integer) token pos_old to position;
+ };
+ result
+ );
+
+ - read_escape_character <-
+ ( + nothing:BOOLEAN;
+ + val:INTEGER;
+ last_character.is_separator.if {
+ position := position+1;
+ {
+ (last_character = 0.to_character) ||
+ {! last_character.is_separator}
+ }.until_do {
+ position := position+1;
+ };
+ (last_character='\\').if {
+ string_tmp.remove_last 1;
+ position := position+1;
+ }.elseif {last_character != 0.to_character} then {
+ syntax_error (current_position,"Unknown escape sequence.");
+ };
+ }.elseif {last_character != 0.to_character} then {
+ ( (last_character = 'a') ||
+ {last_character = 'b'} ||
+ {last_character = 'f'} ||
+ {last_character = 'n'} ||
+ {last_character = 'r'} ||
+ {last_character = 't'} ||
+ {last_character = 'v'} ||
+ {last_character = '\\'} ||
+ {last_character = '?'} ||
+ {last_character = '\''} ||
+ {last_character = '\"'}
+ ).if {
+ string_tmp.add_last last_character;
+ position := position+1;
+ }.elseif {last_character.in_range '0' to '9'} then {
+ ((last_character='0') &&
+ {position<source.upper} &&
+ {! source.item(position+1).is_hexadecimal_digit}).if {
+ string_tmp.add_last last_character;
+ position := position+1;
+ } else {
+ string_tmp2.copy string_tmp;
+ nothing := read_integer; // result is Always TRUE.
+ string_tmp.copy string_tmp2;
+ (last_integer > 255).if {
+ syntax_error (current_position,
+ "Invalid range character number [0,255].");
+ };
+ val := last_integer.to_integer;
+ string_tmp.add_last ((val / 64).decimal_digit);
+ string_tmp.add_last (((val % 64) / 8).decimal_digit);
+ string_tmp.add_last ((val % 8).decimal_digit);
+ (last_character='\\').if {
+ position := position + 1;
+ } else {
+ syntax_error (current_position,"Character '\' is needed.");
+ };
+ };
+ } else {
+ syntax_error (current_position,"Unknown escape sequence.");
+ };
+ last_len_string := last_len_string + 1;
+ };
+ );
+
+ //-- character -> '\'' ascii '\''
+ - read_characters:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + old_pos:INTEGER;
+ // On passe les espaces :
+ ((read_space) && {last_character='\''}).if {
+ old_pos := position;
+ last_len_string := 0;
+ position := position+1;
+ string_tmp.clear;
+ {(last_character=0.to_character) ||
+ {last_character='\n'} ||
+ {last_character='\''}}.until_do {
+ string_tmp.add_last last_character;
+ (last_character='\\').if {
+ position := position+1;
+ read_escape_character;
+ } else {
+ position := position+1;
+ last_len_string := last_len_string+1;
+ };
+ };
+ (last_character='\'').if {
+ position := position+1;
+ last_string := ALIAS_STR.get string_tmp;
+ (last_len_string != 1).if {
+ position := begin_position;
+ syntax_error (current_position,"Character constant too long.");
+ };
+ result := TRUE;
+ short (ALIAS_STR.short_character) token old_pos to position;
+ } else {
+ position := begin_position;
+ syntax_error (current_position,"Unterminated character constant.");
+ };
+ };
+ result
+ );
+
+ //-- string -> '\"' ascii_string '\"'
+ - read_string:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + old_pos:INTEGER;
+ // On passe les espaces :
+ ((read_space) && {last_character='"'}).if { // "
+ last_len_string := 0;
+ old_pos := position;
+ position := position+1;
+ string_tmp.clear;
+ {(last_character=0.to_character) ||
+ {last_character='\n'} ||
+ {last_character='"'}}.until_do { // "
+ string_tmp.add_last last_character;
+ (last_character='\\').if {
+ position := position+1;
+ read_escape_character;
+ } else {
+ position := position+1;
+ last_len_string := last_len_string+1;
+ };
+ };
+ (last_character='"').if { // "
+ position := position+1;
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ short (ALIAS_STR.short_string) token old_pos to position;
+ } else {
+ position := begin_position;
+ syntax_error (current_position,"Unterminated string constant.");
+ };
+ };
+ result
+ );
+
+ //-- external -> '`' ascii_c_code '`'
+ - read_external:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + pos_old:INTEGER;
+ // On passe les espaces :
+ ((! read_space) || {last_character != '`'}).if {
+ result := FALSE;
+ } else {
+ pos_old:=position;
+ position := position+1;
+ string_tmp.clear;
+ {(last_character = 0.to_character) | (last_character='`')}.until_do {
+ string_tmp.add_last last_character;
+ (last_character='\\').if {
+ position := position+1;
+ string_tmp.add_last last_character;
+ (last_character != 0.to_character).if {
+ position := position+1;
+ };
+ } else {
+ position := position+1;
+ };
+ };
+ (last_character != 0.to_character).if {
+ position := position+1;
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ short (ALIAS_STR.short_external) token pos_old to position;
+ } else {
+ result := FALSE;
+ };
+ };
+ result
+ );
+
+ //-- operator -> '!' | '@' | '#' | '$' | '%' | '^' | '&' | '<' | '|'
+ //-- | '*' | '-' | '+' | '=' | '~' | '/' | '?' | '\' | '>'
+ - read_operator:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + old_pos:INTEGER;
+ // On passe les espaces :
+ (read_space).if {
+ };
+ old_pos:=position;
+ string_tmp.clear;
+ {(last_character = 0.to_character) ||
+ {! "!@#$%^&<|*-+=~/?\\>".has last_character}}.until_do {
+ string_tmp.add_last last_character;
+ position := position+1;
+ };
+ (! string_tmp.is_empty).if {
+ last_string := ALIAS_STR.get string_tmp;
+ (
+ (last_string = ALIAS_STR.symbol_affect_immediate) ||
+ {last_string = ALIAS_STR.symbol_affect_code} ||
+ {last_string = ALIAS_STR.symbol_affect_cast}
+ ).if {
+ syntax_error (current_position,"Incorrect operator.");
+ };
+ short (ALIAS_STR.short_operator) token old_pos to position;
+ result := TRUE;
+ };
+ result
+ );
+
+ //
+ // Variable & function Global.
+ //
+
+ - last_slot:ITM_SLOT;
+
+ - last_group:ITM_LIST;
+
+ - last_section:STRING_CONSTANT;
+
+ //
+ // PARSER
+ //
+
+ //++ PROGRAM -> { "Section" (section|TYPE_LIST) { SLOT } } [CONTRACT ';']
+ - read_program:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + pos_sec,old_derive:INTEGER;
+ + t:FAST_ARRAY[STRING_CONSTANT];
+
+ result := TRUE;
+
+ read_space;
+ pos_sec := position;
+
+ //
+ // Read Section Header.
+ //
+ (read_this_keyword (ALIAS_STR.keyword_section)).if_false {
+ syntax_error (current_position,"`Section' is needed.");
+ };
+
+ (read_this_keyword (ALIAS_STR.section_header)).if_false {
+ syntax_error (current_position,"Section `Header' is needed.");
+ };
+ (read_slot_header TRUE).if_false {
+ syntax_error (current_position,"Slot `name' not found.");
+ };
+ {read_slot_header FALSE}.while_do {
+ }; // loop
+
+ //
+ // Read Section Other.
+ //
+ {read_this_keyword (ALIAS_STR.keyword_section)}.while_do {
+ (read_keyword).if {
+ // Public, Private, ...
+ (ALIAS_STR.is_section last_string).if_false {
+ syntax_error (current_position,"Incorrect type section.");
+ };
+ last_section := last_string;
+ } else {
+ // TYPE_LIST.
+ t := read_type_list TRUE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type section.");
+ };
+ string_tmp.clear;
+ (t.lower).to (t.upper-1) do { j:INTEGER;
+ string_tmp.append (t.item j);
+ string_tmp.add_last ',';
+ };
+ string_tmp.append (t.last);
+ last_section := ALIAS_STR.get string_tmp;
+ };
+ "SECTION : ".print;
+ last_section.print;
+ '\n'.print;
+ {read_slot}.while_do {
+ }; // loop
+ }; // loop
+ (read_invariant).if {
+ warning_error (current_position,"Invariant: Sorry, Not yet implemented.");
+ };
+
+ // End of file :
+ result := result | read_space;
+ (last_character != 0.to_character).if {
+ syntax_error (current_position,"Incorrect symbol.");
+ };
+ result
+ ); // read_program
+
+ //++ SLOT -> style TYPE_SLOT [':' (TYPE|'('TYPE_LIST')') ][ affect DEF_SLOT ]';'
+ - read_slot:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + t:STRING_CONSTANT;
+ + lt:FAST_ARRAY[STRING_CONSTANT];
+ + style:CHARACTER;
+ + affect:CHARACTER;
+ + old_pos,old_derive:INTEGER;
+ + s:ITM_SLOT;
+
+ style := read_style;
+ (style != ' ').if {
+ //
+ // Classic slot.
+ //
+ key_comment_default := ALIAS_STR.short_comment_slot_line;
+
+ result := TRUE;
+ //
+ last_slot := read_type_slot;
+ (last_slot = NULL).if {
+ syntax_error (current_position,"Incorrect slot declaration.");
+ };
+
+ last_slot.set_style style;
+
+ (read_affect).if {
+ affect := last_string.first;
+ } else {
+ affect := ' ';
+ };
+
+ // ':' (TYPE|'('TYPE_LIST')'
+ ((affect = ' ') && {read_character ':'}).if {
+ (read_character '(').if {
+ lt := read_type_list FALSE;
+ (lt = NULL).if {
+ syntax_error (current_position,"Incorrect result type.");
+ };
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')' is needed.");
+ };
+ string_tmp.clear;
+ (lt.lower).to (lt.upper-1) do { j:INTEGER;
+ string_tmp.append (lt.item j);
+ string_tmp.add_last ',';
+ };
+ string_tmp.append (lt.last);
+ t := ALIAS_STR.get string_tmp;
+ } else {
+ t := read_type FALSE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect result type.");
+ };
+ };
+
+ (read_affect).if {
+ affect := last_string.first;
+ };
+ } else {
+ t := ALIAS_STR.prototype_void;
+ };
+ "RESULT : ".print;
+ t.print;
+ '\n'.print;
+
+ (affect != ' ').if {
+ read_space;
+ old_pos := position;
+ old_derive := short_derive;
+ read_def_slot;
+ };
+
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ };
+
+ // Added slot in prototype :
+ //BSBS: ICI!!!! add_slot last_slot;
+ };
+ result
+ ); // read_slot
+
+ //++ TYPE_SLOT -> [ LOC_ARG '.' ] identifier [ LOC_ARG { identifier LOC_ARG } ]
+ //++ | [ LOC_ARG ] '\'' operator '\'' [("Left"|"Right") [integer]] [LOC_ARG]
+ - read_type_slot:STRING_CONSTANT <-
+ ( + arg:ITM_ARGUMENT;
+ + result:ITM_SLOT;
+ + list_arg:FAST_ARRAY[ITM_ARGUMENT];
+
+ list_arg := ALIAS_ARRAY[ITM_ARGUMENT].new;
+ arg := read_loc_arg FALSE with_self TRUE;
+ (arg = NULL).if {
+ (read_character '\'').if {
+ result := read_slot_operator list_arg;
+ } else {
+ arg := ITM_ARG.create current_position
+ name (ALIAS_STR.variable_self) type (ITM_TYPE_SIMPLE.type_self);
+ list_arg.add_last arg;
+ result := read_slot_keyword list_arg;
+ };
+ } else {
+ list_arg.add_last arg;
+ (read_character '.').if {
+ result := read_slot_keyword list_arg;
+ }.elseif {read_character '\''} then {
+ result := read_slot_operator list_arg;
+ };
+ };
+ (result != NULL).if {
+ list_arg := ALIAS_ARRAY[ITM_ARGUMENT].copy list_arg;
+ result.set_argument_list list_arg;
+ };
+ result
+ );
+
+ - read_slot_keyword list_arg:FAST_ARRAY[STRING_CONSTANT] :STRING_CONSTANT <-
+ ( + n:STRING;
+ + arg:STRING_CONSTANT;
+ + result:ITM_SLOT;
+
+ read_identifier.if {
+ n := ALIAS_STR.new;
+ n.copy last_string;
+ arg := read_loc_arg FALSE with_self FALSE;
+ (arg != NULL).if {
+ list_arg.add_last arg;
+ (read_identifier).if {
+ (last_section.is_external).if {
+ syntax_error (current_position,"Incorrect in `Section External'.");
+ };
+ {
+ n.append (ALIAS_STR.separate);
+ n.append last_string;
+ arg := read_loc_arg FALSE with_self FALSE;
+ (arg = NULL).if {
+ syntax_error (current_position,"Incorrect symbol.");
+ }; // if
+ list_arg.add_last arg;
+ }.do_while {read_identifier}; // loop
+ };
+ }; // if
+ result := ALIAS_STR.alias n;
+ };
+ result
+ );
+
+ - read_slot_operator list_arg:FAST_ARRAY[STRING_CONSTANT] :STRING_CONSTANT <-
+ ( + name:STRING_CONSTANT;
+ + associativity:STRING_CONSTANT;
+ + priority:INTEGER;
+ + arg:STRING_CONSTANT;
+ + result:STRING_CONSTANT;
+
+ (! read_operator).if {
+ syntax_error (current_position,"Operator is needed.");
+ };
+ (
+ (last_string = ALIAS_STR.symbol_equal) ||
+ {last_string = ALIAS_STR.symbol_not_equal}
+ ).if {
+ syntax_error (current_position,"Incorrect operator.");
+ };
+ name := last_string;
+ (! read_character '\'').if {
+ warning_error (current_position,"Added `''.");
+ };
+ (
+ (read_this_keyword (ALIAS_STR.keyword_left)) ||
+ {read_this_keyword (ALIAS_STR.keyword_right)}
+ ).if {
+ associativity := last_string;
+ (read_integer).if {
+ priority := last_integer.to_integer;
+ };
+ };
+
+ (list_arg.is_empty).if {
+ // Prefix operator.
+ arg := read_loc_arg FALSE with_self TRUE;
+ (arg = NULL).if {
+ syntax_error (current_position,"Operator declaration invalid.");
+ };
+ list_arg.add_last arg;
+ name := operator (ALIAS_STR.slot_prefix) name name;
+ (associativity != NULL).if {
+ syntax_error (current_position,"Not associativity for postfix operator.");
+ };
+ } else {
+ arg := read_loc_arg FALSE with_self FALSE;
+ (arg != NULL).if {
+ // Infix operator.
+ list_arg.add_last arg;
+ name := operator (ALIAS_STR.slot_infix) name name;
+ (associativity = NULL).if {
+ associativity := ALIAS_STR.keyword_left;
+ };
+ } else {
+ // Postfix operator.
+ name := operator (ALIAS_STR.slot_postfix) name name;
+ (associativity != NULL).if {
+ syntax_error (current_position,"Not associativity for prefix operator.");
+ };
+ };
+ };
+ result := name;
+
+ result
+ ); // read_slot_operator
+
+ //++ DEF_SLOT -> [CONTRACT] EXPR [CONTRACT]
+ - read_def_slot <-
+ ( + expr:STRING_CONSTANT;
+
+ read_require;
+ expr := read_expr;
+ (expr = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ read_ensure;
+ );
+
+ //++ LOC_ARG -> identifier ':' TYPE
+ //++ | '(' LOCAL ')'
+ - read_loc_arg mute:BOOLEAN with_self self_first:BOOLEAN :STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+ + t:STRING_CONSTANT;
+ + pos:POSITION;
+ + n:STRING_CONSTANT;
+ + tb:STRING_CONSTANT;
+
+ (
+ (( self_first) && {read_this_keyword (ALIAS_STR.variable_self)}) ||
+ {(! self_first) && {read_identifier}}
+ ).if {
+ pos := current_position;
+ n := last_string;
+ ((read_character ':') && {last_character != '='}).if {
+ t := read_type TRUE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type.");
+ };
+ string_tmp.copy n;
+ string_tmp.add_last ':';
+ string_tmp.append t;
+ result := ALIAS_STR.get string_tmp;
+ } else {
+ mute.if_false {
+ warning_error (current_position,"Added ':' is needed.");
+ };
+ };
+ }.elseif {read_character '('} then {
+ result := read_local_arg mute with_self self_first;
+ (result = NULL).if {
+ mute.if_false {
+ syntax_error (current_position,"Incorrect argument definition.");
+ };
+ } else {
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')'.");
+ };
+ };
+ };
+ result
+ );
+
+ //++ LOCAL -> { identifier [ ':' TYPE ] ',' } identifier ':' TYPE
+ - read_local m:BOOLEAN :FAST_ARRAY[ITM_LOCAL] <-
+ ( + t:ITM_TYPE_MONO;
+ + loc:ITM_LOCAL;
+ + result:FAST_ARRAY[ITM_LOCAL];
+ + beg:INTEGER;
+ + mute:BOOLEAN;
+
+ mute := m;
+ (read_identifier).if {
+ result := ALIAS_ARRAY[ITM_LOCAL].new;
+ beg := result.lower;
+ {
+ ((result.count != 0) && {! read_identifier} && {! mute}).if {
+ syntax_error (current_position,"Incorrect identifier.");
+ };
+ loc := ITM_LOCAL.create current_position name last_string;
+ result.add_last loc;
+ ((read_character ':') && {last_character != '='}).if {
+ mute := FALSE;
+ t := read_type TRUE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect local type.");
+ };
+ beg.to (result.upper) do { j:INTEGER;
+ result.item j.set_type t;
+ };
+ beg := result.upper + 1;
+ };
+ }.do_while {read_character ','};
+ (beg != result.upper + 1).if {
+ (mute).if {
+ ALIAS_ARRAY[ITM_LOCAL].free result;
+ result := NULL;
+ } else {
+ syntax_error (current_position,"Incorrect local type.");
+ };
+ } else {
+ result := ALIAS_ARRAY[ITM_LOCAL].copy result;
+ };
+ };
+
+ result
+ ); // read_local
+
+ - read_local_arg m:BOOLEAN with_self s:BOOLEAN :ITM_ARGUMENT <-
+ ( + t:ITM_TYPE_MONO;
+ + tm:ITM_TYPE_MULTI;
+ + type:FAST_ARRAY[ITM_TYPE_MONO];
+ + name:FAST_ARRAY[STRING_CONSTANT];
+ + beg:INTEGER;
+ + mute:BOOLEAN;
+ + result:ITM_ARGUMENT;
+ + tb:ITM_TYPE_BLOCK;
+
+ mute := m;
+ (
+ ((s) && {read_this_keyword (ALIAS_STR.variable_self)}) ||
+ {read_identifier}
+ ).if {
+ name := ALIAS_ARRAY[STRING_CONSTANT].new;
+ type := ALIAS_ARRAY[ITM_TYPE_MONO].new;
+ beg := name.lower;
+ {
+ ((name.count != 0) && {! read_identifier} && {! mute}).if {
+ syntax_error (current_position,"Incorrect argument identifier.");
+ };
+ name.add_last last_string;
+ ((read_character ':') && {last_character != '='}).if {
+ mute := FALSE;
+ t := read_type TRUE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect argument type.");
+ };
+ beg.to (name.upper) do { j:INTEGER;
+ type.add_last t;
+ };
+ beg := name.upper + 1;
+ };
+ }.do_while {read_character ','};
+ (beg != name.upper + 1).if {
+ (mute).if_false {
+ syntax_error (current_position,"Incorrect argument type.");
+ };
+ ALIAS_ARRAY[STRING_CONSTANT].free name;
+ ALIAS_ARRAY[ITM_TYPE_MONO].free type;
+ } else {
+ (name.count = 1).if {
+ // Single Argument.
+ result := ITM_ARG.create current_position
+ name (name.first)
+ type (type.first);
+ ALIAS_ARRAY[STRING_CONSTANT].free name;
+ ALIAS_ARRAY[ITM_TYPE_MONO].free type;
+ } else {
+ // Vector Arguments.
+ name := ALIAS_ARRAY[STRING_CONSTANT].alias name;
+ type := ALIAS_ARRAY[ITM_TYPE_MONO].alias type;
+ tm := ITM_TYPE_MULTI.get type;
+ result := ITM_ARGS.create current_position name name type tm;
+ };
+ };
+ };
+
+ result
+ ); // read_local
+
+ //++ TYPE_LIST -> TYPE { ',' TYPE }
+ - read_type_list is_section:BOOLEAN :FAST_ARRAY[STRING_CONSTANT] <-
+ ( + lst:FAST_ARRAY[STRING_CONSTANT];
+ + t:STRING_CONSTANT;
+ + ts:STRING_CONSTANT;
+
+ t := read_type FALSE;
+ (t != NULL).if {
+ lst := ALIAS_ARRAY[STRING_CONSTANT].new;
+ lst.add_last t;
+ {read_character ','}.while_do {
+ t := read_type FALSE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type list.");
+ };
+ lst.add_last t;
+ };
+ lst := ALIAS_ARRAY[ITM_TYPE_MONO].alias lst;
+ };
+ lst
+ );
+
+ //++ TYPE -> '{' [ (TYPE | '(' TYPE_LIST ')') ';' ] [ TYPE_LIST ] '}'
+ //++ | [type] PROTOTYPE
+ - read_type is_local:BOOLEAN :STRING_CONSTANT <-
+ ( + style:STRING_CONSTANT;
+ + result:ITM_TYPE_MONO;
+ + lst:FAST_ARRAY[STRING_CONSTANT];
+ + typ_arg,typ_res:ITM_TYPE;
+
+ (read_character '{').if {
+ // '{' [ (TYPE | '(' TYPE_LIST ')') ';' ] [ TYPE_LIST ] '}'
+ (read_character '(').if {
+ // Read vector argument.
+ lst := read_type_list FALSE;
+ (lst = NULL).if {
+ syntax_error (current_position,"Incorrect type list.");
+ };
+ (lst.count = 1).if {
+ typ_arg := lst.first;
+ } else {
+ typ_arg := ITM_TYPE_MULTI.get lst;
+ };
+ (! read_character ')').if {
+ warning_error (current_position,"Added ')'.");
+ }; // if
+ (! read_character ';').if {
+ warning_error (current_position,"Added ';'.");
+ }; // if
+ lst := read_type_list FALSE;
+ } else {
+ lst := read_type_list FALSE;
+ (lst != NULL).if {
+ (read_character ';').if {
+ (lst.count = 1).if {
+ typ_arg := lst.first;
+ } else {
+ typ_arg := ITM_TYPE_MULTI.get lst;
+ string_tmp.copy "Added '";
+ typ_arg.display string_tmp;
+ string_tmp.append "'.";
+ warning_error (current_position,string_tmp);
+ };
+ lst := read_type_list FALSE;
+ };
+ };
+ };
+ (lst != NULL).if {
+ (lst.count = 1).if {
+ typ_res := lst.first;
+ } else {
+ typ_res := ITM_TYPE_MULTI.get lst;
+ };
+ };
+ (! read_character '}').if {
+ warning_error (current_position,"Added '}'.");
+ }; // if
+ result := ITM_TYPE_BLOCK.get typ_arg and typ_res;
+ } else {
+ // Expanded | Strict
+ (
+ (read_this_keyword (ALIAS_STR.keyword_expanded)) ||
+ {read_this_keyword (ALIAS_STR.keyword_strict)}
+ ).if {
+ style := last_string;
+ ((is_local) && {last_string = ALIAS_STR.keyword_expanded}).if {
+ syntax_error (current_position,"`Expanded' is not possible.");
+ };
+ };
+ // PROTOTYPE
+ result := read_prototype style;
+ };
+ result
+ ); // read_type
+
+ //++ PROTOTYPE -> cap_identifier ['['TYPE_LIST {identifier TYPE_LIST} ']']
+ //++ | '[' cap_identifier ']'
+ - read_prototype style:STRING_CONSTANT :STRING_CONSTANT <-
+ ( + name:STRING_CONSTANT;
+ + genericity:FAST_ARRAY[STRING_CONSTANT];
+ + continue:BOOLEAN;
+ + t,result:STRING_CONSTANT;
+ + old_pos,old_derive,sav_derive:INTEGER;
+
+ (read_character '[').if {
+ // '[' cap_identifier ']'
+ (! read_cap_identifier).if {
+ syntax_error (current_position,"Incorrect parameter type.");
+ };
+ string_tmp.copy "[";
+ string_tmp.append last_string;
+ string_tmp.add_last ']';
+ result := ALIAS_STR.get string_tmp;
+ (! read_character ']').if {
+ warning_error (current_position,"Added ']'.");
+ }; // if
+ }.elseif {read_cap_identifier} then {
+ old_pos := position;
+ old_derive := short_derive;
+
+ name := last_string;
+
+ (read_character '[').if {
+ //
+ // Genericity.
+ //
+
+ genericity := ALIAS_ARRAY[STRING_CONSTANT].new;
+ {
+ t := read_type FALSE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect generic type.");
+ };
+ genericity.add_last t;
+
+ (read_identifier).if {
+ continue := TRUE;
+ warning_error (current_position,
+ "Sorry, not yet implemented (ignored).");
+ } else {
+ continue := read_character ',';
+ };
+ }.do_while {continue};
+
+ genericity := ALIAS_ARRAY[ITM_TYPE_MONO].alias genericity;
+ result := ITM_TYPE_GENERIC.get name style style with genericity;
+ (! read_character ']').if {
+ warning_error (current_position,"Added ']'.");
+ }; // if
+ } else {
+ // Simple type.
+ (style = NULL).if {
+ result := name;
+ } else {
+ (name = ALIAS_STR.prototype_self).if {
+ string_tmp.copy "Style `";
+ string_tmp.append style;
+ string_tmp.append "' ignored.";
+ warning_error (current_position,string_tmp);
+ result := name;
+ } else {
+ string_tmp.copy style;
+ string_tmp.add_last ' ';
+ string_tmp.append name;
+ result := ALIAS_STR.get string_tmp;
+ };
+ };
+ }; // if
+ }; // if
+ result
+ ); // read_prototype
+
+ //-----------------------------------------------------------------------------------------------
+
+
+ //++ EXPR -> { ASSIGN !!AMBIGU!! affect } EXPR_OPERATOR
+ //++ ASSIGN -> '(' IDF_ASSIGN { ',' IDF_ASSIGN } ')'
+ //++ | IDF_ASSIGN
+ //++ IDF_ASSIGN -> identifier { identifier }
+ - read_expr:STRING_CONSTANT <-
+ ( + result,value:STRING_CONSTANT;
+ + affect:CHARACTER;
+ + again:BOOLEAN;
+ + l_assignment:FAST_ARRAY[STRING_CONSTANT];
+ + p:INTEGER;
+ + name:STRING_CONSTANT;
+
+ // !! AMBIGU resolution !!
+ save_context;
+ (read_character '(').if {
+ {
+ again := FALSE;
+ (read_identifier).if {
+ string_tmp2.copy last_string;
+ {read_identifier}.while_do {
+ string_tmp2.append (ALIAS_STR.separate);
+ string_tmp2.append last_string;
+ };
+ name := ALIAS_STR.get string_tmp2;
+
+ (read_character ',').if {
+ again := TRUE;
+ };
+ };
+ }.do_while {again};
+ ((name != NULL) && {read_character ')'} && {read_affect}).if {
+ result := name;
+ value := read_expr;
+ (value = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ };
+ }.elseif {read_identifier} then {
+ string_tmp2.copy last_string;
+ {read_identifier}.while_do {
+ string_tmp2.append (ALIAS_STR.separate);
+ string_tmp2.append last_string;
+ };
+ name := ALIAS_STR.get string_tmp2;
+
+ (read_affect).if {
+ result := name;
+ value := read_expr;
+ (value = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ };
+ };
+ (result = NULL).if {
+ restore_context;
+ result := read_expr_operator;
+ };
+ result
+ );
+
+ //++ EXPR_OPERATOR-> { operator } EXPR_MESSAGE { operator {operator} EXPR_MESSAGE } {operator}
+ - read_expr_operator:STRING_CONSTANT <-
+ ( + result,expr:STRING_CONSTANT;
+
+ {read_operator}.while_do {
+ //
+ };
+ result := read_expr_message;
+ (result != NULL).if {
+ // { operator {operator} EXPR_MESSAGE } {operator}
+ {
+ (read_operator).if {
+ {
+ }.do_while {read_operator};
+ expr := read_expr_message;
+ } else {
+ expr := NULL;
+ };
+ }.do_while {expr != NULL};
+ };
+ result
+ ); // read_expr_operator
+
+ //++ EXPR_MESSAGE -> EXPR_BASE { '.' SEND_MSG }
+ - read_expr_message:STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+
+ result := read_expr_base;
+ (result != NULL).if {
+ {read_character '.'}.while_do {
+ result := read_send_msg result;
+ (result=NULL).if {
+ syntax_error (current_position,"Incorrect message.");
+ }; // if
+ }; // loop
+ }; //if
+ result
+ ); // read_expr_message
+
+ //++ EXPR_BASE -> "Old" EXPR
+ //++ | EXPR_PRIMARY
+ //++ | SEND_MSG
+ - read_expr_base:STRING_CONSTANT <-
+ ( + result,old_value:STRING_CONSTANT;
+
+ (read_this_keyword (ALIAS_STR.keyword_old)).if {
+ old_value := read_expr;
+ (old_value = NULL).if {
+ syntax_error (current_position,"Incorrect `Old' expression.");
+ };
+ result := ALIAS_STR.keyword_old;
+ } else {
+ result := read_expr_primary;
+ (result = NULL).if {
+ result := read_send_msg NULL;
+ };
+ };
+ result
+ ); // read_expr_base
+
+ //++ EXPR_PRIMARY -> "Self"
+ //++ | result
+ //++ | PROTOTYPE
+ //++ | integer
+ //++ | characters
+ //++ | string
+ //++ | '(' GROUP ')'
+ //++ | '{' [ LOC_ARG ';' !! AMBIGU!! ] GROUP '}'
+ //++ | external [ ':' ['('] TYPE ['(' TYPE_LIST ')'] [')'] ]
+ - read_expr_primary:ITM_CODE <-
+ ( + result:ITM_CODE;
+ + type :ITM_TYPE_MONO;
+ + ltype:FAST_ARRAY[ITM_TYPE_MONO];
+ + ext :ITM_EXTERNAL_TYPE;
+ + group_sav:ITM_LIST;
+ + arg:ITM_ARGUMENT;
+ + result_id:STRING_CONSTANT;
+
+ (read_this_keyword (ALIAS_STR.variable_self)).if {
+ result := last_string;
+ }.elseif {read_this_keyword (ALIAS_STR.keyword_result)} then {
+ (last_character = '_').if {
+ position := position + 1;
+ string_tmp.copy (ALIAS_STR.keyword_result);
+ string_tmp.add_last '_';
+ {last_character.is_digit}.while_do {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ (string_tmp.is_empty).if {
+ syntax_error (current_position,"Incorrect Result number.");
+ };
+ result := ALIAS_STR.get string_tmp;
+ } else {
+ result := ALIAS_STR.keyword_result;
+ };
+ }.elseif {
+ type := read_prototype NULL;
+ type != NULL
+ } then {
+ result := "PROTOTYPE";
+ }.elseif {read_real} then {
+ result := "REAL";
+ }.elseif {read_integer} then {
+ result := "INTEGER";
+ }.elseif {read_characters} then {
+ result := "CHARACTER";
+ }.elseif {read_string} then {
+ result := "STRING";
+ }.elseif {read_character '(' } then {
+ group_sav := last_group;
+ last_group := ITM_LIST.create current_position;
+ result := last_group;
+ last_group.set_code read_group;
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')'.");
+ }; // if
+ last_group := group_sav;
+ }.elseif {read_character '{' } then {
+ short (ALIAS_STR.short_block) token (position-1) to position;
+ group_sav := last_group;
+ last_group := ITM_LIST.create current_position;
+
+ save_context; // !! SAVE CONTEXT !!
+
+ //
+ arg := read_loc_arg TRUE with_self FALSE;
+ //
+ (arg != NULL).if {
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ }; // if
+ } else {
+
+ restore_context; // !! RESTORE CONTEXT !!
+
+ };
+ result := ITM_BLOCK.create last_group argument arg;
+
+ last_group.set_code read_group;
+ (! read_character '}').if {
+ warning_error (current_position,"Added '}'.");
+ }; // if
+ last_group := group_sav;
+ }.elseif {read_external} then {
+ (! read_character ':').if {
+ result := ITM_EXTERNAL.create current_position text last_string;
+ } else {
+ ext := ITM_EXTERNAL_TYPE.create current_position text
+ last_string persistant (read_character '(');
+ type := read_type FALSE;
+ (type = NULL).if {
+ syntax_error (current_position,"Incorrect type.");
+ };
+ ext.set_type type;
+ (read_character '(').if {
+ ltype := read_type_list FALSE;
+ (ltype = NULL).if {
+ syntax_error (current_position,"Incorrect live type list.");
+ };
+ (! read_character ')').if {
+ warning_error (current_position,"Added ')'.");
+ };
+ ext.set_type_list ltype;
+ };
+ ((ext.is_persistant) && {! read_character ')'}).if {
+ warning_error (current_position,"Added ')'.");
+ };
+ result := ext;
+ };
+ };
+ result
+ ); // read_expr_primaire
+
+ //++ GROUP -> DEF_LOCAL {EXPR ';'} [ EXPR {',' {EXPR ';'} EXPR } ]
+ - read_group:FAST_ARRAY[ITM_CODE] <-
+ ( + e:ITM_CODE;
+ + result:FAST_ARRAY[ITM_CODE];
+
+ read_def_local;
+
+ result := ALIAS_ARRAY[ITM_CODE].new;
+ e := read_expr;
+ {(e != NULL) && {read_character ';'}}.while_do {
+ result.add_last e;
+ e := read_expr;
+ };
+ (e != NULL).if {
+ (read_character ',').if {
+ {
+ e := ITM_RESULT.create e;
+ result.add_last e;
+ e := read_expr;
+ {(e != NULL) && {read_character ';'}}.while_do {
+ result.add_last e;
+ e := read_expr;
+ };
+ (e = NULL).if {
+ syntax_error (current_position,"Incorrect multiple result expression.");
+ };
+ }.do_while {read_character ','};
+ };
+ e := ITM_RESULT.create e;
+ result.add_last e;
+ };
+ ALIAS_ARRAY[ITM_CODE].copy result
+ );
+
+ - read_invariant:BOOLEAN <-
+ ( + lst:ITM_LIST;
+
+ lst := read_contract;
+ lst != NULL
+ );
+
+ - read_require:BOOLEAN <-
+ ( + lst:ITM_LIST;
+ + result:BOOLEAN;
+
+ lst := read_contract;
+ (lst != NULL).if {
+ last_slot.set_require lst;
+ result := TRUE;
+ };
+ result
+ );
+
+ - read_ensure:BOOLEAN <-
+ ( + lst:ITM_LIST;
+ + result:BOOLEAN;
+
+ lst := read_contract;
+ (lst != NULL).if {
+ last_slot.set_ensure lst;
+ result := TRUE;
+ };
+ result
+ );
+
+ //++ CONTRACT -> '[' DEF_LOCAL { ( EXPR ';' | "..." ) } ']'
+ - read_contract:ITM_LIST <-
+ ( + continue:BOOLEAN;
+ + e:ITM_CODE;
+ + result:ITM_LIST;
+ + lst:FAST_ARRAY[ITM_CODE];
+
+ (read_character '[').if {
+ result := last_group := ITM_LIST.create current_position;
+ read_def_local;
+
+ lst := ALIAS_ARRAY[ITM_CODE].new;
+ {
+ e := read_expr;
+ (e = NULL).if {
+ continue := read_word (ALIAS_STR.keyword_ldots);
+ (continue).if {
+ lst.add_last (ITM_LDOTS.create current_position);
+ };
+ } else {
+ lst.add_last e;
+ (! read_character ';').if {
+ warning_error (current_position,"Added ';'.");
+ };
+ continue := TRUE;
+ };
+ }.do_while {continue};
+
+ (! read_character ']').if {
+ warning_error (current_position,"Added ']'.");
+ };
+ e := ITM_PROTOTYPE.create current_position type (ITM_TYPE_SIMPLE.type_void);
+ lst.add_last e;
+ //
+ result.set_code (ALIAS_ARRAY[ITM_CODE].copy lst);
+ };
+ result
+ );
+
+ //++ DEF_LOCAL -> { style LOCAL ';' } !! AMBIGU !!
+ - read_def_local <-
+ ( + loc_lst:FAST_ARRAY[ITM_LOCAL];
+ + local_list,static_list:FAST_ARRAY[ITM_LOCAL];
+ + styl:CHARACTER;
+
+ save_context; // !! SAVE CONTEXT !!
+
+ styl := read_style;
+ local_list := ALIAS_ARRAY[ITM_LOCAL].new;
+ static_list := ALIAS_ARRAY[ITM_LOCAL].new;
+ {styl != ' '}.while_do {
+ loc_lst := read_local TRUE;
+ (loc_lst != NULL).if {
+ (styl = '+').if {
+ local_list.append_collection loc_lst;
+ } else {
+ static_list.append_collection loc_lst;
+ };
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ };
+
+ save_context; // !! SAVE CONTEXT !!
+
+ styl := read_style;
+ } else {
+
+ restore_context; // !! RESTORE CONTEXT !!
+
+ styl := ' ';
+ };
+ };
+ (local_list.is_empty).if {
+ ALIAS_ARRAY[ITM_LOCAL].free local_list;
+ } else {
+ last_group.set_local_list (ALIAS_ARRAY[ITM_LOCAL].copy local_list);
+ };
+ (static_list.is_empty).if {
+ ALIAS_ARRAY[ITM_LOCAL].free static_list;
+ } else {
+ last_group.set_static_list (ALIAS_ARRAY[ITM_LOCAL].copy static_list);
+ };
+ );
+
+ //++ SEND_MSG -> identifier [ ARGUMENT { identifier ARGUMENT } ]
+ - read_send_msg first_arg:ITM_CODE :ITM_CODE <-
+ ( + result:ITM_CODE;
+ + name :STRING_CONSTANT;
+ + n:STRING;
+ + l_arg:FAST_ARRAY[ITM_CODE];
+ + arg:ITM_CODE;
+ + p1,p2,old_derive,sav_derive:INTEGER;
+
+ read_identifier.if {
+ //
+ // Classic Message.
+ //
+ p1 := position - last_string.count;
+ p2 := position;
+ old_derive := short_derive;
+
+ n := ALIAS_STR.new;
+ n.copy last_string;
+ // Argument list.
+ l_arg := ALIAS_ARRAY[ITM_CODE].new;
+ arg := read_argument;
+ (arg != NULL).if {
+ l_arg.add_last arg;
+ {read_identifier}.while_do {
+
+ n.append (ALIAS_STR.separate);
+ n.append last_string;
+ arg := read_argument;
+ (arg = NULL).if {
+ syntax_error (current_position,"Incorrect argument.");
+ }; // if
+ l_arg.add_last arg;
+ }; // loop
+ }; // if
+ name := ALIAS_STR.alias n;
+
+ l_arg.is_empty.if {
+ (first_arg=NULL).if {
+ // Local ou Implicite Slot without argument.
+ result := ITM_READ.create current_position name name;
+ } else {
+ result := ITM_READ_ARG1.create current_position name name arg first_arg;
+ };
+ ALIAS_ARRAY[ITM_CODE].free l_arg;
+ }.elseif {l_arg.count=1} then {
+ result := ITM_READ_ARG2.create current_position name
+ name args (first_arg,(l_arg.first));
+ ALIAS_ARRAY[ITM_CODE].free l_arg;
+ } else {
+ l_arg.add_first first_arg;
+ l_arg := ALIAS_ARRAY[ITM_CODE].copy l_arg;
+ result := ITM_READ_ARGS.create current_position name name args l_arg;
+ };
+ }; // if
+ result
+ ); // read_send_msg
+
+ //++ ARGUMENT -> EXPR_PRIMARY
+ //++ | identifier
+ - read_argument:ITM_CODE <-
+ ( + result:ITM_CODE;
+ result := read_expr_primary;
+ ((result = NULL) && {read_identifier}).if {
+ result := ITM_READ.create current_position name last_string;
+ };
+ result
+ ); // read_argument
+
+ // name, export, import, type, default, external, version, date, comment, author,
+ // bibliography, language, bug_report, copyright.
+ - read_slot_header first:BOOLEAN :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + v:ITM_CODE;
+ + cast:FAST_ARRAY[ITM_TYPE_MONO];
+ + style:CHARACTER;
+ + is_export:BOOLEAN;
+ + parameter_type:ITM_TYPE_PARAMETER;
+
+ style := read_style;
+ (style != ' ').if {
+ result := TRUE;
+ ((! first) && {style = '+'}).if {
+ warning_error (current_position,"Incorrect style slot ('-').");
+ };
+ (first).if {
+ (read_word (ALIAS_STR.slot_name)).if {
+ //
+ // Read `name' slot.
+ //
+
+ (style = '-').if {
+ warning_error (current_position,
+ "`- name' is reserved for Concurrent Object Prototype.\n\
+ \Sorry, COP is not yet implemented.");
+ };
+
+ // style "name" ':=' [type] cap_identifier
+ // ['['cap_identifier {',' cap_identifier}{identifier cap_identifier {',' cap_identifier}}']']
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+
+ (
+ (read_this_keyword (ALIAS_STR.keyword_expanded)) ||
+ {read_this_keyword (ALIAS_STR.keyword_strict)}
+ ).if {
+ //
+ };
+
+ (! read_cap_identifier).if {
+ syntax_error (current_position,"Prototype identifier is needed.");
+ };
+ "NAME : ".print;
+ last_string.print;
+ '\n'.print;
+
+ (read_character '[').if {
+ //
+ // Generic loader.
+ //
+ (! read_cap_identifier).if {
+ syntax_error (current_position,"Identifier parameter type is needed.");
+ };
+ last_string := NULL;
+ {(read_character ',') || {read_identifier}}.while_do {
+ (! read_cap_identifier).if {
+ syntax_error (current_position,"Identifier parameter type is needed.");
+ };
+ }; // loop
+
+ (! read_character ']').if {
+ warning_error (current_position,"Added ']'.");
+ };
+ };
+ } else {
+ syntax_error (current_position,"Slot `name' must to be first slot.");
+ };
+ }.elseif {
+ (is_export := read_word (ALIAS_STR.slot_export)) ||
+ {read_word (ALIAS_STR.slot_import)}
+ } then {
+ // - ("export"|"import") ':=' TYPE_LIST
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ cast := read_type_list FALSE;
+ (cast = NULL).if {
+ syntax_error (current_position,"Incorrect type list.");
+ };
+ (is_export).if {
+ object.set_export_list cast;
+ } else {
+ object.set_import_list cast;
+ };
+ }.elseif {read_word (ALIAS_STR.slot_external)} then {
+ //
+ // Read `external' slot.
+ //
+
+ // - "external" ':=' `<code_c>`
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_external).if_false {
+ syntax_error (current_position,"Incorrect external.");
+ };
+ }.elseif {read_word(ALIAS_STR.slot_default)} then {
+ //
+ // Read `default' slot.
+ //
+
+ // '-' "default" ':=' EXPR_PRIMARY
+
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ v := read_expr_primary;
+ (v = NULL).if {
+ syntax_error (current_position,"Incorrect expr.");
+ };
+ }.elseif {read_word (ALIAS_STR.slot_type)} then {
+ //
+ // Read `type' slot.
+ //
+
+ // '-' "type" ':=' `<type C>`
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_external).if_false {
+ syntax_error (current_position,"Incorrect external.");
+ };
+ (object.type_c != NULL).if {
+ semantic_error (current_position,"Double `type' slot definition.");
+ };
+ object.set_c_type last_string;
+ }.elseif {read_word (ALIAS_STR.slot_version)} then {
+ //
+ // Read `version' slot.
+ //
+
+ // '-' "version" ':=' integer
+
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_integer).if_false {
+ syntax_error (current_position,"Incorrect number.");
+ };
+ }.elseif {
+ (read_word (ALIAS_STR.slot_date)) ||
+ {read_word (ALIAS_STR.slot_comment)} ||
+ {read_word (ALIAS_STR.slot_author)} ||
+ {read_word (ALIAS_STR.slot_bibliography)} ||
+ {read_word (ALIAS_STR.slot_language)} ||
+ {read_word (ALIAS_STR.slot_copyright)} ||
+ {read_word (ALIAS_STR.slot_bug_report)}
+ } then {
+ //
+ // Read `date', `comment', `author', `bibliography',
+ // `language', `copyright' or `bug_report' slots.
+ //
+
+ // '-' ("date"|"comment"|"author"|"bibliography"|"language"|"copyright"|"bug_report") ':=' string
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_string).if_false {
+ syntax_error (current_position,"Incorrect string.");
+ };
+ } else {
+ warning_error (current_position,"Incorrect slot.");
+ };
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ };
+ };
+ result
+ );
+
+Section Public
+
+ //
+ // Parser Entry.
+ //
+
+ - go_on src:STRING <-
+ (
+ // Source information.
+ source := src;
+ position := source.lower;
+ pos_cur := source.lower;
+ pos_line := 1;
+ pos_col := 0;
+
+ // Parse.
+ (! read_program).if {
+ syntax_error (current_position,"Incorrect symbol.");
+ };
+ );
+
+
diff --git a/uml/parsing.li b/uml/parsing.li
new file mode 100644
index 0000000..a619c88
--- /dev/null
+++ b/uml/parsing.li
@@ -0,0 +1,492 @@
+/******* Prototype qui permet de recuperer toutes les informations relative a un fichier.li *******/
+
+
+
+Section Header
+ + name := PARSING;
+ - author:="HILBERT Jerome (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gregoire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_object:OBJECT := OBJECT;
+
+Section Private
+ + buffer1:STRING;
+ + simple:BOOLEAN :=FALSE;
+ + uniquement_public:BOOLEAN:=FALSE;
+
+Section Public
+
+ //recupere le contenu du fichier et renvoit une instance de FICHIER contenant ses informations
+ + parcours_fichier e:ENTRY option simple1:BOOLEAN ou uniquement_public1:BOOLEAN :FICHIER <-
+ (
+ + lee:LIREETECRIRE;
+ + f:FICHIER;
+ + nom:STRING;
+
+ simple:=simple1;
+ uniquement_public:=uniquement_public1;
+ f:=FICHIER.clone;
+ lee:=LIREETECRIRE.clone;
+ e.path.print;
+ "\n".print;
+ buffer1:=lee.lire e;
+ buffer1.append "\n";
+ buffer1.to_lower;
+ le_nettoyeur3;
+ nom:=get_element "name" in "Header";
+ f.make (nom,(get_methodes nom),(get_attributs nom),get_parents);
+ f
+ );
+
+Section Private
+
+ //nettoie le fichier en enlevant tous les commentaires, ce qui se trouve entre "" et entre ()
+ //->il ne restera que ce qu'il faut analyser!
+
+ - le_nettoyeur3 <-
+ (
+ + index,index2,index_g,index_c,index_po,index_pf,index_p:INTEGER;
+ + nb_p:INTEGER;
+ + calcul_index:BLOCK;
+ index:=1;
+ nb_p:=0;
+ //calcul des index
+ calcul_index:={index_g:=buffer1.index_of '"' since index;
+ index_c:=buffer1.index_of '/' since index;
+ index_pf:=buffer1.index_of ')' since index;
+ index_po:=buffer1.index_of '(' since index;
+ index:=(index_g.min index_c).min (index_po.min index_pf);
+ };
+
+ calcul_index.value;
+ {index<(buffer1.count+1)}.while_do{
+ ({index_g=index}&&{buffer1.item (index_g-1) != '\\'}&&{!({buffer1.item (index_g-1) = '\''}&&{buffer1.item (index_g+1) = '\''})}).if{
+ //on enl�ve ce qui est entre ""
+ index2:=index+1;
+ {{(index2:=buffer1.index_of '"' since (index2))!=(buffer1.count+1)}&&
+ {{buffer1.item (index2-1) = '\\'}||
+ {{buffer1.item (index2-1) = '\''}&&{buffer1.item (index2+1) = '\''}}}}.while_do{
+ index2:=index2+1;};
+ (index2=(buffer1.count+1)).if_false{
+ buffer1.remove_between index to index2;
+ };
+ }else{
+ //suppression des commentaires //
+ ({index_c=index}&&{buffer1.item (index_c+1) = '/'}).if{
+ index2:=buffer1.index_of '\n' since (index_c+2);
+ buffer1.remove_between index to (index2-1);
+ }else{
+ //suppression des commentaires /* */
+ ({index_c=index}&&{buffer1.item (index_c+1) = '*'}).if{
+ ((index2:=buffer1.substring_index ("*/",index_c+2))!=0).if{
+ buffer1.remove_between index to (index2+1);
+ };
+ }else{
+ //comptage des (
+ ({index_po=index}&&{!({buffer1.item (index_po-1)='\''}&&{buffer1.item (index_po+1)='\''})}).if{
+ (nb_p=0).if{index_p:=index;};
+ nb_p:=nb_p+1;
+ index:=index+1;
+ }else{
+ //d�comptage des ) et suppression des zones entre parenth�ses
+ ({index_pf=index}&&{!({buffer1.item (index_pf-1)='\''}&&{buffer1.item (index_pf+1)='\''})}).if{
+ nb_p:=nb_p-1;
+ (nb_p=0).if{
+ buffer1.remove_between index_p to (index_pf+1);
+ index:=index_p;
+ }else{index:=index+1;};
+ }else{index:=index+1;};
+ };
+ };
+ };
+ };
+ //calcul des nouveaux index
+ /*index_g:=buffer1.index_of '"' since index;
+ index_c:=buffer1.index_of '/' since index;
+ index_pf:=buffer1.index_of ')' since index;
+ index_po:=buffer1.index_of '(' since index;
+ index:=(index_g.min index_c).min (index_po.min index_pf);*/
+ calcul_index.value;
+ };
+ );
+
+ //renvoit la section s, par exemple si s vaut HEADER, renvoit l'ensemble de la section HEADER. S'il y a plusieurs section du m�me nom,
+ //renvoit les sections concat�n�es
+ - get_section s:ABSTRACT_STRING :STRING <-
+ (
+ + section1:STRING;
+ + index,index0:INTEGER;
+ + index2:INTEGER;
+ + texto:STRING;
+
+ index2:=1;
+ texto:=STRING.create (s.count);
+ section1:=STRING.create 256;
+ section1.copy "";
+ texto.copy s;
+ texto.to_lower;
+
+ {(index0:=buffer1.substring_index ("section",index2))!=0}.while_do{
+ index:=index0+7;
+ {{buffer1.item index ==' '}||{buffer1.item index =='\n'}}.while_do{index:=index+1;};
+ (buffer1.substring index to (index+s.count-1) ==texto).if{
+ index0:=index+s.count;
+ index2:=index0-7;
+ {
+ index:=index2+7;
+ index2:=buffer1.substring_index ("section",(index));
+ }.do_while{{index2!=0}&&{{{(buffer1.item (index2-1))!='\n'}&&{(buffer1.item (index2-1))!=' '}}||{{(buffer1.item (index2+7))!=' '}&&{(buffer1.item (index2+7))!='\n'}}}};
+
+ (index2==0).if{
+ index2:=buffer1.count;
+ };
+ section1.append (buffer1.substring index0 to (index2-1));
+ }else{index2:=index2+8;};
+ // "index2 ".print;index2.print;'\n'.print;
+ // "buffer1 ".print;buffer1.count.print;'\n'.print;
+ };
+ section1
+ );
+
+Section Public
+
+ // renvoit un �l�ment d'une section, pour l'instant cette m�thode ne sert qu'� r�cup�rer le 'name' dans la section HEADER
+ // mais elle pourrait servir �galement � r�cup�rer les auteur, les commentaires, etc..
+ - get_element nom:STRING_CONSTANT in s:STRING_CONSTANT :STRING <-
+ (
+ + index,index2,index3:INTEGER;
+ + section1:STRING;
+ + element:STRING;
+
+ section1:=get_section s;
+ index:=section1.substring_index (nom,1);
+ index:=section1.substring_index (":=",(index+nom.count));
+ index2:=section1.substring_index (";",(index+nom.count));
+ index3:=section1.substring_index ("->",(index+nom.count));
+ (index3>0).if{index2:=index2.min(index3-1)};
+
+ element:=STRING.create (index2-index+2);
+ element.copy (section1.substring (index+2) to (index2-1));
+ element.remove_all_occurrences ' ';
+ element.remove_all_occurrences '\n';
+ element
+);
+//renvoit l'ensemble des parents d'un prototype
+- get_parents :ENS_PARENTS <-
+(
+ + section1:STRING;
+ + index:INTEGER;
+ + index2:INTEGER;
+ + parents:ENS_PARENTS;
+ + parent:STRING;
+
+ parents:=ENS_PARENTS.create;
+ section1:=get_section "INHERIT";
+ index:=1;
+ index2:=1;
+
+ {(index:=section1.substring_index (":",(index2+1)))!=0}.while_do{
+ ((section1.item (index+1))=='=').if_false{
+ ((index2:=section1.substring_index ("expanded",(index+1)))!=0).if{
+ index:=index2+7;
+ };
+ ((index2:=section1.substring_index (":=",(index+1)))==0).if{
+ ((index2:=section1.substring_index (";",index))==0).if{
+ index2:=section1.substring_index ("<" ,index);
+ };
+ };
+
+
+ parent:=STRING.create (index2-index-2);
+ parent.copy (section1.substring (index+1) to (index2-1));
+ parent.remove_all_occurrences ' ';
+ parent.remove_all_occurrences '\n';
+ parent.to_upper;
+ (parents.has parent).if_false{
+ parents.ajouter parent;
+ };
+ }else{
+ index2:=index+1;
+ };
+ };
+ parents
+);
+
+//recherche des attributs
+- get_attributs nom:STRING :ENS_ATTRIBUTS <-
+(
+ + ea:ENS_ATTRIBUTS;
+ + pro:PROTECTED;
+
+ pro:=PROTECTED.clone;
+ pro.set_nom nom;
+
+ ea:=ENS_ATTRIBUTS.create;
+ (simple).if_false{
+ ea.append_collection (get_attributs2 PUBLIC);
+ (uniquement_public).if_false{
+ ea.append_collection (get_attributs2 PRIVATE);
+ ea.append_collection (get_attributs2 pro);
+ };
+ };
+ ea
+);
+//recherche des attributs selon un acc�s (public,private,..)
+- get_attributs2 acces:ACCES :ENS_ATTRIBUTS <-
+(
+ + index,index2,index3:INTEGER;
+ + ea:ENS_ATTRIBUTS;
+ + section1:STRING;
+ + tmp_string:STRING;
+ ea:=ENS_ATTRIBUTS.create;
+
+section1:=get_section (acces.get_type);
+
+ index:=0;
+ {index!=(section1.count+1)}.while_do{
+ index2:=index3:=index;
+ {
+ index:=index+1;
+ index:=section1.index_of '+' since index;
+ }.do_while {
+ ((index > section1.lower) && {section1.item (index-1)='\''}) &&
+{(index < section1.upper) && {section1.item (index+1)='\''}}
+};
+
+{
+ index2:=index2+1;
+ index2:=section1.index_of '-' since index2;
+}.do_while{
+ ((index2 > section1.lower) && {section1.item (index2-1)='<'}) || {
+ {(index2 > section1.lower) && {section1.item (index2-1)='\''}} &&
+ {(index2 < section1.upper) && {section1.item (index2+1)='\''}}
+ }
+};
+
+{
+ index3:=index3+1;
+ index3:=section1.index_of '*' since index3;
+}.do_while {
+((index3 > section1.lower) && {section1.item (index3-1)='\''}) &&
+{(index3 < section1.upper) && {section1.item (index3+1)='\''}}
+};
+index:=index.min index2.min index3;
+
+(index != section1.count+1).if {
+
+ // index2:=section1.index_of ';' since (index+1);
+ index2:=section1.substring_index (":=",(index+1));
+ index3:=section1.index_of ';' since (index+1);
+ ({index2>index3}||{index2==0}).if{index2:=index3;};
+
+ index3:=section1.substring_index ("<-",(index+1));
+ ({index2<index3}||{index3==0}).if{
+ index2:=index2.min((section1.index_of '=' since (index+1))-1);
+ tmp_string:=section1.substring (index+1) to (index2-1);
+ ((tmp_string.index_of ':' since 1)!=(tmp_string.count+1)).if{
+ ea.append_collection (get_attribut tmp_string with acces);
+ };
+ };
+};
+};
+ea
+);
+//analyse une chaine correspondant a un ('i:INTEGER') ou plusieurs ('i,j:INTEGER') attribut(s) et renvoit un ensemble d'attributs
+- get_attribut a:STRING with acces:ACCES :ENS_ATTRIBUTS <-
+(
+ + attribut:ATTRIBUT;
+ + index,index2,index3:INTEGER;
+ + nom,type_retour:STRING;
+ + ea:ENS_ATTRIBUTS;
+
+ ea:=ENS_ATTRIBUTS.create;
+ a.remove_all_occurrences ' ';
+ a.remove_all_occurrences '\n';
+
+ index:=a.index_of ':' since 1;
+ type_retour:=a.substring (index+1) to (a.count);
+ type_retour.to_upper;
+
+ index2:=1;
+ {{(index3:=a.index_of ',' since (index2))!=(a.count+1)}&&{index3<index}}.while_do{
+ attribut:=ATTRIBUT.clone;
+ nom:=a.substring index2 to (index3-1);
+ attribut.make (nom,type_retour,acces);
+ ea.add_last attribut;
+ index2:=index3+1;
+ };
+ attribut:=ATTRIBUT.clone;
+ nom:=a.substring index2 to (index-1);
+ attribut.make (nom,type_retour,acces);
+ ea.add_last attribut;
+ ea
+);
+
+Section Public
+
+ //recherche des attributs
+ - get_methodes nom:STRING :ENS_METHODES <-
+ (
+ + em:ENS_METHODES;
+ + pro:PROTECTED;
+
+ pro:=PROTECTED.clone;
+ pro.set_nom nom;
+
+ em:=ENS_METHODES.create;
+ (simple).if_false{
+ em.append_collection (get_methodes2 PUBLIC);
+ (uniquement_public).if_false{
+ em.append_collection (get_methodes2 PRIVATE);
+ em.append_collection (get_methodes2 pro);
+ };
+ };
+ em
+ );
+ //recherche des attributs selon un acces(public,private,..)
+ - get_methodes2 acces:ACCES:ENS_METHODES <-
+ (
+ + index,index2,index3:INTEGER;
+ + em:ENS_METHODES;
+ + section1:STRING;
+ + tmp_string:STRING;
+ em:=ENS_METHODES.create;
+ section1:=get_section (acces.get_type);
+ "section\t".print;section1.print;'\n'.print;
+
+ index:=0;
+ {index!=(section1.count+1)}.while_do{
+ index2:=index3:=index;
+ {
+ index:=index+1;
+ index:=section1.index_of '+' since index;
+ }.do_while {
+ ((index > section1.lower) && {section1.item (index-1)='\''}) &&
+ {(index < section1.upper) && {section1.item (index+1)='\''}}
+ };
+
+ {
+ index2:=index2+1;
+ index2:=section1.index_of '-' since index2;
+ }.do_while {
+ ((index2 > section1.lower) && {section1.item (index2-1)='<'}) || {
+ ((index2 > section1.lower) && {section1.item (index2-1)='\''}) && {
+ (index2 < section1.upper) && { section1.item (index2+1)='\''}
+ }
+ }
+ };
+
+ {
+ index3:=index3+1;
+ index3:=section1.index_of '*' since index3;
+ }.do_while {
+ ((index3 > section1.lower) && {section1.item (index3-1)='\''}) &&
+ {(index3 < section1.upper) && {section1.item (index3+1)='\''}}
+ };
+
+
+ index:=index.min index2.min index3;
+ (index!=(section1.count+1)).if{
+ // index2:=section1.index_of ';' since (index+1);
+ index2:=section1.substring_index (":=",(index+1));
+ index3:=section1.index_of ';' since (index+1);
+ ({index2>index3}||{index2==0}).if{index2:=index3;};
+ index3:=section1.substring_index ("<-",(index+1));
+ ({{index2>index3}||{index2==(section1.count+1)}}&&{index3!=0}).if{
+ tmp_string:=section1.substring (index+1) to (index3-1);
+ em.add_last (get_methode (tmp_string,acces));
+ };
+ };
+ };
+ em
+);
+
+Section Public
+
+ - get_methode (m:STRING,acces:ACCES) :METHODE <-
+ (
+ + index,index2,index3:INTEGER;
+ + nom,type_retour,tmp_string2:STRING;
+ + methode:METHODE;
+ + ea:ENS_ATTRIBUTS;
+
+ ea:=ENS_ATTRIBUTS.create;
+ methode:=METHODE.clone;
+ m.right_adjust; m.left_adjust;
+ type_retour:=STRING.create 4;
+ type_retour.copy "void";
+ m.replace_all '\t' with ' ';
+ m.append " ";
+ index:=(m.index_of ' ' since 1).min(m.index_of ':' since 1).min(m.index_of '(' since 1);
+ nom:= m.substring 1 to (index-1);
+ nom.replace_all '<' with 'c';
+ nom.replace_all '&' with 'e';
+ {(index2:=m.index_of ':' since (index))!=(m.count+1)}.while_do{
+ ((index2-index)<2).if{
+ type_retour:=m.substring (index2+1) to (m.count-1);
+ index:=m.count;
+ }else{
+ + idx_end_type,last_idx:INTEGER;
+ + tmp_string3:STRING;
+
+ index3:=(m.index_of ' ' since (index2+1)).min(m.index_of ')' since (index2+1));
+ tmp_string2:=m.substring (index+1) to (index3-1);
+ last_idx := tmp_string2.lower;
+ {
+ (
+ idx_end_type := tmp_string2.index_of ':' since last_idx;
+ idx_end_type := tmp_string2.index_of ',' since (idx_end_type+1)
+ ) != tmp_string2.count+1
+ }.while_do {
+ tmp_string3 := tmp_string2.substring last_idx to (idx_end_type-1);
+ "parametres méthodes\t".print;tmp_string3.print;'\n'.print;
+ last_idx := idx_end_type + 1;
+ ea.append_collection(get_attribut tmp_string3 with acces);
+ };
+ /*
+ ((tmp_string2.occurrences ':')>1).if{
+ index3:=m.index_of ':' since (index2+1);
+ tmp_string2:=m.substring (index+1) to (index3-1);
+ };
+ */
+ index:=index3;
+ };
+ };
+ type_retour.to_upper;
+ methode.make (nom,type_retour,ea,acces);
+ methode
+ );
+
+
+/*
+ + le_nettoyeur4 <-
+ (
+ + idx_prefix,idx_end:INTEGER;
+ idx_prefix := 1;
+ { idx_prefix != buffer1.count+1 }.while_do{
+ idx_prefix := buffer1.substring_index "//" since idx_prefix;
+ (buffer1.item (idx_prefix-1) != '\\').if{
+ idx_end := buffer1.index_of '\\n' since idx_prefix;
+ buffer1.remove_between idx_prefix to idx_end;
+ };
+ };
+ idx_prefix := 1;
+ { idx_prefix != buffer1.count+1 }.while_do{
+ idx_prefix := buffer1.substring_index "/*" since idx_prefix;
+ (buffer1.item (idx_prefix-1) != '\\').if{
+ idx_end := buffer1.substring_index "*/" since idx_prefix;
+ (buffer1.item (idx_end-1) != '\\').if{
+ buffer1.remove_between idx_prefix to (idx_end+1);
+ };
+ };
+ };
+ idx_prefix := 1;
+ {
+ ( idx_prefix := (buffer1.index_of '+' since idx_prefix ).min (buffer1.index_of '-' since idx_prefix);
+ idx_end := (buffer1.index_of ';' since idx_prefix).min (buffer1.substring_index "<-" since idx_prefix).min (buffer1.substring_index ":=" since idx_prefix)
+ ) != buffer1.count+1
+ }.while_do{
+
+ };
+ );
+*/
\ No newline at end of file
diff --git a/uml/position.li b/uml/position.li
new file mode 100644
index 0000000..01df7db
--- /dev/null
+++ b/uml/position.li
@@ -0,0 +1,207 @@
+///////////////////////////////////////////////////////////////////////////////
+// Lisaac Compiler //
+// //
+// LSIIT - ULP - CNRS - INRIA - FRANCE //
+// //
+// 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 3 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, see <http://www.gnu.org/licenses/>. //
+// //
+// http://isaacproject.u-strasbg.fr/ //
+///////////////////////////////////////////////////////////////////////////////
+Section Header
+
+ + name := Expanded POSITION;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Coding position : \
+ \ 9 bits : Index prototype [1..511]. \
+ \ 8 bits : Column [0..255]. \
+ \ 15 bits : Line [1..32767].";
+
+ - type := `unsigned long`;
+ - default := ( CONVERT[INTEGER,POSITION].on 0 );
+
+Section Insert
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ - object_size:INTEGER <- POINTER.object_size;
+
+ - code:UINTEGER_32 <- CONVERT[POSITION,UINTEGER_32].on Self;
+
+ //
+ // Creation.
+ //
+
+ - create proto:PROTOTYPE line l:INTEGER column c:INTEGER :POSITION <-
+ ( + cod:UINTEGER_32;
+ ? {l .in_range 0 to 131071};
+ ? {c .in_range 0 to 255};
+ ? {proto.index.in_range 0 to 511};
+ cod := proto.index.to_uinteger_32 | (c << 9) | (l << 17);
+ CONVERT[UINTEGER_32,POSITION].on cod
+ );
+
+ //
+ // Localization.
+ //
+
+ - prototype:PROTOTYPE <- PROTOTYPE.prototype_list.item (code.to_integer & 01FFh);
+
+ - line:UINTEGER_32 <- code >> 17;
+
+ - column:UINTEGER_32 <- (code >> 9) & 0FFh;
+
+ //
+ // Information Generation.
+ //
+
+ - nb_warning:INTEGER;
+
+ - send_error <-
+ (
+ STD_ERROR.put_string msg_err;
+ is_verbose.if {
+ msg_err.print;
+ };
+ ((type_error != warning) || {is_warning}).if {
+ die_with_code exit_failure_code;
+ };
+ );
+
+ - put_error type:INTEGER text txt:ABSTRACT_STRING <-
+ (
+ type_error := type;
+ msg_err.clear;
+ type
+ .when syntax then {
+ msg_err.append "--SYNTAX-----------\n";
+ }.when semantic then {
+ msg_err.append "--SEMANTIC---------\n";
+ }.when warning then {
+ msg_err.append "--WARNING----------\n";
+ }.when message then {
+ msg_err.append "--MESSAGE----------\n";
+ };
+ msg_err.append txt;
+ );
+
+ - put_position <-
+ ( + pos:INTEGER;
+ + c,cols:UINTEGER_32;
+ + src:STRING;
+ + char:CHARACTER;
+ ? {code != 0};
+
+ msg_err.append "\nLine ";
+ line.append_in msg_err;
+ msg_err.append " column ";
+ column.append_in msg_err;
+ msg_err.append " in ";
+ msg_err.append (prototype.name);
+ msg_err.add_last '(';
+ msg_err.append (prototype.filename);
+ msg_err.append "):\n";
+ // Search begin line :
+ src := prototype.source;
+ pos := src.lower;
+ 1.to (line-1) do { l:INTEGER;
+ {src.item pos = '\n'}.until_do {
+ pos := pos + 1;
+ };
+ pos := pos + 1;
+ };
+ // copy line :
+ string_tmp.clear;
+ cols := column;
+ {(pos > src.upper) ||
+ {src.item pos='\n'}}.until_do {
+ char := src.item pos;
+ msg_err.add_last char;
+ (c < cols).if {
+ (char = '\t').if {
+ string_tmp.add_last '\t';
+ } else {
+ string_tmp.add_last ' ';
+ };
+ };
+ c := c + 1;
+ pos := pos + 1;
+ };
+ msg_err.add_last '\n';
+ msg_err.append string_tmp;
+ msg_err.append "^\n";
+ );
+
+ - extract_line:STRING <-
+ ( + pos:INTEGER;
+ + src:STRING;
+ + char:CHARACTER;
+
+ // Search begin line :
+ src := prototype.source;
+ pos := src.lower;
+ 1.to (line-1) do { l:INTEGER;
+ {src.item pos = '\n'}.until_do {
+ pos := pos + 1;
+ };
+ pos := pos + 1;
+ };
+ // copy line :
+ string_tmp.clear;
+ {
+ (pos > src.upper) ||
+ {src.item pos='\n'}
+ }.until_do {
+ char := src.item pos;
+ (char)
+ .when '\\' then { string_tmp.add_last '\\'; }
+ .when '"' then { string_tmp.add_last '\\'; };
+ string_tmp.add_last char;
+ pos := pos + 1;
+ };
+ (string_tmp.last.code = 0Dh).if {
+ string_tmp.remove_last 1;
+ };
+ STRING.create_from_string string_tmp
+ );
+
+Section Private
+
+ //
+ // Service manager
+ //
+
+ - type_error:INTEGER;
+
+ - msg_err:STRING := STRING.create 256;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/uml/private.li b/uml/private.li
new file mode 100644
index 0000000..a95a20e
--- /dev/null
+++ b/uml/private.li
@@ -0,0 +1,19 @@
+Section Header
+ + name :=PRIVATE;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ - parent_acces:ACCES:=ACCES;
+
+Section Public
+
+ //renvoit une chaine de caract�rs d�crivant le type d'acc�s
+ - get_type :ABSTRACT_STRING<-
+ (
+ "private"
+ );
+ //renvoit le type d'acc�s au format UML (-)
+ - get_uml_type :STRING_CONSTANT<-
+ (
+ "-"
+ );
diff --git a/uml/protected.li b/uml/protected.li
new file mode 100644
index 0000000..303ea0f
--- /dev/null
+++ b/uml/protected.li
@@ -0,0 +1,28 @@
+/******* Prototype qui herite de "acces" et qui instancie un acces "protected" *******/
+Section Header
+ + name :=PROTECTED;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_acces:ACCES:=ACCES;
+
+Section Private
+ - nom:STRING;
+
+Section Public
+
+ //renvoit une chaine de caract�rs d�crivant le type d'acc�s. Ici on renvoit le nom du prototype
+ - get_type :ABSTRACT_STRING<-
+ (
+ nom
+ );
+ //renvoit le type d'acc�s au format UML (*)
+ - get_uml_type :STRING_CONSTANT<-
+ (
+ "*"
+ );
+
+ - set_nom nom1:STRING <-
+ (
+ nom:=nom1;
+ );
diff --git a/uml/public.li b/uml/public.li
new file mode 100644
index 0000000..c57626f
--- /dev/null
+++ b/uml/public.li
@@ -0,0 +1,20 @@
+/******* Prototype qui herite de "acces" et qui instancie un acces "public" *******/
+Section Header
+ + name :=PUBLIC;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ - parent_acces:ACCES:=ACCES;
+
+Section Public
+ //renvoit une chaine de caract�rs d�crivant le type d'acc�s
+ - get_type :ABSTRACT_STRING<-
+ (
+ "public"
+ );
+ //renvoit le type d'acc�s au format UML (+)
+ - get_uml_type :STRING_CONSTANT<-
+ (
+ "+"
+ );
diff --git a/uml/svg_creator.li b/uml/svg_creator.li
new file mode 100644
index 0000000..19aee72
--- /dev/null
+++ b/uml/svg_creator.li
@@ -0,0 +1,202 @@
+Section Header
+ + name := SVG_CREATOR;
+ - author:="HILBERT Jerome (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gregoire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_object:OBJECT:=OBJECT;
+
+Section Private
+
+ + fichiers:ENS_FICHIERS;
+ + rectangles:ENS_RECTANGLES;
+ + x:INTEGER;
+ + y:INTEGER;
+ //le fichier SVG dans lequel on ecrit
+ + destination:STRING;
+
+Section Public
+ - make ef:ENS_FICHIERS to dest:STRING <-
+ (
+ fichiers:=ef;
+ ef.clean;
+/*
+ (fichiers.lower).to (fichiers.upper) do{ i:INTEGER;
+ fichiers.item i.print;
+ };
+*/
+ rectangles:=ENS_RECTANGLES.clone;
+ x:=10;
+ y:=10;
+ destination:=dest;
+ );
+
+ //parcours l'ensemble des fichiers. Pour chaque fichier on cherche s'il a deja tous ses parents place sur le diagramme. Des que c'est le cas on cree une
+ // nouvelle instance de FORME_RECTANGLES e partir du fichier et on lui assigne des coordonnees calculees en fonction de la position de ses parents.
+ // gere egalement le cas des morts-vivants.
+ - parcours_fichiers <-
+ (
+ // "debut :::::----------------------------------\n".print;
+ (fichiers.lower).to (fichiers.upper) do{ i:INTEGER;
+ // fichiers.item i.print;
+ };
+ {(fichiers.count)>(rectangles.count)}.while_do{
+ + h_max:INTEGER;
+ + ens_tmp:ENS_RECTANGLES;
+ + k:INTEGER;
+ ens_tmp:=ENS_RECTANGLES.create;
+ (fichiers.lower).to (fichiers.upper) do{ i:INTEGER;
+ + r:FORME_RECTANGLE;
+ r:=FORME_RECTANGLE.clone;
+ r.make_with_file (fichiers.item i);
+ h_max:=h_max.max (r.get_hauteur);
+ (rectangles.has (r.get_nom)).if_false{
+ + xm,ym,tmp:INTEGER;
+ // "svg_creator\n".print;
+ // fichiers.item i.print;
+
+ ((tmp:=(rectangles.has_all_parents (fichiers.item i) and fichiers))>0).if{
+ //"tmp :: ".print;tmp.print;'\n'.print;
+ (rectangles.lower).to (rectangles.upper) do{j:INTEGER;
+ +g:FORME_RECTANGLE;
+
+ g:=rectangles.item j;
+ (r.get_parents.has (g.get_nom)).if{
+ xm:= xm + g.get_x;
+ ym:=ym.max (g.get_y+g.get_hauteur);
+ r.ajout_coord(g);
+ };
+ };
+ ({r.get_parents.count == 0}||{tmp==2}).if{
+ (tmp==2).if{
+ ens_tmp.ajouter r;
+ };
+ xm:=x;
+ ym:=y;
+ modifie_coord_x (r.get_largeur);
+ }else{
+ xm:=xm/(r.get_parents.count);
+ ym:=ym+60;
+ };
+ r.set_coord (xm,ym);
+ rectangles.ajouter r;
+ ajuste_coord r with rectangles;
+ };
+ };
+ };
+ k:=ens_tmp.lower;
+ {k<=ens_tmp.upper}.while_do{
+ + xm,ym:INTEGER;
+ (rectangles.lower).to (rectangles.upper) do{j:INTEGER;
+ +g:FORME_RECTANGLE;
+
+ g:=rectangles.item j;
+ (ens_tmp.item k .get_parents.has (g.get_nom)).if{
+ xm:= xm + g.get_x;
+ ym:=ym.max (g.get_y+g.get_hauteur);
+ ens_tmp.item k .ajout_coord(g);
+ };
+ };
+ k:=k+1;
+ };
+ modifie_coord_y h_max;
+ };
+ //rectangles.print;
+ create_svg;
+ );
+// ecrit dans le fichier SVG destination tout le code SVG g�n�r� � partir de l'ensemble des rectangles.
+- create_svg <-
+(
+ + xy_max:FAST_ARRAY[INTEGER];
+ + buffer_svg1:STRING;
+ + lee:LIREETECRIRE;
+
+ lee:=LIREETECRIRE.clone;
+ lee.ouvrir_svg destination;
+ xy_max:=rectangles.get_xy_max;
+ buffer_svg1:=STRING.create 32;
+ buffer_svg1.copy "";
+ buffer_svg1.append "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<svg xmlns=\"http://www.w3.org/2000/svg\" x=\"0\" y=\"0\" width=\"";
+ xy_max.item 0 .append_in buffer_svg1;
+ buffer_svg1.append "\" height=\"";
+ xy_max.item 1 .append_in buffer_svg1;
+ buffer_svg1.append "\"> <g>\n";
+ lee.ecrire_svg buffer_svg1;
+ (rectangles.lower).to (rectangles.upper) do{i:INTEGER;
+ + r:FORME_RECTANGLE;
+ + er:ENS_RECTANGLES;
+ + buffer_svg:STRING;
+ r:=rectangles.item i;
+ buffer_svg:=STRING.create 20;
+ buffer_svg.copy "";
+ buffer_svg.append (SVG_FORMES.rectangle r);
+ er:=r.get_couples;
+ (er.lower).to (er.upper) do{ j:INTEGER;
+ + p:FORME_RECTANGLE;
+
+ p:=er.item j;
+ buffer_svg.append (SVG_FORMES.trait p between r with rectangles);
+ };
+ lee.ecrire_svg buffer_svg;
+ };
+ buffer_svg1:=STRING.create 12;
+ buffer_svg1.copy "</g> </svg>\n";
+ lee.ecrire_svg buffer_svg1;
+ lee.fermer_svg;
+);
+
+//ajuste les coordonnees d'un rectangle en fonction de l'ensembles des rectangles. Permet d'eviter les collisions entre les rectangles.
+- ajuste_coord fr:FORME_RECTANGLE with er:ENS_RECTANGLES <-
+(
+ (er.lower).to (er.upper) do{i:INTEGER;
+ + p:FORME_RECTANGLE;
+ + y1,y2,y3,y4:INTEGER;
+
+ p:=er.item i;
+ y1:=fr.get_y;
+ y2:=y1+fr.get_hauteur;
+ y3:=p.get_y;
+ y4:=y3+p.get_hauteur;
+ ({{{y1<=y3}&&{y2>=y3}}||{{y1<=y4}&&{y2>=y4}}||{{y2<=y4}&&{y1>=y3}}} && {(p.get_nom)!=(fr.get_nom)}).if{
+ + x1,x2,x3,x4:INTEGER;
+
+ x1:=fr.get_x-20;
+ x2:=x1+fr.get_largeur+40;
+ x3:=p.get_x;
+ x4:=x3+p.get_largeur;
+ ({x1<=x3}&&{x2>x3}).if{
+ p.decal (x2-x3);
+ ajuste_coord p with er;
+ }else{
+ ({x2>=x4}&&{x1<x4}).if{
+ ((x3+(x1-x4))>=0).if{
+ p.decal (x1-x4);
+ ajuste_coord p with er;
+ }else{
+ fr.decal (x4-x1);
+ ajuste_coord fr with er;
+ };
+ }else{
+
+ ({x1>=x3}&&{x2<=x4}).if{
+ p.decal (x2-x3);
+ ajuste_coord p with er;
+ };
+ };
+ };
+ };
+
+ };
+
+);
+- modifie_coord_x coordx:INTEGER <-
+(
+ x:=x+coordx + 20;
+);
+- modifie_coord_y coordy:INTEGER <-
+(
+ y:=y+ coordy +60;
+ x:=10;
+);
+
+
diff --git a/uml/svg_file.li b/uml/svg_file.li
new file mode 100644
index 0000000..5fb45d7
--- /dev/null
+++ b/uml/svg_file.li
@@ -0,0 +1,44 @@
+Section Header
+
+ + name:=SVG_FILE;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+
+ + parent_file:STD_FILE := STD_FILE;
+
+Section Entry
+
+ - make e:ENTRY :BOOLEAN <-
+ (
+ parent_entry := e;
+ physical_open
+ );
+
+Section Public
+
+ //ouverture du fichier en �criture, s'il n'existe pas le fichier sera cr��
+ - physical_open:BOOLEAN <-
+ ( + path_pointer:NATIVE_ARRAY[CHARACTER];
+ ? { name != NULL};
+ path_pointer := path.to_external;
+ stream := `fopen((char*)@path_pointer,"w+b")`:(POINTER);
+ stream != NULL
+ );
+
+Section ENTRY
+
+ //ouverture du fichier svg
+ - open e:ENTRY :ENTRY <-
+ // Return SVG_FILE, NULL:error.
+ (
+ parent_entry:=e;
+ link_count := link_count + 1;
+ (child = NULL).if {
+ child := SVG_FILE.clone;
+ };
+ (child.make this).if_false {
+ child := NULL;
+ };
+ child
+ );
\ No newline at end of file
diff --git a/uml/svg_formes.li b/uml/svg_formes.li
new file mode 100644
index 0000000..56d954d
--- /dev/null
+++ b/uml/svg_formes.li
@@ -0,0 +1,289 @@
+Section Header
+ + name := SVG_FORMES;
+ - author:="HILBERT J�r�me (hilbertjerome at gmail.com), FUHLHABER Simon(simon.fuhlhaber at gmail.com), Jacquemin Gr�goire(greg-jacquemin at hotmail.fr)";
+
+Section Inherit
+ + parent_object:OBJECT:=OBJECT;
+
+Section Public
+ //CREATION DU CODE SVG POUR UN RECTANGLE
+ - rectangle f:FORME_RECTANGLE :STRING <-
+ (
+ + esp_ligne:INTEGER;
+ + chaine,tmp_string:STRING;
+ + x,y,posx1,posx2,posy1,posy2:INTEGER;
+ esp_ligne:=12;
+ x:=f.get_x +10;
+ y:=f.get_y +20;
+ posx1:=x+10;
+ posy1:=y+10;
+ posx2:=f.get_largeur;
+ posy2:=y+esp_ligne;
+ chaine:=STRING.create 256;
+ chaine.copy "<rect width=\"";
+ posx2.append_in chaine;
+ chaine.append "\" height=\"";
+ f.get_hauteur.append_in chaine;
+ chaine.append "\" x=\"";
+ f.get_x.append_in chaine;
+ chaine.append "\" y=\"";
+ f.get_y.append_in chaine;
+ chaine.append "\" fill=\"white\" stroke=\"black\" stroke-width=\"2\"/>\n";
+ chaine.append "<line x1=\"";
+ f.get_x.append_in chaine;
+ chaine.append "\" y1=\"";
+ posy1.append_in chaine;
+ chaine.append "\" x2=\"";
+ (f.get_x+f.get_largeur).append_in chaine;
+ chaine.append "\" y2=\"";
+ posy1.append_in chaine;
+ chaine.append "\" stroke=\"black\"/>\n";
+ tmp_string:=STRING.create (f.get_nom.count+1);
+ tmp_string.copy (f.get_nom);
+ tmp_string.append "\n";
+ chaine.append (get_text tmp_string at x and y with_size 12);
+ posy1:=posy1+20;
+ chaine.append (get_text (f.get_text_attributs) at x and posy1 with_size 10);
+ posy1:=posy1+(esp_ligne*(f.get_attributs.get_nb_lignes)+5);
+ chaine.append "<line x1=\"";
+ f.get_x.append_in chaine;
+ chaine.append "\" y1=\"";
+ posy1.append_in chaine;
+ chaine.append "\" x2=\"";
+ (f.get_x+f.get_largeur).append_in chaine;
+ chaine.append "\" y2=\"";
+ posy1.append_in chaine;
+ chaine.append "\" stroke=\"black\"/>\n";
+ posy1:=posy1+20;
+ chaine.append (get_text (f.get_text_methodes) at x and posy1 with_size 10);
+ chaine
+ );
+ //CREATION DU CODE SVG POUR UN TRAIT
+ - trait pere:FORME_RECTANGLE between fils:FORME_RECTANGLE with er:ENS_RECTANGLES :STRING <-
+ (
+ + c:STRING;
+ + posx1,posy1,posx2,posy2:UREAL_16_16;
+ + angle:REAL;
+ + points:LINKED_LIST[FAST_ARRAY[INTEGER]];
+ + point:FAST_ARRAY[INTEGER];
+ + rectangles:ENS_RECTANGLES;
+ + chaine:STRING;
+ + i:INTEGER;
+
+ rectangles:=ENS_RECTANGLES.clone;
+ rectangles.copy er;
+
+ point:=FAST_ARRAY[INTEGER].create 2;
+
+ c:=STRING.create 1024;
+ chaine:=STRING.create 1024;
+
+ rectangles.remove_parent pere;
+
+ points:=collision rectangles with ((fils.get_x+((fils.get_largeur)/2)),(fils.get_y)) between ((pere.get_x+(pere.get_largeur)/2),(pere.get_y+pere.get_hauteur));
+
+ ((pere.get_y+pere.get_hauteur)>=(points.last.item 1)).if{
+ point.put (pere.get_x+(pere.get_largeur)/2) to 0;
+ point.put ((pere.get_y+pere.get_hauteur)+30) to 1;
+ points.add_last point;
+ };
+ i:=points.lower;
+ chaine.copy "";
+ {i<(points.upper)}.while_do{
+ + x1,y1,x2,y2:INTEGER;
+
+ x1:=points.item i .item 0;
+ y1:=points.item i .item 1;
+ x2:=points.item (i+1) .item 0;
+ y2:=points.item (i+1) .item 1;
+ chaine.append "<line x1=\"";
+ x1.append_in chaine;
+ chaine.append "\" y1=\"";
+ y1.append_in chaine;
+ chaine.append "\" x2=\"";
+ x2.append_in chaine;
+ chaine.append "\" y2=\"";
+ y2.append_in chaine;
+ chaine.append "\" stroke=\"black\"/>\n";
+ i:=i+1;
+ };
+ c.copy "";
+ c.append chaine;
+ posx1:=(pere.get_x.to_ureal_16_16) +(pere.get_largeur.to_ureal_16_16)/2;
+ posy1:=(pere.get_y+pere.get_hauteur).to_ureal_16_16;
+ posx2:=(points.last.item 0).to_ureal_16_16;
+ posy2:=(points.last.item 1).to_ureal_16_16;
+
+ angle:=(((posx1-posx2).abs)/(posy2-posy1)).to_real.atan;
+ (posx1>posx2).if{posx1:=posx1-((angle.sin))*20;}else{posx1:=posx1+((angle.sin))*20;};
+ posy1:=posy1+((angle.cos))*15;
+ c.append "<defs> <marker id=\"Triangle\" viewBox=\"0 0 10 10\" refX=\"0\" refY=\"5\" markerUnits=\"strokeWidth\" markerWidth=\"15\" markerHeight=\"20\" ";
+ c.append "orient=\"auto\"> <path d=\"M 0 0 L 10 5 L 0 10 z\" /> </marker> </defs> <path d=\"M ";
+ posx2.append_in c;
+ c.append " ";
+ posy2.append_in c;
+ c.append " L ";
+ posx1.append_in c;
+ c.append " ";
+ posy1.append_in c;
+ c.append " \" fill=\"none\" stroke=\"black\" stroke-width=\"1\" marker-end=\"url(#Triangle)\" />\n";
+ c
+ );
+
+Section Private
+
+ //CREATION DU CODE SVG POUR L'AFFICHAGE DE TEXTE
+ - get_text text:STRING at x:INTEGER and y:INTEGER with_size size:INTEGER :STRING <-
+ (
+ + svg:STRING;
+ + index1:INTEGER;
+ + index2,y_tmp:INTEGER;
+ svg:=STRING.create 256;
+ index1:=1;
+ index2:=1;
+ y_tmp:=y;
+ svg.copy "";
+ text.right_adjust;
+ text.left_adjust;
+ // text.append "\n";
+ {(index2 < text.upper) && {(index2:=text.substring_index ("\n",index2+1))!=0}}.while_do{
+ svg.append "<text x=\"";
+ x.append_in svg;
+ svg.append "\" y=\"";
+ y_tmp.append_in svg;
+ svg.append "\" fill=\"black\" font-size=\"";
+ size.append_in svg;
+ svg.append "\">";
+ svg.append (text.substring index1 to (index2-1));
+ svg.append "</text>\n";
+ y_tmp:=y_tmp+12;
+ index1:=index2+1;
+ };
+ svg
+ );
+ //METHODE RECURSIVE POUR TRAITER LES COLLISIONS DES TRAITS AVEC LES RECTANGLES
+ - collision rectangles:ENS_RECTANGLES with (x1,y1:INTEGER) between (x2,y2:INTEGER) :LINKED_LIST[FAST_ARRAY[INTEGER]] <-
+ (
+ + points:LINKED_LIST[FAST_ARRAY[INTEGER]];
+ + tmp,point:FAST_ARRAY[INTEGER];
+ + i:INTEGER;
+ + rectxy:ENS_RECTANGLES;
+
+
+ points:=LINKED_LIST[FAST_ARRAY[INTEGER]].create;
+ tmp:=FAST_ARRAY[INTEGER].create 2;
+ tmp.put x1 to 0;
+ tmp.put y1 to 1;
+ points.add_last tmp;
+
+ rectxy:=ENS_RECTANGLES.clone;
+ rectxy.copy rectangles;
+
+ rectxy.remove_not_influent_parents (x1,y1) with (x2,y2);
+ rectxy.bofferding (x1,y1);
+
+ i:=rectxy.lower;
+ {i<=rectxy.upper}.while_do{
+ point:=intersection (x1,y1) and (x2,y2) with (rectxy.item i);
+ ((point.item 0)!=0).if{
+ points.append_collection (collision rectangles with (x1,y1) between ((point.item 0),(point.item 1)));
+ points.append_collection (collision rectangles with ((point.item 0),(point.item 1)) between (x2,y2));
+ i:=rectangles.upper;
+ };
+ i:=i+1;
+ };
+ points
+ );
+
+Section Public
+
+ //RENVOIE A ET B DE L' EQUATION AX + B PASSANT PAR LES POINTS X1,Y1 ET X2,Y2
+ - get_function x1:INTEGER and y1:INTEGER with x2:INTEGER and y2:INTEGER :FAST_ARRAY[UREAL_16_16] <-
+ (
+ + xy :FAST_ARRAY[UREAL_16_16];
+ + a,b:UREAL_16_16;
+
+ xy:=FAST_ARRAY[UREAL_16_16].create 2;
+ xy.put 0 to 0;
+ xy.put 0 to 1;
+ (x1!=x2).if{
+ a:=((y1-y2).to_ureal_16_16)/((x1-x2).to_ureal_16_16);
+ b:=(y1.to_ureal_16_16) -(a*(x1.to_ureal_16_16));
+ xy.put a to 0;
+ xy.put b to 1;
+ }else{
+ xy.put 0 to 0;
+ xy.put x1 to 1;
+ };
+ xy
+ );
+ //TROUVE LE POINT D'INTERSECTION DU TRAIT AVEC LE RECTANGLE ET CALCUL UN POINT POUR LA DEVIATION DU TRAIT
+ - intersection (x1,y1:INTEGER) and (x2,y2:INTEGER) with rect:FORME_RECTANGLE :FAST_ARRAY[INTEGER] <-
+ (
+ + point:FAST_ARRAY[INTEGER];
+ + abs,abs2,ord:INTEGER;
+ + xy:FAST_ARRAY[UREAL_16_16];
+
+ xy:=get_function x1 and y1 with x2 and y2;
+ point:=FAST_ARRAY[INTEGER].create 2;
+ point.put 0 to 0;
+ point.put 0 to 1;
+ ((xy.item 0) == 0).if{
+ abs:=(xy.item 1).to_integer;
+ }else{
+ abs:=(((((rect.get_y + rect.get_hauteur).to_ureal_16_16)-(xy.item 1))/(xy.item 0)).to_integer);
+ // abs2:=((((rect.get_y.to_ureal_16_16)-(xy.item 1))/(xy.item 0)).to_integer);
+ };
+ ({(rect.get_x)<=abs2}&&{((rect.get_x+rect.get_largeur))>=abs2}).if{
+ (abs2>=((rect.get_x)+((rect.get_largeur)/2))).if{
+ point.put ((rect.get_x+rect.get_largeur+rect.get_right)) to 0;
+ rect.update_right;
+ }else{
+ point.put ((rect.get_x-rect.get_left)) to 0;
+ rect.update_left;
+ };
+ point.put ((rect.get_y+rect.get_hauteur)) to 1;
+ };
+ ({(rect.get_x)<=abs}&&{((rect.get_x+rect.get_largeur))>=abs}).if{
+ (abs>=((rect.get_x)+((rect.get_largeur)/2))).if{
+ point.put ((rect.get_x+rect.get_largeur+rect.get_right)) to 0;
+ rect.update_right;
+ }else{
+ point.put ((rect.get_x-rect.get_left)) to 0;
+ rect.update_left;
+ };
+ point.put ((rect.get_y+rect.get_hauteur)) to 1;
+ }else{
+ ((xy.item 0) == 0).if_false{
+ ((xy.item 0)>=0).if{
+ ord:=((xy.item 0) * (((rect.get_x)+(rect.get_largeur)).to_ureal_16_16) + (xy.item 1)).to_integer;
+ ({ord>=(rect.get_y)}&&{ord<=((rect.get_y+rect.get_hauteur))}).if{
+ ({(xy.item 0)> 1}||{y1<(rect.get_y+rect.get_hauteur)}).if{
+ point.put ((rect.get_x+rect.get_largeur+rect.get_right)) to 0;
+ point.put ((rect.get_y-rect.get_right)) to 1;
+ rect.update_right;
+ }else{
+ point.put ((rect.get_x-rect.get_left)) to 0;
+ point.put ((rect.get_y+rect.get_hauteur)) to 1;
+ rect.update_left;
+ };
+
+ };
+ }else{
+ ord:=((xy.item 0) * ((rect.get_x).to_ureal_16_16) + (xy.item 1)).to_integer;
+ ({ord>=(rect.get_y)}&&{ord<=((rect.get_y+rect.get_hauteur))}).if{
+ ({(xy.item 0)< -1}||{y1<(rect.get_y+rect.get_hauteur)}).if{
+ point.put ((rect.get_x-rect.get_left)) to 0;
+ point.put ((rect.get_y-rect.get_left)) to 1;
+ rect.update_left;
+ }else{
+ point.put (rect.get_x+rect.get_largeur+rect.get_right) to 0;
+ point.put (rect.get_y+rect.get_hauteur) to 1;
+ rect.update_right;
+ };
+ };
+ };
+ };
+ };
+ point
+ );
\ No newline at end of file
diff --git a/gl_test/test_any.li b/uml/test_ben.li
similarity index 70%
copy from gl_test/test_any.li
copy to uml/test_ben.li
index 85558a4..0501ec8 100644
--- a/gl_test/test_any.li
+++ b/uml/test_ben.li
@@ -1,53 +1,59 @@
-///////////////////////////////////////////////////////////////////////////////
-// Application //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// 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 3 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, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-
-Section Header
-
- + name := TEST_ANY;
-
- - author := "Damien Bouvarel(dams.bouvarel at wanadoo.fr)";
-
-Section Inherit
-
- - parent_object:OBJECT := OBJECT;
-
-Section Public
-
- - start_test scene:SCENE <-
- (
- OPENGL.make (800,600) title "GL Demo test" fullscreen FALSE;
- ENGINE.make OPENGL;
-
- "*** GL Engine ***\n".print;
-
- ENGINE.attach_scene scene;
- ENGINE_INPUT.add_key_listener MY_EVENT_LISTENER;
- ENGINE_INPUT.add_mouse_listener MY_EVENT_LISTENER;
-
- ENGINE.initialize;
-
- //ENGINE.track_errors;
-
- ENGINE.main_loop;
-
- ENGINE.shutdown;
- OPENGL.shutdown;
- );
+///////////////////////////////////////////////////////////////////////////////
+// Application //
+// //
+// LSIIT - ULP - CNRS - INRIA - FRANCE //
+// //
+// 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 3 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, see <http://www.gnu.org/licenses/>. //
+// //
+// http://isaacproject.u-strasbg.fr/ //
+///////////////////////////////////////////////////////////////////////////////
+Section Header
+
+ + name := TEST_BEN;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Public
+
+ - main <-
+ ( + entry:ENTRY;
+ + file:STD_FILE;
+ + buf:STRING;
+ + is_ok:BOOLEAN;
+
+ entry := FILE_SYSTEM.get_entry "parser_ben.li";
+ (entry != NULL).if {
+ file ?= entry;
+ (file != NULL).if {
+ (file.open).if {
+ buf := STRING.create (file.size);
+ file.read buf size (file.size);
+ file.close;
+ PARSER_BEN.go_on buf;
+ is_ok := TRUE;
+ };
+ };
+ };
+ (is_ok).if_false {
+ "Error open file\n".print;
+ };
+ );
+
--
Lisaac library examples
More information about the Lisaac-commits
mailing list