tcl.puma

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

   add_variable_vars_2 (next);
   .
one_word (ident := ident, env := e, pos := pos, next := next), _ :-
   e2 := get_namespace (e);
   obj := IdentifyLocal (ident, e2->env.objects);
   obj != NIL;
   e->env.objects := object (obj->object.object, ident, e->env.objects);
   use (e->env.objects, pos, acc);
   add_variable_vars_2 (next);
   .
one_word (ident := ident, env := e, pos := pos, next := next), _ :-
   e2->env.objects := object (w, ident, e2->env.objects);
   e->env.objects := object (w, ident, e->env.objects);
   e := e2;
   dcl (e2->env.objects);
{  if (acc == PAF_REF_WRITE) use (e2->env.objects, pos, acc); };
   add_variable_vars_2 (next);
   .
qual_word (next := next, qualification := qualification), _ :-
   add_variable_vars (qualification, acc);
   add_variable_vars_2 (next);
   .
qual_words (next := next), _ :-
   add_variable_vars_2 (next);				/* crazy: ignore it */
   .
global_ident (pos := pos, env := e, ident := ident), _ :-
   obj := IdentifyGlobal (ident);
   obj != NIL;
   e->env.objects := object (obj->object.object, ident, e->env.objects);
   use (e->env.objects, pos, acc);
   .
global_ident (pos := pos, env := e, ident := ident), _ :-
   genv->env.objects := object (w, ident, genv->env.objects);
   e->env.objects := object (w, ident, e->env.objects);
   e := genv;
   dcl (genv->env.objects);
{  if (acc == PAF_REF_WRITE) use (genv->env.objects, pos, acc); };
   .
q: qualification (pos := pos), _ ;
q: complex_qual (pos := pos), _ :-			/* pass 2 */
   need_pass_2 := rtrue;
   .

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

PROCEDURE add_variable_vars_2 (words)		/* ignore initial value */

word_c (next := next: word_c (...)) :-
   add_variable_vars (next, PAF_REF_WRITE);
   .
word_c (next := next) :-
   add_variable_vars (next, PAF_REF_READ);
   .

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

PROCEDURE add_vars (words, acc: int)

w: word_c (next := next), _ :-
   add_var (w, acc);
   add_vars (next, acc);
   .

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

PROCEDURE add_foreach_vars ([words, stmts])

qual_word (qualification := local_text (texts := block (stmts := stmts)),
   next := word_c (next := next)) :-			/* foreach { w ... } */
   add_foreach_vars (stmts);
   add_foreach_vars (next);
   .
w: word_c (next := word_c (next := next)) :-		/* foreach w	*/
   add_var (w, PAF_REF_WRITE);
   add_foreach_vars (next);
   .
stmt (next := next, words := words) :-
   add_vars (words, PAF_REF_WRITE);
   add_foreach_vars (next);
   .

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

PROCEDURE add_var (w: word_c, acc: int)

one_word (env := env, ident := ident, pos := pos), _ :-
   add_var_2 (ident, pos, w, env, acc);
   .
qual_word (env := env, qualification := subscription (qualification :=
      l: local_ident (pos := pos, ident := ident))), _ :-
   add_var_2 (ident, pos, l, env, acc);
   .
qual_word (qualification := qualification (pos := pos)), _ ;
qual_word (qualification := complex_qual (pos := pos)), _ ;
qual_word (qualification := global_ident (pos := pos)), _ ;
qual_word (qualification := subscription (pos := pos)), _ :- /* pass 2 */
   need_pass_2 := rtrue;
   .

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

PROCEDURE add_var_2 (i: tIdent, pos: tPosition, w: [word_c, qualification_c],
	e: envs, acc: int)

e := env (object := proc (...)) ;
e := env (object := program (...)) :-
   obj: objects; obj := IdentifyLocal (i, e->env.objects);
   obj != NIL;
   use (obj, pos, acc);
   .
e := env (object := namespace (...)) :-
   obj: objects; obj := Identify (i, e);
   obj != NIL;
   use (obj, pos, acc);
   .
... :-
   e->env.objects := object (w, i, e->env.objects);
   dcl (e->env.objects);
{  if (acc == PAF_REF_WRITE) use (e->env.objects, pos, acc); };
   .

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

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

_, object (object := object, ident := ident, next := next) :-
   ident == i && object->Kind != kproc;
   RETURN o;
   .
_, object (object := object, ident := ident, next := next) :-
   RETURN IdentifyLocal (i, next);
   .
_, _ :-
   RETURN NIL;
   .

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

FUNCTION IdentifyGlobal (tIdent) objects

i :- genv != NIL; RETURN IdentifyLocal (i, genv->env.objects); .
_ :- RETURN NIL; .

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

FUNCTION Identify (tIdent, envs) objects

i, env (objects := objects) :-
   obj: objects; obj := IdentifyLocal (i, objects);
   obj != NIL;
   RETURN obj;
   .
i, e :-
   e != genv;
   RETURN IdentifyGlobal (i);
   .
... :-
   RETURN NIL;
   .

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

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

_, object (object := object, ident := ident, next := next) :-
   ident == i && object->Kind == kproc;
   RETURN o;
   .
_, object (object := object, ident := ident, next := next) :-
   RETURN IdentifyProcLocal (i, next);
   .
_, _ :-
   RETURN NIL;
   .

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

FUNCTION IdentifyProcGlobal (tIdent) objects

i :- genv != NIL; RETURN IdentifyProcLocal (i, genv->env.objects); .
_ :- RETURN NIL; .

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

FUNCTION IdentifyProc (tIdent, envs) objects

i, env (objects := objects) :-
   obj: objects; obj := IdentifyProcLocal (i, objects);
   obj != NIL;
   RETURN obj;
   .
i, e :-
   e != genv;
   RETURN IdentifyProcGlobal (i);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION get_namespace (envs) env

e: env (object := namespace	(...)) ;
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);
   pass2 (words);
   pass2 (next);
   .
stmt (env := env, next := next: stmts, words := words) :-
   pass2 (words);
   pass2 (next);
   .
proc (next := next, qualification := local_ident (ident := ident), block := block) ;
proc (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 (next := next, qualification := q: local_text (...), block := block) ;
proc (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 (next := next, qualification := q: qualification_c (pos := pos),
      param_names := param_names, env := e1,
      block := block: texts (env := env (env := e2))) :-
   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);
   } else {
      e1->env.objects = mobject (t, ident, e1->env.objects);
      dcl (e1->env.objects);
   }
};
   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))) :-
   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);
      }
   } else {
      e1->env.objects = mobject (t, ident, e1->env.objects);
      dcl (e1->env.objects);
   }
};
   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 := (irename), pos := pos, next :=
      w2: word_c (next :=
      w3: word_c (...)))) :-				/* rename r x	*/
   use_proc_undef (irename, pos);
   use_proc (w2);
   pass3 (w2);
   pass3 (next);
   .
stmt (env := env, next := next: stmts, words := words) :-
   use_proc (words);
   pass3 (words);
   pass3 (next);
   .
proc (env := env, next := next, qualification := q: qualification (...), parameter := parameter, block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (q));
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := get_class (q);
   pass3 (q);
   /* pass3 (parameter); */
   pass3 (block);
   cur_proc_ptr := prev_proc;
   cur_class_ptr := prev_class;
   pass3 (next);