itcl.puma

这是一个Linux下的集成开发环境

      w2: qual_word (qualification := global_ident (ident := (NoIdent)), next :=
      w3: word_c (...)))) :-
   obj: objects; obj := use_word (w1);
{
   if (obj) switch (obj->object.object->Kind) {
   case kclass		:
   case kitcl_class	: use_proc_object (obj, w3); break;
   }
};
   pass3 (w1);
   pass3 (next);
   .
stmt (next := next, words := w1: word_c (next := w2: word_c (...))) :-
   obj: objects; obj := use_word (w1);			/* class object	 */
{							/* object method */
   if (obj) switch (obj->object.object->Kind) {
   case kclass		:
   case kitcl_class	: w2 = declare_object (w2, obj); break;
   case kobj_word	: use_proc_object (obj, w2); break;
   }
};
   pass3 (w1);
   pass3 (next);
   .
stmt (next := next, words := w1: word_c (...)) :-
   obj: objects; obj := use_proc (w1);
   pass3 (w1);
   pass3 (next);
   .
stmt (next := next, words := words) :-
   pass3 (words);
   pass3 (next);
   .
body (env := env, next := next, qualification := qualification, parameter := parameter, block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (qualification));
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := get_class (qualification);
   pass3 (qualification);
   /* pass3 (parameter); */
   pass3 (block);
   cur_proc_ptr := prev_proc;
   cur_class_ptr := prev_class;
   pass3 (next);
   .
configbody (next := next, qualification := qualification, block := block) :-
   obj: objects; obj := use_qual (qualification);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := "";
   pass3 (block);
   cur_proc_ptr := prev_proc;
   pass3 (next);
   .
proc_c (next := next, qualification := qualification, block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (qualification));
   pass3 (qualification);
   /* pass3 (parameter); */
   pass3 (block);
   cur_proc_ptr := prev_proc;
   pass3 (next);
   .
namespace_c (next := next, qualification := qualification, block := block) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (qualification));
   pass3 (qualification);
   pass3 (block);
   cur_class_ptr := prev_class;
   pass3 (next);
   .
one_word (env := env, next := next: words, ident := ident) :-
   pass3 (next);
   .
obj_word (env := env, next := next: words, ident := ident) :-
   pass3 (next);
   .
qual_word (env := env, next := next: words, qualification := qualification) :-
   pass3 (qualification);
   pass3 (next);
   .
qual_words (env := env, next := next: words, qualifications := qualifications) :-
   pass3 (qualifications);
   pass3 (next);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c) :-
   pass3 (qualification);
   pass3 (next);
   .
character (env := env, next := next: texts, pos := pos, text := text) :-
   pass3 (next);
   .
ident (env := env, next := next: texts, pos := pos, ident := ident) :-
   pass3 (next);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c) :-
   obj: objects; obj := use_qual (qualification);
   pass3 (qualification);
   pass3 (next);
   .
block (env := env, next := next, pos := pos, stmts := stmts, type := type) :-
   prev_in_string: rbool; prev_in_string := in_string;
   in_string := type == '"';
   pass3 (stmts);
   in_string := prev_in_string;
   pass3 (next);
   .
block_content (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   pass3 (stmts);
   pass3 (next);
   .
qualification (pos := pos, qualification := qualification: qualification_c, ident := ident) :-
   pass3 (qualification);
   .
local_text (pos := pos, env := env, texts := texts) :-
   pass3 (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   pass3 (texts);
   .
complex_qual (pos := pos, env := env, qualification := qualification, texts := texts) :-
   pass3 (qualification);
   pass3 (texts);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c) :-
   pass3 (qualification);
   pass3 (index);
   .

/**************************************************************/

FUNCTION make_one_word ([texts, qualification_c]) tIdent

ident (next := notext (...), ident := ident) :-
   RETURN ident;
   .
t :-
   length := 0;
   make_one_word_2 (t);
   RETURN MakeIdent (buffer, length);
   .

/**************************************************************/

PROCEDURE make_one_word_2 ([texts, qualification_c])

character (next := next, text := text) :-
   buffer [length ++] := text;
   make_one_word_2 (next);
   .
ident (next := next, ident := ident) :-
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   make_one_word_2 (next);
   .
content (next := next, qualification := qualification) :-
   buffer [length ++] := '$';
   make_one_word_2 (qualification);
   make_one_word_2 (next);
   .
local_ident (pos := pos, env := env, ident := ident) :-
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
global_ident (pos := pos, env := env, ident := ident) :-
   strcpy (& buffer [length], "::"); length := length + 2;
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
local_text (pos := pos, env := env, texts := texts) :-
   make_one_word_2 (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   strcpy (& buffer [length], "::"); length := length + 2;
   make_one_word_2 (texts);
   .
qualification (pos := pos, qualification := qualification, ident := ident) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "::"); length := length + 2;
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
complex_qual (pos := pos, qualification := qualification, texts := texts) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "::"); length := length + 2;
   make_one_word_2 (texts);
   .
