[SCM] Lisaac compiler branch, master, updated. lisaac-0.12-382-ga6fc04c
Benoit Sonntag
sonntag at icps.u-strasbg.fr
Mon Aug 3 21:28:11 UTC 2009
The following commit has been merged in the master branch:
commit a6fc04cf567399693f37aa4d2c33d6d45b57563b
Author: Benoit Sonntag <sonntag at icps.u-strasbg.fr>
Date: Mon Aug 3 23:27:57 2009 +0200
bootstrap begin
diff --git a/lib2/number/integer.li b/lib2/number/integer.li
index 53ed552..125777e 100644
--- a/lib2/number/integer.li
+++ b/lib2/number/integer.li
@@ -528,7 +528,7 @@ Section Public
// Debug manager facility.
//
- - Self:SELF '?' blc:BLOCK <- blc ?# Self;
+ - Self:SELF '?' blc:{BOOLEAN} <- blc ?# Self;
Section INTEGER
diff --git a/src/.gitignore b/src2/.gitignore
similarity index 100%
copy from src/.gitignore
copy to src2/.gitignore
diff --git a/src2/any.li b/src2/any.li
new file mode 100644
index 0000000..2d6d7b4
--- /dev/null
+++ b/src2/any.li
@@ -0,0 +1,360 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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_any_option:ANY_OPTION := ANY_OPTION;
+
+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
+ );
+
+ //
+ // Compiler Options.
+ //
+
+ - debug_level_option:INTEGER;
+ - debug_with_code:BOOLEAN;
+
+ - is_all_warning:BOOLEAN;
+
+ - is_optimization:BOOLEAN;
+ - inline_level:INTEGER := 17;
+
+ - is_java:BOOLEAN; // Fuck the Java!
+
+ - is_statistic:BOOLEAN;
+ - is_quiet:BOOLEAN;
+
+ //
+ //
+ //
+
+ - verbose_level:INTEGER;
+ - is_verbose:BOOLEAN <- (verbose_level != 0);
+
+ //
+ // Other flags.
+ //
+
+ - is_cop:BOOLEAN;
+
+ - 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;
+
+ - is_executing_pass:BOOLEAN;
+
+ //
+ // 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_current: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;
+ - string_tmp3:STRING := STRING.create 256;
+ - string_tmp4:STRING := STRING.create 256;
+
+ //
+ // Path directory and command front end.
+ //
+
+ - path_file:FAST_ARRAY(STRING_CONSTANT) :=
+ FAST_ARRAY(STRING_CONSTANT).create_with_capacity 3000;
+
+ //
+ // 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;
+
+
diff --git a/src2/avoir.txt b/src2/avoir.txt
new file mode 100644
index 0000000..04d2dd3
--- /dev/null
+++ b/src2/avoir.txt
@@ -0,0 +1,10 @@
+./variable/section_.li
+./variable/variable.li
+./variable/slot.li
+./variable/local.li
+./variable/slot_code.li
+./variable/argument.li
+./variable/local_seq.li
+./variable/named.li
+./variable/slot_data.li
+
diff --git a/src2/avoir2.txt b/src2/avoir2.txt
new file mode 100644
index 0000000..bd54469
--- /dev/null
+++ b/src2/avoir2.txt
@@ -0,0 +1,7 @@
+lip_integer.li: - storage:FAST_ARRAY[LIP_INTEGER] := FAST_ARRAY[LIP_INTEGER].create_with_capacity 10;
+lip_slot_code.li: + code:FAST_ARRAY[LIP_CODE];
+lip_slot_code.li: code c:FAST_ARRAY[LIP_CODE] :LIP_SLOT_CODE <-
+lip_slot_code.li: ALIAS_ARRAY[LIP_CODE].free c;
+lip_slot_code.li: code c:FAST_ARRAY[LIP_CODE] <-
+lip_slot_data.li: [
+lip_string.li: - storage:FAST_ARRAY[LIP_STRING] := FAST_ARRAY[LIP_STRING].create_with_capacity 10;
diff --git a/src/clean b/src2/clean
similarity index 100%
copy from src/clean
copy to src2/clean
diff --git a/src2/code_life/call_slot.li b/src2/code_life/call_slot.li
new file mode 100644
index 0000000..00f372d
--- /dev/null
+++ b/src2/code_life/call_slot.li
@@ -0,0 +1,610 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := CALL_SLOT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Call slot method.";
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section Public
+
+ - count_no_recursive:INTEGER;
+ - count_context_sensitive:INTEGER;
+
+ - reset_count_no_recursive <-
+ (
+ count_no_recursive := 0;
+ );
+
+ - reset_count_context_sensitive <-
+ (
+ count_context_sensitive := 0;
+ );
+
+ + profil:PROFIL;
+
+ - set_profil p:PROFIL <-
+ (
+ profil := p;
+ );
+
+ - source:LIST <- profil.code;
+
+ - is_interrupt:BOOLEAN <- profil.is_interrupt;
+
+ - is_external:BOOLEAN <- profil.is_external;
+
+ //
+ // Argument.
+ //
+
+ + argument_list:FAST_ARRAY(WRITE);
+
+ + result_list:Expanded SLIM_ARRAY(RESULT);
+
+ + cop_argument:EXPR;
+
+ + is_cop_return:BOOLEAN;
+
+ - set_args args:FAST_ARRAY(WRITE) <-
+ (
+ argument_list := args;
+ );
+
+ - set_cop_argument arg:EXPR <-
+ (
+ cop_argument := arg;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION profil prof:PROFIL with l_arg:FAST_ARRAY(WRITE) cop arg:EXPR :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p profil prof with l_arg cop arg;
+ result
+ );
+
+ - make p:POSITION profil prof:PROFIL with l_arg:FAST_ARRAY(WRITE) cop arg:EXPR <-
+ ( + n:INTEGER;
+ position := p;
+ cop_argument := arg;
+ // Choice profil.
+ profil := prof;
+ argument_list := l_arg;
+ profil.link Self;
+ //
+ (is_interrupt).if {
+ n := 1;
+ } else {
+ n := profil.result_list.count;
+ };
+ result_list.make_with_capacity n;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+ + wrt:WRITE;
+ + new_arg:FAST_ARRAY(WRITE);
+ + res:RESULT;
+ result := clone;
+
+ new_arg := FAST_ARRAY(WRITE).create_with_capacity (argument_list.count);
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ (argument_list.item j = NULL).if {
+ wrt := NULL;
+ } else {
+ // No Alias := Alias.
+ wrt := argument_list.item j;
+ wrt := wrt.variable.write_direct (wrt.position) with NULL value (wrt.value.my_copy);
+ //wrt := argument_list.item j.my_copy;
+ };
+ new_arg.add_last wrt;
+ };
+ result.set_args new_arg;
+ (cop_argument != NULL).if {
+ result.set_cop_argument (cop_argument.my_copy);
+ };
+ //
+ result.result_list.make_with_capacity (result_list.count);
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ (result_list.item j = NULL).if {
+ res := NULL;
+ } else {
+ // Alias := No Alias.
+ res := result_list.item j.my_copy;
+ };
+ result.result_list.add_last res;
+ };
+ result.profil.link result;
+ result
+ );
+
+ //
+ // Generation.
+ //
+
+ - remove <-
+ ( + e:WRITE;
+
+ ((profil.link_count = 0) && {profil.cop_link_count = 0}).if { // BSBS: Debug...
+ "CALL_SLOT : ".print;
+ debug_display;
+ };
+
+ profil.unlink Self;
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ e := argument_list.item j;
+ (e != NULL).if {
+ e.remove;
+ };
+ };
+ (cop_argument != NULL).if {
+ cop_argument.remove;
+ };
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ result_list.item j.remove;
+ };
+ );
+
+Section Private
+
+ - execute_inline:(BOOLEAN,INSTR) <-
+ // Simple inlining
+ ( + result:INSTR;
+ + is_good:BOOLEAN;
+ + new_src:LIST;
+ + wrt:WRITE;
+ + old_val:EXPR;
+ + rd:READ_LOCAL;
+ + loc:LOCAL;
+ // + prof_block:PROFIL_BLOCK;
+
+ (source = list_current).if {
+ POSITION.put_error semantic text "Recursivity without end (call_slot).";
+ source.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+
+ (
+ (! is_interrupt) && {! is_external} &&
+ {(cop_argument = NULL) || {! profil.result_list.is_empty}}
+ ).if {
+ (profil.link_count = 1).if {
+ //
+ // Inlining simple.
+ //
+ (list_current.old_seq_or_and = seq_or_and).if {
+ argument_to_assignment source index 1 alias FALSE;
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ source.add_last (result_list.item j.write);
+ };
+ result := source.execute;
+ profil.remove_inline;
+ new_execute_pass;
+ is_good := TRUE;
+ };
+ }.elseif {profil.is_inlinable/* && {FALSE}*/} then {
+ //
+ // Inline by copy:
+ //
+ (list_current.old_seq_or_and = seq_or_and).if {
+ profil.unlink Self;
+ LOCAL.alias_on;
+ /*
+ "Write : ".print;
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ result_list.item j.debug_display;
+ };
+ "Source : ".print;
+ source.debug_display;
+ "--------------------\n".print;
+ */
+ new_src := source.my_copy;
+ argument_to_assignment new_src index 1 alias TRUE;
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ wrt := result_list.item j.write;
+ old_val := wrt.value;
+
+ rd ?= old_val;
+ loc := rd.local;
+ (loc.my_alias = NULL).if {
+ profil.slot.name.print; '\n'.print;
+ warning_error (position,"CALL_SLOT : Result bizarre!");
+ warning_error (profil.slot.position,"CALL_SLOT : Result bizarre!");
+ crash_with_message "CALL_SLOT: Result not affect!";
+ };
+ wrt.set_value (old_val.my_copy);
+ old_val.remove;
+ new_src.add_last wrt;
+ };
+ LOCAL.alias_off;
+ /*
+ "Copy:".print;
+ new_src.debug_display;
+ "===========================FIN============================\n".print;
+ */
+
+ result := new_src.execute;
+ is_good := TRUE;
+ new_execute_pass;
+ };
+ };
+ };
+ is_good,
+ result
+ );
+
+ - execute_normal <-
+ ( + wrt:WRITE_LOCAL;
+
+ // Pour l'instant ne change pas le profil
+ // il faut faire une copie de l'ancien !!
+
+ //profil := profil.update self link FALSE;
+
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ wrt ?= argument_list.item j;
+ (wrt != NULL).if {
+ (wrt.execute_argument).if {
+ new_execute_pass;
+ argument_list.put NULL to j;
+ (wrt.ensure_count = 0).if {
+ profil.argument_list.put NULL to j;
+ };
+ };
+ };
+ };
+ (cop_argument != NULL).if {
+ cop_argument := cop_argument.execute_link;
+ (
+ (! is_cop_return) &&
+ {profil_current != NULL} &&
+ {profil_current.cop_link_count != 0} &&
+ {profil_current.link_count = 0} &&
+ {profil_current.result_list.is_empty}
+ ).if {
+ // BSBS: Il faut produire reellement 2 versions (une COP et une non COP)
+ // Ainsi tu pourras generaliser l'optim et l'appliquer que sur la version COP.
+ is_cop_return := profil_current.i_am_the_last Self;
+ };
+ };
+ (profil.is_context_sensitive).if {
+ seq_call_local_and_loop := seq_call_local_and_loop + 1;
+ };
+ seq_call_and_loop := seq_call_and_loop + 1;
+ seq_inline := seq_inline + 1;
+
+ //
+ // Counter.
+ //
+ (! profil.is_recursive).if {
+ count_no_recursive := count_no_recursive + 1;
+ };
+ (profil.is_context_sensitive).if {
+ count_context_sensitive := count_context_sensitive + 1;
+ };
+ );
+
+Section Public
+
+ - execute:INSTR <-
+ ( + result:INSTR;
+ + is_good:BOOLEAN;
+
+ (profil.search_tail_recursive).if {
+ //
+ // Inline Tail recursive:
+ //
+ profil.remove_inline;
+ result := to_tail_recursive;
+ result.execute;
+ new_execute_pass;
+ } else {
+ (is_good,result) := execute_inline;
+ (! is_good).if {
+ execute_normal;
+ (source.is_empty).if {
+ // Suppression.
+ profil.unlink Self;
+ new_execute_pass;
+ } else {
+ result := Self;
+ profil.set_life;
+ };
+ };
+ };
+
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - display_style buffer:STRING <-
+ ( + t:HASHED_SET(TYPE);
+ buffer.append (profil.name);
+ buffer.add_last '(';
+
+ type_list.lower.to (type_list.upper) do { j:INTEGER;
+ t := type_list.item j;
+ t.lower.to (t.upper - 1) do { k:INTEGER;
+ buffer.append (t.item k.name);
+ buffer.add_last 'x';
+ };
+ buffer.append (t.last.name);
+ (j != type_list.upper).if {
+ buffer.add_last ',';
+ };
+ };
+ buffer.add_last ')';
+ );
+
+ - display buffer:STRING <-
+ ( + arg:WRITE;
+
+ buffer.append (profil.name);
+ display_ref buffer;
+ argument_list.is_empty.if {
+ buffer.append "()";
+ } else {
+ buffer.append "(";
+ argument_list.lower.to (argument_list.upper) do { j:INTEGER;
+ arg := argument_list.item j;
+ (arg = NULL).if {
+ buffer.append "<>"
+ } else {
+ arg.value.display buffer;
+ };
+ buffer.add_last ',';
+ };
+ buffer.put ')' to (buffer.upper);
+ };
+ );
+
+ - display_light <-
+ (
+ string_tmp.copy "CALL '";
+ string_tmp.append (profil.name);
+ string_tmp.append "' ";
+ string_tmp.append (position.prototype.intern_name);
+ //position.put_light_position_in(string_tmp);
+ string_tmp.append " --> ";
+ string_tmp.append (source.position.prototype.intern_name);
+ //source.position.put_light_position_in(string_tmp);
+ string_tmp.append " (Version ";
+ // string_tmp.append (proto_self_current.intern_name);
+ string_tmp.append ")\n";
+ string_tmp.print;
+ );
+
+ //////////////////////////////////////////////////////////////////////////
+ // CODE SLOT
+ //////////////////////////////////////////////////////////////////////////
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ ( + val:WRITE;
+ + arg:LOCAL;
+ + wrt:WRITE_LOCAL;
+ + np:INTEGER;
+ + low:INTEGER;
+ + back:INTEGER;
+
+ (cop_argument != NULL).if {
+ (
+ (argument_list.count >=1) &&
+ {argument_list.first != NULL} &&
+ {argument_list.first.variable.name = ALIAS_STR.variable_self}
+ ).if {
+ low := 1;
+ };
+ (argument_list.count-low > 0).if {
+ back := buffer.count;
+ buffer.append "pthread_mutex_lock (&(";
+ cop_argument.genere buffer;
+ buffer.append "->thread.mutex));\n";
+ (low).to (argument_list.upper) do { j:INTEGER;
+ val := argument_list.item j;
+ (val != NULL).if {
+ buffer.append indent;
+ cop_argument.genere buffer;
+ buffer.append "->param_";
+ np.append_in buffer;
+ buffer.append "=(int)";
+ val.genere_value buffer;
+ buffer.append ";\n";
+ np := np + 1;
+ } else {
+ "arg null\n".print;
+ };
+ };
+ buffer.append indent;
+ (np = 0).if {
+ buffer.keep_head back;
+ };
+ };
+ cop_argument.genere buffer;
+ buffer.append "->thread.procedure = COP_";
+ buffer.append (profil.name);
+ buffer.append ";\n";
+ buffer.append indent;
+ (is_cop_return).if {
+ buffer.append "return";
+ } else {
+ buffer.append "run_procedure";
+ };
+ buffer.append "((lith_object *)";
+ cop_argument.genere buffer;
+ buffer.add_last ')';
+ } else {
+ (result_list.is_empty).if_false {
+ wrt ?= result_list.first.write;
+ wrt.genere_first_result buffer;
+ };
+ buffer.append (profil.name);
+ (is_interrupt || {is_external}).if {
+ (argument_list.first != NULL).if {
+ semantic_error (argument_list.first.position,
+ "Impossible `Self' argument for External or Interrupt slot.");
+ };
+ };
+ (! is_interrupt).if {
+ buffer.add_last '(';
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ val := argument_list.item j;
+ arg := profil.argument_list.item j;
+ (val != NULL).if {
+ (buffer.last != '(').if {
+ buffer.add_last ',';
+ };
+ val.genere_value buffer;
+ };
+ };
+ (result_list.count > 1).if {
+ (result_list.lower+1).to (result_list.upper) do { j:INTEGER;
+ (buffer.last != '(').if {
+ buffer.add_last ',';
+ };
+ wrt ?= result_list.item j.write;
+ wrt.genere_argument_result buffer;
+ };
+ };
+ buffer.add_last ')';
+ };
+ };
+ );
+
+ //
+ // Intern routine.
+ //
+
+Section Private
+
+ - to_tail_recursive:LOOP <-
+ ( + switch:SWITCH;
+ + msg_slot:CALL_SLOT;
+ + body:LIST;
+ + wrt:WRITE;
+ + new_val:EXPR;
+ + new_wrt:INSTR;
+ + result:LOOP;
+
+ result := LOOP.create position name (profil.name) body source;
+
+ //
+ // Main List.
+ //
+
+ // Argument -> Affectation.
+ wrt := argument_list.first;
+ (wrt != NULL).if {
+ argument_list.put NULL to 0;
+ (! wrt.value.static_type.is_expanded).if {
+ new_val := CAST.create (wrt.static_type) value (wrt.value);
+ wrt.set_value new_val;
+ };
+ wrt.variable.set_style '+';
+ new_wrt := wrt.execute;
+ (new_wrt != NULL).if {
+ list_current.insert new_wrt to (list_current.index);
+ };
+ };
+ (argument_list.lower + 1).to (argument_list.upper) do { k:INTEGER;
+ wrt := argument_list.item k;
+ (wrt != NULL).if {
+ argument_list.put NULL to k;
+ wrt.variable.set_style '+';
+ new_wrt := wrt.execute;
+ (new_wrt != NULL).if {
+ list_current.insert new_wrt to (list_current.index);
+ };
+ };
+ };
+
+ (debug_level_option != 0).if {
+ ? { + push:PUSH;
+ push ?= source.first;
+ (push != NULL) && {push.is_first}
+ };
+ list_current.insert (source.first) to (list_current.index);
+ source.put NOP to (source.lower);
+ };
+
+ // Extract Switch/body:
+ switch ?= source.last;
+ (switch.list.lower).to (switch.list.upper) do { k:INTEGER;
+ body := switch.list.item k.code;
+ (body.is_empty).if_false {
+ msg_slot ?= body.last;
+ (msg_slot != NULL).if {
+ // DEBUG
+ (msg_slot = Self).if {
+ semantic_error (position,"CALL_SLOT : BUG!!!!");
+ };
+ (msg_slot.profil != profil).if {
+ semantic_error (position,"CALL_SLOT : BUG2!!!!");
+ };
+ // FIN DEBUG
+ msg_slot.argument_to_assignment body index (body.upper) alias FALSE;
+ body.put (LOOP_END.create (msg_slot.position) loop result) to (body.upper);
+ };
+ };
+ };
+ result
+ );
+
+ - argument_to_assignment lst:LIST index idx:INTEGER alias is_alias:BOOLEAN <-
+ ( + val,new_wrt:WRITE;
+ + loc:LOCAL;
+
+ // Argument -> Affectation.
+ (argument_list.upper).downto (argument_list.lower) do { k:INTEGER;
+ val := argument_list.item k;
+ (val != NULL).if {
+ argument_list.put NULL to k;
+ (is_alias).if {
+ loc ?= val.variable;
+ new_wrt := loc.write (val.position) value (val.value);
+ loc.unwrite val;
+ } else {
+ new_wrt := val;
+ };
+ lst.insert new_wrt to idx;
+ new_wrt.variable.set_style '+';
+ };
+ };
+ );
diff --git a/src/code_life/case.li b/src2/code_life/case.li
similarity index 100%
copy from src/code_life/case.li
copy to src2/code_life/case.li
diff --git a/src/code_life/cast.li b/src2/code_life/cast.li
similarity index 100%
copy from src/code_life/cast.li
copy to src2/code_life/cast.li
diff --git a/src/code_life/cop_lock.li b/src2/code_life/cop_lock.li
similarity index 100%
copy from src/code_life/cop_lock.li
copy to src2/code_life/cop_lock.li
diff --git a/src/code_life/cop_unlock.li b/src2/code_life/cop_unlock.li
similarity index 100%
copy from src/code_life/cop_unlock.li
copy to src2/code_life/cop_unlock.li
diff --git a/src2/code_life/expr.li b/src2/code_life/expr.li
new file mode 100644
index 0000000..f3176d0
--- /dev/null
+++ b/src2/code_life/expr.li
@@ -0,0 +1,219 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all expression";
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section Public
+
+ - cardinality:INTEGER <- 1;
+
+ //
+ // Comparison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <- FALSE;
+
+ - Self:SELF '!==' Right 60 other:EXPR :BOOLEAN <- ! (Self == other);
+
+ //
+ // Type.
+ //
+
+ - static_type:TYPE_FULL <-
+ (
+ deferred;
+ NULL
+ );
+
+ - get_type t:TYPES_TMP <- deferred;
+
+ //
+ // Flag.
+ //
+
+ - is_constant:BOOLEAN <- FALSE;
+
+ //
+ // Check type.
+ //
+
+ - check_type t:TYPE_FULL with p:POSITION :EXPR <-
+ ( + result:EXPR;
+ + local:VARIABLE;
+ + instr:INSTR;
+ + rec:EXPR;
+ + slot_name:STRING_CONSTANT;
+ + slot_msg:SLOT;
+ + node:NODE;
+ + args:FAST_ARRAY(EXPR);
+ + ts:ITM_TYPE_SIMPLE;
+
+ ? {static_type != NULL};
+ ? {t != NULL};
+
+ (t.affect_with static_type).if {
+ result := Self;
+ } else {
+ ? {list_current != NULL};
+ (static_type.is_export_to t).if {
+ // Auto-export.
+ local := static_type.get_temporary position;
+ instr := local.write position value Self;
+ list_current.add_last instr;
+ //
+ slot_name := ALIAS_STR.get (TYPE.last_cast_name);
+ slot_msg := static_type.get_slot slot_name;
+ (slot_msg = NULL).if {
+ string_tmp.clear;
+ static_type.append_name_in string_tmp;
+ string_tmp.append " -> ";
+ t.append_name_in string_tmp;
+ string_tmp.append ". Slot `";
+ string_tmp.append slot_name;
+ string_tmp.append "' not found in `";
+ static_type.append_name_in string_tmp;
+ string_tmp.append "'.";
+ POSITION.put_error semantic text string_tmp;
+ p.put_position;
+ static_type.prototype.position.put_position;
+ POSITION.send_error;
+ //semantic_error p,string_tmp;
+ };
+ (slot_msg.argument_count != 1).if {
+ semantic_error ((slot_msg.position),"No argument for this slot.");
+ };
+ ts ?= slot_msg.result_type;
+ ((ts = NULL) || {ts.to_run_for NULL != t}).if {
+ string_tmp.copy "Type result `";
+ slot_msg.result_type.append_in string_tmp;
+ string_tmp.append "' is incorrect (Used for auto-conversion to `";
+ t.append_name_in string_tmp;
+ string_tmp.append "').";
+ POSITION.put_error semantic text string_tmp;
+ slot_msg.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ //
+ rec := local.read position;
+ node := NODE.new_read position slot slot_msg
+ receiver rec self rec intern FALSE;
+ list_current.add_last node;
+ //
+ result := node.result_expr;
+ }.elseif {t.is_import_to static_type} then {
+ local := static_type.get_temporary position;
+ instr := local.write position value Self;
+ list_current.add_last instr;
+ //
+ slot_name := ALIAS_STR.get (TYPE.last_cast_name);
+ slot_msg := t.get_slot slot_name;
+ (slot_msg = NULL).if {
+ string_tmp.clear;
+ t.append_name_in string_tmp;
+ string_tmp.append " <- ";
+ static_type.append_name_in string_tmp;
+ string_tmp.append ". Slot `";
+ string_tmp.append slot_name;
+ string_tmp.append "' not found in `";
+ t.append_name_in string_tmp;
+ string_tmp.append "'.";
+ POSITION.put_error semantic text string_tmp;
+ p.put_position;
+ t.prototype.position.put_position;
+ POSITION.send_error;
+ //semantic_error p,string_tmp;
+ };
+ (slot_msg.argument_count != 2).if {
+ semantic_error ((slot_msg.position),"Incorrect argument for this slot.");
+ };
+ ts ?= slot_msg.result_type;
+ ((ts = NULL) || {ts.to_run_for NULL != t}).if {
+ string_tmp.copy "Type result `";
+ slot_msg.result_type.append_in string_tmp;
+ string_tmp.append "' is incorrect (Used for auto-conversion to `";
+ t.append_name_in string_tmp;
+ string_tmp.append "').";
+ POSITION.put_error semantic text string_tmp;
+ slot_msg.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ //
+ args := FAST_ARRAY(EXPR).create_with_capacity 2;
+ args.add_last (PROTOTYPE_CST.create position type t);
+ args.add_last (local.read position);
+ node := NODE.new_read position slot slot_msg
+ receiver (args.first.my_copy) with args intern FALSE;
+ list_current.add_last node;
+ //
+ result := node.result_expr;
+ } else {
+ // Type Error
+ string_tmp.copy "Type `";
+ t.append_name_in string_tmp;
+ string_tmp.append "' is invalid with `";
+ static_type.append_name_in string_tmp;
+ string_tmp.append "'.";
+ POSITION.put_error semantic text string_tmp;
+ p.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ };
+ result
+ );
+
+ //
+ // Execute.
+ //
+
+ - execute:INSTR <-
+ (
+ execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ (
+ deferred;
+ NULL
+ );
+ //[ ? {Result != NULL}; ];
+
+ - execute_unlink:INSTR <-
+ (
+ deferred;
+ NULL
+ );
+
+
+
diff --git a/src2/code_life/expr_multiple.li b/src2/code_life/expr_multiple.li
new file mode 100644
index 0000000..0f0dab4
--- /dev/null
+++ b/src2/code_life/expr_multiple.li
@@ -0,0 +1,138 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_MULTIPLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Multiple expression manager";
+
+ // BSBS: Utiliser ca une seule fois ! cela doit etre possible!
+
+Section Inherit
+
+ - parent_expr:EXPR := EXPR;
+
+Section Public
+
+ + expr_list:FAST_ARRAY(EXPR);
+
+ - cardinality:INTEGER <- expr_list.count;
+
+ - static_type:TYPE_FULL <-
+ (
+ expr_list.first.static_type
+ );
+
+ - get_type t:TYPES_TMP <-
+ (
+ crash_with_message "EXPR_MULTIPLE.get_type";
+ );
+
+ //
+ // Creation
+ //
+
+ // BSBS: Optim : Il faut que ce soit alouer et free après !!!
+ - create l:FAST_ARRAY(EXPR) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make l;
+ result
+ );
+
+ - make l:FAST_ARRAY(EXPR) <-
+ (
+ expr_list := l;
+ position := l.last.position;
+ );
+
+ - my_copy:SELF <-
+ ( + new_lst:FAST_ARRAY(EXPR);
+
+ new_lst := FAST_ARRAY(EXPR).create_with_capacity (expr_list.count);
+ (expr_list.lower).to (expr_list.upper) do { j:INTEGER;
+ new_lst.add_last (expr_list.item j.my_copy);
+ };
+ SELF.create new_lst
+ );
+
+ //
+ // Remove.
+ //
+
+ - remove <-
+ (
+ (expr_list.lower).to (expr_list.upper) do { j:INTEGER;
+ expr_list.item j.remove;
+ };
+ );
+
+ //
+ // Execute.
+ //
+
+ - execute_unlink:INSTR <-
+ (
+ (expr_list.lower).to (expr_list.upper) do { j:INTEGER;
+ expr_list.item j.remove;
+ };
+ NULL
+ );
+
+ - execute_link:EXPR <-
+ (
+ list_current.debug_display;
+ crash_with_message "EXPR_MULTIPLE.execute_link";
+ NULL
+ );
+
+ //
+ // Access facility.
+ //
+
+ - lower:INTEGER <- expr_list.lower;
+ - upper:INTEGER <- expr_list.upper;
+
+ - item i:INTEGER :EXPR <- expr_list.item i;
+ - last:EXPR <- expr_list.last;
+ - first:EXPR <- expr_list.first;
+
+ - count:INTEGER <- expr_list.count;
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ (expr_list.lower).to (expr_list.upper - 1) do { j:INTEGER;
+ expr_list.item j.display buffer;
+ buffer.add_last ',';
+ };
+ expr_list.last.display buffer;
+ buffer.add_last ')';
+ );
+
\ No newline at end of file
diff --git a/src/code_life/instr.li b/src2/code_life/instr.li
similarity index 100%
copy from src/code_life/instr.li
copy to src2/code_life/instr.li
diff --git a/src2/code_life/list.li b/src2/code_life/list.li
new file mode 100644
index 0000000..2baa6db
--- /dev/null
+++ b/src2/code_life/list.li
@@ -0,0 +1,357 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Expression list, immediate evaluation";
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section Private
+
+ + expr_list:FAST_ARRAY(INSTR);
+
+Section Public
+
+ - is_invariant:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ result := TRUE;
+ j := expr_list.lower;
+ {(j <= expr_list.upper) && {result}}.while_do {
+ result := expr_list.item j.is_invariant;
+ j := j + 1;
+ };
+ result
+ );
+
+ - old_seq_or_and:UINTEGER_32;
+
+ //
+ // Linked list INSTR.
+ //
+
+ - lower:INTEGER <- expr_list.lower + 1;
+ - upper:INTEGER <- expr_list.upper + 1;
+ - count:INTEGER <- expr_list.count;
+
+ - first:INSTR <- expr_list.first;
+ - second:INSTR <- expr_list.second;
+
+ - item i:INTEGER :INSTR <- expr_list.item (i-1);
+
+ - current_item:INSTR <- expr_list.item index;
+
+ - last:INSTR <- expr_list.last;
+
+ - add_first i:INSTR <-
+ (
+ expr_list.add_first i;
+ );
+
+ - add_last i:INSTR <-
+ (
+ expr_list.add_last i;
+ );
+
+ - add e:INSTR to idx:INTEGER <-
+ (
+ expr_list.add e to (idx-1);
+ );
+
+ - put e:INSTR to idx:INTEGER <-
+ (
+ expr_list.put e to (idx-1);
+ );
+
+ - remove_last <-
+ (
+ expr_list.remove_last;
+ );
+
+ - remove_index idx:INTEGER <-
+ (
+ expr_list.remove (idx-1);
+ );
+
+ //
+ // Iterator.
+ //
+
+ + index:INTEGER;
+
+ - inc_index <-
+ (
+ index := index + 1;
+ );
+
+ - insert_before e:INSTR <-
+ (
+ ? {e != NULL};
+ expr_list.add e to (index - 1);
+ index := index + 1;
+ );
+
+ - insert e:INSTR to idx:INTEGER <-
+ (
+ ? {e != NULL};
+ expr_list.add e to (idx - 1);
+ (idx <= index).if {
+ index := index + 1;
+ };
+ );
+
+ //
+ // Flags.
+ //
+
+ - is_empty:BOOLEAN <- count = 0;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p;
+ result
+ );
+
+ - make p:POSITION <-
+ (
+ new_depend_pass;
+ position := p;
+ expr_list := FAST_ARRAY(INSTR).create_with_capacity 2;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+
+ result := SELF.create position;
+ (lower).to (upper) do { j:INTEGER;
+ result.add_last (item j.my_copy);
+ };
+ result
+ );
+
+ //
+ // Remove.
+ //
+
+ - remove <-
+ (
+ (lower).to (upper) do { j:INTEGER;
+ item j.remove;
+ };
+ );
+
+ //
+ // Execute.
+ //
+
+ - i_am_the_last i:INSTR :BOOLEAN <-
+ (
+ last.i_am_the_last i
+ );
+
+ - execute:INSTR <-
+ ( + result:INSTR;
+
+ execute_case;
+
+ (list_current != NULL).if {
+ // Fusion list.
+ (expr_list.is_empty).if_false {
+ lower.to (upper-1) do { j:INTEGER;
+ list_current.insert_before (item j);
+ };
+ result := last;
+ ? {result != NULL};
+ new_execute_pass;
+ };
+ } else {
+ result := Self;
+ };
+ result
+ );
+
+ - execute_case <-
+ ( + new_expr:INSTR;
+ + old_list_current:LIST;
+
+ //
+ seq_list.add_last Self;
+ seq_inline := seq_inline + 1;
+
+ // Update Context.
+ old_list_current := list_current;
+ list_current := Self;
+
+ // Execute expression list.
+ ? {index = 0};
+ index := lower;
+ {index <= upper}.while_do {
+ old_seq_or_and := seq_or_and;
+ new_expr := item index.execute;
+ (new_expr != NULL).if {
+ put new_expr to index;
+ index := index + 1;
+ (new_expr = CALL_NULL).if {
+ // Delete all ...
+ {index <= upper}.while_do {
+ item index.remove;
+ remove_index index;
+ };
+ };
+ } else {
+ remove_index index;
+ };
+ };
+
+ // Last.
+ old_seq_or_and := seq_or_and;
+ index := 0; // Debug necessity
+
+ // Restore Context.
+ list_current := old_list_current;
+ //
+ seq_list.remove_last;
+ seq_inline := seq_inline + 1;
+ );
+
+Section Public
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.append "{\n";
+ indent.append " ";
+
+ genere_body buffer;
+
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.add_last '}';
+ );
+
+ - genere_extern buffer:STRING <-
+ ( + pos_local:INTEGER;
+
+ // Local.
+ pos_local := buffer.count+1;
+ stack_local.clear;
+
+ genere_body buffer;
+
+ // Local.
+ string_tmp.clear;
+ add_local (var_size.item 3) in string_tmp; // 64 bits
+ add_local (var_size.item 2) in string_tmp; // 32 bits
+ add_local (var_size.item 1) in string_tmp; // 16 bits
+ add_local (var_size.item 0) in string_tmp; // 8 bits
+ buffer.insert_string string_tmp to pos_local;
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ // Begin List.
+ buffer.add_last '(';
+
+ // Code.
+ buffer.add_last '\n';
+ indent.append " ";
+
+ (lower).to (upper) do { j:INTEGER;
+ buffer.append indent;
+ item j.display buffer;
+ buffer.add_last '\n';
+ };
+ indent.remove_last 2;
+ buffer.append indent;
+
+ // End List.
+ buffer.add_last ')';
+ display_ref buffer;
+ );
+
+Section Private
+
+ - genere_body buffer:STRING <-
+ ( + old_count,j:INTEGER;
+ j := lower;
+ {j <= upper}.while_do {
+ buffer.append indent;
+ old_count := buffer.count;
+ {
+ item j.genere buffer;
+ j := j + 1;
+ }.do_while {(j <= upper) && {old_count = buffer.count}};
+ buffer.append ";\n";
+ };
+ );
+
+ - add_local tab:FAST_ARRAY(LOCAL) in buf:STRING <-
+ ( + loc:LOCAL;
+ + t:TYPE_FULL;
+ + cur:INTEGER;
+
+ (! tab.is_empty).if {
+ (tab.lower).to (tab.upper) do { j:INTEGER;
+ loc := tab.item j;
+ loc.is_result.if_false {
+ (((buf.count + loc.intern_name.count - cur) > 70) || {t != loc.type}).if {
+ // New line
+ (t != NULL).if {
+ buf.append ";\n";
+ };
+ cur := buf.count;
+ t := loc.type;
+ buf.append indent;
+ t.genere_declaration buf;
+ buf.add_last ' ';
+ } else {
+ buf.add_last ',';
+ };
+ t.genere_star_declaration buf;
+ buf.append (loc.intern_name);
+ };
+ };
+ buf.append ";\n";
+ tab.clear;
+ };
+ );
+
diff --git a/src/code_life/loop.li b/src2/code_life/loop.li
similarity index 100%
copy from src/code_life/loop.li
copy to src2/code_life/loop.li
diff --git a/src/code_life/loop_end.li b/src2/code_life/loop_end.li
similarity index 100%
copy from src/code_life/loop_end.li
copy to src2/code_life/loop_end.li
diff --git a/src/code_life/nop.li b/src2/code_life/nop.li
similarity index 100%
copy from src/code_life/nop.li
copy to src2/code_life/nop.li
diff --git a/src2/code_life/push.li b/src2/code_life/push.li
new file mode 100644
index 0000000..0fc6ee3
--- /dev/null
+++ b/src2/code_life/push.li
@@ -0,0 +1,165 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PUSH;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Push context for debug mode";
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section PUSH,LISAAC
+
+ - source_line:HASHED_DICTIONARY(STRING,UINTEGER_32) :=
+ HASHED_DICTIONARY(STRING,UINTEGER_32).create;
+
+Section Public
+
+ + context:LOCAL;
+
+ + is_first:BOOLEAN;
+
+ - set_first f:BOOLEAN <-
+ (
+ is_first := f;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create pos:POSITION context v:LOCAL first f:BOOLEAN :SELF <-
+ ( + result:SELF;
+ ? {v != NULL};
+
+ result := clone;
+ result.make pos context v first f;
+ result
+ );
+
+ - make pos:POSITION context v:LOCAL first f:BOOLEAN <-
+ ( ? {pos.code != 0};
+ ? {v != NULL};
+ (v = NULL).if {
+ crash_with_message "PUSH";
+ };
+ position := pos;
+ context := v;
+ is_first := f;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+ + new_context:LOCAL;
+
+ (LOCAL.is_alias).if {
+ new_context := context.get_alias;
+ new_context.set_ensure_count 1;
+ result := create position context new_context first is_first;
+ } else {
+ result := create position context context first is_first;
+ };
+ result
+ );
+
+ //
+ // Execute.
+ //
+
+ - remove <-
+ (
+ // Nothing.
+ );
+
+ - execute:INSTR <-
+ ( + result:INSTR;
+ + other:SELF;
+
+ result := Self;
+ (list_current.index < list_current.upper).if {
+ other ?= list_current.item (list_current.index + 1);
+ (other != NULL).if {
+ (other.context = context).if {
+ result := NULL;
+ (is_first).if {
+ other.set_first TRUE;
+ };
+ }.elseif {(is_first) && {! other.is_first}} then {
+ result := NULL;
+ };
+ };
+ };
+ result
+ );
+
+ //
+ // Genere
+ //
+
+ - genere buffer:STRING <-
+ ( + id:UINTEGER_32;
+ add_var_size context;
+ (is_first).if {
+ buffer.append "push_first(&";
+ } else {
+ buffer.append "push(&";
+ };
+ buffer.append (context.intern_name);
+ buffer.add_last ',';
+ id := position.code;
+ (debug_with_code).if {
+ (! source_line.fast_has id).if {
+ source_line.fast_put (position.extract_line) to id;
+ };
+ buffer.add_last 'L';
+ };
+ id.append_in buffer;
+ buffer.add_last ')';
+
+ buffer.append "; // L";
+ position.line.append_in buffer;
+ buffer.add_last ' ';
+ buffer.append (position.prototype.name);
+
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append "push(";
+ buffer.append (context.intern_name);
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
diff --git a/src2/code_life/read.li b/src2/code_life/read.li
new file mode 100644
index 0000000..cb394fd
--- /dev/null
+++ b/src2/code_life/read.li
@@ -0,0 +1,261 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := READ;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Read for local, global or slot";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_slot:BOOLEAN <- FALSE;
+
+ - variable:VARIABLE <-
+ (
+ deferred;
+ NULL
+ );
+
+ - static_type:TYPE_FULL <-
+ (
+ variable.type
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+ result ?= variable.read position;
+ result
+ );
+
+ //
+ // Searching.
+ //
+
+ - get_type t:TYPES_TMP <-
+ (
+ variable.get_type t;
+ );
+
+ - get_last_value:EXPR <- variable.get_last_value NULL;
+
+ //
+ // Executing pass.
+ //
+
+ - remove <-
+ (
+ variable.unread Self;
+ );
+
+ - is_require_constant:CONSTANT <-
+ ( + result:CONSTANT;
+ + j:INTEGER;
+ + val:EXPR;
+ + req_list:FAST_ARRAY(WRITE);
+ //? { variable.require_first != NULL };
+
+ ((variable.require_first = NULL) && {!variable.type.is_expanded}).if {
+ variable.intern_name.print; '\n'.print;
+ "style [".print; variable.style.print; "]\n".print;
+ warning_error (position,"READ : Compiler BUG! (require_first = NULL) ");
+ list_current.debug_display;
+ die_with_code 0;
+ //crash_with_message "BUG READ : require_first = NULL";
+ };
+
+ (variable.require_first != NULL).if {
+ val := variable.require_first.value;
+ (val.is_constant).if {
+ result ?= val;
+ req_list := variable.require_list;
+ (req_list != NULL).if {
+ j := req_list.lower;
+ {(j > req_list.upper) || {result = NULL}}.until_do {
+ val := req_list.item j.value;
+ ((! val.is_constant) || {result !== val}).if {
+ result := NULL;
+ };
+ j := j + 1;
+ };
+ };
+ };
+ };
+ result
+ );
+
+ - execute_access_unlink:INSTR <-
+ (
+ deferred;
+ NULL
+ );
+
+ - execute_access_link <- deferred;
+
+ - execute_unlink:INSTR <-
+ // Delete read
+ (
+ variable.unread Self;
+ new_execute_pass;
+ execute_access_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + cst:CONSTANT;
+ + rec:INSTR;
+ + result:EXPR;
+ + val:EXPR;
+ + s:SLOT_DATA;
+ + l:LOCAL;
+ + wrt:WRITE;
+ + tmp_type:TYPES_TMP;
+ //+ old_loop_invariant:LOOP;
+
+ // Simplify type.
+ ((! variable.is_static) && {! variable.type.is_strict}).if {
+ tmp_type := TYPES_TMP.new;
+ variable.get_type tmp_type;
+ (tmp_type.first = TYPE_NULL).if {
+ tmp_type.remove_first;
+ };
+ (variable.name == "storage").if {
+ variable.intern_name.print; ' '.print;
+ tmp_type.count.print;
+ '\n'.print;
+ };
+ (tmp_type.count = 1).if {
+ variable.set_type (tmp_type.first.default.to_strict);
+ };
+ tmp_type.free;
+ };
+
+ //
+ s ?= variable;
+ (
+ (s = NULL) || {
+ ((s.style != '+') || {! s.id_section.is_mapping}) &&
+ {(! variable.type.is_expanded) || {variable.type.is_default_expanded}}
+ }
+ ).if {
+ cst := is_require_constant; // BSBS: Ce cas devrait rentrer dans get_last_value
+ (cst != NULL).if {
+ //
+ // CONSTANT propagation.
+ //
+ variable.unread Self;
+ rec := execute_access_unlink;
+ (rec != NULL).if {
+ list_current.insert_before rec;
+ };
+ result := cst.my_copy;
+ new_execute_pass;
+ }.elseif {
+ (val := get_last_value) != NULL
+ } then {
+ //
+ // VALUE_EXPR propagation, step by step.
+ //
+ result := val;
+ variable.unread Self;
+ new_execute_pass;
+ };
+ };
+
+ (result = NULL).if {
+ //
+ // Normal.
+ //
+ ((is_slot) && {loop_invariant != NULL} && {is_invariant}).if {
+ //old_loop_invariant := loop_invariant;
+ //loop_invariant := NULL;
+ //
+ l := static_type.get_temporary position;
+ wrt := l.write position value Self;
+ loop_list.insert_before wrt;
+ result := l.read position;
+ //
+ //wrt.execute;
+ //result := result.execute_link;
+ //
+ //loop_invariant := old_loop_invariant;
+ count_invariant := count_invariant + 1;
+ } else {
+ variable.set_read;
+ execute_access_link;
+ result := Self;
+ };
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - display_ref buffer:STRING <-
+ ( + req_list:FAST_ARRAY(WRITE);
+ //is_verbose.if {
+ buffer.add_last '<';
+ buffer.append (object_id.to_string);
+ buffer.append "/R";
+ (variable.require_first != NULL).if {
+ variable.require_first.object_id.append_in buffer;
+ req_list := variable.require_list;
+ (req_list != NULL).if {
+ (req_list.lower).to (req_list.upper) do { j:INTEGER;
+ buffer.add_last ',';
+ req_list.item j.object_id.append_in buffer;
+ };
+ };
+ } else {
+ buffer.add_last '*';
+ };
+ buffer.append "/E";
+ variable.ensure_count.append_in buffer;
+ buffer.add_last '>';
+ //};
+ );
+
+ - display buffer:STRING <-
+ (
+ buffer.append (variable.intern_name);
+ buffer.add_last '[';
+ variable.type.append_name_in buffer;
+ buffer.add_last ']';
+ display_ref buffer;
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/code_life/read_global.li b/src2/code_life/read_global.li
new file mode 100644
index 0000000..61127da
--- /dev/null
+++ b/src2/code_life/read_global.li
@@ -0,0 +1,106 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := READ_GLOBAL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Read for global";
+
+Section Inherit
+
+ + parent_read:Expanded READ;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- global.is_invariant NULL;
+
+ + global:SLOT_DATA;
+
+ - variable:VARIABLE <- global;
+
+ //
+ // Comparison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + rd:READ_GLOBAL;
+
+ rd ?= other;
+ ((rd != NULL) && {global = rd.global})
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with g:SLOT_DATA :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with g;
+ result
+ );
+
+ - make p:POSITION with g:SLOT_DATA <-
+ (
+ position := p;
+ global := g;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_access_unlink:INSTR <-
+ (
+ global.execute;
+ NULL
+ );
+
+ - execute_access_link <-
+ (
+ global.execute;
+ );
+
+ //
+ // Genere
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.append (variable.intern_name);
+ );
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/code_life/read_local.li b/src2/code_life/read_local.li
new file mode 100644
index 0000000..b8aba23
--- /dev/null
+++ b/src2/code_life/read_local.li
@@ -0,0 +1,105 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := READ_LOCAL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Read for local.";
+
+Section Inherit
+
+ + parent_read:Expanded READ;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- local.is_invariant;
+
+ + local:LOCAL;
+
+ - variable:VARIABLE <- local;
+
+ //
+ // Comparison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + rd:READ_LOCAL;
+
+ rd ?= other;
+ ((rd != NULL) && {local = rd.local})
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with l:LOCAL :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with l;
+ result
+ );
+
+ - make p:POSITION with l:LOCAL <-
+ (
+ position := p;
+ local := l;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_access_unlink:INSTR <- NULL;
+
+ - execute_access_link;
+
+ //
+ // Genere
+ //
+
+ - genere buffer:STRING <-
+ ( + tb:PROFIL_BLOCK;
+ (variable.ensure_count = -1).if {
+ buffer.add_last '*';
+ };
+ buffer.append (variable.intern_name);
+ //
+ tb ?= local.type.raw;
+ (tb != NULL).if {
+ add_var_size local;
+ };
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/code_life/read_slot.li b/src2/code_life/read_slot.li
new file mode 100644
index 0000000..5e93272
--- /dev/null
+++ b/src2/code_life/read_slot.li
@@ -0,0 +1,172 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := READ_SLOT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Read for slot";
+
+Section Inherit
+
+ + parent_read:Expanded READ;
+
+Section Public
+
+ - is_slot:BOOLEAN <- TRUE;
+
+ - is_invariant:BOOLEAN <- slot.is_invariant receiver;
+
+ + slot:SLOT_DATA;
+
+ + receiver:EXPR;
+
+ - variable:VARIABLE <- slot;
+
+ - get_last_value:EXPR <- variable.get_last_value receiver;
+
+ //
+ // Comparison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + rd:READ_SLOT;
+
+ rd ?= other;
+ ((rd != NULL) && {slot = rd.slot} && {receiver == rd.receiver})
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with (r:EXPR,s:SLOT_DATA) :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with (r,s);
+ result
+ );
+
+ - make p:POSITION with (r:EXPR,s:SLOT_DATA) <-
+ (
+ position := p;
+ receiver := r;
+ slot := s;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+
+ result ?= slot.read position with (receiver.my_copy);
+ result
+ );
+
+ //
+ // Executing pass.
+ //
+
+ - remove <-
+ (
+ receiver.remove;
+ parent_read.remove;
+ );
+
+ - execute_access_unlink:INSTR <-
+ (
+ slot.execute;
+ receiver.execute_unlink
+ );
+
+ - execute_access_link <-
+ (
+ slot.execute;
+ receiver := receiver.execute_link;
+ );
+
+ //
+ // Genere
+ //
+
+ - genere buffer:STRING <-
+ ( + tf:TYPE_FULL;
+ + t:TYPE;
+
+ (is_java).if {
+ receiver.genere buffer;
+ buffer.add_last '.';
+ buffer.append (variable.intern_name);
+ } else {
+ (slot.intern_name = ALIAS_STR.slot_self).if {
+ buffer.append "((";
+ tf := slot.type;
+ tf.genere_declaration buffer;
+ buffer.add_last ' ';
+ tf.genere_star_declaration buffer;
+ buffer.add_last ')';
+ receiver.genere buffer;
+ buffer.append ".self)";
+ } else {
+ tf := receiver.static_type;
+ ((tf.is_strict) || {tf.is_expanded_ref}).if {
+ receiver.genere buffer;
+ buffer.append "->";
+ }.elseif {tf.is_expanded} then {
+ receiver.genere buffer;
+ buffer.add_last '.';
+ } else {
+ buffer.append "((";
+ t := slot.receiver_type;
+ t.put_reference_declaration buffer;
+ buffer.add_last ' ';
+ t.put_reference_star_declaration buffer;
+ buffer.add_last ')';
+ receiver.genere buffer;
+ buffer.append ")->";
+ };
+ buffer.append (variable.intern_name);
+ };
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ receiver.display buffer;
+ buffer.append "->";
+ parent_read.display buffer;
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src/code_life/result.li b/src2/code_life/result.li
similarity index 100%
copy from src/code_life/result.li
copy to src2/code_life/result.li
diff --git a/src2/code_life/switch.li b/src2/code_life/switch.li
new file mode 100644
index 0000000..831d112
--- /dev/null
+++ b/src2/code_life/switch.li
@@ -0,0 +1,523 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SWITCH;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Switch for late binding resolution";
+
+ // BSBS: Optim. : Détecter les switch identique l'un après l'autre
+ // pour les fusionner...
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ (expr.is_invariant).if {
+ result := TRUE;
+ j := list.lower;
+ {(j <= list.upper) && {result}}.while_do {
+ result := list.item j.code.is_invariant;
+ j := j + 1;
+ };
+ };
+ result
+ );
+
+ + expr:EXPR;
+
+ + list:FAST_ARRAY(CASE);
+
+ - count:INTEGER <- list.count;
+
+ //
+ // Creation.
+ //
+
+ - create n:NODE with e:EXPR size s:INTEGER :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make n with e size s;
+ result
+ );
+
+
+ - make n:NODE with e:EXPR size s:INTEGER <-
+ ( + first:CASE;
+ position := n.position;
+ expr := e;
+ list := FAST_ARRAY(CASE).create_with_capacity s;
+ (n.first_code != NULL).if {
+ first := CASE.create (n.first_type) with (n.first_code);
+ list.add_last first;
+ };
+ );
+
+ //
+ // Copy.
+ //
+
+ - set_expr e:EXPR list l:FAST_ARRAY(CASE) <-
+ (
+ expr := e;
+ list := l;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+ + new_list:FAST_ARRAY(CASE);
+
+ new_list := FAST_ARRAY(CASE).create_with_capacity (list.count);
+ (list.lower).to (list.upper) do { j:INTEGER;
+ new_list.add_last (list.item j.my_copy);
+ };
+
+ result := clone;
+ result.set_expr (expr.my_copy) list new_list;
+ result
+ );
+
+ //
+ // Remove.
+ //
+
+ - remove <-
+ (
+ (expr != NULL).if {
+ expr.remove;
+ };
+ (list.lower).to (list.upper) do { j:INTEGER;
+ list.item j.code.remove;
+ };
+ );
+
+ //
+ // Execute
+ //
+
+ - i_am_the_last i:INSTR :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ j := list.lower;
+ {(j <= list.upper) && {!result}}.while_do {
+ result := list.item j.code.i_am_the_last i;
+ j := j + 1;
+ };
+ result
+ );
+
+ - execute:INSTR <-
+ ( + lst_typ:TYPES_TMP;
+ + result:INSTR;
+ + typ:TYPE;
+ + wrt:WRITE;
+ + lst:LIST;
+ + tb:PROFIL_BLOCK;
+ + is_end:BOOLEAN;
+ + count_empty:INTEGER;
+
+ // Update.
+ lst_typ := TYPES_TMP.new;
+ expr.get_type lst_typ;
+ ? {lst_typ.count <= list.count};
+
+ (lst_typ.count > list.count).if {
+ "New type: ".print;
+ lst_typ.print;
+ "\nOld type: ".print;
+ string_tmp.clear;
+ list.lower.to (list.upper) do { j:INTEGER;
+ list.item j.id.append_name_in string_tmp;
+ string_tmp.add_last ',';
+ };
+ string_tmp.print;
+ '\n'.print;
+ syntax_error (position,"*****SWITCH BUG********");
+ };
+
+ //
+ // BSBS: Ajoute un pattern pour les elseif ...
+ //
+ (lst_typ.lower).to (lst_typ.upper) do { j:INTEGER;
+ typ := lst_typ.item j;
+ {typ = list.item j.id}.until_do {
+ list.item j.remove;
+ list.remove j;
+ };
+ (list.item j.code.is_empty).if {
+ count_empty := count_empty + 1;
+ };
+ };
+ {lst_typ.count = list.count}.until_do {
+ list.last.remove;
+ list.remove_last;
+ };
+ lst_typ.free;
+
+ // Execute.
+ (
+ (list.count = 1) || {
+ (list.count = 2) &&
+ {debug_level_option = 0} &&
+ {list.first.id = TYPE_NULL} &&
+ {! list.first.code.is_empty} &&
+ {
+ wrt ?= list.first.code.first; // For ?= with NULL type.
+ wrt = NULL
+ }
+ }
+ ).if {
+ result := expr.execute_unlink;
+ (result != NULL).if {
+ list_current.insert_before result;
+ };
+ tb ?= list.last.id;
+ (tb != NULL).if {
+ tb.dec_id;
+ };
+ result := list.last.code.execute;
+ is_end := TRUE;
+ }.elseif {count_empty = list.count} then {
+ result := expr.execute_unlink;
+ is_end := TRUE;
+ };
+ //
+ (! is_end).if {
+ // Normal execution.
+ (
+ (expr.static_type.raw = type_boolean) &&
+ {list.count = 2} &&
+ {list.first.code.is_empty}
+ ).if {
+ ? {! list.second.code.is_empty};
+ expr := EXPR_NOT_LOGIC.create (expr.position) with expr;
+ lst := list.first.code;
+ list.first .set_code (list.second.code);
+ list.second.set_code lst;
+ };
+ expr := expr.execute_link;
+
+ CALL_SLOT.reset_count_no_recursive;
+ ((list.first.id = TYPE_NULL) && {list.count = 2}).if {
+ list.first .code.execute_case;
+ list.second.code.execute_case;
+ } else {
+ (list.lower).to (list.upper) do { j:INTEGER;
+ list.item j.execute;
+ };
+ };
+ result := detect_logic_expr;
+ (result = NULL).if {
+ result := Self;
+ };
+ };
+ result
+ );
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ ( + lst:LIST;
+ + first_case:INTEGER;
+ + typ_first:TYPE;
+ + typ_id:TYPE_ID;
+ + wrt:WRITE;
+ + i:INTEGER;
+
+ (
+ (list.first.id = TYPE_NULL) &&
+ {debug_level_option = 0} &&
+ {! list.first.code.is_empty} &&
+ {
+ wrt ?= list.first.code.first; // For ?= with NULL type.
+ wrt = NULL
+ }
+ ).if {
+ list.remove_first;
+ };
+ i := list.upper;
+ {i >= list.lower}.while_do {
+ (list.item i.code.is_empty).if {
+ list.remove i;
+ };
+ i := i - 1;
+ };
+ //
+ (list.is_empty).if_false {
+ typ_first := list.first.id;
+ typ_id ?= typ_first;
+ ((list.count <= 2) || {typ_first = TYPE_NULL}).if {
+ buffer.append "if (";
+ //
+ ((expr.static_type.raw.is_block) && {typ_first = TYPE_NULL}).if {
+ expr.genere buffer;
+ buffer.append ".__id==0";
+ } else {
+ typ_first.put_access_id expr in buffer;
+ (expr.static_type.raw != type_boolean).if {
+ buffer.append "==";
+ typ_first.put_id buffer;
+ } else {
+ ? {typ_first.name = ALIAS_STR.prototype_true};
+ };
+ };
+ buffer.append ") ";
+ //
+ list.first.genere buffer;
+ first_case := 1;
+ //
+ (list.count = 2).if {
+ lst := list.second.code;
+ buffer.append " else ";
+
+ buffer.append "/* ";
+ buffer.append (list.second.id.name);
+ buffer.append " */ ";
+
+ list.second.genere buffer;
+ first_case := 2;
+ }.elseif {list.count > 2} then {
+ buffer.append " else {\n";
+ indent.append " ";
+ buffer.append indent;
+ };
+ };
+ (first_case <= list.upper).if {
+ polymorphic_counter := polymorphic_counter + 1;
+ buffer.append "switch (";
+ list.item first_case.id.put_access_id expr in buffer;
+ buffer.append ") {\n";
+ (first_case).to (list.upper) do { j:INTEGER;
+ buffer.append indent;
+ buffer.append "case ";
+ list.item j.id.put_id buffer;
+ buffer.append ": ";
+ list.item j.genere buffer;
+ buffer.add_last ' ';
+ buffer.append "break;\n";
+ };
+ buffer.append indent;
+ buffer.add_last '}';
+ (first_case != 0).if {
+ buffer.add_last '\n';
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.add_last '}';
+ };
+ };
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ ( + line:{INTEGER; };
+
+ line :=
+ { j:INTEGER;
+ + i:LIST;
+ buffer.append indent;
+ buffer.put '+' to (buffer.upper-1);
+ buffer.put '-' to (buffer.upper);
+ buffer.append (list.item j.id.intern_name);
+ buffer.append ":\n";
+ buffer.append indent;
+ i := list.item j.code;
+ (i = NULL).if {
+ buffer.append "<Empty>";
+ } else {
+ i.display buffer;
+ };
+ };
+
+ buffer.append "Switch ";
+ expr.display buffer;
+ buffer.add_last '\n';
+ (list.count > 0).if {
+ indent.append "| ";
+ 0.to (list.upper - 1) do { j:INTEGER;
+ line.value j;
+ buffer.add_last '\n';
+ };
+ indent.put ' ' to (indent.upper-1);
+ line.value (list.upper);
+ indent.remove_last 2;
+ };
+ );
+
+ - switch_new_pass:BOOLEAN;
+ - reset_switch_new_pass <-
+ (
+ switch_new_pass := FALSE;
+ );
+
+Section Private
+
+ - detect_logic_expr:INSTR <-
+ // Detection !, |, &, ||, && :
+ ( + result:INSTR;
+ + wr_true,wr_false:WRITE;
+ + rd:READ;
+ + val_true,val_false:EXPR;
+ + a,b,c,d:BOOLEAN;
+
+ (
+ (expr.static_type.raw = type_boolean) &&
+ {list.count = 2} &&
+ {list.first.code.count = 1} &&
+ {list.second.code.count = 1}
+ ).if {
+ ? {list.first.id = type_true };
+ ? {list.second.id = type_false};
+
+ ((list.first.id != type_true) || {list.second.id != type_false}).if {
+ syntax_error (position,"PB dans SWITCH.");
+ };
+
+ wr_true ?= list.first .code.first;
+ wr_false ?= list.second.code.first;
+ (
+ (wr_true != NULL) &&
+ {wr_false != NULL} &&
+ {wr_true.static_type.raw = type_boolean} &&
+ {wr_true.variable = wr_false.variable}
+ ).if {
+ val_true := wr_true .value;
+ val_false := wr_false.value;
+ // BSBS: val_true.static_type = type_true ???
+ (
+ (a := val_true.is_constant) &&
+ {b := (val_true.static_type.raw = type_true)}
+ ).if {
+ // | or ||
+ rd ?= val_false;
+ (rd != NULL).if {
+ // |
+ wr_true.remove;
+ val_false := EXPR_OR_LOGIC.create position with expr and val_false;
+ wr_false.set_value val_false;
+ result := wr_false;
+ new_execute_pass;
+ }.elseif {(CALL_SLOT.count_no_recursive = 0) || {modify_count = 0}} then {
+ // ||
+ wr_true.remove;
+ val_false := EXPR_OR_OR_LOGIC.create position with expr and val_false;
+ wr_false.set_value val_false;
+ result := wr_false;
+ switch_new_pass := TRUE;
+ };
+ }.elseif {
+ (c := val_false.is_constant) &&
+ {d := (val_false.static_type.raw = type_false)}
+ } then {
+ // & or &&
+ rd ?= val_true;
+ (rd != NULL).if {
+ // &
+ wr_false.remove;
+ val_true := EXPR_AND_LOGIC.create position with expr and val_true;
+ wr_true.set_value val_true;
+ result := wr_true;
+ new_execute_pass;
+ }.elseif {(CALL_SLOT.count_no_recursive = 0) || {modify_count = 0}} then {
+ // &&
+ wr_false.remove;
+ val_true := EXPR_AND_AND_LOGIC.create position with expr and val_true;
+ wr_true.set_value val_true;
+ result := wr_true;
+ switch_new_pass := TRUE;
+ };
+ }.elseif {
+ (a) && {!b} && {c} && {!d}
+ } then {
+ // !
+ wr_false.remove;
+ wr_true.set_value (EXPR_NOT_LOGIC.create position with expr);
+ result := wr_true;
+ new_execute_pass;
+ };
+ };
+ };
+ result
+ );
+
+ - switch_fusion <-
+ ( + other:SWITCH;
+ + index:INTEGER;
+ + wrt:WRITE;
+ + rd,rd2:READ;
+
+ index := list_current.index + 1;
+ other ?= list_current.item index;
+ ((other != NULL) && {other.expr == expr} && {other.list.count = list.count}).if {
+ concat_switch other;
+ list_current.put NOP to index;
+ };
+ (index < list_current.upper).if {
+ // BSBS: Dans ce cas la, tu devrai en avoir 250 !!!!
+ // Regarde pourquoi tu n'as que 14 cas !
+ wrt ?= list_current.item index;
+ rd ?= expr;
+ ((wrt != NULL) && {rd != NULL} && {wrt.variable != rd.variable}).if {
+ rd2 ?= wrt.value;
+ other ?= list_current.item (index + 1);
+ ((rd2 != NULL) && {other != NULL} &&
+ {other.expr == expr} && {other.list.count = list.count}).if {
+ (list.lower).to (list.upper-1) do { j:INTEGER;
+ list.item j.code.add_last (wrt.my_copy);
+ };
+ list.last.code.add_last wrt;
+ list_current.put NOP to index;
+ concat_switch other;
+ list_current.put NOP to (index + 1);
+ };
+ };
+ };
+ );
+
+ - concat_switch other:SWITCH <-
+ ( + other_list:FAST_ARRAY(CASE);
+ + code:LIST;
+
+ other.expr.remove;
+ other_list := other.list;
+ (list.lower).to (list.upper) do { j:INTEGER;
+ code := list.item j.code;
+ code.add_last (other_list.item j.code);
+ };
+ new_execute_pass;
+ );
\ No newline at end of file
diff --git a/src/code_life/write.li b/src2/code_life/write.li
similarity index 100%
copy from src/code_life/write.li
copy to src2/code_life/write.li
diff --git a/src/code_life/write_global.li b/src2/code_life/write_global.li
similarity index 100%
copy from src/code_life/write_global.li
copy to src2/code_life/write_global.li
diff --git a/src/code_life/write_local.li b/src2/code_life/write_local.li
similarity index 100%
copy from src/code_life/write_local.li
copy to src2/code_life/write_local.li
diff --git a/src/code_life/write_slot.li b/src2/code_life/write_slot.li
similarity index 100%
copy from src/code_life/write_slot.li
copy to src2/code_life/write_slot.li
diff --git a/src/compiler_any/any_option.li b/src2/compiler_any/any_option.li
similarity index 100%
copy from src/compiler_any/any_option.li
copy to src2/compiler_any/any_option.li
diff --git a/src2/constant/character_cst.li b/src2/constant/character_cst.li
new file mode 100644
index 0000000..cd811bb
--- /dev/null
+++ b/src2/constant/character_cst.li
@@ -0,0 +1,99 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := CHARACTER_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Character constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ //
+ // Value.
+ //
+
+ + text:STRING_CONSTANT;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION char car:STRING_CONSTANT :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p char car;
+ result
+ );
+
+ - make p:POSITION char car:STRING_CONSTANT <-
+ (
+ position := p;
+ text := car;
+ static_type := type_character.default;
+ );
+
+ - my_copy:SELF <- SELF.create position char text;
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + s:SELF;
+ s ?= other;
+ (s != NULL) && {text = s.text}
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '\'';
+ buffer.append text;
+ buffer.add_last '\'';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '\'';
+ buffer.append text;
+ buffer.add_last '\'';
+ display_ref buffer;
+ );
+
+
+
+
+
diff --git a/src/constant/constant.li b/src2/constant/constant.li
similarity index 100%
copy from src/constant/constant.li
copy to src2/constant/constant.li
diff --git a/src2/constant/integer_cst.li b/src2/constant/integer_cst.li
new file mode 100644
index 0000000..a9b17e1
--- /dev/null
+++ b/src2/constant/integer_cst.li
@@ -0,0 +1,253 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := INTEGER_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Integer constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ //
+ // Value.
+ //
+
+ + value:INTEGER_64;
+
+ - set_value new_value:INTEGER_64 <-
+ (
+ value := new_value;
+ check_type;
+ );
+
+ - to_power:INTEGER_64 <-
+ // 2^Result = self or else -1
+ ( + result,val:INTEGER_64;
+
+ val := value;
+ (val = 0).if {
+ result := -1;
+ } else {
+ {(val & 1) = 0}.while_do {
+ val := val >> 1;
+ result := result + 1;
+ };
+ (val != 1).if {
+ result := -1;
+ };
+ };
+ result
+ );
+
+ - is_signed:BOOLEAN <-
+ ( + typ:STRING_CONSTANT;
+
+ typ := static_type.raw.name;
+ (typ = ALIAS_STR.prototype_integer_64) ||
+ {typ = ALIAS_STR.prototype_integer_32} ||
+ {typ = ALIAS_STR.prototype_integer_16} ||
+ {typ = ALIAS_STR.prototype_integer_8 }
+ );
+
+ - is_saturated:BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ (is_signed).if {
+ result := value = -1;
+ } else {
+ (static_type.raw.name)
+ .when (ALIAS_STR.prototype_uinteger_64) then {
+ result := FALSE; // value = 0FFFFFFFFFFFFFFFFh;
+ }
+ .when (ALIAS_STR.prototype_uinteger_32) then {
+ result := value = 0FFFF_FFFFh;
+ }
+ .when (ALIAS_STR.prototype_uinteger_16) then {
+ result := value = 0FFFFh;
+ }
+ .when (ALIAS_STR.prototype_uinteger_8 ) then {
+ result := value = 0FFh;
+ };
+ };
+ result
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION value v:INTEGER_64 type t:TYPE_FULL :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p value v type t;
+ result
+ );
+
+ - make p:POSITION value v:INTEGER_64 type t:TYPE_FULL <-
+ (
+ position := p;
+ value := v;
+ static_type := t;
+ check_type;
+ );
+
+ - my_copy:SELF <- SELF.create position value value type static_type;
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + p:INTEGER_CST;
+ p ?= other;
+ (p != NULL) && {value = p.value} && {static_type = p.static_type}
+ );
+
+ //
+ // Depend.
+ //
+
+ - cast_type p:TYPE_FULL <-
+ (
+ ? { p.raw != type_integer };
+ static_type := p;
+ check_type;
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last ' ';
+ value.append_in buffer;
+ (value > UINTEGER_32.maximum.to_integer_64).if {
+ buffer.append "LLU";
+ }.elseif {value > INTEGER.maximum.to_integer_64} then {
+ buffer.append "LU";
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ static_type.append_name_in buffer;
+ buffer.add_last ')';
+ value.append_in buffer;
+ display_ref buffer;
+ );
+
+Section Private
+
+ - check_type <-
+ ( + error:BOOLEAN;
+ + min,max:INTEGER_64;
+
+ // Check Range.
+ (static_type.raw.name)
+ .when (ALIAS_STR.prototype_uinteger_64) then {
+ (value < 0).if {
+ error := TRUE;
+ max := 0; // BSBS: A revoir...
+ };
+ }
+ .when (ALIAS_STR.prototype_uinteger_32) then {
+ ((value < 0) || {value > UINTEGER_32.maximum.to_integer_64}).if {
+ error := TRUE;
+ max := UINTEGER_32.maximum.to_integer_64;
+ };
+ }
+ .when (ALIAS_STR.prototype_uinteger_16) then {
+ ((value < 0) || {value > UINTEGER_16.maximum.to_integer_64}).if {
+ error := TRUE;
+ max := UINTEGER_16.maximum.to_integer_64;
+ };
+ }
+ .when (ALIAS_STR.prototype_uinteger_8) then {
+ ((value < 0) || {value > UINTEGER_8.maximum.to_integer_64}).if {
+ error := TRUE;
+ max := UINTEGER_8.maximum.to_integer_64;
+ };
+ }
+ .when (ALIAS_STR.prototype_integer_64) then {
+ // Nothing. (Pb: BSBS : Can't range test.)
+ }
+ .when (ALIAS_STR.prototype_integer_32) then {
+ ((value < INTEGER.minimum) || {value > INTEGER.maximum.to_integer_64}).if {
+ error := TRUE;
+ min := INTEGER.minimum;
+ max := INTEGER.maximum.to_integer_64;
+ };
+ }
+ .when (ALIAS_STR.prototype_integer_16) then {
+ ((value < INTEGER_16.minimum) || {value > INTEGER_16.maximum.to_integer_64}).if {
+ error := TRUE;
+ min := INTEGER_16.minimum;
+ max := INTEGER_16.maximum.to_integer_64;
+ };
+ }
+ .when (ALIAS_STR.prototype_integer_8) then {
+ ((value < INTEGER_8.minimum) || {value > INTEGER_8.maximum.to_integer_64}).if {
+ error := TRUE;
+ min := INTEGER_8.minimum;
+ max := INTEGER_8.maximum.to_integer_64;
+ };
+ };
+
+ (error).if {
+ string_tmp.copy "Invalid constant integer (";
+ value.append_in string_tmp;
+ string_tmp.append ") cast into ";
+ static_type.append_name_in string_tmp;
+ string_tmp.append " [";
+ min.append_in string_tmp;
+ string_tmp.append "..";
+ max.append_in string_tmp;
+ string_tmp.append "] => new value=0.";
+ POSITION.put_error warning text string_tmp;
+ position.put_position;
+ list_current.position.put_position;
+ POSITION.send_error;
+ value := 0;
+ };
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src2/constant/native_array_character_cst.li b/src2/constant/native_array_character_cst.li
new file mode 100644
index 0000000..8b8a87e
--- /dev/null
+++ b/src2/constant/native_array_character_cst.li
@@ -0,0 +1,100 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := NATIVE_ARRAY_CHARACTER_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "String constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ //
+ // Value.
+ //
+
+ + string:STRING_CONSTANT;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION text n:STRING_CONSTANT :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p text n;
+ result
+ );
+
+ - make p:POSITION text n:STRING_CONSTANT <-
+ (
+ position := p;
+ string := n;
+ static_type := type_n_a_character.default;
+ );
+
+ - my_copy:SELF <- SELF.create position text string;
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + p:NATIVE_ARRAY_CHARACTER_CST;
+ p ?= other;
+ (p != NULL) && {string = p.string}
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '\"';
+ buffer.append string;
+ buffer.add_last '\"';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '\"';
+ buffer.append string;
+ buffer.add_last '\"';
+ display_ref buffer;
+ );
+
+
+
+
+
+
diff --git a/src2/constant/prototype_cst.li b/src2/constant/prototype_cst.li
new file mode 100644
index 0000000..3915a77
--- /dev/null
+++ b/src2/constant/prototype_cst.li
@@ -0,0 +1,100 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROTOTYPE_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Prototype constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION type t:TYPE_FULL :SELF<-
+ ( + result:SELF;
+ ? {p.code != 0};
+ ? {t != NULL};
+
+ result := clone;
+ result.make p type t;
+ result
+ );
+
+ - make p:POSITION type t:TYPE_FULL <-
+ (
+ position := p;
+ static_type := t.to_strict;
+ );
+
+ - my_copy:SELF <-
+ (
+ SELF.create position type static_type
+ );
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + p:PROTOTYPE_CST;
+ p ?= other;
+ (p != NULL) && {static_type = p.static_type}
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_link:EXPR <-
+ (
+ Self
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ static_type.genere_value buffer;
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ static_type.display buffer;
+ display_ref buffer;
+ );
+
+
diff --git a/src2/constant/real_cst.li b/src2/constant/real_cst.li
new file mode 100644
index 0000000..4dcaf92
--- /dev/null
+++ b/src2/constant/real_cst.li
@@ -0,0 +1,113 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := REAL_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Real float constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ //
+ // Value.
+ //
+
+ + value:STRING_CONSTANT;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION value v:STRING_CONSTANT type t:TYPE_FULL :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p value v type t;
+ result
+ );
+
+ - make p:POSITION value v:STRING_CONSTANT type t:TYPE_FULL <-
+ (
+ position := p;
+ value := v;
+ static_type := t;
+ );
+
+ - my_copy:SELF <- SELF.create position value value type static_type;
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + p:REAL_CST;
+ p ?= other;
+ (p != NULL) && {value = p.value} && {static_type = p.static_type}
+ );
+
+ //
+ // Depend.
+ //
+
+ - cast_type p:TYPE_FULL <-
+ (
+ ? { p != type_real };
+ static_type := p;
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.append value;
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ static_type.append_name_in buffer;
+ buffer.add_last ')';
+ buffer.append value;
+ display_ref buffer;
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/constant/string_cst.li b/src2/constant/string_cst.li
new file mode 100644
index 0000000..e1c927d
--- /dev/null
+++ b/src2/constant/string_cst.li
@@ -0,0 +1,180 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := STRING_CST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "String constant";
+
+Section Inherit
+
+ + parent_constant:Expanded CONSTANT;
+
+Section Public
+
+ - output:STRING :=
+ ( + result:STRING;
+
+ result := STRING.create 256;
+ title "STRING CONSTANT" in result;
+ result
+ );
+
+ - output_count:INTEGER;
+
+ //
+ // Value.
+ //
+
+ + string:STRING_CONSTANT;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION text n:STRING_CONSTANT length len:INTEGER :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p text n length len;
+ result
+ );
+
+ - make p:POSITION text n:STRING_CONSTANT length len:INTEGER <-
+ (
+ position := p;
+ string := n;
+ dico_string.put len to n;
+ static_type := type_string_constant.default;
+ );
+
+ - my_copy:SELF <- clone;
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + p:STRING_CST;
+ p ?= other;
+ (p != NULL) && {string = p.string}
+ );
+
+ //
+ // Generation.
+ //
+
+ - genere buffer:STRING <-
+ ( + idx,count,cur:INTEGER;
+ - is_init:BOOLEAN;
+ - is_storage:BOOLEAN;
+ - is_count:BOOLEAN;
+
+ (is_init).if_false {
+ is_storage := type_string_constant.get_local_slot (ALIAS_STR.slot_storage)
+ .slot_data_intern.ensure_count != 0;
+ is_count := type_string_constant.get_local_slot (ALIAS_STR.slot_count)
+ .slot_data_intern.ensure_count != 0;
+ is_init := TRUE;
+ };
+
+ count := dico_string.fast_at string;
+ (count >= 0).if {
+ output_count := output_count + 1;
+ idx := output_count;
+
+ cur := output.count - 1;
+ (is_java).if {
+ output.append "private static ";
+ };
+ output.append "__";
+ output.append (type_string_constant.intern_name);
+ output.append " __string_";
+ idx.append_in output;
+ output.add_last '=';
+ (is_java).if {
+ output.append "new __STRING_CONSTANT(";
+ } else {
+ output.add_last '{';
+ (static_type.is_late_binding).if {
+ output.append "__";
+ output.append (static_type.raw.intern_name);
+ output.append "__,";
+ };
+ };
+ (is_count).if {
+ count.append_in output;
+ output.add_last ',';
+ };
+ (is_storage).if {
+ output.add_last '\"';
+ output.append string;
+ {(output.count - cur) > 78}.while_do {
+ output.insert_string "\\\n" to (cur+78);
+ cur := cur + 78;
+ };
+ output.add_last '\"';
+ } else {
+ output.remove_last 1;
+ };
+ (is_java).if {
+ output.append ");\n";
+ } else {
+ output.append "};\n";
+ };
+ dico_string.fast_put (-idx) to string;
+ } else {
+ idx := -count;
+ };
+ //
+ (is_java).if {
+ buffer.append "__string_";
+ idx.append_in buffer;
+ } else {
+ buffer.append "(&__string_";
+ idx.append_in buffer;
+ buffer.add_last ')';
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '\"';
+ buffer.append string;
+ buffer.add_last '\"';
+ display_ref buffer;
+ );
+
+Section Private
+
+ - dico_string:HASHED_DICTIONARY(INTEGER,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(INTEGER,STRING_CONSTANT).create;
+
+
+
+
diff --git a/src2/context/context.li b/src2/context/context.li
new file mode 100644
index 0000000..7c77b33
--- /dev/null
+++ b/src2/context/context.li
@@ -0,0 +1,222 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := CONTEXT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Create a new context for analyser";
+
+ // BSBS: A revoir, car globalement, maintenant on compile
+ // que un slot à la fois, donc, tu n'as plus besoin de ca...
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - stack:FAST_ARRAY(CONTEXT) := FAST_ARRAY(CONTEXT).create_with_capacity 16;
+
+ - top:INTEGER := -1;
+
+Section Public
+
+ //
+ // Extern
+ //
+
+ - push_extern pos:POSITION profil prof:PROFIL_SLOT :LOCAL <-
+ (
+ top := top + 1;
+ (top > stack.upper).if {
+ stack.add_last clone;
+ };
+ stack.item top.elt_push_extern pos profil prof
+ );
+
+ - pop_extern <-
+ (
+ stack.item top.elt_pop_extern;
+ top := top - 1;
+ );
+
+ //
+ // Block.
+ //
+
+ - push_block p:POSITION profil prof:PROFIL_BLOCK :LOCAL <-
+ (
+ top := top + 1;
+ (top > stack.upper).if {
+ stack.add_last clone;
+ };
+ stack.item top.elt_push_block p profil prof
+ );
+
+ - pop_block <-
+ (
+ stack.item top.elt_pop_block;
+ top := top - 1;
+ );
+
+ //
+ // Intern
+ //
+
+ - push_intern p:POSITION <-
+ (
+ top := top + 1;
+ (top > stack.upper).if {
+ stack.add_last clone;
+ };
+ stack.item top.elt_push_intern p;
+ );
+
+ - limit_context:INTEGER <- stack.item top.local;
+
+ - pop_intern <-
+ (
+ stack.item top.elt_pop_intern;
+ top := top - 1;
+ );
+
+Section Private
+
+ + local:INTEGER;
+
+ + result:INTEGER;
+
+ + list:LIST;
+
+ + profil:PROFIL;
+
+ + old_profil_first:PROFIL_SLOT; // BSBS: NE DOIT PAS ETRE UTILE !
+
+ + context_extern:LOCAL;
+
+ //
+ // Extern
+ //
+
+ - elt_push_extern pos:POSITION profil prof:PROFIL_SLOT :LOCAL <-
+ ( + res:LOCAL;
+
+ local := stack_local_lower;
+ result := stack_result_lower;
+ list := list_current;
+ old_profil_first := profil_first;
+ profil := profil_second;
+ //
+ stack_local_lower := stack_local.upper + 1;
+ stack_result_lower := stack_result.upper + 1;
+ list_current := LIST.create pos;
+ profil_second := profil_first := prof;
+ //
+ (debug_level_option != 0).if {
+ // Debug mode : Add context local.
+ res := TYPE_CONTEXT.default.new_local pos name (ALIAS_STR.variable_context) style '+';
+ res.set_ensure_count 1;
+ list_current.add_last (PUSH.create pos context res first TRUE);
+ };
+ res
+ );
+
+ - elt_pop_extern <-
+ (
+ ITM_OBJECT.pop_stack_until stack_local_lower;
+ stack_local_lower := local;
+ stack_result.remove_since stack_result_lower;
+ stack_result_lower := result;
+ list_current := list;
+ profil_second := profil;
+ profil_first := old_profil_first;
+ );
+
+ //
+ // Block
+ //
+
+ - elt_push_block p:POSITION profil prof:PROFIL_BLOCK :LOCAL <-
+ ( + res:LOCAL;
+ local := stack_local.upper + 1;
+ result := stack_result_lower;
+ list := list_current;
+ profil := profil_second;
+ profil_second := prof;
+ //
+ stack_result_lower := stack_result.upper + 1;
+ list_current := LIST.create p;
+ context_extern := ITM_OBJECT.context_extern;
+ ITM_OBJECT.set_context_extern NULL;
+ //
+ (debug_level_option != 0).if {
+ // Debug mode : Add context local.
+ res := TYPE_CONTEXT.default.new_local p name (ALIAS_STR.variable_context) style '+';
+ res.set_ensure_count 1;
+ list_current.add_last (PUSH.create p context res first TRUE);
+ };
+ res
+ );
+
+ - elt_pop_block <-
+ (
+ list_current := list;
+ ITM_OBJECT.pop_stack_until local;
+ stack_result.remove_since stack_result_lower;
+ stack_result_lower := result;
+ (ITM_OBJECT.context_extern = NULL).if {
+ ITM_OBJECT.set_context_extern context_extern;
+ };
+ profil_second := profil;
+ );
+
+ //
+ // Intern
+ //
+
+ - elt_push_intern p:POSITION <-
+ (
+ local := stack_local.upper + 1;
+ result := stack_result_lower;
+ list := list_current;
+ //profil := NULL;
+ //
+ stack_result_lower := stack_result.upper + 1;
+ list_current := LIST.create p;
+ context_extern := ITM_OBJECT.context_extern;
+ ITM_OBJECT.set_context_extern NULL;
+ );
+
+ - elt_pop_intern <-
+ (
+ list_current := list;
+ ITM_OBJECT.pop_stack_until local;
+ stack_result.remove_since stack_result_lower;
+ stack_result_lower := result;
+ (ITM_OBJECT.context_extern = NULL).if {
+ ITM_OBJECT.set_context_extern context_extern;
+ };
+ );
+
diff --git a/src2/dispatcher/dta.li b/src2/dispatcher/dta.li
new file mode 100644
index 0000000..763956c
--- /dev/null
+++ b/src2/dispatcher/dta.li
@@ -0,0 +1,147 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := DTA;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all late binding";
+
+Section Inherit
+
+ + parent_itm_object:Expanded ITM_OBJECT;
+
+Section Public
+
+ + result_expr:EXPR;
+
+ + slot:SLOT;
+
+ + self_arg:EXPR;
+
+ + context:LOCAL;
+
+ //
+ // Service
+ //
+
+ - remove <-
+ (
+ // Nothing.
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append "DTA";
+ deferred;
+ );
+
+Section NODE_TYPE, DTA
+
+ - product t:TYPE with e:EXPR self type_self:TYPE_FULL :LIST <-
+ ( + result:LIST;
+
+ result := LIST.create (e.position);
+ (t = TYPE_NULL).if {
+ TYPE_NULL.product_error position in result;
+ ? {result.count != 0};
+ } else {
+ lookup t with e in result;
+ };
+ result
+ );
+
+ - update_branch l:LIST self type_self:TYPE_FULL :BOOLEAN <-
+ [
+ -? {type_self != NULL};
+ ]
+ ( + node:NODE;
+ + result:BOOLEAN;
+
+ node ?= l.first;
+ (node = NULL).if {
+ result := TRUE;
+ } else {
+
+ /*
+ "DTA: ".print;
+ type_self.print;
+ '\n'.print;
+ */
+ node.update_link type_self;
+ node ?= l.second;
+ (node != NULL).if {
+ node.update_link type_self;
+ };
+ };
+ result
+ );
+
+Section NODE_STYLE, SELF
+
+ - get_argument:FAST_ARRAY(EXPR) <-
+ ( + result:FAST_ARRAY(EXPR);
+
+ result := FAST_ARRAY(EXPR).create_with_capacity 1;
+ result.add_last (self_arg.my_copy);
+ result
+ );
+
+Section DTA
+
+ - finalise typ:TYPE with (expr:EXPR,s:SLOT) in lst:LIST <-
+ ( + node:NODE_STYLE;
+
+ node := NODE_STYLE.create (expr.my_copy,s) with Self result result_expr;
+ lst.add_last node;
+ );
+
+Section Private
+
+ - lookup typ:TYPE with expr:EXPR in lst:LIST <-
+ ( + s:SLOT;
+ + name:STRING_CONSTANT;
+ + node_style:NODE_STYLE;
+ + r:EXPR;
+
+ name := slot.name;
+ s := typ.get_local_slot name;
+ (s = NULL).if {
+ // Lookup parent.
+ s := typ.get_path_slot name;
+ r := s.result_type.get_expr_for typ;
+ node_style := NODE_STYLE.create (expr.my_copy,s) with Self result r;
+ lst.add_last node_style;
+ lst.add_last (NODE_TYPE.create r with Self);
+ } else {
+ // Direct call.
+ s.is_equal_profil slot;
+ finalise typ with (expr,s) in lst;
+ };
+ lst.add_last (PROTOTYPE_CST.create (expr.position) type (TYPE_VOID.default)); // BSBS: Alias.
+ );
diff --git a/src2/dispatcher/dta_block.li b/src2/dispatcher/dta_block.li
new file mode 100644
index 0000000..1120f76
--- /dev/null
+++ b/src2/dispatcher/dta_block.li
@@ -0,0 +1,152 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := DTA_BLOCK;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Lisaac IS A Advanced Compiler";
+
+Section Inherit
+
+ + parent_dta_rd_args:Expanded DTA_RD_ARGS;
+
+Section Public
+
+ + result_expr:EXPR;
+
+ // Add.
+
+ + model:TYPE_BLOCK;
+
+ //
+ // Creation.
+ //
+
+ - create mod:TYPE_BLOCK with larg:FAST_ARRAY(EXPR) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make mod with larg;
+ result
+ );
+
+ - make mod:TYPE_BLOCK with larg:FAST_ARRAY(EXPR) <-
+ (
+ (profil_current = NULL).if {
+ context := context_main;
+ } else {
+ context := profil_current.context;
+ };
+ model := mod;
+ argument_list := larg;
+ result_expr := mod.get_expr_for (mod.position);
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append "DTA_BLOCK";
+ );
+
+Section NODE_STYLE, SELF
+
+ - get_argument:FAST_ARRAY(EXPR) <-
+ ( + result:FAST_ARRAY(EXPR);
+ + rd:READ_SLOT;
+ (copy_argument).if {
+ result := FAST_ARRAY(EXPR).create_with_capacity (argument_list.count);
+ rd ?= argument_list.first;
+ result.add_last (rd.receiver.my_copy);
+ (argument_list.lower+1).to (argument_list.upper) do { j:INTEGER;
+ result.add_last (argument_list.item j.my_copy);
+ };
+ } else {
+ result := argument_list;
+ copy_argument := TRUE;
+ };
+ result
+ );
+
+Section NODE_TYPE, DTA
+
+ - product t:TYPE with e:EXPR self type_self:TYPE_FULL :LIST <-
+ ( + result:LIST;
+ + t_block:PROFIL_BLOCK;
+ + wrt:WRITE;
+ + wrt_larg:FAST_ARRAY(WRITE);
+ + call:CALL_SLOT;
+ + em:EXPR_MULTIPLE;
+ + rd:READ;
+ + result_var:VARIABLE;
+
+ result := LIST.create (e.position);
+ (t = TYPE_NULL).if {
+ TYPE_NULL.product_error (e.position) in result;
+ } else {
+ t_block ?= t;
+
+
+ (t_block = NULL).if { // BSBS: debug
+ "<<<".print;
+ t.print;
+ ">>>".print; '\n'.print;
+ list_current.debug_display;
+ syntax_error (argument_list.first.position,"Block not found");
+ };
+
+ wrt_larg := t_block.write_argument get_argument;
+ call := CALL_SLOT.create (e.position) profil t_block with wrt_larg cop NULL;
+ (result_expr.static_type.raw != TYPE_VOID).if {
+ em ?= result_expr;
+ (em != NULL).if {
+ (em.lower).to (em.upper) do { j:INTEGER;
+ rd ?= em.item j;
+ ? {rd != NULL};
+ result_var := rd.variable;
+ rd := call.profil.result_list.item j.read (e.position);
+ wrt := result_var.write (e.position) value rd;
+ call.result_list.add_last (RESULT.create wrt);
+ };
+ } else {
+ rd ?= result_expr;
+ result_var := rd.variable;
+ rd := call.profil.result_list.first.read (e.position);
+ wrt := result_var.write (e.position) value rd;
+ call.result_list.add_last (RESULT.create wrt);
+ };
+ };
+ result.add_last call;
+ };
+ result
+ );
+
+ - update_branch l:LIST self type_self:TYPE_FULL :BOOLEAN <-
+ (
+ TRUE
+ );
+
+
diff --git a/src/dispatcher/dta_cast.li b/src2/dispatcher/dta_cast.li
similarity index 100%
copy from src/dispatcher/dta_cast.li
copy to src2/dispatcher/dta_cast.li
diff --git a/src/dispatcher/dta_rd.li b/src2/dispatcher/dta_rd.li
similarity index 100%
copy from src/dispatcher/dta_rd.li
copy to src2/dispatcher/dta_rd.li
diff --git a/src2/dispatcher/dta_rd_args.li b/src2/dispatcher/dta_rd_args.li
new file mode 100644
index 0000000..ebd354d
--- /dev/null
+++ b/src2/dispatcher/dta_rd_args.li
@@ -0,0 +1,145 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := DTA_RD_ARGS;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Read site with arguments";
+
+Section Inherit
+
+ + parent_dta:Expanded DTA_RD;
+
+Section Public
+
+ - self_arg:EXPR <- argument_list.first;
+
+ // Add.
+
+ + argument_list:FAST_ARRAY(EXPR);
+
+ + copy_argument:BOOLEAN;
+
+ - parameter_to_type p:ITM_TYPE_PARAMETER :TYPE_FULL <-
+ ( + result:TYPE_FULL;
+ + idx:INTEGER;
+
+ // For Genericity.
+ result := self_arg.static_type.raw.parameter_to_type p;
+ (result = NULL).if {
+ // For Self + type parametric.
+ idx := slot.get_index_argument_type p;
+ (idx != - 1).if {
+ result := argument_list.item idx.static_type;
+ };
+ };
+ result
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION call sl:SLOT with args:FAST_ARRAY(EXPR) intern flag:BOOLEAN :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p call sl with args intern flag;
+ result
+ );
+
+ - make p:POSITION call sl:SLOT with args:FAST_ARRAY(EXPR) intern flag:BOOLEAN <-
+ (
+ position := p;
+ slot := sl;
+ argument_list := args;
+ result_expr := get_expr_result;
+ is_intern := flag;
+ (profil_current = NULL).if {
+ context := context_main;
+ } else {
+ context := profil_current.context;
+ };
+ );
+
+ //
+ // Just for ITM_EXPRESSION
+ //
+
+ - create_partial p:POSITION call sl:SLOT :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make_partial p call sl;
+ result
+ );
+
+ - make_partial p:POSITION call sl:SLOT <-
+ (
+ position := p;
+ slot := sl;
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append "DTA_RD_ARGS:";
+ buffer.append (slot.name);
+ );
+
+ //
+ // Service
+ //
+
+ - remove <-
+ (
+ (! copy_argument).if {
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ argument_list.item j.remove;
+ };
+ copy_argument := TRUE;
+ };
+ );
+
+Section NODE_STYLE, SELF
+
+ - get_argument:FAST_ARRAY(EXPR) <-
+ ( + result:FAST_ARRAY(EXPR);
+
+ (copy_argument).if {
+ result := FAST_ARRAY(EXPR).create_with_capacity (argument_list.count);
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ result.add_last (argument_list.item j.my_copy);
+ };
+ } else {
+ result := argument_list;
+ copy_argument := TRUE;
+ };
+ result
+ );
+
diff --git a/src/dispatcher/dta_wr_code.li b/src2/dispatcher/dta_wr_code.li
similarity index 100%
copy from src/dispatcher/dta_wr_code.li
copy to src2/dispatcher/dta_wr_code.li
diff --git a/src/dispatcher/dta_wr_value.li b/src2/dispatcher/dta_wr_value.li
similarity index 100%
copy from src/dispatcher/dta_wr_value.li
copy to src2/dispatcher/dta_wr_value.li
diff --git a/src2/dispatcher/node.li b/src2/dispatcher/node.li
new file mode 100644
index 0000000..888c3e7
--- /dev/null
+++ b/src2/dispatcher/node.li
@@ -0,0 +1,317 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := NODE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all switch node";
+
+Section Inherit
+
+ + parent_instr:Expanded INSTR;
+
+Section NODE, PROFIL_BLOCK, ITM_OLD
+
+ - node_list_base:LINKED_LIST(NODE_TYPE) := node_list;
+
+ - node_list:LINKED_LIST(NODE_TYPE) := LINKED_LIST(NODE_TYPE).create;
+
+ - set_node_list l:LINKED_LIST(NODE_TYPE) <-
+ (
+ node_list := l;
+ );
+
+Section PROTOTYPE
+
+ - extend_pass <-
+ ( + j:INTEGER;
+ + is_ok:BOOLEAN;
+
+ //NODE_TYPE.reset_count_flat;
+
+ VARIABLE.update;
+ j := node_list.lower;
+ {j <= node_list.upper}.while_do {
+ is_ok := node_list.item j.update;
+ (is_ok).if {
+ node_list.remove j;
+ } else {
+ j := j + 1;
+ };
+ };
+ /*
+ NODE_TYPE.count_flat.print;
+ '/'.print;
+ (NODE_TYPE.count_flat + NODE_TYPE.count_not_flat).print;
+ '\n'.print;
+ */
+ );
+
+Section Public
+
+ //
+ // Extern Creation read.
+ //
+
+ - new_read p:POSITION slot s:SLOT receiver rec:EXPR
+ self my_self:EXPR intern is_intern:BOOLEAN :NODE <-
+ ( + result:NODE_TYPE;
+ + dta:DTA_RD;
+ //
+ dta := DTA_RD.create p call s self my_self intern is_intern;
+ result := NODE_TYPE.create rec with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+ - new_read p:POSITION slot s:SLOT receiver rec:EXPR
+ with larg:FAST_ARRAY(EXPR) intern is_intern:BOOLEAN :NODE <-
+ ( + dta:DTA_RD_ARGS;
+ + result:NODE_TYPE;
+
+ // Control argument type.
+ dta := DTA_RD_ARGS.create p call s with larg intern is_intern;
+ s.check_argument_type larg for dta;
+ result := NODE_TYPE.create rec with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+ //
+ // Just for ITM_EXPRESSION.
+ //
+
+ - new_read_partial p:POSITION slot s:SLOT :NODE_TYPE <-
+ ( + dta:DTA_RD_ARGS;
+
+ dta := DTA_RD_ARGS.create_partial p call s;
+ NODE_TYPE.create_partial dta
+ );
+
+ - new_read_finalize (rec:EXPR,s:SLOT) with larg:FAST_ARRAY(EXPR) <-
+ ( + dta:DTA_RD_ARGS;
+ // Control argument type.
+ dta ?= data;
+
+ dta.make (data.position) call s with larg intern FALSE;
+ data.slot.check_argument_type larg for dta;
+ make rec with data;
+ //
+ node_list.add_last Self;
+ );
+
+ //
+ // Extern creation writes.
+ //
+
+ - new_write p:POSITION slot s:SLOT receiver rec:EXPR value val:EXPR :NODE <-
+ ( + dta:DTA_WR_VALUE;
+ + result:NODE_TYPE;
+
+ dta := DTA_WR_VALUE.create p slot s self rec value val;
+ result := NODE_TYPE.create rec with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+ - new_write p:POSITION slot s:SLOT receiver rec:EXPR code val:ITM_CODE :NODE <-
+ ( + dta:DTA_WR_CODE;
+ + result:NODE_TYPE;
+
+ dta := DTA_WR_CODE.create p slot s self rec code val;
+ result := NODE_TYPE.create rec with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+ //
+ // Extern creation cast.
+ //
+
+ - new_cast p:POSITION type typ:TYPE_FULL with val:EXPR :NODE <-
+ ( + dta:DTA_CAST;
+ + result:NODE_TYPE;
+
+ dta := DTA_CAST.create p type typ;
+ result := NODE_TYPE.create val with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+ //
+ // Extern creation value block.
+ //
+
+ - new_block p:POSITION receiver e:EXPR with larg:FAST_ARRAY(EXPR) :NODE <-
+ ( + dta:DTA_BLOCK;
+ + result:NODE_TYPE;
+ + lst_typ_f:FAST_ARRAY(TYPE_FULL);
+ + new_expr:EXPR;
+ + block_model:TYPE_BLOCK;
+ + pb:PROFIL_BLOCK;
+ + pos:POSITION;
+
+ pb ?= e.static_type.raw;
+ (pb = NULL).if {
+ block_model ?= e.static_type.raw;
+ } else {
+ block_model := pb.to_type_block;
+ };
+ // Control argument type.
+ lst_typ_f := block_model.argument_list;
+ pos := block_model.position;
+
+ (lst_typ_f.count+1 != larg.count).if {
+ string_tmp.copy "Incorrect size of vector argument for this block. (Value:";
+ larg.count.append_in string_tmp;
+ string_tmp.append ", Type:";
+ (lst_typ_f.count+1).append_in string_tmp;
+ string_tmp.add_last ')';
+ POSITION.put_error semantic text string_tmp;
+ pos.put_position;
+ p .put_position;
+ POSITION.send_error;
+ };
+ (larg.lower + 1).to (larg.upper) do { j:INTEGER;
+ new_expr := larg.item j.check_type (lst_typ_f.item (j-1)) with pos;
+ larg.put new_expr to j;
+ };
+ //
+ (debug_level_option != 0).if {
+ (profil_current = NULL).if {
+ crash_with_message "NODE";
+ };
+ list_current.add_last (
+ PUSH.create p context (profil_current.context) first FALSE
+ );
+ };
+ //
+ dta := DTA_BLOCK.create block_model with larg;
+ result := NODE_TYPE.create e with dta;
+ //
+ node_list.add_last result;
+ result
+ );
+
+Section Public
+
+ - position:POSITION <- data.position;
+
+ + data:DTA;
+
+ + expr:EXPR;
+
+ + first_code:LIST;
+ + first_type:TYPE;
+ + switch:SWITCH;
+
+ - count:INTEGER <-
+ ( + result:INTEGER;
+
+ (switch != NULL).if {
+ result := switch.count;
+ }.elseif {first_type != NULL} then {
+ result := 1;
+ };
+ result
+ );
+
+ - result_expr:EXPR <- deferred;
+
+ //
+ // Execute.
+ //
+
+ - remove <-
+ (
+ data.remove;
+ (switch = NULL).if {
+ expr.remove;
+ (first_code != NULL).if {
+ first_code.remove;
+ };
+ } else {
+ switch.remove;
+ };
+ );
+
+ - execute:INSTR <-
+ ( + result:INSTR;
+
+ data.remove;
+ (switch != NULL).if {
+ result := switch.execute;
+ } else {
+ expr.remove;
+ (first_code != NULL).if { // Warning: Dead Code!
+ result := first_code.execute;
+ };
+ };
+ result
+ );
+
+
+Section NODE, DTA
+
+ //
+ // Update.
+ //
+
+ - update_link self_type:TYPE_FULL :BOOLEAN <-
+ (
+ deferred;
+ );
+
+Section Public
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ (switch = NULL).if {
+ (first_code = NULL).if {
+ to_pointer.append_in buffer;
+ buffer.append "<NODE VIDE=";
+ expr.display buffer;
+ buffer.append ", Data: ";
+ data.display buffer;
+ buffer.append ", Result: ";
+ result_expr.display buffer;
+ buffer.add_last '>';
+ } else {
+ expr.display buffer;
+ first_code.display buffer;
+ };
+ } else {
+ switch.display buffer;
+ };
+ );
+
diff --git a/src2/dispatcher/node_style.li b/src2/dispatcher/node_style.li
new file mode 100644
index 0000000..485344d
--- /dev/null
+++ b/src2/dispatcher/node_style.li
@@ -0,0 +1,316 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := NODE_STYLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Switch node for style";
+
+Section Inherit
+
+ + parent_node:Expanded NODE;
+
+Section Public
+
+ + result_expr:EXPR;
+
+ + slot:SLOT;
+
+Section NODE, DTA
+
+ //
+ // Creation.
+ //
+
+ - create (e:EXPR,sl:SLOT) with dta:DTA result r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make (e,sl) with dta result r;
+ result
+ );
+
+ - make (e:EXPR,sl:SLOT) with dta:DTA result r:EXPR <-
+ (
+ expr := e;
+ slot := sl;
+ data := dta;
+ result_expr := r;
+ );
+
+Section Public
+
+ - my_copy:SELF <-
+ (
+ crash_with_message "NODE_STYLE.my_copy";
+ NULL
+ );
+
+Section NODE, DTA
+
+ //
+ // Update.
+ //
+
+ - update_link self_type:TYPE_FULL :BOOLEAN <-
+ [
+ -? {self_type != NULL};
+ ]
+ ( + typ:TYPE;
+ + list:FAST_ARRAY(CASE);
+ + case:CASE;
+ + e:EXPR;
+ + low,up,count:INTEGER;
+
+ (slot.slot_id = NULL).if {
+ (first_code = NULL).if {
+ first_type := TYPE_ID.get_index (slot.lower_style);
+ first_code := call_for first_type self self_type;
+ };
+ } else {
+ low := slot.lower_style;
+ up := slot.upper_style;
+ count := up-low + 1;
+ (switch = NULL).if {
+ (slot.style = '-').if {
+ e := slot.slot_id.read position;
+ expr.remove;
+ } else {
+ e := slot.slot_id.read position with expr;
+ };
+ switch := SWITCH.create Self with e size count;
+ };
+ list := switch.list;
+ (list.count != count).if {
+ 0.to (count-1) do { j:INTEGER;
+ typ := TYPE_ID.get_index (j+low);
+
+ ((j > list.upper) || {typ != list.item j.id}).if {
+ case := CASE.create typ with (call_for typ self self_type);
+ list.add case to j;
+ };
+ };
+ };
+ };
+ FALSE
+ );
+
+Section Private
+
+ - call_for t:TYPE self type_self:TYPE_FULL :LIST <-
+ [
+ -? {type_self != NULL};
+ ]
+ ( + result:LIST;
+ + typ:TYPE_ID;
+ + call:CALL_SLOT;
+ + em:EXPR_MULTIPLE;
+ + rd:READ;
+ + wrt:WRITE;
+ + result_var:VARIABLE;
+ + new_larg:FAST_ARRAY(EXPR);
+ + slot_dta:SLOT_DATA;
+ + slot_cod:SLOT_CODE;
+ + idx:INTEGER;
+ + type:TYPE_FULL;
+ + my_profil:PROFIL;
+ + wrt_lst:FAST_ARRAY(WRITE);
+ + ctext:LOCAL;
+ + new_type_self:TYPE_FULL;
+ + data_rd:DTA_RD;
+ + cop_arg:EXPR;
+ + new_val:EXPR;
+
+ result := LIST.create position;
+
+ data_rd ?= data;
+ ((type_self.prototype.style = '-') && {data_rd != NULL} && {! data_rd.is_intern}).if {
+ cop_arg := data.self_arg.my_copy;
+ };
+
+ typ ?= t;
+ idx := typ.index;
+ (idx = 0).if {
+ // Data.
+ (cop_arg != NULL).if {
+ result.add_last (COP_LOCK.create position with cop_arg);
+ };
+ //
+ slot_dta := slot.slot_data;
+ slot_dta.init;
+ (slot.slot_data_list != NULL).if {
+ (slot.slot_data_list.lower).to (slot.slot_data_list.upper) do { j:INTEGER;
+ slot.slot_data_list.item j.init;
+ };
+ };
+ //
+ (result_expr.static_type.raw = TYPE_VOID).if {
+ // BSBS: Pourquoi tu produit quelque chose qui serre à rien ???
+ (slot_dta.style = '-').if {
+ result.add_last (slot_dta.read position);
+ } else {
+ result.add_last (slot_dta.read position with (expr.my_copy));
+ };
+ } else {
+ em ?= result_expr;
+ (em != NULL).if {
+ (em.lower).to (em.upper - 1) do { j:INTEGER;
+ rd ?= em.item j;
+ ? {rd != NULL};
+ result_var := rd.variable;
+ result.add_last (new_write result_var with (expr,slot.slot_data_list.item j));
+ };
+ rd ?= em.last;
+ } else {
+ rd ?= result_expr;
+ };
+
+ //(slot_dta.name == "storage").if {
+ /*
+ string_tmp.clear;
+ string_tmp.copy (type_self.raw.name);
+ string_tmp.add_last ' ';
+ string_tmp.append (t.name);
+ (data.slot != NULL).if {
+ string_tmp.add_last ' ';
+ string_tmp.append (data.slot.name);
+ };
+ result.add_last (
+ EXTERNAL_C.create position text (ALIAS_STR.get string_tmp) access NULL persistant TRUE type (TYPE_NULL.default)
+ );
+ */
+ /*
+ "Data : ".print; slot_dta.intern_name.print;
+ " dans ".print; type_self.raw.name.print;
+ (profil_current != NULL).if {
+ profil_current.name.print;
+ };
+ '\n'.print;
+ */
+ //};
+ result_var := rd.variable;
+ result.add_last (new_write result_var with (expr,slot_dta));
+ };
+ (cop_arg != NULL).if {
+ result.add_last (COP_UNLOCK.create position);
+ };
+ } else {
+ // Function.
+ slot_cod := slot.slot_code idx;
+ (slot_cod.id_section.is_inherit_or_insert).if {
+ new_larg := FAST_ARRAY(EXPR).create_with_capacity 1;
+ new_larg.add_last (data.self_arg.my_copy);
+ } else {
+ new_larg := data.get_argument;
+ };
+ type := new_larg.first.static_type;
+ ? {type != NULL};
+ //
+ (debug_level_option != 0).if {
+ // BSBS: Poser le PUSH avant le NODE
+ (data.context = NULL).if {
+ ctext := context_main;
+ } else {
+ ctext := data.context;
+ };
+ result.add_last (
+ PUSH.create position context ctext first FALSE
+ );
+ };
+ //
+ rd ?= new_larg.first;
+ ((rd != NULL) && {rd.variable.name = ALIAS_STR.variable_self}).if {
+ // Fix Self type for resend call (else it's fixed by NODE_TYPE)
+ new_type_self := type;
+ } else {
+ new_type_self := type_self;
+ };
+ /*
+ string_tmp.copy "// ";
+ new_type_self.display string_tmp;
+ string_tmp.append " / ";
+ type_self.display string_tmp;
+ result.add_last (
+ EXTERNAL_C.create (data.position)
+ text (ALIAS_STR.get string_tmp) access NULL persistant TRUE type (TYPE_VOID.default)
+ );
+ */
+ new_val := CAST.create new_type_self value (new_larg.first);
+ new_larg.put new_val to 0;
+ (my_profil, wrt_lst) := slot_cod.get_profil new_larg self new_type_self;
+ //
+ (result_expr.static_type.raw = TYPE_VOID).if {
+ result.add_last (
+ CALL_SLOT.create position profil my_profil with wrt_lst cop cop_arg
+ );
+ } else {
+ call := CALL_SLOT.create position profil my_profil with wrt_lst cop NULL;
+ (cop_arg != NULL).if {
+ result.add_last (COP_LOCK.create position with cop_arg);
+ result.add_last call;
+ result.add_last (COP_UNLOCK.create position);
+ } else {
+ result.add_last call;
+ };
+ em ?= result_expr;
+ (em != NULL).if {
+ (em.lower).to (em.upper) do { j:INTEGER;
+ rd ?= em.item j;
+ ? {rd != NULL};
+ result_var := rd.variable;
+ rd := call.profil.result_list.item j.read position;
+ wrt := result_var.write position value rd;
+ call.result_list.add_last (RESULT.create wrt);
+ };
+ }.elseif {
+ (call.profil.result_list.count != 0) ||
+ {call.is_interrupt}
+ } then {
+ rd ?= result_expr;
+ result_var := rd.variable;
+ (call.is_interrupt).if_false {
+ rd := call.profil.result_list.first.read position;
+ };
+ wrt := result_var.write position value rd;
+ call.result_list.add_last (RESULT.create wrt);
+ };
+ };
+ };
+ result
+ );
+
+Section Private
+
+ - new_write var:VARIABLE with (e:EXPR,slot:SLOT_DATA) :WRITE <-
+ ( + rd:READ;
+
+ (slot.style = '-').if {
+ rd := slot.read position;
+ } else {
+ rd := slot.read position with (e.my_copy);
+ };
+ var.write position value rd
+ );
+
\ No newline at end of file
diff --git a/src2/dispatcher/node_type.li b/src2/dispatcher/node_type.li
new file mode 100644
index 0000000..7128f9f
--- /dev/null
+++ b/src2/dispatcher/node_type.li
@@ -0,0 +1,222 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := NODE_TYPE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Switch node for type";
+
+Section Inherit
+
+ + parent_node:Expanded NODE;
+
+Section Public
+
+ - result_expr:EXPR <- data.result_expr;
+
+ + is_self:BOOLEAN;
+
+ //
+ // Creation.
+ //
+
+ - create e:EXPR with d:DTA :SELF <-
+ // Create with back-link.
+ ( + result:SELF;
+
+ result := clone;
+ result.make e with d;
+ result
+ );
+
+ - make e:EXPR with d:DTA <-
+ (
+ expr := e;
+ data := d;
+ late_binding_counter := late_binding_counter + 1;
+ );
+
+ //
+ // Just for ITM_EXPRESSION
+ //
+
+ - create_partial d:DTA :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make_partial d;
+ result
+ );
+
+ - make_partial d:DTA <-
+ (
+ data := d;
+ );
+
+Section Public
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+
+ result := SELF.create (expr.my_copy) with data;
+ node_list.add_last result;
+ result
+ );
+
+ //
+ // Update.
+ //
+
+ - update:BOOLEAN <-
+ (
+ update_case NULL & update_depth NULL
+ );
+
+Section NODE, DTA
+
+ - update_link self_type:TYPE_FULL :BOOLEAN <-
+ (
+ update_case self_type & update_depth self_type
+ );
+
+Section Private
+
+ - update_case type_self:TYPE_FULL :BOOLEAN <-
+ ( + typ_f:TYPE_FULL;
+ + typ:TYPE;
+ + lst_typ:TYPES_TMP;
+ + list:FAST_ARRAY(CASE);
+ + case:CASE;
+ + result:BOOLEAN;
+
+ typ_f := expr.static_type;
+
+ (typ_f.is_expanded && {typ_f.raw != type_boolean}).if {
+ (first_code = NULL).if {
+ first_type := typ_f.raw;
+ first_code := data.product first_type with expr self type_self;
+ };
+ result := TRUE;
+ }.elseif {(typ_f.raw = type_boolean) && {count = 2}} then {
+ result := TRUE;
+ } else {
+ ((typ_f.raw.is_block) || {typ_f.raw.subtype_list.count != count}).if {
+ lst_typ := TYPES_TMP.new;
+ expr.get_type lst_typ;
+ /*
+ ((data.slot != NULL) && {data.slot.name == "storage"}).if {
+ lst_typ.print; '\n'.print;
+ };
+ */
+
+ (! lst_typ.is_empty).if {
+ (lst_typ.count = 1).if {
+ (first_code = NULL).if {
+ first_type := lst_typ.first;
+ first_code := data.product first_type with expr self type_self;
+ };
+ } else {
+ (switch = NULL).if {
+ switch := SWITCH.create Self with expr size (lst_typ.count);
+ };
+ list := switch.list;
+ (list.count != lst_typ.count).if {
+ (lst_typ.lower).to (lst_typ.upper) do { j:INTEGER;
+ typ := lst_typ.item j;
+ ((j > list.upper) || {typ != list.item j.id}).if {
+ add_stack_type typ;
+ //
+ case := CASE.create typ with (data.product typ with expr self type_self);
+ list.add case to j;
+ //
+ stack_type.remove_last;
+ };
+ };
+ };
+ };
+ };
+ lst_typ.free;
+ } else {
+ //count_flat := count_flat + 1;
+ //"Yes\n".print;
+ };
+ };
+ result
+ );
+
+ - update_depth self_type:TYPE_FULL :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + list:FAST_ARRAY(CASE);
+ + new_type_self:TYPE_FULL;
+
+ (switch = NULL).if {
+ (first_code != NULL).if {
+ (self_type = NULL).if {
+ new_type_self := expr.static_type;
+ (! new_type_self.is_expanded).if {
+ new_type_self := first_type.default.to_strict;
+ };
+ } else {
+ new_type_self := self_type;
+ };
+
+ add_stack_type first_type;
+ result := data.update_branch first_code self new_type_self;
+ stack_type.remove_last;
+ };
+ } else {
+ list := switch.list;
+
+ (list.lower).to (list.upper) do { j:INTEGER;
+ (self_type = NULL).if {
+ new_type_self := list.item j.id.default.to_strict;
+ } else {
+ new_type_self := self_type;
+ };
+ add_stack_type (list.item j.id);
+ data.update_branch (list.item j.code) self new_type_self;
+ stack_type.remove_last;
+ };
+ };
+ result
+ );
+
+Section Private
+
+ - stack_type:FAST_ARRAY(TYPE) := FAST_ARRAY(TYPE).create_with_capacity 16;
+
+ - add_stack_type t:TYPE <-
+ (
+ stack_type.add_last t;
+ ((stack_type.count > 1) && {stack_type.first = t}).if {
+ string_tmp.copy "Cyclic inheritance : ";
+ (stack_type.lower).to (stack_type.upper) do { j:INTEGER;
+ stack_type.item j.append_name_in string_tmp;
+ string_tmp.append ", ";
+ };
+ string_tmp.append "...";
+ semantic_error (data.position, string_tmp);
+ };
+ );
\ No newline at end of file
diff --git a/src/external/arithmetic/avoir.txt b/src2/external/arithmetic/avoir.txt
similarity index 100%
copy from src/external/arithmetic/avoir.txt
copy to src2/external/arithmetic/avoir.txt
diff --git a/src/external/arithmetic/expr_add.li b/src2/external/arithmetic/expr_add.li
similarity index 100%
copy from src/external/arithmetic/expr_add.li
copy to src2/external/arithmetic/expr_add.li
diff --git a/src/external/arithmetic/expr_and.li b/src2/external/arithmetic/expr_and.li
similarity index 100%
copy from src/external/arithmetic/expr_and.li
copy to src2/external/arithmetic/expr_and.li
diff --git a/src2/external/arithmetic/expr_binary.li b/src2/external/arithmetic/expr_binary.li
new file mode 100644
index 0000000..e1a656d
--- /dev/null
+++ b/src2/external/arithmetic/expr_binary.li
@@ -0,0 +1,220 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_BINARY;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Binary Expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- left.is_invariant && {right.is_invariant};
+
+ + left:EXPR;
+
+ + right:EXPR;
+
+ - symbol:STRING_CONSTANT <-
+ (
+ deferred;
+ NULL
+ );
+
+ - static_type:TYPE_FULL <- left.static_type;
+
+ - get_type t:TYPES_TMP <-
+ (
+ left .get_type t;
+ //right.get_type t;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with l:EXPR and r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with l and r;
+ result
+ );
+
+ - make p:POSITION with l:EXPR and r:EXPR <-
+ (
+ position := p;
+ left := l;
+ right := r;
+ );
+
+ - my_copy:SELF <- SELF.create position with (left.my_copy) and (right.my_copy);
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + same:SELF;
+
+ same ?= other;
+ (same != NULL) && {left == same.left} && {right == same.right}
+ );
+
+ //
+ // Remove
+ //
+
+ - remove <-
+ (
+ left .remove;
+ right.remove;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_unlink:INSTR <-
+ ( + instr:INSTR;
+ instr := left.execute_unlink;
+ (instr != NULL).if {
+ list_current.insert_before instr;
+ };
+ right.execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + result:EXPR;
+ + old_seq:UINTEGER_32;
+ + left_cst,right_cst:INTEGER_CST;
+
+ old_seq := seq_call_and_loop;
+ left := left.execute_link;
+ right := right.execute_link;
+ //
+ left_cst ?= left;
+ right_cst ?= right;
+ // Conservator transformation.
+ result := exec_conservator;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_conservator_left left_cst;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_conservator_right right_cst;
+ };
+ (
+ (result = NULL) &&
+ {right_cst != NULL} &&
+ {left_cst != NULL}
+ ).if {
+ result := exec left_cst and right_cst;
+ };
+ ((result = NULL) && {old_seq = seq_call_and_loop}).if {
+ // No conservator transformation.
+ result := exec;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_left left_cst;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_right right_cst;
+ };
+ };
+ (result = NULL).if {
+ result := Self;
+ } else {
+ result.set_position position;
+ new_execute_pass;
+ };
+
+ result
+ );
+
+ - exec_conservator:EXPR <- NULL;
+ - exec_conservator_left left_cst :INTEGER_CST :EXPR <- NULL;
+ - exec_conservator_right right_cst:INTEGER_CST :EXPR <- NULL;
+
+ - exec left_cst:INTEGER_CST and right_cst:INTEGER_CST :EXPR <- NULL;
+
+ - exec:EXPR <- NULL;
+ - exec_left left_cst :INTEGER_CST :EXPR <- NULL;
+ - exec_right right_cst:INTEGER_CST :EXPR <- NULL;
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ (
+ (static_type.raw = type_pointer).if {
+ buffer.append "(void *)";
+ } else {
+ buffer.add_last '(';
+ static_type.genere_declaration buffer;
+ buffer.add_last ')';
+ };
+ buffer.add_last '(';
+ (static_type.raw = type_pointer).if {
+ buffer.append "(unsigned long)";
+ }.elseif {! left.static_type.is_expanded} then {
+ buffer.append "(void *)"; // BSBS: A virer quand tu auras optim '=='
+ };
+ left.genere buffer;
+ buffer.add_last ' ';
+ buffer.append symbol;
+ buffer.add_last ' ';
+ (static_type.raw = type_pointer).if {
+ buffer.append "(unsigned long)";
+ }.elseif {! right.static_type.is_expanded} then {
+ buffer.append "(void *)"; // BSBS: A virer quand tu auras optim '=='
+ };
+ right.genere buffer;
+ buffer.add_last ')';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ left.display buffer;
+ buffer.append symbol;
+ right.display buffer;
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/external/arithmetic/expr_div.li b/src2/external/arithmetic/expr_div.li
similarity index 100%
copy from src/external/arithmetic/expr_div.li
copy to src2/external/arithmetic/expr_div.li
diff --git a/src/external/arithmetic/expr_mod.li b/src2/external/arithmetic/expr_mod.li
similarity index 100%
copy from src/external/arithmetic/expr_mod.li
copy to src2/external/arithmetic/expr_mod.li
diff --git a/src/external/arithmetic/expr_mul.li b/src2/external/arithmetic/expr_mul.li
similarity index 100%
copy from src/external/arithmetic/expr_mul.li
copy to src2/external/arithmetic/expr_mul.li
diff --git a/src/external/arithmetic/expr_neg.li b/src2/external/arithmetic/expr_neg.li
similarity index 100%
copy from src/external/arithmetic/expr_neg.li
copy to src2/external/arithmetic/expr_neg.li
diff --git a/src/external/arithmetic/expr_not.li b/src2/external/arithmetic/expr_not.li
similarity index 100%
copy from src/external/arithmetic/expr_not.li
copy to src2/external/arithmetic/expr_not.li
diff --git a/src/external/arithmetic/expr_or.li b/src2/external/arithmetic/expr_or.li
similarity index 100%
copy from src/external/arithmetic/expr_or.li
copy to src2/external/arithmetic/expr_or.li
diff --git a/src/external/arithmetic/expr_shift_l.li b/src2/external/arithmetic/expr_shift_l.li
similarity index 100%
copy from src/external/arithmetic/expr_shift_l.li
copy to src2/external/arithmetic/expr_shift_l.li
diff --git a/src/external/arithmetic/expr_shift_r.li b/src2/external/arithmetic/expr_shift_r.li
similarity index 100%
copy from src/external/arithmetic/expr_shift_r.li
copy to src2/external/arithmetic/expr_shift_r.li
diff --git a/src/external/arithmetic/expr_sub.li b/src2/external/arithmetic/expr_sub.li
similarity index 100%
copy from src/external/arithmetic/expr_sub.li
copy to src2/external/arithmetic/expr_sub.li
diff --git a/src2/external/arithmetic/expr_unary.li b/src2/external/arithmetic/expr_unary.li
new file mode 100644
index 0000000..a145966
--- /dev/null
+++ b/src2/external/arithmetic/expr_unary.li
@@ -0,0 +1,171 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_UNARY;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Unary Expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- right.is_invariant;
+
+ + right:EXPR;
+
+ - symbol:CHARACTER <-
+ (
+ deferred;
+ ' '
+ );
+
+ - static_type:TYPE_FULL <- right.static_type;
+
+ - get_type t:TYPES_TMP <-
+ (
+ t.add (static_type.raw);
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with r;
+ result
+ );
+
+ - make p:POSITION with r:EXPR <-
+ (
+ position := p;
+ right := r;
+ );
+
+ - my_copy:SELF <- SELF.create position with (right.my_copy);
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + same:SELF;
+
+ same ?= other;
+ (same != NULL) && {right == same.right}
+ );
+
+ - remove <-
+ (
+ right.remove;
+ );
+
+ //
+ // Execute.
+ //
+
+ - execute_unlink:INSTR <-
+ (
+ right.execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + result:EXPR;
+ + old_seq:UINTEGER_32;
+ + right_cst:INTEGER_CST;
+
+ old_seq := seq_call_and_loop;
+ right := right.execute_link;
+ //
+ right_cst ?= right;
+ // Conservator transformation.
+ result := exec_conservator;
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_right right_cst;
+ };
+ ((result = NULL) && {old_seq = seq_call_and_loop}).if {
+ // No conservator transformation.
+ result := exec;
+ };
+ (result = NULL).if {
+ result := Self;
+ } else {
+ result.set_position position;
+ new_execute_pass;
+ };
+
+ result
+ );
+
+ - exec_conservator:EXPR <- NULL;
+
+ - exec_right right_cst:INTEGER_CST :EXPR <- NULL;
+
+ - exec:EXPR <- NULL;
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '(';
+ static_type.genere_declaration buffer;
+ buffer.add_last ')';
+ //
+ buffer.add_last '(';
+ buffer.add_last symbol;
+ buffer.add_last ' ';
+ right.genere buffer;
+ buffer.add_last ')';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ buffer.add_last symbol;
+ buffer.add_last ' ';
+ right.display buffer;
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src/external/arithmetic/expr_xor.li b/src2/external/arithmetic/expr_xor.li
similarity index 100%
copy from src/external/arithmetic/expr_xor.li
copy to src2/external/arithmetic/expr_xor.li
diff --git a/src/external/call_null.li b/src2/external/call_null.li
similarity index 100%
copy from src/external/call_null.li
copy to src2/external/call_null.li
diff --git a/src2/external/comparison/expr_binary_cmp.li b/src2/external/comparison/expr_binary_cmp.li
new file mode 100644
index 0000000..6ec7670
--- /dev/null
+++ b/src2/external/comparison/expr_binary_cmp.li
@@ -0,0 +1,243 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_BINARY_CMP;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Binary comparison expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- left.is_invariant && {right.is_invariant};
+
+ + left:EXPR;
+
+ + right:EXPR;
+
+ - set_left l:EXPR and_right r:EXPR <-
+ (
+ left := l;
+ right := r;
+ );
+
+ - symbol:STRING_CONSTANT <-
+ (
+ deferred;
+ NULL
+ );
+
+ - static_type:TYPE_FULL <- type_boolean.default;
+
+ - get_type t:TYPES_TMP <-
+ (
+ t.add type_true;
+ t.add type_false;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with l:EXPR and r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with l and r;
+ result
+ );
+
+ - make p:POSITION with l:EXPR and r:EXPR <-
+ (
+ position := p;
+ left := l;
+ right := r;
+ );
+
+ - my_copy:SELF <- SELF.create position with (left.my_copy) and (right.my_copy);
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + same:SELF;
+
+ same ?= other;
+ (same != NULL) && {left == same.left} && {right == same.right}
+ );
+
+ //
+ // Remove
+ //
+
+ - remove <-
+ (
+ left .remove;
+ right.remove;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_unlink:INSTR <-
+ ( + instr:INSTR;
+ instr := left.execute_unlink;
+ (instr != NULL).if {
+ list_current.insert_before instr;
+ };
+ right.execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + result:EXPR;
+ + old_seq:UINTEGER_32;
+ + left_cst,right_cst:INTEGER_CST;
+
+ old_seq := seq_call_and_loop;
+ left := left .execute_link;
+ right := right.execute_link;
+ //
+ left_cst ?= left;
+ right_cst ?= right;
+ // Conservator transformation.
+ result := exec_conservator;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_conservator_left left_cst;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_conservator_right right_cst;
+ };
+ (
+ (result = NULL) &&
+ {right_cst != NULL} &&
+ {left_cst != NULL}
+ ).if {
+ result := exec left_cst and right_cst;
+ };
+ ((result = NULL) && {old_seq = seq_call_and_loop}).if {
+ // No conservator transformation.
+ result := exec;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_left left_cst;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_right right_cst;
+ };
+ };
+ //
+ (result = NULL).if {
+ result := Self;
+ } else {
+ result.set_position position;
+ new_execute_pass;
+ };
+
+ result
+ );
+
+ - exec_conservator:EXPR <- NULL;
+ - exec_conservator_left left_cst :INTEGER_CST :EXPR <- NULL;
+ - exec_conservator_right right_cst:INTEGER_CST :EXPR <- NULL;
+
+ - exec left_cst:INTEGER_CST and right_cst:INTEGER_CST :EXPR <- NULL;
+
+ - exec:EXPR <- NULL;
+ - exec_left left_cst :INTEGER_CST :EXPR <- NULL;
+ - exec_right right_cst:INTEGER_CST :EXPR <- NULL;
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '(';
+ (
+ (left.static_type.raw = type_pointer) &&
+ {ALIAS_STR.is_integer (right.static_type.raw.name)}
+ ).if {
+ buffer.append "(unsigned long)";
+ }.elseif {! left.static_type.is_expanded} then {
+ buffer.append "(void *)"; // BSBS: A virer quand tu auras optim '=='
+ };
+ ((left.static_type.raw = TYPE_NULL) && {right.static_type.raw.is_block}).if {
+ buffer.add_last '0';
+ } else {
+ left.genere buffer;
+ (left.static_type.raw.is_block).if {
+ buffer.append ".__id";
+ };
+ };
+ buffer.add_last ' ';
+ buffer.append symbol;
+ buffer.add_last ' ';
+
+ (
+ (ALIAS_STR.is_integer (left.static_type.raw.name)) &&
+ {right.static_type.raw = type_pointer}
+ ).if {
+ buffer.append "(unsigned long)";
+ }.elseif {! right.static_type.is_expanded} then {
+ buffer.append "(void *)"; // BSBS: A virer quand tu auras optim '=='
+ };
+ ((right.static_type.raw = TYPE_NULL) && {left.static_type.raw.is_block}).if {
+ buffer.add_last '0';
+ } else {
+ right.genere buffer;
+ (right.static_type.raw.is_block).if {
+ buffer.append ".__id";
+ };
+ };
+ buffer.add_last ')';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ left.static_type.append_name_in buffer;
+ buffer.add_last ' ';
+ left.display buffer;
+ buffer.append symbol;
+ right.display buffer;
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/external/comparison/expr_equal.li b/src2/external/comparison/expr_equal.li
similarity index 100%
copy from src/external/comparison/expr_equal.li
copy to src2/external/comparison/expr_equal.li
diff --git a/src/external/comparison/expr_inf.li b/src2/external/comparison/expr_inf.li
similarity index 100%
copy from src/external/comparison/expr_inf.li
copy to src2/external/comparison/expr_inf.li
diff --git a/src/external/comparison/expr_inf_eq.li b/src2/external/comparison/expr_inf_eq.li
similarity index 100%
copy from src/external/comparison/expr_inf_eq.li
copy to src2/external/comparison/expr_inf_eq.li
diff --git a/src/external/comparison/expr_not_equal.li b/src2/external/comparison/expr_not_equal.li
similarity index 100%
copy from src/external/comparison/expr_not_equal.li
copy to src2/external/comparison/expr_not_equal.li
diff --git a/src/external/comparison/expr_sup.li b/src2/external/comparison/expr_sup.li
similarity index 100%
copy from src/external/comparison/expr_sup.li
copy to src2/external/comparison/expr_sup.li
diff --git a/src/external/comparison/expr_sup_eq.li b/src2/external/comparison/expr_sup_eq.li
similarity index 100%
copy from src/external/comparison/expr_sup_eq.li
copy to src2/external/comparison/expr_sup_eq.li
diff --git a/src2/external/external_c.li b/src2/external/external_c.li
new file mode 100644
index 0000000..afd83af
--- /dev/null
+++ b/src2/external/external_c.li
@@ -0,0 +1,229 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXTERNAL_C;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit";
+ - comment := "External C instruction.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ + is_persistant:BOOLEAN;
+
+ + static_type:TYPE_FULL;
+
+ + living_type:TYPES;
+
+ - set_living_type l:TYPES <-
+ (
+ living_type := l;
+ );
+
+ - get_type t:TYPES_TMP <-
+ (
+ (living_type = NULL).if {
+ t.add (static_type.raw);
+ } else {
+ t.union living_type;
+ };
+ );
+
+ //
+ // External value.
+ //
+
+ + code:STRING_CONSTANT;
+ + access_list:FAST_ARRAY(EXPR);
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION
+ text c:STRING_CONSTANT
+ access ac:FAST_ARRAY(EXPR)
+ persistant per:BOOLEAN
+ type t:TYPE_FULL :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p text c access ac persistant per type t;
+ result
+ );
+
+ - make p:POSITION
+ text c:STRING_CONSTANT
+ access ac:FAST_ARRAY(EXPR)
+ persistant per:BOOLEAN
+ type t:TYPE_FULL <-
+ (
+ position := p;
+ static_type := t;
+ is_persistant := per;
+ code := c;
+ access_list := ac;
+ );
+
+ - my_copy:SELF <-
+ ( + result:SELF;
+ + new_access:FAST_ARRAY(EXPR);
+ + val:EXPR;
+
+ (access_list != NULL).if {
+ new_access := FAST_ARRAY(EXPR).create_with_capacity (access_list.count);
+ (access_list.lower).to (access_list.upper) do { j:INTEGER;
+ val := access_list.item j.my_copy;
+ new_access.add_last val;
+ };
+ };
+ result := SELF.create position text code
+ access new_access persistant is_persistant type static_type;
+ result.set_living_type living_type;
+ result
+ );
+
+ //
+ // Generation.
+ //
+
+ - remove <-
+ (
+ (access_list != NULL).if {
+ (access_list.lower).to (access_list.upper) do { j:INTEGER;
+ access_list.item j.remove;
+ };
+ };
+ );
+
+ - execute_unlink:INSTR <-
+ ( + result,instr:INSTR;
+
+ (is_persistant).if {
+ // Normal.
+ static_type := TYPE_VOID.default;
+ result := execute_link;
+ } else {
+ // Remove.
+ (access_list != NULL).if {
+ (access_list.lower).to (access_list.upper) do { j:INTEGER;
+ instr := access_list.item j.execute_unlink;
+ (instr != NULL).if {
+ list_current.insert_before instr;
+ };
+ };
+ };
+ };
+ result
+ );
+
+ - execute_link:EXPR <-
+ ( + e:EXPR;
+
+ // Normal
+ (access_list != NULL).if {
+ (access_list.lower).to (access_list.upper) do { j:INTEGER;
+ e := access_list.item j.execute_link;
+ access_list.put e to j;
+ };
+ };
+ Self
+ );
+
+ - genere buffer:STRING <-
+ ( + idx,beg:INTEGER;
+
+ (static_type.raw != TYPE_VOID).if {
+ buffer.append "((";
+ static_type.genere_declaration buffer;
+ buffer.add_last ' ';
+ static_type.genere_star_declaration buffer;
+ buffer.append ")(";
+ };
+
+ (access_list != NULL).if {
+ beg := code.lower;
+ idx := code.index_of '@' since beg;
+ (access_list.lower).to (access_list.upper) do { j:INTEGER;
+ beg.to (idx-1) do { k:INTEGER;
+ buffer.add_last (code.item k);
+ };
+ beg := idx + 1;
+ access_list.item j.genere buffer;
+ idx := code.index_of '@' since beg;
+ };
+ // Copy end.
+ beg.to (code.upper) do { k:INTEGER;
+ buffer.add_last (code.item k);
+ };
+ } else {
+ buffer.append code;
+ };
+ (static_type.raw != TYPE_VOID).if {
+ buffer.append "))";
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '`';
+ buffer.append code;
+ ((access_list != NULL) && { ! access_list.is_empty}).if {
+ buffer.add_last '(';
+ access_list.lower.to (access_list.upper - 1) do { j:INTEGER;
+ access_list.item j.display buffer;
+ buffer.add_last ',';
+ };
+ access_list.last.display buffer;
+ buffer.add_last ')';
+ };
+ buffer.add_last '`';
+ static_type.append_name_in buffer;
+ (living_type != NULL).if {
+ buffer.add_last '(';
+ (living_type.lower).to (living_type.upper-1) do { j:INTEGER;
+ buffer.append (living_type.item j.intern_name);
+ buffer.add_last ',';
+ };
+ buffer.append (living_type.last.intern_name);
+ buffer.add_last ')';
+ };
+ display_ref buffer;
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/external/get_type_id.li b/src2/external/get_type_id.li
similarity index 100%
copy from src/external/get_type_id.li
copy to src2/external/get_type_id.li
diff --git a/src/external/is_expanded.li b/src2/external/is_expanded.li
similarity index 100%
copy from src/external/is_expanded.li
copy to src2/external/is_expanded.li
diff --git a/src/external/item.li b/src2/external/item.li
similarity index 100%
copy from src/external/item.li
copy to src2/external/item.li
diff --git a/src/external/logic/expr_and_and_logic.li b/src2/external/logic/expr_and_and_logic.li
similarity index 100%
copy from src/external/logic/expr_and_and_logic.li
copy to src2/external/logic/expr_and_and_logic.li
diff --git a/src/external/logic/expr_and_logic.li b/src2/external/logic/expr_and_logic.li
similarity index 100%
copy from src/external/logic/expr_and_logic.li
copy to src2/external/logic/expr_and_logic.li
diff --git a/src2/external/logic/expr_binary_logic.li b/src2/external/logic/expr_binary_logic.li
new file mode 100644
index 0000000..89fe690
--- /dev/null
+++ b/src2/external/logic/expr_binary_logic.li
@@ -0,0 +1,221 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_BINARY_LOGIC;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Binary logical expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- left.is_invariant && {right.is_invariant};
+
+ + left:EXPR;
+
+ + right:EXPR;
+
+ - symbol:STRING_CONSTANT <-
+ (
+ deferred;
+ NULL
+ );
+
+ - static_type:TYPE_FULL <- type_boolean.default;
+
+ - get_type t:TYPES_TMP <-
+ (
+ t.add type_true;
+ t.add type_false;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with l:EXPR and r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with l and r;
+ result
+ );
+
+ - make p:POSITION with l:EXPR and r:EXPR <-
+ (
+ position := p;
+ left := l;
+ right := r;
+ );
+
+ - my_copy:SELF <- SELF.create position with (left.my_copy) and (right.my_copy);
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + same:SELF;
+
+ same ?= other;
+ (same != NULL) && {left == same.left} && {right == same.right}
+ );
+
+ //
+ // Remove
+ //
+
+ - remove <-
+ (
+ left .remove;
+ right.remove;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_unlink:INSTR <-
+ ( + instr:INSTR;
+ instr := left.execute_unlink;
+ (instr != NULL).if {
+ list_current.insert_before instr;
+ };
+ right.execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + result:EXPR;
+ + old_seq:UINTEGER_32;
+ + left_cst,right_cst:PROTOTYPE_CST;
+ + left_t,right_t:TYPE;
+
+ old_seq := seq_call_and_loop;
+ left := left .execute_link;
+ right := right.execute_link;
+ //
+ left_cst ?= left;
+ right_cst ?= right;
+
+ (left_cst != NULL).if { // BSBS : Peux faire mieux !!!
+ (left_cst.static_type.raw = type_true).if {
+ left_t := type_true;
+ } else {
+ left_t := type_false;
+ };
+ };
+ (right_cst != NULL).if {
+ (right_cst.static_type.raw = type_true).if {
+ right_t := type_true;
+ } else {
+ right_t := type_false;
+ };
+ };
+
+ // Conservator transformation.
+ result := exec_conservator;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_conservator_left left_t;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_conservator_right right_t;
+ };
+ (
+ (result = NULL) &&
+ {right_cst != NULL} &&
+ {left_cst != NULL}
+ ).if {
+ result := exec left_t and right_t;
+ };
+ ((result = NULL) && {old_seq = seq_call_and_loop}).if {
+ // No conservator transformation.
+ result := exec;
+ ((result = NULL) && {left_cst != NULL}).if {
+ result := exec_left left_t;
+ };
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_right right_t;
+ };
+ };
+ //
+ (result = NULL).if {
+ result := Self;
+ } else {
+ result.set_position position;
+ new_execute_pass;
+ };
+
+ result
+ );
+
+ - exec_conservator:EXPR <- NULL;
+ - exec_conservator_left left_cst :TYPE :EXPR <- NULL;
+ - exec_conservator_right right_cst:TYPE :EXPR <- NULL;
+
+ - exec left_cst:TYPE and right_cst:TYPE :EXPR <- NULL;
+
+ - exec:EXPR <- NULL;
+ - exec_left left_cst :TYPE :EXPR <- NULL;
+ - exec_right right_cst:TYPE :EXPR <- NULL;
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '(';
+ left.genere buffer;
+ buffer.add_last ' ';
+ buffer.append symbol;
+ buffer.add_last ' ';
+ right.genere buffer;
+ buffer.add_last ')';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ left.display buffer;
+ buffer.append symbol;
+ right.display buffer;
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/external/logic/expr_not_logic.li b/src2/external/logic/expr_not_logic.li
similarity index 100%
copy from src/external/logic/expr_not_logic.li
copy to src2/external/logic/expr_not_logic.li
diff --git a/src/external/logic/expr_or_logic.li b/src2/external/logic/expr_or_logic.li
similarity index 100%
copy from src/external/logic/expr_or_logic.li
copy to src2/external/logic/expr_or_logic.li
diff --git a/src/external/logic/expr_or_or_logic.li b/src2/external/logic/expr_or_or_logic.li
similarity index 100%
copy from src/external/logic/expr_or_or_logic.li
copy to src2/external/logic/expr_or_or_logic.li
diff --git a/src2/external/logic/expr_unary_logic.li b/src2/external/logic/expr_unary_logic.li
new file mode 100644
index 0000000..a952b59
--- /dev/null
+++ b/src2/external/logic/expr_unary_logic.li
@@ -0,0 +1,178 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := EXPR_UNARY_LOGIC;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Unary logical expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ - is_invariant:BOOLEAN <- right.is_invariant;
+
+ + right:EXPR;
+
+ - symbol:CHARACTER <-
+ (
+ deferred;
+ ' '
+ );
+
+ - static_type:TYPE_FULL <- type_boolean.default;
+
+ - get_type t:TYPES_TMP <-
+ (
+ t.add type_true;
+ t.add type_false;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION with r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p with r;
+ result
+ );
+
+ - make p:POSITION with r:EXPR <-
+ (
+ position := p;
+ right := r;
+ );
+
+ - my_copy:SELF <- SELF.create position with (right.my_copy);
+
+ //
+ // Comparaison.
+ //
+
+ - Self:SELF '==' Right 60 other:EXPR :BOOLEAN <-
+ ( + same:SELF;
+
+ same ?= other;
+ (same != NULL) && {right == same.right}
+ );
+
+ - remove <-
+ (
+ right.remove;
+ );
+
+ //
+ // Execute.
+ //
+
+ - execute_unlink:INSTR <-
+ (
+ right.execute_unlink
+ );
+
+ - execute_link:EXPR <-
+ ( + result:EXPR;
+ + old_seq:UINTEGER_32;
+ + right_cst:PROTOTYPE_CST;
+ + right_t:TYPE;
+
+ old_seq := seq_call_and_loop;
+ right := right.execute_link;
+ //
+ right_cst ?= right;
+ (right_cst != NULL).if {
+ (right_cst.static_type.raw = type_true).if {
+ right_t := type_true;
+ } else {
+ right_t := type_false;
+ };
+ };
+
+ // Conservator transformation.
+ result := exec_conservator;
+ ((result = NULL) && {right_cst != NULL}).if {
+ result := exec_right right_t;
+ };
+ ((result = NULL) && {old_seq = seq_call_and_loop}).if {
+ // No conservator transformation.
+ result := exec;
+ };
+ //
+ (result = NULL).if {
+ result := Self;
+ } else {
+ result.set_position position;
+ new_execute_pass;
+ };
+
+ result
+ );
+
+ - exec_conservator:EXPR <- NULL;
+
+ - exec_right right_cst:TYPE :EXPR <- NULL;
+
+ - exec:EXPR <- NULL;
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ (
+ buffer.add_last '(';
+ buffer.add_last symbol;
+ buffer.add_last ' ';
+ right.genere buffer;
+ buffer.add_last ')';
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.add_last '(';
+ buffer.add_last symbol;
+ buffer.add_last ' ';
+ right.display buffer;
+ buffer.add_last ')';
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/external/put_to.li b/src2/external/put_to.li
new file mode 100644
index 0000000..0baefaf
--- /dev/null
+++ b/src2/external/put_to.li
@@ -0,0 +1,173 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PUT_TO;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Put for NATIVE_ARRAY(E) (see ITEM)";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR; // BSBS: C'est une INSTR, mais pb dans ITM_EXTERNAL
+
+Section Public
+
+ - is_invariant:BOOLEAN <-
+ receiver.is_invariant && {index.is_invariant} && {value.is_invariant};
+
+ + receiver:EXPR;
+
+ + index:EXPR;
+
+ + value:EXPR;
+
+ - static_type:TYPE_FULL <- TYPE_VOID.default;
+
+ - get_type t:TYPES_TMP <-
+ (
+ t.add TYPE_VOID;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION base rec:EXPR index idx:EXPR value v:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make p base rec index idx value v;
+ result
+ );
+
+ - make p:POSITION base rec:EXPR index idx:EXPR value v:EXPR <-
+ ( + type_generic:TYPE_GENERIC;
+ + first_type:TYPE_FULL;
+
+ position := p;
+ receiver := rec;
+ index := idx;
+ value := v;
+ //
+ type_generic ?= receiver.static_type.raw;
+ first_type := type_generic.generic_list.first;
+ (
+ (! first_type.is_expanded) ||
+ {first_type.raw = type_boolean}
+ ).if {
+ type_generic.add_put_to Self;
+ };
+ );
+
+ - my_copy:SELF <-
+ SELF.create position base (receiver.my_copy) index (index.my_copy) value (value.my_copy);
+
+ //
+ // Remove
+ //
+
+ - remove <-
+ ( + type_generic:TYPE_GENERIC;
+ + first_type:TYPE_FULL;
+
+ type_generic ?= receiver.static_type.raw;
+ first_type := type_generic.generic_list.first;
+ (
+ (! first_type.is_expanded) ||
+ {first_type.raw = type_boolean}
+ ).if {
+ type_generic.remove_put_to Self;
+ };
+ //
+ receiver.remove;
+ index.remove;
+ value.remove;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_unlink:INSTR <-
+ (
+ execute_link
+ );
+
+ - execute_link:EXPR <-
+ (
+ receiver := receiver.execute_link;
+ index := index.execute_link;
+ value := value.execute_link;
+ Self
+ );
+
+ //
+ // Genere.
+ //
+
+ - genere buffer:STRING <-
+ ( + type_generic:TYPE_GENERIC;
+ + first_type:TYPE_FULL;
+
+ receiver.genere buffer;
+ buffer.add_last '[';
+ index.genere buffer;
+ buffer.append "]=";
+ type_generic ?= receiver.static_type.raw;
+ first_type := type_generic.generic_list.first;
+ ((first_type.is_expanded) && {! first_type.is_expanded_c}).if {
+ (value.static_type.is_expanded_ref).if {
+ buffer.append "*(";
+ value.genere buffer;
+ buffer.add_last ')';
+ } else {
+ value.genere buffer;
+ };
+ } else {
+ value.genere buffer;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ receiver.display buffer;
+ buffer.add_last '[';
+ index.display buffer;
+ buffer.append "]=";
+ value.display buffer;
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/external/size_of.li b/src2/external/size_of.li
similarity index 100%
copy from src/external/size_of.li
copy to src2/external/size_of.li
diff --git a/src2/item/itm_arg.li b/src2/item/itm_arg.li
new file mode 100644
index 0000000..31c4767
--- /dev/null
+++ b/src2/item/itm_arg.li
@@ -0,0 +1,147 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_ARG;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "One argument";
+
+Section Inherit
+
+ + parent_itm_argument:Expanded ITM_ARGUMENT;
+
+Section Public
+
+ + name:STRING_CONSTANT;
+
+ + type:ITM_TYPE_MONO;
+
+ - upper:INTEGER := 0;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT type t:ITM_TYPE_MONO :SELF <-
+ ( + result:SELF;
+
+ result := SELF.clone;
+ result.make p name n type t;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT type t:ITM_TYPE_MONO <-
+ (
+ position := p;
+ name := n;
+ type := t;
+ );
+
+ //
+ // Running.
+ //
+/*
+ - item idx:INTEGER :ITM_TYPE_MONO <-
+ ( ? {idx = 0};
+ type
+ );
+ */
+
+ - to_run_in arg_lst:FAST_ARRAY(LOCAL) for p:PARAMETER_TO_TYPE <-
+ ( + t:ITM_TYPE_MONO;
+
+ (name = ALIAS_STR.variable_self).if {
+ t := ITM_TYPE_SIMPLE.type_self;
+ } else {
+ t := type;
+ };
+ arg_lst.add_last (
+ LOCAL.create position name name style ' ' type (t.to_run_for p)
+ );
+ );
+
+ - get_index_type p:ITM_TYPE_PARAMETER :INTEGER <-
+ ( + result:INTEGER;
+ (type != p).if {
+ result := 1;
+ };
+ result
+ );
+
+ - check larg:FAST_ARRAY(EXPR) index idx:INTEGER for p:PARAMETER_TO_TYPE :INTEGER <-
+ ( + new_expr:EXPR;
+
+ new_expr := larg.item idx.check_type (type.to_run_for p) with position;
+ larg.put new_expr to idx;
+ idx + 1
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.append name;
+ buffer.add_last ':';
+ type.display buffer;
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ (name = ALIAS_STR.variable_self).if {
+ put name to buf like (ALIAS_STR.short_keyword);
+ } else {
+ put name to buf like (ALIAS_STR.short_local);
+ };
+ buf.add_last ':';
+ type.shorter_in buf;
+ );
+
+
+ //
+ // Comparaison.
+ //
+
+ - is_equal other:ITM_ARGUMENT <-
+ ( + o:ITM_ARG;
+ + err:STRING_CONSTANT;
+ ? {other != Self};
+
+ o ?= other;
+ (o = NULL).if {
+ err := "Invariance number vector argument invalid.";
+ }.elseif {name != o.name} then {
+ err := "Invariance name argument invalid.";
+ }.elseif {type != o.type} then {
+ err := "Invariance type argument invalid.";
+ };
+ (err != NULL).if {
+ POSITION.put_error semantic text err;
+ position.put_position;
+ (other.position).put_position;
+ POSITION.send_error;
+ };
+ );
\ No newline at end of file
diff --git a/src2/item/itm_args.li b/src2/item/itm_args.li
new file mode 100644
index 0000000..d8efad1
--- /dev/null
+++ b/src2/item/itm_args.li
@@ -0,0 +1,166 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_ARGS;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "One argument vector";
+
+Section Inherit
+
+ + parent_itm_argument:Expanded ITM_ARGUMENT;
+
+Section Public
+
+ + name:FAST_ARRAY(STRING_CONSTANT);
+
+ + type:ITM_TYPE_MULTI;
+
+ - upper:INTEGER <- name.upper;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION name n:FAST_ARRAY(STRING_CONSTANT)
+ type t:ITM_TYPE_MULTI :SELF <-
+ ( + result:SELF;
+
+ result := SELF.clone;
+ result.make p name n type t;
+ result
+ );
+
+ - make p:POSITION name n:FAST_ARRAY(STRING_CONSTANT)
+ type t:ITM_TYPE_MULTI <-
+ (
+ position := p;
+ name := n;
+ type := t;
+ );
+
+ //
+ // Running.
+ //
+/*
+ - item idx:INTEGER :ITM_TYPE_MONO <-
+ ( ? {idx.in_range 0 to upper};
+ type.item idx
+ );
+ */
+
+ - to_run_in arg_lst:FAST_ARRAY(LOCAL) for p:PARAMETER_TO_TYPE <-
+ ( + t:TYPE_FULL;
+
+ (name.lower).to (name.upper) do { j:INTEGER;
+ t := type.item j.to_run_for p;
+ arg_lst.add_last (
+ LOCAL.create position name (name.item j) style ' ' type t
+ );
+ };
+ );
+
+ - get_index_type p:ITM_TYPE_PARAMETER :INTEGER <-
+ ( + i:INTEGER;
+
+ i := name.lower;
+ {(i <= name.upper) && {type.item i != p}}.while_do {
+ i := i + 1;
+ };
+ i
+ );
+
+ - check larg:FAST_ARRAY(EXPR) index idx:INTEGER for p:PARAMETER_TO_TYPE :INTEGER <-
+ ( + new_expr:EXPR;
+
+ (type.lower).to (type.upper) do { i:INTEGER;
+ new_expr := larg.item (idx+i).check_type (type.item i.to_run_for p) with position;
+ larg.put new_expr to (idx+i);
+ };
+ idx + type.count
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.add_last '(';
+ (name.lower).to (name.upper - 1) do { j:INTEGER;
+ buffer.append (name.item j);
+ buffer.add_last ':';
+ type.item j.display buffer;
+ buffer.add_last ',';
+ };
+ buffer.append (name.last);
+ buffer.add_last ':';
+ type.last.display buffer;
+ buffer.add_last ')';
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ buf.add_last '(';
+ (name.lower).to (name.upper - 1) do { j:INTEGER;
+ (name.item j = ALIAS_STR.variable_self).if {
+ put (name.item j) to buf like (ALIAS_STR.short_keyword);
+ } else {
+ put (name.item j) to buf like (ALIAS_STR.short_local);
+ };
+ buf.add_last ':';
+ type.item j.shorter_in buf;
+ buf.add_last ',';
+ };
+ put (name.last) to buf like (ALIAS_STR.short_local);
+ buf.add_last ':';
+ type.last.shorter_in buf;
+ buf.add_last ')';
+ );
+
+ //
+ // Comparaison.
+ //
+
+ - is_equal other:ITM_ARGUMENT <-
+ ( + o:ITM_ARGS;
+ + err:STRING_CONSTANT;
+ ? {other != Self};
+
+ o ?= other;
+ (o = NULL).if {
+ err := "Invariance number vector argument invalid.";
+ }.elseif {name != o.name} then {
+ err := "Invariance name argument invalid.";
+ }.elseif {type != o.type} then {
+ err := "Invariance type argument invalid.";
+ };
+ (err != NULL).if {
+ POSITION.put_error semantic text err;
+ position.put_position;
+ (other.position).put_position;
+ POSITION.send_error;
+ };
+ );
diff --git a/src2/item/itm_argument.li b/src2/item/itm_argument.li
new file mode 100644
index 0000000..f9d1538
--- /dev/null
+++ b/src2/item/itm_argument.li
@@ -0,0 +1,84 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_ARGUMENT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent argument";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_OBJECT;
+
+Section Public
+
+ - lower:INTEGER <- 0;
+
+ - upper:INTEGER <- ( deferred; 0);
+
+ - count:INTEGER <- upper + 1;
+
+ //
+ // Running.
+ //
+/*
+ - item idx:INTEGER :ITM_TYPE_MONO <-
+ (
+ deferred;
+ NULL
+ );
+*/
+ - to_run_in arg_lst:FAST_ARRAY(LOCAL) for p:PARAMETER_TO_TYPE <-
+ (
+ deferred;
+ );
+
+ - get_index_type p:ITM_TYPE_PARAMETER :INTEGER <-
+ (
+ deferred;
+ );
+
+ - check larg:FAST_ARRAY(EXPR) index idx:INTEGER for p:PARAMETER_TO_TYPE :INTEGER <-
+ (
+ deferred;
+ 0
+ );
+
+ //
+ // Comparaison.
+ //
+
+ - is_equal other:ITM_ARGUMENT <- deferred;
+
+ //
+ // Display.
+ //
+
+ - shorter_in buf:STRING <-
+ (
+ deferred;
+ );
+
+
diff --git a/src2/item/itm_binary.li b/src2/item/itm_binary.li
new file mode 100644
index 0000000..5e6b129
--- /dev/null
+++ b/src2/item/itm_binary.li
@@ -0,0 +1,255 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_BINARY;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Binary operator message";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ //
+ // Data
+ //
+
+ + position_list:FAST_ARRAY(POSITION);
+
+ + value_list :FAST_ARRAY(ITM_CODE);
+
+ + operator_list:FAST_ARRAY(STRING_CONSTANT);
+
+ //
+ // Constructor
+ //
+
+ - create p:FAST_ARRAY(POSITION) values v:FAST_ARRAY(ITM_CODE)
+ operators o:FAST_ARRAY(STRING_CONSTANT) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p values v operators o;
+ result
+ );
+
+ - make p:FAST_ARRAY(POSITION) values v:FAST_ARRAY(ITM_CODE)
+ operators o:FAST_ARRAY(STRING_CONSTANT) <-
+ (
+ ? { p.count=o.count };
+ ? { p.count=(v.count-1) };
+ position_list := p;
+ value_list := v;
+ operator_list := o;
+ );
+
+ //
+ // Runnable.
+ //
+
+ - to_run_expr:EXPR <-
+ ( + max_pos,max_lev:INTEGER;
+ + max_pri :STRING_CONSTANT;
+ + expr :INSTR;
+ + val_list:FAST_ARRAY(EXPR);
+ + val:EXPR;
+ + typ_list:TYPES_TMP;
+ + typ:TYPE;
+ + slo_list:FAST_ARRAY(SLOT);
+ + slo,slo_ref:SLOT;
+ + ope_list:FAST_ARRAY(STRING_CONSTANT);
+ + pos_list:FAST_ARRAY(POSITION);
+ + nam:STRING_CONSTANT;
+ + site:NODE;
+ + extern:EXPR;
+ + loc:VARIABLE;
+ + l_arg:FAST_ARRAY(EXPR);
+ + result:EXPR;
+
+ // Array Temporary.
+ ope_list := ALIAS_ARRAY(STRING_CONSTANT).new;
+ ope_list.copy operator_list;
+ pos_list := ALIAS_ARRAY(POSITION).new;
+ pos_list.copy position_list;
+ val_list := ALIAS_ARRAY(EXPR).new;
+ typ_list := TYPES_TMP.new;
+ slo_list := ALIAS_ARRAY(SLOT).new;
+
+ // ITM_CODE -> EXPR
+ (value_list.lower).to (value_list.upper) do { j:INTEGER;
+ val := value_list.item j.to_run_expr;
+ val_list.add_last val;
+ typ := val.static_type.raw;
+ typ_list.add typ;
+ };
+
+ // Error verification.
+ (operator_list.lower).to (operator_list.upper) do { j:INTEGER;
+ nam := operator_list.item j;
+ ((nam = ALIAS_STR.operator_equal) || {nam = ALIAS_STR.operator_not_equal}).if {
+ // '=' or '!=':
+ slo_list.add_last NULL;
+ } else {
+ // Other:
+ typ := typ_list.first;
+ slo_ref := typ.get_slot nam;
+ (slo_ref = NULL).if {
+ error_slot (position_list.item j) name nam in typ list typ_list;
+ } else {
+ slo_list.add_last slo_ref;
+ (typ_list.lower+1).to (typ_list.upper) do { k:INTEGER;
+ typ := typ_list.item k;
+ slo := typ.get_slot nam;
+ (slo = NULL).if {
+ error_slot (position_list.item j) name nam in typ list typ_list;
+ } else {
+ (slo_ref.priority_and_level != slo.priority_and_level).if {
+ position.put_error semantic text
+ "Conflicting declaration associativity or priority.";
+ slo_ref.position.put_position;
+ slo.position.put_position;
+ position_list.item j.put_position;
+ position.send_error;
+ };
+ };
+ };
+ };
+ };
+ };
+
+ // operator_list -> SW_READ.
+ {slo_list.is_empty}.until_do {
+ // Search max level.
+ max_lev := -1;
+ (slo_list.lower).to (slo_list.upper) do { j:INTEGER;
+ slo := slo_list.item j;
+ (slo = NULL).if {
+ // '=' or '!='.
+ (
+ (50 > max_lev) ||
+ {(50 = max_lev) && {max_pri = ALIAS_STR.keyword_right}}
+ ).if {
+ max_lev := 50;
+ max_pri := ALIAS_STR.keyword_right;
+ max_pos := j;
+ };
+ } else {
+ // Other:
+ (
+ (slo.priority > max_lev) ||
+ {
+ (slo.priority = max_lev) &&
+ {slo.associativity = max_pri} &&
+ {max_pri = ALIAS_STR.keyword_right}
+ }
+ ).if {
+ max_lev := slo.priority;
+ max_pri := slo.associativity;
+ max_pos := j;
+ };
+ };
+ };
+ // Test conflicting.
+ (
+ (max_pos < slo_list.upper) &&
+ {slo_list.item (max_pos+1) != NULL} &&
+ {slo_list.item (max_pos+1).priority = max_lev} &&
+ {slo_list.item (max_pos+1).associativity != max_pri}
+ ).if {
+ warning_error ((pos_list.item max_pos),
+ "Conflicting left/right priority.");
+ };
+
+ (slo_list.item max_pos = NULL).if {
+ // '=' or '!='.
+ (ope_list.item max_pos = ALIAS_STR.operator_equal).if {
+ extern := EXPR_EQUAL.create (pos_list.item max_pos) with
+ (val_list.item max_pos) and (val_list.item (max_pos+1));
+ } else {
+ extern := EXPR_NOT_EQUAL.create (pos_list.item max_pos) with
+ (val_list.item max_pos) and (val_list.item (max_pos+1));
+ };
+ loc := type_boolean.default.get_temporary (pos_list.item max_pos);
+ expr := loc.write (pos_list.item max_pos) value extern;
+ list_current.add_last expr;
+ val := loc.read (pos_list.item max_pos);
+ } else {
+ // SW_READ.
+ l_arg := FAST_ARRAY(EXPR).create_with_capacity 2;
+ l_arg.add_last (val_list.item max_pos);
+ l_arg.add_last (val_list.item (max_pos + 1));
+
+ site := NODE.new_read (pos_list.item max_pos)
+ slot (slo_list.item max_pos)
+ receiver (l_arg.first.my_copy)
+ with l_arg;
+
+ list_current.add_last site;
+ val := site.result_expr;
+ };
+
+ // Delete operator.
+ slo_list.remove max_pos;
+ ope_list.remove max_pos;
+ pos_list.remove max_pos;
+ val_list.remove (max_pos+1);
+ //
+ val_list.put val to max_pos;
+ };
+
+ result := val_list.first;
+
+ // Free Array Temporary.
+ ALIAS_ARRAY(STRING_CONSTANT).free ope_list;
+ ALIAS_ARRAY(POSITION).free pos_list;
+ ALIAS_ARRAY(EXPR).free val_list;
+ typ_list.free;
+ ALIAS_ARRAY(SLOT).free slo_list;
+
+ result
+ );
+
+Section Private
+
+ - error_slot p:POSITION name s:STRING_CONSTANT in t:TYPE list st:TYPES_TMP <-
+ (
+ string_tmp.copy "Slot '";
+ string_tmp.append s;
+ string_tmp.append "' not found in ";
+ string_tmp.append (t.intern_name);
+ string_tmp.append ". ( ";
+ (st.lower).to (st.upper-1) do { j:INTEGER;
+ st.item j.append_name_in string_tmp;
+ string_tmp.add_last ' ';
+ };
+ st.last.append_name_in string_tmp;
+ string_tmp.add_last ')';
+ semantic_error (p,string_tmp);
+ );
+
+
+
+
diff --git a/src/item/itm_block.li b/src2/item/itm_block.li
similarity index 100%
copy from src/item/itm_block.li
copy to src2/item/itm_block.li
diff --git a/src/item/itm_character.li b/src2/item/itm_character.li
similarity index 100%
copy from src/item/itm_character.li
copy to src2/item/itm_character.li
diff --git a/src/item/itm_code.li b/src2/item/itm_code.li
similarity index 100%
copy from src/item/itm_code.li
copy to src2/item/itm_code.li
diff --git a/src/item/itm_constant.li b/src2/item/itm_constant.li
similarity index 100%
copy from src/item/itm_constant.li
copy to src2/item/itm_constant.li
diff --git a/src2/item/itm_expression.li b/src2/item/itm_expression.li
new file mode 100644
index 0000000..da8178b
--- /dev/null
+++ b/src2/item/itm_expression.li
@@ -0,0 +1,261 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_EXPRESSION;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "operator list message";
+
+Section Inherit
+
+ - parent_itm_code:ITM_CODE := ITM_CODE;
+
+Section Public
+
+ - position:POSITION <- value_list.first.position;
+
+ //
+ // Data
+ //
+
+ + value_list :FAST_ARRAY(ITM_CODE);
+
+ //
+ // Constructor
+ //
+
+ - create v:FAST_ARRAY(ITM_CODE) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make v;
+ result
+ );
+
+ - make v:FAST_ARRAY(ITM_CODE) <-
+ (
+ value_list := v;
+ );
+
+ //
+ // Runnable.
+ //
+
+ - to_run_expr:EXPR <-
+ ( + max_pos,max_lev,idx,idx_post,idx_pre,low:INTEGER;
+ + continue:BOOLEAN;
+ + max_pri :STRING_CONSTANT;
+ + left,right:EXPR;
+ + instr:INSTR;
+ + val_list:FAST_ARRAY(INSTR);
+ + val:EXPR;
+ + typ:TYPE;
+ + slo:SLOT;
+ + nam,op_name:STRING_CONSTANT;
+ + site:NODE;
+ + n_t:NODE_TYPE;
+ + extern:EXPR_BINARY_CMP;
+ + loc:VARIABLE;
+ + l_arg:FAST_ARRAY(EXPR);
+ + result:EXPR;
+ + itm_op:ITM_OPERATOR;
+
+ val_list := ALIAS_ARRAY(INSTR).new;
+ // Search unary message.
+ idx := -1;
+ low := value_list.lower;
+ {
+ // Search first message.
+ {
+ idx := idx + 1;
+ itm_op ?= value_list.item idx;
+ }.do_while {(itm_op != NULL) && {idx != value_list.upper}};
+ (itm_op != NULL).if {
+ semantic_error (itm_op.position,"Operator postfix not found.");
+ };
+ val := value_list.item idx.to_run_expr;
+ typ := val.static_type.raw;
+ // Post-fix.
+ idx_post := idx + 1;
+ continue := TRUE;
+ {(idx_post <= value_list.upper) && {continue}}.while_do {
+ continue := FALSE;
+ (idx_post != value_list.upper).if {
+ itm_op ?= value_list.item (idx_post + 1);
+ };
+ ((idx_post = value_list.upper) || {itm_op != NULL}).if {
+ itm_op ?= value_list.item idx_post;
+ slo := typ.get_slot (operator (ALIAS_STR.slot_postfix) name (itm_op.name));
+ (slo != NULL).if {
+ site := NODE.new_read (itm_op.position) slot slo receiver val self val intern FALSE;
+ list_current.add_last site;
+ val := site.result_expr;
+ idx_post := idx_post + 1;
+ continue := TRUE;
+ };
+ };
+ };
+ // Pre-fix.
+ idx_pre := idx - 1;
+ continue := TRUE;
+ {(idx_pre >= low) && {continue}}.while_do {
+ continue := FALSE;
+ (idx_pre != low).if {
+ itm_op ?= value_list.item (idx_pre - 1);
+ };
+ ((idx_pre = low) || {itm_op != NULL}).if {
+ itm_op ?= value_list.item idx_pre;
+ slo := typ.get_slot (operator (ALIAS_STR.slot_prefix) name (itm_op.name));
+ (slo = NULL).if {
+ error_slot (itm_op.position) name "prefix" operator (itm_op.name) in typ;
+ };
+ site := NODE.new_read (itm_op.position) slot slo receiver val self val intern FALSE;
+ list_current.add_last site;
+ val := site.result_expr;
+ idx_pre := idx_pre - 1;
+ continue := TRUE;
+ };
+ };
+ val_list.add_last val;
+ idx := idx_post;
+ (idx < value_list.upper).if {
+ // Infix.
+ typ := val.static_type.raw;
+ itm_op ?= value_list.item idx;
+ op_name := itm_op.name;
+ (op_name = ALIAS_STR.symbol_equal).if {
+ instr := EXPR_EQUAL.create (itm_op.position) with NULL and NULL;
+ }.elseif {op_name = ALIAS_STR.symbol_not_equal} then {
+ instr := EXPR_NOT_EQUAL.create (itm_op.position) with NULL and NULL;
+ } else {
+ nam := operator (ALIAS_STR.slot_infix) name op_name;
+ slo := typ.get_slot nam;
+ (slo = NULL).if {
+ error_slot (itm_op.position) name "infix" operator op_name in typ;
+ };
+ instr := NODE.new_read_partial (itm_op.position) slot slo;
+ };
+ val_list.add_last instr;
+ };
+ low := idx_post + 1;
+ }.do_while {idx <= value_list.upper};
+
+ {val_list.count = 1}.until_do {
+ // Search max level.
+ max_lev := -1;
+ (val_list.lower+1).to (val_list.upper-1) by 2 do { j:INTEGER;
+ site ?= val_list.item j;
+ (site = NULL).if {
+ // '=' or '!='.
+ (
+ (50 > max_lev) ||
+ {(50 = max_lev) && {max_pri = ALIAS_STR.keyword_right}}
+ ).if {
+ max_lev := 50;
+ max_pri := ALIAS_STR.keyword_right;
+ max_pos := j;
+ };
+ } else {
+ // Other:
+ slo := site.data.slot;
+ (
+ (slo.priority > max_lev) ||
+ {
+ (slo.priority = max_lev) &&
+ {slo.associativity = max_pri} &&
+ {max_pri = ALIAS_STR.keyword_right}
+ }
+ ).if {
+ max_lev := slo.priority;
+ max_pri := slo.associativity;
+ max_pos := j;
+ };
+ };
+ };
+
+ n_t ?= val_list.item max_pos;
+ left ?= val_list.item (max_pos - 1);
+ right ?= val_list.item (max_pos + 1);
+ (n_t = NULL).if {
+ // '=' or '!='.
+ extern ?= val_list.item max_pos;
+ extern.set_left left and_right right;
+ loc := type_boolean.default.get_temporary (extern.position);
+ instr:= loc.write (extern.position) value extern;
+ list_current.add_last instr;
+ val := loc.read (instr.position);
+ } else {
+ // SW_READ.
+ l_arg := FAST_ARRAY(EXPR).create_with_capacity 2;
+ l_arg.add_last left;
+ l_arg.add_last right;
+ slo := left.static_type.raw.get_slot (n_t.data.slot.name);
+ n_t.new_read_finalize (left.my_copy,slo) with l_arg;
+ list_current.add_last n_t;
+ val := n_t.result_expr;
+ };
+
+ // Delete operator.
+ val_list.remove max_pos;
+ val_list.remove max_pos;
+ //
+ val_list.put val to (max_pos - 1);
+ };
+
+ result ?= val_list.first;
+
+ // Free Array Temporary.
+ ALIAS_ARRAY(INSTR).free val_list;
+
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ (value_list.lower).to (value_list.upper) do { i:INTEGER;
+ value_list.item i.append_in buffer;
+ };
+ );
+
+Section Private
+
+ - error_slot p:POSITION name s:STRING_CONSTANT operator op:STRING_CONSTANT in t:TYPE <-
+ (
+ string_tmp.copy "Slot ";
+ string_tmp.append s;
+ string_tmp.append " '";
+ string_tmp.append op;
+ string_tmp.append "' not found in ";
+ string_tmp.append (t.intern_name);
+ string_tmp.add_last '.';
+ semantic_error (p,string_tmp);
+ );
+
+
+
+
diff --git a/src/item/itm_expression_old.li b/src2/item/itm_expression_old.li
similarity index 100%
copy from src/item/itm_expression_old.li
copy to src2/item/itm_expression_old.li
diff --git a/src2/item/itm_extern.li b/src2/item/itm_extern.li
new file mode 100644
index 0000000..a1beeae
--- /dev/null
+++ b/src2/item/itm_extern.li
@@ -0,0 +1,114 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_EXTERN;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for externals";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ //
+ // Data
+ //
+
+ + extern:STRING_CONSTANT;
+
+ //
+ // Constructor.
+ //
+
+ - last_code:STRING_CONSTANT;
+
+ - get_access:FAST_ARRAY(EXPR) <-
+ ( + idx,base:INTEGER;
+ + e:EXPR;
+ + loc:STRING_CONSTANT;
+ + var:VARIABLE;
+ + access_list:FAST_ARRAY(EXPR);
+
+ string_tmp2.copy extern;
+ idx := string_tmp2.index_of '@' since (string_tmp2.lower);
+ (idx <= string_tmp2.count).if {
+ access_list := ALIAS_ARRAY(EXPR).new;
+ {idx > string_tmp2.upper}.until_do {
+ base := idx;
+ idx := idx + 1;
+ string_tmp.clear;
+ {
+ (idx > string_tmp2.upper) ||
+ {
+ (! string_tmp2.item idx.is_letter_or_digit) &&
+ {string_tmp2.item idx != '_'}
+ }
+ }.until_do {
+ string_tmp.add_last (string_tmp2.item idx);
+ idx := idx + 1;
+ };
+ string_tmp.is_empty.if {
+ syntax_error (position,"Incorrect external local slot access.");
+ };
+ loc := ALIAS_STR.get string_tmp;
+ var := lookup loc;
+ (var = NULL).if {
+ string_tmp.copy "External local slot access `";
+ string_tmp.append loc;
+ string_tmp.append "' is not found.";
+ semantic_error (position,string_tmp);
+ }.elseif {var.style = '-'} then {
+ string_tmp.copy "External local slot access `";
+ string_tmp.append loc;
+ string_tmp.append "' must be in `+' style.";
+ semantic_error (position,string_tmp);
+ };
+ e := var.read position;
+ access_list.add_last e;
+
+ string_tmp2.remove_between base to (base+loc.count);
+ string_tmp2.insert_string "(@)" to base;
+ idx := string_tmp2.index_of '@' since (base+2);
+ };
+ access_list := ALIAS_ARRAY(EXPR).copy access_list;
+ };
+ last_code := ALIAS_STR.get string_tmp2;
+ access_list
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.add_last '`';
+ buffer.append extern;
+ buffer.add_last '`';
+ );
+
+
diff --git a/src2/item/itm_external.li b/src2/item/itm_external.li
new file mode 100644
index 0000000..dcf1bd5
--- /dev/null
+++ b/src2/item/itm_external.li
@@ -0,0 +1,170 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_EXTERNAL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "External C without type result";
+
+Section Inherit
+
+ + parent_itm_extern:Expanded ITM_EXTERN;
+
+Section Public
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION text n:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p text n;
+ result
+ );
+
+ - make p:POSITION text n:STRING_CONSTANT <-
+ (
+ position := p;
+ extern := n;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + result:EXPR;
+ + lst_acc:FAST_ARRAY(EXPR);
+ + num:INTEGER;
+ + exp1,exp2,exp3:EXPR;
+ + left,right:EXPR;
+ + type:TYPE_FULL;
+
+ extern.is_integer.if {
+ num := extern.to_integer;
+ (num > 31).if {
+ syntax_error (position,"Unknown external lisaac code (0..31).");
+ };
+ num
+ .when 0 then { // is_expanded_type:BOOLEAN
+ exp1 := profil_slot.argument_list.first.read position;
+ result := IS_EXPANDED.create position receiver exp1;
+ }
+ .when 1 then { // type_id_intern:INTEGER
+ exp1 := profil_slot.argument_list.first.read position;
+ result := GET_TYPE_ID.create position receiver exp1;
+ }
+ .when 2 then { // INTEGER > INTEGER -> BOOLEAN.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_SUP.create position with left and right;
+ }
+ .when 3 then { // INTEGER - INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_SUB.create position with left and right;
+ }
+ .when 4 then { // INTEGER * INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_MUL.create position with left and right;
+ }
+ .when 5 then { // INTEGER / INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_DIV.create position with left and right;
+ }
+ .when 6 then { // INTEGER & INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_AND.create position with left and right;
+ }
+ .when 7 then { // INTEGER >> INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_SHIFT_R.create position with left and right;
+ }
+ .when 8 then { // INTEGER << INTEGER -> INTEGER.
+ left := profil_slot.argument_list.first .read position;
+ right := profil_slot.argument_list.item 1.read position;
+ result := EXPR_SHIFT_L.create position with left and right;
+ }
+ .when 9 then { // put OBJECT to INTEGER.
+ exp1 := profil_slot.argument_list.first .read position;
+ exp2 := profil_slot.argument_list.item 1.read position;
+ exp3 := profil_slot.argument_list.item 2.read position;
+ result := PUT_TO.create position base exp1 index exp3 value exp2;
+ }
+ .when 10 then { // item INTEGER -> OBJECT.
+ exp1 := profil_slot.argument_list.first .read position;
+ exp2 := profil_slot.argument_list.item 1.read position;
+ result := ITEM.create position base exp1 index exp2;
+ }
+ .when 11 then { // debug_level -> INTEGER.
+ result := INTEGER_CST.create position value debug_level_option type (type_integer.default);
+ }
+ .when 12 then { // object_size -> INTEGER.
+ exp1 := profil_slot.argument_list.first.read position;
+ result := SIZE_OF.create position receiver exp1;
+ }
+ .when 13 then { // CONVERT SRC TO DST.on src:SRC :DST.
+ type := profil_slot.result_list.first.type;
+ exp2 := profil_slot.argument_list.second.read position;
+ result := CAST.create type value exp2;
+ }
+ .when 14 then { // top_runtime_stack -> POINTER.
+ (debug_level_option = 0).if {
+ result := PROTOTYPE_CST.create position type (TYPE_NULL.default);
+ } else {
+ result := EXTERNAL_C.create position text "top_context->back->back"
+ access NULL persistant FALSE type (type_pointer.default);
+ };
+ }
+ .when 15 then { // is_cop_type:BOOLEAN
+ type := profil_slot.argument_list.first.type;
+ (type.prototype.style = '-').if {
+ result := PROTOTYPE_CST.create position type (type_true.default);
+ } else {
+ result := PROTOTYPE_CST.create position type (type_false.default);
+ };
+ }
+ .when 16 then { // LIST.upper:INTEGER
+ not_yet_implemented;
+ }
+ .when 17 then { // LIST.item index:INTEGER :E
+ not_yet_implemented;
+ }
+ .when 18 to 31 then { // FREE
+ syntax_error (position,"Free external lisaac code.");
+ };
+ } else {
+ lst_acc := get_access;
+ result := EXTERNAL_C.create position text last_code
+ access lst_acc persistant TRUE type (TYPE_VOID.default);
+ };
+ result
+ );
+
diff --git a/src2/item/itm_external_type.li b/src2/item/itm_external_type.li
new file mode 100644
index 0000000..07880a7
--- /dev/null
+++ b/src2/item/itm_external_type.li
@@ -0,0 +1,111 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_EXTERNAL_TYPE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "External C with type result";
+
+Section Inherit
+
+ + parent_itm_extern:Expanded ITM_EXTERN;
+
+Section Public
+
+ //
+ // Data
+ //
+
+ + type:ITM_TYPE_MONO;
+
+ + type_list:FAST_ARRAY(ITM_TYPE_MONO);
+
+ + is_persistant:BOOLEAN;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION text n:STRING_CONSTANT persistant per:BOOLEAN :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p text n persistant per;
+ result
+ );
+
+ - make p:POSITION text n:STRING_CONSTANT persistant per:BOOLEAN <-
+ (
+ position := p;
+ extern := n;
+ is_persistant := per;
+ );
+
+ //
+ // Added
+ //
+
+ - set_type t:ITM_TYPE_MONO <-
+ (
+ type := t;
+ );
+
+ - set_type_list t:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ type_list := t;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + e:EXTERNAL_C;
+ + lt:TYPES_TMP;
+ + lst_acc:FAST_ARRAY(EXPR);
+ + typ:TYPE;
+ + tmp:VARIABLE;
+
+ lst_acc := get_access;
+ last_position := position;
+ e := EXTERNAL_C.create position text last_code
+ access lst_acc persistant is_persistant type (type.to_run_for profil_slot);
+
+ (type_list != NULL).if {
+ lt := TYPES_TMP.new;
+ (type_list.lower).to (type_list.upper) do { j:INTEGER;
+ typ := type_list.item j.to_run_for profil_slot.raw;
+ lt.add typ;
+ };
+ e.set_living_type (lt.to_types);
+ };
+ // For argument.
+ tmp := e.static_type.get_temporary position;
+ list_current.add_last (tmp.write position value e);
+ tmp.read position
+ );
+
+
+
+
diff --git a/src/item/itm_ldots.li b/src2/item/itm_ldots.li
similarity index 100%
copy from src/item/itm_ldots.li
copy to src2/item/itm_ldots.li
diff --git a/src2/item/itm_list.li b/src2/item/itm_list.li
new file mode 100644
index 0000000..f534a9d
--- /dev/null
+++ b/src2/item/itm_list.li
@@ -0,0 +1,203 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_LIST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Instruction list";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ // BSBS: OPTIM : Dans 95% des cas, les list sont sans local (il faudrait spécialiser)
+ // Mais pb avec le parser...
+
+ //
+ // Data
+ //
+
+ + local_list:FAST_ARRAY(ITM_LOCAL); // `+'
+
+ + static_list:FAST_ARRAY(ITM_LOCAL); // `-'
+
+ + code:FAST_ARRAY(ITM_CODE);
+
+ + is_check_name:BOOLEAN;
+
+ - is_check_local:INTEGER;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p;
+ result
+ );
+
+ - make p:POSITION <-
+ (
+ position := p;
+ );
+
+ //
+ // Added
+ //
+
+ - set_local_list l:FAST_ARRAY(ITM_LOCAL) <-
+ (
+ ? {! l.is_empty};
+ local_list := l;
+ );
+
+ - set_static_list l:FAST_ARRAY(ITM_LOCAL) <-
+ (
+ ? {! l.is_empty};
+ static_list := l;
+ );
+
+ - set_code c:FAST_ARRAY(ITM_CODE) <-
+ (
+ code := c;
+ );
+
+Section Public
+
+ - is_affect:POSITION <-
+ ( + result,default:POSITION;
+ + j:INTEGER;
+ + itm_r:ITM_RESULT;
+
+ j := code.lower;
+ {(j < code.upper) && {result = default}}.while_do {
+ itm_r ?= code.item j;
+ (itm_r != NULL).if {
+ result := itm_r.is_affect;
+ } else {
+ result := code.item j.position;
+ };
+ j := j + 1;
+ };
+ (result = default).if {
+ result := code.last.is_affect;
+ };
+ result
+ );
+
+ //
+ // Runnable.
+ //
+
+ - to_run_expr:EXPR <-
+ // List intern.
+ ( + i:INSTR;
+ + var:LOCAL;
+ + stack_top:INTEGER;
+ + result_top:INTEGER;
+ + result:EXPR;
+ + nb_result:INTEGER;
+ + lr:FAST_ARRAY(EXPR);
+
+ stack_top := stack_local .upper + 1;
+ result_top := stack_result.upper + 1;
+
+ // Push Local.
+ (local_list != NULL).if {
+ (local_list.lower).to (local_list.upper) do { j:INTEGER;
+ var := local_list.item j.to_run;
+ stack_local.add_last var;
+ var.init;
+ };
+ };
+ (static_list != NULL).if {
+ (static_list.lower).to (static_list.upper) do { j:INTEGER;
+ var := static_list.item j.to_run_static;
+ stack_local.add_last var;
+ };
+ };
+ // Append code.
+ (code.lower).to (code.upper) do { j:INTEGER;
+ i := code.item j.to_run;
+ list_current.add_last i;
+ };
+ // Compute result expr.
+ nb_result := stack_result.upper - result_top + 1;
+
+ (nb_result = 0).if {
+ result := PROTOTYPE_CST.create position type (TYPE_VOID.default); // BSBS: Alias.
+ } else {
+ (nb_result > 1).if {
+ // Creation Vector.
+ lr := FAST_ARRAY(EXPR).create_with_capacity nb_result;
+ (result_top).to (stack_result.upper) do { j:INTEGER;
+ lr.add_last (stack_result.item j.read position);
+ };
+ result := EXPR_MULTIPLE.create lr;
+ } else {
+ result := stack_result.last.read position;
+ };
+ };
+ // Pop local / Result.
+ pop_stack_until stack_top;
+ stack_result.remove_since result_top;
+ ? {stack_result.upper = Old stack_result.upper};
+ //
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ (code.count = 1).if {
+ buffer.add_last '(';
+ code.first.append_in buffer;
+ buffer.add_last ')';
+ } else {
+ buffer.append "(\n";
+ (code.lower).to (code.upper) do { i:INTEGER;
+ indent.append " ";
+ code.item i.append_in buffer;
+ buffer.append ";\n";
+ };
+ indent.remove_last 2;
+ buffer.append ")";
+ };
+ );
+
+Section ITM_LIST, ITM_RESULT
+
+ - stack_result:FAST_ARRAY(LOCAL) := FAST_ARRAY(LOCAL).create_with_capacity 16;
+
+
+
+
diff --git a/src2/item/itm_list_idf.li b/src2/item/itm_list_idf.li
new file mode 100644
index 0000000..9885897
--- /dev/null
+++ b/src2/item/itm_list_idf.li
@@ -0,0 +1,73 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_LIST_IDF;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "List identifier for assignment.";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ - is_affect:POSITION; // Nothing (it s good with 0).
+ // BSBS: A quoi ca sert ca ??? (Stop the Whisky)
+
+ //
+ // Data
+ //
+
+ + list_name:FAST_ARRAY(STRING_CONSTANT);
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION with lst:FAST_ARRAY(STRING_CONSTANT) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p with lst;
+ result
+ );
+
+ - make p:POSITION with lst:FAST_ARRAY(STRING_CONSTANT) <-
+ (
+ position := p;
+ list_name := lst;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ (
+ semantic_error (position,"ITM_LIST_IDF.to_run_expr");
+ NULL
+ );
+
+
\ No newline at end of file
diff --git a/src2/item/itm_local.li b/src2/item/itm_local.li
new file mode 100644
index 0000000..63224e2
--- /dev/null
+++ b/src2/item/itm_local.li
@@ -0,0 +1,143 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_LOCAL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Local declaration slot";
+
+Section Inherit
+
+ + parent_itm_object:Expanded ITM_OBJECT;
+
+Section Public
+
+ //
+ // Data
+ //
+
+ + type:ITM_TYPE_MONO;
+
+ + name:STRING_CONSTANT;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n;
+ result
+ );
+
+ - create p:POSITION name n:STRING_CONSTANT type t:ITM_TYPE_MONO :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n;
+ result.set_type t;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT <-
+ (
+ name := n;
+ position := p;
+ );
+
+ //
+ // Set
+ //
+
+ - set_type t:ITM_TYPE_MONO <-
+ (
+ type := t;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run:LOCAL <-
+ ( + pos:POSITION;
+ + result:LOCAL;
+
+ last_position := position;
+ result := LOCAL.create position name name style '+' type (type.to_run_for profil_slot);
+ last_position := pos;
+ result
+ );
+
+ - to_run_static:LOCAL <-
+ // Static local slot.
+ ( + result:LOCAL;
+ + slot:ITM_SLOT;
+ + larg:FAST_ARRAY(ITM_ARGUMENT);
+ + arg:ITM_ARGUMENT;
+ + proto:PROTOTYPE;
+
+ (type = ITM_TYPE_SIMPLE.type_self).if {
+ semantic_error (position,"Type `SELF' is not possible for `-' style local.");
+ };
+ result := LOCAL.create position name name style '-' type (type.to_run_for profil_slot);
+ //
+ proto := position.prototype;
+ slot := proto.first_slot;
+ {(slot != NULL) && {slot.position != position}}.while_do {
+ slot := slot.next;
+ };
+ (slot = NULL).if {
+ slot := ITM_SLOT.create position name (result.intern_name)
+ feature (SECTION_.get_name (ALIAS_STR.section_private));
+ slot.set_style '-';
+ slot.set_result_type type;
+ larg := ALIAS_ARRAY(ITM_ARGUMENT).new;
+ arg := ITM_ARG.create position name (ALIAS_STR.variable_self)
+ type (ITM_TYPE_SIMPLE.type_self);
+ larg.add_last arg;
+ larg := ALIAS_ARRAY(ITM_ARGUMENT).copy larg;
+ slot.set_argument_list larg;
+ proto.add_slot slot;
+ } else {
+ result.set_intern_name (slot.name);
+ };
+ //
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.append name;
+ buffer.add_last ':';
+ type.append_in buffer;
+ );
+
+
+
+
diff --git a/src/item/itm_number.li b/src2/item/itm_number.li
similarity index 100%
copy from src/item/itm_number.li
copy to src2/item/itm_number.li
diff --git a/src/item/itm_object.li b/src2/item/itm_object.li
similarity index 100%
copy from src/item/itm_object.li
copy to src2/item/itm_object.li
diff --git a/src2/item/itm_old.li b/src2/item/itm_old.li
new file mode 100644
index 0000000..6163151
--- /dev/null
+++ b/src2/item/itm_old.li
@@ -0,0 +1,125 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_OLD;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Old primitive for contract";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ + value:ITM_CODE;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION value val:ITM_CODE :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p value val;
+ result
+ );
+
+ - make p:POSITION value val:ITM_CODE <-
+ (
+ position := p;
+ value := val;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + expr_old:EXPR;
+ + instr:INSTR;
+ + result_old:LOCAL;
+ + lst:LIST;
+ + old_upper,diff:INTEGER;
+ + node:NODE_TYPE;
+ + old_stack_local:FAST_ARRAY(LOCAL);
+ + old_profil:PROFIL;
+
+ old_stack_local := stack_local;
+ old_profil := profil_current;
+ stack_local := stack_local_empty;
+ profil_current := profil_slot;
+ ? {stack_local.is_empty};
+ //
+ old_upper := list_current.upper;
+ expr_old := value.to_run_expr;
+ result_old := expr_old.static_type.get_temporary position;
+ list_current.add_last (result_old.write position value expr_old);
+ diff := list_current.upper - old_upper;
+ // Move instr to up.
+ lst := profil_slot.code;
+ {diff != 0}.while_do {
+ instr := list_current.last;
+ //
+ (NODE.node_list != NODE.node_list_base).if {
+ node ?= instr;
+ (node != NULL).if {
+ NODE.node_list.remove (NODE.node_list.fast_first_index_of node);
+ NODE.node_list_base.add_last node;
+ };
+ };
+
+ list_current.remove_last;
+ (debug_level_option != 0).if {
+ ? { + push:PUSH;
+ push ?= lst.first;
+ (push != NULL) && {push.is_first}
+ };
+ lst.add instr to (lst.lower + 1);
+ } else {
+ lst.add_first instr;
+ };
+ diff := diff - 1;
+ };
+ //
+ profil_current := old_profil;
+ stack_local := old_stack_local;
+ //
+ result_old.read position
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.append "Old ";
+ value.append_in buffer;
+ );
+
+Section Private
+
+ - stack_local_empty:FAST_ARRAY(LOCAL) := FAST_ARRAY(LOCAL).create 0;
diff --git a/src/item/itm_operator.li b/src2/item/itm_operator.li
similarity index 100%
copy from src/item/itm_operator.li
copy to src2/item/itm_operator.li
diff --git a/src/item/itm_prototype.li b/src2/item/itm_prototype.li
similarity index 100%
copy from src/item/itm_prototype.li
copy to src2/item/itm_prototype.li
diff --git a/src2/item/itm_read.li b/src2/item/itm_read.li
new file mode 100644
index 0000000..5df0213
--- /dev/null
+++ b/src2/item/itm_read.li
@@ -0,0 +1,305 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_READ;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "For local access variable or send message without argument";
+
+ // BSBS: Optim: Penser à faire un ITM_READ_ARG3 pour tous les `if then else'
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ - is_affect:POSITION; // Nothing (it's good with 0).
+
+ //
+ // Data
+ //
+
+ + name:STRING_CONSTANT;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT <-
+ (
+ position := p;
+ name := n;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + result:EXPR;
+ + loc:LOCAL;
+
+ loc := lookup name;
+ (loc != NULL).if {
+ //
+ // Local Access.
+ //
+ (loc.style = '-').if {
+ loc.set_ensure_count 1;
+ name := loc.intern_name;
+ result := to_run_with NULL args NULL;
+ } else {
+ result := loc.read position;
+ };
+ } else {
+ //
+ // Slot Access without argument.
+ //
+ result := to_run_with NULL args NULL;
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.append name;
+ buffer.append "()";
+ );
+
+Section ITM_READ, SLOT_DATA
+
+ - to_run_with first_itm:ITM_CODE args larg:FAST_ARRAY(ITM_CODE) :EXPR <-
+ ( + rec:EXPR;
+ //
+ + itm_list:ITM_LIST;
+ + itm_read:ITM_READ;
+ + is_resend,implicit_self:BOOLEAN;
+
+ //
+ // Compute `rec'.
+ //
+
+ (first_itm = NULL).if {
+ // Implicit Self.
+ rec := lookup (ALIAS_STR.variable_self).read position;
+ implicit_self := TRUE;
+ } else {
+ rec := first_itm.to_run_expr;
+ // Resend detect.
+ itm_list ?= first_itm;
+ (itm_list != NULL).if {
+ itm_read ?= itm_list.code.first;
+ } else {
+ itm_read ?= first_itm;
+ };
+ is_resend := (
+ (itm_read != NULL) &&
+ {position.prototype.search_parent (itm_read.name)}
+ );
+ };
+ to_run_with_self (rec,implicit_self,is_resend) args larg
+ );
+
+ - to_run_with_self (r:EXPR,implicit_self,is_resend:BOOLEAN)
+ args larg:FAST_ARRAY(ITM_CODE) :EXPR <-
+ ( + args:FAST_ARRAY(EXPR);
+ + rec_type:TYPE;
+ + rec:EXPR;
+ + em:EXPR_MULTIPLE;
+ + pos_null:POSITION;
+ //
+ + slot_msg:SLOT;
+ + is_block_value:BOOLEAN;
+ //
+ + base:NODE;
+
+ rec := r;
+ //
+ // Detect slot.
+ //
+ args := ALIAS_ARRAY(EXPR).new;
+ rec_type := rec.static_type.raw;
+ (rec_type = TYPE_VOID).if {
+ // BSBS: Ce cas ne doit jamais arriver !
+ // il se déclenche avec parent.msg.truc lorsque msg du parent n'a pas de type de retour
+ // Mais que le profil général en a un...
+ semantic_error (position,"Call on Void");
+ };
+
+ (
+ (rec_type.is_block) &&
+ {name = ALIAS_STR.slot_value}
+ ).if {
+ // { ... }.value
+ is_block_value := TRUE;
+ } else {
+ slot_msg := rec_type.get_slot name;
+ (slot_msg = NULL).if {
+ string_tmp.copy "Slot `";
+ string_tmp.append name;
+ string_tmp.append "' not found in `";
+ rec_type.append_name_in string_tmp;
+ string_tmp.append "'.";
+ semantic_error (position,string_tmp);
+ };
+ // Verification
+ (verify).if {
+ (
+ ((larg = NULL) && {slot_msg.argument_list.count != 1}) ||
+ {(larg != NULL) && {larg.count != slot_msg.argument_list.count-1}}
+ ).if {
+ POSITION.put_error semantic text "Incorrect number argument.";
+ slot_msg.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ last_position := slot_msg.position;
+ ( !
+ slot_msg.id_section.access rec_type with (profil_slot.type_self.raw)
+ ).if {
+ string_tmp.copy "Type ";
+ profil_slot.type_self.append_name_in string_tmp;
+ string_tmp.append " does not have access to this slot.";
+ POSITION.put_error warning text string_tmp;
+ slot_msg.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ last_position := pos_null;
+ };
+ };
+ //
+ // Add arguments
+ //
+ add_arg rec to 0 in args for slot_msg block is_block_value;
+ em ?= rec;
+ (em != NULL).if {
+ rec := em.expr_list.first;
+ };
+ (larg != NULL).if {
+ (larg.lower).to (larg.upper) do { j:INTEGER;
+ add_arg (larg.item j.to_run_expr) to (j+1) in args for slot_msg block is_block_value;
+ };
+ };
+
+ //
+ // Send message.
+ //
+ (is_block_value).if {
+ // { ... }.value
+ args := ALIAS_ARRAY(EXPR).copy args;
+ args.put (args.first.my_copy) to 0;
+ //rec := slot_msg.slot_data_intern.read position with rec;
+ base := NODE.new_block position receiver rec with args;
+ }.elseif {args.count = 1} then {
+ // Classic message without arguments.
+ (is_resend).if {
+ args.put (lookup (ALIAS_STR.variable_self).read position) to 0;
+ args.first.remove;
+ };
+
+ ((verify) && {is_all_warning} && {name == "deferred"}).if {
+ string_tmp.copy "Deferred in `";
+ string_tmp.append (profil_slot.slot.name);
+ string_tmp.append "' for ";
+ rec.static_type.append_name_in string_tmp;
+ warning_error (position,string_tmp);
+ };
+
+ base := NODE.new_read position slot slot_msg
+ receiver rec self (args.first) intern implicit_self;
+
+ ALIAS_ARRAY(EXPR).free args;
+ } else {
+ // Classic message with arguments.
+ (is_resend).if {
+ args.put (lookup (ALIAS_STR.variable_self).read position) to 0;
+ } else {
+ args.put (args.first.my_copy) to 0;
+ };
+ args := ALIAS_ARRAY(EXPR).copy args;
+ base := NODE.new_read position slot slot_msg
+ receiver rec with args intern implicit_self;
+ };
+ list_current.add_last base;
+
+ (larg != NULL).if {
+ ALIAS_ARRAY(ITM_CODE).free larg;
+ };
+
+ ? {base.result_expr != NULL};
+ base.result_expr
+ );
+
+Section Private
+
+ - add_arg e:EXPR to idx:INTEGER
+ in args:FAST_ARRAY(EXPR) for slot:SLOT block is_block_value:BOOLEAN <-
+ ( + em:EXPR_MULTIPLE;
+ + count:INTEGER;
+
+ em ?= e;
+ (em != NULL).if {
+ count := em.cardinality;
+ args.append_collection (em.expr_list);
+ } else {
+ count := 1;
+ args.add_last e;
+ };
+ (verify).if {
+ (! is_block_value).if {
+ (slot.argument_list.item idx.count != count).if {
+ string_tmp.copy "Incorrect vector size for #";
+ idx.append_in string_tmp;
+ string_tmp.append " argument of `";
+ string_tmp.append name;
+ string_tmp.append "' slot. (slot #";
+ slot.argument_list.item idx.count.append_in string_tmp;
+ string_tmp.append ", call #";
+ count.append_in string_tmp;
+ string_tmp.add_last ')';
+ POSITION.put_error semantic text string_tmp;
+ slot.argument_list.item idx.position.put_position;
+ e.position.put_position;
+ POSITION.send_error;
+ };
+ }.elseif {(idx = 0) && {count != 1}} then {
+ semantic_error (e.position,"Incorrect vector size for `value' message.");
+ };
+ };
+ );
+
\ No newline at end of file
diff --git a/src/item/itm_read_arg1.li b/src2/item/itm_read_arg1.li
similarity index 100%
copy from src/item/itm_read_arg1.li
copy to src2/item/itm_read_arg1.li
diff --git a/src2/item/itm_read_arg2.li b/src2/item/itm_read_arg2.li
new file mode 100644
index 0000000..a434c82
--- /dev/null
+++ b/src2/item/itm_read_arg2.li
@@ -0,0 +1,131 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_READ_ARG2;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "For send message with two argument (receiver + argument)\
+ \ or simple binary message";
+
+Section Inherit
+
+ + parent_itm_read:Expanded ITM_READ;
+
+Section Public
+
+ - is_affect:POSITION <-
+ ( + result:POSITION;
+
+ (arg_first != NULL).if {
+ result := arg_first.position;
+ } else {
+ result := arg_second.is_affect;
+ };
+ result
+ );
+
+ //
+ // Data
+ //
+
+ + arg_first:ITM_CODE;
+
+ + arg_second:ITM_CODE;
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT args (a1,a2:ITM_CODE) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n args (a1,a2);
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT args (a1,a2:ITM_CODE) <-
+ (
+ ? { a2 != NULL };
+ position := p;
+ name := n;
+ arg_first := a1;
+ arg_second := a2;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + result:EXPR;
+ + l_arg:FAST_ARRAY(ITM_CODE);
+ + v1,v2:EXPR;
+ + t1,t2:TYPE_FULL;
+
+ (
+ (name = ALIAS_STR.operator_equal) ||
+ {name = ALIAS_STR.operator_not_equal}
+ ).if {
+ v1 := arg_first .to_run_expr;
+ v2 := arg_second.to_run_expr;
+ (verify).if {
+ t1 := v1.static_type;
+ t2 := v2.static_type;
+ (
+ (! t1.is_expanded) &&
+ {! t2.is_expanded} &&
+ {! t1.is_sub_type t2} &&
+ {! t2.is_sub_type t1}
+ ).if {
+ string_tmp.clear;
+ t1.append_name_in string_tmp;
+ string_tmp.append " and ";
+ t2.append_name_in string_tmp;
+ string_tmp.append " are not comparable.";
+ warning_error (position,string_tmp);
+ };
+ };
+ (name = ALIAS_STR.operator_equal).if {
+ result := EXPR_EQUAL.create position with v1 and v2;
+ } else {
+ result := EXPR_NOT_EQUAL.create position with v1 and v2;
+ };
+ } else {
+ l_arg := ALIAS_ARRAY(ITM_CODE).new;
+ l_arg.add_last arg_second;
+ result := to_run_with arg_first args l_arg;
+ };
+ result
+ );
+
+
+
+
+
+
+
+
+
+
diff --git a/src2/item/itm_read_args.li b/src2/item/itm_read_args.li
new file mode 100644
index 0000000..6569559
--- /dev/null
+++ b/src2/item/itm_read_args.li
@@ -0,0 +1,97 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_READ_ARGS;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Message with a lot of arguments";
+
+Section Inherit
+
+ + parent_itm_read:Expanded ITM_READ;
+
+Section Public
+
+ - is_affect:POSITION <-
+ ( + result,default:POSITION;
+ + j:INTEGER;
+
+ (args.first != NULL).if {
+ result := args.first.position;
+ } else {
+ j := args.lower + 1;
+ {(j <= args.upper) && {result = default}}.while_do {
+ result := args.item j.is_affect;
+ j := j + 1;
+ };
+ };
+ result
+ );
+
+ //
+ // Data
+ //
+
+ + args:FAST_ARRAY(ITM_CODE);
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT args arg:FAST_ARRAY(ITM_CODE) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n args arg;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT args arg:FAST_ARRAY(ITM_CODE) <-
+ (
+ position := p;
+ name := n;
+ args := arg;
+ );
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + l_arg:FAST_ARRAY(ITM_CODE);
+
+ l_arg := ALIAS_ARRAY(ITM_CODE).new;
+ (args.lower+1).to (args.upper) do { j:INTEGER;
+ l_arg.add_last (args.item j);
+ };
+ to_run_with (args.first) args l_arg
+ );
+
+
+
+
+
+
+
+
diff --git a/src/item/itm_real.li b/src2/item/itm_real.li
similarity index 100%
copy from src/item/itm_real.li
copy to src2/item/itm_real.li
diff --git a/src/item/itm_result.li b/src2/item/itm_result.li
similarity index 100%
copy from src/item/itm_result.li
copy to src2/item/itm_result.li
diff --git a/src2/item/itm_slot.li b/src2/item/itm_slot.li
new file mode 100644
index 0000000..9d34f17
--- /dev/null
+++ b/src2/item/itm_slot.li
@@ -0,0 +1,386 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_SLOT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Slot item";
+
+Section Inherit
+
+ + parent_named:Expanded NAMED;
+
+Section Public
+
+ //
+ // Shorter information.
+ //
+
+ + comment:STRING_CONSTANT;
+
+ - set_comment str:STRING_CONSTANT <-
+ (
+ comment := str;
+ );
+
+ + comment_chapter:STRING_CONSTANT;
+
+ - set_comment_chapter c:STRING_CONSTANT <-
+ (
+ comment_chapter := c;
+ );
+
+ + stat_shorter:INTEGER_8;
+
+ - set_stat_shorter s:INTEGER_8 <-
+ (
+ stat_shorter := s;
+ );
+
+ //
+ // Profil
+ //
+
+ + id_section:SECTION_;
+
+ - argument_count:INTEGER <-
+ ( + result:INTEGER;
+
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ result := result + argument_list.item j.count;
+ };
+ result
+ );
+
+ + argument_list:FAST_ARRAY(ITM_ARGUMENT);
+
+ + result_type:ITM_TYPE;
+
+ - set_result_type t:ITM_TYPE <-
+ ( + tm:ITM_TYPE_MONO;
+
+ (id_section.is_inherit_or_insert).if {
+ tm ?= t;
+ (
+ (tm = NULL) ||
+ {tm = ITM_TYPE_SIMPLE.type_self} ||
+ {tm = ITM_TYPE_SIMPLE.type_void}
+ ).if {
+ semantic_error (position,"Incorrect type for inheritance slot.");
+ };
+ };
+ /*
+ "ITM_SLOT : ".print;
+ name.print; ' '.print;
+ ( +tmu:ITM_TYPE_MULTI;
+ tmu ?= t;
+ (tmu != NULL).if {
+ tmu.count.print;
+ };
+ );
+ '\n'.print;
+ */
+ result_type := t;
+ );
+
+ - set_argument_list p:FAST_ARRAY(ITM_ARGUMENT) <-
+ (
+ ((p.count > 1) || {p.first.count > 1}).if {
+ (id_section.is_interrupt).if {
+ semantic_error (p.last.position,"No argument for interrupt slot.");
+ };
+ (id_section.is_inherit_or_insert).if {
+ semantic_error (p.last.position,"No argument for inheritance slot.");
+ };
+ };
+ argument_list := p;
+ );
+
+ - is_equal_profil other:ITM_SLOT <-
+ (
+ (Self != other).if {
+ (result_type != other.result_type).if {
+ string_tmp.copy "Invariance type result invalid."; // (";
+ //type.to_run.append_name_in string_tmp;
+ //string_tmp.append " != ";
+ //other.type.to_run.append_name_in string_tmp;
+ //string_tmp.append ").";
+ POSITION.put_error semantic text string_tmp;
+ position.put_position;
+ (other.position).put_position;
+ POSITION.send_error;
+ };
+ (id_section != other.id_section).if {
+ POSITION.put_error warning text
+ "Invariance section declaration invalid.";
+ position.put_position;
+ (other.position).put_position;
+ POSITION.send_error;
+ };
+ (argument_list != NULL).if {
+ ? {argument_list.count = other.argument_list.count};
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ argument_list.item j.is_equal (other.argument_list.item j);
+ };
+ };
+ };
+ );
+
+ //
+ // Data.
+ //
+
+ + affect:CHARACTER; // ':', '?', '<'
+
+ - set_affect a:CHARACTER <-
+ (
+ affect := a;
+ );
+
+ + next:ITM_SLOT;
+
+ - set_next n:ITM_SLOT <-
+ (
+ next := n;
+ );
+
+ //
+ // Access associativity & priority level.
+ //
+
+ - priority_and_level:INTEGER <-
+ (
+ crash_with_message "ITM_SLOT.priority_and_level.";
+ 0
+ );
+
+ - associativity:STRING_CONSTANT <-
+ (
+ crash_with_message "ITM_SLOT.associativity.";
+ NULL
+ );
+
+ - priority:INTEGER <-
+ (
+ crash_with_message "ITM_SLOT.priority.";
+ 0
+ );
+
+ //
+ // Value.
+ //
+
+ + require:ITM_LIST;
+ + ensure:ITM_LIST;
+
+ + value:ITM_CODE;
+
+ - set_value e:ITM_CODE type p:PROTOTYPE <-
+ // Static definition.
+ [
+ -? {affect != '\0'};
+ ]
+ (
+ (affect = '<').if {
+ value := e;
+ } else {
+ //semantic_error (position,"not_yet_implemented");
+ value := default_value e in p;
+ };
+ );
+
+ - set_require e:ITM_LIST <-
+ (
+ require := e;
+ );
+
+ - set_ensure e:ITM_LIST <-
+ (
+ ensure := e;
+ );
+
+ //
+ // Constructeur.
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT feature sec:SECTION_ :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n feature sec;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT feature sec:SECTION_ <-
+ (
+ name := n;
+ position := p;
+ id_section := sec;
+ );
+
+ //
+ // Runnable.
+ //
+
+ - get_index_argument_type p:ITM_TYPE_PARAMETER :INTEGER <-
+ ( + i,result,max:INTEGER;
+ + arg:ITM_ARGUMENT;
+
+ i := argument_list.lower;
+ {(i <= argument_list.upper) && {result = max}}.while_do {
+ arg := argument_list.item i;
+ max := max + arg.count;
+ result := result + arg.get_index_type p;
+ i := i +1;
+ };
+ (result = max).if {
+ result := -1;
+ };
+ result
+ );
+
+ - check_argument_type larg:FAST_ARRAY(EXPR) for p:PARAMETER_TO_TYPE <-
+ ( + idx:INTEGER;
+ + a:ITM_ARGUMENT;
+
+ (argument_list.lower).to (argument_list.upper) do { i:INTEGER;
+ a := argument_list.item i;
+ idx := a.check larg index idx for p;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.append name;
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ buffer.add_last ' ';
+ argument_list.item j.append_in buffer;
+ };
+ buffer.add_last ' ';
+ buffer.add_last ':';
+ result_type.append_in buffer;
+ );
+
+ - pretty_name_in buffer:STRING <-
+ ( + j:INTEGER;
+
+ j := name.lower;
+ {j < name.upper}.while_do {
+ ((name.item j = '_') && {name.item (j+1) = '_'}).if {
+ buffer.add_last ' ';
+ j := j + 2;
+ } else {
+ buffer.add_last (name.item j);
+ j := j + 1;
+ };
+ };
+ buffer.add_last (name.last);
+ );
+
+ - shorter_profile_in buf:STRING <-
+ (
+ // style.
+ (style = '+').if {
+ put "+" to buf like (ALIAS_STR.short_slot_style);
+ } else {
+ put "-" to buf like (ALIAS_STR.short_slot_style);
+ };
+ shorter_profile_intern_in buf;
+ // Result.
+ (result_type != ITM_TYPE_SIMPLE.type_void).if {
+ buf.add_last ':';
+ result_type.shorter_in buf;
+ };
+ );
+
+Section ITM_SLOT
+
+ - shorter_profile_intern_in buf:STRING <-
+ ( + j,i:INTEGER;
+ // Name + arguments.
+ string_tmp.clear;
+ j := name.lower;
+ argument_list.first.shorter_in buf;
+ buf.add_last '.';
+ i := argument_list.lower+1;
+ {j < name.upper}.while_do {
+ ((name.item j = '_') && {name.item (j+1) = '_'}).if {
+ put string_tmp to buf like (ALIAS_STR.short_slot);
+ buf.add_last ' ';
+ argument_list.item i.shorter_in buf;
+ buf.add_last ' ';
+ string_tmp.clear;
+ j := j + 2;
+ i := i + 1;
+ } else {
+ string_tmp.add_last (name.item j);
+ j := j + 1;
+ };
+ };
+ string_tmp.add_last (name.last);
+ put string_tmp to buf like (ALIAS_STR.short_slot);
+ (i <= argument_list.upper).if {
+ buf.add_last ' ';
+ argument_list.last.shorter_in buf;
+ buf.add_last ' ';
+ };
+ );
+
+Section Private
+
+ - default_value v:ITM_CODE in t:PROTOTYPE :ITM_CODE <-
+ ( //+ lst:ITM_LIST;
+ + s:ITM_SLOT;
+ + n:STRING_CONSTANT;
+ + sec:SECTION_;
+ + larg:FAST_ARRAY(ITM_ARGUMENT);
+ + a:ITM_CODE;
+
+ // Add function for init.
+ string_tmp.copy "__init_";
+ string_tmp.append name;
+ n := ALIAS_STR.get string_tmp;
+ sec := SECTION_.get_name (ALIAS_STR.section_public);
+ 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 '<';
+ ? {result_type != NULL};
+ s.set_value v type t;
+ s.set_argument_list larg;
+ s.set_result_type result_type;
+ t.slot_list.fast_put s to (s.name);
+ (t.generic_count = 0).if {
+ a := ITM_PROTOTYPE.create (v.position) type (ITM_TYPE_SIMPLE.get (t.name));
+ };
+ ITM_READ_ARG1.create (v.position) name n arg a
+ );
diff --git a/src/item/itm_slot_operator.li b/src2/item/itm_slot_operator.li
similarity index 100%
copy from src/item/itm_slot_operator.li
copy to src2/item/itm_slot_operator.li
diff --git a/src/item/itm_string.li b/src2/item/itm_string.li
similarity index 100%
copy from src/item/itm_string.li
copy to src2/item/itm_string.li
diff --git a/src2/item/itm_type.li b/src2/item/itm_type.li
new file mode 100644
index 0000000..ef95eae
--- /dev/null
+++ b/src2/item/itm_type.li
@@ -0,0 +1,57 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all type";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ - print <-
+ (
+ string_tmp.clear;
+ append_in string_tmp;
+ string_tmp.print;
+ );
+
+ - append_in buffer:STRING <- deferred;
+
+ - shorter_in buf:STRING <- deferred;
+
+ - to_run_in lst:FAST_ARRAY(TYPE_FULL) for p:PARAMETER_TO_TYPE <-
+ (
+ deferred;
+ );
+
+ - get_expr_for p:PARAMETER_TO_TYPE :EXPR <-
+ (
+ deferred;
+ NULL
+ );
diff --git a/src2/item/itm_type_block.li b/src2/item/itm_type_block.li
new file mode 100644
index 0000000..9fe4333
--- /dev/null
+++ b/src2/item/itm_type_block.li
@@ -0,0 +1,132 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_BLOCK;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type block definition";
+
+Section Inherit
+
+ + parent_itm_type_mono:Expanded ITM_TYPE_MONO;
+
+Section ITM_TYPE_SIMPLE, ITM_TYPE_SELF
+
+ - dico:FAST_ARRAY(ITM_TYPE_BLOCK) := FAST_ARRAY(ITM_TYPE_BLOCK).create_with_capacity 32;
+
+Section Private
+
+ - create typ_arg:ITM_TYPE and typ_res:ITM_TYPE :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make typ_arg and typ_res;
+ result
+ );
+
+ - make typ_arg:ITM_TYPE and typ_res:ITM_TYPE <-
+ (
+ type_argument := typ_arg;
+ type_result := typ_res;
+ );
+
+Section Public
+
+ + type_argument:ITM_TYPE;
+ + type_result:ITM_TYPE;
+
+ - get typ_arg:ITM_TYPE and typ_res:ITM_TYPE :ITM_TYPE_BLOCK <-
+ ( + result:ITM_TYPE_BLOCK;
+ + idx:INTEGER;
+
+ idx := dico.lower;
+ {
+ (idx <= dico.upper) && {
+ {dico.item idx.type_argument != typ_arg} ||
+ {dico.item idx.type_result != typ_res}
+ }
+ }.while_do {
+ idx := idx + 1;
+ };
+ (idx <= dico.upper).if {
+ result := dico.item idx;
+ } else {
+ result := create typ_arg and typ_res;
+ dico.add_last result;
+ };
+ result
+ );
+
+ - to_run_for p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ (
+ TYPE_BLOCK.get Self with p
+ );
+
+ - append_in buffer:STRING <-
+ ( + typ_mul:ITM_TYPE_MULTI;
+ buffer.add_last '{';
+ (type_argument != NULL).if {
+ type_argument.append_in buffer;
+ buffer.add_last ';';
+ buffer.add_last ' ';
+ };
+ (type_result != NULL).if {
+ typ_mul ?= type_result;
+ (typ_mul = NULL).if {
+ type_result.append_in buffer;
+ } else {
+ typ_mul.display_raw buffer;
+ };
+ };
+ buffer.add_last '}';
+ );
+
+ - shorter_in buf:STRING <-
+ ( + typ_mul:ITM_TYPE_MULTI;
+ put "{" to buf like (ALIAS_STR.short_block);
+ (type_argument != NULL).if {
+ type_argument.shorter_in buf;
+ buf.add_last ';';
+ buf.add_last ' ';
+ };
+ (type_result != NULL).if {
+ typ_mul ?= type_result;
+ (typ_mul = NULL).if {
+ type_result.shorter_in buf;
+ } else {
+ typ_mul.shorter_raw_in buf;
+ };
+ };
+ put "}" to buf like (ALIAS_STR.short_block);
+ );
+
+ //
+ // Cast.
+ //
+
+ - append_cast_name_in buf:STRING <-
+ (
+ crash_with_message "ITM_TYPE_BLOCK.append_cast_name_in ";
+ );
\ No newline at end of file
diff --git a/src2/item/itm_type_generic.li b/src2/item/itm_type_generic.li
new file mode 100644
index 0000000..300f50c
--- /dev/null
+++ b/src2/item/itm_type_generic.li
@@ -0,0 +1,150 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_GENERIC;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Generic style type";
+
+Section Inherit
+
+ + parent_itm_type_style:Expanded ITM_TYPE_STYLE;
+
+Section Private
+
+ - dico:FAST_ARRAY(ITM_TYPE_GENERIC) := FAST_ARRAY(ITM_TYPE_GENERIC).create_with_capacity 32;
+
+ - create n:STRING_CONSTANT style s:STRING_CONSTANT with lt:FAST_ARRAY(ITM_TYPE_MONO) :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make n style s with lt;
+ result
+ );
+
+ - make n:STRING_CONSTANT style s:STRING_CONSTANT with lt:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ name := n;
+ style := s;
+ list_type := lt;
+ );
+
+Section Public
+
+ - hash_code:INTEGER <- name.hash_code;
+
+ + list_type:FAST_ARRAY(ITM_TYPE_MONO);
+
+ - get n:STRING_CONSTANT style s:STRING_CONSTANT
+ with lt:FAST_ARRAY(ITM_TYPE_MONO) :SELF <-
+ ( + result:SELF;
+ + idx:INTEGER;
+
+ idx := dico.lower;
+ {
+ (idx <= dico.upper) && {
+ (dico.item idx.name != n ) ||
+ {dico.item idx.style != s } ||
+ {dico.item idx.list_type != lt}
+ }
+ }.while_do {
+ idx := idx + 1;
+ };
+ (idx <= dico.upper).if {
+ result ?= dico.item idx;
+ } else {
+ result := create n style s with lt;
+ dico.add_last result;
+ };
+ result
+ );
+
+ - to_run_for p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ ( + lst:FAST_ARRAY(TYPE_FULL);
+ + t:TYPE_FULL;
+ + j:INTEGER;
+ + result:TYPE_FULL;
+
+ lst := ALIAS_ARRAY(TYPE_FULL).new;
+ j := list_type.lower;
+ {
+ t := list_type.item j.to_run_for p;
+ lst.add_last t;
+ j := j + 1;
+ }.do_while {(j <= list_type.upper) && {t != NULL}};
+ (t = NULL).if {
+ ALIAS_ARRAY(TYPE_FULL).free lst;
+ } else {
+ lst := ALIAS_ARRAY(TYPE_FULL).alias lst;
+ result := TYPE_GENERIC.get Self with lst;
+ };
+ result
+ );
+
+ - append_in buffer:STRING <-
+ (
+ (style != NULL).if {
+ buffer.append style;
+ buffer.add_last ' ';
+ };
+ buffer.append name;
+ buffer.add_last '(';
+ (list_type.lower).to (list_type.upper - 1) do { j:INTEGER;
+ list_type.item j.append_in buffer;
+ buffer.add_last ',';
+ };
+ list_type.last.append_in buffer;
+ buffer.add_last ')';
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ (style != NULL).if {
+ put style to buf like (ALIAS_STR.short_keyword);
+ buf.add_last ' ';
+ };
+ put name to buf like (ALIAS_STR.short_prototype);
+ buf.add_last '(';
+ (list_type.lower).to (list_type.upper - 1) do { j:INTEGER;
+ list_type.item j.shorter_in buf;
+ buf.add_last ',';
+ };
+ list_type.last.shorter_in buf;
+ buf.add_last ')';
+ );
+
+ //
+ // Cast.
+ //
+
+ - append_cast_name_in buf:STRING <-
+ (
+ parent_itm_type_style.append_cast_name_in buf;
+ buf.append "_of_";
+ (list_type.lower).to (list_type.upper - 1) do { j:INTEGER;
+ list_type.item j.append_cast_name_in buf;
+ buf.append "_and_";
+ };
+ list_type.last.append_cast_name_in buf;
+ );
\ No newline at end of file
diff --git a/src2/item/itm_type_generic_elt.li b/src2/item/itm_type_generic_elt.li
new file mode 100644
index 0000000..eabafe4
--- /dev/null
+++ b/src2/item/itm_type_generic_elt.li
@@ -0,0 +1,113 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_GENERIC_ELT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Virtual element for generic style type";
+
+Section Inherit
+
+ + parent_itm_type:Expanded ITM_TYPE_MONO;
+
+Section Private
+
+ - list:FAST_ARRAY(ITM_TYPE_GENERIC_ELT) :=
+ // 'A' to 'Z'
+ ( + result:FAST_ARRAY(ITM_TYPE_GENERIC_ELT);
+
+ result := FAST_ARRAY(ITM_TYPE_GENERIC_ELT).create_with_capacity 26;
+ 'A'.to 'Z' do { c:CHARACTER;
+ result.add_last (create c);
+ };
+ result
+ );
+
+ - create idf:CHARACTER :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make idf;
+ result
+ );
+
+ - make idf:CHARACTER <-
+ (
+ index := idf -! 'A';
+ );
+
+Section Public
+
+ + index:INTEGER;
+
+ - hash_code:INTEGER <- index;
+
+ - get idf:CHARACTER :ITM_TYPE_GENERIC_ELT <-
+ (
+ list.item (idf -! 'A')
+ );
+
+ - display buffer:STRING <-
+ (
+ buffer.append "Generic[";
+ buffer.add_last ('A' +# index);
+ buffer.add_last ']';
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ string_tmp.clear;
+ string_tmp.add_last ('A' +# index);
+ put string_tmp to buf like (ALIAS_STR.short_keyprototype);
+ );
+
+ - string_tmp:STRING := STRING.create 100;
+
+ - to_run:TYPE_FULL <-
+ ( + type_generic:TYPE_GENERIC;
+ + result:TYPE_FULL;
+ + t:CHARACTER;
+
+ t := 'A' +# index;
+ type_generic ?= ITM_TYPE_SELF.self_up;
+ (type_generic != NULL).if {
+ result := type_generic.generic_to_type t;
+ };
+ (result = NULL).if {
+ string_tmp.copy "Type parameter `";
+ string_tmp.add_last t;
+ string_tmp.append "' is not define.";
+ semantic_error (ITM_TYPE_SELF.to_run.prototype.position,string_tmp);
+ };
+ result
+ );
+
+ //
+ // Cast.
+ //
+
+ - append_cast_name_in buf:STRING <-
+ (
+ buf.add_last ('a' +# index);
+ );
\ No newline at end of file
diff --git a/src2/item/itm_type_mono.li b/src2/item/itm_type_mono.li
new file mode 100644
index 0000000..8a70962
--- /dev/null
+++ b/src2/item/itm_type_mono.li
@@ -0,0 +1,69 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_MONO;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type simple";
+
+Section Inherit
+
+ + parent_itm_type:Expanded ITM_TYPE;
+
+Section Public
+
+ - hash_code:INTEGER <-
+ (
+ deferred;
+ 0
+ );
+
+ //
+ // Runnable.
+ //
+
+ - to_run_for p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ (
+ deferred;
+ NULL
+ );
+
+ - to_run_in lst:FAST_ARRAY(TYPE_FULL) for p:PARAMETER_TO_TYPE <-
+ (
+ lst.add_last (to_run_for p);
+ );
+
+ - get_expr_for p:PARAMETER_TO_TYPE :EXPR <-
+ ( + t:TYPE_FULL;
+
+ t := to_run_for p;
+ t.get_temporary_expr (p.position)
+ );
+
+ //
+ // Cast.
+ //
+
+ - append_cast_name_in buf:STRING <- deferred;
\ No newline at end of file
diff --git a/src2/item/itm_type_multi.li b/src2/item/itm_type_multi.li
new file mode 100644
index 0000000..4738baa
--- /dev/null
+++ b/src2/item/itm_type_multi.li
@@ -0,0 +1,153 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_MULTI;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "List of type";
+
+Section Inherit
+
+ + parent_itm_type:Expanded ITM_TYPE;
+
+Section Private
+
+ - dico:FAST_ARRAY(ITM_TYPE_MULTI) := FAST_ARRAY(ITM_TYPE_MULTI).create_with_capacity 32;
+
+ - create lt:FAST_ARRAY(ITM_TYPE_MONO) :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make lt;
+ result
+ );
+
+ - make lt:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ list_type := lt;
+ );
+
+Section Public
+
+ + list_type:FAST_ARRAY(ITM_TYPE_MONO);
+
+ - count:INTEGER <- list_type.count;
+
+ - lower:INTEGER <- list_type.lower;
+
+ - upper:INTEGER <- list_type.upper;
+
+ - item i:INTEGER :ITM_TYPE_MONO <-
+ (
+ list_type.item i
+ );
+
+ - last:ITM_TYPE_MONO <-
+ (
+ list_type.last
+ );
+
+ - first:ITM_TYPE_MONO <-
+ (
+ list_type.first
+ );
+
+ - get lt:FAST_ARRAY(ITM_TYPE_MONO) :SELF <-
+ ( + result:SELF;
+ + idx:INTEGER;
+
+ idx := dico.lower;
+ {(idx <= dico.upper) && {dico.item idx.list_type != lt}}.while_do {
+ idx := idx + 1;
+ };
+ (idx <= dico.upper).if {
+ result ?= dico.item idx;
+ } else {
+ result := create lt;
+ dico.add_last result;
+ };
+ result
+ );
+
+ //
+ // Runnable.
+ //
+
+ - get_expr_for p:PARAMETER_TO_TYPE :EXPR <-
+ ( + lst:FAST_ARRAY(EXPR);
+ + t:TYPE_FULL;
+
+ lst := FAST_ARRAY(EXPR).create_with_capacity count;
+ lower.to upper do { i:INTEGER;
+ t := item i.to_run_for p;
+ lst.add_last (t.get_temporary_expr (p.position));
+ };
+ EXPR_MULTIPLE.create lst
+ );
+
+ - to_run_in lst:FAST_ARRAY(TYPE_FULL) for p:PARAMETER_TO_TYPE <-
+ ( + t:TYPE_FULL;
+
+ lower.to upper do { i:INTEGER;
+ t := item i.to_run_for p;
+ lst.add_last t;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ buffer.add_last '(';
+ display_raw buffer;
+ buffer.add_last ')';
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ buf.add_last '(';
+ shorter_raw_in buf;
+ buf.add_last ')';
+ );
+
+ - display_raw buffer:STRING <-
+ (
+ (list_type.lower).to (list_type.upper - 1) do { j:INTEGER;
+ list_type.item j.append_in buffer;
+ buffer.add_last ',';
+ };
+ list_type.last.append_in buffer;
+ );
+
+ - shorter_raw_in buf:STRING <-
+ (
+ (list_type.lower).to (list_type.upper - 1) do { j:INTEGER;
+ list_type.item j.shorter_in buf;
+ buf.add_last ',';
+ };
+ list_type.last.shorter_in buf;
+ );
diff --git a/src/item/itm_type_parameter.li b/src2/item/itm_type_parameter.li
similarity index 100%
copy from src/item/itm_type_parameter.li
copy to src2/item/itm_type_parameter.li
diff --git a/src/item/itm_type_self.li b/src2/item/itm_type_self.li
similarity index 100%
copy from src/item/itm_type_self.li
copy to src2/item/itm_type_self.li
diff --git a/src2/item/itm_type_simple.li b/src2/item/itm_type_simple.li
new file mode 100644
index 0000000..bd900e1
--- /dev/null
+++ b/src2/item/itm_type_simple.li
@@ -0,0 +1,123 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_SIMPLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Simple type";
+
+Section Inherit
+
+ + parent_itm_type_mono:Expanded ITM_TYPE_MONO;
+
+Section ITM_TYPE_SIMPLE, ITM_TYPE_SELF
+
+ - dico:HASHED_DICTIONARY(ITM_TYPE_SIMPLE,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(ITM_TYPE_SIMPLE,STRING_CONSTANT).create;
+
+Section ITM_TYPE_SIMPLE
+
+ - create n:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make n;
+ result
+ );
+
+ - make n:STRING_CONSTANT <-
+ (
+ name := n;
+ dico.fast_put Self to n;
+ );
+
+Section Public
+
+ - type_null:ITM_TYPE_SIMPLE := ITM_TYPE_SIMPLE.get (ALIAS_STR.variable_null);
+ - type_void:ITM_TYPE_SIMPLE := ITM_TYPE_SIMPLE.get (ALIAS_STR.variable_void);
+ - type_self:ITM_TYPE_SIMPLE := ITM_TYPE_PARAMETER.create (ALIAS_STR.prototype_self);
+
+ - hash_code:INTEGER <- name.hash_code;
+
+ + name:STRING_CONSTANT;
+
+ - style:STRING_CONSTANT; // NULL
+
+ - get n:STRING_CONSTANT :ITM_TYPE_SIMPLE <-
+ [
+ -? {n != NULL};
+ ]
+ ( + result:ITM_TYPE_SIMPLE;
+
+ result := dico.fast_reference_at n;
+ (result = NULL).if {
+ result := create n;
+ };
+ result
+ );
+
+ + to_run_for p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ ( + result:TYPE_FULL;
+
+ (Self = type_null).if {
+ result := TYPE_NULL.default;
+ }.elseif {Self = type_void} then {
+ result := TYPE_VOID.default;
+ } else {
+ result := TYPE.get Self;
+ };
+ /*to_run_for :=*/ result // BSBS: A tester pour les perfs.
+ );
+
+ - append_in buffer:STRING <-
+ (
+ (style != NULL).if {
+ buffer.append style;
+ buffer.add_last ' ';
+ };
+ buffer.append name;
+ );
+
+ - shorter_in buf:STRING <-
+ (
+ (style != NULL).if {
+ put style to buf like (ALIAS_STR.short_keyword);
+ buf.add_last ' ';
+ };
+ put name to buf like (ALIAS_STR.short_prototype);
+ );
+
+ //
+ // Cast.
+ //
+
+ - append_cast_name_in buf:STRING <-
+ (
+ (name.lower).to (name.upper) do { j:INTEGER;
+ buf.add_last (name.item j.to_lower);
+ };
+ );
+
+
\ No newline at end of file
diff --git a/src2/item/itm_type_style.li b/src2/item/itm_type_style.li
new file mode 100644
index 0000000..4b51e2a
--- /dev/null
+++ b/src2/item/itm_type_style.li
@@ -0,0 +1,79 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_TYPE_STYLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type with style";
+
+Section Inherit
+
+ + parent_itm_type_simple:Expanded ITM_TYPE_SIMPLE;
+
+Section Private
+
+ - dico:FAST_ARRAY(ITM_TYPE_STYLE) := FAST_ARRAY(ITM_TYPE_STYLE).create_with_capacity 32;
+
+ - create n:STRING_CONSTANT style s:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make n style s;
+ result
+ );
+
+ - make n:STRING_CONSTANT style s:STRING_CONSTANT <-
+ (
+ name := n;
+ style := s;
+ );
+
+Section Public
+
+ + style:STRING_CONSTANT;
+
+ - get n:STRING_CONSTANT style s:STRING_CONSTANT :SELF <-
+ ( + result:SELF;
+ + idx:INTEGER;
+
+ idx := dico.lower;
+ {
+ (idx <= dico.upper) && {
+ (dico.item idx.name != n) ||
+ {dico.item idx.style != s}
+ }
+ }.while_do {
+ idx := idx + 1;
+ };
+ (idx <= dico.upper).if {
+ result ?= dico.item idx;
+ } else {
+ result := create n style s;
+ dico.add_last result;
+ };
+ result
+ );
+
+
diff --git a/src2/item/itm_write.li b/src2/item/itm_write.li
new file mode 100644
index 0000000..21cbcd1
--- /dev/null
+++ b/src2/item/itm_write.li
@@ -0,0 +1,197 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_WRITE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all write";
+
+Section Inherit
+
+ + parent_itm_code:Expanded ITM_CODE;
+
+Section Public
+
+ //
+ // Data
+ //
+
+ + assign:ITM_CODE;
+
+ + value:ITM_CODE;
+
+ - type:STRING_CONSTANT <-
+ (
+ deferred;
+ NULL
+ );
+
+ //
+ // Constructor
+ //
+
+ - create p:POSITION assign n:ITM_CODE with v:ITM_CODE :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p assign n with v;
+ result
+ );
+
+ - make p:POSITION assign n:ITM_CODE with v:ITM_CODE <-
+ (
+ position := p;
+ assign := n;
+ value := v;
+ );
+
+ //
+ // Access.
+ //
+
+ - get_simple_name:STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+ + without_arg:ITM_READ;
+
+ without_arg ?= assign;
+ (without_arg != NULL).if {
+ result := without_arg.name;
+ } else {
+ semantic_error (position,"ITM_WRITE: Not yet implemented.");
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buffer:STRING <-
+ (
+ assign.append_in buffer;
+ buffer.append type;
+ value.append_in buffer;
+ );
+
+Section Private
+
+ - affect name:STRING_CONSTANT with v:EXPR :EXPR <-
+ ( + loc:LOCAL;
+ + result:EXPR;
+
+ loc := lookup name;
+ (loc != NULL).if {
+ result := affect_local loc with v;
+ } else {
+ result := affect_slot name with v;
+ };
+ result
+ );
+
+ - affect_local loc:LOCAL with v:EXPR :EXPR <-
+ ( + e:INSTR;
+ + result:EXPR;
+ + val:EXPR;
+
+ (loc.style = '-').if {
+ result := affect_slot (loc.intern_name) with v;
+ } else {
+ (loc.style = ' ').if {
+ POSITION.put_error semantic text "Argument assignment is not possible.";
+ loc.position.put_position;
+ position.put_position;
+ POSITION.send_error;
+ };
+ val := v.check_type (loc.type) with position;
+ e := loc.write position value val;
+ list_current.add_last e;
+ result := loc.read position;
+ };
+ result
+ );
+
+ - affect_slot name:STRING_CONSTANT with v:EXPR :EXPR <-
+ ( + loc:VARIABLE;
+ + slot:SLOT;
+ + slot_dta:SLOT_DATA;
+ + node:NODE;
+ + result:EXPR;
+ + rec:EXPR;
+ + type:TYPE;
+ + em:EXPR_MULTIPLE;
+ + new_val:EXPR;
+ + lst:FAST_ARRAY(EXPR);
+
+ loc := lookup (ALIAS_STR.variable_self);
+ rec := loc.read position;
+ //
+ type := rec.static_type.raw;
+ slot := type.get_slot name;
+ (slot = NULL).if {
+ string_tmp.copy "Slot `";
+ string_tmp.append name;
+ string_tmp.append "' not found in static type ";
+ string_tmp.append (type.intern_name);
+ string_tmp.add_last '.';
+ semantic_error (position,string_tmp);
+ };
+ // Control type.
+ em ?= v;
+ slot_dta := slot.slot_data;
+ (em != NULL).if {
+ lst := em.expr_list;
+ (lst.lower).to (lst.upper - 1) do { j:INTEGER;
+ new_val := check (lst.item j) with (slot.slot_data_list.item j.type) and (slot.position);
+ lst.put new_val to j;
+ };
+ new_val := check (lst.last) with (slot_dta.type) and (slot.position);
+ lst.put new_val to (lst.upper);
+ new_val := em;
+ } else {
+ new_val := check v with (slot_dta.type) and (slot.position);
+ };
+ //
+ node := NODE.new_write position slot slot receiver rec value new_val;
+ list_current.add_last node;
+ result := node.result_expr;
+ result
+ );
+
+ - check v:EXPR with t:TYPE_FULL and p:POSITION :EXPR <-
+ ( + block:PROFIL_BLOCK;
+
+ block ?= v.static_type.raw;
+ ((block != NULL) && {block.is_context_sensitive}).if {
+ string_tmp.copy "This block is extern context sensitive (with `";
+ string_tmp.append (block.context_extern.name);
+ string_tmp.append "' local variable).";
+ POSITION.put_error semantic text string_tmp;
+ block.code.position.put_position;
+ p.put_position;
+ block.context_extern.position.put_position;
+ POSITION.send_error;
+ };
+ v.check_type t with p
+ );
+
diff --git a/src/item/itm_write_cast.li b/src2/item/itm_write_cast.li
similarity index 100%
copy from src/item/itm_write_cast.li
copy to src2/item/itm_write_cast.li
diff --git a/src/item/itm_write_code.li b/src2/item/itm_write_code.li
similarity index 100%
copy from src/item/itm_write_code.li
copy to src2/item/itm_write_code.li
diff --git a/src2/item/itm_write_value.li b/src2/item/itm_write_value.li
new file mode 100644
index 0000000..19d75eb
--- /dev/null
+++ b/src2/item/itm_write_value.li
@@ -0,0 +1,134 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ITM_WRITE_VALUE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Write with a value";
+
+Section Inherit
+
+ + parent_itm_write:Expanded ITM_WRITE;
+
+Section Public
+
+ - type:STRING_CONSTANT <- ":=";
+
+ //
+ // Runnable
+ //
+
+ - to_run_expr:EXPR <-
+ ( + ass_multiple:ITM_LIST_IDF;
+ + val:EXPR;
+ + val_multiple:EXPR_MULTIPLE;
+ + j:INTEGER;
+ + lst_idf:FAST_ARRAY(STRING_CONSTANT);
+ + itm_read:ITM_READ;
+ + lst_exp:FAST_ARRAY(EXPR);
+ + result:EXPR;
+
+ val := value.to_run_expr;
+
+ val_multiple ?= val;
+ (val_multiple != NULL).if {
+ //
+ // Assignment Vector.
+ //
+ lst_exp := FAST_ARRAY(EXPR).create_with_capacity (val_multiple.count);
+ ass_multiple ?= assign;
+ (ass_multiple != NULL).if {
+ lst_idf := ass_multiple.list_name;
+ (lst_idf.lower).to (lst_idf.upper-1) do { i:INTEGER;
+ j := affect (lst_idf.item i) with val_multiple index j in lst_exp;
+ };
+ j := affect (lst_idf.last) with val_multiple index j in lst_exp;
+ } else {
+ itm_read ?= assign;
+ ? {itm_read != NULL};
+ j := affect (itm_read.name) with val_multiple index j in lst_exp;
+ };
+ (j <= val_multiple.upper).if {
+ semantic_error (position,"Incorrect size vector.");
+ };
+ result := EXPR_MULTIPLE.create lst_exp;
+ } else {
+ //
+ // Assignment simple.
+ //
+ itm_read ?= assign;
+ ? {itm_read != NULL};
+ result := affect (itm_read.name) with val;
+ };
+ result
+ );
+
+Section Private
+
+ - affect idf:STRING_CONSTANT with val:EXPR_MULTIPLE
+ index n:INTEGER in lst:FAST_ARRAY(EXPR) :INTEGER <-
+ ( + loc:LOCAL;
+ + result:INTEGER;
+ + slot:SLOT;
+ + typ_multi:ITM_TYPE_MULTI;
+ + lst_expr:FAST_ARRAY(EXPR);
+
+ (n > val.upper).if {
+ semantic_error (position,"Incorrect size vector.");
+ };
+
+ loc := lookup idf;
+ (loc != NULL).if {
+ lst.add_last (affect_local loc with (val.item n));
+ result := n + 1;
+ } else {
+ slot := profil_slot.type_self.get_slot idf;
+ (slot = NULL).if {
+ string_tmp.copy "Slot `";
+ string_tmp.append idf;
+ string_tmp.append "' not found in static type ";
+ profil_slot.type_self.append_name_in string_tmp;
+ string_tmp.add_last '.';
+ semantic_error (position,string_tmp);
+ };
+ typ_multi ?= slot.result_type;
+ (typ_multi != NULL).if {
+ result := n + typ_multi.count;
+ (result > val.count).if {
+ semantic_error (position,"Incorrect size vector.");
+ };
+ //BSBS: Recycle les EXPR_MULTIPLE
+ lst_expr := FAST_ARRAY(EXPR).create_with_capacity (typ_multi.count);
+ 0.to (typ_multi.upper) do { i:INTEGER;
+ lst_expr.add_last (val.item (n+i));
+ };
+ lst.add_last (affect_slot idf with (EXPR_MULTIPLE.create lst_expr));
+ } else {
+ lst.add_last (affect_slot idf with (val.item n));
+ result := n + 1;
+ };
+ };
+ result
+ );
\ No newline at end of file
diff --git a/src/item/old/itm_type_self.li b/src2/item/old/itm_type_self.li
similarity index 100%
copy from src/item/old/itm_type_self.li
copy to src2/item/old/itm_type_self.li
diff --git a/src/lip/lip_affect.li b/src2/lip/lip_affect.li
similarity index 100%
copy from src/lip/lip_affect.li
copy to src2/lip/lip_affect.li
diff --git a/src/lip/lip_binary.li b/src2/lip/lip_binary.li
similarity index 100%
copy from src/lip/lip_binary.li
copy to src2/lip/lip_binary.li
diff --git a/src2/lip/lip_boolean.li b/src2/lip/lip_boolean.li
new file mode 100644
index 0000000..9787d3f
--- /dev/null
+++ b/src2/lip/lip_boolean.li
@@ -0,0 +1,108 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_BOOLEAN;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ + parent_lip_constant:Expanded LIP_CONSTANT;
+
+Section Private
+
+ - true:LIP_BOOLEAN :=
+ ( + result:LIP_BOOLEAN;
+ result := clone;
+ result.set_value TRUE;
+ result
+ );
+
+ - false:LIP_BOOLEAN := LIP_BOOLEAN;
+
+ - set_value i:BOOLEAN <-
+ (
+ value := i;
+ );
+
+Section Public
+
+ + value:BOOLEAN;
+
+ //
+ // Creation.
+ //
+
+ - get b:BOOLEAN :LIP_BOOLEAN <-
+ ( + result:LIP_BOOLEAN;
+ b.if {
+ result := true;
+ } else {
+ result := false;
+ };
+ result
+ );
+
+ - free; // Nothing.
+
+ //
+ // Operation.
+ //
+
+ - name:STRING_CONSTANT <- "BOOLEAN";
+
+ - Self:SELF '!' :LIP_CONSTANT <- get (! value);
+
+ - copy:LIP_CONSTANT <- Self;
+
+ - print <-
+ (
+ value.print;
+ );
+
+Section LIP_CONSTANT
+
+ - my_copy other:SELF :LIP_CONSTANT <- other;
+
+ - Self:SELF '|#' other:SELF :LIP_CONSTANT <-
+ (
+ get (value | other.value)
+ );
+
+ - Self:SELF '&#' other:SELF :LIP_CONSTANT <-
+ (
+ get (value & other.value)
+ );
+
+ - Self:SELF '=#' other:SELF :LIP_CONSTANT <-
+ (
+ get (value = other.value)
+ );
+
+ - Self:SELF '!=#' other:SELF :LIP_CONSTANT <-
+ (
+ get (value != other.value)
+ );
+
\ No newline at end of file
diff --git a/src/lip/lip_call.li b/src2/lip/lip_call.li
similarity index 100%
copy from src/lip/lip_call.li
copy to src2/lip/lip_call.li
diff --git a/src2/lip/lip_code.li b/src2/lip/lip_code.li
new file mode 100644
index 0000000..ce2578f
--- /dev/null
+++ b/src2/lip/lip_code.li
@@ -0,0 +1,187 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_CODE;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ + parent_itm_object:Expanded ITM_OBJECT;
+
+Section Public
+
+ - list_parent:FAST_ARRAY(STRING_CONSTANT) := FAST_ARRAY(STRING_CONSTANT).create_with_capacity 1;
+
+ - list_method:FAST_ARRAY(LIP_SLOT_CODE) := FAST_ARRAY(LIP_SLOT_CODE).create_with_capacity 32;
+
+ - list_data:HASHED_DICTIONARY(LIP_SLOT_DATA,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(LIP_SLOT_DATA,STRING_CONSTANT).create;
+
+ - stack:FAST_ARRAY(LIP_SLOT_DATA) := FAST_ARRAY(LIP_SLOT_DATA).create_with_capacity 8;
+
+ - get_data n:STRING_CONSTANT :LIP_SLOT_DATA <-
+ (
+ list_data.fast_reference_at n
+ );
+
+ - get_method n:STRING_CONSTANT :LIP_SLOT_CODE <-
+ ( + j:INTEGER;
+ + result:LIP_SLOT_CODE;
+
+ j := list_method.lower;
+ {(j <= list_method.upper) && {list_method.item j.name != n}}.while_do {
+ j := j + 1;
+ };
+ (j <= list_method.upper).if {
+ result := list_method.item j;
+ };
+ result
+ );
+
+ - print_usage <-
+ ( + slot:LIP_SLOT_CODE;
+ + is_ok:BOOLEAN;
+
+ (list_method.lower).to (list_method.upper) do { j:INTEGER;
+ slot := list_method.item j;
+ (slot.section = ALIAS_STR.section_public).if {
+ is_ok := TRUE;
+ slot.print;
+ };
+ };
+ (is_ok).if_false {
+ "\t Sorry, no option (see `make.lip').\n".print;
+ };
+ );
+
+ - get_integer n:STRING_CONSTANT :INTEGER <-
+ ( + d:LIP_SLOT_DATA;
+ + int:LIP_INTEGER;
+ + result:INTEGER;
+
+ d := get_data n;
+ (d = NULL).if {
+ "Warning: Slot `".print;
+ n.print;
+ "' not found.\n".print;
+ } else {
+ int ?= d.value;
+ (int = NULL).if {
+ semantic_error (d.position,"INTEGER type is needed.");
+ };
+ result := int.value;
+ };
+ result
+ );
+
+ - get_boolean n:STRING_CONSTANT :BOOLEAN <-
+ ( + d:LIP_SLOT_DATA;
+ + bool:LIP_BOOLEAN;
+ + result:BOOLEAN;
+
+ d := get_data n;
+ (d = NULL).if {
+ "Warning: Slot `".print;
+ n.print;
+ "' not found.\n".print;
+ } else {
+ bool ?= d.value;
+ (bool = NULL).if {
+ semantic_error (d.position,"BOOLEAN type is needed.");
+ };
+ result := bool.value;
+ };
+ result
+ );
+
+ - get_string n:STRING_CONSTANT :STRING_CONSTANT <-
+ ( + d:LIP_SLOT_DATA;
+ + str:LIP_STRING;
+ + result:STRING_CONSTANT;
+
+ d := get_data n;
+ (d = NULL).if {
+ "Warning: Slot `".print;
+ n.print;
+ "' not found.\n".print;
+ } else {
+ str ?= d.value;
+ (str = NULL).if {
+ semantic_error (d.position,"STRING type is needed.");
+ };
+ result := str.value;
+ };
+ result
+ );
+
+ - put_string v:STRING_CONSTANT to n:STRING_CONSTANT <-
+ ( + d:LIP_SLOT_DATA;
+ + str:LIP_STRING;
+
+ d := get_data n;
+ (d = NULL).if {
+ "Warning: Slot `".print;
+ n.print;
+ "' not found.\n".print;
+ } else {
+ str ?= d.value;
+ (str = NULL).if {
+ semantic_error (d.position,"STRING type is needed.");
+ };
+ str.set_value v;
+ };
+ );
+
+ - put_boolean v:BOOLEAN to n:STRING_CONSTANT <-
+ ( + d:LIP_SLOT_DATA;
+
+ d := get_data n;
+ (d = NULL).if {
+ "Warning: Slot `".print;
+ n.print;
+ "' not found.\n".print;
+ } else {
+ (d.set_value (LIP_BOOLEAN.get v)).if_false {
+ semantic_error (d.position,"BOOLEAN type is needed.");
+ };
+ };
+ );
+
+ //
+ // Run.
+ //
+
+ - run <-
+ (
+ warning_error (position,"Unreachable code.");
+ );
+
+ - run_expr:LIP_CONSTANT <-
+ (
+ semantic_error (position,"No expression result.");
+ NULL
+ );
+
diff --git a/src2/lip/lip_constant.li b/src2/lip/lip_constant.li
new file mode 100644
index 0000000..5577718
--- /dev/null
+++ b/src2/lip/lip_constant.li
@@ -0,0 +1,184 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_CONSTANT;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ - name:STRING_CONSTANT <- ( deferred; NULL);
+
+ - copy:LIP_CONSTANT <-
+ (
+ deferred;
+ );
+
+ - copy_of other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := my_copy s;
+ };
+ result
+ );
+
+ - free <- deferred;
+
+ - '-' Self:SELF :LIP_CONSTANT <- NULL;
+
+ - '!' Self:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '|' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self |# s;
+ };
+ result
+ );
+
+ - Self:SELF '&' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self &# s;
+ };
+ result
+ );
+
+ - Self:SELF '+' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self +# s;
+ };
+ result
+ );
+
+ - Self:SELF '-' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self -# s;
+ };
+ result
+ );
+
+ - Self:SELF '>' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self ># s;
+ };
+ result
+ );
+
+ - Self:SELF '<' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self <# s;
+ };
+ result
+ );
+
+ - Self:SELF '==' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self =# s;
+ };
+ result
+ );
+
+ - Self:SELF '>=' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self >=# s;
+ };
+ result
+ );
+
+ - Self:SELF '<=' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self <=# s;
+ };
+ result
+ );
+
+ - Self:SELF '!==' other:LIP_CONSTANT :LIP_CONSTANT <-
+ ( + result:LIP_CONSTANT;
+ + s:SELF;
+ s ?= other;
+ (s != NULL).if {
+ result := Self !=# s;
+ };
+ result
+ );
+
+ - print <- deferred;
+
+Section LIP_CONSTANT
+
+ - my_copy other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '|#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '&#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '+#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '-#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '>#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '<#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '=#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '>=#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '<=#' other:SELF :LIP_CONSTANT <- NULL;
+
+ - Self:SELF '!=#' other:SELF :LIP_CONSTANT <- NULL;
+
diff --git a/src2/lip/lip_if.li b/src2/lip/lip_if.li
new file mode 100644
index 0000000..533ba48
--- /dev/null
+++ b/src2/lip/lip_if.li
@@ -0,0 +1,84 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_IF;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ + parent_lip_code:Expanded LIP_CODE;
+
+Section Public
+
+ + condition:LIP_CODE;
+
+ + then:FAST_ARRAY(LIP_CODE);
+
+ + else:FAST_ARRAY(LIP_CODE);
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION if rec:LIP_CODE then the:FAST_ARRAY(LIP_CODE)
+ else els:FAST_ARRAY(LIP_CODE) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make p if rec then the else els;
+ result
+ );
+
+ - make p:POSITION if rec:LIP_CODE then the:FAST_ARRAY(LIP_CODE)
+ else els:FAST_ARRAY(LIP_CODE) <-
+ (
+ position := p;
+ condition := rec;
+ then := the;
+ else := els;
+ );
+
+ //
+ // Run.
+ //
+
+ - run <-
+ ( + val:LIP_BOOLEAN;
+
+ val ?= condition.run_expr;
+ (val = NULL).if {
+ semantic_error (position,"BOOLEAN needed.");
+ };
+ (val.value).if {
+ (then.lower).to (then.upper) do { i:INTEGER;
+ then.item i.run;
+ };
+ }.elseif {else != NULL} then {
+ (else.lower).to (else.upper) do { i:INTEGER;
+ else.item i.run;
+ };
+ };
+ val.free;
+ );
diff --git a/src2/lip/lip_integer.li b/src2/lip/lip_integer.li
new file mode 100644
index 0000000..8ca1c00
--- /dev/null
+++ b/src2/lip/lip_integer.li
@@ -0,0 +1,172 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_INTEGER;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ + parent_lip_constant:Expanded LIP_CONSTANT;
+
+Section Private
+
+ - storage:FAST_ARRAY(LIP_INTEGER) := FAST_ARRAY(LIP_INTEGER).create_with_capacity 10;
+
+ - set_value v:INTEGER <-
+ (
+ value := v;
+ );
+
+Section Public
+
+ + value:INTEGER;
+
+ //
+ // Creation.
+ //
+
+ - get i:INTEGER :LIP_INTEGER <-
+ ( + result:LIP_INTEGER;
+ (storage.is_empty).if {
+ result := clone;
+ } else {
+ result := storage.last;
+ storage.remove_last;
+ };
+ result.set_value i;
+ result
+ );
+
+ - free <-
+ (
+ storage.add_last Self;
+ );
+
+ //
+ // Operation.
+ //
+
+ - name:STRING_CONSTANT <- "INTEGER";
+
+ - Self:SELF '-' :LIP_CONSTANT <-
+ (
+ value := - value;
+ Self
+ );
+
+ - Self:SELF '!' :LIP_CONSTANT <-
+ (
+ value := ~ value;
+ Self
+ );
+
+ - copy:LIP_CONSTANT <-
+ (
+ get value
+ );
+
+ - print <-
+ (
+ value.print;
+ );
+
+Section LIP_CONSTANT
+
+ - my_copy other:SELF :LIP_CONSTANT <-
+ (
+ value := other.value;
+ Self
+ );
+
+ - Self:SELF '|#' other:SELF :LIP_CONSTANT <-
+ (
+ value := value | other.value;
+ other.free;
+ Self
+ );
+
+ - Self:SELF '&#' other:SELF :LIP_CONSTANT <-
+ (
+ value := value & other.value;
+ other.free;
+ Self
+ );
+
+ - Self:SELF '+#' other:SELF :LIP_CONSTANT <-
+ (
+ value := value + other.value;
+ other.free;
+ Self
+ );
+
+ - Self:SELF '-#' other:SELF :LIP_CONSTANT <-
+ (
+ value := value - other.value;
+ other.free;
+ Self
+ );
+
+ - Self:SELF '>#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value > other.value)
+ );
+
+ - Self:SELF '<#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value < other.value)
+ );
+
+ - Self:SELF '=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value = other.value)
+ );
+
+ - Self:SELF '>=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value >= other.value)
+ );
+
+ - Self:SELF '<=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value <= other.value)
+ );
+
+ - Self:SELF '!=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value != other.value)
+ );
diff --git a/src/lip/lip_print.li b/src2/lip/lip_print.li
similarity index 100%
copy from src/lip/lip_print.li
copy to src2/lip/lip_print.li
diff --git a/src2/lip/lip_slot_code.li b/src2/lip/lip_slot_code.li
new file mode 100644
index 0000000..709f447
--- /dev/null
+++ b/src2/lip/lip_slot_code.li
@@ -0,0 +1,148 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_SLOT_CODE;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ - parent_lip_code:Expanded LIP_CODE;
+
+Section Public
+
+ + section:STRING_CONSTANT;
+
+ + name:STRING_CONSTANT;
+
+ + argument:LIP_SLOT_DATA;
+
+ + code:FAST_ARRAY(LIP_CODE);
+
+ + comment:STRING_CONSTANT;
+
+ // + comment_chapter:STRING_CONSTANT;
+
+ - set_comment c:STRING_CONSTANT <-
+ (
+ comment := c;
+ );
+
+ /*
+ - set_comment_chapter c:STRING_CONSTANT <-
+ (
+ comment_chapter := c;
+ );
+ */
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION section sec:STRING_CONSTANT
+ name n:STRING_CONSTANT
+ argument arg:LIP_SLOT_DATA
+ code c:FAST_ARRAY(LIP_CODE) :LIP_SLOT_CODE <-
+ ( + result:LIP_SLOT_CODE;
+
+ result := get_method n;
+ (result != NULL).if {
+ ((arg = NULL) ^ (result.argument = NULL)).if {
+ semantic_error (result.position,"Incorrect redefinition.");
+ };
+ ALIAS_ARRAY(LIP_CODE).free c;
+ } else {
+ result := clone;
+ result.make p section sec name n argument arg code c;
+ };
+ result
+ );
+
+ - make p:POSITION section sec:STRING_CONSTANT
+ name n:STRING_CONSTANT
+ argument arg:LIP_SLOT_DATA
+ code c:FAST_ARRAY(LIP_CODE) <-
+ (
+ position := p;
+ section := sec;
+ name := n;
+ argument := arg;
+ code := c;
+ list_method.add_last Self;
+ );
+
+ //
+ // Operation.
+ //
+
+ - run_with val:LIP_CONSTANT :BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ result := ! ((val = NULL) ^ (argument = NULL));
+ (result).if {
+ (argument != NULL).if {
+ ? { val != NULL };
+ result := argument.set_value val;
+ stack.add_last argument;
+ } else {
+ stack.add_last NULL;
+ };
+ (result).if {
+ (code.lower).to (code.upper) do { j:INTEGER;
+ code.item j.run;
+ };
+ };
+ stack.remove_last;
+ };
+ result
+ );
+
+ //
+ // Print.
+ //
+
+ - print <-
+ (
+ " -".print;
+ name.print;
+ (argument != NULL).if {
+ " <".print;
+ argument.print;
+ ">".print;
+ };
+ " :\n".print;
+ (comment != NULL).if {
+ '\t'.print;
+ (comment.lower).to (comment.upper) do { i:INTEGER;
+ comment.item i.print;
+ ((comment.item i = '\n') && {i < comment.upper}).if {
+ '\t'.print;
+ };
+ };
+ } else {
+ "\t Sorry, no comment (see `make.lip').\n".print;
+ };
+ );
+
diff --git a/src/lip/lip_slot_data.li b/src2/lip/lip_slot_data.li
similarity index 100%
copy from src/lip/lip_slot_data.li
copy to src2/lip/lip_slot_data.li
diff --git a/src2/lip/lip_string.li b/src2/lip/lip_string.li
new file mode 100644
index 0000000..fde456c
--- /dev/null
+++ b/src2/lip/lip_string.li
@@ -0,0 +1,149 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LIP_STRING;
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Inherit
+
+ + parent_lip_constant:Expanded LIP_CONSTANT;
+
+Section Private
+
+ - storage:FAST_ARRAY(LIP_STRING) := FAST_ARRAY(LIP_STRING).create_with_capacity 10;
+
+Section Public
+
+ + value:STRING_CONSTANT;
+
+ - set_value v:STRING_CONSTANT <-
+ (
+ value := v;
+ );
+
+ //
+ // Creation.
+ //
+
+ - get str:STRING_CONSTANT :LIP_STRING <-
+ ( + result:LIP_STRING;
+ (storage.is_empty).if {
+ result := clone;
+ } else {
+ result := storage.last;
+ storage.remove_last;
+ };
+ result.set_value str;
+ result
+ );
+
+ - free <-
+ (
+ storage.add_last Self;
+ );
+
+ //
+ // Operation.
+ //
+
+ - name:STRING_CONSTANT <- "STRING";
+
+ - copy:LIP_CONSTANT <-
+ (
+ get value
+ );
+
+ - print <-
+ (
+ string_tmp.clear;
+ append_in string_tmp;
+ string_tmp.print;
+ );
+
+ - append_in str:STRING <-
+ ( + i:INTEGER;
+ + car:CHARACTER;
+
+ i := value.lower;
+ {i <= value.upper}.while_do {
+ car := value.item i;
+ (car = '\\').if {
+ i := i + 1;
+ (i <= value.upper).if {
+ car := value.item i;
+ (car)
+ .when 'a' then { str.add_last '\a'; }
+ .when 'b' then { str.add_last '\b'; }
+ .when 'f' then { str.add_last '\f'; }
+ .when 'n' then { str.add_last '\n'; }
+ .when 'r' then { str.add_last '\r'; }
+ .when 't' then { str.add_last '\t'; }
+ .when 'v' then { str.add_last '\v'; }
+ .when '\\' then { str.add_last '\\'; }
+ .when '?' then { str.add_last '\?'; }
+ .when '\'' then { str.add_last '\''; }
+ .when '\"' then { str.add_last '\"'; };
+ } else {
+ str.add_last car;
+ };
+ } else {
+ str.add_last car;
+ };
+ i := i + 1;
+ };
+ );
+
+Section LIP_CONSTANT
+
+ - my_copy other:SELF :LIP_CONSTANT <-
+ (
+ value := other.value;
+ Self
+ );
+
+ - Self:SELF '=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value = other.value)
+ );
+
+ - Self:SELF '!=#' other:SELF :LIP_CONSTANT <-
+ (
+ other.free;
+ free;
+ LIP_BOOLEAN.get (value != other.value)
+ );
+
+ - Self:SELF '+#' other:SELF :LIP_CONSTANT <-
+ (
+ string_tmp.copy value;
+ string_tmp.append (other.value);
+ value := ALIAS_STR.get string_tmp;
+ other.free;
+ Self
+ );
+
\ No newline at end of file
diff --git a/src/lip/lip_unary.li b/src2/lip/lip_unary.li
similarity index 100%
copy from src/lip/lip_unary.li
copy to src2/lip/lip_unary.li
diff --git a/src/lip/lip_value.li b/src2/lip/lip_value.li
similarity index 100%
copy from src/lip/lip_value.li
copy to src2/lip/lip_value.li
diff --git a/src2/lisaac.li b/src2/lisaac.li
new file mode 100644
index 0000000..e99e3aa
--- /dev/null
+++ b/src2/lisaac.li
@@ -0,0 +1,809 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LISAAC;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+ - external := `#include "path.h"`;
+
+ // Top 5 memory record :
+ // 1 - LOCAL (>20MB) (il fo Aliaser les tmp !)
+ // 2 - READ_LOCAL (15MB)
+ // 3 - LIST (13MB) (En baisse => a retester)
+ // 4 - PROTOTYPE_CST (10MB)
+ // 5 - WRITE_LOCAL (10MB)
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - output_name:STRING_CONSTANT;
+
+ - input_name:STRING_CONSTANT;
+
+ - path_lisaac:STRING_CONSTANT <-
+ ( + path:NATIVE_ARRAY(CHARACTER);
+ + path_str :STRING;
+ + j:INTEGER;
+ //COMMAND_LINE.executable_name.print; '\n'.print;
+ // Load LISAAC_DIRECTORY.
+ path_str := ENVIRONMENT.get_environment_variable "LISAAC_DIRECTORY";
+ (path_str != NULL).if {
+ string_tmp.copy path_str;
+ } else {
+ path := `LISAAC_DIRECTORY`:NATIVE_ARRAY(CHARACTER);
+ string_tmp.clear;
+ j := 0;
+ {path.item j != '\0'}.while_do {
+ string_tmp.add_last (path.item j);
+ j := j + 1;
+ };
+ };
+ ((string_tmp.last != '/') && {string_tmp.last != '\\'}).if {
+ string_tmp.add_last '/';
+ };
+ path_lisaac := ALIAS_STR.get string_tmp
+ );
+
+ //
+ // Command.
+ //
+
+ - begin_usage: STRING_CONSTANT :=
+ "----------------------------------------------------------------\n\
+ \-- Lisaac IS An Advanced Compiler V.0.14 --\n\
+ \-- LORIA - LSIIT - ULP - CNRS - FRANCE --\n\
+ \-- Benoit SONNTAG - sonntag at icps.u-strasbg.fr --\n\
+ \-- http://www.IsaacOS.com --\n\
+ \----------------------------------------------------------------\n\
+ \Usage: \n\
+ \ lisaac [<lip_file.lip>] [<input_file[.li]>] {<Options>} \n\
+ \ \n\
+ \ Note: without <lip_file> or <input_file>, \n\
+ \ the nearest `make.lip' file is interpreted. \n\
+ \ \n\
+ \Options: \n";
+
+ - end_usage:STRING_CONSTANT :=
+ " \n\
+ \Bug report: \n\
+ \\t post in : https://gna.org/bugs/?group=isaac \n\
+ \\t mail to : sonntag at icps.u-strasbg.fr \n";
+
+ - display_usage <-
+ (
+ begin_usage.print;
+ LIP_CODE.print_usage;
+ end_usage.print;
+ die_with_code exit_failure_code;
+ );
+
+ //
+ // Options.
+ //
+
+ - read_options <-
+ ( + cmd:STRING;
+ + j,i:INTEGER;
+ + f:POINTER;
+ + lip_ok:BOOLEAN;
+ + s:LIP_SLOT_CODE;
+ + t:STRING_CONSTANT;
+ + arg:LIP_CONSTANT;
+ + is_path_list:BOOLEAN;
+
+ // Default value.
+ is_ansi := TRUE;
+ // Read argument.
+ j := 1;
+ {j > COMMAND_LINE.upper}.until_do {
+ cmd := COMMAND_LINE.item j;
+ (cmd.item 1='-').if {
+ //
+ // Lecture des options :
+ //
+ ((cmd.count >= 3) && {cmd.item 2 = '-'}).if {
+ (cmd.item 3)
+ .when 'v' then {
+ verbose_level := 1;
+ }
+ .when 'p' then {
+ is_path_list := TRUE;
+ };
+ } else {
+ (lip_ok).if_false {
+ load_lip "make.lip";
+ lip_ok := TRUE;
+ };
+ string_tmp.copy cmd;
+ string_tmp.remove_first 1;
+ s := LIP_CODE.get_method (ALIAS_STR.get string_tmp);
+ ((s = NULL) || {s.section != ALIAS_STR.section_public}).if {
+ "ERROR : Option `".print;
+ cmd.print;
+ "' not found.\n".print;
+ display_usage;
+ };
+ (s.argument != NULL).if {
+ j := j + 1;
+ (j > COMMAND_LINE.upper).if {
+ "ERROR : For option `".print;
+ cmd.print;
+ "', argument needed.\n".print;
+ display_usage;
+ };
+ cmd := COMMAND_LINE.item j;
+ t := s.argument.value.name;
+ arg := NULL;
+ (t = ALIAS_STR.prototype_boolean).if {
+ cmd.to_upper;
+ (cmd == "TRUE").if {
+ arg := LIP_BOOLEAN.get TRUE;
+ }.elseif {cmd == "FALSE"} then {
+ arg := LIP_BOOLEAN.get FALSE;
+ };
+ }.elseif {t = ALIAS_STR.prototype_integer} then {
+ (cmd.is_integer).if {
+ arg := LIP_INTEGER.get (cmd.to_integer);
+ };
+ } else {
+ arg := LIP_STRING.get (ALIAS_STR.get cmd);
+ };
+ (arg = NULL).if {
+ "ERROR : Incorrect type for `".print;
+ cmd.print;
+ "' argument.\n".print;
+ display_usage;
+ };
+ };
+ (s.run_with arg).if_false {
+ "ERROR : Invalid argument.\n".print;
+ display_usage;
+ };
+ };
+ } else {
+ //
+ // Input name & Current Directory.
+ //
+ (cmd.has_suffix ".lip").if {
+ // .lip
+ (lip_ok).if {
+ "ERROR : Put options after `".print;
+ cmd.print;
+ "'.".print;
+ display_usage;
+ };
+ load_lip cmd;
+ lip_ok := TRUE;
+ } else {
+ // .li
+ (lip_ok).if_false {
+ load_lip "make.lip";
+ lip_ok := TRUE;
+ };
+ (input_name != NULL).if {
+ display_usage;
+ };
+ string_tmp.copy (COMMAND_LINE.item j);
+ string_tmp2.copy string_tmp;
+ string_tmp.replace_all '\\' with '/';
+ i := last_index (string_tmp,'/');
+ (i < string_tmp.lower).if {
+ string_tmp.copy "./";
+ } else {
+ string_tmp.remove_last (string_tmp.upper-i);
+ string_tmp2.remove_first i;
+ };
+ i := last_index (string_tmp2,'.');
+ (i > string_tmp2.lower).if {
+ string_tmp2.remove_last (string_tmp2.upper-i+1);
+ };
+ LIP_CALL.load_directory (ALIAS_STR.get string_tmp) is_recursive FALSE;
+ input_name := ALIAS_STR.get string_tmp2;
+ LIP_CODE.put_string input_name to (ALIAS_STR.slot_input_file);
+ };
+ };
+ j := j+1;
+ };
+ (lip_ok).if_false {
+ load_lip "make.lip";
+ };
+
+ // Executing `front_end':
+ s := LIP_CODE.get_method (ALIAS_STR.slot_front_end);
+ (s = NULL).if {
+ "Slot `front_end' not found in *.lip file.\n".print;
+ die_with_code exit_failure_code;
+ };
+ s.run_with NULL;
+
+ (is_path_list).if {
+ string_tmp.clear;
+ (path_file.lower).to (path_file.upper) do { n:INTEGER;
+ string_tmp.append (path_file.item n);
+ string_tmp.add_last '\n';
+ };
+ (! FS_MIN.make_file "current_path.txt").if {
+ STD_ERROR.put_string "Error: File `current_path.txt' is not created !\n";
+ die_with_code exit_failure_code;
+ };
+ f := FS_MIN.open_write "current_path.txt";
+ FS_MIN.write f with string_tmp size (string_tmp.count);
+ FS_MIN.close f;
+ die_with_code 0;
+ };
+
+ // Loading variable.
+ input_name := LIP_CODE.get_string (ALIAS_STR.slot_input_file);
+ debug_level_option := LIP_CODE.get_integer (ALIAS_STR.slot_debug_level);
+ debug_with_code := LIP_CODE.get_boolean (ALIAS_STR.slot_debug_with_code);
+ is_all_warning := LIP_CODE.get_boolean (ALIAS_STR.slot_is_all_warning);
+ is_optimization := LIP_CODE.get_boolean (ALIAS_STR.slot_is_optimization);
+ inline_level := LIP_CODE.get_integer (ALIAS_STR.slot_inline_level);
+ is_java := LIP_CODE.get_boolean (ALIAS_STR.slot_is_java);
+ is_statistic := LIP_CODE.get_boolean (ALIAS_STR.slot_is_statistic);
+ is_quiet := LIP_CODE.get_boolean (ALIAS_STR.slot_is_quiet);
+ //
+ ((input_name = NULL) || {input_name.is_empty}).if {
+ "ERROR : `input_file' is empty.\n".print;
+ display_usage;
+ };
+ string_tmp.copy input_name;
+ (is_java).if {
+ string_tmp.append ".java";
+ } else {
+ string_tmp.append ".c";
+ };
+ output_name := ALIAS_STR.get string_tmp;
+ );
+
+ - last_index (n:STRING,c:CHARACTER) :INTEGER <-
+ // BSBS: A Mettre dans STRING.
+ ( + result:INTEGER;
+ result := n.upper;
+ {(result < n.lower) || {n.item result = c}}.until_do {
+ result := result-1;
+ };
+ result
+ );
+
+ - load_lip file_lip:ABSTRACT_STRING <-
+ ( + path_lip:STRING_CONSTANT;
+ + is_good:BOOLEAN;
+ + count:INTEGER;
+
+ string_tmp.clear;
+ {
+ string_tmp.append file_lip;
+ path_lip := ALIAS_STR.get string_tmp;
+ (is_good := PARSER.read_lip path_lip).if_false {
+ string_tmp.copy path_lip;
+ string_tmp.remove_last (file_lip.count);
+ string_tmp.append "../";
+ count := count + 1;
+ };
+ }.do_while {(count < 5) && {! is_good}};
+ (is_good).if_false {
+ string_tmp.copy path_lisaac;
+ string_tmp.append "make.lip";
+ path_lip := ALIAS_STR.get string_tmp;
+ (is_good := PARSER.read_lip path_lip).if_false {
+ "File `".print;
+ path_lip.print;
+ "' not found !\nIncorrect installation.\n".print;
+ die_with_code exit_failure_code;
+ };
+ };
+ {LIP_CODE.list_parent.is_empty}.until_do {
+ path_lip := LIP_CODE.list_parent.first;
+ LIP_CODE.list_parent.remove_first;
+ (path_lip.is_empty).if {
+ string_tmp.copy path_lisaac;
+ string_tmp.append "make.lip";
+ path_lip := ALIAS_STR.get string_tmp;
+ };
+ (PARSER.read_lip path_lip).if_false {
+ "File `".print;
+ path_lip.print;
+ "' not found ! (see `*.lip')\n".print;
+ die_with_code exit_failure_code;
+ };
+ };
+ // Auto-load 'lisaac' variable.
+ LIP_CODE.put_string path_lisaac to (ALIAS_STR.variable_lisaac);
+ );
+
+ - put_trace_code buf:STRING <-
+ ( + proto:PROTOTYPE;
+
+ ((debug_level_option != 0) || {CALL_NULL.is_necessary}).if {
+ title "DEBUG MANAGER" in buf;
+
+ (is_java).if {
+ buf.append
+ "private static void print_string(String str) \n\
+ \{ \n\
+ \ System.out.print(str);\n\
+ \}\n\
+ \\n";
+ } else {
+ buf.append
+ "void print_string(char *str) \n\
+ \{ \n\
+ \ while (*str!=0) {\n\
+ \ print_char(*str); \n\
+ \ str++; \n\
+ \ };\n\
+ \}\n\
+ \\n";
+ };
+ };
+
+ (debug_level_option != 0).if {
+ buf.append "char *trace[";
+ buf.append (PROTOTYPE.prototype_list.count.to_string);
+ buf.append "]={\n";
+ (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper-1) do {
+ j:INTEGER;
+ proto := PROTOTYPE.prototype_list.item j;
+ buf.append " \"";
+ buf.append (proto.name);
+ buf.append " (";
+ buf.append (proto.filename);
+ buf.append ")\",\n";
+ };
+ proto := PROTOTYPE.prototype_list.last;
+ buf.append " \"";
+ buf.append (proto.name);
+ buf.append " (";
+ buf.append (proto.filename);
+ buf.append ")\"\n};\n\n";
+
+ //
+ // Source Code.
+ //
+
+ (debug_with_code).if {
+ + src:HASHED_DICTIONARY(STRING,UINTEGER_32);
+ + key:UINTEGER_32;
+
+ output_decl.append
+ "\n//==========================//\n\
+ \// SOURCE LINE REFERENCE //\n\
+ \//==========================//\n";
+
+ buf.append
+ "struct __source {\n\
+ \ unsigned int pos;\n\
+ \ char *line;\n\
+ \} __src[";
+ src := PUSH.source_line;
+ src.count.append_in buf;
+ buf.append "]={\n";
+ (src.lower).to (src.upper) do { j:INTEGER;
+ key := src.key j;
+ output_decl.append "#define L";
+ key.append_in output_decl;
+ output_decl.add_last ' ';
+ (j-1).append_in output_decl;
+ output_decl.add_last '\n';
+ //
+ buf.append " {";
+ key.append_in buf;
+ buf.append ",\"";
+ buf.append (src.item j);
+ buf.append "\"},\n";
+ };
+ buf.remove (buf.upper - 1);
+ buf.append "};\n\n";
+ };
+
+ //
+ // Signal manager.
+ //
+
+ (is_ansi).if {
+ buf.append
+ "// Unix Signal manager:\n\
+ \void interrupt_signal(int sig) \n\
+ \{ \n\
+ \ stack_print(top_context); \n\
+ \ print_string(\"User interrupt.\\n\"); \n\
+ \ die_with_code(1); \n\
+ \} \n\n";
+ };
+
+ //
+ // Stack manager.
+ //
+
+ buf.append
+ "void push_first(_____CONTEXT *path,unsigned long code)\n\
+ \{ \n";
+ (debug_level_option = 20).if {
+ buf.append
+ " _____CONTEXT *cur,loop;\n\
+ \ cur = top_context; \n\
+ \ while ((cur != (void *)0) && (cur != path)) cur = cur->back; \n\
+ \ if (cur == path) {\n\
+ \ loop.back = top_context;\n\
+ \ loop.code = code; \n\
+ \ stack_print(&loop);\n\
+ \ print_string(\"COMPILER : Debug context looping detected !\\n\");\n\
+ \ die_with_code(1);\n\
+ \ };\n";
+ };
+ buf.append
+ " path->back = top_context;\n\
+ \ path->code = code;\n\
+ \ top_context = path;\n\
+ \} \n\
+ \ \n\
+ \void push(_____CONTEXT *path,unsigned long code)\n\
+ \{ \n\
+ \ path->code = code;\n\
+ \ top_context = path;\n\
+ \} \n\
+ \ \n\
+ \void stack_print(_____CONTEXT *up) \n\
+ \{ _____CONTEXT *back,*next; \n\
+ \ int j; \n\
+ \ next = (void *)0; \n\
+ \ while (up != (void *)0) { \n\
+ \ back = up -> back; \n\
+ \ up -> back = next; \n\
+ \ next = up; \n\
+ \ up = back; \n\
+ \ }; \n\
+ \ print_string(\"\\n============== BOTTOM ==============\\n\"); \n\
+ \ while (next != (void *)0) { \n";
+ (debug_with_code).if {
+ buf.append
+ " print_string(\"Line #\"); \n\
+ \ print_integer(__src[next->code].pos >> 17); \n\
+ \ print_string(\" Column #\"); \n\
+ \ print_integer((__src[next->code].pos >> 9) & 0xFF); \n\
+ \ print_string(\" in \"); \n\
+ \ print_string(trace[__src[next->code].pos & 0x1FF]); \n\
+ \ print_string(\".\\n\"); \n\
+\ if ((__src[next->code].pos & 0x1FF) != 0) { \n\
+ \ print_string(__src[next->code].line); \n\
+ \ print_char('\\n'); \n\
+ \ for (j=0;j < ((__src[next->code].pos >> 9) & 0xFF);j++) {\n\
+ \ if (__src[next->code].line[j]=='\\t') print_char('\\t');\n\
+ \ else print_char(' ');\n\
+ \ }; \n\
+ \ print_char('^'); \n\
+ \ print_char('\\n'); \n\
+\ }; \n";
+
+ } else {
+ buf.append
+ " print_string(\"Line #\"); \n\
+ \ print_integer(next->code >> 17); \n\
+ \ print_string(\" Column #\"); \n\
+ \ print_integer((next->code >> 9) & 0xFF); \n\
+ \ print_string(\" in \"); \n\
+ \ print_string(trace[next->code & 0x1FF]); \n\
+ \ print_string(\".\\n\"); \n";
+ };
+ buf.append
+ " next = next -> back; \n\
+ \ }; \n\
+ \ print_string(\"================ TOP ===============\\n\"); \n\
+ \ top_context = (void *)0; \n\
+ \} \n\
+ \ \n\
+ \void print_integer(unsigned short n) \n\
+ \{ unsigned short val; \n\
+ \ char car; \n\
+ \ car = (n % 10) + '0'; \n\
+ \ val = n / 10; \n\
+ \ if (val != 0) print_integer(val); \n\
+ \ print_char(car); \n\
+ \} \n\n";
+ };
+ );
+
+ - load_main_object <-
+ ( + type_gen:FAST_ARRAY(ITM_TYPE_MONO);
+ + itm_type_character:ITM_TYPE_MONO;
+ + itm_type_n_a_character:ITM_TYPE_MONO;
+
+ // NULL, VOID, CONTEXT
+ TYPE_NULL.make_null;
+ TYPE_VOID.make_void;
+ TYPE_CONTEXT.make_context;
+ TYPE_ID.make_type_id; // Pas utile !
+ // Input.
+ string_tmp.copy input_name;
+ string_tmp.to_upper;
+ type_input := ITM_TYPE_SIMPLE.get (ALIAS_STR.get string_tmp).to_run_for NULL.raw;
+ // Other prototype.
+ type_true := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_true)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_false := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_false)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_boolean := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_boolean)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_integer := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_real := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_real)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_integer_32 := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer_32)
+ style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
+ type_string_constant := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_string_constant)
+ .to_run_for NULL.raw;
+ itm_type_character := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_character)
+ style (ALIAS_STR.keyword_expanded);
+ type_character := itm_type_character.to_run_for NULL.raw;
+ type_block := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_block).to_run_for NULL.raw;
+ //
+ type_pointer := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_pointer).to_run_for NULL.raw;
+ // NATIVE_ARRAY(CHARACTER)
+ type_gen := ALIAS_ARRAY(ITM_TYPE_MONO).new;
+ type_gen.add_last itm_type_character;
+ type_gen := ALIAS_ARRAY(ITM_TYPE_MONO).alias type_gen;
+ itm_type_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
+ style NULL with type_gen;
+ type_n_a_character := itm_type_n_a_character.to_run_for NULL.raw;
+ // NATIVE_ARRAY[NATIVE_ARRAY(CHARACTER)]
+ type_gen := ALIAS_ARRAY(ITM_TYPE_MONO).new;
+ type_gen.add_last itm_type_n_a_character;
+ type_gen := ALIAS_ARRAY(ITM_TYPE_MONO).alias type_gen;
+ type_n_a_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
+ style NULL with type_gen.to_run_for NULL.raw;
+ //
+ ? {type_input != NULL};
+ );
+
+ - print msg:STRING_CONSTANT stat n:INTEGER for t:INTEGER <-
+ ( + pour_mil:INTEGER;
+
+ (t != 0).if {
+ STD_ERROR.put_string msg;
+ pour_mil := `(int)((1000./ @t * @n))`:INTEGER;
+ STD_ERROR.put_integer (pour_mil/10);
+ STD_ERROR.put_character '.';
+ STD_ERROR.put_integer (pour_mil%10);
+ STD_ERROR.put_string "% (";
+ STD_ERROR.put_integer n;
+ STD_ERROR.put_character '/';
+ STD_ERROR.put_integer t;
+ STD_ERROR.put_string ")\n";
+ };
+ );
+
+Section Public
+
+ //
+ // Creation.
+ //
+
+ - main <-
+ ( + file_output:POINTER;
+ //+ entry:ENTRY;
+ + begin_time,end_time:UINTEGER_64;
+ + time:INTEGER;
+ + txt:STRING;
+ + s:LIP_SLOT_CODE;
+
+ ALIAS_STR.make;
+
+ begin_time := SYSTEM.get_universal_time;
+
+ //
+ // Load Environment.
+ //
+ read_options;
+ is_verbose.if {
+ string_tmp.copy "\ninput file : ";
+ string_tmp.append input_name;
+ string_tmp.append ".li\noutput file : ";
+ string_tmp.append output_name;
+ string_tmp.append "\npath directory :\n";
+ path_file.lower.to (path_file.upper) do { j:INTEGER;
+ string_tmp.append " ";
+ string_tmp.append (path_file.item j);
+ string_tmp.add_last '\n';
+ };
+ string_tmp.print;
+ };
+
+ //
+ // Header C
+ //
+ (is_java).if {
+ output_decl.copy "// Java code generated by Lisaac compiler (www.isaacOS.com) //\n";
+ output_decl.append "class ";
+ output_decl.append input_name;
+ output_decl.append " {\n";
+ output_decl.append "private static String arg[];\n";
+ } else {
+ output_decl.copy "// C code generated by Lisaac compiler (www.isaacOS.com) //\n";
+ // ANSI argument command.
+ (debug_level_option != 0).if {
+ output_decl.append "#include <signal.h>\n";
+ };
+ output_decl.append
+ "int arg_count;\n\
+ \char **arg_vector;\n";
+ };
+
+ // External.
+ title "EXTERNAL" in output_decl;
+
+ //
+ // Load prototype constant.
+ //
+ load_main_object;
+
+ // Compilation.
+ type_input.prototype.depend;
+
+ // Type / Struct.
+ title "TYPE" in output_decl;
+
+ (is_java).if {
+ output_decl.append
+ "// Generic Object\n\
+ \class ___OBJ {\n\
+ \ long __id;\n\
+ \};\n\n";
+ } else {
+ output_decl.append
+ "// Generic Object\n\
+ \struct ___OBJ {\n\
+ \ unsigned long __id;\n\
+ \};\n\n";
+ };
+ title "GLOBAL" in output_glob;
+
+ // Function header.
+ title "FUNCTION HEADER" in output_code;
+
+ // Debug source code.
+ (is_java).if_false {
+ ((debug_level_option != 0) || {CALL_NULL.is_necessary}).if {
+ output_code.append "// Debug Manager\n";
+ output_code.append "void print_string(char *str);\n";
+ };
+ (debug_level_option != 0).if {
+ (is_ansi).if {
+ output_code.append "void interrupt_signal(int sig);\n";
+ };
+ output_code.append
+ "void stack_print(_____CONTEXT *up);\n\
+ \void push_first(_____CONTEXT *path,unsigned long code);\n\
+ \void push(_____CONTEXT *path,unsigned long code);\n\
+ \void print_integer(unsigned short n);\n";
+ };
+ };
+
+ // Extern source code.
+ output_code.append "// Source code\n";
+ PROFIL_LIST.genere_handler output_code;
+
+ // Source code.
+ title "SOURCE CODE" in output_code;
+
+ (is_java).if {
+ output_code.append "public static void main(String parg[])\n";
+ } else {
+ output_code.append "int main(int argc,char **argv)\n";
+ };
+ output_code.append "{\n";
+ indent.append " ";
+
+ list_main.genere_extern output_code;
+
+ (is_java).if_false {
+ output_code.append " return(0);\n";
+ };
+ indent.remove_last 2;
+ output_code.append indent;
+ output_code.append "}\n\n";
+
+ PROFIL_LIST.genere output_code;
+
+ TYPE.genere_all_struct;
+ (is_java).if_false {
+ output_decl.append "\nvoid *table_type[";
+ TYPE.id_counter_without_type.append_in output_decl;
+ output_decl.append "];\n";
+ };
+
+ // String Constant.
+
+ // Trace code.
+ put_trace_code output_code;
+
+ (is_java).if {
+ output_code.append "\n} // End class MAIN\n";
+ };
+
+ //
+ // Saving File Output.
+ //
+ (! FS_MIN.make_file output_name).if {
+ STD_ERROR.put_string "Error: File ";
+ STD_ERROR.put_string output_name;
+ STD_ERROR.put_string " is not created !\n";
+ die_with_code exit_failure_code;
+ };
+
+ file_output := FS_MIN.open_write output_name;
+ FS_MIN.write file_output with output_decl size (output_decl.count);
+ FS_MIN.write file_output with output_glob size (output_glob.count);
+ (STRING_CST.output_count != 0).if {
+ txt := STRING_CST.output;
+ FS_MIN.write file_output with txt size (txt.count);
+ };
+ FS_MIN.write file_output with output_code size (output_code.count);
+ FS_MIN.close file_output;
+ //
+ end_time := SYSTEM.get_universal_time;
+ (is_quiet).if_false {
+ STD_ERROR.put_string " => ";
+ time := (end_time - begin_time).to_integer;
+ (time >= 120).if {
+ STD_ERROR.put_integer (time/60);
+ STD_ERROR.put_string " minutes, ";
+ time := time % 60;
+ };
+ STD_ERROR.put_integer time;
+ STD_ERROR.put_string " second(s).\n";
+ //
+ (POSITION.nb_warning != 0).if {
+ STD_ERROR.put_string " => ";
+ STD_ERROR.put_integer (POSITION.nb_warning);
+ STD_ERROR.put_string " warning(s).\n";
+ };
+ };
+
+ (is_statistic).if {
+ print " Null call score : " stat null_counter for late_binding_counter;
+ print " Polymorphic call : " stat polymorphic_counter for late_binding_counter;
+ (is_optimization).if {
+ " Invariant loop score : ".print; count_invariant.print; '\n'.print;
+ };
+ };
+
+ //
+ // Execute finality command (front end).
+ //
+ // Executing `front_end':
+ LIP_CODE.put_boolean is_cop to (ALIAS_STR.slot_is_cop);
+ s := LIP_CODE.get_method (ALIAS_STR.slot_back_end);
+ (s = NULL).if {
+ "Warning: Slot `back_end' not found in *.lip file.\n".print;
+ } else {
+ s.run_with NULL;
+ };
+ );
+
diff --git a/src2/make.lip b/src2/make.lip
new file mode 100755
index 0000000..27e7eca
--- /dev/null
+++ b/src2/make.lip
@@ -0,0 +1,86 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 Inherit
+
+ + parent:STRING;
+
+Section Private
+
+ - src_path <-
+ (
+ path (lisaac + "src2/");
+ path (lisaac + "src2/tools/");
+ path (lisaac + "src2/type/");
+ path (lisaac + "src2/item/");
+ path (lisaac + "src2/constant/");
+ path (lisaac + "src2/variable/");
+ path (lisaac + "src2/external/");
+ path (lisaac + "src2/external/logic/");
+ path (lisaac + "src2/external/arithmetic/");
+ path (lisaac + "src2/external/comparison/");
+ path (lisaac + "src2/dispatcher/");
+ path (lisaac + "src2/code_life/");
+ path (lisaac + "src2/lip/");
+ );
+
+ - compiler_path <-
+ (
+ src_path;
+ input_file := "lisaac";
+ path (lisaac + "src2/compiler_any/");
+ );
+
+ - shorter_path <-
+ (
+ src_path;
+ input_file := "shorter";
+ path (lisaac + "src2/shorter_any/");
+ );
+
+ //
+ // Execute function.
+ //
+
+ - front_end <-
+ (
+ general_front_end;
+ ((input_file = "") | (input_file = "lisaac")).if {
+ compiler_path;
+ };
+ );
+
+Section Public
+
+ - compiler <-
+ // Compile the Lisaac compiler.
+ (
+ compiler_path;
+ );
+
+ - shorter <-
+ // Compile the shorter.
+ (
+ shorter_path;
+ );
+
+
+
+
\ No newline at end of file
diff --git a/src/my_grep b/src2/my_grep
similarity index 100%
copy from src/my_grep
copy to src2/my_grep
diff --git a/src/parameter_to_type.li b/src2/parameter_to_type.li
similarity index 100%
copy from src/parameter_to_type.li
copy to src2/parameter_to_type.li
diff --git a/src2/parser.li b/src2/parser.li
new file mode 100644
index 0000000..6d1f609
--- /dev/null
+++ b/src2/parser.li
@@ -0,0 +1,3208 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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;
+
+ - 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
+
+ //
+ // Shorter Section.
+ //
+
+ - is_active_short:BOOLEAN;
+
+ - short_dico:HASHED_DICTIONARY(LINKED_LIST(STRING_CONSTANT),STRING_CONSTANT) :=
+ HASHED_DICTIONARY(LINKED_LIST(STRING_CONSTANT),STRING_CONSTANT).create;
+
+ - short_derive:INTEGER;
+
+ - token:STRING := STRING.create 100;
+
+ - short key:STRING_CONSTANT token beg:INTEGER to end:INTEGER <-
+ ( + pos:INTEGER;
+ + add_text:ABSTRACT_STRING;
+ + fmt:LINKED_LIST(STRING_CONSTANT);
+
+ (is_shorter).if {
+ (is_active_short).if {
+ //
+ // SHORTER
+ //
+ (short_dico.fast_has key).if {
+ // Extract token.
+ token.clear;
+ pos := beg + short_derive;
+ beg.to (end-1) do { j:INTEGER;
+ token.add_last (source.item j);
+ output_code.remove pos;
+ };
+ short_derive := short_derive - token.count;
+ // Insert format.
+ fmt := short_dico.at key;
+ fmt.lower.to (fmt.upper) do { j:INTEGER;
+ (fmt.item j = NULL).if {
+ add_text := token;
+ } else {
+ add_text := fmt.item j;
+ };
+ output_code.insert_string add_text to pos;
+ pos := pos + add_text.count;
+ short_derive := short_derive + add_text.count;
+ };
+ };
+ };
+ };
+ );
+
+ - short_remove begin:INTEGER to end:INTEGER <-
+ (
+ output_code.remove_between
+ (begin + short_derive) to (end + short_derive);
+ short_derive := short_derive - (end - begin + 1);
+ );
+
+ - short_local:HASHED_SET(STRING_CONSTANT);
+
+Section Private
+
+ //
+ // Source information.
+ //
+
+ - object : PROTOTYPE;
+
+ - 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;
+ };
+ (pos_line > 32767).if {
+ result := POSITION.create object line 32767 column pos_col;
+ syntax_error (result,"Line counter overflow.");
+ };
+ (pos_col > 255).if {
+ result := POSITION.create object line pos_line column 255;
+ syntax_error (result,"Column counter overflow (line too long).");
+ };
+ POSITION.create object 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 <-
+ ( + beg:INTEGER;
+
+ (is_shorter).if {
+ token.clear;
+ beg := old_position + old_short_derive;
+ output_code.remove_between beg to (position+short_derive-1);
+ (old_position).to (position-1) do { j:INTEGER;
+ token.add_last (source.item j);
+ };
+ output_code.insert_string token to beg;
+ short_derive := old_short_derive;
+ };
+
+ 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;
+ - is_parameter_type:BOOLEAN;
+
+ - last_comment_extern:STRING_CONSTANT;
+ - last_comment_slot :STRING_CONSTANT;
+ - skip_comment:BOOLEAN;
+
+ - read_space:BOOLEAN <-
+ ( + posold,pos,pos2:INTEGER;
+ + level_comment:INTEGER;
+ + stat:INTEGER;
+
+ pos := position;
+ posold := -1;
+ (is_shorter2).if {
+ string_tmp3.clear;
+ string_tmp4.clear;
+ };
+ {posold = position}.until_do {
+ posold := position;
+
+ // Skip spaces :
+ {(last_character = 0.to_character) || {last_character > ' '}}.until_do {
+ ((is_shorter2) || {is_shorter}).if {
+ (last_character = '\n').if {
+ (stat)
+ .when 0 then { stat := 1; }
+ .when 1 then { stat := 2; }
+ .when 2 then { };
+ };
+ };
+ 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 {
+ (is_shorter2).if {
+ (stat)
+ .when 0 or 1 then {
+ string_tmp3.add_last last_character;
+ }
+ .when 2 then {
+ string_tmp4.add_last last_character;
+ };
+ };
+ position := position + 1;
+ };
+ (is_shorter2).if {
+ (stat)
+ .when 0 or 1 then { string_tmp3.add_last '\n'; }
+ .when 2 then { string_tmp4.add_last '\n'; };
+ };
+ (is_shorter).if {
+ // BSBS: A revoir ...
+ ((pos2-2+short_derive).in_range (output_code.lower) to (output_code.upper)).if {
+ output_code.remove_between (pos2-2+short_derive) to (pos2-1+short_derive);
+ short_derive := short_derive - 2;
+ };
+ // Bug ?
+ ( + nb,p:INTEGER;
+ p := pos2 - 3;
+ {(p >= source.lower) && {source.item p <= ' '}}.while_do {
+ (source.item p = '\n').if {
+ nb := nb + 1;
+ };
+ p := p - 1;
+ };
+ (nb > 1).if {
+ stat := 2;
+ };
+ );
+ (stat)
+ .when 0 or 1 then {
+ short (ALIAS_STR.short_comment_slot_line) token pos2 to position;
+ }
+ .when 2 then {
+ short (ALIAS_STR.short_comment_line) token pos2 to position;
+ };
+ };
+ position := position + 1;
+ };
+ };
+ (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;
+ };
+ };
+ };
+ ((is_shorter2) && {! skip_comment}).if {
+ (string_tmp3.is_empty).if {
+ last_comment_slot := NULL;
+ } else {
+ last_comment_slot := ALIAS_STR.get string_tmp3;
+ };
+ (string_tmp4.is_empty).if_false {
+ last_comment_extern := ALIAS_STR.get string_tmp4;
+ };
+ };
+ // FALSE : Last character.
+ begin_position := position;
+ ((position != pos) | (last_character != 0.to_character))
+ );
+
+ - read_symbol st:STRING_CONSTANT :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;
+ last_string := st;
+ } 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 <-
+ (
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)) ||
+ {read_symbol (ALIAS_STR.symbol_affect_cast)} ||
+ {read_symbol (ALIAS_STR.symbol_affect_code)}
+ );
+
+ //-- 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;
+ (is_shorter).if {
+ (result).if {
+ (st = ALIAS_STR.keyword_section).if {
+ short (ALIAS_STR.short_keyword_section) token
+ (position-last_string.count) to position;
+ } else {
+ short (ALIAS_STR.short_keyword) token
+ (position-last_string.count) to position;
+ };
+ };
+ };
+ 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;
+ + car:CHARACTER;
+ // On passe les espaces :
+ ((! read_space) || {! last_character.is_upper}).if {
+ result := FALSE;
+ } else {
+ posold := position;
+ string_tmp.clear;
+ string_tmp.add_last last_character;
+ position := position + 1;
+ is_parameter_type := TRUE;
+ {
+ (last_character = 0.to_character) ||
+ {
+ (! last_character.is_upper) &&
+ {! last_character.is_digit} &&
+ {last_character != '_'}
+ }
+ }.until_do {
+ car := last_character;
+ is_parameter_type := is_parameter_type && {car.is_digit};
+ string_tmp.add_last car;
+ position := position+1;
+ };
+ 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.");
+ };
+ };
+ );
+
+ //-- character -> '\'' ascii '\''
+ - read_characters:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + old_pos:INTEGER;
+ + count:INTEGER;
+ // On passe les espaces :
+ ((read_space) && {last_character='\''}).if {
+ 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;
+ count := count + 1;
+ } else {
+ position := position+1;
+ count := count + 1;
+ };
+ };
+ (last_character='\'').if {
+ position := position+1;
+ last_string := ALIAS_STR.get string_tmp;
+ (count != 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 {
+ 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_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:SECTION_;
+
+ //
+ // PARSER
+ //
+
+ //++ PROGRAM -> { "Section" (section|TYPE_LIST) { SLOT } } [CONTRACT ';']
+ - read_program:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + pos_sec,old_derive:INTEGER;
+ + t:FAST_ARRAY(ITM_TYPE_MONO);
+
+ result := TRUE;
+
+ pos_sec := position;
+ old_derive := short_derive;
+
+ read_space;
+
+ (is_shorter).if {
+ output_code.remove_between (source.lower+old_derive) to (position-1+short_derive);
+ short_derive := short_derive - ((position+short_derive) - (source.lower+old_derive));
+ };
+ pos_sec := position;
+ old_derive := short_derive;
+ last_comment_extern := NULL;
+ //
+ // 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
+
+ (is_shorter2).if {
+ object.set_comment_header last_comment_extern;
+ };
+
+ //
+ // Read Section Other.
+ //
+ {read_this_keyword (ALIAS_STR.keyword_section)}.while_do {
+ last_comment_extern := NULL;
+ (read_keyword).if {
+ // Public, Private, ...
+ (ALIAS_STR.is_section last_string).if_false {
+ syntax_error (current_position,"Incorrect type section.");
+ };
+ last_section := SECTION_.get_name last_string;
+ (last_section.is_mapping).if {
+ object.set_mapping;
+ }.elseif {
+ (last_section.is_inherit_or_insert) &&
+ {object.last_slot != NULL} &&
+ {! object.last_slot.id_section.is_inherit_or_insert}
+ } then {
+ syntax_error (current_position,
+ "`Section Inherit/Insert' must to be first section.");
+ }.elseif {
+ (last_section.is_inherit) &&
+ {object.type_style = ALIAS_STR.keyword_expanded} &&
+ {object.name != ALIAS_STR.prototype_true } &&
+ {object.name != ALIAS_STR.prototype_false}
+ } then {
+ warning_error (current_position,
+ "`Section Inherit' is not possible with Expanded object (Use `Section Insert').");
+ };
+ } else {
+ // TYPE_LIST.
+ t := read_type_list TRUE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type section.");
+ };
+ last_section := SECTION_.get_type_list t;
+ };
+ {read_slot}.while_do {
+ }; // loop
+
+ (is_shorter).if {
+ (
+ (! is_short_private) &&
+ {last_section.is_private}
+ ).if {
+ output_code.remove_between
+ (pos_sec + old_derive) to (position + short_derive - 1);
+ short_derive := old_derive - (position - pos_sec);
+ };
+
+ pos_sec:=position;
+ old_derive:=short_derive;
+ };
+
+ }; // 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:ITM_TYPE;
+ + lt:FAST_ARRAY(ITM_TYPE_MONO);
+ + style:CHARACTER;
+ + affect:CHARACTER;
+ + old_pos,old_derive:INTEGER;
+ + s:ITM_SLOT;
+
+ style := read_style;
+ (style != ' ').if {
+ //
+ // Classic slot.
+ //
+ 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.");
+ };
+ t := ITM_TYPE_MULTI.get lt;
+ } else {
+ t := read_type FALSE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect result type.");
+ };
+ };
+
+ (read_affect).if {
+ affect := last_string.first;
+ };
+ } else {
+ t := ITM_TYPE_SIMPLE.type_void;
+ };
+ last_slot.set_result_type t;
+ last_slot.set_affect affect;
+
+ (affect != ' ').if {
+ read_space;
+ (is_shorter2).if {
+ (last_comment_slot != NULL).if {
+ last_slot.set_comment last_comment_slot;
+ };
+ (last_comment_extern != NULL).if {
+ last_slot.set_comment_chapter last_comment_extern;
+ };
+ skip_comment := TRUE;
+ };
+ old_pos := position;
+ old_derive := short_derive;
+ read_def_slot;
+ };
+
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ };
+ (is_shorter2).if {
+ skip_comment := FALSE;
+ read_space;
+ ((last_slot.comment = NULL) && {last_comment_slot != NULL}).if {
+ last_slot.set_comment last_comment_slot;
+ };
+ };
+
+ (is_shorter).if {
+ (
+ (! is_short_code) &&
+ {old_pos != 0} &&
+ {! last_section.is_header}
+ ).if {
+ (current_position.column<5).if {
+ {
+ (last_character != 0.to_character) &&
+ {last_character.is_separator} &&
+ {last_character != '\n'}
+ }.while_do {
+ position := position + 1;
+ };
+ (last_character = '\n').if {
+ position := position + 1;
+ };
+ };
+ output_code.remove_between
+ (old_pos + old_derive) to (position + short_derive - 1);
+ short_derive := old_derive - (position - old_pos);
+ };
+ };
+
+ // Added slot in prototype :
+ s := object.slot_list.fast_reference_at (last_slot.name);
+ (s != NULL).if {
+ POSITION.put_error semantic text "Double slot declaration.";
+ s.position.put_position;
+ last_slot.position.put_position;
+ POSITION.send_error;
+ };
+ object.add_slot last_slot;
+
+ (is_shorter).if {
+ short_local.clear;
+ };
+ };
+ result
+ ); // read_slot
+
+ //++ TYPE_SLOT -> [ LOC_ARG '.' ] identifier [ LOC_ARG { identifier LOC_ARG } ]
+ //++ | [ LOC_ARG ] '\'' operator '\'' [("Left"|"Right") [integer]] [LOC_ARG]
+ - read_type_slot:ITM_SLOT <-
+ ( + 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(ITM_ARGUMENT) :ITM_SLOT <-
+ ( + n:STRING;
+ + arg:ITM_ARGUMENT;
+ + result:ITM_SLOT;
+
+ read_identifier.if {
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ 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'.");
+ };
+ {
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+ 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 := ITM_SLOT.create current_position name (ALIAS_STR.alias n) feature last_section;
+ };
+ result
+ );
+
+ - read_slot_operator list_arg:FAST_ARRAY(ITM_ARGUMENT) :ITM_SLOT <-
+ ( + name,pretty_name:STRING_CONSTANT;
+ + associativity:STRING_CONSTANT;
+ + priority:INTEGER;
+ + arg:ITM_ARGUMENT;
+ + result:ITM_SLOT_OPERATOR;
+
+ (! 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.");
+ };
+ pretty_name := 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 := ITM_SLOT_OPERATOR.create current_position name name feature last_section;
+ result.set_associativity associativity priority priority;
+ result.set_pretty_name pretty_name;
+ result
+ ); // read_slot_operator
+
+ //++ DEF_SLOT -> [CONTRACT] EXPR [CONTRACT]
+ - read_def_slot <-
+ ( + expr:ITM_CODE;
+
+ read_require;
+ expr := read_expr;
+ (expr = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ last_slot.set_value expr type object;
+ read_ensure;
+ );
+
+ //++ LOC_ARG -> identifier ':' TYPE
+ //++ | '(' LOCAL ')'
+ - read_loc_arg mute:BOOLEAN with_self self_first:BOOLEAN :ITM_ARGUMENT <-
+ ( + result:ITM_ARGUMENT;
+ + t:ITM_TYPE_MONO;
+ + pos:POSITION;
+ + n:STRING_CONSTANT;
+ + tb:ITM_TYPE_BLOCK;
+
+ (
+ (( 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.");
+ };
+
+ (
+ (self_first) &&
+ {t != ITM_TYPE_SIMPLE.type_self} &&
+ {
+ (object.name != ALIAS_STR.prototype_block) ||
+ {tb ?= t; tb = NULL}
+ }
+ ).if {
+ syntax_error (current_position,"Type `SELF' is needed.");
+ };
+ result := ITM_ARG.create pos name n type t;
+
+ (is_shorter).if {
+ short_local.add n;
+ };
+ } 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;
+
+ (is_shorter).if {
+ (result.lower).to (result.upper) do { j:INTEGER;
+ short_local.add (result.item j.name);
+ };
+ };
+ };
+ };
+
+ 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 {
+ (
+ (s) && {
+ (type.first != ITM_TYPE_SIMPLE.type_self) || {
+ (object.name = ALIAS_STR.prototype_block) &&
+ {tb ?= type.first; tb = NULL}
+ }
+ }
+ ).if {
+ syntax_error (current_position,"Type `SELF' is needed.");
+ };
+ (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;
+ };
+
+ (is_shorter).if {
+ (name.lower).to (name.upper) do { j:INTEGER;
+ short_local.add (name.item j);
+ };
+ };
+ };
+ };
+
+ result
+ ); // read_local
+
+ //++ TYPE_LIST -> TYPE { ',' TYPE }
+ - read_type_list is_section:BOOLEAN :FAST_ARRAY(ITM_TYPE_MONO) <-
+ ( + lst:FAST_ARRAY(ITM_TYPE_MONO);
+ + t:ITM_TYPE_MONO;
+ + ts:ITM_TYPE_SIMPLE;
+
+ t := read_type FALSE;
+ (t != NULL).if {
+ (is_section).if {
+ ts ?= t;
+ (ts = NULL).if {
+ syntax_error (current_position,
+ "For a section, the prototype name only (without '['...']').");
+ };
+ };
+ lst := ALIAS_ARRAY(ITM_TYPE_MONO).new;
+ lst.add_last t;
+ {read_character ','}.while_do {
+ t := read_type FALSE;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type list.");
+ };
+ (is_section).if {
+ ts ?= t;
+ (ts = NULL).if {
+ syntax_error (current_position,
+ "For a section, the prototype name only (without '['...']').");
+ };
+ };
+ lst.add_last t;
+ };
+ lst := ALIAS_ARRAY(ITM_TYPE_MONO).alias lst;
+ };
+ lst
+ );
+
+ //++ TYPE -> '{' [ (TYPE | '(' TYPE_LIST ')') ';' ] [ TYPE_LIST ] '}'
+ //++ | [type] PROTOTYPE [ CONTRACT ]
+ - read_type is_local:BOOLEAN :ITM_TYPE_MONO <-
+ ( + style:STRING_CONSTANT;
+ + result:ITM_TYPE_MONO;
+ + lst:FAST_ARRAY(ITM_TYPE_MONO);
+ + typ_arg,typ_res:ITM_TYPE;
+ + contract:ITM_LIST;
+
+ (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.append_in 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;
+ contract := read_contract;
+ (contract != NULL).if {
+ warning_error (current_position,"Sorry, not yet implemented.");
+ };
+ };
+ result
+ ); // read_type
+
+ //++ PROTOTYPE -> cap_identifier{('.'|'...')cap_identifier}['('PARAM_TYPE{','PARAM_TYPE}')']
+ - read_prototype styl:STRING_CONSTANT :ITM_TYPE_MONO <-
+ ( + nam:STRING_CONSTANT;
+ + genericity:FAST_ARRAY(ITM_TYPE_MONO);
+ + result,t:ITM_TYPE_MONO;
+ + old_pos,old_derive,sav_derive,pos_before:INTEGER;
+ + continue:BOOLEAN;
+
+
+ (read_cap_identifier).if {
+ old_pos := position;
+ old_derive := short_derive;
+ string_tmp2.copy last_string;
+ {
+ continue := read_word (ALIAS_STR.keyword_ldots);
+ (continue).if {
+ (read_cap_identifier).if_false {
+ syntax_error (current_position,"Prototype name needed.");
+ };
+ string_tmp2.append (ALIAS_STR.keyword_ldots);
+ string_tmp2.append last_string;
+ } else {
+ pos_before := position;
+ ((read_character '.') && {read_cap_identifier}).if {
+ continue := TRUE;
+ string_tmp2.add_last '.';
+ string_tmp2.append last_string;
+ } else {
+ position := pos_before;
+ };
+ };
+ }.do_while {continue};
+ nam := ALIAS_STR.get string_tmp2;
+
+ (read_character '(').if {
+ //
+ // Genericity.
+ //
+ genericity := ALIAS_ARRAY(ITM_TYPE_MONO).new;
+ {
+ t := read_param_type;
+ (t = NULL).if {
+ syntax_error (current_position,"Type needed.");
+ };
+ genericity.add_last t;
+ }.do_while {read_character ','};
+ genericity := ALIAS_ARRAY(ITM_TYPE_MONO).alias genericity;
+ result := ITM_TYPE_GENERIC.get nam style styl with genericity;
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')'.");
+ };
+ } else {
+ // Simple type.
+ (is_parameter_type).if {
+ (styl != NULL).if {
+ string_tmp.copy "Style `";
+ string_tmp.append styl;
+ string_tmp.append "' for parameter type is ignored.";
+ warning_error (current_position,string_tmp);
+ };
+ result := ITM_TYPE_PARAMETER.get nam;
+ }.elseif {styl = NULL} then {
+ result := ITM_TYPE_SIMPLE.get nam;
+ } else {
+ (nam = ALIAS_STR.prototype_self).if {
+ string_tmp.copy "Style `";
+ string_tmp.append styl;
+ string_tmp.append "' ignored.";
+ warning_error (current_position,string_tmp);
+ result := ITM_TYPE_SIMPLE.type_self;
+ } else {
+ result := ITM_TYPE_STYLE.get nam style styl;
+ };
+ };
+ }; // if
+ (is_shorter).if {
+ sav_derive := short_derive;
+ short_derive := old_derive;
+ (
+ (result = ITM_TYPE_SIMPLE.type_self) ||
+ {result = ITM_TYPE_SIMPLE.type_null}
+ ).if {
+ short (ALIAS_STR.short_keyprototype) token
+ (old_pos - nam.count) to old_pos;
+ } else {
+ short (ALIAS_STR.short_prototype) token
+ (old_pos - nam.count) to old_pos;
+ };
+ short_derive := sav_derive + (short_derive - old_derive);
+ };
+ }; // if
+ result
+ ); // read_prototype
+
+ - read_param_type:ITM_TYPE_MONO <-
+ //++ PARAM_TYPE -> TYPE
+ //++ | CONSTANT
+ //++ | identifier
+ ( + result:ITM_TYPE_MONO;
+ + cst:ITM_CONSTANT;
+
+ result := read_type FALSE;
+ (result = NULL).if {
+ cst := read_constant;
+ (cst != NULL).if {
+ syntax_error (current_position,"1) Sorry, not yet implemented.");
+ //result :=
+ }.elseif {read_identifier} then {
+ syntax_error (current_position,"2) Sorry, not yet implemented.");
+ //result :=
+ };
+ };
+ result
+ );
+
+ //++ EXPR -> { ASSIGN !!AMBIGU!! affect } EXPR_OPERATOR
+ //++ ASSIGN -> '(' IDF_ASSIGN { ',' IDF_ASSIGN } ')'
+ //++ | IDF_ASSIGN
+ //++ IDF_ASSIGN -> identifier { identifier }
+ - read_expr:ITM_CODE <-
+ ( + result,value:ITM_CODE;
+ + affect:CHARACTER;
+ + again:BOOLEAN;
+ + l_assignment:FAST_ARRAY(STRING_CONSTANT);
+ + p:INTEGER;
+ + name:STRING_CONSTANT;
+
+ // !! AMBIGU resolution !!
+ save_context;
+ (read_character '(').if {
+ l_assignment := ALIAS_ARRAY(STRING_CONSTANT).new;
+ {
+ again := FALSE;
+ (read_identifier).if {
+ p := position - last_string.count;
+ 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;
+ l_assignment.add_last name;
+
+ (is_shorter).if {
+ (! short_local.fast_has name).if {
+ short (ALIAS_STR.short_slot_call) token p to position;
+ };
+ };
+
+ (read_character ',').if {
+ again := TRUE;
+ };
+ };
+ }.do_while {again};
+ ((! l_assignment.is_empty) && {read_character ')'} && {read_affect}).if {
+ l_assignment := ALIAS_ARRAY(STRING_CONSTANT).copy l_assignment;
+ result := ITM_LIST_IDF.create current_position with l_assignment;
+ affect := last_string.first;
+ value := read_expr;
+ (value = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (affect)
+ .when ':' then {
+ result := ITM_WRITE_VALUE.create (result.position) assign result with value;
+ }
+ .when '<' then {
+ syntax_error (current_position,"Impossible '<-' style assignment with vector.");
+ }
+ .when '?' then {
+ syntax_error (current_position,"Sorry, Not yet implemented !");
+ result := ITM_WRITE_CAST.create (result.position) assign result with value;
+ };
+ } else {
+ ALIAS_ARRAY(STRING_CONSTANT).free l_assignment;
+ };
+ }.elseif {read_identifier} then {
+ p := position - last_string.count;
+ 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;
+
+ (is_shorter).if {
+ (! short_local.fast_has name).if {
+ short (ALIAS_STR.short_slot_call) token p to position;
+ };
+ };
+
+ (read_affect).if {
+ result := ITM_READ.create current_position name name;
+ affect := last_string.first;
+ value := read_expr;
+ (value = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (affect)
+ .when ':' then {
+ result := ITM_WRITE_VALUE.create (result.position) assign result with value;
+ }
+ .when '<' then {
+ result := ITM_WRITE_CODE.create (result.position) assign result with value;
+ }
+ .when '?' then {
+ result := ITM_WRITE_CAST.create (result.position) assign result with value;
+ };
+ };
+ };
+ (result = NULL).if {
+ restore_context;
+ result := read_expr_operator;
+ };
+ result
+ );
+
+ //++ EXPR_OPERATOR-> { operator } EXPR_MESSAGE { operator {operator} EXPR_MESSAGE } {operator}
+ - read_expr_operator:ITM_CODE <-
+ ( + result:ITM_CODE;
+ + expr :ITM_CODE;
+ + l_expr:FAST_ARRAY(ITM_CODE);
+ + itm_op:ITM_OPERATOR;
+ + last_msg,first_msg:INTEGER;
+
+ l_expr := ALIAS_ARRAY(ITM_CODE).new;
+ {read_operator}.while_do {
+ expr := ITM_OPERATOR.create current_position name last_string;
+ l_expr.add_last expr;
+ };
+ expr := read_expr_message;
+ (expr = NULL).if {
+ // Error.
+ (! l_expr.is_empty).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ ALIAS_ARRAY(ITM_CODE).free l_expr;
+ } else {
+ // { operator {operator} EXPR_MESSAGE } {operator}
+ first_msg := l_expr.count;
+ {
+ last_msg := l_expr.count;
+ l_expr.add_last expr;
+ (read_operator).if {
+ {
+ expr := ITM_OPERATOR.create current_position name last_string;
+ l_expr.add_last expr;
+ }.do_while {read_operator};
+ expr := read_expr_message;
+ } else {
+ expr := NULL;
+ };
+ }.do_while {expr != NULL};
+
+ // Last Post-fix operator.
+ {last_msg < l_expr.upper}.while_do {
+ itm_op ?= l_expr.item (last_msg + 1);
+ expr := ITM_READ_ARG1.create (itm_op.position)
+ name (operator (ALIAS_STR.slot_postfix) name (itm_op.name))
+ arg (l_expr.item last_msg);
+ l_expr.put expr to last_msg;
+ l_expr.remove (last_msg + 1);
+ };
+ ((last_msg - first_msg) < 3).if {
+ // First Pre-fix operator.
+ {first_msg != 0}.while_do {
+ itm_op ?= l_expr.item (first_msg - 1);
+ expr := ITM_READ_ARG1.create (itm_op.position)
+ name (operator (ALIAS_STR.slot_prefix) name (itm_op.name))
+ arg (l_expr.item first_msg);
+ l_expr.put expr to first_msg;
+ first_msg := first_msg - 1;
+ l_expr.remove first_msg;
+ };
+ };
+ (l_expr.count = 1).if {
+ result := l_expr.first;
+ ALIAS_ARRAY(ITM_CODE).free l_expr;
+ }.elseif {l_expr.count = 3} then {
+ // Simple binary message.
+ itm_op ?= l_expr.second;
+ result := ITM_READ_ARG2.create (itm_op.position)
+ name (operator (ALIAS_STR.slot_infix) name (itm_op.name))
+ args (l_expr.first,l_expr.item 2);
+ //
+ ALIAS_ARRAY(ITM_CODE).free l_expr;
+ } else {
+ // Complex expression.
+ l_expr := ALIAS_ARRAY(ITM_CODE).copy l_expr;
+ result := ITM_EXPRESSION.create l_expr;
+ };
+ };
+ result
+ ); // read_expr_operator
+
+ //++ EXPR_MESSAGE -> EXPR_BASE { '.' SEND_MSG }
+ - read_expr_message:ITM_CODE <-
+ ( + result:ITM_CODE;
+
+ 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:ITM_CODE <-
+ ( + result,old_value:ITM_CODE;
+
+ (read_this_keyword (ALIAS_STR.keyword_old)).if {
+ old_value := read_expr;
+ (old_value = NULL).if {
+ syntax_error (current_position,"Incorrect `Old' expression.");
+ };
+ result := ITM_OLD.create current_position value old_value;
+ } else {
+ result := read_expr_primary;
+ (result = NULL).if {
+ result := read_send_msg NULL;
+ };
+ };
+ result
+ ); // read_expr_base
+
+ //++ EXPR_PRIMARY -> "Self"
+ //++ | result
+ //++ | PROTOTYPE
+ //++ | CONSTANT
+ //++ | '(' 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 := ITM_READ.create current_position name 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_id := ALIAS_STR.get string_tmp;
+ } else {
+ result_id := ALIAS_STR.keyword_result;
+ };
+ result := ITM_READ.create current_position name result_id;
+ }.elseif {
+ type := read_prototype NULL;
+ type != NULL
+ } then {
+ result := ITM_PROTOTYPE.create current_position type type;
+ }.elseif {(result := read_constant) != NULL} then {
+ }.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
+ short (ALIAS_STR.short_block) token (position-1) to position;
+ 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
+
+ - read_constant:ITM_CONSTANT <-
+ //++ CONSTANT -> integer
+ //++ | real
+ //++ | characters
+ //++ | string
+ ( + result:ITM_CONSTANT;
+
+ (read_real).if {
+ result := ITM_REAL.create current_position value last_real;
+ }.elseif {read_integer} then {
+ result := ITM_NUMBER.create current_position value last_integer;
+ }.elseif {read_characters} then {
+ result := ITM_CHARACTER.create current_position char last_string;
+ }.elseif {read_string} then {
+ result := ITM_STRING.create current_position text last_string;
+ };
+ result
+ );
+
+ //++ 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 {
+
+ short (ALIAS_STR.short_slot_call) token
+ (position-last_string.count) to position;
+
+ 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;
+
+ (is_shorter).if {
+ (
+ (! l_arg.is_empty) ||
+ {first_arg != NULL} ||
+ {! short_local.fast_has last_string}
+ ).if {
+ sav_derive := short_derive;
+ short_derive := old_derive;
+ short (ALIAS_STR.short_slot_call) token p1 to p2;
+ short_derive := sav_derive + (short_derive-old_derive);
+ };
+ };
+
+ 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 {
+ (is_shorter).if {
+ (short_local.fast_has last_string).if_false {
+ short (ALIAS_STR.short_slot_call) token
+ (position-last_string.count) to position;
+ };
+ };
+ result := ITM_READ.create current_position name last_string;
+ };
+ result
+ ); // read_argument
+
+ // name, export, import, type, default, external, version, lip,
+ // 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;
+ + instr:LIP_CODE;
+ + param:{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 {
+ is_cop := TRUE;
+ (is_java).if {
+ semantic_error (current_position,"COP not yet implemented.");
+ } else {
+ output_decl.append
+ "#include <pthread.h>\n\
+ \#include <limits.h>\n\n\
+ \void print_char(char car);\n\
+ \int die_with_code(int code);\n\n\
+ \static pthread_key_t current_thread;\n\
+ \static pthread_attr_t thread_attr;\n\
+ \pthread_t c_thread;\n\
+ \int thread_counter;\n\n\
+ \static char thread_stack[512][PTHREAD_STACK_MIN];\n\n\
+ \typedef struct lith_object_struct lith_object;\n\
+ \typedef struct lith_node_struct lith_node;\n\
+ \struct lith_node_struct {\n\
+ \ pthread_mutex_t mutex;\n\
+ \ lith_node *next;\n\
+ \ lith_object *object;\n\
+ \};\n\
+ \struct lith_object_struct {\n\
+ \ unsigned long __id; // Just for late binding.\n\
+ \ lith_node *first;\n\
+ \ lith_node *last;\n\
+ \ lith_object *(*procedure)(lith_object *obj,pthread_mutex_t *mutex);\n\
+ \ pthread_mutex_t mutex;\n\
+ \};\n\
+ \struct {\n\
+ \ lith_node *first;\n\
+ \ pthread_mutex_t mutex;\n\
+ \} pool;\n\n\
+ \void *thread_life(void *ptr)\n\
+ \{ lith_node node,*n;\n\
+ \ lith_object *obj,*new_obj;\n\n\
+ \ pthread_mutex_init(&node.mutex,NULL);\n\
+ \ pthread_mutex_lock(&node.mutex);\n\
+ \ node.object = (lith_object *)ptr;\n\
+ \ do {\n\
+ \ // Append fifo object.\n\
+ \ obj = node.object;\n\
+ \ node.next = NULL;\n\
+ \ n = obj->last;\n\
+ \ if (n == NULL) {\n\
+ \ obj->first = &node;\n\
+ \ pthread_mutex_unlock(&node.mutex);\n\
+ \ } else {\n\
+ \ n->next = &node;\n\
+ \ };\n\
+ \ obj->last = &node;\n\
+ \ pthread_setspecific(current_thread,(void *)obj);\n\
+ \ // Run procedure.\n\
+ \ new_obj = obj->procedure(obj,&node.mutex);\n\
+ \ // Remove fifo object.\n\
+ \ pthread_mutex_lock(&obj->mutex);\n\
+ \ n = obj->first->next;\n\
+ \ if (n != NULL) {\n\
+ \ pthread_mutex_unlock(&n->mutex);\n\
+ \ } else {\n\
+ \ obj->last = NULL;\n\
+ \ };\n\
+ \ obj->first = n;\n\
+ \ pthread_mutex_unlock(&obj->mutex);\n\
+ \ if (new_obj != NULL) {\n\
+ \ node.object = new_obj;\n\
+ \ } else {\n\
+ \ // Add in pool.\n\
+ \ pthread_mutex_lock(&pool.mutex);\n\
+ \ node.next = pool.first;\n\
+ \ pool.first = &node;\n\
+ \ pthread_mutex_unlock(&pool.mutex);\n\
+ \ // Sleep.\n\
+ \ pthread_mutex_lock(&node.mutex);\n\
+ \ };\n\
+ \ } while (1);\n\
+ \ return NULL;\n\
+ \};\n\n\
+ \void run_procedure(lith_object *obj)\n\
+ \{ lith_node *node;\n\
+ \ char *msg=\"COP Error!\\n\";\n\
+ \ // Pool manager.\n\
+ \ pthread_mutex_lock(&pool.mutex);\n\
+ \ node = pool.first;\n\
+ \ if (node != NULL) {\n\
+ \ pool.first = node->next;\n\
+ \ };\n\
+ \ pthread_mutex_unlock(&pool.mutex);\n\
+ \ // Run thread.\n\
+ \ if (node == NULL) {\n\
+ \ pthread_attr_setstack(&thread_attr, thread_stack[thread_counter++],PTHREAD_STACK_MIN);\n\
+ \ if ((thread_counter>512) || pthread_create(&c_thread,&thread_attr, thread_life, (void *)obj)) {\n\
+ \ while (*msg != 0) print_char(*(msg++));\n\
+ \ die_with_code(1);\n\
+ \ };\n\
+ \ } else {\n\
+ \ node->object = obj;\n\
+ \ pthread_mutex_unlock(&node->mutex);\n\
+ \ };\n\
+ \};\n\n";
+ };
+ };
+
+ // style "name" ':=' [type] cap_identifier [ '(' PARAM {',' PARAM}')' ]
+ // PARAM -> cap_identifier | identifier ':' TYPE
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ object.set_position current_position;
+ object.set_style style;
+ (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 {
+ object.set_type_style last_string;
+ };
+
+ (! read_cap_identifier).if {
+ syntax_error (current_position,"Prototype identifier is needed.");
+ };
+ short (ALIAS_STR.short_prototype) token
+ (position-last_string.count) to position;
+
+ (object.shortname != last_string).if {
+ syntax_error (current_position,"Incorrect name (filename != name).");
+ };
+ (read_character '(').if {
+ //
+ // Generic loader.
+ //
+ param := { + res:ITM_TYPE_PARAMETER;
+ (read_identifier).if {
+ (read_character ':').if_false {
+ warning_error (current_position,"Added ':'.");
+ };
+ (read_type TRUE = NULL).if {
+ syntax_error (current_position,"Type needed.");
+ };
+ // BSBS: Warning: type::{INTEGER,CHARACTER,REAL,STRING_CONSTANT}
+ semantic_error (current_position,"Sorry, not yet implemented.");
+ }.elseif {read_cap_identifier} then {
+ (is_parameter_type).if_false {
+ syntax_error (current_position,"Identifier parameter type is needed.");
+ };
+ short (ALIAS_STR.short_keyprototype) token
+ (position - last_string.count) to position;
+ res ?= ITM_TYPE_PARAMETER.get last_string;
+ };
+ res
+ };
+
+ ((! is_shorter) && {! is_shorter2}).if {
+ (object.generic_count = 0).if {
+ syntax_error (current_position,"Object can't be generic.");
+ };
+ };
+ parameter_type := param.value;
+ (parameter_type = NULL).if {
+ syntax_error (current_position,"Identifier parameter type is needed.");
+ };
+
+ object.idf_generic_list.add_last parameter_type;
+ {read_character ','}.while_do {
+ parameter_type := param.value;
+ (parameter_type = NULL).if {
+ syntax_error (current_position,"Identifier parameter type is needed.");
+ };
+ object.idf_generic_list.add_last parameter_type;
+ }; // loop
+
+ (! read_character ')').if {
+ warning_error (current_position,"Added ')'.");
+ };
+
+ ((! is_shorter) && {! is_shorter2}).if {
+ (object.idf_generic_list.count != object.generic_count).if {
+ syntax_error (current_position,"Invalid generic list number.");
+ };
+ };
+ };
+ } 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
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (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>`
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_external).if_false {
+ syntax_error (current_position,"Incorrect external.");
+ };
+ output_decl.append "// ";
+ output_decl.append (object.name);
+ output_decl.add_last '\n';
+ output_decl.append last_string;
+ output_decl.add_last '\n';
+ }.elseif {read_word(ALIAS_STR.slot_default)} then {
+ //
+ // Read `default' slot.
+ //
+
+ // '-' "default" ':=' EXPR_PRIMARY
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (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.");
+ };
+ (object.default_value != NULL).if {
+ semantic_error (current_position,"Double `default' slot definition.");
+ };
+ object.set_default_value v;
+ }.elseif {read_word (ALIAS_STR.slot_type)} then {
+ //
+ // Read `type' slot.
+ //
+
+ // '-' "type" ':=' `<type C>`
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (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
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (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_lip)} then {
+ //
+ // LIP interpreter.
+ //
+
+ // '-' lip <- ( { LIP_EXPR ';' } )
+ (read_symbol (ALIAS_STR.symbol_affect_code)).if_false {
+ warning_error (current_position,"Added '<-' is needed.");
+ };
+ (read_character '(').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ {(instr := readlip_expr) != NULL}.while_do {
+ instr.run;
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')' is needed.");
+ };
+ }.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
+ short (ALIAS_STR.short_slot) token
+ (position-last_string.count) to position;
+
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ warning_error (current_position,"Added ':='.");
+ };
+ (read_string).if_false {
+ syntax_error (current_position,"Incorrect string.");
+ };
+ (is_shorter2).if {
+ object.set_comment_slot last_string;
+ };
+ } else {
+ warning_error (current_position,"Incorrect slot.");
+ };
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';'.");
+ };
+ };
+ result
+ );
+
+ //
+ // Parser for LIP file.
+ //
+
+ - readlip_program <-
+ //// PROGRAM -> { 'Section' ('Inherit' | 'Public' | 'Private') { SLOT ';' } }
+ ( + idx:INTEGER;
+ + section:STRING_CONSTANT;
+
+ idx := LIP_CODE.list_parent.lower;
+ {read_this_keyword (ALIAS_STR.keyword_section)}.while_do {
+ (read_this_keyword (ALIAS_STR.section_inherit)).if {
+ // { '+' string ':' STRING [ ':=' string ] ';' }
+ {read_character '+'}.while_do {
+ (read_identifier).if_false {
+ warning_error (current_position,"Identifier needed.");
+ };
+ (read_character ':').if_false {
+ warning_error (current_position,"Added ':' is needed.");
+ };
+ (read_word (ALIAS_STR.prototype_string)).if_false {
+ warning_error (current_position,"`STRING' type needed.");
+ };
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if {
+ (read_string).if_false {
+ syntax_error (current_position,"String needed.");
+ };
+ string_tmp.copy (object.filename);
+ {
+ (!string_tmp.is_empty) &&
+ {string_tmp.last != '/'} &&
+ {string_tmp.last != '\\'}
+ }.while_do {
+ string_tmp.remove_last 1;
+ };
+ string_tmp.append last_string;
+ } else {
+ string_tmp.clear;
+ };
+ LIP_CODE.list_parent.add (ALIAS_STR.get string_tmp) to idx;
+ idx := idx + 1;
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ }.elseif {
+ (read_this_keyword (ALIAS_STR.section_public)) ||
+ {read_this_keyword (ALIAS_STR.section_private)}
+ } then {
+ section := last_string;
+ {readlip_slot section}.while_do {
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ } else {
+ syntax_error (current_position,"`Public' or `Private' or `Inherit' needed.");
+ };
+ };
+ );
+
+ - readlip_slot sec:STRING_CONSTANT :BOOLEAN <-
+ //// SLOT -> '+' identifier ':' TYPE [ ':=' EXPR_CONSTANT ]
+ //// | '-' identifier [ identifier ':' TYPE ] '<-' '(' { EXPR ';' } ')'
+ ( + result:BOOLEAN;
+ + t:LIP_CONSTANT;
+ + n,na:STRING_CONSTANT;
+ + data:LIP_SLOT_DATA;
+ + slot_code:LIP_SLOT_CODE;
+ + cst:LIP_CONSTANT;
+ + cod:FAST_ARRAY(LIP_CODE);
+ + instr:LIP_CODE;
+ + pos:POSITION;
+
+ (read_character '+').if {
+ // Data.
+ result := TRUE;
+ (sec = ALIAS_STR.section_public).if {
+ syntax_error (current_position,"No data in Public section.");
+ };
+ (read_identifier).if_false {
+ syntax_error (current_position,"Identifier is incorrect.");
+ };
+ n := last_string;
+ (read_character ':').if_false {
+ warning_error (current_position,"Added ':' is needed.");
+ };
+ t := readlip_type;
+ (t = NULL).if {
+ syntax_error (current_position,"type is incorrect.");
+ };
+ data := LIP_SLOT_DATA.create current_position name n value t argument FALSE;
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if {
+ cst := readlip_expr_constant;
+ (cst = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ data.set_value cst;
+ cst.free;
+ };
+ }.elseif {read_character '-'} then {
+ // Function.
+ result := TRUE;
+ (read_identifier).if_false {
+ syntax_error (current_position,"Identifier is incorrect.");
+ };
+ pos := current_position;
+ n := last_string;
+ (read_identifier).if {
+ na := last_string;
+ (read_character ':').if_false {
+ warning_error (current_position,"Added ':' is needed.");
+ };
+ t := readlip_type;
+ (t = NULL).if {
+ syntax_error (current_position,"Incorrect type.");
+ };
+ data := LIP_SLOT_DATA.create current_position name na value t argument TRUE;
+ };
+ //
+ (read_symbol (ALIAS_STR.symbol_affect_code)).if_false {
+ warning_error (current_position,"Added '<-' is needed.");
+ };
+ is_shorter2 := TRUE;
+ (read_character '(').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ is_shorter2 := FALSE;
+ cod := ALIAS_ARRAY(LIP_CODE).new;
+ {(instr := readlip_expr) != NULL}.while_do {
+ cod.add_last instr;
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')' is needed.");
+ };
+ cod := ALIAS_ARRAY(LIP_CODE).copy cod;
+ slot_code := LIP_SLOT_CODE.create pos section sec
+ name n argument data code cod;
+ (sec = ALIAS_STR.section_public).if {
+ (last_comment_slot = NULL).if {
+ warning_error (pos,"Comment needed.");
+ } else {
+ slot_code.set_comment (ALIAS_STR.get last_comment_slot);
+ };
+ };
+ };
+ result
+ );
+
+ - readlip_type:LIP_CONSTANT <-
+ //// TYPE -> 'BOOLEAN' | 'STRING' | 'INTEGER'
+ ( + result:LIP_CONSTANT;
+
+ (read_cap_identifier).if {
+ (last_string = ALIAS_STR.prototype_integer).if {
+ result := LIP_INTEGER.get 0;
+ }.elseif {last_string = ALIAS_STR.prototype_string} then {
+ result := LIP_STRING.get (ALIAS_STR.get "");
+ }.elseif {last_string = ALIAS_STR.prototype_boolean} then {
+ result := LIP_BOOLEAN.get FALSE;
+ } else {
+ syntax_error (current_position,"Incorrect type.");
+ };
+ };
+ result
+ );
+
+ - readlip_expr:LIP_CODE <-
+ //// EXPR -> [ identifier !!AMBIGU!! ':=' ] EXPR_OPERATOR [ '.' FUNCTION ]
+ ( + result,val:LIP_CODE;
+ + nam:STRING_CONSTANT;
+
+ save_context; // !! SAVE CONTEXT !!
+
+ (read_identifier).if {
+ nam := last_string;
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if {
+ val := readlip_expr_operator;
+ (val = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ result := LIP_AFFECT.create current_position name nam value val;
+ } else {
+ restore_context; // !! RESTORE CONTEXT !!
+ };
+ };
+ (result = NULL).if {
+ result := readlip_expr_operator;
+ ((result != NULL) && {read_character '.'}).if {
+ result := readlip_function result;
+ (result = NULL).if {
+ syntax_error (current_position,"Incorrect slot.");
+ };
+ };
+ };
+ result
+ );
+
+ - readlip_function rec:LIP_CODE :LIP_CODE <-
+ //// FUNCTION -> 'if' '{' { EXPR ';' } '}' [ 'else' '{' { EXPR ';' } '}' ]
+ //// | 'print'
+ ( + result:LIP_CODE;
+ + the,els:FAST_ARRAY(LIP_CODE);
+ + val:LIP_CODE;
+
+ (read_word (ALIAS_STR.slot_if)).if {
+ the := ALIAS_ARRAY(LIP_CODE).new;
+ (read_character '{').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ {(val := readlip_expr) != NULL}.while_do {
+ the.add_last val;
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ (read_character '}').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ the := ALIAS_ARRAY(LIP_CODE).copy the;
+ (read_word (ALIAS_STR.slot_else)).if {
+ els := ALIAS_ARRAY(LIP_CODE).new;
+ (read_character '{').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ {(val := readlip_expr) != NULL}.while_do {
+ els.add_last val;
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+ (read_character '}').if_false {
+ warning_error (current_position,"Added '(' is needed.");
+ };
+ els := ALIAS_ARRAY(LIP_CODE).copy els;
+ };
+ result := LIP_IF.create current_position if rec then the else els;
+ }.elseif {read_word (ALIAS_STR.slot_print)} then {
+ result := LIP_PRINT.create current_position message rec;
+ };
+ result
+ );
+
+ - readlip_expr_operator:LIP_CODE <-
+ //// EXPR_OPERATOR-> EXPR_CMP { ('|' | '&') EXPR_CMP }
+ ( + result,right:LIP_CODE;
+ + is_or:BOOLEAN;
+
+ result := readlip_expr_cmp;
+ (result != NULL).if {
+ {(is_or := read_character '|') || {read_character '&'}}.while_do {
+ right := readlip_expr_cmp;
+ (right = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (is_or).if {
+ result := LIP_BINARY.create current_position with result operator '|' and right;
+ } else {
+ result := LIP_BINARY.create current_position with result operator '&' and right;
+ };
+ };
+ };
+ result
+ );
+
+ - readlip_expr_cmp:LIP_CODE <-
+ //// EXPR_CMP -> EXPR_BINARY { ('='|'!='|'>'|'<'|'>='|'<=') EXPR_BINARY }
+ ( + result,right:LIP_CODE;
+ + op:STRING_CONSTANT;
+ + type:CHARACTER;
+
+ result := readlip_expr_binary;
+ (result != NULL).if {
+ {
+ (read_symbol (ALIAS_STR.symbol_great_equal)) ||
+ {read_symbol (ALIAS_STR.symbol_less_equal)} ||
+ {read_symbol (ALIAS_STR.symbol_not_equal)} ||
+ {read_symbol (ALIAS_STR.symbol_equal)} ||
+ {read_symbol (ALIAS_STR.symbol_great)} ||
+ {read_symbol (ALIAS_STR.symbol_less)}
+ }.while_do {
+ op := last_string;
+ right := readlip_expr_binary;
+ (right = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (op)
+ .when ">=" then { type := 'S'; }
+ .when "<=" then { type := 'I'; }
+ .when "!=" then { type := 'E'; }
+ .when "=" then { type := '='; }
+ .when ">" then { type := '>'; }
+ .when "<" then { type := '<'; };
+ result := LIP_BINARY.create current_position with result operator type and right;
+ };
+ };
+ result
+ );
+
+ - readlip_expr_binary:LIP_CODE <-
+ //// EXPR_BINARY -> EXPR_UNARY { ('-'|'+') EXPR_UNARY }
+ ( + result,right:LIP_CODE;
+ + is_sub:BOOLEAN;
+
+ result := readlip_expr_unary;
+ (result != NULL).if {
+ {(is_sub := read_character '-') || {read_character '+'}}.while_do {
+ right := readlip_expr_unary;
+ (right = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (is_sub).if {
+ result := LIP_BINARY.create current_position with result operator '-' and right;
+ } else {
+ result := LIP_BINARY.create current_position with result operator '+' and right;
+ };
+ };
+ };
+ result
+ );
+
+ - readlip_expr_unary:LIP_CODE <-
+ //// EXPR_UNARY -> ( '-' | '!' ) EXPR_UNARY
+ //// | EXPR_BASE
+ //// | identifier [ EXPR_ARGUMENT ]
+ ( + result:LIP_CODE;
+ + is_neg:BOOLEAN;
+ + type:CHARACTER;
+ + nam:STRING_CONSTANT;
+ + arg:LIP_CODE;
+
+ ((is_neg := read_character '-') || {read_character '!'}).if {
+ result := readlip_expr_unary;
+ (result = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (is_neg).if {
+ type := '-';
+ } else {
+ type := '!';
+ };
+ result := LIP_UNARY.create current_position operator type with result;
+ }.elseif {read_identifier} then {
+ nam := last_string;
+ arg := readlip_expr_argument;
+ result := LIP_CALL.create current_position name nam with arg;
+ } else {
+ result := readlip_expr_base;
+ };
+ result
+ );
+
+ - readlip_expr_base:LIP_CODE <-
+ //// EXPR_BASE -> '(' EXPR_OPERATOR ')'
+ //// | EXPR_CONSTANT
+ ( + result:LIP_CODE;
+ + v:LIP_CONSTANT;
+
+ (read_character '(').if {
+ result := readlip_expr_operator;
+ (result = NULL).if {
+ syntax_error (current_position,"Incorrect expression.");
+ };
+ (read_character ')').if_false {
+ warning_error (current_position,"Added ')' is needed.");
+ };
+ } else {
+ v := readlip_expr_constant;
+ (v != NULL).if {
+ result := LIP_VALUE.create current_position with v;
+ };
+ };
+ result
+ );
+
+ - readlip_expr_constant:LIP_CONSTANT <-
+ //// EXPR_CONSTANT-> integer
+ //// | string
+ //// | TRUE
+ //// | FALSE
+ ( + result:LIP_CONSTANT;
+
+ (read_integer).if {
+ result := LIP_INTEGER.get last_integer;
+ }.elseif {read_string} then {
+ result := LIP_STRING.get last_string;
+ }.elseif {read_cap_identifier} then {
+ (last_string = ALIAS_STR.prototype_true).if {
+ result := LIP_BOOLEAN.get TRUE;
+ }.elseif {last_string = ALIAS_STR.prototype_false} then {
+ result := LIP_BOOLEAN.get FALSE;
+ } else {
+ syntax_error (current_position,"Type incorrect.");
+ };
+ };
+ result
+ );
+
+ - readlip_expr_argument:LIP_CODE <-
+ //// EXPR_ARGUMENT-> identifier
+ //// | EXPR_BASE
+ ( + result:LIP_CODE;
+
+ (read_identifier).if {
+ result := LIP_CALL.create current_position name last_string with NULL;
+ } else {
+ result := readlip_expr_base;
+ };
+ result
+ );
+
+ //
+ // Parser for FORMAT.LI
+ //
+
+ //|| FORMAT -> { '-' identifier ':=' SHORT_DEF ';' }
+ - read_format <-
+ ( + def:LINKED_LIST(STRING_CONSTANT);
+
+ {read_character '-'}.while_do {
+ (read_identifier).if_false {
+ syntax_error (current_position,"Incorrect slot identifier.");
+ };
+ def := LINKED_LIST(STRING_CONSTANT).create;
+ (short_dico.fast_has last_string).if {
+ syntax_error (current_position,"Double definition slot.");
+ };
+ short_dico.fast_put def to last_string;
+ (read_symbol (ALIAS_STR.symbol_affect_immediate)).if_false {
+ syntax_error (current_position,"Assignment ':=' is needed.");
+ };
+ (read_short_def def).if_false {
+ syntax_error (current_position,"Incorrect definition.");
+ };
+ (read_character ';').if_false {
+ warning_error (current_position,"Added ';' is needed.");
+ };
+ };
+
+ // End of file :
+ read_space;
+ (last_character != 0.to_character).if {
+ syntax_error (current_position,"Incorrect symbol.");
+ };
+ );
+
+ //|| SHORT_DEF -> { SHORT_ELT '+' } SHORT_ELT
+ - read_short_def def:LINKED_LIST(STRING_CONSTANT) :BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ read_short_elt.if {
+ result := TRUE;
+ def.add_last last_string;
+ {read_character '+'}.while_do {
+ (read_short_elt).if_false {
+ syntax_error (current_position,"Incorrect format expression.");
+ };
+ def.add_last last_string;
+ };
+ };
+ result
+ );
+
+ //|| SHORT_ELT -> "token" | string
+ - read_short_elt:BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ read_identifier.if {
+ (last_string != ALIAS_STR.short_token).if {
+ warning_error (current_position,"Variable not `token'.");
+ };
+ last_string := NULL;
+ result := TRUE;
+ }.elseif {read_string} then {
+ string_tmp.clear;
+ j := last_string.lower;
+ {j <= last_string.upper}.while_do {
+ (last_string.item j = '\\').if {
+ j := j+1;
+ last_string.item j
+ .when 'a' then { string_tmp.add_last '\a'; }
+ .when 'b' then { string_tmp.add_last '\b'; }
+ .when 'f' then { string_tmp.add_last '\f'; }
+ .when 'n' then { string_tmp.add_last '\n'; }
+ .when 'r' then { string_tmp.add_last '\r'; }
+ .when 't' then { string_tmp.add_last '\t'; }
+ .when 'v' then { string_tmp.add_last '\v'; }
+ .when '\\' then { string_tmp.add_last '\\'; }
+ .when '?' then { string_tmp.add_last '\?'; }
+ .when '\'' then { string_tmp.add_last '\''; }
+ .when '\"' then { string_tmp.add_last '\"'; };
+ } else {
+ string_tmp.add_last (last_string.item j);
+ };
+ j := j+1;
+ };
+ last_string := ALIAS_STR.get string_tmp;
+ result := TRUE;
+ };
+ result
+ );
+
+Section Public
+
+ //
+ // Parser Entry.
+ //
+
+ - go_on obj:PROTOTYPE <-
+ (
+ ? { object=NULL};
+
+ // Source information.
+ object := obj;
+ source := obj.source;
+ position := source.lower;
+ pos_cur := source.lower;
+ pos_line := 1;
+ pos_col := 0;
+
+ (is_shorter).if {
+ is_active_short := TRUE;
+ short_derive := 0;
+ output_code.copy source;
+ short_local := HASHED_SET(STRING_CONSTANT).create;
+ short (ALIAS_STR.short_begin) token 1 to 1;
+ };
+
+ // Parse.
+ (! read_program).if {
+ syntax_error (current_position,"Incorrect symbol.");
+ };
+
+ short (ALIAS_STR.short_end) token (source.upper) to (source.upper);
+
+ object := NULL; // Parser is Free (see require test...)
+ );
+
+ - read_lip path_lip:STRING_CONSTANT :BOOLEAN <-
+ ( + entry:POINTER;
+
+ entry := FS_MIN.open_read path_lip;
+ (entry != NULL).if {
+ FS_MIN.close entry;
+ object := PROTOTYPE.create path_lip
+ name path_lip generic_count 0;
+
+ source := object.source;
+ position := source.lower;
+ pos_cur := source.lower;
+ pos_line:=1;
+ pos_col :=0;
+
+ // Parse.
+ readlip_program;
+ //
+ object := NULL; // Parser is Free (see require test...)
+ }
+ );
+
+ - parse_format fmt_name:STRING_CONSTANT <-
+ (
+ // Source information.
+ (FILE_SYSTEM.get_entry fmt_name = NULL).if {
+ STD_ERROR.put_string "Error: File format `";
+ STD_ERROR.put_string fmt_name;
+ STD_ERROR.put_string "' is not open !\n";
+ die_with_code exit_failure_code;
+ };
+
+ object := PROTOTYPE.create fmt_name
+ name (ALIAS_STR.short_format)
+ generic_count 0;
+
+ source := object.source;
+ position := source.lower;
+ pos_cur := source.lower;
+ pos_line := 1;
+ pos_col := 0;
+
+ // Parse.
+ read_format;
+
+ object := NULL; // Parser is Free (see require test...)
+ );
+
+
diff --git a/src2/path.h b/src2/path.h
new file mode 100755
index 0000000..8717230
--- /dev/null
+++ b/src2/path.h
@@ -0,0 +1 @@
+#define LISAAC_DIRECTORY "/home/sonntag/compiler"
diff --git a/src2/profil.li b/src2/profil.li
new file mode 100644
index 0000000..3edb176
--- /dev/null
+++ b/src2/profil.li
@@ -0,0 +1,575 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROFIL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Method with costumization";
+
+Section Inherit
+
+ + parent_any:Expanded ANY;
+
+Section PROFIL_LIST
+
+ + life_index:INTEGER;
+
+ - set_life_index idx:INTEGER <-
+ (
+ life_index := idx;
+ );
+
+Section Public
+
+ - slot:SLOT <- deferred;
+
+ - is_interrupt:BOOLEAN;
+
+ - is_external:BOOLEAN;
+
+ + type_self:TYPE_FULL;
+
+ + argument_list:FAST_ARRAY(LOCAL);
+
+ + result_list:Expanded SLIM_ARRAY(LOCAL);
+
+ + code:LIST;
+ + context:LOCAL;
+
+ + count_intern_call:INTEGER;
+
+ + link_count:INTEGER;
+ + cop_link_count:INTEGER;
+
+ + name:STRING_CONSTANT;
+
+ - is_context_sensitive:BOOLEAN <- deferred;
+
+ + stat:INTEGER_8 := -1;
+ // 00 : No recursive, No inlinable.
+ // 01 : No recursive, Inlinable.
+ // 10 : Recusive, No tail.
+ // 11 : Recusive, Tail
+
+ - recursivity_bit:INTEGER_8 := 10b;
+ - tail_bit:INTEGER_8 := 01b;
+ - inlining_bit:INTEGER_8 := 01b;
+
+ - is_tail_recursive:BOOLEAN <- stat = 11b;
+ - is_not_tail_recursive:BOOLEAN <- stat = 10b;
+ - is_inlinable:BOOLEAN <- stat = 01b;
+ - is_recursive:BOOLEAN <- (stat & recursivity_bit) != 0;
+
+ //
+
+ - mode_recursive:BOOLEAN;
+
+ - set_mode_recursive b:BOOLEAN <-
+ (
+ mode_recursive := b;
+ );
+
+ - set_life <-
+ (
+ PROFIL_LIST.set_life Self;
+ (mode_recursive).if {
+ execute_recursive;
+ };
+ );
+
+ - link call:CALL_SLOT <-
+ (
+ (call.cop_argument != NULL).if {
+ cop_link_count := cop_link_count + 1;
+ } else {
+ link_count := link_count + 1;
+ };
+ );
+
+ - unlink call:CALL_SLOT <-
+ (
+ (call.cop_argument != NULL).if {
+ cop_link_count := cop_link_count - 1;
+ ? {cop_link_count >= 0};
+ } else {
+ link_count := link_count - 1;
+ ? {link_count >= 0};
+ };
+ );
+
+ - write_argument args:FAST_ARRAY(EXPR) :FAST_ARRAY(WRITE) <-
+ ( + loc:LOCAL;
+ + val:EXPR;
+ + wrt:WRITE;
+ + result:FAST_ARRAY(WRITE);
+
+ (args.count != argument_list.count).if {
+ semantic_error (args.last.position,"Incorrect vector size.");
+ };
+
+ result := FAST_ARRAY(WRITE).create_with_capacity (argument_list.count);
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ loc := argument_list.item j;
+ val := args.item j;
+ (loc != NULL).if {
+ wrt := loc.write (val.position) value val;
+ result.add_last wrt;
+ } else {
+ result.add_last NULL;
+ val.remove;
+ };
+ };
+ result
+ );
+
+ //
+ // Comparaison.
+ //
+
+ - compatibility_with other:PROFIL <-
+ ( + n1,n2:INTEGER;
+ (argument_list.count != other.argument_list.count).if {
+ POSITION.put_error semantic text "Incorrect vector size argument.";
+ code.position.put_position;
+ other.code.position.put_position;
+ POSITION.send_error;
+ };
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ (argument_list.item j.type != other.argument_list.item j.type).if {
+ POSITION.put_error semantic text "Incorrect invariant type argument.";
+ argument_list.item j.position.put_position;
+ other.argument_list.item j.position.put_position;
+ POSITION.send_error;
+ };
+ };
+ (result_list.count != other.result_list.count).if {
+ POSITION.put_error semantic text "Incorrect vector size result.";
+ code.position.put_position;
+ other.code.position.put_position;
+ POSITION.send_error;
+ };
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ (result_list.item j.type != other.result_list.item j.type).if {
+ POSITION.put_error semantic text "Incorrect invariant type result.";
+ result_list.item j.position.put_position;
+ other.result_list.item j.position.put_position;
+ POSITION.send_error;
+ };
+ };
+ );
+
+ - lookup n:STRING_CONSTANT :LOCAL <-
+ ( + j:INTEGER;
+ + result:LOCAL;
+
+ j := argument_list.lower;
+ {(j > argument_list.upper) || {argument_list.item j.name = n}}.until_do {
+ j := j + 1;
+ };
+ (j <= argument_list.upper).if {
+ result := argument_list.item j;
+ } else {
+ j := result_list.lower;
+ {(j > result_list.upper) || {result_list.item j.name = n}}.until_do {
+ j := j + 1;
+ };
+ (j <= result_list.upper).if {
+ result := result_list.item j;
+ };
+ };
+
+ result
+ );
+
+ //
+ // Execute.
+ //
+
+ - remove_inline <-
+ (
+ PROFIL_LIST.remove Self;
+ );
+
+ - remove <-
+ (
+ code.remove;
+ );
+
+ - search_tail_recursive:BOOLEAN <-
+ ( + switch:SWITCH;
+ + msg:CALL_SLOT;
+ + lst:LIST;
+ + count_recur:INTEGER;
+ + result:BOOLEAN;
+
+ (
+ (! mode_recursive) &&
+ {is_not_tail_recursive} &&
+ {! code.is_empty}
+ ).if {
+ switch ?= code.last;
+ (switch != NULL).if {
+ // Verification des cases :
+ (switch.list.lower).to (switch.list.upper) do { j:INTEGER;
+ lst := switch.list.item j.code;
+ (lst.is_empty).if_false {
+ msg ?= lst.last;
+ ((msg != NULL) && {msg.profil = Self}).if {
+ count_recur := count_recur + 1;
+ };
+ };
+ };
+ (count_recur = switch.list.count).if {
+ semantic_error (slot.position,"Recursivity without end.");
+ };
+ (count_recur = switch.list.count - 1).if {
+ ((count_intern_call - 1) = count_recur).if {
+ (link_count = count_intern_call).if {
+ result := TRUE;
+ stat := stat | tail_bit;
+ };
+ };
+ };
+ };
+ };
+ result
+ );
+
+ - i_am_the_last i:INSTR :BOOLEAN <-
+ (
+ code.i_am_the_last i
+ );
+
+ - execute_recursive <-
+ ( + old_list_current:LIST;
+
+ (stat = -1).if {
+ count_intern_call := count_intern_call + 1;
+ (count_intern_call = 1).if {
+ old_list_current := list_current;
+ //
+ execute 3;
+ //
+ list_current := old_list_current;
+ ? {code != NULL};
+ (count_intern_call = 1).if {
+ stat := 0;
+ } else {
+ stat := recursivity_bit;
+ };
+ };
+ };
+ );
+
+ - execute inline_lev:INTEGER <-
+ ( + old_seq_inline:UINTEGER_32;
+
+ list_current := NULL;
+ old_seq_inline := seq_inline;
+
+ CALL_SLOT.reset_count_context_sensitive;
+
+ seq_call_and_loop := seq_call_and_loop + 1;
+
+ code ?= code.execute;
+
+ // BSBS: Netoyer les result pas utile
+
+ LOCAL_SEQ.clear;
+
+ seq_call_and_loop := seq_call_and_loop + 1;
+
+ (
+ (CALL_SLOT.count_context_sensitive = 0) &&
+ {! mode_recursive} &&
+ {stat = 0} &&
+ {is_context_sensitive || {(seq_inline - old_seq_inline) < inline_lev}}
+ ).if {
+ stat := stat | inlining_bit;
+ new_execute_pass;
+ };
+ );
+
+ //
+ // Genere.
+ //
+
+ - is_static:BOOLEAN <- deferred;
+
+ - genere_handler buffer:STRING <-
+ (
+ (link_count != 0).if {
+ genere_handler_intern buffer;
+ buffer.append ";\n";
+ };
+ ((cop_link_count != 0) && {result_list.count = 0}).if {
+ genere_handler_cop buffer;
+ buffer.append ";\n";
+ };
+ );
+
+ - genere_handler_intern buffer:STRING <-
+ ( + ts:TYPE_FULL;
+ + v:LOCAL;
+
+ (is_static).if {
+ buffer.append "static ";
+ };
+
+ // Result.
+ (result_list.is_empty).if {
+ buffer.append "void ";
+ } else {
+ ts := result_list.first.type;
+ ts.genere_declaration buffer;
+ ts.genere_star_declaration buffer;
+ buffer.add_last ' ';
+ };
+
+ // Name.
+ buffer.append name;
+ buffer.add_last '(';
+
+ // Arguments.
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ v := argument_list.item j;
+ (v != NULL).if {
+ ? {v.style = ' '};
+
+ (v.style != ' ').if {
+ semantic_error (v.position,"BUG PROFIL.genere_handler Error");
+ };
+ genere v result FALSE in buffer;
+ buffer.add_last ',';
+ };
+ };
+
+ // Results.
+ (result_list.lower + 1).to (result_list.upper) do { j:INTEGER;
+ v := result_list.item j;
+ v.set_ensure_count (-1);
+ v.set_result TRUE;
+ genere v result TRUE in buffer;
+ buffer.add_last ',';
+ };
+ (buffer.last = ',').if {
+ buffer.remove_last 1;
+ };
+ buffer.add_last ')';
+ );
+
+ - genere_handler_cop buffer:STRING <-
+ (
+ buffer.append "lith_object *COP_";
+ buffer.append name;
+ buffer.append "(lith_object *obj,pthread_mutex_t *mutex)";
+ );
+
+ - genere buffer:STRING <-
+ ( + loc:LOCAL;
+ + t,ts:TYPE_FULL;
+ + v:LOCAL;
+ + np:INTEGER;
+ + low:INTEGER;
+
+ ((link_count != 0) || {result_list.count != 0}).if {
+ ((cop_link_count != 0) && {result_list.count = 0}).if {
+ // COP link.
+ not_yet_implemented;
+ buffer.add_last '\n';
+ genere_handler_cop buffer;
+ buffer.append "\n{ ";
+
+ buffer.append " self;\n\
+ \ self = ";
+ buffer.append "ptr;\n\
+ \ pthread_mutex_lock (&(self->mutex));\n\
+ \ pthread_setspecific(current_thread,self);\n ";
+ buffer.append name;
+ buffer.append "(self);\n";
+ buffer.append " pthread_mutex_unlock (&(self->mutex));\n\
+ \ return(NULL);\n\
+ \};\n";
+ };
+ // Version normal.
+ buffer.add_last '\n';
+ genere_handler_intern buffer;
+ buffer.add_last '\n';
+ add_comment buffer;
+ //
+ buffer.append "{\n";
+ indent.append " ";
+ code.genere_extern buffer;
+ (result_list.is_empty).if_false {
+ loc := result_list.first;
+ buffer.append indent;
+ buffer.append "return(";
+ t := loc.type;
+ (
+ (t.is_expanded) &&
+ {! t.is_expanded_ref} &&
+ {! t.is_expanded_c}
+ ).if {
+ buffer.add_last '&';
+ };
+ buffer.append (loc.intern_name);
+ buffer.append ");\n";
+ };
+ // End.
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.append "}\n";
+ } else {
+ // COP direct.
+ buffer.add_last '\n';
+ genere_handler_cop buffer;
+ buffer.add_last '\n';
+ add_comment buffer;
+ //
+ buffer.append "{\n";
+ indent.append " ";
+ (argument_list.count > 0).if {
+ buffer.append indent;
+ v := argument_list.first;
+ ((v != NULL) && {v.name = ALIAS_STR.variable_self}).if {
+ genere v result FALSE in buffer;
+ buffer.add_last '=';
+ put_cast_self buffer;
+ buffer.append "obj;\n";
+ low := 1;
+ };
+ };
+ (argument_list.count-low > 0).if {
+ (low).to (argument_list.upper) do { j:INTEGER;
+ v := argument_list.item j;
+ (v != NULL).if {
+ buffer.append indent;
+ genere v result FALSE in buffer;
+ buffer.append "=(";
+ ts := v.type;
+ ts.genere_declaration buffer;
+ buffer.add_last ' ';
+ ts.genere_star_declaration buffer;
+ buffer.append ")((";
+ put_cast_self buffer;
+ buffer.append "obj)->param_";
+ np.append_in buffer;
+ buffer.append ");\n";
+ np := np + 1;
+ };
+ };
+ type_self.raw.set_param np;
+ };
+ buffer.append " pthread_mutex_unlock(&obj->mutex);\n";
+ buffer.append " pthread_mutex_lock(mutex);\n";
+ //
+ name.print; '\n'.print;
+
+ code.genere_extern buffer;
+ //
+ buffer.append " return NULL;\n}\n";
+ indent.remove_last 2;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append (slot.name);
+ append_type buffer;
+ );
+
+ - display_all buffer:STRING <-
+ (
+ display buffer;
+ code.display buffer;
+ buffer.append "\n---------------------\n";
+ );
+
+Section Private
+
+ - put_cast_self buffer:STRING <-
+ (
+ buffer.add_last '(';
+ type_self.genere_declaration buffer;
+ buffer.add_last ' ';
+ type_self.genere_star_declaration buffer;
+ buffer.add_last ')';
+ );
+
+ - add_comment buffer:STRING <-
+ (
+ buffer.append "// ";
+ append_type buffer;
+ ((stat & 10b) = 0).if {
+ buffer.append "No recursive, ";
+ } else {
+ buffer.append "Recursive, ";
+ };
+ ((stat & 01b) = 0).if {
+ buffer.append "No inlinable.";
+ } else {
+ buffer.append "Inlinable.";
+ };
+ buffer.add_last '\n';
+ );
+
+ - append_type buffer:STRING <-
+ ( + v:VARIABLE;
+
+ buffer.add_last '(';
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ v := argument_list.item j;
+ (v != NULL).if {
+ v.display_type buffer;
+ buffer.add_last ',';
+ };
+ };
+ (buffer.last = ',').if {
+ buffer.remove_last 1;
+ };
+ buffer.add_last ')';
+ (result_list.is_empty).if {
+ buffer.append " Void ";
+ } else {
+ buffer.append " With result ";
+ };
+ );
+
+ - genere v:LOCAL result is_res:BOOLEAN in buffer:STRING <-
+ ( + ts:TYPE_FULL;
+
+ ts := v.type;
+ ts.genere_declaration buffer;
+ buffer.add_last ' ';
+ ts.genere_star_declaration buffer;
+ (is_res).if {
+ buffer.add_last '*';
+ };
+ buffer.append (v.intern_name);
+ );
\ No newline at end of file
diff --git a/src2/profil_block.li b/src2/profil_block.li
new file mode 100644
index 0000000..582ec8e
--- /dev/null
+++ b/src2/profil_block.li
@@ -0,0 +1,378 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROFIL_BLOCK;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Method with costumization";
+
+Section Inherit
+
+ + parent_profil:Expanded PROFIL;
+
+ + parent_type:Expanded TYPE;
+
+Section Public
+
+ - slot:SLOT <-
+ (
+ crash_with_message "PROFIL_BLOCK.slot";
+ NULL
+ );
+
+ - type_c:STRING_CONSTANT <- type_block.intern_name;
+
+ + to_type_block:TYPE_BLOCK;
+
+ + slot_self:SLOT_DATA;
+ + slot_value:SLOT_DATA;
+
+ - inc_id <-
+ (
+ slot_value.set_ensure_count (slot_value.ensure_count + 1);
+ );
+
+ - dec_id <-
+ (
+ slot_value.set_ensure_count (slot_value.ensure_count - 1);
+ ? {slot_value.ensure_count >= 0};
+ );
+
+ + context_extern:LOCAL;
+
+ + profil_list:FAST_ARRAY(PROFIL_SLOT);
+ + node_list:LINKED_LIST(NODE_TYPE);
+
+ - is_context_sensitive:BOOLEAN <- context_extern != NULL;
+
+ //
+ // Creation.
+ //
+
+ - create base:ITM_BLOCK :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make base;
+ result
+ );
+
+ - make base:ITM_BLOCK <-
+ ( + list:ITM_LIST;
+ + old_node_list:LINKED_LIST(NODE_TYPE);
+ + var:LOCAL;
+ + old_list:LIST;
+ + old_profil:PROFIL;
+ + result:EXPR;
+ + mul:EXPR_MULTIPLE;
+ + rd:READ_LOCAL;
+ + a_list:FAST_ARRAY(TYPE_FULL);
+ + r_list:FAST_ARRAY(TYPE_FULL);
+ + stack_top:INTEGER;
+
+ list := base.list;
+ stack_top := stack_local .upper + 1;
+
+ PROFIL_LIST.add Self;
+ type_self := ITM_TYPE_SIMPLE.type_self.to_run_for profil_slot;
+ default := TYPE_FULL.create Self with (
+ TYPE_FULL.expanded_bit | TYPE_FULL.default_expanded_bit
+ );
+ //
+ slot_self := SLOT_DATA.clone;
+ slot_self.make (list.position) name (ALIAS_STR.slot_self) style '+' base NULL type type_self;
+ slot_self.set_intern_name (ALIAS_STR.slot_self);
+ //
+ slot_value := SLOT_DATA.clone;
+ slot_value.make (list.position) name (ALIAS_STR.slot_id) style '+' base NULL type default;
+ slot_value.set_intern_name (ALIAS_STR.slot_id);
+ //
+ profil_list := FAST_ARRAY(PROFIL_SLOT).create_with_capacity 2;
+ node_list := LINKED_LIST(NODE_TYPE).create;
+ old_node_list := NODE.node_list;
+ NODE.set_node_list node_list;
+
+ // index TYPE
+ index := index_count;
+ index_count := index_count + 1;
+
+ // Name : value
+ name := ALIAS_STR.get_intern (ALIAS_STR.slot_value);
+
+ // Create code.
+ old_profil := profil_current;
+ old_list := list_current;
+ profil_current := Self;
+ list_current := LIST.create (list.position);
+ ITM_OBJECT.set_context_extern NULL;
+ // Add context debug.
+ (debug_level_option != 0).if {
+ context := TYPE_CONTEXT.default.new_local (list.position)
+ name (ALIAS_STR.variable_context) style '+';
+ context.set_ensure_count 1;
+ list_current.add_last (PUSH.create (list.position) context context first TRUE);
+ };
+
+ // Append arguments.
+ a_list := ALIAS_ARRAY(TYPE_FULL).new;
+ (base.argument != NULL).if {
+ argument_list := FAST_ARRAY(LOCAL).create_with_capacity (base.argument.count+1);
+ argument_list.add_last NULL;
+ base.argument.to_run_in argument_list for profil_slot;
+ 1.to (argument_list.upper) do { j:INTEGER;
+ a_list.add_last (argument_list.item j.type);
+ };
+ } else {
+ argument_list := FAST_ARRAY(LOCAL).create 1;
+ };
+ var := LOCAL.create (list.position) name (ALIAS_STR.variable_self) style ' ' type type_self;
+
+ argument_list.put var to 0;
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ stack_local.add_last (argument_list.item j);
+ };
+ a_list := ALIAS_ARRAY(TYPE_FULL).alias a_list;
+ //
+ code := list_current;
+ //
+ result := list.to_run_expr;
+ // Result.
+ r_list := ALIAS_ARRAY(TYPE_FULL).new;
+ (result.static_type.raw != TYPE_VOID).if {
+ mul ?= result;
+ (mul != NULL).if {
+ result_list.make_with_capacity (mul.count);
+ (mul.lower).to (mul.upper) do { j:INTEGER;
+ rd ?= mul.item j;
+ var := rd.local;
+ result_list.add_last var;
+ r_list.add_last (var.type);
+ };
+ } else {
+ rd ?= result;
+ var := rd.local;
+ result_list.add_last var;
+ r_list.add_last (var.type);
+ };
+ };
+ result.remove; // BSBS: Il y a un petit gachi...
+ r_list := ALIAS_ARRAY(TYPE_FULL).alias r_list;
+ //
+ context_extern := ITM_OBJECT.context_extern;
+ to_type_block := TYPE_BLOCK.get_direct a_list and_result r_list;
+ stack_local.remove_since stack_top;
+ //
+ NODE.set_node_list old_node_list;
+ profil_current := old_profil;
+ list_current := old_list;
+ );
+
+ //
+ // Genere Profil.
+ //
+
+ - is_static:BOOLEAN <- TRUE;
+
+ - genere_handler_intern buffer:STRING <-
+ (
+ (is_context_sensitive).if {
+ warning_error (code.position,
+ "Compiler limit : This block is context sensitive, and \
+ \evaluation too far away from the context."
+ );
+ };
+ parent_profil.genere_handler_intern buffer;
+ );
+
+ //
+ // TYPE BLOCK.
+ //
+
+ - intern_name:STRING_CONSTANT <- name;
+
+ - write_argument args:FAST_ARRAY(EXPR) :FAST_ARRAY(WRITE) <-
+ ( + rd:READ;
+ + rec:EXPR;
+
+ rec := args.first;
+ rd := slot_self.read (rec.position) with rec;
+ args.put rd to 0;
+ parent_profil.write_argument args
+ );
+
+ - set_late_binding <-
+ (
+ type_block.set_late_binding;
+ );
+
+ - link call:CALL_SLOT <-
+ (
+ (link_count = 0).if {
+ NODE.node_list.append_collection node_list;
+ };
+ link_count := link_count + 1;
+ );
+
+ - get_expr_result:EXPR <-
+ ( + result:EXPR;
+ + lst:FAST_ARRAY(EXPR);
+ + loc:LOCAL;
+
+ (result_list.count > 1).if {
+ lst := FAST_ARRAY(EXPR).create_with_capacity (result_list.count);
+ (result_list.lower).to (result_list.upper) do { k:INTEGER;
+ loc := result_list.item k;
+ lst.add_last (loc.type.get_temporary_expr (loc.position));
+ };
+ result := EXPR_MULTIPLE.create lst;
+ }.elseif {result_list.count = 1} then {
+ loc := result_list.first;
+ result := loc.type.get_temporary_expr (loc.position);
+ } else {
+ result := PROTOTYPE_CST.create (code.position) type (TYPE_VOID.default); //BSBS: Alias.
+ };
+ result
+ );
+
+ - is_block:BOOLEAN := TRUE;
+
+ - Self:SELF '==' Right 60 other:TYPE :BOOLEAN <-
+ (
+ other = to_type_block
+ );
+
+ - append_name_in buf:STRING <-
+ (
+ buf.add_last '{';
+ (argument_list.count > 1).if {
+ (argument_list.count > 2).if {
+ buf.add_last '(';
+ (argument_list.lower+1).to (argument_list.upper-1) do { j:INTEGER;
+ argument_list.item j.type.display buf;
+ buf.add_last ',';
+ };
+ argument_list.last.type.display buf;
+ buf.add_last ')';
+ } else {
+ argument_list.last.type.display buf;
+ };
+ buf.add_last ';';
+ buf.add_last ' ';
+ };
+ (result_list.lower).to (result_list.upper-1) do { j:INTEGER;
+ result_list.item j.type.display buf;
+ buf.add_last ',';
+ };
+ (result_list.is_empty).if_false {
+ result_list.last.type.display buf;
+ };
+ buf.add_last '}';
+ // Debug
+ buf.append "(PROFIL_BLOCK)";
+ );
+
+ - prototype:PROTOTYPE <- type_block.prototype;
+
+ - subtype_list:HASHED_SET(TYPE) <- type_block.subtype_list;
+ - add_subtype t:TYPE <- type_block.add_subtype t;
+
+ - get_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_slot n
+ );
+
+ - get_local_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_local_slot n
+ );
+
+ - get_path_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_path_slot n
+ );
+
+ - genere_struct <-
+ (
+ // Nothing.
+ );
+
+ //
+ // Code source generation.
+ //
+
+ - put_id buffer:STRING <- index.append_in buffer;
+
+ - put_access_id e:EXPR in buffer:STRING <-
+ (
+ e.genere buffer;
+ buffer.append ".__id";
+ );
+
+ - put_value buffer:STRING <-
+ (
+ index.append_in buffer;
+ );
+
+ - put_expanded_declaration buffer:STRING <-
+ (
+ // BSBS: A revoir car c'est un gros bordel entre PROFIL_BLOCK et TYPE_BLOCK!
+ buffer.append "__";
+ buffer.append type_c;
+ );
+
+Section Public
+ /*
+ - to_run_for p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ (
+ "PROFIL BLOCK\n".print;
+ NULL
+ );
+ */
+
+ - is_sub_type other:TYPE :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + t:TYPE_BLOCK;
+
+ result := Self == other;
+ (result).if_false {
+ t ?= other;
+ result := (
+ (t != NULL) &&
+ {t.argument_list = to_type_block.argument_list} &&
+ {to_type_block.is_sub_type_result t}
+ );
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append "BLOCK SEND ";
+ append_type buffer;
+ );
diff --git a/src2/profil_list.li b/src2/profil_list.li
new file mode 100644
index 0000000..c0e13f7
--- /dev/null
+++ b/src2/profil_list.li
@@ -0,0 +1,193 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROFIL_LIST;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Profil list manager.";
+
+Section Inherit
+
+ + parent_any:Expanded ANY;
+
+Section Private
+
+ - profil_list:FAST_ARRAY(PROFIL) := FAST_ARRAY(PROFIL).create_with_capacity 65536;
+
+ - life_limit:INTEGER;
+
+ - current:INTEGER;
+
+ - swap i1:INTEGER with i2:INTEGER <-
+ (
+ profil_list.item i2.set_life_index i1;
+ profil_list.item i1.set_life_index i2;
+ profil_list.swap i1 with i2;
+ );
+
+ - clean <-
+ (
+ reduce_profil := profil_list.upper >= life_limit;
+ {profil_list.upper >= life_limit}.while_do {
+ profil_list.last.remove;
+ ! {profil_list.last.set_life_index (-1)};
+ profil_list.remove_last;
+ };
+ );
+
+Section Public
+
+ - reduce_profil:BOOLEAN := TRUE;
+
+ - add p:PROFIL <-
+ (
+ profil_list.add_last p;
+ p.set_life_index (profil_list.upper);
+ );
+
+ - set_life p:PROFIL <-
+ [
+ -? { p.life_index != -1 };
+ -? { profil_list.item (p.life_index) = p };
+ ]
+ ( + idx:INTEGER;
+
+ idx := p.life_index;
+ (idx = life_limit).if {
+ life_limit := life_limit + 1;
+ }.elseif {idx > life_limit} then {
+ swap idx with life_limit;
+ life_limit := life_limit + 1;
+ };
+ )
+ [
+ +? { profil_list.item (p.life_index) = p };
+ +? { p.life_index < life_limit };
+ ];
+
+ - unset_life p:PROFIL <-
+ [
+ -? { p.life_index != -1 };
+ ]
+ ( + idx:INTEGER;
+
+ idx := p.life_index;
+ (idx < life_limit).if {
+ life_limit := life_limit - 1;
+ (idx < life_limit).if {
+ (idx > current).if {
+ swap idx with life_limit;
+ } else {
+ swap idx with current;
+ swap current with life_limit;
+ current := current - 1;
+ };
+ };
+ };
+ );
+
+ - remove p:PROFIL <-
+ [
+ -? { p.life_index != -1 };
+ ]
+ ( + idx:INTEGER;
+
+ unset_life p;
+ idx := p.life_index;
+ (idx != profil_list.upper).if {
+ swap idx with (profil_list.upper);
+ };
+ profil_list.remove_last;
+ // Debug.
+ ! {p.set_life_index (-1)};
+ );
+
+ - execute_pass_recursive <-
+ (
+ VARIABLE.update;
+ life_limit := 0;
+ PROFIL.set_mode_recursive TRUE;
+ profil_current := profil_slot := NULL;
+ list_current := NULL;
+ list_main.execute;
+ PROFIL.set_mode_recursive FALSE;
+ clean;
+ reduce_profil := TRUE;
+ );
+
+ - inline_level_current:INTEGER := 3;
+
+ - execute_pass <-
+ (
+ VARIABLE.update;
+ life_limit := 0;
+ profil_slot := NULL;
+ list_current := NULL;
+ list_main.execute;
+ current := profil_list.lower;
+ {current < life_limit}.while_do {
+ profil_current := profil_list.item current;
+ profil_current.execute inline_level_current;
+ current := current + 1;
+ };
+ current := 0;
+ clean;
+ ((! reduce_profil) && {inline_level_current < inline_level}).if {
+ inline_level_current := inline_level_current + 3;
+ new_execute_pass;
+ };
+ );
+
+ //
+ // Genere.
+ //
+
+ - genere_handler buffer:STRING <-
+ (
+ (profil_list.lower).to (profil_list.upper) do { j:INTEGER;
+ profil_list.item j.genere_handler buffer;
+ };
+ );
+
+ - genere buffer:STRING <-
+ (
+ (profil_list.lower).to (profil_list.upper) do { j:INTEGER;
+ profil_list.item j.genere buffer;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display <-
+ (
+ string_tmp.clear;
+ (profil_list.upper).downto (profil_list.lower) do { j:INTEGER;
+ profil_list.item j.display_all string_tmp;
+ };
+ string_tmp.print;
+ );
+
\ No newline at end of file
diff --git a/src2/profil_slot.li b/src2/profil_slot.li
new file mode 100644
index 0000000..245ca98
--- /dev/null
+++ b/src2/profil_slot.li
@@ -0,0 +1,182 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROFIL_SLOT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Method with costumization";
+
+Section Inherit
+
+ + parent_profil:Expanded PROFIL;
+
+ - parent_parameter_to_type:Expanded PARAMETER_TO_TYPE;
+
+Section Public
+
+ - position:POSITION <- slot.position;
+
+ - slot:SLOT <- slot_code;
+
+ - is_interrupt:BOOLEAN <- slot_code.id_section.is_interrupt;
+ - is_external:BOOLEAN <- slot_code.id_section.is_external;
+
+ + slot_code:SLOT_CODE;
+
+ + is_context_sensitive:BOOLEAN;
+ // BSBS: Le bloc passé en argument peux ne pas etre context sensitive
+ // Et puis, cet stat peu changer dans le temps...
+
+ - set_context_sensitive <-
+ (
+ is_context_sensitive := TRUE;
+ );
+
+ //
+ // Creation.
+ //
+
+ - arg_type_tmp:FAST_ARRAY(EXPR);
+ - parameter_to_type p:ITM_TYPE_PARAMETER :TYPE_FULL <-
+ ( + idx:INTEGER;
+ + result:TYPE_FULL;
+
+ (p.name = ALIAS_STR.prototype_self).if {
+ // For Self.
+ result := type_self;
+ } else {
+ // For Genericity.
+ result := type_self.raw.parameter_to_type p;
+ (result = NULL).if {
+ // For Type parametric.
+ idx := slot_code.get_index_argument_type p;
+ (idx != - 1).if {
+ result := arg_type_tmp.item idx.static_type;
+ };
+ };
+ };
+
+ result
+ );
+
+ - make s:SLOT_CODE
+ with (typ_self:TYPE_FULL,call_lst:FAST_ARRAY(EXPR))
+ verify is_first:BOOLEAN :FAST_ARRAY(WRITE) <-
+ [
+ -? {typ_self != NULL};
+ ]
+ ( + loc:LOCAL;
+ + typ:TYPE_FULL;
+ + item_lst:FAST_ARRAY(ITM_ARGUMENT);
+ + result:FAST_ARRAY(WRITE);
+ + tm:ITM_TYPE_MULTI;
+ + ts:ITM_TYPE_MONO;
+
+ PROFIL_LIST.add Self;
+
+ (s.id_section.is_external).if {
+ name := s.name;
+ } else {
+ name := ALIAS_STR.get_intern (s.name);
+ };
+ slot_code := s;
+ type_self := typ_self;
+ //
+ list_current := LIST.create (s.position);
+ profil_current := profil_slot := Self;
+ //
+ (debug_level_option != 0).if {
+ // Debug mode : Add context local.
+ context := TYPE_CONTEXT.default.new_local (s.position)
+ name (ALIAS_STR.variable_context) style '+';
+ context.set_ensure_count 1;
+ list_current.add_last (PUSH.create (slot_code.position) context context first TRUE);
+ };
+ //
+ code := list_current;
+ arg_type_tmp := call_lst;
+ //
+ // Arguments.
+ item_lst := s.argument_list;
+ argument_list := FAST_ARRAY(LOCAL).create_with_capacity (s.argument_count);
+ (item_lst.lower).to (item_lst.upper) do { j:INTEGER;
+ item_lst.item j.to_run_in argument_list for Self;
+ };
+
+ ((s.id_section.is_external) && {argument_list.count > 1}).if {
+ (argument_list.lower+1).to (argument_list.upper) do { j:INTEGER;
+ loc := argument_list.item j;
+ loc.set_ensure_count 1;
+ loc.write (loc.position) value (
+ EXTERNAL_C.create (loc.position) text "/* External slot */"
+ access NULL persistant FALSE type (loc.type)
+ );
+ };
+ };
+
+ // Results
+ tm ?= s.result_type;
+ (tm != NULL).if {
+ result_list.make_with_capacity (tm.count);
+ (tm.lower).to (tm.upper) do { k:INTEGER;
+ typ := tm.item k.to_run_for Self;
+ loc := typ.get (s.position) result (k+1);
+ result_list.add_last loc;
+ };
+ } else {
+ ts ?= s.result_type;
+ (ts != ITM_TYPE_SIMPLE.type_void).if {
+ typ := ts.to_run_for Self;
+ result_list.add_last (typ.get (s.position) result 0);
+ };
+ };
+ //
+ result := write_argument call_lst;
+ //
+ slot_code.create_code is_first;
+ //
+ result
+ );
+
+ //
+ // Execute.
+ //
+
+ - remove_inline <-
+ (
+ parent_profil.remove_inline;
+ slot_code.remove_profil Self;
+ );
+
+ - remove <-
+ (
+ parent_profil.remove;
+ slot_code.remove_profil Self;
+ );
+
+ //
+ // Genere.
+ //
+
+ - is_static:BOOLEAN <- (! slot.id_section.is_interrupt) && {! slot.id_section.is_external};
diff --git a/src2/shorter.li b/src2/shorter.li
new file mode 100644
index 0000000..963d7c1
--- /dev/null
+++ b/src2/shorter.li
@@ -0,0 +1,465 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SHORTER;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - bibliography:= "http://IsaacOS.com";
+ - author := "Matthieu Brehier, Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Shorter source code.";
+
+ - external := `#include "path.h"`;
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - last_index (n:STRING,c:CHARACTER) :INTEGER <-
+ // BSBS: A Mettre dans STRING.
+ ( + result:INTEGER;
+ result := n.upper;
+ {(result<n.lower) || {n.item result = c}}.until_do {
+ result := result-1;
+ };
+ result
+ );
+
+ - output_name : STRING_CONSTANT;
+
+ - input_name : STRING_CONSTANT;
+
+ - format_name : STRING_CONSTANT;
+
+ - proto_input:PROTOTYPE;
+
+ //
+ // Buffer.
+ //
+
+ - directory_list:STRING;
+
+ - file_list:STRING;
+
+ - current_list:STRING;
+
+ //
+ // Command.
+ //
+
+ - usage:STRING_CONSTANT :=
+ "----------------------------------------------------------------\n\
+ \-- Lisaac source Shorter --\n\
+ \-- LORIA - LSIIT - ULP - CNRS - FRANCE --\n\
+ \-- Benoit SONNTAG - sonntag at icps.u-strasbg.fr --\n\
+ \-- http://www.IsaacOS.com --\n\
+ \----------------------------------------------------------------\n\
+ \Usage: \n\
+ \ shorter <input_file[.li]> [Options] \n\
+ \ \n\
+ \Options: \n\
+ \ -o <output> : output file or directory \n\
+ \ (default: <input_file.ext>) \n\
+ \ -p : include `Section Private' \n\
+ \ -c : include code source \n\
+ \ -r : recursive builder documentation \n\
+ \ -f <format_file> : formatting description file \n\
+ \ (see `/lisaac/shorter/') \n\
+ \ -d : Lisaac doc style (no -c, -r) \n\
+ \ \n\
+ \Examples: \n\
+ \ * Output format file: \n\
+ \ shorter -c -p -f latex hello_world.li \n\
+ \ \n\
+ \ * Build html documentation: \n\
+ \ shorter -r -f html ~/lisaac/lib \n\
+ \ \n\
+ \ * Build html documentation style JavaDoc: \n\
+ \ shorter -d -f belinda ~/lisaac/lib \n\
+ \ \n\
+ \Bug report: \n\
+ \ post in : https://gna.org/bugs/?group=isaac \n\
+ \ mail to : sonntag at icps.u-strasbg.fr \n";
+
+ - display_usage <-
+ (
+ usage.print;
+ die_with_code exit_failure_code;
+ );
+
+ //
+ // Options.
+ //
+
+ - read_options <-
+ ( + cmd:STRING;
+ + j:INTEGER;
+ + var_lisaac:STRING_CONSTANT;
+ + path:NATIVE_ARRAY(CHARACTER);
+
+ // Read argument.
+ is_shorter := TRUE;
+ j := 1;
+ {j > COMMAND_LINE.upper}.until_do {
+ cmd := COMMAND_LINE.item j;
+ (cmd.item 1='-').if {
+ //
+ // Lecture des options :
+ //
+ (cmd.item 2 = 'o').if {
+ // Output name.
+ j := j+1;
+ (j > COMMAND_LINE.count).if {
+ display_usage;
+ };
+ output_name := ALIAS_STR.get (COMMAND_LINE.item j);
+ }.elseif {cmd.item 2 = 'f'} then {
+ j := j+1;
+ (j > COMMAND_LINE.count).if {
+ display_usage;
+ };
+ format_name := ALIAS_STR.get (COMMAND_LINE.item j);
+ }.elseif {cmd.item 2 = 'c'} then {
+ is_short_code := TRUE;
+ }.elseif {cmd.item 2 = 'p'} then {
+ is_short_private := TRUE;
+ }.elseif {cmd.item 2 = 'r'} then {
+ is_short_recursive := TRUE;
+ }.elseif {cmd.item 2 = 'd'} then {
+ is_shorter := FALSE;
+ is_shorter2 := TRUE;
+ is_short_recursive := TRUE;
+ } else {
+ display_usage;
+ };
+ } else {
+ //
+ // Input name.
+ //
+ (input_name != NULL).if {
+ display_usage;
+ };
+ string_tmp.copy (COMMAND_LINE.item j);
+ input_name := ALIAS_STR.get string_tmp;
+ };
+ j := j+1;
+ };
+
+ (input_name = NULL).if {
+ display_usage;
+ };
+
+ (format_name != NULL).if {
+ path := `LISAAC_DIRECTORY`:NATIVE_ARRAY(CHARACTER);
+ var_lisaac := STRING_CONSTANT.new_intern path
+ count (path.fast_first_index_of '\0' until 1024);
+ //var_lisaac := ENVIRONMENT.get_environment_variable "LISAAC";
+ //(var_lisaac = NULL).if {
+ //STD_ERROR.put_string "Unable to find `LISAAC' environment variable.\n";
+ //STD_ERROR.put_string "Please, set the environment variable `LISAAC'\n";
+ //STD_ERROR.put_string "with the appropriate absolute path to lisaac \
+ //\root directory.\n";
+ //STD_ERROR.put_string "Example: 'set LISAAC=/lisaac/'\n";
+ //die_with_code exit_failure_code;
+ //};
+ //
+ string_tmp.copy var_lisaac;
+ ((var_lisaac.last != '/') &&
+ {var_lisaac.last != '\\'}).if {
+ string_tmp.add_last '/';
+ };
+ string_tmp.append "shorter/";
+ string_tmp.append format_name;
+ string_tmp.append ".li";
+ PARSER.parse_format (ALIAS_STR.get string_tmp);
+ };
+ );
+
+ - extract_proto_name st:ABSTRACT_STRING :STRING_CONSTANT <-
+ ( + i:INTEGER;
+
+ string_tmp.copy st;
+ string_tmp.replace_all '\\' with '/';
+ i := last_index (string_tmp,'/');
+ (i >= string_tmp.lower).if {
+ string_tmp.remove_first i;
+ };
+ i := last_index (string_tmp,'.');
+ ? {i > string_tmp.lower};
+ string_tmp.remove_last (string_tmp.upper-i+1);
+ string_tmp.to_upper;
+ ALIAS_STR.get string_tmp
+ );
+
+ - add_ext n:STRING_CONSTANT :STRING_CONSTANT <-
+ ( + txt:STRING_CONSTANT;
+ string_tmp.copy n;
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_type_file)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_type_file).first;
+ string_tmp.append txt;
+ } else {
+ string_tmp.append ".txt";
+ };
+ ALIAS_STR.get string_tmp
+ );
+
+ - save_file n:STRING_CONSTANT with buf:STRING <-
+ ( + file:STD_FILE;
+ + entry:ENTRY;
+
+ (is_short_recursive).if {
+ (output_name != NULL).if {
+ string_tmp.copy output_name;
+ ((string_tmp.last != '/') || {string_tmp.last != '\\'}).if {
+ string_tmp.add_last '/';
+ };
+ } else {
+ string_tmp.clear;
+ };
+ string_tmp.append n;
+ } else {
+ string_tmp.copy output_name;
+ };
+ entry := FILE_SYSTEM.make_file string_tmp;
+ (entry = NULL).if {
+ STD_ERROR.put_string "Error: File ";
+ STD_ERROR.put_string string_tmp;
+ STD_ERROR.put_string " is not created !\n";
+ die_with_code exit_failure_code;
+ };
+ (! entry.open).if {
+ STD_ERROR.put_string "Error: File ";
+ STD_ERROR.put_string string_tmp;
+ STD_ERROR.put_string " is not open !\n";
+ die_with_code exit_failure_code;
+ };
+ file ?= entry;
+ file.write buf from (buf.lower) size (buf.count);
+ file.close;
+ );
+
+ - check_in entry:ENTRY begin n:INTEGER <-
+ ( + name:STRING_CONSTANT;
+ + tok:STRING_CONSTANT;
+ + tok_lst:LINKED_LIST(STRING_CONSTANT);
+ + dir:DIRECTORY;
+
+ (! entry.open).if {
+ "Warning: directory `".print;
+ entry.path.print;
+ "\' not open.\n".print;
+ } else {
+ dir ?= entry;
+ // Directory
+ (dir.lower).to (dir.upper) do { i:INTEGER;
+ (dir.item i.is_directory).if {
+ check_in (dir.item i) begin n;
+ };
+ };
+ // Lisaac file `.li'
+ (dir.lower).to (dir.upper) do { i:INTEGER;
+ (! dir.item i.is_directory).if {
+ name := dir.item i.name;
+ (name.has_suffix ".li").if {
+ string_tmp.copy name;
+ string_tmp.remove_last 3;
+ string_tmp.to_upper;
+ tok := ALIAS_STR.get string_tmp;
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_file_list_item)).if {
+ tok_lst := PARSER.short_dico.fast_at (ALIAS_STR.short_file_list_item);
+ (tok_lst.lower).to (tok_lst.upper) do { j:INTEGER;
+ (tok_lst.item j = NULL).if {
+ current_list.append tok;
+ file_list.append tok;
+ } else {
+ current_list.append (tok_lst.item j);
+ file_list.append (tok_lst.item j);
+ };
+ };
+ } else {
+ current_list.append tok;
+ current_list.add_last '\n';
+ file_list.append tok;
+ file_list.add_last '\n';
+ };
+ // Creation prototype file.
+ (PROTOTYPE.prototype_dico.fast_has tok).if {
+ "Error: Double definition prototype:\n".print;
+ PROTOTYPE.prototype_dico.fast_at tok.filename.print; '\n'.print;
+ dir.item i.path.print; '\n'.print;
+ die_with_code exit_failure_code;
+ };
+ proto_input := PROTOTYPE.create (dir.item i.path) name tok generic_count 0;
+ //
+ PARSER.go_on proto_input;
+ (is_shorter).if {
+ save_file (add_ext tok) with output_code;
+ };
+ };
+ }; // Lisaac file `.li'
+ };
+ current_list.is_empty.if_false {
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_file_list_begin)).if {
+ tok := PARSER.short_dico.fast_at (ALIAS_STR.short_file_list_begin).first;
+ current_list.prepend tok;
+ };
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_file_list_end)).if {
+ tok := PARSER.short_dico.fast_at (ALIAS_STR.short_file_list_end).first;
+ current_list.append tok;
+ };
+ string_tmp.copy (dir.path);
+ string_tmp.remove_first n;
+ string_tmp.is_empty.if_false {
+ string_tmp.replace_all '/' with '-';
+
+ tok := ALIAS_STR.get string_tmp;
+
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_directory_list_item)).if {
+ tok_lst := PARSER.short_dico.fast_at (ALIAS_STR.short_directory_list_item);
+ (tok_lst.lower).to (tok_lst.upper) do { j:INTEGER;
+ (tok_lst.item j = NULL).if {
+ directory_list.append tok;
+ } else {
+ directory_list.append (tok_lst.item j);
+ };
+ };
+ } else {
+ directory_list.append tok;
+ directory_list.add_last '\n';
+ };
+
+ save_file (add_ext tok) with current_list;
+ current_list.clear;
+ };
+ };
+ };
+ );
+
+Section Public
+
+ //
+ // Creation.
+ //
+
+ - main <-
+ ( + txt:STRING_CONSTANT;
+ + p:PROTOTYPE;
+
+ ALIAS_STR.make;
+
+ //
+ read_options;
+
+ // SELF, NULL, VOID, CONTEXT
+ TYPE_NULL.make_null;
+ TYPE_VOID.make_void;
+ TYPE_CONTEXT.make_context;
+ TYPE_ID.make_type_id; // Pas utile !
+
+ (is_short_recursive).if {
+ + dir:DIRECTORY;
+ + ent:ENTRY;
+
+ directory_list := STRING.create 100;
+ file_list := STRING.create 100;
+ current_list := STRING.create 100;
+
+ ent := FILE_SYSTEM.get_entry input_name;
+ ((ent = NULL) || {! ent.is_directory}).if {
+ "Error: directory `".print;
+ input_name.print;
+ "\' not found.\n".print;
+ die_with_code exit_failure_code;
+ };
+ (! ent.open).if {
+ "Error: directory `".print;
+ input_name.print;
+ "\' not open.\n".print;
+ die_with_code exit_failure_code;
+ };
+ dir ?= ent;
+ check_in dir begin (dir.path.count + 1);
+ // index file.
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_index)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_index).first;
+ save_file (add_ext "index") with (txt.to_string);
+ };
+ // Default file.
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_default)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_default).first;
+ save_file (add_ext "default") with (txt.to_string);
+ };
+ // Directory_list file.
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_directory_list_begin)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_directory_list_begin).first;
+ directory_list.prepend txt;
+ };
+ (PARSER.short_dico.has (ALIAS_STR.short_directory_list_end)).if {
+ txt := PARSER.short_dico.at (ALIAS_STR.short_directory_list_end).first;
+ directory_list.append txt;
+ };
+ save_file (add_ext "directory_list") with directory_list;
+
+ // file_list file.
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_file_list_begin)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_file_list_begin).first;
+ file_list.prepend txt;
+ };
+ (PARSER.short_dico.fast_has (ALIAS_STR.short_file_list_end)).if {
+ txt := PARSER.short_dico.fast_at (ALIAS_STR.short_file_list_end).first;
+ file_list.append txt;
+ };
+ save_file (add_ext "file_list") with file_list;
+ } else {
+ // Input.
+ (input_name.has_suffix ".li").if_false {
+ string_tmp.copy input_name;
+ string_tmp.append ".li";
+ input_name := ALIAS_STR.get string_tmp;
+ };
+
+ proto_input := PROTOTYPE.create input_name
+ name (extract_proto_name input_name)
+ generic_count 0;
+ PARSER.go_on proto_input;
+
+ (output_name = NULL).if {
+ output_name := add_ext (proto_input.name);
+ };
+ save_file output_name with output_code;
+ };
+ (is_shorter2).if {
+ (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper) do { j:INTEGER;
+ p := PROTOTYPE.prototype_list.item j;
+ output_code.clear;
+ p.shorter_out output_code;
+ save_file (add_ext (p.name)) with output_code;
+ };
+ };
+ );
+
+
+
+
diff --git a/src2/shorter_any/any_option.li b/src2/shorter_any/any_option.li
new file mode 100644
index 0000000..ed17ed4
--- /dev/null
+++ b/src2/shorter_any/any_option.li
@@ -0,0 +1,59 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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_OPTION;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Public
+
+ - is_shorter2:BOOLEAN;
+
+ - is_shorter :BOOLEAN;
+
+ - is_short_code:BOOLEAN;
+ - is_short_private:BOOLEAN;
+ - is_short_recursive:BOOLEAN;
+
+ - put tok:ABSTRACT_STRING to buf:STRING like key:STRING_CONSTANT <-
+ ( + lst:LINKED_LIST(STRING_CONSTANT);
+
+ (key != NULL).if {
+ lst := PARSER.short_dico.fast_reference_at key;
+ (lst != NULL).if {
+ (lst.lower).to (lst.upper) do { j:INTEGER;
+ (lst.item j = NULL).if {
+ buf.append tok;
+ } else {
+ buf.append (lst.item j);
+ };
+ };
+ };
+ };
+ );
\ No newline at end of file
diff --git a/src2/tools/alias_array.li b/src2/tools/alias_array.li
new file mode 100644
index 0000000..6ad575f
--- /dev/null
+++ b/src2/tools/alias_array.li
@@ -0,0 +1,97 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ALIAS_ARRAY(E);
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Aliser collection.";
+
+Section Inherit
+
+ - parent_object:ANY := ANY;
+
+Section Private
+
+ - bucket:HASHED_SET(FAST_ARRAY(E)) :=
+ HASHED_SET(FAST_ARRAY(E)).create;
+
+ - free_list:FAST_ARRAY(FAST_ARRAY(E)) :=
+ FAST_ARRAY(FAST_ARRAY(E)).create_with_capacity 5;
+
+ - empty_list:FAST_ARRAY(E) := FAST_ARRAY(E).create_with_capacity 0;
+
+Section Public
+
+ //
+ // Temporary manager.
+ //
+
+ - new:FAST_ARRAY(E) <-
+ ( + result:FAST_ARRAY(E);
+
+ (free_list.is_empty).if {
+ result := FAST_ARRAY(E).create_with_capacity 16;
+ } else {
+ result := free_list.last;
+ free_list.remove_last;
+ };
+
+ result
+ );
+
+ - alias tmp:FAST_ARRAY(E) :FAST_ARRAY(E) <-
+ ( + result:FAST_ARRAY(E);
+
+ (tmp.is_empty).if {
+ result := empty_list;
+ } else {
+ result := bucket.reference_at tmp;
+ (result = NULL).if {
+ result := FAST_ARRAY(E).create_with_capacity (tmp.count);
+ result.copy tmp;
+ bucket.fast_add result;
+ };
+ };
+ free tmp;
+ result
+ );
+
+ - copy tmp:FAST_ARRAY(E) :FAST_ARRAY(E) <-
+ ( + result:FAST_ARRAY(E);
+
+ result := FAST_ARRAY(E).create_with_capacity (tmp.count);
+ result.copy tmp;
+ free tmp;
+ result
+ );
+
+ - free tmp:FAST_ARRAY(E) <-
+ (
+ tmp.clear;
+ free_list.add_last tmp;
+ );
+
+
+
diff --git a/src2/tools/alias_str.li b/src2/tools/alias_str.li
new file mode 100644
index 0000000..62b3ad7
--- /dev/null
+++ b/src2/tools/alias_str.li
@@ -0,0 +1,532 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := ALIAS_STR;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Alias string constant and keyword";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - list:HASHED_SET(ABSTRACT_STRING);
+
+ - free:FAST_ARRAY(STRING) := FAST_ARRAY(STRING).create_with_capacity 5;
+
+Section Public
+
+ - keyword_section :STRING_CONSTANT := "Section";
+ - keyword_right :STRING_CONSTANT := "Right";
+ - keyword_left :STRING_CONSTANT := "Left";
+ - keyword_ldots :STRING_CONSTANT := "...";
+ - keyword_old :STRING_CONSTANT := "Old";
+ - keyword_expanded :STRING_CONSTANT := "Expanded";
+ - keyword_strict :STRING_CONSTANT := "Strict";
+ - keyword_result :STRING_CONSTANT := "Result";
+
+ - symbol_affect_immediate:STRING_CONSTANT := ":=";
+ - symbol_affect_cast :STRING_CONSTANT := "?=";
+ - symbol_affect_code :STRING_CONSTANT := "<-";
+ - symbol_auto_export :STRING_CONSTANT := "->";
+ - symbol_auto_import :STRING_CONSTANT := symbol_affect_code;
+ - symbol_equal :STRING_CONSTANT := "=";
+ - symbol_not_equal :STRING_CONSTANT := "!=";
+ - symbol_great :STRING_CONSTANT := ">";
+ - symbol_great_equal :STRING_CONSTANT := ">=";
+ - symbol_less :STRING_CONSTANT := "<";
+ - symbol_less_equal :STRING_CONSTANT := "<=";
+
+ - operator_equal :STRING_CONSTANT;
+ - operator_not_equal :STRING_CONSTANT;
+
+ - section_header :STRING_CONSTANT := "Header";
+ - section_inherit :STRING_CONSTANT := "Inherit";
+ - section_insert :STRING_CONSTANT := "Insert";
+ - section_public :STRING_CONSTANT := "Public";
+ - section_private :STRING_CONSTANT := "Private";
+ - section_interrupt :STRING_CONSTANT := "Interrupt";
+ - section_mapping :STRING_CONSTANT := "Mapping";
+ - section_directory :STRING_CONSTANT := "Directory";
+ - section_external :STRING_CONSTANT := "External";
+
+ - section_default :STRING_CONSTANT := "DEFAULT";
+ - section_common :STRING_CONSTANT := "Common";
+
+ - prototype_integer :STRING_CONSTANT := "INTEGER";
+ - prototype_real :STRING_CONSTANT := "REAL";
+ - prototype_character :STRING_CONSTANT := "CHARACTER";
+ - prototype_string_constant :STRING_CONSTANT := "STRING_CONSTANT";
+ - prototype_string :STRING_CONSTANT := "STRING";
+ - prototype_native_array :STRING_CONSTANT := "NATIVE_ARRAY";
+ - prototype_native_array_volatile:STRING_CONSTANT := "NATIVE_ARRAY_VOLATILE";
+ - prototype_block :STRING_CONSTANT := "BLOCK";
+ - prototype_boolean :STRING_CONSTANT := "BOOLEAN";
+ - prototype_true :STRING_CONSTANT := "TRUE";
+ - prototype_false :STRING_CONSTANT := "FALSE";
+ - prototype_pointer :STRING_CONSTANT := "POINTER";
+ - prototype_context :STRING_CONSTANT := "___CONTEXT";
+ - prototype_cop :STRING_CONSTANT := "___COP";
+ - prototype_generic :STRING_CONSTANT := "___GENERIC";
+ - prototype_type_id :STRING_CONSTANT := "___TYPE_ID";
+ - prototype_self :STRING_CONSTANT := "SELF";
+
+ - prototype_uinteger_64 :STRING_CONSTANT := "UINTEGER_64";
+ - prototype_uinteger_32 :STRING_CONSTANT := "UINTEGER_32";
+ - prototype_uinteger_16 :STRING_CONSTANT := "UINTEGER_16";
+ - prototype_uinteger_8 :STRING_CONSTANT := "UINTEGER_8";
+ - prototype_integer_64 :STRING_CONSTANT := "INTEGER_64";
+ - prototype_integer_32 :STRING_CONSTANT := "INTEGER_32";
+ - prototype_integer_16 :STRING_CONSTANT := "INTEGER_16";
+ - prototype_integer_8 :STRING_CONSTANT := "INTEGER_8";
+ - prototype_n_a_character :STRING_CONSTANT := "NATIVE_ARRAY__CHARACTER";
+ - prototype_n_a_n_a_character:STRING_CONSTANT :=
+ "NATIVE_ARRAY__NATIVE_ARRAY__CHARACTER";
+
+ - variable_self :STRING_CONSTANT := "Self";
+ - variable_context :STRING_CONSTANT := "__pos";
+ - variable_null :STRING_CONSTANT := "NULL";
+ - variable_void :STRING_CONSTANT := "VOID";
+ - variable_tmp :STRING_CONSTANT := "__tmp";
+
+ - variable_lisaac :STRING_CONSTANT := "lisaac";
+ /*
+ - variable_input_file :STRING_CONSTANT := "input_file";
+ - variable_output_file:STRING_CONSTANT := "output_file";
+ - variable_target :STRING_CONSTANT := "target";
+ */
+ - slot_name :STRING_CONSTANT := "name";
+ - slot_export :STRING_CONSTANT := "export";
+ - slot_import :STRING_CONSTANT := "import";
+ - slot_external :STRING_CONSTANT := "external";
+ - slot_default :STRING_CONSTANT := "default";
+ - slot_type :STRING_CONSTANT := "type";
+ - slot_version :STRING_CONSTANT := "version";
+ - slot_date :STRING_CONSTANT := "date";
+ - slot_comment :STRING_CONSTANT := "comment";
+ - slot_author :STRING_CONSTANT := "author";
+ - slot_bibliography :STRING_CONSTANT := "bibliography";
+ - slot_language :STRING_CONSTANT := "language";
+ - slot_copyright :STRING_CONSTANT := "copyright";
+ - slot_bug_report :STRING_CONSTANT := "bug_report";
+
+ - slot_value :STRING_CONSTANT := "value";
+ - slot_self :STRING_CONSTANT := "self";
+ - slot_id :STRING_CONSTANT := "__id";
+ - slot_clone :STRING_CONSTANT := "clone";
+ - slot_main :STRING_CONSTANT := "main";
+ - slot_infix :STRING_CONSTANT := "__infix";
+ - slot_postfix :STRING_CONSTANT := "__postfix";
+ - slot_prefix :STRING_CONSTANT := "__prefix";
+ - slot_to :STRING_CONSTANT := "to_";
+ - slot_from :STRING_CONSTANT := "from_";
+ - slot_storage :STRING_CONSTANT := "storage";
+ - slot_count :STRING_CONSTANT := "count";
+
+ // LIP file.
+ - slot_lip :STRING_CONSTANT := "lip";
+ - slot_if :STRING_CONSTANT := "if";
+ - slot_else :STRING_CONSTANT := "else";
+ - slot_print :STRING_CONSTANT := "print";
+ - slot_exit :STRING_CONSTANT := "exit";
+ - slot_run :STRING_CONSTANT := "run";
+ - slot_path :STRING_CONSTANT := "path";
+ - slot_front_end :STRING_CONSTANT := "front_end";
+ - slot_back_end :STRING_CONSTANT := "back_end";
+ - slot_input_file :STRING_CONSTANT := "input_file";
+ - slot_debug_level :STRING_CONSTANT := "debug_level";
+ - slot_debug_with_code:STRING_CONSTANT := "debug_with_code";
+ - slot_is_all_warning:STRING_CONSTANT := "is_all_warning";
+ - slot_is_optimization:STRING_CONSTANT := "is_optimization";
+ - slot_inline_level :STRING_CONSTANT := "inline_level";
+ - slot_is_java :STRING_CONSTANT := "is_java";
+ - slot_is_statistic :STRING_CONSTANT := "is_statistic";
+ - slot_is_quiet :STRING_CONSTANT := "is_quiet";
+ - slot_get_integer :STRING_CONSTANT := "get_integer";
+ - slot_get_string :STRING_CONSTANT := "get_string";
+ - slot_is_cop :STRING_CONSTANT := "is_cop";
+
+ - c_void :STRING_CONSTANT := "void";
+ - c_struct :STRING_CONSTANT := "struct __";
+ - code_empty :STRING_CONSTANT := "/* NOTHING */";
+ - separate :STRING_CONSTANT := "__";
+
+ - path_lisaac :STRING_CONSTANT := "__PATH_LISAAC_SYSTEM__";
+ - short_format :STRING_CONSTANT := "__SHORT_LISAAC_FORMAT__";
+
+ //
+ // Shorter.
+ //
+
+ - short_type_file :STRING_CONSTANT := "type_file";
+ - short_token :STRING_CONSTANT := "token";
+ - short_begin :STRING_CONSTANT := "begin";
+ - short_end :STRING_CONSTANT := "end";
+
+ // Syntax
+ - short_keyword :STRING_CONSTANT := "keyword";
+ - short_keyword_section:STRING_CONSTANT := "keyword_section";
+ - short_integer :STRING_CONSTANT := "integer";
+ - short_character :STRING_CONSTANT := "character";
+ - short_string :STRING_CONSTANT := "string";
+ - short_operator :STRING_CONSTANT := "operator";
+ - short_prototype :STRING_CONSTANT := "prototype";
+ - short_keyprototype:STRING_CONSTANT := "keyprototype";
+ - short_comment_line :STRING_CONSTANT := "comment_line";
+ - short_comment_slot_line :STRING_CONSTANT := "comment_slot_line";
+ - short_comment_header_line:STRING_CONSTANT := "comment_header_line";
+ - short_comment :STRING_CONSTANT := "comment";
+ - short_slot :STRING_CONSTANT := "slot";
+ - short_slot_call :STRING_CONSTANT := "slot_call";
+ - short_slot_style :STRING_CONSTANT := "slot_style";
+ - short_block :STRING_CONSTANT := "block";
+ - short_external :STRING_CONSTANT := "external";
+ - short_local :STRING_CONSTANT := "local";
+ - short_warning :STRING_CONSTANT := "warning";
+ - short_identifier :STRING_CONSTANT := "identifier";
+ - short_identifier_slot:STRING_CONSTANT := "identifier_slot";
+
+ - short_prototype_comment_light:STRING_CONSTANT := "prototype_comment_light";
+ - short_prototype_comment:STRING_CONSTANT := "prototype_comment";
+
+ - short_title :STRING_CONSTANT := "title";
+ - short_table_begin :STRING_CONSTANT := "table_begin";
+ - short_table_item :STRING_CONSTANT := "table_item";
+ - short_table_slot_name :STRING_CONSTANT := "table_slot_name";
+ - short_table_slot_comment :STRING_CONSTANT := "table_slot_comment";
+ - short_table_end :STRING_CONSTANT := "table_end";
+ - short_sub_title :STRING_CONSTANT := "sub_title";
+ - short_slot_title :STRING_CONSTANT := "slot_title";
+ - short_subsub_title :STRING_CONSTANT := "subsub_title";
+ - short_prototype_path:STRING_CONSTANT := "prototype_path";
+
+
+ - short_index :STRING_CONSTANT := "index";
+ - short_default :STRING_CONSTANT := "default";
+ - short_directory_list_begin:STRING_CONSTANT := "directory_list_begin";
+ - short_directory_list_item :STRING_CONSTANT := "directory_list_item";
+ - short_directory_list_end :STRING_CONSTANT := "directory_list_end";
+ - short_file_list_begin :STRING_CONSTANT := "file_list_begin";
+ - short_file_list_item :STRING_CONSTANT := "file_list_item";
+ - short_file_list_end :STRING_CONSTANT := "file_list_end";
+
+ - is_integer n:STRING_CONSTANT :BOOLEAN <-
+ (
+ (n = prototype_uinteger_64) ||
+ {n = prototype_uinteger_32} ||
+ {n = prototype_uinteger_16} ||
+ {n = prototype_uinteger_8 } ||
+ {n = prototype_integer_64 } ||
+ {n = prototype_integer_32 } ||
+ {n = prototype_integer_16 } ||
+ {n = prototype_integer_8 } ||
+ {n = prototype_integer }
+ );
+
+ - is_section n:STRING_CONSTANT :BOOLEAN <-
+ (
+ (n = section_inherit) ||
+ {n = section_insert} ||
+ {n = section_interrupt} ||
+ {n = section_private} ||
+ {n = section_public} ||
+ {n = section_mapping} ||
+ {n = section_directory} ||
+ {n = section_external}
+ );
+
+ - get str:ABSTRACT_STRING :STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+ + tmp:ABSTRACT_STRING;
+ ? {str != NULL};
+ ? {list != NULL};
+
+ tmp := list.reference_at str;
+ (tmp = NULL).if {
+ result := STRING_CONSTANT.create_copy str;
+ list.fast_add result;
+ } else {
+ result ?= tmp;
+ };
+ ? {result == str};
+ result
+ );
+
+ - get_intern str:ABSTRACT_STRING :STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+ + v,m:INTEGER;
+
+ tmp_name.copy str;
+ tmp_name.append "__";
+ count_variable := count_variable + 1;
+ v:=count_variable;
+ { v = 0 }.until_do {
+ m := v & 31;
+ (m < 26).if {
+ tmp_name.add_last ('A' +# m);
+ } else {
+ tmp_name.add_last ('0' +# (m-26));
+ };
+ v := v >> 5;
+ };
+ result := STRING_CONSTANT.create_copy tmp_name;
+ list.fast_add result;
+ result
+ );
+
+ - new:STRING <-
+ ( + result:STRING;
+
+ (free.is_empty).if {
+ result := STRING.create 128;
+ } else {
+ result := free.last;
+ free.remove_last;
+ };
+ result
+ );
+
+ - alias str:STRING :STRING_CONSTANT <-
+ ( + result:STRING_CONSTANT;
+
+ result := get str;
+ free.add_last str;
+ str.clear;
+ result
+ );
+
+ - make <-
+ (
+ tmp_name := STRING.create 255;
+
+ list := HASHED_SET(ABSTRACT_STRING).create;
+
+ // Keyword list :
+ list.add keyword_section;
+ list.add keyword_right;
+ list.add keyword_left;
+ list.add keyword_ldots;
+ list.add keyword_old;
+ list.add keyword_expanded;
+ list.add keyword_strict;
+ list.add keyword_result;
+
+ // Symbol list :
+ list.add symbol_affect_immediate;
+ list.add symbol_affect_cast;
+ list.add symbol_affect_code;
+ list.add symbol_auto_export;
+ list.add symbol_equal;
+ list.add symbol_not_equal;
+ list.add symbol_great;
+ list.add symbol_great_equal;
+ list.add symbol_less;
+ list.add symbol_less_equal;
+
+ // Section name list :
+ list.add section_header;
+ list.add section_inherit;
+ list.add section_insert;
+ list.add section_interrupt;
+ list.add section_private;
+ list.add section_public;
+ list.add section_mapping;
+ list.add section_directory;
+ list.add section_external;
+
+ list.add section_default;
+ list.add section_common;
+
+ // Les types de base :
+ list.add prototype_integer;
+ list.add prototype_real;
+ list.add prototype_character;
+ list.add prototype_string_constant;
+ list.add prototype_string;
+ list.add prototype_native_array;
+ list.add prototype_native_array_volatile;
+ list.add prototype_block;
+ list.add prototype_boolean;
+ list.add prototype_true;
+ list.add prototype_false;
+ list.add prototype_pointer;
+ list.add prototype_context;
+ list.add prototype_generic;
+ list.add prototype_type_id;
+ list.add prototype_self;
+
+ // Integers :
+ list.add prototype_uinteger_64;
+ list.add prototype_uinteger_32;
+ list.add prototype_uinteger_16;
+ list.add prototype_uinteger_8;
+ list.add prototype_integer_64;
+ list.add prototype_integer_32;
+ list.add prototype_integer_16;
+ list.add prototype_integer_8;
+ list.add prototype_n_a_character;
+ list.add prototype_n_a_n_a_character;
+
+ // Les variables de base :
+ list.add variable_self;
+ list.add variable_context;
+ list.add variable_null;
+ list.add variable_void;
+ list.add variable_tmp;
+
+ list.add variable_lisaac;
+ /*
+ list.add variable_input_file;
+ list.add variable_output_file;
+ list.add variable_target;
+ */
+
+ // Slot particulier :
+ list.add slot_name;
+ list.add slot_export;
+ list.add slot_import;
+ list.add slot_external;
+ list.add slot_default;
+ list.add slot_type;
+ list.add slot_version;
+ list.add slot_date;
+ list.add slot_comment;
+ list.add slot_author;
+ list.add slot_bibliography;
+ list.add slot_language;
+ list.add slot_copyright;
+ list.add slot_bug_report;
+
+ list.add slot_value;
+ list.add slot_self;
+ list.add slot_id;
+ list.add slot_clone;
+ list.add slot_main;
+ list.add slot_infix;
+ list.add slot_postfix;
+ list.add slot_prefix;
+ list.add slot_to;
+ list.add slot_from;
+ list.add slot_storage;
+ list.add slot_count;
+ // Lip.
+ list.add slot_lip;
+ list.add slot_if;
+ list.add slot_else;
+ list.add slot_print;
+ list.add slot_exit;
+ list.add slot_run;
+ list.add slot_path;
+ list.add slot_front_end;
+ list.add slot_back_end;
+ list.add slot_input_file;
+ list.add slot_debug_level;
+ list.add slot_debug_with_code;
+ list.add slot_is_all_warning;
+ list.add slot_is_optimization;
+ list.add slot_inline_level;
+ list.add slot_is_java;
+ list.add slot_is_statistic;
+ list.add slot_is_quiet;
+ list.add slot_get_integer;
+ list.add slot_get_string;
+ list.add slot_is_cop;
+
+ // Type C :
+ list.add c_void;
+ list.add c_struct;
+ list.add code_empty;
+ list.add separate;
+
+ list.add path_lisaac;
+ list.add short_format;
+
+ // Shorter slot :
+ list.add short_token;
+ list.add short_type_file;
+ list.add short_begin;
+ list.add short_end;
+ list.add short_keyword;
+ list.add short_keyword_section;
+ list.add short_integer;
+ list.add short_character;
+ list.add short_string;
+ list.add short_operator;
+ list.add short_prototype;
+ list.add short_keyprototype;
+ list.add short_comment_line;
+ list.add short_comment_slot_line;
+ list.add short_comment_header_line;
+ list.add short_comment;
+ list.add short_slot;
+ list.add short_slot_call;
+ list.add short_slot_style;
+ list.add short_block;
+ list.add short_external;
+ list.add short_local;
+ list.add short_warning;
+ list.add short_identifier;
+ list.add short_identifier_slot;
+
+ list.add short_prototype_comment_light;
+ list.add short_prototype_comment;
+
+ list.add short_title;
+ list.add short_table_begin;
+ list.add short_table_item;
+ list.add short_table_slot_name;
+ list.add short_table_slot_comment;
+ list.add short_table_end;
+ list.add short_sub_title;
+ list.add short_slot_title;
+ list.add short_subsub_title;
+ list.add short_prototype_path;
+
+ list.add short_index;
+ list.add short_default;
+ list.add short_directory_list_begin;
+ list.add short_directory_list_item;
+ list.add short_directory_list_end;
+ list.add short_file_list_begin;
+ list.add short_file_list_item;
+ list.add short_file_list_end;
+
+ // Operator '=' and '!=' :
+ operator_equal := operator slot_infix name symbol_equal;
+ operator_not_equal := operator slot_infix name symbol_not_equal;
+ );
+
+Section Private
+
+ - tmp_name:STRING;
+
+ - count_variable:INTEGER;
+
+
+
+
+
diff --git a/src2/tools/coupled.li b/src2/tools/coupled.li
new file mode 100644
index 0000000..5eefb49
--- /dev/null
+++ b/src2/tools/coupled.li
@@ -0,0 +1,52 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := COUPLED(E);
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Couple object";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ + first :E;
+ + second:E;
+
+ - create elt1:E and elt2:E :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make elt1 and elt2;
+ result
+ );
+
+ - make elt1:E and elt2:E <-
+ (
+ first := elt1;
+ second := elt2;
+ );
diff --git a/src2/tools/position.li b/src2/tools/position.li
new file mode 100644
index 0000000..94e2b9e
--- /dev/null
+++ b/src2/tools/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).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/src2/tools/slim_array.li b/src2/tools/slim_array.li
new file mode 100644
index 0000000..fe97746
--- /dev/null
+++ b/src2/tools/slim_array.li
@@ -0,0 +1,107 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SLIM_ARRAY(E); // BSBS: A mettre en Expanded.
+
+ - copyright := "2003-2008 Sonntag Benoit";
+
+ - author := "Sonntag Benoit (sonntag at icps.u-strasbg.fr)";
+ - comment := "The main prototype";
+
+Section Insert
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Private
+
+ + list:FAST_ARRAY(E);
+
+Section Public
+
+ + first:E;
+
+ - last:E <-
+ ( + result:E;
+ (list != NULL).if {
+ result := list.last;
+ } else {
+ result := first;
+ };
+ result
+ );
+
+ - lower:INTEGER <- 0;
+
+ - upper:INTEGER <-
+ ( + result:INTEGER;
+ (first = NULL).if {
+ result := -1;
+ }.elseif {list != NULL} then {
+ result := list.count;
+ };
+ result
+ );
+
+ - count:INTEGER <- upper + 1;
+
+ - is_empty:BOOLEAN <- first = NULL;
+
+ - item i:INTEGER :E <-
+ ( + result:E;
+
+ (i = 0).if {
+ result := first;
+ } else {
+ result := list.item (i-1);
+ };
+ result
+ );
+
+ - put e:E to i:INTEGER <-
+ (
+ (i = 0).if {
+ first := e;
+ } else {
+ list.put e to (i-1);
+ };
+ );
+
+ - add_last e:E <-
+ (
+ (first = NULL).if {
+ first := e;
+ } else {
+ (list = NULL).if {
+ list := FAST_ARRAY(E).create_with_capacity 4;
+ };
+ list.add_last e;
+ };
+ );
+
+ - make_with_capacity n:INTEGER <-
+ (
+ first := NULL;
+ (n > 1).if {
+ list := FAST_ARRAY(E).create_with_capacity (n-1);
+ };
+ );
+
diff --git a/src2/tools/table.li b/src2/tools/table.li
new file mode 100644
index 0000000..aad188b
--- /dev/null
+++ b/src2/tools/table.li
@@ -0,0 +1,113 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TABLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Display array manager.";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Private
+
+ - table:FAST_ARRAY2(ABSTRACT_STRING) := FAST_ARRAY2(ABSTRACT_STRING).create (10,10);
+
+ - size:FAST_ARRAY(INTEGER) := FAST_ARRAY(INTEGER).create_with_capacity 10;
+
+ - line:INTEGER;
+ - column:INTEGER;
+
+Section Public
+
+ - new_table (l,c:INTEGER) <-
+ (
+ table.make (l,c);
+ line := column := 0;
+ );
+
+ - add n:ABSTRACT_STRING <-
+ (
+ ? {n != NULL};
+
+ table.put n to (line,column);
+ (column = table.upper2).if {
+ column := 0;
+ line := line + 1;
+ } else {
+ column := column + 1;
+ };
+ );
+
+ - append_in buffer:STRING <-
+ ( + siz:INTEGER;
+ + append_line,append_bar:BLOCK;
+
+ // Size column.
+ size.make (table.count2);
+ 0.to (table.upper1) do { l:INTEGER;
+ 0.to (table.upper2) do { c:INTEGER;
+ siz := table.item (l,c).count;
+ (siz > size.item c).if {
+ size.put siz to c;
+ };
+ };
+ };
+
+ // Sub-code for one line.
+ append_line :=
+ { l:INTEGER;
+ + n:ABSTRACT_STRING;
+ buffer.append "// ";
+ 0.to (table.upper2) do { c:INTEGER;
+ n := table.item (l,c);
+ buffer.append "| ";
+ buffer.append n;
+ buffer.extend_multiple ' ' by (size.item c - n.count + 1);
+ };
+ buffer.append "|\n";
+ };
+ append_bar :=
+ {
+ buffer.append "// ";
+ 0.to (table.upper2) do { c:INTEGER;
+ buffer.add_last '+';
+ buffer.extend_multiple '-' by (size.item c + 2);
+ };
+ buffer.append "+\n";
+ };
+
+ // Display Header.
+ append_bar.value;
+ append_line.value 0;
+ append_bar.value;
+ // Display table.
+ 1.to (table.upper1) do { l:INTEGER;
+ append_line.value l;
+ };
+ // Display End.
+ append_bar.value;
+ );
\ No newline at end of file
diff --git a/src2/tools/types.li b/src2/tools/types.li
new file mode 100644
index 0000000..04eb5bd
--- /dev/null
+++ b/src2/tools/types.li
@@ -0,0 +1,158 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPES;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Aliser TYPE collection.";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section TYPES
+
+ + storage:NATIVE_ARRAY(TYPE);
+ // Internal access to storage location.
+
+Section LISAAC
+
+ - size:INTEGER;
+
+Section Public
+
+ - lower:INTEGER := 0;
+
+ + upper:INTEGER := -1; // Upper index bound.
+
+ - count:INTEGER <- upper + 1;
+
+ - is_empty:BOOLEAN <- upper = -1;
+
+ - first:TYPE <-
+ [ -? {! is_empty}; ]
+ (
+ storage.item 0
+ );
+
+ - second:TYPE <-
+ [ -? {upper >= 1}; ]
+ (
+ storage.item 1
+ );
+
+ - last:TYPE <-
+ [ -? {! is_empty}; ]
+ (
+ storage.item upper
+ );
+
+ - item i:INTEGER :TYPE <-
+ [ -? {i.in_range lower to upper}; ]
+ (
+ storage.item i
+ )
+ [ +? {Result != NULL}; ];
+
+ - Self:SELF '==' Right 60 other:TYPES :BOOLEAN <-
+ (
+ (Self = other) ||
+ {
+ (upper = other.upper) &&
+ {(is_empty) || {storage.fast_memcmp (other.storage) until (upper + 1)}}
+ }
+ );
+
+ - Self:SELF '<=' Right 60 other:TYPES :BOOLEAN <-
+ // True, if `Self' is include in `other'.
+ ( + result:BOOLEAN;
+ + j1,j2:INTEGER;
+ + t:TYPE;
+
+ (upper <= other.upper).if {
+ j1 := j2 := lower;
+ result := TRUE;
+ {(j1 <= upper) && {result}}.while_do {
+ t := item j1;
+ {(j2 <= other.upper) && {other.item j2 != t}}.while_do {
+ j2 := j2 + 1;
+ };
+ result := (j2 <= other.upper);
+ j1 := j1 + 1;
+ };
+ };
+ result
+ );
+
+ - hash_code:INTEGER <-
+ ( + result:INTEGER;
+
+ (! is_empty).if {
+ result := (upper << 8) + last.index;
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - print <-
+ (
+ (! is_empty).if {
+ (lower).to (upper - 1) do { j:INTEGER;
+ item j.print;
+ '('.print;
+ item j.index.print;
+ ") x ".print;
+ };
+ last.print;
+ '('.print;
+ last.index.print;
+ ')'.print;
+ } else {
+ "<Vide>".print;
+ };
+ );
+
+Section TYPES_TMP
+
+ - create tab:TYPES_TMP :TYPES <-
+ ( + result:TYPES;
+
+ result := clone;
+ result.make tab;
+ result
+ );
+
+ - make tab:TYPES_TMP <-
+ ( + up:INTEGER;
+
+ up := tab.upper;
+ storage := NATIVE_ARRAY(TYPE).calloc_intern (up + 1);
+ storage.copy_from (tab.storage) until up;
+ upper := up;
+ size := size + count * 4;
+ );
\ No newline at end of file
diff --git a/src2/tools/types_tmp.li b/src2/tools/types_tmp.li
new file mode 100644
index 0000000..2e8a2fa
--- /dev/null
+++ b/src2/tools/types_tmp.li
@@ -0,0 +1,246 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPES_TMP;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Aliser TYPE collection.";
+
+Section Inherit
+
+ + parent_types:Expanded TYPES;
+
+Section Private
+
+ - bucket:HASHED_SET(TYPES) := HASHED_SET(TYPES).create;
+
+ - free_list:FAST_ARRAY(TYPES_TMP) := FAST_ARRAY(TYPES_TMP).create_with_capacity 5;
+
+ + capacity:INTEGER;
+
+ - create_types_tmp:TYPES_TMP <-
+ ( + result:TYPES_TMP;
+
+ result := clone;
+ result.make_types_tmp;
+ result
+ );
+
+ - make_types_tmp <-
+ (
+ capacity := 256;
+ storage := NATIVE_ARRAY(TYPE).calloc_intern capacity;
+ )
+ [ +? {is_empty}; ];
+
+Section LISAAC
+
+ - print_types <-
+ (
+ (bucket.lower).to (bucket.upper) do { j:INTEGER;
+ bucket.item j.print; '\n'.print;
+ };
+ );
+
+Section Public
+
+ - types_empty:TYPES := TYPES;
+
+ //
+ // Creation.
+ //
+
+ - new:TYPES_TMP <-
+ ( + result:TYPES_TMP;
+
+ (free_list.is_empty).if {
+ result := create_types_tmp;
+ } else {
+ result := free_list.last;
+ free_list.remove_last;
+ };
+ result
+ );
+
+ - update t:TYPES :TYPES <-
+ [
+ -? { + tmp:TYPES_TMP; tmp ?= t; tmp = NULL};
+ ]
+ ( + result:TYPES;
+
+ ((t != NULL) && {t.count = count}).if {
+ result := t;
+ free;
+ } else {
+ result := to_types;
+ };
+ result
+ );
+
+ - to_types:TYPES <-
+ ( + result:TYPES;
+
+ (is_empty).if {
+ result := types_empty;
+ } else {
+ result := bucket.reference_at Self;
+ (result = NULL).if {
+ result := TYPES.create Self;
+ bucket.fast_add result;
+ };
+ };
+ 20 ? {result == Self};
+
+ free;
+ result
+ );
+
+ - free <-
+ (
+ upper := -1;
+ free_list.add_last Self;
+ );
+
+ //
+ // Update list.
+ //
+
+ - remove_first <-
+ (
+ (lower + 1).to upper do { i:INTEGER;
+ storage.put (item i) to (i - 1);
+ };
+ upper := upper - 1;
+ );
+
+ - add t:TYPE <-
+ ( + idx:INTEGER;
+
+ (is_empty).if {
+ add_last t;
+ } else {
+ idx := search t from 0 to count;
+ (idx > upper).if {
+ add_last t;
+ }.elseif {item idx != t} then {
+ add t to idx;
+ };
+ };
+ )
+ [
+ 20 ? {order_test};
+ ];
+
+ - union other:TYPES <-
+ ( + idx1,idx2,t2idx:INTEGER;
+ + t2:TYPE;
+
+ {idx2 > other.upper}.until_do {
+ t2 := other.item idx2;
+ t2idx := t2.index;
+ {(idx1 <= upper) && {item idx1.index < t2idx}}.while_do {
+ idx1 := idx1 + 1;
+ };
+ ((idx1 > upper) || {item idx1 != t2}).if {
+ add t2 to idx1;
+ };
+ idx1 := idx1 + 1;
+ idx2 := idx2 + 1;
+ };
+ )
+ [
+ 20 ? {order_test};
+ ];
+
+Section Private
+
+ - add_last t:TYPE <-
+ ( + new_capacity:INTEGER;
+
+ (upper + 1 > capacity - 1 ).if {
+ new_capacity := capacity * 2;
+ storage := storage.realloc capacity with new_capacity;
+ capacity := new_capacity;
+ };
+ upper := upper + 1;
+ storage.put t to upper;
+ );
+
+ - add t:TYPE to index:INTEGER <-
+ ( + new_capacity:INTEGER;
+ (index = upper + 1).if {
+ add_last t;
+ } else {
+ (upper + 1 > capacity - 1 ).if {
+ new_capacity := capacity * 2;
+ storage := storage.realloc capacity with new_capacity;
+ capacity := new_capacity;
+ };
+ upper := upper + 1;
+ (upper - 1).downto index do { i:INTEGER;
+ storage.put (item i) to (i + 1);
+ };
+ storage.put t to index;
+ };
+ );
+
+ - search t:TYPE from beg:INTEGER to end:INTEGER :INTEGER <-
+ // Dichotomic research.
+ ( + middle,result:INTEGER;
+
+ ((end - beg) < 2).if {
+ (t.index > item beg.index).if {
+ result := end;
+ } else {
+ result := beg;
+ };
+ } else {
+ middle := (beg + end) >> 1;
+ (t.index > item middle.index).if {
+ result := search t from middle to end;
+ } else {
+ result := search t from beg to middle;
+ };
+ };
+ result
+ );
+
+ - order_test:BOOLEAN <-
+ ( + j:INTEGER;
+
+ {(j < upper) && {item j.index < item (j+1).index}}.while_do {
+ j := j + 1;
+ };
+ j >= upper
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/type/old/type_block.li b/src2/type/old/type_block.li
similarity index 100%
copy from src/type/old/type_block.li
copy to src2/type/old/type_block.li
diff --git a/src/type/old/type_link.li b/src2/type/old/type_link.li
similarity index 100%
copy from src/type/old/type_link.li
copy to src2/type/old/type_link.li
diff --git a/src/type/old/type_parameter.li b/src2/type/old/type_parameter.li
similarity index 100%
copy from src/type/old/type_parameter.li
copy to src2/type/old/type_parameter.li
diff --git a/src2/type/prototype.li b/src2/type/prototype.li
new file mode 100644
index 0000000..d9f0b47
--- /dev/null
+++ b/src2/type/prototype.li
@@ -0,0 +1,758 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := PROTOTYPE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Prototype source code.";
+
+Section Inherit
+
+ + parent_named:Expanded NAMED;
+
+Section Public
+
+ - prototype_list:FAST_ARRAY(PROTOTYPE) :=
+ FAST_ARRAY(PROTOTYPE).create_with_capacity 512;
+ // BSBS: Voir si il faut le conserver !
+
+ - prototype_dico:HASHED_DICTIONARY(PROTOTYPE,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(PROTOTYPE,STRING_CONSTANT).create;
+
+Section Public
+
+ + index:INTEGER; // in `prototype_list', for POSITION.
+
+ + shortname:STRING_CONSTANT;
+
+ //
+ // Slots
+ //
+
+ + slot_list:HASHED_DICTIONARY(ITM_SLOT,STRING_CONSTANT);
+
+ + first_slot:ITM_SLOT;
+
+ + last_slot:ITM_SLOT;
+
+ - add_slot s:ITM_SLOT <-
+ (
+ slot_list.fast_put s to (s.name);
+ (first_slot = NULL).if {
+ first_slot := s;
+ } else {
+ last_slot.set_next s;
+ };
+ last_slot := s;
+ );
+
+ - search_parent n:STRING_CONSTANT :BOOLEAN <-
+ ( + slot:ITM_SLOT;
+ + result:BOOLEAN;
+
+ slot := first_slot;
+ {
+ (result := (slot != NULL) && {slot.id_section.is_inherit_or_insert})
+ && {slot.name != n}
+ }.while_do {
+ slot := slot.next;
+ };
+ result
+ );
+
+ //
+ // Run Slot.
+ //
+
+ - init_slot_for typ:TYPE <-
+ ( + cur:ITM_SLOT;
+
+ // Parent.
+ cur := first_slot;
+ {(cur != NULL) && {cur.id_section.is_inherit_or_insert}}.while_do {
+ typ.slot_run.add_last (SLOT.create cur type typ);
+ cur := cur.next;
+ };
+ // Mapping.
+ (is_mapping).if {
+ {cur != NULL}.while_do {
+ (cur.id_section.is_mapping).if {
+ ? {cur.style = '+'};
+ typ.slot_run.add_last (SLOT.create cur type typ);
+ };
+ cur := cur.next;
+ };
+ };
+ );
+
+ //
+ // Mapping / Late binding / Expanded
+ //
+
+ + type_style:STRING_CONSTANT; // Reference / Expanded / Strict.
+
+ + is_mapping:BOOLEAN;
+
+ - set_mapping <-
+ (
+ is_mapping := TRUE;
+ );
+
+ - set_type_style s:STRING_CONSTANT <-
+ (
+ type_style := s;
+ );
+
+ //
+ // Cast information.
+ //
+
+ + export_list:FAST_ARRAY(ITM_TYPE_MONO);
+ + import_list:FAST_ARRAY(ITM_TYPE_MONO);
+
+ - set_export_list s:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ export_list := s;
+ );
+
+ - set_import_list s:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ import_list := s;
+ );
+
+ //
+ // Source file.
+ //
+
+ + filename:STRING_CONSTANT; // Pathname of prototype.
+
+ + source : STRING; // Text source code.
+
+ + generic_count:INTEGER;
+
+ + idf_generic_list:FAST_ARRAY(ITM_TYPE_PARAMETER);
+
+ //
+ // Default value.
+ //
+
+ + default_value:ITM_CODE;
+
+ - set_default_value v:ITM_CODE <-
+ (
+ default_value := v; //default_value v to_slot name in Self;
+ );
+
+ //
+ // Creation.
+ //
+
+ - create f:STRING_CONSTANT name n:STRING_CONSTANT generic_count c:INTEGER :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make f name n generic_count c;
+ result
+ );
+
+ - make f:STRING_CONSTANT name n:STRING_CONSTANT generic_count c:INTEGER <-
+ ( //+ file:STD_FILE;
+ //+ entry:ENTRY;
+ + file:POINTER;
+ + sz,idx:INTEGER;
+ ? {! prototype_dico.fast_has n};
+ ? {n != NULL};
+
+ filename := f;
+ name := n;
+ idx := n.fast_last_index_of '.';
+ (idx != 0).if {
+ string_tmp.copy n;
+ string_tmp.remove_first idx;
+ shortname := ALIAS_STR.get string_tmp;
+ } else {
+ shortname := n;
+ };
+ generic_count := c;
+ idf_generic_list := FAST_ARRAY(ITM_TYPE_PARAMETER).create_with_capacity c;
+
+ // Collection.
+ index := prototype_list.count;
+ prototype_list.add_last Self;
+ prototype_dico.fast_put Self to f;
+
+ // Read file.
+ //entry := FILE_SYSTEM.get f;
+ //file ?= entry.open_read_only;
+ //source := STRING.create (file.size);
+ //file.read source size (file.size);
+ //file.close;
+
+ file := FS_MIN.open_read f;
+ sz := FS_MIN.file_size file;
+ source := STRING.create (sz+1);
+ FS_MIN.read file in source size sz;
+ FS_MIN.close file;
+
+ // Init.
+ slot_list := HASHED_DICTIONARY(ITM_SLOT,STRING_CONSTANT).create;
+ position := POSITION.create Self line 1 column 0;
+ //
+ );
+
+ //
+ // Execute.
+ //
+
+ - depend <-
+ ( + slot_main:SLOT;
+ + self_main:EXPR;
+ + base:NODE;
+ + pass_count_depend:INTEGER;
+ + i:INSTR;
+ + cmd:STRING_CONSTANT;
+
+ + buf:STRING;
+
+ //
+ // Creation list execution.
+ //
+ list_current := LIST.create position;
+ (debug_level_option != 0).if {
+ // Debug mode : Add context local.
+ context_main := TYPE_CONTEXT.default.new_local position
+ name (ALIAS_STR.variable_context) style '+';
+ context_main.set_ensure_count 1;
+ list_current.add_last (PUSH.create position context context_main first TRUE);
+ };
+
+ // Command argument.
+ (is_ansi).if {
+ (is_java).if {
+ cmd := "arg = parg";
+ } else {
+ string_tmp.clear;
+ (debug_level_option != 0).if {
+ string_tmp.copy "signal(SIGINT,interrupt_signal);\n ";
+ };
+ string_tmp.append
+ "arg_count = argc;\n\
+ \ arg_vector = argv;\n\
+ \#ifdef _PTHREAD_H\n\
+ \ pthread_key_create(¤t_thread, NULL);\n\
+ \ pthread_attr_init(&thread_attr);\n\
+ \ /*pthread_attr_setdetachstate(&thread_attr,PTHREAD_CREATE_DETACHED);*/\n\
+ \#endif\n ";
+ cmd := ALIAS_STR.get string_tmp;
+ };
+ i := EXTERNAL_C.create position text cmd
+ access NULL persistant TRUE type (TYPE_VOID.default);
+ list_current.add_last i;
+ };
+ // Main Call.
+ slot_main := get_slot_main;
+ self_main := PROTOTYPE_CST.create position type (type_input.default);
+ base := NODE.new_read (slot_main.position) slot slot_main
+ receiver self_main self self_main intern TRUE;
+ list_current.add_last base;
+
+ // Result.
+ list_current.add_last (INTEGER_CST.create position value 0 type (type_integer.default));
+ list_main := list_current;
+
+ //
+ // Detect life code.
+ //
+ pass_count := 1;
+ (is_quiet).if_false {
+ STD_ERROR.put_string "Depending pass: .";
+ };
+ {modify_count != 0}.while_do {
+ modify_count := 0;
+ (is_quiet).if_false {
+ STD_ERROR.put_string ".";
+ };
+ pass_count := pass_count + 1;
+ NODE.extend_pass;
+ };
+
+ (is_quiet).if_false {
+ STD_ERROR.put_string " (";
+ STD_ERROR.put_integer pass_count;
+ STD_ERROR.put_string ")\n";
+ };
+
+ buf := STRING.create 2000;
+
+ (is_verbose).if {
+ PROFIL_LIST.display;
+ };
+
+ //
+ // Evaluation.
+ //
+ (is_quiet).if_false {
+ STD_ERROR.put_string "Executing pass: ";
+ };
+ pass_count_depend := pass_count;
+
+ // First pass (recursive)
+ is_executing_pass := TRUE;
+ (is_quiet).if_false {
+ STD_ERROR.put_string "*";
+ };
+ pass_count := pass_count + 1;
+ PROFIL_LIST.execute_pass_recursive;
+ // End first pass.
+ {
+ modify_count := 0;
+ null_counter := 0;
+ (is_quiet).if_false {
+ STD_ERROR.put_string ".";
+ };
+ pass_count := pass_count + 1;
+
+ SWITCH.reset_switch_new_pass;
+
+ PROFIL_LIST.execute_pass;
+
+ (SWITCH.switch_new_pass).if {
+ new_execute_pass;
+ };
+
+ }.do_while
+ //{pass_count < 40};
+ {modify_count != 0};
+
+ (is_quiet).if_false {
+ STD_ERROR.put_string " (";
+ STD_ERROR.put_integer (pass_count - pass_count_depend);
+ STD_ERROR.put_string ")\n";
+ };
+ //
+ (is_verbose).if {
+ list_main.debug_display;
+ PROFIL_LIST.display;
+ };
+ );
+
+ //
+ // Type C
+ //
+
+ + type_c :STRING_CONSTANT;
+
+ - set_c_type n:STRING_CONSTANT <-
+ (
+ type_c := n;
+ );
+
+ //
+ // Shorter.
+ //
+
+ + comment_slot:STRING_CONSTANT;
+ + comment_header:STRING_CONSTANT;
+
+ - set_comment_slot t:STRING_CONSTANT <-
+ (
+ comment_slot := t;
+ );
+
+ - set_comment_header t:STRING_CONSTANT <-
+ (
+ comment_header := t;
+ );
+
+ - shorter_out buf:STRING <-
+ ( + title:STRING_CONSTANT;
+ + s:ITM_SLOT;
+ put name to buf like (ALIAS_STR.short_title);
+
+ (comment_slot != NULL).if {
+ put comment_slot to buf like (ALIAS_STR.short_prototype_comment_light);
+ };
+ (comment_header != NULL).if {
+ put comment_header to buf like (ALIAS_STR.short_prototype_comment);
+ };
+
+ list_tmp.clear;
+ shorter_get_all_slot_in list_tmp;
+
+ // Table.
+ shorter_table list_tmp select { sl:ITM_SLOT;
+ sl.id_section.is_inherit_or_insert
+ } title "Inherit/Insert Summary" in buf;
+
+ shorter_table list_tmp select { sl:ITM_SLOT;
+ sl.name.has_prefix "create"
+ } title "Constructor Summary" in buf;
+
+ (list_tmp.lower).to (list_tmp.upper) do { j:INTEGER;
+ s := list_tmp.item j;
+ (s.stat_shorter = 0).if {
+ title := s.comment_chapter;
+ shorter_table list_tmp select { sl:ITM_SLOT;
+ sl.comment_chapter = title
+ } title title in buf;
+ };
+ };
+
+ // Detail.
+ shorter_detail list_tmp select { sl:ITM_SLOT;
+ sl.id_section.is_inherit_or_insert
+ } title "Inherit/Insert Detail" in buf;
+
+ shorter_detail list_tmp select { sl:ITM_SLOT;
+ sl.name.has_prefix "create"
+ } title "Constructor Detail" in buf;
+
+ (list_tmp.lower).to (list_tmp.upper) do { j:INTEGER;
+ s := list_tmp.item j;
+ (s.stat_shorter = 1).if {
+ title := s.comment_chapter;
+ shorter_detail list_tmp select { sl:ITM_SLOT;
+ sl.comment_chapter = title
+ } title title in buf;
+ };
+ };
+
+ (list_tmp.lower).to (list_tmp.upper) do { j:INTEGER;
+ list_tmp.item j.set_stat_shorter 0;
+ };
+ );
+
+Section PROTOTYPE
+
+ - get_slot_main:SLOT <-
+ ( + result:SLOT;
+ + s:ITM_SLOT;
+
+ s := first_slot;
+ {
+ ((s.id_section.is_public) && {s.name = ALIAS_STR.slot_main}).if {
+ (s.result_type != ITM_TYPE_SIMPLE.type_void).if {
+ semantic_error ((s.position),"Unix mode: Not value return.");
+ };
+ (s.argument_count != 1).if {
+ semantic_error ((s.position),"Unix mode: Not argument list.");
+ };
+ result := type_input.get_slot (s.name);
+ };
+ s := s.next;
+ }.do_while {(s != NULL) && {result = NULL}};
+
+ (result = NULL).if {
+ semantic_error (position,"Entry point not found (slot `main' in `Section Public').");
+ };
+ result
+ );
+
+ - shorter_get_all_slot_in lst:FAST_ARRAY(ITM_SLOT) <-
+ ( + s:ITM_SLOT;
+ + ps:ITM_TYPE_SIMPLE;
+ + p:PROTOTYPE;
+ + i:INTEGER;
+
+ s := first_slot;
+ {s != NULL}.while_do {
+ (is_short_private || {! s.id_section.is_private}).if {
+ i := lst.lower;
+ {(i <= lst.upper) && {lst.item i.name != s.name}}.while_do {
+ i := i + 1;
+ };
+ (i > lst.upper).if {
+ lst.add_last s;
+ };
+ };
+ s := s.next;
+ };
+
+ // Parent.
+ s := first_slot;
+ {(s != NULL) && {s.id_section.is_inherit_or_insert}}.while_do {
+ ps ?= s.result_type;
+ ((ps != NULL) && {
+ ({s.style = '+'} && {ps.style = ALIAS_STR.keyword_expanded}) ||
+ {s.name.has_prefix "inherit"} || {s.name.has_prefix "insert"}
+ }).if {
+ p := NULL;
+ i := prototype_list.lower;
+ {(i <= prototype_list.upper) && {p = NULL}}.while_do {
+ (prototype_list.item i.name = ps.name).if {
+ p := prototype_list.item i;
+ };
+ i := i + 1;
+ };
+ (p != NULL).if {
+ p.shorter_get_all_slot_in lst;
+ };
+ };
+ s := s.next;
+ };
+ );
+
+ - shorter_table lst:FAST_ARRAY(ITM_SLOT) select sel:BLOCK
+ title t:STRING_CONSTANT in buf:STRING <-
+ ( + is_first_cur:BOOLEAN;
+ + s:ITM_SLOT;
+
+ is_first_cur := TRUE;
+ (lst.lower).to (lst.upper) do { i:INTEGER;
+ s := lst.item i;
+ ((sel.value s) && {s.stat_shorter = 0}).if {
+ (is_first_cur).if {
+ (t = NULL).if {
+ put "Slot Summary" to buf like (ALIAS_STR.short_table_begin);
+ } else {
+ put t to buf like (ALIAS_STR.short_table_begin);
+ };
+ is_first_cur := FALSE;
+ };
+ s.set_stat_shorter 1;
+ string_tmp.clear;
+ string_tmp2.clear;
+ s.pretty_name_in string_tmp2;
+ put string_tmp2 to string_tmp like (ALIAS_STR.short_table_slot_name);
+ (
+ (s.id_section.is_inherit_or_insert) &&
+ {
+ (
+ (s.style != '+') || {
+ + ts:ITM_TYPE_SIMPLE;
+ ts ?= s.result_type;
+ (ts = NULL) || {ts.style != ALIAS_STR.keyword_expanded}
+ }
+ ) &&
+ {! s.name.has_prefix "inherit"} &&
+ {! s.name.has_prefix "insert"}
+ }
+ ).if {
+ put " No developed." to string_tmp like (ALIAS_STR.short_warning);
+ };
+ string_tmp2.clear;
+ get_all_comment_slot (s.name) in string_tmp2;
+ string_tmp3.clear;
+ shorter_comment string_tmp2 in string_tmp3 light TRUE;
+ put string_tmp3 to string_tmp like (ALIAS_STR.short_table_slot_comment);
+ put string_tmp to buf like (ALIAS_STR.short_table_item);
+ };
+ };
+ (is_first_cur).if_false {
+ put NULL to buf like (ALIAS_STR.short_table_end);
+ };
+ );
+
+ - shorter_detail lst:FAST_ARRAY(ITM_SLOT) select sel:BLOCK
+ title t:STRING_CONSTANT in buf:STRING <-
+ ( + is_first:BOOLEAN;
+ + s:ITM_SLOT;
+
+ is_first := TRUE;
+ (lst.lower).to (lst.upper) do { i:INTEGER;
+ s := lst.item i;
+ ((sel.value s) && {s.stat_shorter = 1}).if {
+ (is_first).if {
+ (t = NULL).if {
+ put "Detail slot" to buf like (ALIAS_STR.short_sub_title);
+ } else {
+ put t to buf like (ALIAS_STR.short_sub_title);
+ };
+ is_first := FALSE;
+ };
+ s.set_stat_shorter 2;
+ //
+ string_tmp2.clear;
+ s.pretty_name_in string_tmp2;
+ put string_tmp2 to buf like (ALIAS_STR.short_slot_title);
+ string_tmp.copy (s.position.prototype.filename);
+ string_tmp.append " line #";
+ s.position.line.append_in string_tmp;
+ put string_tmp to buf like (ALIAS_STR.short_prototype_path);
+ //
+ put "Section:" to buf like (ALIAS_STR.short_subsub_title);
+ string_tmp.clear;
+ s.id_section.append_in string_tmp;
+ put string_tmp to buf like (ALIAS_STR.short_keyword_section);
+ //
+ put "Profile:" to buf like (ALIAS_STR.short_subsub_title);
+ s.shorter_profile_in buf;
+ //
+ string_tmp.clear;
+ get_all_comment_slot (s.name) in string_tmp;
+ shorter_comment string_tmp in buf light FALSE;
+ };
+ };
+ );
+
+ - get_all_comment_slot n:STRING_CONSTANT in buf:STRING <-
+ ( + s:ITM_SLOT;
+ + ps:ITM_TYPE_SIMPLE;
+ + p:PROTOTYPE;
+ + i:INTEGER;
+
+ s := slot_list.fast_reference_at n;
+ ((s != NULL) && {s.comment != NULL}).if {
+ buf.append (s.comment);
+ };
+ // Parent.
+ s := first_slot;
+ {(s != NULL) && {s.id_section.is_inherit_or_insert}}.while_do {
+ ps ?= s.result_type;
+ (ps != NULL).if {
+ p := NULL;
+ i := prototype_list.lower;
+ {(i <= prototype_list.upper) && {p = NULL}}.while_do {
+ (prototype_list.item i.name = ps.name).if {
+ p := prototype_list.item i;
+ };
+ i := i + 1;
+ };
+ (p != NULL).if {
+ p.get_all_comment_slot n in buf;
+ };
+ };
+ s := s.next;
+ };
+ );
+
+ - list_tmp:FAST_ARRAY(ITM_SLOT) := FAST_ARRAY(ITM_SLOT).create_with_capacity 256;
+
+ - str_tmp:STRING := STRING.create 512;
+ - str_tmp2:STRING := STRING.create 64;
+ - str_tmp3:STRING := STRING.create 64;
+
+ - shorter_comment str:STRING in buf:STRING light is_light:BOOLEAN <-
+ ( + cur:INTEGER;
+ + stat,old_stat:INTEGER;
+ + car:CHARACTER;
+ + i:INTEGER;
+ + lst:LINKED_LIST(STRING_CONSTANT);
+ + code_balise:STRING_CONSTANT;
+
+ cur := str.lower;
+ str_tmp.clear;
+ code_balise := ALIAS_STR.short_comment_slot_line;
+ {cur <= str.upper}.while_do {
+ car := str.item cur;
+ (stat)
+ .when 0 then {
+ // Begin.
+ (car = '*').if {
+ (str_tmp.count > 1).if {
+ (is_light).if {
+ buf.append str_tmp;
+ cur := str.upper + 1;
+ } else {
+ put "Description:" to buf like (ALIAS_STR.short_subsub_title);
+ put str_tmp to buf like code_balise;
+ };
+ };
+ str_tmp.clear;
+ stat := 1;
+ }.elseif {car = '`'} then {
+ old_stat := stat;
+ stat := 2;
+ str_tmp2.clear;
+ } else {
+ str_tmp.add_last car;
+ };
+ }
+ .when 1 then {
+ // Begin slot.
+ (car.to_lower.in_range 'a' to 'z').if {
+ str_tmp.add_last (car.to_lower);
+ }.elseif {(car = ' ') && {!str_tmp.is_empty}} then {
+ str_tmp.add_last '_';
+ }.elseif {car = ':'} then {
+ (str_tmp.count != 0).if {
+ code_balise := ALIAS_STR.get str_tmp;
+ lst := PARSER.short_dico.fast_reference_at code_balise;
+ (lst = NULL).if {
+ code_balise := NULL;
+ } else {
+ str_tmp.replace_all '_' with ' ';
+ str_tmp.add_last ':';
+ str_tmp.put (str_tmp.first.to_upper) to 1;
+ put str_tmp to buf like (ALIAS_STR.short_subsub_title);
+ };
+ };
+ str_tmp.clear;
+ stat := 3;
+ };
+ }
+ .when 2 then {
+ // Begin ref.
+ (car = '\'').if {
+ (code_balise != NULL).if {
+ i := list_tmp.lower;
+ {
+ (i <= list_tmp.upper) && {
+ str_tmp3.clear;
+ list_tmp.item i.pretty_name_in str_tmp3;
+ ! (str_tmp3 == str_tmp2)
+ }
+ }.while_do {
+ i := i + 1;
+ };
+ (i <= list_tmp.upper).if {
+ put str_tmp2 to str_tmp like (ALIAS_STR.short_identifier_slot);
+ } else {
+ put str_tmp2 to str_tmp like (ALIAS_STR.short_identifier);
+ };
+ };
+ stat := old_stat;
+ } else {
+ str_tmp2.add_last car;
+ };
+ }
+ .when 3 then {
+ // Read slot.
+ (car = '*').if {
+ (str_tmp.count > 1).if {
+ put str_tmp to buf like code_balise;
+ };
+ str_tmp.clear;
+ stat := 1;
+ }.elseif {car = '`'} then {
+ old_stat := stat;
+ stat := 2;
+ str_tmp2.clear;
+ } else {
+ str_tmp.add_last car;
+ };
+ };
+ cur := cur + 1;
+ };
+ (str_tmp.count > 1).if {
+ (is_light).if {
+ buf.append str_tmp;
+ } else {
+ (stat = 0).if {
+ put "Description:" to buf like (ALIAS_STR.short_subsub_title);
+ };
+ put str_tmp to buf like code_balise;
+ };
+ };
+ );
\ No newline at end of file
diff --git a/src2/type/type.li b/src2/type/type.li
new file mode 100644
index 0000000..95f3170
--- /dev/null
+++ b/src2/type/type.li
@@ -0,0 +1,1038 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type without style";
+
+Section Inherit
+
+ - parent_hashable:HASHABLE := HASHABLE;
+
+ + parent_any:Expanded ANY;
+
+ - parent_parameter_to_type:Expanded PARAMETER_TO_TYPE;
+
+Section TYPE
+
+ - dico_type:HASHED_DICTIONARY(TYPE,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(TYPE,STRING_CONSTANT).create;
+
+ - index_count:INTEGER;
+
+Section Public
+
+ + param_count:INTEGER;
+
+ - set_param n:INTEGER <-
+ (
+ param_count := param_count.max n;
+ );
+
+ + subtype_list:HASHED_SET(TYPE);
+
+ + default:TYPE_FULL;
+
+ + size:INTEGER;
+
+ - position:POSITION <- prototype.position;
+
+ - parameter_to_type p:ITM_TYPE_PARAMETER :TYPE_FULL <-
+ (
+ NULL
+ );
+
+ //
+ //
+ //
+
+ + last_pass_binding:INTEGER;
+
+ - is_late_binding:BOOLEAN <- pass_count = last_pass_binding;
+
+ - set_late_binding <-
+ (
+ last_pass_binding := pass_count;
+ );
+
+ //
+ //
+ //
+
+ + itm_type:ITM_TYPE_SIMPLE;
+
+ + prototype:PROTOTYPE;
+
+ - type_c:STRING_CONSTANT <- prototype.type_c;
+
+ + slot_run:FAST_ARRAY(SLOT);
+
+ + index:INTEGER;
+
+ + intern_name:STRING_CONSTANT;
+
+ - name:STRING_CONSTANT <- prototype.name;
+
+ - hash_code:INTEGER <- intern_name.hash_code;
+
+ - key:STRING_CONSTANT <- prototype.filename;
+
+ //
+ // Get.
+ //
+
+ - get itm_typ:ITM_TYPE_SIMPLE :TYPE_FULL <-
+ ( + result:TYPE_FULL;
+ + base:TYPE;
+ + styl:STRING_CONSTANT;
+ + proto:PROTOTYPE;
+
+ proto := load_prototype (itm_typ.name) generic_count 0;
+ base := dico_type.fast_reference_at (proto.filename);
+ (base = NULL).if {
+ base := TYPE.clone;
+ dico_type.fast_put base to (proto.filename);
+ base.make itm_typ with proto;
+ };
+ //
+ styl := itm_typ.style;
+ (styl = NULL).if {
+ result := base.default;
+ } else {
+ (styl = ALIAS_STR.keyword_expanded).if {
+ result := base.default + TYPE_FULL.expanded_bit;
+ } else {
+ result := base.default + TYPE_FULL.strict_bit;
+ };
+ };
+ result
+ );
+
+ //
+ // Contract
+ //
+
+ - last_type_contract:TYPE;
+
+ - search_require n:STRING_CONSTANT :ITM_SLOT <-
+ ( + j:INTEGER;
+ + result:ITM_SLOT;
+ + typ:TYPE;
+ + ts:ITM_TYPE_SIMPLE;
+
+ j := slot_run.lower;
+ {
+ (j <= slot_run.upper) &&
+ {slot_run.item j.id_section.is_inherit_or_insert} &&
+ {result = NULL}
+ }.while_do {
+ ts ?= slot_run.item j.result_type;
+ typ := ts.to_run_for Self.raw;
+ result := typ.prototype.slot_list.fast_reference_at n;
+ ((result = NULL) || {result.require = NULL}).if {
+ result := typ.search_require n;
+ } else {
+ last_type_contract := typ;
+ };
+ j := j + 1;
+ };
+ result
+ );
+
+ - search_ensure n:STRING_CONSTANT :ITM_SLOT <-
+ ( + j:INTEGER;
+ + result:ITM_SLOT;
+ + typ:TYPE;
+ + ts:ITM_TYPE_SIMPLE;
+
+ j := slot_run.lower;
+ {
+ (j <= slot_run.upper) &&
+ {slot_run.item j.id_section.is_inherit_or_insert} &&
+ {result = NULL}
+ }.while_do {
+ ts ?= slot_run.item j.result_type;
+ typ := ts.to_run_for Self.raw;
+ result := typ.prototype.slot_list.fast_reference_at n;
+ ((result = NULL) || {result.ensure = NULL}).if {
+ result := typ.search_ensure n;
+ } else {
+ last_type_contract := typ;
+ };
+ j := j + 1;
+ };
+ result
+ );
+
+ //
+ // Searching.
+ //
+
+ - add_subtype t:TYPE <-
+ ( + j:INTEGER;
+ + it:ITM_TYPE_MONO;
+
+ (! subtype_list.fast_has t).if {
+ subtype_list.fast_add t;
+ j := slot_run.lower;
+ {
+ (j <= slot_run.upper) &&
+ {slot_run.item j.id_section.is_inherit_or_insert}
+ }.while_do {
+ (slot_run.item j.id_section.is_inherit).if {
+ it ?= slot_run.item j.result_type;
+ it.to_run_for Self.raw.add_subtype t;
+ };
+ j := j + 1;
+ };
+ };
+ );
+
+ - get_slot n:STRING_CONSTANT :SLOT <-
+ // Static lookup algorithm.
+ ( + result:SLOT;
+ + j:INTEGER;
+ + it:ITM_TYPE_MONO;
+
+ result := get_local_slot n;
+ (result = NULL).if {
+ j := slot_run.lower;
+ {
+ (j <= slot_run.upper) &&
+ {slot_run.item j.id_section.is_inherit_or_insert} &&
+ {result = NULL}
+ }.while_do {
+ it ?= slot_run.item j.result_type;
+ result := it.to_run_for Self.get_slot n;
+ j := j + 1;
+ };
+ };
+ result
+ );
+
+ - get_local_slot n:STRING_CONSTANT :SLOT <-
+ ( + j:INTEGER;
+ + itm_slot:ITM_SLOT;
+ + result:SLOT;
+
+ j := slot_run.lower;
+ {(j <= slot_run.upper) && {slot_run.item j.name != n}}.while_do {
+ j := j + 1;
+ };
+ (j <= slot_run.upper).if {
+ result := slot_run.item j;
+ } else {
+ itm_slot := prototype.slot_list.fast_reference_at n;
+ (itm_slot != NULL).if {
+ result := SLOT.create itm_slot type Self;
+ slot_run.add_last result;
+ };
+ };
+ result
+ );
+
+ - get_path_slot n:STRING_CONSTANT :SLOT <-
+ ( + result:SLOT;
+ + j:INTEGER;
+ + it:ITM_TYPE_MONO;
+
+ j := slot_run.lower;
+ {result = NULL}.while_do {
+ ? {j <= slot_run.upper};
+ ? {slot_run.item j.id_section.is_inherit_or_insert};
+ it ?= slot_run.item j.result_type;
+ result := it.to_run_for Self.get_slot n;
+ j := j + 1;
+ };
+ ? {result != NULL};
+ slot_run.item (j-1)
+ );
+
+ //
+ // Import / Export
+ //
+
+ - last_cast_name:STRING := STRING.create 32;
+
+ - is_export_to t:TYPE_FULL :BOOLEAN <-
+ (
+ is_cast t with (ALIAS_STR.slot_to) on (prototype.export_list)
+ );
+
+ - is_import_to t:TYPE_FULL :BOOLEAN <-
+ (
+ is_cast t with (ALIAS_STR.slot_from) on (prototype.import_list)
+ );
+
+Section Private
+
+ - is_cast t:TYPE_FULL with msg:STRING_CONSTANT on lst:FAST_ARRAY(ITM_TYPE_MONO) :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ (lst != NULL).if {
+ j := lst.lower;
+ {(j <= lst.upper) && {lst.item j.to_run_for profil_slot != t}}.while_do {
+ j := j + 1;
+ };
+ (j <= lst.upper).if {
+ result := TRUE;
+ last_cast_name.copy msg;
+ lst.item j.append_cast_name_in last_cast_name;
+ };
+ };
+ result
+ );
+
+Section Public
+
+ //
+ // Genere.
+ //
+
+ - genere_list:FAST_ARRAY(TYPE) := FAST_ARRAY(TYPE).create_with_capacity 128;
+
+ - add_genere_list <-
+ (
+ ((slot_run != NULL) && {(slot_run.is_empty) || {slot_run.first != NULL}}).if {
+ (genere_list.fast_first_index_of Self > genere_list.upper).if { // BSBS: a revoir !!
+ genere_list.add_last Self;
+ };
+ };
+ );
+
+ - genere_all_struct <-
+ (
+ TYPE_NULL.genere_typedef;
+ (genere_list.lower).to (genere_list.upper) do { j:INTEGER;
+ genere_list.item j.genere_typedef;
+ };
+ TYPE_NULL.genere_struct;
+ (genere_list.lower).to (genere_list.upper) do { j:INTEGER;
+ genere_list.item j.genere_struct;
+ };
+ (debug_level_option != 0).if {
+ TYPE_CONTEXT.genere_typedef;
+ TYPE_CONTEXT.genere_struct;
+ };
+ );
+
+ - id_counter_with_type:INTEGER := 4;
+ - id_counter_without_type:INTEGER := 0;
+
+ - slot_size:FAST_ARRAY(FAST_ARRAY(SLOT_DATA)) :=
+ ( + result:FAST_ARRAY(FAST_ARRAY(SLOT_DATA));
+
+ result := FAST_ARRAY(FAST_ARRAY(SLOT_DATA)).create_with_capacity 5;
+ 0.to 4 do { j:INTEGER;
+ result.add_last (FAST_ARRAY(SLOT_DATA).create_with_capacity 8);
+ };
+ result
+ );
+
+ + detect_recursivity_generation:BOOLEAN;
+
+ - genere_struct <-
+ ( + slot_data:SLOT_DATA;
+ + slot:SLOT;
+ + tab:FAST_ARRAY(SLOT_DATA);
+ + action:{SLOT_DATA; };
+ + tg:TYPE_GENERIC;
+ + count_slot:SLOT_DATA;
+ + storage_slot:SLOT_DATA;
+
+ ((slot_run.is_empty) || {slot_run.first != NULL}).if {
+ (detect_recursivity_generation).if {
+ string_tmp.copy "Compiler limit: Cyclic depending structure definition for ";
+ append_name_in string_tmp;
+ string_tmp.add_last '.';
+ semantic_error (position,string_tmp);
+ };
+ detect_recursivity_generation := TRUE;
+ // Depending.
+ (slot_run.lower).to (slot_run.upper) do { j:INTEGER;
+ slot := slot_run.item j;
+ ((slot.style = '+') && {slot.lower_style = 0}).if {
+ action := { s:SLOT_DATA;
+ (
+ (
+ (s.ensure_count > 0) ||
+ {s.id_section.is_mapping}
+ ) &&
+ {s.type.raw != Self} &&
+ {(s.type.is_expanded) || {s.type.raw.is_block}}
+ ).if {
+ s.type.raw.genere_struct;
+ };
+ };
+ (slot.slot_data_list != NULL).if {
+ (slot.slot_data_list.lower).to (slot.slot_data_list.upper) do { k:INTEGER;
+ action.value (slot.slot_data_list.item k);
+ };
+ };
+ action.value (slot.slot_data);
+ };
+ };
+ // Sort slot.
+ (slot_run.lower).to (slot_run.upper) do { j:INTEGER;
+ slot := slot_run.item j;
+ (slot.style = '+').if {
+ // In struct.
+ (slot.lower_style = 0).if {
+ action := { s:SLOT_DATA;
+ (
+ (s.id_section.is_mapping) ||
+ {s.ensure_count > 0}
+ ).if {
+ add_slot_struct s;
+ };
+ };
+ (slot.slot_data_list != NULL).if {
+ (slot.slot_data_list.lower).to (slot.slot_data_list.upper) do { k:INTEGER;
+ action.value (slot.slot_data_list.item k);
+ };
+ };
+ action.value (slot.slot_data);
+ };
+ slot_data := slot.slot_id;
+ ((slot_data != NULL) && {slot_data.ensure_count > 0}).if {
+ add_slot_struct slot_data;
+ };
+ } else {
+ // In global.
+ (slot.lower_style = 0).if {
+ action := { s:SLOT_DATA;
+ (s.ensure_count > 0).if {
+ s.genere output_glob;
+ };
+ };
+ (slot.slot_data_list != NULL).if {
+ (slot.slot_data_list.lower).to (slot.slot_data_list.upper) do { k:INTEGER;
+ action.value (slot.slot_data_list.item k);
+ };
+ };
+ action.value (slot.slot_data);
+ };
+ slot_data := slot.slot_id;
+ ((slot_data != NULL) && {slot_data.ensure_count > 0}).if {
+ slot_data.slot_id.genere output_glob;
+ };
+ };
+ };
+
+ (
+ (prototype.name = ALIAS_STR.prototype_native_array) ||
+ {prototype.name = ALIAS_STR.prototype_native_array_volatile}
+ ).if {
+ tg ?= Self;
+ tg.generic_list.first.raw.genere_struct;
+ } else {
+ (type_c != NULL).if {
+ 0.to 4 do { j:INTEGER;
+ tab := slot_size.item j;
+ // BSBS: A tester sont utilité !
+ (! tab.is_empty).if {
+ semantic_error ((tab.first.position),"Slot is not possible with a type C");
+ };
+ };
+ (is_java).if_false {
+ ((name = ALIAS_STR.prototype_true) ||
+ {name = ALIAS_STR.prototype_false}).if {
+ output_decl.append "#define ";
+ output_decl.append intern_name;
+ output_decl.append "__ ";
+ output_decl.add_last ((name = ALIAS_STR.prototype_true).to_character);
+ output_decl.add_last '\n';
+ }.elseif {is_late_binding} then {
+ semantic_error ((tab.first.position),"Late binding is not possible with a type C");
+ };
+ };
+ } else {
+ output_decl.append "// ";
+ output_decl.append intern_name;
+ output_decl.add_last '\n';
+ (is_java).if {
+ output_decl.append "static private int __";
+ output_decl.append intern_name;
+ output_decl.append "__ = ";
+ } else {
+ output_decl.append "#define __";
+ output_decl.append intern_name;
+ output_decl.append "__ ";
+ };
+ string_tmp.clear;
+ (is_late_binding).if {
+ id_counter_with_type.append_in output_decl;
+ id_counter_with_type := id_counter_with_type + 1;
+ (prototype.style != '-').if {
+ string_tmp.append " unsigned long __id;\n";
+ };
+ (prototype.is_mapping).if {
+ semantic_error ((prototype.position),
+ "Late binding is not possible with `mapping' object.");
+ };
+ } else {
+ id_counter_without_type.append_in output_decl;
+ id_counter_without_type := id_counter_without_type + 1;
+ };
+ (is_java).if {
+ output_decl.add_last ';';
+ };
+ output_decl.add_last '\n';
+ (prototype.style = '-').if {
+ string_tmp.append " lith_object thread;\n";
+ (param_count != 0).if {
+ 1.to param_count do { n:INTEGER;
+ string_tmp.append " int param_";
+ (n-1).append_in string_tmp;
+ string_tmp.append ";\n";
+ };
+ };
+ };
+ 4.downto 0 do { j:INTEGER;
+ tab := slot_size.item j;
+ (tab.lower).to (tab.upper) do { i:INTEGER;
+ slot_data := tab.item i;
+ ((prototype.is_mapping) && {slot_data.type.is_expanded_c}).if {
+ string_tmp.append " volatile ";
+ } else {
+ string_tmp.append " ";
+ };
+ slot_data.genere string_tmp;
+ };
+ tab.clear;
+ };
+
+ (Self = type_block).if {
+ string_tmp.append " void *self;\n";
+ };
+
+ (string_tmp.is_empty).if {
+ string_tmp.append " void *Nothing;\n";
+ };
+
+ (is_java).if {
+ output_decl.append "static class __";
+ output_decl.append intern_name;
+ (is_late_binding).if {
+ output_decl.append " extends __OBJ";
+ };
+ output_decl.append " {\n";
+ output_decl.append string_tmp;
+ (prototype.is_mapping).if {
+ semantic_error (position,"Mapping is not yet implemented for Java code.");
+ };
+ (Self = type_string_constant).if {
+ // STRING_CONSTANT constructor.
+ output_decl.append "\n public __";
+ output_decl.append intern_name;
+ output_decl.add_last '(';
+ (is_late_binding).if {
+ output_decl.append "int pid,";
+ };
+ storage_slot := get_local_slot (ALIAS_STR.slot_storage).slot_data_intern;
+ count_slot := get_local_slot (ALIAS_STR.slot_count).slot_data_intern;
+ (count_slot.ensure_count != 0).if {
+ output_decl.append "int pcount,";
+ };
+ (storage_slot.ensure_count != 0).if {
+ output_decl.append "String pstorage,";
+ };
+ output_decl.remove_last 1;
+ output_decl.append ")\n {\n ";
+ (is_late_binding).if {
+ output_decl.append "__id = pid;\n";
+ };
+ (count_slot.ensure_count != 0).if {
+ output_decl.append (count_slot.intern_name);
+ output_decl.append " = pcount;\n";
+ };
+ (storage_slot.ensure_count != 0).if {
+ output_decl.append (storage_slot.intern_name);
+ output_decl.append " = pstorage.toCharArray();\n";
+ };
+ output_decl.append " };\n";
+ };
+ // Basic Constructor.
+ output_decl.append "\n public __";
+ output_decl.append intern_name;
+ output_decl.add_last '(';
+ (is_late_binding).if {
+ output_decl.append "int pid";
+ };
+ output_decl.append ")\n {\n ";
+ (is_late_binding).if {
+ output_decl.append "__id = pid;\n";
+ } else {
+ output_decl.append "super();\n";
+ };
+ output_decl.append " };\n};\n";
+ } else {
+ output_decl.append "struct ";
+ output_decl.append intern_name;
+ output_decl.append "_struct {\n";
+ output_decl.append string_tmp;
+ (prototype.is_mapping).if {
+ output_decl.append "} __attribute__ ((packed));\n";
+ } else {
+ output_decl.append "};\n";
+ };
+ };
+ // Prototype declaration.
+ (is_java).if {
+ output_glob.append "private static __";
+ output_glob.append intern_name;
+ output_glob.add_last ' ';
+ output_glob.append intern_name;
+ output_glob.append "_=new __";
+ output_glob.append intern_name;
+ output_glob.add_last '(';
+ (is_late_binding).if {
+ output_glob.append "__";
+ output_glob.append intern_name;
+ output_glob.append "__";
+ };
+ output_glob.append ");\n";
+ } else {
+ output_glob.append "__";
+ output_glob.append intern_name;
+ output_glob.add_last ' ';
+ output_glob.append intern_name;
+ output_glob.add_last '_';
+ (is_late_binding).if {
+ output_glob.append "={__";
+ output_glob.append intern_name;
+ output_glob.append "__}";
+ };
+ output_glob.append ";\n";
+ output_glob.append "#define ";
+ output_glob.append intern_name;
+ output_glob.append "__ (&";
+ output_glob.append intern_name;
+ output_glob.append "_)\n\n";
+ };
+ };
+ };
+
+ // Flag on:
+ slot_run.force NULL to 0;
+ };
+ );
+
+ - genere_typedef <-
+ ( + tg:TYPE_GENERIC;
+
+ (
+ (prototype.name = ALIAS_STR.prototype_native_array) ||
+ {prototype.name = ALIAS_STR.prototype_native_array_volatile}
+ ).if {
+ tg ?= Self;
+ tg.generic_list.first.raw.genere_typedef;
+ } else {
+ output_decl.append "typedef ";
+ (type_c != NULL).if {
+ output_decl.append type_c;
+ } else {
+ output_decl.append "struct ";
+ output_decl.append intern_name;
+ output_decl.append "_struct";
+ };
+ output_decl.append " __";
+ output_decl.append intern_name;
+ output_decl.append ";\n";
+ };
+ );
+
+Section Private
+
+ - add_slot_struct s:SLOT_DATA <-
+ (
+ (prototype.is_mapping).if {
+ (s.id_section.is_mapping).if {
+ slot_size.first.add_last s;
+ } else {
+ semantic_error (s.position,"Slot is not in `Mapping' section.");
+ };
+ } else {
+ ((s.type.is_expanded) && {! s.type.is_default_expanded}).if {
+ slot_size.item 4.add_last s;
+ } else {
+ slot_size.item (s.type.size).add_last s;
+ };
+ };
+ );
+
+Section Public
+
+ //
+ // Declaration generation.
+ //
+
+ - put_reference_declaration buffer:STRING <-
+ (
+ buffer.append "__";
+ buffer.append intern_name;
+ add_genere_list;
+ );
+
+ - put_reference_star_declaration buffer:STRING <-
+ (
+ (is_block).if_false { // BSBS: A mettre dans TYPE_BLOCK
+ (is_java).if {
+ buffer.append "[]";
+ } else {
+ buffer.add_last '*';
+ };
+ };
+ );
+
+ - put_expanded_declaration buffer:STRING <-
+ (
+ ((is_java) && {type_c != NULL}).if {
+ buffer.append type_c;
+ } else {
+ buffer.append "__";
+ buffer.append intern_name;
+ };
+ add_genere_list;
+ );
+
+ - put_generic_declaration buffer:STRING <-
+ (
+ (is_block).if { // BSBS: A mettre dans TYPE_BLOCK
+ put_expanded_declaration buffer;
+ } else {
+ (is_java).if {
+ buffer.append "__OBJ ";
+ } else {
+ buffer.append (ALIAS_STR.c_void);
+ };
+ };
+ );
+
+ //
+ // Code source generation.
+ //
+
+ - put_id buffer:STRING <-
+ (
+ buffer.append (ALIAS_STR.separate); // <=> "__"
+ buffer.append intern_name;
+ buffer.append (ALIAS_STR.separate);
+ );
+
+ - put_access_id e:EXPR in buffer:STRING <-
+ // For switch.
+ ( + t:TYPE;
+
+ t := e.static_type.raw;
+ (t = type_boolean).if {
+ e.genere buffer;
+ }.elseif {t = type_block} then {
+ e.genere buffer;
+ //buffer.append ".__id";
+ } else {
+ (is_java).if {
+ e.genere buffer;
+ buffer.append ".__id";
+ } else {
+ buffer.append "((struct ___OBJ *)";
+ e.genere buffer;
+ buffer.append ")->__id";
+ };
+ };
+ );
+
+ - put_value buffer:STRING <-
+ (
+ buffer.append intern_name;
+ buffer.append (ALIAS_STR.separate);
+ add_genere_list;
+ );
+
+ //
+ // Display.
+ //
+
+ - append_name_in buf:STRING <-
+ (
+ buf.append name;
+ );
+
+ - print <-
+ (
+ string_tmp.clear;
+ append_name_in string_tmp;
+ string_tmp.print;
+ );
+
+Section Public
+
+ - is_block:BOOLEAN := FALSE;
+
+ - Self:SELF '==' Right 60 other:TYPE :BOOLEAN <- (Self = other);
+
+ - is_sub_type other:TYPE :BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ (Self = other).if {
+ result := TRUE;
+ }.elseif {other.subtype_list != NULL} then {
+ result := other.subtype_list.fast_has Self;
+ };
+ result
+ );
+
+ - is_sub_type_with_name n:STRING_CONSTANT :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + idx:INTEGER;
+ + type_parent:TYPE;
+ + ts:ITM_TYPE_SIMPLE;
+
+ (n = prototype.name).if {
+ result := TRUE;
+ } else {
+ idx := slot_run.lower;
+ {
+ (idx <= slot_run.upper) &&
+ {slot_run.item idx.id_section.is_inherit_or_insert} &&
+ {! result}
+ }.while_do {
+ (slot_run.item idx.id_section.is_inherit).if {
+ ts ?= slot_run.item idx.result_type;
+ type_parent := ts.to_run_for Self.raw;
+ result := type_parent.is_sub_type_with_name n;
+ };
+ idx := idx + 1;
+ };
+ };
+ result
+ );
+
+Section TYPE
+
+ - load_prototype n:STRING_CONSTANT generic_count gen_count:INTEGER :PROTOTYPE <-
+ ( + j,idx_path,idx_name,idx_name_old,idx_path_old:INTEGER;
+ + entry:POINTER;
+ + result:PROTOTYPE;
+ + path,found:STRING_CONSTANT;
+ + cn,cp:CHARACTER;
+ + read_char:{};
+
+ result := dico_name_to_prototype.fast_reference_at n;
+ (result = NULL).if {
+ read_char := {
+ cn := n.item idx_name;
+ (cn = '.').if {
+ (
+ (idx_name > n.lower+1) &&
+ {n.item (idx_name-1) = '.'} &&
+ {n.item (idx_name-2) = '.'}
+ ).if {
+ idx_name := idx_name - 2;
+ cn := '*';
+ } else {
+ cn := '/';
+ };
+ } else {
+ cn := cn.to_lower;
+ };
+ };
+ j := path_file.lower;
+ {(j > path_file.upper) || {result != NULL}}.until_do {
+ path := path_file.item j;
+ idx_name := n.upper;
+ idx_path := path.upper-3; // ".li"
+ {
+ read_char.value;
+ cp := path.item idx_path;
+ idx_name := idx_name - 1;
+ idx_path := idx_path - 1;
+ }.do_while {
+ (idx_name >= n.lower) &&
+ {idx_path >= path.lower} &&
+ {cn = cp}
+ };
+ ((idx_name < n.lower) && {cn = cp}).if {
+ ((idx_path < path.lower) || {path.item idx_path = '/'}).if {
+ found := path;
+ };
+ }.elseif {(cn = '*') && {cp = '/'}} then {
+ idx_name_old := idx_name+1;
+ idx_path_old := idx_path+1;
+ {(idx_name >= n.lower) && {idx_path >= path.lower}}.while_do {
+ read_char.value;
+ cp := path.item idx_path;
+ (cn = cp).if {
+ // Nothing.
+ }.elseif {(cn = '*') && {cp = '/'}} then {
+ idx_name_old := idx_name;
+ idx_path_old := idx_path;
+ } else {
+ idx_name := idx_name_old;
+ idx_path := idx_path_old;
+ {
+ idx_path := idx_path - 1;
+ }.do_while {(idx_path >= path.lower) && {path.item idx_path != '/'}};
+ idx_path_old := idx_path;
+ };
+ idx_name := idx_name - 1;
+ idx_path := idx_path - 1;
+ };
+ (idx_name < n.lower).if {
+ found := path;
+ };
+ };
+ (found != NULL).if {
+ result := PROTOTYPE.prototype_dico.fast_reference_at found;
+ (result = NULL).if {
+ entry := FS_MIN.open_read found;
+ ((entry != NULL) /*&& {entry.is_file}*/).if {
+ // Load prototype.
+ FS_MIN.close entry;
+ result := PROTOTYPE.create found name n generic_count gen_count;
+ PARSER.go_on result;
+ } else {
+ string_tmp.copy "Cannot open `";
+ string_tmp.append found;
+ string_tmp.append "'.";
+ semantic_error (last_position,string_tmp);
+ };
+ };
+ dico_name_to_prototype.add result to n;
+ };
+ j := j + 1;
+ };
+ (result = NULL).if {
+ string_tmp.copy n;
+ string_tmp.append " is not found.";
+ POSITION.put_error semantic text string_tmp;
+ (list_current != NULL).if {
+ list_current.position.put_position;
+ };
+ POSITION.send_error;
+ };
+ };
+ (result.generic_count != gen_count).if {
+ //crash;
+ POSITION.put_error semantic text "Incorrect genericity definition.";
+ result.position.put_position;
+ (last_position.code != 0).if {
+ last_position.put_position;
+ } else {
+ ? {crash; TRUE};
+ };
+ POSITION.send_error;
+ };
+ result
+ );
+
+ - make itm_typ:ITM_TYPE_SIMPLE with proto:PROTOTYPE <-
+ ( + mask_bit:UINTEGER_8;
+
+ index := index_count;
+ index_count := index_count + 1;
+ prototype := proto;
+ string_tmp.copy name;
+ string_tmp.replace_all '.' with '_';
+ intern_name := ALIAS_STR.get_intern string_tmp;
+ itm_type := itm_typ;
+ slot_run := FAST_ARRAY(SLOT).create_with_capacity 10; // BSBS: A voir.
+ (prototype.type_style = ALIAS_STR.keyword_expanded).if {
+ // Expanded.
+ mask_bit := TYPE_FULL.expanded_bit | TYPE_FULL.default_expanded_bit;
+ }.elseif {prototype.type_style = ALIAS_STR.keyword_strict} then {
+ // Strict.
+ mask_bit := TYPE_FULL.strict_bit | TYPE_FULL.default_strict_bit;
+ };
+ default := TYPE_FULL.create Self with mask_bit;
+ prototype.init_slot_for Self;
+ //
+ subtype_list := HASHED_SET(TYPE).create;
+ subtype_list.fast_add TYPE_NULL;
+ add_subtype Self;
+ // Size.
+ (POINTER.object_size = 4).if {
+ size := 2; // 32 bits
+ } else {
+ size := 3; // 64 bits
+ };
+ name
+ .when (ALIAS_STR.prototype_integer) then {
+ size := 2; // 32 bits
+ }
+ .when (ALIAS_STR.prototype_integer_8) or (ALIAS_STR.prototype_uinteger_8) then {
+ size := 0; // 8 bits
+ }
+ .when (ALIAS_STR.prototype_character) or (ALIAS_STR.prototype_boolean) then {
+ size := 0; // 8 bits
+ }
+ .when (ALIAS_STR.prototype_integer_16) or (ALIAS_STR.prototype_uinteger_16) then {
+ size := 1; // 16 bits
+ }
+ .when (ALIAS_STR.prototype_integer_32) or (ALIAS_STR.prototype_uinteger_32) then {
+ size := 2; // 32 bits
+ }
+ .when (ALIAS_STR.prototype_integer_64) or (ALIAS_STR.prototype_uinteger_64) then {
+ size := 3; // 64 bits
+ };
+ );
+
+ - dico_name_to_prototype:HASHED_DICTIONARY(PROTOTYPE,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(PROTOTYPE,STRING_CONSTANT).create;
+
+Section TYPE, TYPE_FULL
+
+ + type_full_list:FAST_ARRAY(TYPE_FULL);
+
+ - get_with flg:UINTEGER_8 :TYPE_FULL <-
+ ( + result:TYPE_FULL;
+ + i:INTEGER;
+
+ (flg = default.flag).if {
+ result := default;
+ } else {
+ (type_full_list = NULL).if {
+ type_full_list := FAST_ARRAY(TYPE_FULL).create_with_capacity 2;
+ result := TYPE_FULL.create Self with flg;
+ type_full_list.add_last result;
+ } else {
+ {(i <= type_full_list.upper) && {type_full_list.item i.flag != flg}}.while_do {
+ i := i + 1;
+ };
+ (i <= type_full_list.upper).if {
+ result := type_full_list.item i;
+ } else {
+ result := TYPE_FULL.create Self with flg;
+ type_full_list.add_last result;
+ };
+ };
+ };
+ result
+ );
+
+
+
\ No newline at end of file
diff --git a/src2/type/type_block.li b/src2/type/type_block.li
new file mode 100644
index 0000000..78ff98c
--- /dev/null
+++ b/src2/type/type_block.li
@@ -0,0 +1,226 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_BLOCK;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Virtual type for BLOCK manager";
+
+Section Inherit
+
+ + parent_type:Expanded TYPE;
+
+Section Private
+
+ - dico:FAST_ARRAY(TYPE_BLOCK) := FAST_ARRAY(TYPE_BLOCK).create_with_capacity 2048;
+
+Section TYPE_BLOCK //,PROFIL_BLOCK
+
+ //
+ // Creation.
+ //
+
+ - create a_list:FAST_ARRAY(TYPE_FULL) and_result r_list:FAST_ARRAY(TYPE_FULL) :SELF <-
+ ( + result:SELF;
+ result := clone;
+ result.make a_list and_result r_list;
+ result
+ );
+
+ - make a_list:FAST_ARRAY(TYPE_FULL) and_result r_list:FAST_ARRAY(TYPE_FULL) <-
+ (
+ argument_list := a_list;
+ result_list := r_list;
+ default := TYPE_FULL.create Self with 0;
+ );
+
+Section Public
+
+ - intern_name:STRING_CONSTANT <- type_block.intern_name;
+
+ - is_block:BOOLEAN := TRUE;
+
+ + argument_list:FAST_ARRAY(TYPE_FULL);
+ + result_list:FAST_ARRAY(TYPE_FULL);
+
+ - get_expr_for p:POSITION :EXPR <-
+ ( + result:EXPR;
+ + lst:FAST_ARRAY(EXPR);
+
+ (result_list.count > 1).if {
+ lst := FAST_ARRAY(EXPR).create_with_capacity (result_list.count);
+ (result_list.lower).to (result_list.upper) do { j:INTEGER;
+ lst.add_last (result_list.item j.get_temporary_expr p);
+ };
+ result := EXPR_MULTIPLE.create lst;
+ }.elseif {result_list.count = 1} then {
+ result := result_list.first.get_temporary_expr p;
+ } else {
+ result := PROTOTYPE_CST.create p type (TYPE_VOID.default);
+ };
+ result
+ );
+
+ - get t:ITM_TYPE_BLOCK with p:PARAMETER_TO_TYPE :TYPE_FULL <-
+ ( + a_list:FAST_ARRAY(TYPE_FULL);
+ + r_list:FAST_ARRAY(TYPE_FULL);
+
+ // Argument.
+ a_list := ALIAS_ARRAY(TYPE_FULL).new;
+ (t.type_argument != NULL).if {
+ t.type_argument.to_run_in a_list for p;
+ };
+ a_list := ALIAS_ARRAY(TYPE_FULL).alias a_list;
+ // Result.
+ r_list := ALIAS_ARRAY(TYPE_FULL).new;
+ (t.type_result != NULL).if {
+ t.type_result.to_run_in r_list for p;
+ };
+ r_list := ALIAS_ARRAY(TYPE_FULL).alias r_list;
+ //
+ get_direct a_list and_result r_list.default
+ );
+
+ - get_direct a_list:FAST_ARRAY(TYPE_FULL) and_result r_list:FAST_ARRAY(TYPE_FULL) :TYPE_BLOCK <-
+ ( + idx:INTEGER;
+ + result:TYPE_BLOCK;
+
+ idx := dico.lower;
+ {
+ (idx <= dico.upper) && {
+ {dico.item idx.argument_list != a_list} ||
+ {dico.item idx.result_list != r_list}
+ }
+ }.while_do {
+ idx := idx + 1;
+ };
+ (idx <= dico.upper).if {
+ result := dico.item idx;
+ } else {
+ result := create a_list and_result r_list;
+ dico.add_last result;
+ };
+ result
+ );
+
+ - prototype:PROTOTYPE <- type_block.prototype;
+
+ - get_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_slot n
+ );
+
+ - get_local_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_local_slot n
+ );
+
+ - get_path_slot n:STRING_CONSTANT :SLOT <-
+ (
+ type_block.get_path_slot n
+ );
+
+ - genere_struct <- type_block.genere_struct;
+
+ //
+ // Code source generation.
+ //
+
+ - put_id buffer:STRING <- index.append_in buffer;
+
+ - put_access_id e:EXPR in buffer:STRING <-
+ (
+ buffer.append "(int)";
+ e.genere buffer;
+ );
+
+ - put_value buffer:STRING <-
+ (
+ buffer.append "(void *)";
+ index.append_in buffer;
+ );
+
+ - is_sub_type other:TYPE :BOOLEAN <-
+ ( + me:TYPE_BLOCK;
+
+ me ?= other;
+ (me != NULL) &&
+ {me.argument_list = argument_list} &&
+ {me.result_list = result_list}
+ );
+
+ - is_sub_type_result other:TYPE_BLOCK :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+ (result_list = other.result_list) ||
+ {
+ (result_list != NULL) &&
+ {other.result_list != NULL} &&
+ {result_list.count = other.result_list.count} &&
+ {
+ result := TRUE;
+ j := result_list.lower;
+ {(j <= result_list.upper) && {result}}.while_do {
+ result := result_list.item j.is_sub_type (other.result_list.item j);
+ j := j + 1;
+ };
+ result
+ }
+ }
+ );
+
+ //
+ // Display.
+ //
+
+ - append_name_in buf:STRING <-
+ (
+ buf.add_last '{';
+ (argument_list.is_empty).if_false {
+ (argument_list.count > 1).if {
+ buf.add_last '(';
+ (argument_list.lower).to (argument_list.upper-1) do { j:INTEGER;
+ argument_list.item j.display buf;
+ buf.add_last ',';
+ };
+ argument_list.last.display buf;
+ buf.add_last ')';
+ } else {
+ argument_list.first.display buf;
+ };
+ buf.add_last ';';
+ buf.add_last ' ';
+ };
+ (result_list.is_empty).if_false {
+ (result_list.lower).to (result_list.upper-1) do { j:INTEGER;
+ result_list.item j.display buf;
+ buf.add_last ',';
+ };
+ result_list.last.display buf;
+ };
+ buf.add_last '}';
+ // Debug
+ buf.append "(TYPE_BLOCK)";
+ );
diff --git a/src2/type/type_context.li b/src2/type/type_context.li
new file mode 100644
index 0000000..5547ba9
--- /dev/null
+++ b/src2/type/type_context.li
@@ -0,0 +1,70 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_CONTEXT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type Context for debug mode";
+
+Section Inherit
+
+ + parent_type:Expanded TYPE;
+
+Section Public
+
+ - name:STRING_CONSTANT <- ALIAS_STR.prototype_context;
+
+ - intern_name:STRING_CONSTANT <- name;
+
+ - type_c:STRING_CONSTANT <- "_____CONTEXT";
+
+ //
+ // Creation.
+ //
+
+ - make_context <-
+ (
+ dico_type.fast_put Self to name;
+ //slot_run := FAST_ARRAY(SLOT).create_with_capacity 1; // BSBS: Plus utile !
+ default := TYPE_FULL.create Self with (TYPE_FULL.expanded_bit);
+ );
+
+ - genere_typedef <-
+ (
+ // Nothing.
+ );
+
+ - genere_struct <-
+ (
+ output_decl.append
+ "// ___CONTEXT\n\
+ \typedef struct ___CONTEXT_struct _____CONTEXT; \n\
+ \struct ___CONTEXT_struct {\n\
+ \ unsigned long code; \n\
+ \ _____CONTEXT *back; \n\
+ \};\n\
+ \_____CONTEXT *top_context; \n\n";
+ );
+
\ No newline at end of file
diff --git a/src2/type/type_full.li b/src2/type/type_full.li
new file mode 100644
index 0000000..cc5cc85
--- /dev/null
+++ b/src2/type/type_full.li
@@ -0,0 +1,393 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_FULL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type with attribute flags.";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ + parent_type:TYPE; // BSBS: Passer en héritage + Insert mode.
+
+Section TYPE, TYPE_FULL
+
+ - get_with flg:UINTEGER_8 :TYPE_FULL <- parent_type.get_with flg;
+
+Section Public
+
+ - get_slot n:STRING_CONSTANT :SLOT <- parent_type.get_slot n;
+
+ - hash_code:INTEGER <- raw.name.hash_code;
+
+ - size:INTEGER <- parent_type.size;
+
+ - prototype:PROTOTYPE <- parent_type.prototype;
+
+ - is_sub_type other:TYPE_FULL :BOOLEAN <- parent_type.is_sub_type (other.raw);
+
+ - slot_run:FAST_ARRAY(SLOT) <- parent_type.slot_run;
+
+ - is_late_binding:BOOLEAN <- parent_type.is_late_binding;
+
+Section TYPE
+
+ + flag:UINTEGER_8;
+ // 7 6 5 4 3 2 1 0
+ // | | | | | +- 0:Reference / 1:Expanded
+ // | | | | +--- 0:Reference / 1:Expanded (by default)
+ // | | | +----- 0:Normal / 1:Strict
+ // | | +------- 0:Normal / 1:Strict (by default)
+ // | +--------- 0:Normal / 1:Temporary
+ // +----------- 0:Normal / 1:Old generic
+
+ //
+ // Creation.
+ //
+
+ - create typ:TYPE with code:UINTEGER_8 :SELF <-
+ [
+ -? {typ != NULL};
+ ]
+ ( + result:SELF;
+
+ result := clone;
+ result.make typ with code;
+ result
+ );
+
+ - make typ:TYPE with code:UINTEGER_8 <-
+ (
+ parent_type := typ;
+ flag := code;
+ ((raw != NULL) && {raw.name != NULL} && {raw.name == "INTEGER"} && {! is_expanded}).if {
+ crash;
+ };
+ ? {is_expanded -> (! is_strict)};
+ );
+
+Section Public
+
+ - is_parameter_type:BOOLEAN <- FALSE;
+
+ - raw:TYPE <- parent_type;
+
+ //
+ // Set.
+ //
+
+ - expanded_bit :UINTEGER_8 := 000001b;
+ - default_expanded_bit:UINTEGER_8 := 000010b;
+ - strict_bit :UINTEGER_8 := 000100b;
+ - default_strict_bit :UINTEGER_8 := 001000b;
+ - expanded_ref_bit :UINTEGER_8 := 010000b;
+ - generic_bit :UINTEGER_8 := 100000b;
+
+ //
+ // Access.
+ //
+
+ - is_expanded :BOOLEAN <- (flag & expanded_bit ) != 0;
+ - is_default_expanded :BOOLEAN <- (flag & default_expanded_bit) != 0;
+ - is_strict :BOOLEAN <- (flag & strict_bit ) != 0;
+ - is_default_strict :BOOLEAN <- (flag & default_expanded_bit) != 0;
+ - is_expanded_ref :BOOLEAN <- (flag & expanded_ref_bit ) != 0;
+ - is_generic :BOOLEAN <- (flag & generic_bit ) != 0;
+
+ - is_expanded_c:BOOLEAN <- (is_expanded) && {raw.type_c != NULL};
+
+ - Self:SELF '==' Right 60 other:TYPE_FULL :BOOLEAN <-
+ (
+ (Self = other) || {(raw = other.raw) && {(flag & 01111b) = (other.flag & 01111b)}}
+ );
+
+ - Self:SELF '!==' Right 60 other:TYPE_FULL :BOOLEAN <- ! (Self == other);
+
+ - append_name_in buffer:STRING <-
+ (
+ (is_strict).if {
+ buffer.append "Strict ";
+ };
+ (is_expanded).if {
+ buffer.append "Expanded ";
+ };
+ raw.append_name_in buffer;
+ // buffer.append (raw.name);
+ );
+
+ //
+ // Operation.
+ //
+
+ - Self:SELF '+' other:UINTEGER_8 :TYPE_FULL <- get_with (flag | other);
+
+ - Self:SELF '-' other:UINTEGER_8 :TYPE_FULL <- get_with (flag & ~other);
+
+ - to_strict:TYPE_FULL <-
+ ( + result:TYPE_FULL;
+
+ (is_expanded).if {
+ result := Self;
+ } else {
+ result := get_with (flag | strict_bit);
+ };
+ result
+ );
+
+ - to_no_strict:TYPE_FULL <-
+ ( + result:TYPE_FULL;
+
+ (is_expanded).if {
+ result := Self;
+ } else {
+ result := get_with (flag & ~strict_bit);
+ };
+ result
+ );
+
+ //
+ // Variable product.
+ //
+
+ - new_local p:POSITION
+ name n:STRING_CONSTANT
+ style s:CHARACTER
+ result r:BOOLEAN :LOCAL <-
+ (
+ LOCAL.create p name n style s type Self result r
+ );
+
+ - new_local p:POSITION name n:STRING_CONSTANT style s:CHARACTER :LOCAL <-
+ (
+ LOCAL.create p name n style s type Self
+ );
+
+ - get_temporary_expr p:POSITION :EXPR <-
+ ( + result:EXPR;
+
+ (raw = TYPE_VOID).if {
+ result := PROTOTYPE_CST.create p type (TYPE_VOID.default); //BSBS: Alias.
+ } else {
+ result := get_temporary p.read p;
+ };
+ result
+ );
+
+ - get_temporary p:POSITION :LOCAL <-
+ (
+ new_local p name (ALIAS_STR.variable_tmp) style '+'
+ );
+
+ - get p:POSITION result n:INTEGER :LOCAL <-
+ ( + intern:STRING_CONSTANT;
+ string_tmp.copy (ALIAS_STR.keyword_result);
+ (n != 0).if {
+ string_tmp.add_last '_';
+ n.append_in string_tmp;
+ };
+ intern := ALIAS_STR.get string_tmp;
+ new_local p name intern style '+'
+ );
+
+ //
+ // Type Control.
+ //
+
+ //+----------+----------+----------+----------+
+ //| A := B-->| Reference| Expanded | Strict |
+ //| V | TYPE | TYPE | TYPE |
+ //+----------+----------+----------+----------+
+ //| Reference| B.sub A | FALSE | B.sub A |
+ //| TYPE | | | |
+ //+----------+----------+----------+----------+
+ //| Expanded | FALSE | A = B | A = B |
+ //| TYPE | | | |
+ //+----------+----------+----------+----------+
+ //| Strict | FALSE | FALSE | A = B |
+ //| TYPE |Sauf NULL | | |
+ //+----------+----------+----------+----------+
+ - affect_with other:TYPE_FULL :BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ (other == Self).if {
+ result := TRUE;
+ } else {
+ (is_strict).if {
+ // A: Strict.
+ result := other.raw = TYPE_NULL;
+ }.elseif {is_expanded} then {
+ // A: Expanded.
+ result :=
+ ((other.is_strict) && {raw == other.raw }) ||
+ {(raw = type_boolean) && {other.is_sub_type Self}} ||
+ {(raw = type_pointer) && {other.raw = TYPE_NULL }};
+ } else {
+ // A: Reference.
+ result :=
+ (
+ (! other.is_expanded) ||
+ { + tb:TYPE_BLOCK;
+ tb ?= raw;
+ (tb != NULL)
+ }
+ ) && {other.is_sub_type Self};
+ };
+ };
+ result
+ );
+
+ //
+ // Import / Export manager.
+ //
+
+ - is_export_to t:TYPE_FULL :BOOLEAN <- raw.is_export_to t;
+
+ - is_import_to t:TYPE_FULL :BOOLEAN <- raw.is_import_to t;
+
+ //
+ // Default value.
+ //
+ + recursivity_test:BOOLEAN;
+ - default_value p:POSITION :EXPR <-
+ ( + result:EXPR;
+
+ ((prototype != NULL) && {prototype.default_value != NULL}).if {
+ // Prototype User definition.
+ (recursivity_test).if {
+ crash;
+ POSITION.put_error semantic text
+ "Recursivity without end (default used default, ...).";
+ list_current.position.put_position;
+ prototype.default_value.position.put_position;
+ POSITION.send_error;
+ } else {
+ recursivity_test := TRUE;
+ result := prototype.default_value.to_run_expr;
+ recursivity_test := FALSE;
+ };
+ } else {
+ (is_expanded).if {
+ // Copy of model prototype.
+ result := PROTOTYPE_CST.create p type Self;
+ } else {
+ result := PROTOTYPE_CST.create p type (TYPE_NULL.default);
+ };
+ };
+
+ result
+ );
+
+ //
+ // Declaration generation.
+ //
+
+ - genere_declaration buffer:STRING <-
+ (
+ (is_expanded).if {
+ raw.put_expanded_declaration buffer;
+ }.elseif {is_strict} then {
+ raw.put_reference_declaration buffer;
+ } else {
+ raw.put_generic_declaration buffer;
+ };
+ );
+
+ - genere_star_declaration buffer:STRING <-
+ (
+ ((! is_expanded) || {is_expanded_ref}).if {
+ raw.put_reference_star_declaration buffer;
+ };
+ );
+
+ //
+ // Generation code.
+ //
+
+ - genere_value buffer:STRING <-
+ ( + tb:PROFIL_BLOCK;
+ (
+ (is_expanded) && {! is_expanded_ref} &&
+ {raw != type_true} && {raw != type_false} &&
+ {tb ?= raw; tb = NULL}
+ ).if {
+ buffer.append "(*";
+ raw.put_value buffer;
+ buffer.add_last ')';
+ } else {
+ raw.put_value buffer;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buf:STRING <-
+ (
+ (is_generic).if {
+ buf.append "Generic ";
+ };
+ append_name_in buf;
+ );
+
+ - print <-
+ (
+ string_tmp.clear;
+ display string_tmp;
+ string_tmp.print;
+ );
+
+ - print_full <-
+ (
+ string_tmp.clear;
+ display string_tmp;
+ string_tmp.add_last ' ';
+ string_tmp.add_last '[';
+ (is_expanded).if {
+ string_tmp.add_last 'e';
+ };
+ (is_default_expanded).if {
+ string_tmp.add_last 'E';
+ };
+ (is_strict).if {
+ string_tmp.add_last 's';
+ };
+ (is_default_strict).if {
+ string_tmp.add_last 'S';
+ };
+ (is_temporary).if {
+ string_tmp.add_last 'T';
+ };
+ (is_generic).if {
+ string_tmp.add_last 'G';
+ };
+ string_tmp.add_last ']';
+ //
+ string_tmp.print;
+ );
+
diff --git a/src2/type/type_generic.li b/src2/type/type_generic.li
new file mode 100644
index 0000000..8ea299a
--- /dev/null
+++ b/src2/type/type_generic.li
@@ -0,0 +1,299 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_GENERIC;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Type generic";
+
+Section Inherit
+
+ + parent_type:Expanded TYPE;
+
+Section Private
+
+ // BSBS: Vu que les ITM_TYPE sont aliaser, il n'est pas necessary d'aliaser les TYPE !
+ // Mais attention au pb des TYPE_GENERIC et de leur alias de slot_run...
+
+ - dicog_type:HASHED_DICTIONARY(TYPE_GENERIC,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(TYPE_GENERIC,STRING_CONSTANT).create;
+
+Section Public
+
+ + name:STRING_CONSTANT;
+
+ + key:STRING_CONSTANT;
+
+ + generic_list:FAST_ARRAY(TYPE_FULL);
+
+ - parameter_to_type p:ITM_TYPE_PARAMETER :TYPE_FULL <-
+ ( + idx:INTEGER;
+ + tab:FAST_ARRAY(ITM_TYPE_PARAMETER);
+ + result:TYPE_FULL;
+
+ tab := prototype.idf_generic_list;
+ idx := tab.fast_first_index_of p;
+ (idx <= tab.upper).if {
+ result := generic_list.item idx;
+ };
+ result
+ );
+
+ //
+ // Import / Export
+ //
+
+ - is_export_to t:TYPE_FULL :BOOLEAN <-
+ (
+ is_cast t with (ALIAS_STR.slot_to) on export_list and (prototype.import_list)
+ );
+
+ - is_import_to t:TYPE_FULL :BOOLEAN <-
+ (
+ is_cast t with (ALIAS_STR.slot_from) on import_list and (prototype.import_list)
+ );
+
+Section Private
+
+ + export_list:FAST_ARRAY(TYPE_FULL);
+ + import_list:FAST_ARRAY(TYPE_FULL);
+
+ - is_cast t:TYPE_FULL with msg:STRING_CONSTANT
+ on lst:FAST_ARRAY(TYPE_FULL)
+ and lstp:FAST_ARRAY(ITM_TYPE_MONO) :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+
+ (lst != NULL).if {
+ j := lst.fast_first_index_of t;
+ (j <= lst.upper).if {
+ result := TRUE;
+ last_cast_name.copy msg;
+ lstp.item j.append_cast_name_in last_cast_name;
+ };
+ };
+ result
+ );
+
+Section Public
+
+ //
+ // Get
+ //
+
+ - get itm_typ:ITM_TYPE_SIMPLE :TYPE_FULL <-
+ (
+ crash_with_message "`get' in TYPE_GENERIC !";
+ NULL
+ );
+
+ - get itm_typ:ITM_TYPE_SIMPLE with gen:FAST_ARRAY(TYPE_FULL) :TYPE_FULL <-
+ ( + base:TYPE_GENERIC;
+ + result,t:TYPE_FULL;
+ + styl,k:STRING_CONSTANT;
+ + proto:PROTOTYPE;
+
+ proto := load_prototype (itm_typ.name) generic_count (gen.count);
+ string_tmp.copy (proto.filename);
+ (gen.lower).to (gen.upper) do { j:INTEGER;
+ string_tmp.add_last ' ';
+ t := gen.item j;
+ (t.flag & 1111b).append_in string_tmp;
+ string_tmp.append (t.raw.key); // BSBS: transformer la key par un numero de fichier...
+ // BSBS: parce que la, tu as des key immense !
+ };
+ k := ALIAS_STR.get string_tmp;
+ //
+ base := dicog_type.fast_reference_at k;
+ (base = NULL).if {
+ base := TYPE_GENERIC.clone;
+ dicog_type.fast_put base to k;
+ base.make itm_typ with proto generic gen key k;
+ };
+ //
+ styl := itm_typ.style;
+ (styl = NULL).if {
+ result := base.default;
+ } else {
+ (styl = ALIAS_STR.keyword_expanded).if {
+ result := base.default + TYPE_FULL.expanded_bit;
+ } else {
+ result := base.default + TYPE_FULL.strict_bit;
+ };
+ };
+ result
+ );
+
+ //
+ // Life Type for collection (see PUT_TO and ITEM)
+ // BSBS: A revoir : il n'y a que NATIVE_ARRAY qui a besoin de ca,
+ // il faudrai plutot stocker ca ailleurs... ou? chépa!
+ //
+
+ + put_to_list:FAST_ARRAY(PUT_TO);
+
+ - add_put_to n:PUT_TO <-
+ (
+ (put_to_list = NULL).if {
+ put_to_list := FAST_ARRAY(PUT_TO).create_with_capacity 16;
+ };
+ put_to_list.add_last n;
+ );
+
+ - remove_put_to n:PUT_TO <-
+ ( + idx:INTEGER;
+
+ idx := put_to_list.fast_first_index_of n;
+ put_to_list.swap idx with (put_to_list.upper);
+ put_to_list.remove_last;
+ );
+
+ + recursive_test:BOOLEAN;
+
+ + old_type:TYPES;
+
+ - get_type t:TYPES_TMP <-
+ ( + typ:TYPE_FULL;
+ + tmp_type:TYPES_TMP;
+
+ typ := generic_list.first;
+ (typ.is_expanded && {typ.raw != type_boolean}).if {
+ t.add (typ.raw);
+ } else {
+ (put_to_list != NULL).if {
+ (! recursive_test).if {
+ recursive_test := TRUE;
+ tmp_type := TYPES_TMP.new;
+ (put_to_list.lower).to (put_to_list.upper) do { j:INTEGER;
+ put_to_list.item j.value.get_type tmp_type;
+ };
+ old_type := tmp_type.update old_type;
+ recursive_test := FALSE;
+ };
+ t.union old_type;
+ };
+ };
+ );
+
+ //
+ // Declaration generation.
+ //
+
+ - put_reference_declaration buffer:STRING <-
+ (
+ (prototype.name = ALIAS_STR.prototype_native_array).if {
+ generic_list.first.genere_declaration buffer;
+ }.elseif {prototype.name = ALIAS_STR.prototype_native_array_volatile} then {
+ buffer.append "volatile ";
+ generic_list.first.genere_declaration buffer;
+ } else {
+ parent_type.put_reference_declaration buffer;
+ };
+ );
+
+ - put_reference_star_declaration buffer:STRING <-
+ (
+ (
+ (prototype.name = ALIAS_STR.prototype_native_array) ||
+ {prototype.name = ALIAS_STR.prototype_native_array_volatile}
+ ).if {
+ (is_java).if {
+ buffer.append "[]";
+ } else {
+ buffer.add_last '*';
+ };
+ generic_list.first.genere_star_declaration buffer;
+ } else {
+ parent_type.put_reference_star_declaration buffer;
+ };
+ );
+
+Section Public
+
+ - make itm_typ:ITM_TYPE_SIMPLE <-
+ (
+ crash_with_message "TYPE_GENERIC.make";
+ );
+
+ - make itm_typ:ITM_TYPE_SIMPLE with proto:PROTOTYPE
+ generic gen:FAST_ARRAY(TYPE_FULL) key k:STRING_CONSTANT <-
+ ( + mask_bit:UINTEGER_8;
+
+ index := index_count;
+ index_count := index_count + 1;
+ //
+ string_tmp.copy (itm_typ.name);
+ string_tmp.add_last '[';
+ (gen.lower).to (gen.upper - 1) do { j:INTEGER;
+ gen.item j.append_name_in string_tmp;
+ string_tmp.add_last ',';
+ };
+ gen.last.append_name_in string_tmp;
+ string_tmp.add_last ']';
+ name := ALIAS_STR.get string_tmp;
+ key := k;
+ generic_list := gen;
+ string_tmp.copy name;
+ string_tmp.replace_all ',' with 'x';
+ string_tmp.replace_all '[' with 'o';
+ string_tmp.replace_all ']' with 'o';
+ string_tmp.replace_all ' ' with '_';
+ string_tmp.replace_all '.' with '_';
+ intern_name := ALIAS_STR.get_intern string_tmp;
+ //
+ prototype := proto;
+ itm_type := itm_typ;
+ slot_run := FAST_ARRAY(SLOT).create_with_capacity 10; // BSBS: A voir.
+ (prototype.type_style = ALIAS_STR.keyword_expanded).if {
+ // Expanded.
+ mask_bit := TYPE_FULL.expanded_bit | TYPE_FULL.default_expanded_bit;
+ }.elseif {prototype.type_style = ALIAS_STR.keyword_strict} then {
+ // Strict.
+ mask_bit := TYPE_FULL.strict_bit | TYPE_FULL.default_strict_bit;
+ };
+ default := TYPE_FULL.create Self with mask_bit;
+ prototype.init_slot_for Self;
+ //
+ subtype_list := HASHED_SET(TYPE).create;
+ subtype_list.fast_add TYPE_NULL;
+ add_subtype Self;
+ // BSBS: Size ???
+
+ // Import / Export.
+ (prototype.export_list != NULL).if {
+ export_list := FAST_ARRAY(TYPE_FULL).create_with_capacity (prototype.export_list.count);
+ (prototype.export_list.lower).to (prototype.export_list.upper) do { j:INTEGER;
+ export_list.add_last (prototype.export_list.item j.to_run_for Self);
+ };
+ };
+ (prototype.import_list != NULL).if {
+ import_list := FAST_ARRAY(TYPE_FULL).create_with_capacity (prototype.import_list.count);
+ (prototype.import_list.lower).to (prototype.import_list.upper) do { j:INTEGER;
+ import_list.add_last (prototype.import_list.item j.to_run_for Self);
+ };
+ };
+ );
+
+
\ No newline at end of file
diff --git a/src2/type/type_id.li b/src2/type/type_id.li
new file mode 100644
index 0000000..ef7835b
--- /dev/null
+++ b/src2/type/type_id.li
@@ -0,0 +1,104 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_ID;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Virtual type style slot segregation";
+
+Section Inherit
+
+ + parent_type:Expanded TYPE;
+
+Section Private
+
+ - list_id:FAST_ARRAY(TYPE_ID);
+
+ - create i:INTEGER :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make i;
+ result
+ );
+
+ - make i:INTEGER <-
+ (
+ index := i;
+ default := TYPE_FULL.create Self with 0;
+ );
+
+Section Public
+
+ - name:STRING_CONSTANT <- ALIAS_STR.prototype_type_id;
+
+ - intern_name:STRING_CONSTANT <- name;
+
+ - get_index idx:INTEGER :TYPE_ID <-
+ ( + result:TYPE_ID;
+
+ (idx > list_id.upper).if {
+ result := TYPE_ID.create idx;
+ list_id.add_last result;
+ ? {list_id.upper = idx};
+ } else {
+ result := list_id.item idx;
+ };
+ result
+ );
+
+ - make_type_id <-
+ (
+ list_id := FAST_ARRAY(TYPE_ID).create_with_capacity 3;
+ list_id.add_last (create 0);
+ list_id.add_last (create 1);
+ );
+
+ - add_genere_list; // Nothing.
+
+ - genere_struct; // Nothing.
+
+ - is_sub_type other:TYPE :BOOLEAN <-
+ (
+ other.name = name
+ );
+
+ //
+ // Declaration generation.
+ //
+
+ - put_generic_declaration buffer:STRING <- buffer.append "int";
+
+ - put_reference_star_declaration buffer:STRING; // Nothing.
+
+ //
+ // Code source generation.
+ //
+
+ - put_id buffer:STRING <- index.append_in buffer;
+
+ - put_access_id e:EXPR in buffer:STRING <- e.genere buffer;
+
+ - put_value buffer:STRING <- index.append_in buffer;
\ No newline at end of file
diff --git a/src2/type/type_null.li b/src2/type/type_null.li
new file mode 100644
index 0000000..3f05b71
--- /dev/null
+++ b/src2/type/type_null.li
@@ -0,0 +1,130 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := TYPE_NULL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Special type NULL";
+
+Section Inherit
+
+ + parent_type:Expanded TYPE;
+
+Section Public
+
+ - name:STRING_CONSTANT <- ALIAS_STR.variable_null;
+
+ - intern_name:STRING_CONSTANT <- name;
+
+ //
+ // Creation.
+ //
+
+ - make_null <-
+ (
+ index := index_count;
+ index_count := index_count + 1;
+ dico_type.fast_put Self to name;
+ slot_run := FAST_ARRAY(SLOT).create_with_capacity 1; // BSBS: Plus utile !
+ default := TYPE_FULL.create Self with 0;
+ );
+
+ - get_local_slot n:STRING_CONSTANT :SLOT <- NULL;
+
+ - get_path_slot n:STRING_CONSTANT :SLOT <- NULL;
+
+ //
+ // Error.
+ //
+
+ //- bug:INTEGER;
+
+ - product_error p:POSITION in lst:LIST <-
+ ( + ctext:LOCAL;
+
+ (debug_level_option != 0).if {
+ (profil_current = NULL).if {
+ ctext := context_main;
+ } else {
+ ctext := profil_current.context;
+ };
+ lst.add_last (
+ PUSH.create p context ctext first FALSE
+ );
+ };
+ lst.add_last CALL_NULL;
+ );
+
+Section Public
+
+ //
+ // Import / Export
+ //
+
+ - is_export_to t:TYPE_FULL :BOOLEAN <- FALSE;
+
+ - is_import_to t:TYPE_FULL :BOOLEAN <- FALSE;
+
+ //
+ //
+ //
+
+ - is_sub_type other:TYPE :BOOLEAN <- TRUE;
+
+ - genere_typedef <-
+ (
+ );
+
+ - genere_struct <-
+ (
+ (is_java).if_false {
+ output_decl.append
+ "// NULL\n\
+ \#ifndef NULL\n\
+ \#define NULL ((void *)0)\n\
+ \#endif\n\n";
+ };
+ );
+
+ //
+ // Code source generation.
+ //
+
+ - put_id buffer:STRING <-
+ (
+ put_value buffer;
+ );
+
+ - put_access_id e:EXPR in buffer:STRING <- e.genere buffer;
+
+ - put_value buffer:STRING <-
+ (
+ (is_java).if {
+ buffer.append "null";
+ } else {
+ buffer.append name;
+ };
+ );
+
\ No newline at end of file
diff --git a/src/type/type_void.li b/src2/type/type_void.li
similarity index 100%
copy from src/type/type_void.li
copy to src2/type/type_void.li
diff --git a/src/update b/src2/update
similarity index 100%
copy from src/update
copy to src2/update
diff --git a/src/variable/argument.li b/src2/variable/argument.li
similarity index 100%
copy from src/variable/argument.li
copy to src2/variable/argument.li
diff --git a/src2/variable/local.li b/src2/variable/local.li
new file mode 100644
index 0000000..a776f92
--- /dev/null
+++ b/src2/variable/local.li
@@ -0,0 +1,397 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LOCAL;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Local slot";
+
+Section Inherit
+
+ + parent_variable:Expanded VARIABLE;
+
+Section Public
+
+ // BSBS: Doit pas etre utile.
+
+ + is_result :BOOLEAN := FALSE;
+
+ - set_result r:BOOLEAN <-
+ (
+ is_result := r;
+ );
+
+ //
+ // Copy alias manager.
+ //
+
+ - is_alias:BOOLEAN;
+
+ - alias_on <-
+ (
+ is_alias := TRUE;
+ );
+
+ - alias_off <-
+ (
+ (list_alias.lower).to (list_alias.upper) do { j:INTEGER;
+ list_alias.item j.set_my_alias NULL;
+ };
+ list_alias.clear;
+ is_alias := FALSE;
+ );
+
+ - list_alias:FAST_ARRAY(LOCAL) := FAST_ARRAY(LOCAL).create_with_capacity 64;
+
+ - get_alias:LOCAL <-
+ (
+ (my_alias = NULL).if {
+ my_alias := my_copy;
+ my_alias.set_type_list type_list;
+ list_alias.add_last Self;
+ };
+ my_alias
+ );
+
+ + my_alias:LOCAL;
+
+ - set_my_alias new_loc:LOCAL <-
+ (
+ my_alias := new_loc;
+ );
+
+ - write p:POSITION with r:EXPR value val:EXPR :WRITE <-
+ ( + result:WRITE;
+
+ (my_alias != NULL).if {
+ result := my_alias.write_direct p with NULL value val;
+ }.elseif {is_alias} then {
+ result := get_alias.write_direct p with NULL value val;
+ } else {
+ result := write_direct p with NULL value val;
+ };
+ result
+ );
+
+ - read p:POSITION with r:EXPR :READ <-
+ ( + result:READ;
+
+ (my_alias != NULL).if {
+ result := my_alias.read_direct p with NULL;
+ }.elseif {is_alias} then { // BSBS: voir Mildred
+ result := get_alias.read_direct p with NULL; // BSBS: cas impossible !!!
+ } else {
+ //? {! is_alias};
+ result := read_direct p with NULL;
+ };
+ result
+ );
+
+ //
+ // Sequence optimizer
+ //
+
+ + last_seq:LOCAL_SEQ;
+
+ - reset_last_write w:WRITE <-
+ (
+ ((last_seq != NULL) && {last_seq.last_write = w}).if {
+ last_seq.set_last_write NULL;
+ };
+ );
+
+ - set_last_seq s:LOCAL_SEQ <-
+ (
+ last_seq := s;
+ );
+
+ - set_write w:WRITE <-
+ (
+ (last_seq = NULL).if {
+ LOCAL_SEQ.new Self;
+ //"LOCAL:".print;
+ //intern_name.print; '\n'.print;
+ };
+ (
+ (! PROFIL.mode_recursive) &&
+ {loop_invariant = NULL} &&
+ {last_seq.last_write != NULL} &&
+ {last_seq.last_index != -1} &&
+ {last_seq.last_list_current = list_current} &&
+ {last_seq.last_index < list_current.index} &&
+ {last_seq.last_seq_call_local_and_loop = seq_call_local_and_loop} &&
+ {list_current.item (last_seq.last_index) = last_seq.last_write} // BSBS: Voir pourquoi pas tjrs le cas
+ ).if {
+ list_current.put (last_seq.last_write.value) to (last_seq.last_index);
+ unwrite (last_seq.last_write);
+ new_execute_pass;
+ };
+ // Save context
+ last_seq.set_seq w;
+ );
+
+ - set_read <-
+ (
+ (last_seq != NULL).if {
+ last_seq.set_last_index (-1);
+ };
+ );
+
+ - get_last_index:INTEGER <- last_seq.last_index;
+
+ - is_invariant:BOOLEAN <-
+ (
+ (loop_seq_call_local_and_loop = seq_call_local_and_loop) &&
+ {
+ (
+ (last_seq != NULL) && {last_seq.last_write != NULL} &&
+ {last_seq.last_seq_index <= loop_seq_index}
+ ) || {style = ' '}
+ }
+ );
+
+ - get_last_value rec:EXPR :EXPR <-
+ [
+ ? {rec = NULL};
+ ]
+ ( + result:EXPR;
+ + val:EXPR;
+ + rd:READ;
+ + l:LOCAL;
+ + g:SLOT_DATA;
+ /*
+ + bug:BOOLEAN;
+
+ (intern_name == "__tmp__TC").if {
+ bug:=TRUE;
+ "0\n".print;
+ (last_seq = NULL).if {
+ "last seq NULL\n".print;
+ crash;
+ } else {
+ (last_seq.last_write = NULL).if {
+ "last_write null\n".print;
+ };
+ };
+ };
+ */
+
+
+ (
+ (! PROFIL.mode_recursive) && {loop_invariant = NULL} &&
+ {last_seq != NULL} && {last_seq.last_write != NULL}
+ ).if {
+ /*
+ (bug).if {
+ "1\n".print;
+ };
+ */
+ (
+ (is_seq_list (last_seq.last_list_current)) &&
+ {
+ (last_seq.last_seq_call_local_and_loop = seq_call_local_and_loop) ||
+ {require_count = 1}
+ }
+ ).if {
+ val := last_seq.last_write.value;
+ rd ?= val;
+ (rd != NULL).if {
+ l ?= rd.variable;
+ g ?= rd.variable;
+ };
+ (
+ ( // Constant propagation.
+ val.is_constant
+ ) ||
+ { // Local propagation.
+ (l != NULL) && {
+ (
+ (l.last_seq != NULL) && {l.last_seq.last_write != NULL} &&
+ {l.last_seq.last_seq_index < last_seq.last_seq_index} &&
+ {last_seq.last_seq_call_local_and_loop = seq_call_local_and_loop}
+ ) || {l.require_count <= 1} || {l.style = ' '}
+ }
+ } ||
+ { // Global propagation.
+ (g != NULL) && {g.style = '-'} && {
+ (
+ (g.last_write != NULL) && {g.last_seq_index < last_seq.last_seq_index} &&
+ {last_seq.last_seq_call_and_loop = seq_call_and_loop} &&
+ {is_seq_list (g.last_list_current)}
+ ) || {g.require_count = 1}
+ }
+ }
+ ).if {
+ result := val.my_copy;
+ }.elseif {
+ // Propagation step by step.
+ (last_seq.last_seq_or_and = seq_or_and) &&
+ {ensure_count = 1} &&
+ {list_current.index > list_current.lower} &&
+ {list_current.item (list_current.index - 1) = last_seq.last_write}
+ } then {
+ unwrite (last_seq.last_write);
+ last_seq.set_last_write NULL;
+ list_current.put NOP to (list_current.index - 1);
+ result := val;
+ };
+ };
+ };
+ result
+ );
+
+ - set_type_list t:TYPES <-
+ (
+ type_list := t;
+ );
+
+ //
+ //
+ //
+
+ - is_local:BOOLEAN <- TRUE;
+
+ //
+ // Creation.
+ //
+
+ - create p:POSITION name n:STRING_CONSTANT
+ style c:CHARACTER type t:TYPE_FULL result r:BOOLEAN :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n style c type t result r;
+ result
+ );
+
+ - create p:POSITION name n:STRING_CONSTANT
+ style c:CHARACTER type t:TYPE_FULL :SELF<-
+ ( + result:SELF;
+ result := clone;
+ result.make p name n style c type t result FALSE;
+ result
+ );
+
+ - make p:POSITION name n:STRING_CONSTANT
+ style c:CHARACTER type t:TYPE_FULL result r:BOOLEAN <-
+ ( + tmp:TYPES_TMP;
+ ? {p.code != 0};
+ ? {t != NULL};
+
+ position := p;
+ name := n;
+ is_result := r;
+ intern_name := ALIAS_STR.get_intern n;
+
+ ((t.is_expanded) && {! t.is_expanded_c}).if {
+ type := t + TYPE_FULL.expanded_ref_bit;
+ } else {
+ type := t;
+ };
+ style := c;
+
+ (is_static).if {
+ tmp := TYPES_TMP.new;
+ tmp.add (t.raw);
+ type_list := tmp.to_types;
+ } else {
+ type_list := TYPES_TMP.types_empty;
+ };
+
+ (
+ + tb:TYPE_BLOCK;
+
+ tb ?= type.raw;
+ ((tb != NULL) && {name = ALIAS_STR.variable_self}).if {
+ "************ ERROR : ".print;
+ intern_name.print;
+ " ************\n".print;
+ crash_with_message "ERROR TYPE BLOCK!!!!";
+ };
+ );
+
+ );
+
+ - my_copy:LOCAL <-
+ ( + result:LOCAL;
+
+ result := LOCAL.create position name name style style type type;
+ result
+ );
+
+ //
+ // Value.
+ //
+
+ - init <-
+ ( + val:EXPR;
+ + i:INSTR;
+ + int:INTEGER_CST;
+
+ val := type.default_value position;
+ (ALIAS_STR.is_integer (type.raw.name)).if {
+ int ?= val;
+ (int != NULL).if {
+ int.cast_type type;
+ };
+ } else {
+ val := val.check_type type with position;
+ };
+ i := write position value val;
+ list_current.add_last i;
+ );
+
+ - set_intern_name n:STRING_CONSTANT <-
+ (
+ intern_name := n;
+ );
+
+Section VARIABLE
+
+ - new_read p:POSITION with r:EXPR :READ <-
+ [ -? {r = NULL}; ]
+ (
+ READ_LOCAL.create p with Self
+ );
+
+ - new_write p:POSITION with r:EXPR value v:EXPR :WRITE <-
+ [ -? {r = NULL}; ]
+ (
+ WRITE_LOCAL.create p with v in Self
+ );
+
+ /*
+ - new_access r:EXPR :ACCESS <-
+ (
+ ACCESS_LOCAL.create Self
+ );
+ */
+
+
+
+
+
+
+
+
diff --git a/src2/variable/local_seq.li b/src2/variable/local_seq.li
new file mode 100644
index 0000000..5901e36
--- /dev/null
+++ b/src2/variable/local_seq.li
@@ -0,0 +1,103 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := LOCAL_SEQ;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Local slot";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - list_busy:FAST_ARRAY(LOCAL) := FAST_ARRAY(LOCAL).create_with_capacity 512;
+
+ - list_free:FAST_ARRAY(LOCAL_SEQ) := FAST_ARRAY(LOCAL_SEQ).create_with_capacity 512;
+
+ - clean <-
+ (
+ last_write := NULL;
+ );
+
+Section Public
+
+ + last_write:WRITE;
+ + last_seq_index:UINTEGER_32;
+ + last_seq_or_and:UINTEGER_32;
+ + last_seq_call_and_loop:UINTEGER_32;
+ + last_seq_call_local_and_loop:UINTEGER_32;
+
+ + last_list_current:LIST;
+ + last_index:INTEGER;
+
+ - set_last_write w:WRITE <-
+ (
+ last_write := w;
+ );
+
+ - set_last_index i:INTEGER <-
+ (
+ last_index := i;
+ );
+
+ - new l:LOCAL <-
+ ( + result:LOCAL_SEQ;
+
+ (list_free.is_empty).if {
+ result := clone;
+ } else {
+ result := list_free.last;
+ list_free.remove_last;
+ };
+ result.clean;
+ list_busy.add_last l;
+ l.set_last_seq result;
+ );
+
+ - set_seq w:WRITE <-
+ (
+ // Save context
+ last_write := w;
+ last_seq_index := seq_index;
+ last_seq_or_and := seq_or_and;
+ last_seq_call_and_loop := seq_call_and_loop;
+ last_seq_call_local_and_loop:= seq_call_local_and_loop;
+ //
+ last_list_current := list_current;
+ last_index := list_current.index;
+ );
+
+ - clear <-
+ ( + l:LOCAL;
+
+ (list_busy.upper).downto (list_busy.lower) do { j:INTEGER;
+ l := list_busy.item j;
+ list_free.add_last (l.last_seq);
+ l.set_last_seq NULL;
+ };
+ list_busy.clear;
+ );
diff --git a/src/variable/named.li b/src2/variable/named.li
similarity index 100%
copy from src/variable/named.li
copy to src2/variable/named.li
diff --git a/src/variable/old/argument.li b/src2/variable/old/argument.li
similarity index 100%
copy from src/variable/old/argument.li
copy to src2/variable/old/argument.li
diff --git a/src/variable/old/slot.li b/src2/variable/old/slot.li
similarity index 100%
copy from src/variable/old/slot.li
copy to src2/variable/old/slot.li
diff --git a/src/variable/old/slot_code.li b/src2/variable/old/slot_code.li
similarity index 100%
copy from src/variable/old/slot_code.li
copy to src2/variable/old/slot_code.li
diff --git a/src/variable/old/slot_data.li b/src2/variable/old/slot_data.li
similarity index 100%
copy from src/variable/old/slot_data.li
copy to src2/variable/old/slot_data.li
diff --git a/src2/variable/section_.li b/src2/variable/section_.li
new file mode 100644
index 0000000..4d79f5d
--- /dev/null
+++ b/src2/variable/section_.li
@@ -0,0 +1,173 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SECTION_;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Test Section protection";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ + name:STRING_CONSTANT;
+
+ + type_list:FAST_ARRAY(ITM_TYPE_MONO);
+
+ //
+ // Creation.
+ //
+
+ - get_name n:STRING_CONSTANT :SECTION_ <-
+ ( + result:SECTION_;
+
+ result := bucket_name.fast_reference_at n;
+ (result = NULL).if {
+ result := clone;
+ result.make n list NULL;
+ bucket_name.fast_put result to n;
+ };
+ result
+ );
+
+ - get_type_list l:FAST_ARRAY(ITM_TYPE_MONO) :SECTION_ <-
+ ( + result:SECTION_;
+
+ result := bucket_list.fast_reference_at l;
+ (result = NULL).if {
+ result := clone;
+ result.make NULL list l;
+ bucket_list.fast_put result to l;
+ };
+ result
+ );
+
+ //
+ // Consultation
+ //
+
+ - is_mapping:BOOLEAN <- name = ALIAS_STR.section_mapping;
+
+ - is_private:BOOLEAN <- name = ALIAS_STR.section_private;
+
+ - is_public:BOOLEAN <- name = ALIAS_STR.section_public;
+
+ - is_header:BOOLEAN <- name = ALIAS_STR.section_header;
+
+ - is_inherit:BOOLEAN <- name = ALIAS_STR.section_inherit;
+
+ - is_insert:BOOLEAN <- name = ALIAS_STR.section_insert;
+
+ - is_inherit_or_insert:BOOLEAN <- (is_inherit) || {is_insert};
+
+ - is_interrupt:BOOLEAN <- name = ALIAS_STR.section_interrupt;
+
+ - is_directory:BOOLEAN <- name = ALIAS_STR.section_directory;
+
+ - is_external:BOOLEAN <- name = ALIAS_STR.section_external;
+
+ - is_private_style:BOOLEAN <-
+ (
+ ? {! is_header};
+ (! is_public) && {type_list = NULL}
+ );
+
+ //
+ // Display.
+ //
+
+ - append_in buf:STRING <-
+ (
+ (name != NULL).if {
+ buf.append name;
+ } else {
+ (type_list.lower).to (type_list.upper - 1) do { j:INTEGER;
+ type_list.item j.append_in buf;
+ buf.add_last ',';
+ buf.add_last ' ';
+ };
+ type_list.last.append_in buf;
+ };
+ );
+
+ //
+ // Access test.
+ //
+
+ - access me:TYPE with client:TYPE :BOOLEAN <-
+ ( + result:BOOLEAN;
+ + j:INTEGER;
+ + ts:ITM_TYPE_SIMPLE;
+ ? {! is_header};
+
+ ((me = client) || {is_public} || {is_external}).if {
+ result := TRUE;
+ }.elseif {is_directory} then {
+ string_tmp.copy (me.prototype.filename);
+ j := string_tmp.last_index_of '/';
+ string_tmp.keep_head j;
+ result := client.prototype.filename.has_prefix string_tmp;
+ }.elseif {type_list != NULL} then {
+ j := type_list.lower;
+ {(j <= type_list.upper) && {! result}}.while_do {
+ ts ?= type_list.item j;
+ result := client.is_sub_type_with_name (ts.name);
+ j := j + 1;
+ };
+ };
+ result
+ );
+
+Section Public
+
+ - hash_code:INTEGER <-
+ ( + result:INTEGER;
+
+ (name != NULL).if {
+ result := name.hash_code;
+ } else {
+ result := type_list.hash_code;
+ };
+ result
+ );
+
+Section SECTION_
+
+ // BSBS: Tu devrais créer deux sous-proto section_name, section_list.
+
+ - bucket_name:HASHED_DICTIONARY(SECTION_,STRING_CONSTANT) :=
+ HASHED_DICTIONARY(SECTION_,STRING_CONSTANT).create;
+
+ - bucket_list:HASHED_DICTIONARY(SECTION_,FAST_ARRAY(ITM_TYPE_MONO)) :=
+ HASHED_DICTIONARY(SECTION_,FAST_ARRAY(ITM_TYPE_MONO)).create;
+
+ - make n:STRING_CONSTANT list t:FAST_ARRAY(ITM_TYPE_MONO) <-
+ (
+ name := n;
+ type_list := t;
+ );
+
\ No newline at end of file
diff --git a/src2/variable/slot.li b/src2/variable/slot.li
new file mode 100644
index 0000000..10fd7de
--- /dev/null
+++ b/src2/variable/slot.li
@@ -0,0 +1,182 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SLOT;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for slot runnable";
+
+Section Inherit
+
+ + parent_itm_slot:ITM_SLOT := ITM_SLOT;
+
+Section Public
+
+ - common_slot:SLOT <- Self;
+
+ + slot_id:SLOT_DATA;
+
+ + receiver_type:TYPE;
+
+ //
+ // Creation.
+ //
+
+ - create s:ITM_SLOT type t:TYPE :SLOT <-
+ ( + result:SLOT;
+
+ result := clone;
+ result.make s type t
+ );
+
+ - make s:ITM_SLOT type t:TYPE :SLOT <-
+ ( + result:SLOT;
+
+ parent_itm_slot := s;
+ receiver_type := t;
+ //
+ (affect = '<').if {
+ // Code.
+ result := slot_code_intern := SLOT_CODE.create Self with value;
+ } else {
+ // Data
+ create_slot_data;
+ result := slot_data_intern;
+ };
+ //
+ result
+ );
+
+ //
+ // Style.
+ //
+
+ - lower_style:INTEGER <-
+ ( + result:INTEGER;
+ (slot_data_intern = NULL).if {
+ result := 1;
+ };
+ result
+ );
+
+ - upper_style:INTEGER <-
+ ( + result:INTEGER;
+ (slot_code_intern != NULL).if {
+ (slot_code_list != NULL).if {
+ result := slot_code_list.upper + 2;
+ } else {
+ result := 1;
+ };
+ };
+ result
+ );
+
+ - slot_data:SLOT_DATA <-
+ (
+ (slot_data_intern = NULL).if {
+ create_slot_data;
+ (slot_id = NULL).if {
+ slot_id := SLOT_DATA.create common_slot type (TYPE_ID.get_index 1.default);
+ slot_id.init;
+ };
+ };
+ slot_data_intern
+ );
+
+ - slot_code idx:INTEGER :SLOT_CODE <-
+ ( + result:SLOT_CODE;
+
+ (idx = 1).if {
+ result := slot_code_intern;
+ } else {
+ result := slot_code_list.item (idx-2);
+ };
+ result
+ );
+
+ - add_style v:ITM_CODE :INTEGER <-
+ ( + slot:SLOT_CODE;
+ + result:INTEGER;
+
+ slot := SLOT_CODE.create common_slot with v;
+ (slot_code_intern = NULL).if {
+ slot_code_intern := slot;
+ slot_id := SLOT_DATA.create common_slot type (TYPE_ID.get_index 0.default);
+ slot_id.init;
+ result := 1;
+ } else {
+ (slot_code_list = NULL).if {
+ slot_code_list := FAST_ARRAY(SLOT_CODE).create_with_capacity 1;
+ };
+ slot_code_list.add_last slot;
+ (slot_id = NULL).if {
+ slot_id := SLOT_DATA.create common_slot type (TYPE_ID.get_index 1.default);
+ slot_id.init;
+ };
+ result := slot_code_list.upper + 2;
+ };
+ result
+ );
+
+ //
+ // Display.
+ //
+
+ - display_all <-
+ (
+ (lower_style).to (upper_style) do { j:INTEGER;
+ item_style j.display_all;
+ };
+ );
+
+Section Public
+
+ + slot_data_intern:SLOT_DATA; // Index 0
+ + slot_code_intern:SLOT_CODE; // Index 1
+
+ + slot_code_list:FAST_ARRAY(SLOT_CODE); // Index x+2
+ + slot_data_list:FAST_ARRAY(SLOT_DATA); // Vector data slot
+
+ - create_slot_data <-
+ ( + typ:TYPE_FULL;
+ + tm:ITM_TYPE_MULTI;
+ + ts:ITM_TYPE_MONO;
+
+ tm ?= result_type;
+ (tm != NULL).if {
+ slot_data_list := FAST_ARRAY(SLOT_DATA).create_with_capacity (tm.count-1);
+ (tm.lower).to (tm.upper-1) do { k:INTEGER;
+ typ := tm.item k.to_run_for receiver_type;
+ slot_data_list.add_last (
+ SLOT_DATA.create common_slot type typ
+ );
+ };
+ typ := tm.last.to_run_for NULL;
+ } else {
+ ts ?= result_type;
+ typ := ts.to_run_for receiver_type;
+ };
+ slot_data_intern := SLOT_DATA.create common_slot type typ;
+ );
\ No newline at end of file
diff --git a/src2/variable/slot_code.li b/src2/variable/slot_code.li
new file mode 100644
index 0000000..056887f
--- /dev/null
+++ b/src2/variable/slot_code.li
@@ -0,0 +1,326 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SLOT_CODE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Slot with method";
+
+Section Inherit
+
+ + parent_slot:SLOT := SLOT;
+
+Section Public
+
+ - common_slot:SLOT <- parent_slot;
+
+ + index:INTEGER;
+
+ //
+ // Static and Dynamic profil.
+ //
+
+ + value:ITM_CODE;
+
+ //
+ // Dynamic profil.
+ //
+
+ + profil:FAST_ARRAY(PROFIL_SLOT);
+
+ - get_profil args:FAST_ARRAY(EXPR) self type_self:TYPE_FULL :(PROFIL, FAST_ARRAY(WRITE)) <-
+ [
+ -? {type_self != NULL};
+ ]
+ ( + result:PROFIL_SLOT;
+ + res_lst:FAST_ARRAY(WRITE);
+ + pro:PROFIL_SLOT;
+ + j,i:INTEGER;
+ + loc:LOCAL;
+ + typ:TYPE_FULL;
+ + typ_block:PROFIL_BLOCK;
+ + typ_list:TYPES_TMP;
+ + pro_list:FAST_ARRAY(PROFIL_SLOT);
+ + is_new:BOOLEAN;
+
+ // Block Detect.
+ j := args.lower;
+ {(j <= args.upper) && {(typ = NULL) || {! typ.raw.is_block}}}.while_do {
+ typ := args.item j.static_type;
+ (typ.raw.is_block).if {
+ typ_list := TYPES_TMP.new;
+ args.item j.get_type typ_list;
+ (typ_list.first = TYPE_NULL).if {
+ (typ_list.count > 1).if {
+ typ_block ?= typ_list.second;
+ } else {
+ typ := NULL;
+ };
+ } else {
+ typ_block ?= typ_list.first;
+ };
+ typ_list.free;
+ };
+ j := j + 1;
+ };
+
+ (typ_block != NULL).if {
+ pro_list := typ_block.profil_list;
+ i := pro_list.lower;
+ {(i <= pro_list.upper) && {result = NULL}}.while_do {
+ pro := pro_list.item i;
+ (
+ (pro.slot = Self) && {
+ (pro.type_self = NULL) || {pro.type_self == type_self}
+ } // BSBS: il fo aussi tester les args comme plus bas...
+ ).if {
+ result := pro; // Rmq. : It's limit for dispatching (See...)
+ };
+ i := i + 1;
+ };
+
+ (result = NULL).if {
+ result := PROFIL_SLOT.clone;
+ result.set_context_sensitive;
+ typ_block.profil_list.add_last result;
+ is_new := TRUE;
+ };
+ } else {
+ // Select classic Profil (no block).
+ j := profil.lower;
+ {(j <= profil.upper) && {result = NULL}}.while_do {
+ pro := profil.item j;
+ ((pro.type_self = NULL) || {pro.type_self == type_self}).if {
+ result := pro;
+ i := args.lower + 1;
+ {(i <= args.upper) && {result != NULL}}.while_do {
+ typ := args.item i.static_type;
+ loc := pro.argument_list.item i;
+ (
+ (loc != NULL) &&
+ {(typ.is_expanded) || {loc.type.is_expanded }} &&
+ {typ !== loc.type} && {loc.type.raw != type_boolean}
+ ).if {
+ result := NULL;
+ };
+ i := i + 1;
+ };
+ };
+ j := j + 1;
+ };
+ (result = NULL).if {
+ result := PROFIL_SLOT.clone;
+ profil.add_last result;
+ ((id_section.is_external) && {profil.count > 1}).if {
+ semantic_error (position,"Polymorphic External slot is not possible.");
+ };
+ is_new := TRUE;
+ };
+ };
+ (is_new).if {
+ res_lst := result.make Self with (type_self, args) verify (profil.count = 1);
+ } else {
+ res_lst := result.write_argument args;
+ };
+ result, res_lst
+ );
+
+ //
+ // Constructeur.
+ //
+
+ - create base:SLOT with val:ITM_CODE :SLOT_CODE <-
+ ( + result:SELF;
+ result := clone;
+ result.make base with val;
+ result
+ );
+
+ - make base:SLOT with val:ITM_CODE <-
+ (
+ parent_slot := base;
+ value := val;
+ profil := FAST_ARRAY(PROFIL_SLOT).create_with_capacity 1;
+ );
+
+ //
+ // Execute.
+ //
+
+ + last_type_contract:TYPE;
+ + is_require:BOOLEAN;
+
+ - previous_contract:ITM_LIST <-
+ ( + slot:ITM_SLOT;
+ + contract:ITM_LIST;
+
+ (is_require).if {
+ slot := last_type_contract.search_require name;
+ } else {
+ slot := last_type_contract.search_ensure name;
+ };
+ (slot != NULL).if {
+ (is_require).if {
+ contract := slot.require;
+ } else {
+ contract := slot.ensure;
+ };
+ last_type_contract := last_type_contract.last_type_contract;
+ };
+ contract
+ );
+
+ - create_code is_first:BOOLEAN <-
+ ( + contract:ITM_LIST;
+ + slot:ITM_SLOT;
+ + result:EXPR;
+ + mul:EXPR_MULTIPLE;
+ + nb_result_list:INTEGER;
+
+ verify := is_first;
+ // Require
+ is_require := TRUE;
+ contract := require;
+ last_type_contract := receiver_type;
+ (contract = NULL).if {
+ slot := receiver_type.search_require name;
+ (slot != NULL).if {
+ (verify).if {
+ is_equal_profil slot;
+ };
+ contract := slot.require;
+ last_type_contract := receiver_type.last_type_contract;
+ };
+ };
+ (contract != NULL).if {
+ contract.to_run_expr;
+ };
+
+ // Body.
+ result := value.to_run_expr;
+ (result.static_type.raw != TYPE_VOID).if {
+ mul ?= result;
+ (mul != NULL).if {
+ nb_result_list := mul.count;
+ } else {
+ nb_result_list := 1;
+ };
+ } else {
+ list_current.add_last result;
+ };
+ (profil_slot.result_list.count != nb_result_list).if {
+ string_tmp.copy "Incorrect value result (slot:";
+ profil_slot.result_list.count.append_in string_tmp;
+ string_tmp.append ", list:";
+ nb_result_list.append_in string_tmp;
+ string_tmp.append ").";
+ semantic_error (result.position,string_tmp);
+ };
+ (nb_result_list = 1).if {
+ put_result result in (profil_slot.result_list.first);
+ }.elseif {nb_result_list > 1} then {
+ (mul.lower).to (mul.upper) do { j:INTEGER;
+ put_result (mul.item j) in (profil_slot.result_list.item j);
+ };
+ };
+
+ // Ensure
+ is_require := FALSE;
+ contract := ensure;
+ last_type_contract := receiver_type;
+ (contract = NULL).if {
+ slot := receiver_type.search_ensure name;
+ (slot != NULL).if {
+ (verify).if {
+ is_equal_profil slot;
+ };
+ contract := slot.ensure;
+ last_type_contract := receiver_type.last_type_contract;
+ };
+ };
+ (contract != NULL).if {
+ contract.to_run_expr;
+ };
+ // Result.
+ (id_section.is_interrupt).if {
+ list_current.add_first (
+ EXTERNAL_C.create position text "__BEGIN_INTERRUPT__" access NULL
+ persistant TRUE type (TYPE_VOID.default)
+ );
+ list_current.add_last (
+ EXTERNAL_C.create position text "__END_INTERRUPT__" access NULL
+ persistant TRUE type (TYPE_VOID.default)
+ );
+ };
+ );
+
+ - remove_profil prof:PROFIL_SLOT <-
+ ( + idx:INTEGER;
+
+ idx := profil.fast_first_index_of prof;
+ (idx <= profil.upper).if { // Else, This profil is in BLOCK
+ profil.remove idx;
+ };
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append name;
+ (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
+ buffer.add_last ' ';
+ argument_list.item j.display buffer;
+ };
+ buffer.add_last ' ';
+ buffer.add_last ':';
+ type.display buffer;
+ );
+
+ - display_all <-
+ ( + prof:PROFIL;
+
+ string_tmp.clear;
+ (profil != NULL).if {
+ (profil.upper).downto (profil.lower) do { k:INTEGER;
+ prof := profil.item k;
+ prof.display_all string_tmp;
+ };
+ };
+ string_tmp.print;
+ );
+
+Section Private
+
+ - put_result e:EXPR in v:LOCAL <-
+ ( + val:EXPR;
+ + wrt:WRITE;
+ val := e.check_type (v.type) with (v.position);
+ wrt := v.write position value val;
+ list_current.add_last wrt;
+ );
+
\ No newline at end of file
diff --git a/src2/variable/slot_data.li b/src2/variable/slot_data.li
new file mode 100644
index 0000000..00b54b2
--- /dev/null
+++ b/src2/variable/slot_data.li
@@ -0,0 +1,514 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := SLOT_DATA;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Slot with data style";
+
+Section Inherit
+
+ + parent_variable:Expanded VARIABLE;
+
+ + parent_slot:SLOT := SLOT;
+
+Section Public
+
+ // BUG COMPILO 0.11
+
+ - id_section:SECTION_ <-
+ ( + result:SECTION_;
+
+ (parent_slot != NULL).if {
+ result := parent_slot.id_section;
+ } else {
+ result := SECTION_.get_name (ALIAS_STR.section_private);
+ };
+ result
+ );
+
+ - receiver_type:TYPE <-
+ ( + result:TYPE;
+
+ (parent_slot != NULL).if {
+ result := parent_slot.receiver_type;
+ } else {
+ result := type_block;
+ };
+ result
+ );
+
+ //
+
+ - common_slot:SLOT <- parent_slot;
+
+ //
+ // Sequence optimizer
+ //
+
+ + last_write:WRITE;
+ + last_seq_index:UINTEGER_32;
+ + last_seq_or_and:UINTEGER_32;
+ + last_seq_call_and_loop:UINTEGER_32;
+ + last_seq_call_local_and_loop:UINTEGER_32;
+
+ + last_list_current:LIST;
+ + last_index:INTEGER;
+
+ - is_invariant rec:EXPR :BOOLEAN <-
+ (
+ ((rec = NULL) || {rec.is_invariant}) &&
+ {last_write != NULL} &&
+ {loop_seq_call_and_loop = seq_call_and_loop} &&
+ {last_seq_index <= loop_seq_index}
+ );
+
+ - reset_last_write w:WRITE <-
+ (
+ (last_write = w).if {
+ last_write := NULL;
+ };
+ );
+
+ - set_read <-
+ (
+ last_index := -1;
+ );
+
+ - get_last_index:INTEGER <- last_index;
+
+ - set_write w:WRITE <-
+ (
+ /* A FAIRE
+ (
+ (! PROFIL.mode_recursive) &&
+ {style = '-'} &&
+ {last_write != NULL} &&
+ {last_index < list_current.index} &&
+ {last_sequence = sequence_global}
+ ).if {
+ ? {list_current.item last_index = last_write};
+ list_current.put (last_write.value) to last_index;
+ unwrite last_write;
+ new_execute_pass;
+ };
+ */
+ last_write := w;
+ last_seq_index := seq_index;
+ last_seq_or_and := seq_or_and;
+ last_seq_call_and_loop := seq_call_and_loop;
+ last_seq_call_local_and_loop:= seq_call_local_and_loop;
+ //
+ last_list_current := list_current;
+ last_index := list_current.index;
+ );
+
+ - get_last_value rec:EXPR :EXPR <-
+ ( + result:EXPR;
+ + val:EXPR;
+ + rd:READ;
+ + rd_loc:READ_LOCAL;
+ + wrt_slot:WRITE_SLOT;
+ + l:LOCAL;
+ + g:SLOT_DATA;
+ + is_rec_ok:BOOLEAN;
+ + my_require_count:INTEGER;
+ + pb:PROFIL_BLOCK;
+ + i:INSTR;
+
+ ((! PROFIL.mode_recursive) && {loop_invariant = NULL} && {last_write != NULL}).if {
+
+ my_require_count := require_count;
+ (rec != NULL).if {
+ // Block exception.
+ pb ?= rec.static_type.raw;
+ ((pb != NULL) && {require_list != NULL}).if {
+ rd_loc ?= rec;
+ l := rd_loc.local;
+ wrt_slot ?= require_first;
+ rd_loc ?= wrt_slot.receiver;
+ (rd_loc.local = l).if {
+ my_require_count := 1;
+ } else {
+ my_require_count := 0;
+ };
+ (require_list.lower).to (require_list.upper) do { j:INTEGER;
+ wrt_slot ?= require_list.item j;
+ rd_loc ?= wrt_slot.receiver;
+ (rd_loc.local = l).if {
+ my_require_count := my_require_count + 1;
+ };
+ };
+ };
+ };
+
+ (
+ (
+ (last_seq_call_and_loop = seq_call_and_loop) &&
+ {is_seq_list last_list_current}
+ ) || {my_require_count = 1}
+ ).if {
+ // Receiver test.
+ (rec = NULL).if {
+ is_rec_ok := TRUE;
+ }.elseif {rec.is_constant} then {
+ wrt_slot ?= last_write;
+ is_rec_ok := rec == wrt_slot.receiver;
+ } else {
+ rd ?= rec;
+ (rd != NULL).if {
+ l ?= rd.variable;
+ g ?= rd.variable;
+ wrt_slot ?= last_write;
+ rd ?= wrt_slot.receiver;
+ is_rec_ok := (rd != NULL) && {
+ (
+ {l = rd.variable} && {is_seq_list last_list_current} && {
+ (
+ (l.last_seq != NULL) && {l.last_seq.last_write != NULL} &&
+ {l.last_seq.last_seq_index < last_seq_index} &&
+ {last_seq_call_local_and_loop = seq_call_local_and_loop}
+ ) || {l.require_count <= 1} || {l.style = ' '}
+ }
+ ) ||
+ {
+ {g = rd.variable} && {g.style = '-'} && {
+ (
+ (g.last_write != NULL) && {g.last_seq_index < last_seq_index} &&
+ {last_seq_call_and_loop = seq_call_and_loop} &&
+ {is_seq_list (g.last_list_current)}
+ ) || {g.require_count = 1}
+ }
+ }
+ };
+ };
+ };
+ (is_rec_ok).if {
+ val := last_write.value;
+ rd ?= val;
+ (rd = NULL).if {
+ l := NULL;
+ g := NULL;
+ } else {
+ l ?= rd.variable;
+ g ?= rd.variable;
+ };
+ (
+ ( // Constant propagation.
+ val.is_constant
+ ) ||
+ { // Local propagation.
+ (l != NULL) && {is_seq_list last_list_current} && {
+ (
+ (l.last_seq != NULL) && {l.last_seq.last_write != NULL} &&
+ {l.last_seq.last_seq_index < last_seq_index} &&
+ {last_seq_call_local_and_loop = seq_call_local_and_loop}
+ ) || {l.require_count <= 1} || {l.style = ' '}
+ }
+ } ||
+ { // Global propagation.
+ (g != NULL) && {g.style = '-'} && {
+ (
+ (g.last_write != NULL) && {g.last_seq_index < last_seq_index} &&
+ {last_seq_call_and_loop = seq_call_and_loop} &&
+ {is_seq_list (g.last_list_current)}
+ ) || {g.require_count = 1}
+ }
+ }
+ ).if {
+ (rec != NULL).if {
+ rec.remove;
+ };
+ result := val.my_copy;
+ }.elseif {
+ // Propagation step by step.
+ (last_seq_or_and = seq_or_and) &&
+ {ensure_count = 1} &&
+ {list_current.index > list_current.lower} &&
+ {list_current.item (list_current.index - 1) = last_write}
+ } then {
+ (rec != NULL).if {
+ rec.remove;
+ wrt_slot ?= last_write;
+ wrt_slot.receiver.remove;
+ };
+ unwrite last_write;
+ list_current.put NOP to (list_current.index - 1);
+ result := val;
+ }.elseif {
+ (rec != NULL) && {is_seq_list last_list_current} &&
+ {my_require_count = 1} && {ensure_count = 1} &&
+ {last_index.in_range (last_list_current.lower) to (last_list_current.upper)} &&
+ {last_list_current.item last_index = last_write}
+ } then {
+ // Local conversion.
+ l := type.get_temporary position;
+ i := l.write (last_write.position) value val;
+ last_list_current.put i to last_index;
+ result := l.read (rec.position);
+ //
+ rec.remove;
+ wrt_slot ?= last_write;
+ wrt_slot.receiver.remove;
+ unwrite last_write;
+ };
+ };
+ };
+ };
+ result
+ );
+
+ //
+ // Constructeur.
+ //
+
+ - create b:SLOT type t:TYPE_FULL :SELF <-
+ (
+ create (b.position) name (b.name) style (b.style) base b type t
+ );
+
+ - create pos:POSITION name n:STRING_CONSTANT
+ style s:CHARACTER base b:SLOT type t:TYPE_FULL :SELF <-
+ // BSBS: N'est plus utilise' !!!
+ ( + result:SELF;
+ result := clone;
+ result.make pos name n style s base b type t;
+ result
+ );
+
+ - make pos:POSITION name n:STRING_CONSTANT style s:CHARACTER base b:SLOT type t:TYPE_FULL <-
+ ( + tmp:TYPES_TMP;
+ parent_slot := b;
+ //
+ position := pos;
+ name := n;
+ style := s;
+ intern_name := ALIAS_STR.get_intern name;
+ //
+ type := t;
+ (is_static).if {
+ tmp := TYPES_TMP.new;
+ tmp.add (type.raw);
+ type_list := tmp.to_types;
+ } else {
+ type_list := TYPES_TMP.types_empty;
+ };
+ ? {type != NULL};
+ );
+
+ //
+ // Context
+ //
+
+ + value_init:LIST;
+
+ - init <-
+ ( + val,rec:EXPR;
+ + wrt:WRITE;
+ + old_list:LIST;
+ + rd:ITM_READ_ARG1;
+ /*
+ string_tmp.copy "init : ";
+ string_tmp.append name;
+ warning_error (position,string_tmp);
+ */
+ ((value_init = NULL) && {(affect != '<') || {Self = slot_id}}).if {
+ // Context.
+ old_list := list_current;
+ value_init := list_current := LIST.create position;
+
+ (Self = slot_id).if {
+ val := PROTOTYPE_CST.create position type type;
+ } else {
+ // Code.
+ (value != NULL).if {
+ rd ?= value;
+ ((rd != NULL) && {rd.arg = NULL}).if {
+ rec := PROTOTYPE_CST.create position type (receiver_type.default);
+ val := rd.to_run_with_self (rec,FALSE,FALSE) args NULL;
+ } else {
+ val := value.to_run_expr;
+ };
+ } else {
+ val := type.default_value position;
+ };
+ val := val.check_type type with position;
+ };
+ (style = '+').if {
+ rec := PROTOTYPE_CST.create position type (receiver_type.default);
+ } else {
+ rec := NULL;
+ };
+ (debug_level_option != 0).if {
+ list_current.add_last (
+ PUSH.create position context context_main first FALSE
+ );
+ };
+ wrt := write position with rec value val;
+ (is_zero val).if {
+ wrt.set_quiet_generation;
+ };
+ list_current.add_last wrt;
+ list_current.add_last (PROTOTYPE_CST.create position type (TYPE_VOID.default)); // BSBS:Alias
+
+ list_current := old_list;
+ };
+ );
+
+ //
+ // Execute.
+ //
+
+ - execute <-
+ ( + lst:FAST_ARRAY(SLOT);
+ + slot:SLOT_DATA;
+ + s:SLOT;
+ + val:LIST;
+ + old_list_current:LIST;
+ //+ old_profil_current:PROFIL_SLOT;
+ + insert_index:INTEGER;
+
+ (value_init != NULL).if {
+ val := value_init;
+ value_init := NULL;
+ insert_index := list_main.index;
+ list_main.add val to insert_index;
+
+ (type.is_expanded).if {
+ lst := type.slot_run;
+ (lst != NULL).if {
+ (lst.lower).to (lst.upper) do { j:INTEGER;
+ s := lst.item j;
+ (s.style = '+').if {
+ slot := s.slot_data_intern;
+ (slot != NULL).if {
+ slot.execute;
+ };
+ slot := s.slot_id;
+ (slot != NULL).if {
+ slot.execute;
+ };
+ };
+ };
+ };
+ };
+
+ old_list_current := list_current;
+ //old_profil_current := profil_current;
+ list_current := NULL;
+ //profil_current := NULL;
+
+ val.execute;
+ list_main.inc_index;
+
+ list_current := old_list_current;
+ //profil_current := old_profil_current;
+ };
+ );
+
+ //
+ // Genere
+ //
+
+ - genere buffer:STRING <-
+ (
+ type.genere_declaration buffer;
+ buffer.add_last ' ';
+ type.genere_star_declaration buffer;
+ buffer.append intern_name;
+ buffer.append ";\n";
+ );
+
+ //
+ // Display.
+ //
+
+ - display buffer:STRING <-
+ (
+ buffer.append intern_name;
+ buffer.add_last ' ';
+ buffer.add_last ':';
+ type.display buffer;
+ );
+
+ - display_all <-
+ (
+ string_tmp.clear;
+ display string_tmp;
+ string_tmp.print;
+ );
+
+Section VARIABLE
+
+ - new_read p:POSITION with r:EXPR :READ <-
+ ( + result:READ;
+ (style = '-').if {
+ ? {r = NULL};
+ result := READ_GLOBAL.create p with Self;
+ } else {
+ ? {r != NULL};
+ result := READ_SLOT.create p with (r,Self);
+ };
+ result
+ );
+
+ - new_write p:POSITION with r:EXPR value v:EXPR :WRITE <-
+ ( + result:WRITE;
+ (style = '-').if {
+ ? {r = NULL};
+ result := WRITE_GLOBAL.create p with v in Self;
+ } else {
+ ? {r != NULL};
+ result := WRITE_SLOT.create p with v in (r,Self);
+ };
+ result
+ );
+
+ /*
+ - new_access r:EXPR :ACCESS <-
+ ( + result:ACCESS;
+
+ (style = '-').if {
+ result := ACCESS_GLOBAL.create Self;
+ } else {
+ result := ACCESS_SLOT.create Self with r;
+ };
+ result
+ );
+ */
+ - is_zero e:EXPR :BOOLEAN <-
+ ( + pro:PROTOTYPE_CST;
+ + int:INTEGER_CST;
+ (
+ pro ?= e;
+ (pro != NULL) && {
+ (pro.static_type.raw = TYPE_NULL) ||
+ {pro.static_type.raw = type_false}
+ }
+ ) || {
+ int ?= e;
+ (int != NULL) && {int.value = 0}
+ }
+ );
\ No newline at end of file
diff --git a/src2/variable/variable.li b/src2/variable/variable.li
new file mode 100644
index 0000000..c13397d
--- /dev/null
+++ b/src2/variable/variable.li
@@ -0,0 +1,406 @@
+///////////////////////////////////////////////////////////////////////////////
+// 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 := VARIABLE;
+
+ - copyright := "2003-2007 Benoit Sonntag";
+
+
+ - author := "Sonntag Benoit (bsonntag at loria.fr)";
+ - comment := "Parent for all variable";
+
+Section Inherit
+
+ + parent_named:Expanded NAMED;
+
+Section Public
+
+ - is_local:BOOLEAN <- FALSE;
+
+ //
+ //
+ //
+
+ + intern_name:STRING_CONSTANT;
+
+ - set_intern_name n:STRING_CONSTANT <-
+ (
+ intern_name := n;
+ );
+
+ - is_argument:BOOLEAN <- (style = ' ');
+
+ //
+ // Type.
+ //
+
+ + type:TYPE_FULL;
+
+ - set_type t:TYPE_FULL <-
+ (
+ ? {t != NULL};
+ type := t;
+ );
+
+ - init <- deferred;
+
+ //
+ // Typing Context.
+ //
+
+ - is_static:BOOLEAN <-
+ ((type.is_expanded) && {type.raw != type_boolean}) ||
+ {name = ALIAS_STR.variable_self};
+
+ + type_list:TYPES;
+
+ + ensure_count:INTEGER;
+
+ - set_ensure_count c:INTEGER <-
+ // Necessary for `context' local, `External' argument slot and `BLOCK' manager.
+ (
+ ensure_count := c;
+ );
+
+ + require_list:FAST_ARRAY(WRITE);
+ + require_first:WRITE;
+ - require_count:INTEGER <-
+ ( + result:INTEGER;
+ (require_first != NULL).if {
+ (require_list != NULL).if {
+ result := 1 + require_list.count;
+ } else {
+ result := 1;
+ };
+ };
+ result
+ );
+
+ + level_type:INTEGER;
+ - level_pass:INTEGER;
+
+ - update <-
+ (
+ level_pass := level_pass + 1;
+ );
+
+ // BSBS: BIG OPTIMISATION.
+ // Les listes de types s'auto-entretien (références cyclique)
+ // Il faut absolument régler ca !!!
+ // Nous avons le même pb avec 'item' et 'put__to'
+ // Il faudrai uniformiser la chose (item et put_to travailleraient
+ // avec une variable virtuel...)
+ // Aussi, il faut que tu profite de last_write pour optimiser...
+ - get_type t:TYPES_TMP <-
+ ( + tmp_type:TYPES_TMP;
+ + typ:TYPE;
+
+ (level_type < level_pass).if {
+ (! is_static).if {
+ typ := type.raw;
+ (
+ (is_executing_pass) || {
+ (require_first != NULL)/* &&
+ {
+ ((typ.subtype_list = NULL) || {typ.subtype_list.count > type_list.count}) ||
+ {typ = type_block}
+ }*/
+ }).if {
+ level_type := level_pass;
+ tmp_type := TYPES_TMP.new;
+ (require_first != NULL).if {
+
+ require_first.get_type tmp_type;
+ (require_list != NULL).if {
+ (require_list.lower).to (require_list.upper) do { j:INTEGER;
+ require_list.item j.get_type tmp_type;
+ };
+ };
+ };
+ type_list := tmp_type.update type_list;
+ };
+ };
+ };
+ t.union type_list;
+ );
+
+ //
+ // Sequence optimizer
+ //
+
+ - reset_last_write w:WRITE <-
+ (
+ deferred;
+ );
+
+ - set_write w:WRITE <-
+ (
+ deferred;
+ );
+
+ - set_read <-
+ (
+ deferred;
+ );
+
+ - get_last_index:INTEGER <- deferred;
+
+ - get_last_value rec:EXPR :EXPR <-
+ (
+ deferred;
+ NULL
+ );
+
+ //
+ // Writing.
+ //
+
+ - write p:POSITION value val:EXPR :WRITE <-
+ (
+ write p with NULL value val
+ );
+
+ - write p:POSITION with r:EXPR value val:EXPR :WRITE <-
+ (
+ write_direct p with r value val
+ );
+
+ - write_direct p:POSITION with r:EXPR value val:EXPR :WRITE <-
+ ( + e:WRITE;
+ + tmp_type:TYPES_TMP;
+
+ e := new_write p with r value val;
+ // Update require list.
+ (require_first = NULL).if {
+ require_first := e;
+ } else {
+ (require_list = NULL).if {
+ require_list := FAST_ARRAY(WRITE).create_with_capacity 1;
+ };
+ require_list.add_last e;
+ };
+
+ // Update type list.
+ ((! is_static) && {e.value != NULL} && {! is_executing_pass}).if {
+ tmp_type := TYPES_TMP.new;
+ (type_list != NULL).if {
+ tmp_type.union type_list;
+ };
+ e.value.get_type tmp_type;
+ type_list := tmp_type.update type_list;
+ };
+
+ e.set_create;
+ /*
+ (intern_name == "Self__GB").if {
+ "Creat :".print;
+ e.debug_display;
+ warning_error (e.position,"LA");
+ };
+ */
+
+ e
+ );
+
+ - unwrite e:WRITE <-
+ ( + idx:INTEGER;
+ /*
+ (intern_name == "Self__GB").if {
+ e.debug_display;
+ warning_error (e.position,"LA");
+ };
+ */
+
+ (! e.is_create).if {
+ crash;
+ };
+
+ (e.is_delete).if {
+ crash;
+ };
+
+ e.set_delete;
+
+ reset_last_write e;
+
+ // Require list.
+ (require_first = e).if {
+ (require_list != NULL).if {
+ require_first := require_list.first;
+ require_list.remove_first;
+ (require_list.is_empty).if {
+ require_list := NULL;
+ };
+ } else {
+ require_first := NULL;
+ };
+ } else {
+ ? {require_list != NULL};
+ //e.debug_display;
+ (require_list = NULL).if {
+ intern_name.print; '\n'.print;
+ crash_with_message "******** VARIABLE.unwrite : BUG require_list = NULL **********\n";
+ };
+
+ idx := require_list.fast_first_index_of e;
+ ? {idx <= require_list.upper};
+
+ (idx > require_list.upper).if {
+ intern_name.print; '\n'.print;
+ /*
+ e.to_pointer.print; ' '.print;
+
+ e.debug_display;
+ "\n--------\n".print;
+ require_first.debug_display;
+ (require_list.lower).to (require_list.upper) do { j:INTEGER;
+ require_list.item j.debug_display;
+ };
+ */
+ crash_with_message "******** VARIABLE.unwrite : BUG !!! **********\n";
+ };
+
+ require_list.remove idx;
+ (require_list.is_empty).if {
+ require_list := NULL;
+ };
+ };
+ );
+
+ //
+ // Reading.
+ //
+
+ - read p:POSITION :READ <-
+ (
+ read p with NULL
+ );
+ //[ ? {ensure_count := Old ensure_count + 1}; ];
+
+ - read p:POSITION with r:EXPR :READ <-
+ (
+ read_direct p with r
+ );
+
+ - read_direct p:POSITION with r:EXPR :READ <-
+ ( + result:READ;
+
+ result := new_read position with r;
+ ensure_count := ensure_count + 1;
+ /*
+ (intern_name == "Result__ID").if {
+ "VARIABLE create :".print;
+ result.debug_display;
+ (result.object_id = 6).if {
+ // crash;
+ };
+ };
+ */
+
+ result
+ );
+ //[ ? {ensure_count := Old ensure_count + 1}; ];
+
+ - unread e:READ <-
+ (
+
+ ensure_count := ensure_count - 1;
+ (ensure_count < 0).if {
+ "C'est : ".print;
+ e.debug_display;
+ "\n dans :\n".print;
+ list_current.debug_display;
+ '\n'.print;
+ crash;
+ };
+ /*
+ (intern_name == "Result__ID").if {
+ "VARIABLE delete :".print;
+ e.debug_display;
+ };
+*/
+
+ ? {ensure_count >= 0};
+ );
+
+ //
+ // Display.
+ //
+
+ - display_require buffer:STRING <-
+ ( + rd:READ;
+
+ (require_first != NULL).if {
+ buffer.append indent;
+ require_first.display buffer;
+ buffer.add_last '\n';
+ rd ?= require_first.value;
+ (rd != NULL).if {
+ indent.append " ";
+ rd.variable.display_require buffer;
+ indent.remove_last 2;
+ };
+ (require_list != NULL).if {
+ (require_list.lower).to (require_list.upper) do { i:INTEGER;
+ buffer.append indent;
+ require_list.item i.display buffer;
+ buffer.add_last '\n';
+ rd ?= require_list.item i.value;
+ (rd != NULL).if {
+ indent.append " ";
+ rd.variable.display_require buffer;
+ indent.remove_last 2;
+ };
+ };
+ };
+ };
+ );
+
+ - display buffer:STRING <-
+ (
+ buffer.append intern_name;
+ buffer.add_last ':';
+ type.append_name_in buffer;
+ //buffer.append (type.intern_name);
+ );
+
+ - display_type buffer:STRING <-
+ (
+ buffer.add_last '{';
+ (type_list.is_empty).if_false {
+ (type_list.lower).to (type_list.upper - 1) do { j:INTEGER;
+ buffer.append (type_list.item j.intern_name);
+ buffer.add_last 'x';
+ };
+ buffer.append (type_list.last.intern_name);
+ };
+ buffer.add_last '}';
+ );
+
+
+
+
+
+
+
+
+
diff --git a/src/wc_all b/src2/wc_all
similarity index 100%
copy from src/wc_all
copy to src2/wc_all
--
Lisaac compiler
More information about the Lisaac-commits
mailing list