tcl.puma

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

complex_qual (qualification := qualification (pos := pos)) => pos :- .
qualification_c (pos := pos) => pos :- .

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

FUNCTION get_env (qualification_c) env

qualification (qualification := qualification) ;
complex_qual  (qualification := qualification) ;
subscription  (qualification := qualification) ;
qualification :-
   RETURN get_env_2 (qualification);
   .

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

FUNCTION get_env_2 (qualification_c) env

local_ident (pos := pos, env := e, ident := ident) :-
   obj: objects; obj := IdentifyLocal (ident, e->env.objects);
   obj != NIL && obj->object.object->Kind == knamespace;
   use (obj, pos, PAF_REF_READ);
   RETURN obj->object.object->namespace.block->words.env;
   .
local_ident (pos := pos, ident := ident) :-
   use_undef (ident, pos);
   RETURN NIL;
   .
global_ident (pos := pos, ident := ident) :-
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL && obj->object.object->Kind == knamespace;
   use (obj, pos, PAF_REF_READ);
   RETURN obj->object.object->namespace.block->words.env;
   .
global_ident (pos := pos, ident := ident) :-
   use_undef (ident, pos);
   RETURN NIL;
   .
qualification (pos := pos, qualification := qualification, ident := ident) :-
   env: envs; env := get_env_2 (qualification);
   env != NIL;
   obj: objects; obj := IdentifyLocal (ident, env->env.objects);
   obj != NIL && obj->object.object->Kind == knamespace;
   use (obj, pos, PAF_REF_READ);
   RETURN obj->object.object->namespace.block->words.env;
   .
qualification (pos := pos, ident := ident) :-
   use_undef (ident, pos);
   RETURN NIL;
   .
complex_qual (pos := pos, qualification := qualification, texts := texts) :-
   env: envs; env := get_env_2 (qualification);
   env != NIL;
   ident: tIdent; ident := make_one_word (texts);
   obj: objects; obj := IdentifyLocal (ident, env->env.objects);
   obj != NIL && obj->object.object->Kind == knamespace;
   use (obj, pos, PAF_REF_READ);
   RETURN obj->object.object->namespace.block->words.env;
   .
subscription (pos := pos, qualification := qualification, index := index) :-
   RETURN get_env_2 (qualification);
   .
local_text (pos := pos, env := env, texts := texts) :-
   RETURN NIL;
   .
global_text (pos := pos, env := env, texts := texts) :-
   RETURN NIL;
   .
_ :-
   RETURN NIL;
   .

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

FUNCTION get_ident (qualification_c) tIdent

qualification (ident := ident) :-
   RETURN ident;
   .
complex_qual (texts := texts) :-
   RETURN make_one_word (texts);
   .
subscription (qualification := qualification) :-
   RETURN get_ident (qualification);
   .
local_ident (ident := ident) :-
   RETURN ident;
   .
global_ident (ident := ident) :-
   RETURN ident;
   .
_ :-
   RETURN NoIdent;
   .

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

PROCEDURE add_qualifications (tIdent, word_c)

(iset), w2: word_c (next := noword (...)) :-		/* set r	*/
   add_qual (w2, PAF_REF_READ);
   .
(iset), w2 :-						/* set w x	*/
   add_qual (w2, PAF_REF_WRITE);
   .
(ivariable), w2: word_c (next := noword (...)) :-	/* variable d	*/
   add_variable_quals (w2, PAF_REF_READ);
   .
(ivariable), w2 :-					/* variable w x ... */
   add_variable_quals (w2, PAF_REF_WRITE);
   .
(iappend), w2 :-					/* append w	*/
   add_qual (w2, PAF_REF_WRITE);
   .
(ilappend), w2 :-					/* lappend w	*/
   add_qual (w2, PAF_REF_WRITE);
   .
(iarray), w2: one_word (ident := (iset), next :=	/* array set w	*/
   w3: word_c (...)) :-
   add_qual (w3, PAF_REF_WRITE);
   .
(iarray), w2: word_c (next := w3: word_c (...)) :-	/* array x r	*/
   add_qual (w3, PAF_REF_READ);
   .
(ibinary), w2: one_word (ident := (iscan), next :=   /* binary scan x x w ... */
   w3: word_c (next :=
   w4: word_c (next :=
   w5: word_c (...)))) :-
   add_quals (w5, PAF_REF_WRITE);
   .