subscription (pos := pos, qualification := qualification, index := index) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "("); length := length + 1;
   make_one_word_2 (index);
   strcpy (& buffer [length], ")"); length := length + 1;
   .
block (next := notext (...), stmts := nostmt (...)) :-
   .
notext (...) :-
   .
_ :-
   buffer [length ++] := '?';
   .

/**************************************************************/

FUNCTION Mword (words, [word_c, qualification_c, qualifications]) words

w, local_ident (pos := pos, ident := ident) :-
   RETURN one_word (_, w, ident, pos);
   .
w, t: qualification_c (...) :-
   RETURN qual_word (_, w, t);
   .
w, t: one_qualification (...) :-
   RETURN qual_words (_, w, t);
   .
w, t: one_word (next := next) :-
   next := w;
   RETURN t;
   .

/**************************************************************/

FUNCTION Mqualification ([word_c, qualification_c, qualifications]) qualifications

one_word (ident := ident, pos := pos) :-
   RETURN one_qualification (next := noqualification (_), qualification :=
      local_ident (pos := pos, ident := ident));
   .
q: qualification_c (...) :-
   RETURN one_qualification (next := noqualification (_), qualification := q);
   .
q: qualifications (...) :-
   RETURN q;
   .

/**************************************************************/

FUNCTION Mstmt (stmts, words) stmts

s, w :-
   stmt: stmts; stmt := Mstmt_1 (s, w, default_attr);
   stmt != NIL;
   RETURN stmt;
   .
s, w :-
   RETURN stmt (_, s, w);
   .

/**************************************************************/

FUNCTION Mstmt_1 (stmts, words, attr: int) stmts

s, w1: one_word (ident := (ipublic), pos := pos, next := w2), _ :-
   RETURN Mstmt_1 (s, w2, PAF_PUBLIC);
   .
s, w1: one_word (ident := (iprotected), pos := pos, next := w2), _ :-
   RETURN Mstmt_1 (s, w2, PAF_PROTECTED);
   .
s, w1: one_word (ident := (iprivate), pos := pos, next := w2), _ :-
   RETURN Mstmt_1 (s, w2, PAF_PRIVATE);
   .
s, w1: one_word (ident := ident, pos := pos, next := w2), _ :-
   ident == iproc	||
   ident == imethod	||
   ident == ibody	||
   ident == iconfigbody	||
   ident == iconstructor||
   ident == idestructor	||
   ident == iclass	||
   ident == iitcl_class	||
   ident == inamespace	||
   ident == iat_scope	;
   gpos := pos;
   RETURN Mstmt_2 (s, ident, w2, attr);
   .
s, w1: qual_word (next := w2, qualification := global_ident (pos := pos, ident := ident)), _ :-
   RETURN Mstmt_1 (s, one_word (_, w2, ident, pos), attr);
   .
... :-
   RETURN NIL;
   .

/**************************************************************/

FUNCTION Mstmt_2 (stmts, tIdent, words, attr: int) stmts

s, (iproc),
   w2: word_c (next := noword (...)), _ :-
   get_end_pos (w2 => epos);
   RETURN proc (_, s, make_qualification (w2), noword (_), noword (_),
      notext (_), epos, attr);
   .
