itcl.puma

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

   RETURN IdentifySuper (ident, env);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION IdentifySuper (tIdent, envs) objects

ident, NIL :-
   RETURN NIL;
   .
ident, env2 (env1 := env1, env2 := env2) :-
   obj: objects; obj := IdentifyMember (ident, env1);
   obj != NIL;
   RETURN obj;
   .
ident, env2 (env1 := env1, env2 := env2) :-
   RETURN IdentifySuper (ident, env2);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION IdentifyVariable (tIdent, envs) objects

ident, env (env := env, objects := objects) :-
   obj: objects; obj := IdentifyLocal (ident, objects);
   obj != NIL;
   RETURN obj;
   .
ident, env (env := NIL) :-
   RETURN NIL;
   .
ident, env (env := env: env (object := class (...))) ;
ident, env (env := env: env (object := itcl_class (...))) :-
   obj: objects; obj := IdentifyMember (ident, env);
   obj != NIL;
   RETURN obj;
   .
... :-
   RETURN NIL;
   .

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

FUNCTION IdentifyProcLocal (i: tIdent, o: objects) objects

_, object (object := object, ident := ident, next := next) :-
   ident == i && Tree_IsType (object, kproc_c);
   RETURN o;
   .
_, object (object := object, ident := ident, next := next) :-
   RETURN IdentifyProcLocal (i, next);
   .
_, _ :-
   RETURN NIL;
   .

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

FUNCTION IdentifyProcGlobal (tIdent) objects

i :- RETURN IdentifyProcLocal (i, genv->env.objects); .

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

FUNCTION IdentifyProc (tIdent, envs) objects

i, env :-
   obj: objects; obj := IdentifyProcMember (i, env);
   obj != NIL;
   RETURN obj;
   .
i, env (env := NIL) :-
   RETURN NIL;
   .
i, env (env := env) ;
i, env2 (env2 := env) :-
   RETURN IdentifyProc (i, env);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION IdentifyProcMember (tIdent, envs) objects

ident, env (env := env, objects := objects) :-
   obj: objects; obj := IdentifyProcLocal (ident, objects);
   obj != NIL;
   RETURN obj;
   .
ident, env (env := env, objects := objects) :-
   RETURN IdentifyProcSuper (ident, env);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION IdentifyProcSuper (tIdent, envs) objects

ident, NIL :-
   RETURN NIL;
   .
ident, env2 (env1 := env1, env2 := env2) :-
   obj: objects; obj := IdentifyProcMember (ident, env1);
   obj != NIL;
   RETURN obj;
   .
ident, env2 (env1 := env1, env2 := env2) :-
   RETURN IdentifyProcSuper (ident, env2);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION get_namespace (envs) env

e: env (object := namespace_c	(...)) ;
e: env (object := program	(...)) :- RETURN e; .

env (env := env) :- RETURN get_namespace (env); .

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

PROCEDURE pass2 (t: Tree)

stmt (env := env, next := next: stmts, words := words:
      one_word (ident := ident, next := w2: word_c (...))) :-
   add_qualifications (ident, w2, default_attr);
   pass2 (words);
   pass2 (next);
   .
stmt (env := env, next := next: stmts, words := words) :-
   pass2 (words);
   pass2 (next);
   .