(iscan), w2: word_c (next :=				/* scan x x w ... */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_quals (w4, PAF_REF_WRITE);
   .
(iforeach), w2 :-					/* foreach */
   add_foreach_quals (w2);
   .
(ivwait), w2 :-						/* vwait r	*/
   add_qual (w2, PAF_REF_READ);
   .
(iincr), w2 :-						/* incr w	*/
   add_qual (w2, PAF_REF_WRITE);
   .
(iparray), w2 :-					/* parray r	*/
   add_qual (w2, PAF_REF_READ);
   .
(icatch), w2: word_c (next := w3: word_c (...)) :-	/* catch x w	*/
   add_qual (w3, PAF_REF_WRITE);
   .
(igets), w2: word_c (next := w3: word_c (...)) :-	/* gets x w	*/
   add_qual (w3, PAF_REF_WRITE);
   .
(iinfo), w2: one_word (ident := (iexists), next :=	/* info exists r */
   w3: word_c (...)) :-
   add_qual (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (iargs), next :=	/* info args r */
   w3: word_c (...)) :-
   add_qual (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (ibody), next :=	/* info body r */
   w3: word_c (...)) :-
   add_qual (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (idefault), next :=	/* info default r x w */
   w3: word_c (next :=
   w4: word_c (next :=
   w5: word_c (...)))) :-
   add_qual (w2, PAF_REF_READ);
   add_qual (w5, PAF_REF_WRITE);
   .
(itkinfo), w2: one_word (ident := (ivariable), next :=	/* tkinfo variable r */
   w3: word_c (...)) :-
   add_qual (w3, PAF_REF_READ);
   .
(ifile), w2: one_word (ident := (ilstat), next :=	/* file lstat x w */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_qual (w4, PAF_REF_WRITE);
   .
(ifile), w2: one_word (ident := (istat), next :=	/* file stat x w */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_qual (w4, PAF_REF_WRITE);
   .
(iunset), w2 :-						/* unset w ...	*/
   add_quals (w2, PAF_REF_WRITE);
   .
/*
(irename), w2 :-					/* rename r	/*
   add_qual (w2, PAF_REF_READ);
   .
*/

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

PROCEDURE add_variable_quals ([words, qualification_c], acc: int)

LOCAL { tTree obj, e2; }

qual_word (env := env, next := next: words, qualification := qualification), _ :-
   add_variable_quals (qualification, acc);
   add_variable_quals_2 (next);
   .
qual_words (next := next), _ :-
   add_variable_quals_2 (next);			/* crazy: ignore it */
   .
subscription (pos := pos, env := env, qualification := qualification), _ :-
   add_variable_quals (qualification, acc);
   .
q: qualification_c (env := e, pos := pos), _ :-
   e2 := get_env (q);
   e2 != NIL;
   ident: tIdent; ident := get_ident (q);
   obj: objects; obj := IdentifyLocal (ident, e2->env.objects);
   obj == NIL;
   e2->env.objects := object (q, ident, e2->env.objects);
   e := e2;
   dcl (e2->env.objects);
{  if (acc == PAF_REF_WRITE) use (e2->env.objects, pos, acc); };
   .
q: qualification_c (pos := pos), _ :-
   e2 != NIL;
   use (obj, pos, acc);
   .

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

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

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

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

PROCEDURE add_quals (words, acc: int)

w: word_c (next := next), _ :-
   add_qual (w, acc);
   add_quals (next, acc);
   .

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

PROCEDURE add_foreach_quals ([words, stmts])

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

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

PROCEDURE add_qual (w: [word_c, qualifications], acc: int)

qual_word (qualification := qualification), _ :-
   add_qual_2 (qualification, acc);
   .
qual_words (qualifications := qualifications), _ :-
   add_qual (qualifications, acc);
   .
one_qualification (next := next: noqualification (...), qualification := qualification: qualification_c), _ :-
   add_qual_2 (qualification, acc);
   .
one_qualification (next := next: qualifications, qualification := qualification: qualification_c), _ :-
   add_qual (next, acc);
   .

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

PROCEDURE add_qual_2 (w: qualification_c, acc: int)

LOCAL { tIdent id; tTree env; }

global_ident (pos := pos, ident := ident), _ :-
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL;
   use (obj, pos, acc);
   .
global_ident (pos := pos, ident := ident), _ :-
   genv->env.objects := object (w, ident, genv->env.objects);
   dcl (genv->env.objects);
{  if (acc == PAF_REF_WRITE) use (genv->env.objects, pos, acc); };
   .
global_text (pos := pos, texts := texts), _ :-
   id := make_one_word (texts);
   obj: objects; obj := IdentifyGlobal (id);
   obj != NIL;
   use (obj, pos, acc);
   .
global_text (pos := pos, texts := texts), _ :-
   genv->env.objects := object (w, id, genv->env.objects);
   dcl (genv->env.objects);
{  if (acc == PAF_REF_WRITE) use (genv->env.objects, pos, acc); };
   .
local_text (...), _ :-
   .
subscription (qualification := local_ident (...)), _ :-
   .
subscription (qualification := local_text (...)), _ :-
   .
subscription (qualification := qualification), _ :-
   add_qual_2 (qualification, acc);
   .
qualification_c (pos := pos), _ :-
   env := get_env (w);
   env != NIL;
   id := get_ident (w);
   obj: objects; obj := IdentifyLocal (id, env->env.objects);
   obj != NIL;
   use (obj, pos, acc);
   .
qualification_c (pos := pos, env := e), _ :-
   env != NIL;
   e := env;
   env->env.objects := object (w, id, env->env.objects);
   dcl (env->env.objects);
{  if (acc == PAF_REF_WRITE) use (env->env.objects, pos, acc); };
   .

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

PROCEDURE use_qual (qualification_c)

global_ident (pos := pos, ident := ident) :-
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
global_ident (pos := pos, ident := ident) :-
   use_undef (ident, pos);
   .
local_ident (pos := pos, env := e: env (object := proc (...)), ident := ident) ;
local_ident (pos := pos, env := e: env (object := program (...)), ident := ident) :-
   obj: objects; obj := IdentifyLocal (ident, e->env.objects);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
local_ident (pos := pos, env := e: env (object := namespace (...)), ident := ident) :-
   obj: objects; obj := Identify (ident, e);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
local_ident (pos := pos, ident := ident) :-
   use_undef (ident, pos);
   .
/*
global_text (pos := pos, texts := texts) :-
   ident: tIdent; ident := make_one_word (texts);
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
local_text (pos := pos, env := e, texts := texts) :-
   ident: tIdent; ident := make_one_word (texts);
   obj: objects; obj := Identify (ident, e);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
*/
subscription (qualification := qualification, index := index) :-
   use_qual (qualification);
   .
q: qualification_c (pos := pos) :-
   env: envs; env := get_env (q);
   env != NIL;
   ident: tIdent; ident := get_ident (q);
   obj: objects; obj := IdentifyLocal (ident, env->env.objects);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
q: qualification_c (pos := pos) :-
   env: envs; env := get_env (q);
   env != NIL;
   ident: tIdent; ident := get_ident (q);
   use_undef (ident, pos);
   .

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