s, (iproc),
   w2: word_c	(next :=
   w3: word_c	(next := noword	(...))), _ :-
   get_end_pos (w3 => epos);
   RETURN proc (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, notext (_), epos, attr);
   .
s, (iproc),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4:>qual_word (qualification := local_text (texts := b: block (epos := epos))))), _ :-
   p: proc;
   p := proc (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, b, epos, attr);
   w4 := noword (_);
   RETURN p;
   .
s, (iproc),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4: word_c	(...))), _ :-
   get_end_pos (w4 => epos);
   RETURN proc (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, notext (_), epos, attr);
   .
s, (imethod),
   w2: word_c	(next := noword	(...)), _ :-
   itcl := itcl + 1;
   get_end_pos (w2 => epos);
   RETURN method (_, s, make_qualification (w2), noword (_), noword (_),
       notext (_), epos, attr);
   .
s, (imethod),
   w2: word_c	(next :=
   w3: word_c	(next := noword	(...))), _ :-
   itcl := itcl + 1;
   get_end_pos (w3 => epos);
   RETURN method (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, notext (_), epos, attr);
   .
s, (imethod),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4:>qual_word (qualification := local_text (texts := b: block (epos := epos))))), _ :-
   itcl := itcl + 1;
   p: method;
   p := method (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, b, epos, attr);
   w4 := noword (_);
   RETURN p;
   .
s, (imethod),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4: one_word (...))), _ :-
   itcl := itcl + 1;
   get_end_pos (w4 => epos);
   RETURN method (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, notext (_), epos, attr);
   .
s, (inamespace),
   w2: one_word (ident := (ieval), next :=
   w3: word_c	(next :=
   w4: qual_word (qualification := local_text (texts := b: block (epos := epos))))), _ :-
   tcl80 := tcl80 + 1;
   RETURN namespace (_, s, make_qualification (w3), b, epos, attr);
   .
s, (inamespace),
   w2: one_word (ident := (ieval), next :=
   w3: word_c	(next :=
   w4: word_c	(...))), _ :-
   tcl80 := tcl80 + 1;
   get_end_pos (w4 => epos);
   RETURN namespace (_, s, make_qualification (w3), notext (_), epos, attr);
   .
s, (inamespace),
   w2: word_c (next := next), _ :-
   get_script (next => script, epos);
   itcl := itcl + 1;
   RETURN namespace (_, s, make_qualification (w2), script, epos, attr);
   .
s, (iat_scope),
   w2: word_c (next := next), _ :-
   itcl := itcl + 1;
   get_end_pos_2 (next => epos);
   RETURN namespace (_, s, make_qualification (w2),
      block (_, notext (_), gpos, epos, stmt (_, nostmt (_), next), '@'), epos, attr);
   .
s, (iclass),
   w2: word_c	(next :=
   w3: qual_word (qualification := local_text (texts := b: block (epos := epos)))), _ :-
   itcl := itcl + 1;
   RETURN class (_, s, make_qualification (w2), b, epos, attr);
   .
s, (iitcl_class),
   w2: word_c	(next :=
   w3: qual_word (qualification := local_text (texts := b: block (epos := epos)))), _ :-
   itcl15 := itcl15 + 1;
   RETURN itcl_class (_, s, make_qualification (w2), b, epos, attr);
   .
s, (ibody),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4:>qual_word (qualification := local_text (texts := b: block (epos := epos))))), _ :-
   itcl := itcl + 1;
   p: body;
   p := body (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, b, epos, attr);
   w4 := noword (_);
   RETURN p;
   .
s, (iconfigbody),
   w2: word_c	(next :=
   w3:>qual_word (qualification := local_text (texts := b: block (epos := epos)))), _ :-
   itcl := itcl + 1;
   RETURN configbody (_, s, make_qualification (w2), noword (_), noword (_),
      b, epos, attr);
   .
s, (iconstructor),
   w2: word_c	(next :=
   w3:>qual_word (qualification :=
       local_text (texts := b: block (epos := epos)), next := noword (...))), _ :-
   itcl := itcl + 1;
   p: constructor;