configbody (next := next, qualification := qualification, block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := "";
   get_objects (block);
   pass2 (block);
   cur_proc_ptr := prev_proc;
   pass2 (next);
   .
proc_c (next := next, qualification := local_ident (ident := ident), block := block) ;
proc_c (next := next, qualification := global_ident (ident := ident), block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   pass2 (block);
   cur_proc_ptr := prev_proc;
   pass2 (next);
   .
proc_c (next := next, qualification := q: local_text (...), block := block) ;
proc_c (next := next, qualification := q: global_text (...), block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (q));
   pass2 (block);
   cur_proc_ptr := prev_proc;
   pass2 (next);
   .
proc_c (next := next, qualification := q: qualification_c (pos := pos),
      param_names := param_names, env := e1,
      block := block: texts (env := env (env := e2)), attribute := attribute) :-
   e: envs; e := get_env (q);
   ident: tIdent; ident := get_ident (q);
{  if (e) {
      e1 = e;
      e2 = e;
      e->env.objects = mobject (t, ident, e->env.objects);
      dcl (e->env.objects, attribute);
   } else {
      e1->env.objects = mobject (t, ident, e1->env.objects);
      dcl (e1->env.objects, attribute);
   }
};
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := get_class (q);
   get_param_objects (param_names);
   get_objects (block);
   pass2 (block);
   cur_proc_ptr := prev_proc;
   cur_class_ptr := prev_class;
   pass2 (next);
   .
namespace (next := next, qualification := local_ident (ident := ident), block := block) ;
namespace (next := next, qualification := global_ident (ident := ident), block := block) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   pass2 (block);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
namespace (next := next, qualification := q: local_text (...), block := block) ;
namespace (next := next, qualification := q: global_text (...), block := block) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (q));
   pass2 (block);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
namespace (next := next, qualification := q: qualification_c (pos := pos),
      env := e1, block := blk: texts (env := env (env := e2)),
      attribute := attribute) :-
   e: envs; e := get_env (q);
   ident: tIdent; ident := get_ident (q);
   obj: objects;
{  if (e) {
      e1 = e;
      e2 = e;
      obj = IdentifyLocal (ident, e->env.objects);
      if (obj != NoTree && obj->object.object->Kind == knamespace) {
	 relocate (blk, obj->object.object->namespace.block->texts.env);
	 use (obj, pos, PAF_REF_READ);
      } else {
	 e->env.objects = mobject (t, ident, e->env.objects);
	 dcl (e->env.objects, attribute);
      }
   } else {
      e1->env.objects = mobject (t, ident, e1->env.objects);
      dcl (e1->env.objects, attribute);
   }
};
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   pass2 (blk);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
class (next := next, qualification := local_ident (ident := ident), block := block) ;
itcl_class (next := next, qualification := local_ident (ident := ident), block := block) ;
class (next := next, qualification := global_ident (ident := ident), block := block) ;
itcl_class (next := next, qualification := global_ident (ident := ident), block := block) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   pass2 (block);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
class (next := next, qualification := q: local_text (...), block := block) ;
itcl_class (next := next, qualification := q: local_text (...), block := block) ;
class (next := next, qualification := q: global_text (...), block := block) ;
itcl_class (next := next, qualification := q: global_text (...), block := block) :-
   ident: tIdent; ident := get_ident (q);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   pass2 (block);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
class (next := next, qualification := q: qualification_c (pos := pos),
      env := e1, block := blk: texts (env := env (env := e2)),
      attribute := attribute) ;
itcl_class (next := next, qualification := q: qualification_c (pos := pos),
      env := e1, block := blk: texts (env := env (env := e2)),
      attribute := attribute) :-
   e: envs; e := get_env (q);
   ident: tIdent; ident := get_ident (q);
   obj: objects;
{  if (e) {
      e1 = e;
      e2 = e;
      obj = IdentifyLocal (ident, e->env.objects);
      if (obj != NoTree && Tree_IsType (obj->object.object, knamespace_c)) {
	 relocate (blk, obj->object.object->namespace_c.block->texts.env);
	 use (obj, pos, PAF_REF_READ);
      } else {
	 e->env.objects = mobject (t, ident, e->env.objects);
	 dcl (e->env.objects, attribute);
      }
   } else {
      e1->env.objects = mobject (t, ident, e1->env.objects);
      dcl (e1->env.objects, attribute);
   }
};
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   pass2 (blk);
   cur_class_ptr := prev_class;
   pass2 (next);
   .
stmt_c (env := env, next := next: stmts) :-
   pass2 (next);
   .
one_word (env := env, next := next: words, ident := ident, pos := pos) :-
   pass2 (next);
   .
qual_word (env := env, next := next: words, qualification := qualification: qualification_c) :-
   pass2 (qualification);
   pass2 (next);
   .
qual_words (env := env, next := next: words, qualifications := qualifications) :-
   pass2 (qualifications);
   pass2 (next);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c) :-
   pass2 (qualification);
   pass2 (next);
   .
block (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   pass2 (stmts);
   pass2 (next);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c) :-
   pass2 (qualification);
   pass2 (next);
   .
block_content (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   pass2 (stmts);
   pass2 (next);
   .
text (env := env, next := next: texts, pos := pos) :-
   pass2 (next);
   .
local_text (pos := pos, env := env, texts := texts) :-
   pass2 (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   pass2 (texts);
   .
qualification (pos := pos, env := env, qualification := qualification: qualification_c, ident := ident) :-
   pass2 (qualification);
   .
complex_qual (pos := pos, env := env, qualification := qualification: qualification_c, texts := texts) :-
   pass2 (qualification);
   pass2 (texts);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c) :-
   pass2 (qualification);
   pass2 (index);
   .

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

PROCEDURE pass3 (Tree)

stmt (next := next, words :=
      w1: one_word (ident := ident)) :-			/* #		*/
   GetCStr (ident) [0] == '#';
   pass3 (next);
   .
stmt (next := next, words :=
      w1: one_word (ident := (ilocal), pos := pos, next :=
      w2: word_c (next :=
      w3: word_c (...)))) :-				/* local r d	*/
   use_proc_undef (ilocal, pos);
   obj: objects; obj := use_word (w2);
   w3 := declare_object (w3, obj);
   pass3 (w2);
   pass3 (next);
   .
stmt (next := next, words :=
      w1: one_word (ident := (irename), pos := pos, next :=
      w2: word_c (next :=
      w3: word_c (...)))) :-				/* rename r x	*/
   use_proc_undef (irename, pos);
   obj: objects; obj := use_proc (w2);
   pass3 (w2);
   pass3 (next);
   .
stmt (next := next, words :=
      w1: one_word (ident := (idelete), pos := pos, next :=
      w2: one_word (ident := ident, next := w3))) :-	/* delete x w ... */
   use_proc_undef (idelete, pos);
   ident == iobject || ident == iclass || ident == inamespace;
   add_vars (w3, PAF_REF_WRITE);
   pass3 (w3);
   pass3 (next);
   .
stmt (next := next, words :=			/* itcl_info objects ... */
      w1: one_word (ident := (iitcl_info), pos := pos, next :=
      w2: one_word (ident := (iobjects), next := w3))) :-
   use_proc_undef (iitcl_info, pos);
   itcl_info (w3);
   pass3 (w3);
   pass3 (next);
   .
stmt (next := next, env := env, words :=		/* virtual	*/
      w1: one_word (ident := (ivirtual), pos := pos, next := w2)) :-
   use_proc_undef (ivirtual, pos);
   pass3 (stmt (env := env, next := nostmt (env := env), words := w2));
   pass3 (next);
   .
stmt (next := next, env := env, words :=		/* previous	*/
      w1: one_word (ident := (iprevious), pos := pos, next := w2)) :-
   use_proc_undef (iprevious, pos);
   pass3 (stmt (env := env, next := nostmt (env := env), words := w2));
   pass3 (next);
   .
stmt (next := next, env := env, words :=		/* $this method */
      w1: qual_word (next :=
      w2: one_word (ident := ident, pos := pos, next := w3),
      qualification := local_text (texts := content (next := notext (_),
      qualification := local_ident (ident := (ithis)))))) :-
   obj: objects; obj := IdentifyMember (ident, get_namespace (env));
{  if (obj) use (obj, pos, PAF_REF_READ); };
   pass3 (w3);
   pass3 (next);
   .
stmt (next := next, words :=				/* class :: proc */
      w1: word_c (next :=