itcl.puma

linux 下的源代码分析阅读器 red hat公司新版

TRAFO	itcl

PUBLIC	Interpret_itcl make_one_word Mword Mqualification Mstmt Mblock_content

GLOBAL {
# include "Reuse.h"
# include "Position.h"
# include "StringM.h"
# include "Idents.h"
# include "Parser.h"
# include "Eval.h"
# include "paf.h"

# define null		(char *) NULL
# define scope_type(cur_class) cur_class ? PAF_MBR_FUNC_DEF : PAF_FUNC_DEF
# define default_attr	PAF_PUBLIC

extern	FILE *	cross_ref_fp	;
extern	int	report_local_vars;

static	tIdent
		iat_scope	,
		iclass		,
		icommon		,
		iconfigbody	,
		iconstructor	,
		idestructor	,
		idelete		,
		ihash_auto	,
		iinherit	,
		iisa		,
		iitcl		,
		iitcl_class	,
		iitcl_info	,
		iitk		,
		iiwidgets	,
		ilocal		,
		imethod		,
		iobject		,
		iobjects	,
		iprevious	,
		iprivate	,
		iprotected	,
		ipublic		,
		ithis		,
		ivirtual	;

static	char	buffer [1024]	;
static	char	args_buffer [1024];
static	int	length		;
static	rbool	need_pass_2	;
static	rbool	in_string	;
static	tPosition gpos		;
static	tTree	genv, predef	;
static	char *	p		;
static	char *	current_ident	;
static	char *	current_class	;
static	char *	cur_proc_ptr	= NULL;
static	char *	cur_class_ptr	= NULL;
static	char *	cur_arg_types_ptr = NULL;

static tIdent MakeID
# if defined __STDC__ | defined __cplusplus
(char * s)
# else
(s)
 char * s;
# endif
{
   return MakeIdent (s, strlen (s));
}
}

BEGIN {
   yyf		= stdout;
   need_pass_2	= rfalse;
   in_string	= rfalse;

   iappend	= MakeID ("append");
   iarray	= MakeID ("array");
   ibreak	= MakeID ("break");
   icatch	= MakeID ("catch");
   icontinue	= MakeID ("continue");
   idefault	= MakeID ("default");
   ifor		= MakeID ("for");
   iforeach	= MakeID ("foreach");
   iglobal	= MakeID ("global");
   iif		= MakeID ("if");
   iincr	= MakeID ("incr");
   iinfo	= MakeID ("info");
   ilappend	= MakeID ("lappend");
   ireturn	= MakeID ("return");
   iset		= MakeID ("set");
   iunset	= MakeID ("unset");
   iwhile	= MakeID ("while");

   last_keyword	= MakeID ("concat");
   last_keyword	= MakeID ("eval");
   last_keyword	= MakeID ("expr");
   last_keyword	= MakeID ("format");
   last_keyword	= MakeID ("glob");
   last_keyword	= MakeID ("join");
   last_keyword	= MakeID ("lindex");
   last_keyword	= MakeID ("linsert");
   last_keyword	= MakeID ("list");
   last_keyword	= MakeID ("llength");
   last_keyword	= MakeID ("lrange");
   last_keyword	= MakeID ("lreplace");
   last_keyword	= MakeID ("lsearch");
   last_keyword	= MakeID ("lsort");
   last_keyword	= MakeID ("regexp");
   last_keyword	= MakeID ("regsub");
   last_keyword	= MakeID ("split");
   last_keyword	= MakeID ("string");
   last_keyword	= MakeID ("switch");
   last_keyword	= MakeID ("uplevel");
   last_keyword	= MakeID ("upvar");
   last_keyword	= MakeID ("winfo");

   iargs	= MakeID ("args");
   ibinary	= MakeID ("binary");
   ibody	= MakeID ("body");
   icatch	= MakeID ("catch");
   ieval	= MakeID ("eval");
   iexists	= MakeID ("exists");
   ifile	= MakeID ("file");
   iforeach	= MakeID ("foreach");
   igets	= MakeID ("gets");
   iglobal	= MakeID ("global");
   ilstat	= MakeID ("lstat");
   inamespace	= MakeID ("namespace");
   iparray	= MakeID ("parray");
   iproc	= MakeID ("proc");
   irename	= MakeID ("rename");
   iscan	= MakeID ("scan");
   isource	= MakeID ("source");
   istat	= MakeID ("stat");
   itkinfo	= MakeID ("tkinfo");
   ivariable	= MakeID ("variable");
   ivwait	= MakeID ("vwait");

   iat_scope	= MakeID ("@scope");
   iclass	= MakeID ("class");
   icommon	= MakeID ("common");
   iconfigbody	= MakeID ("configbody");
   iconstructor	= MakeID ("constructor");
   idelete	= MakeID ("delete");
   idestructor	= MakeID ("destructor");
   ihash_auto	= MakeID ("#auto");
   iinherit	= MakeID ("inherit");
   iisa		= MakeID ("isa");
   iitcl	= MakeID ("itcl");
   iitcl_class	= MakeID ("itcl_class");
   iitcl_info	= MakeID ("itcl_info");
   iitk		= MakeID ("itk");
   iiwidgets	= MakeID ("iwidgets");
   ilocal	= MakeID ("local");
   imethod	= MakeID ("method");
   iobject	= MakeID ("object");
   iobjects	= MakeID ("objects");
   iprevious	= MakeID ("previous");
   iprivate	= MakeID ("private");
   iprotected	= MakeID ("protected");
   ipublic	= MakeID ("public");
   ithis	= MakeID ("this");
   ivirtual	= MakeID ("virtual");

   genv		= mnoobject ();
   predef	= mnostmt ();
   predef	= mclass (predef, mlocal_ident (NoPosition, iitcl),
		     mnotext (), NoPosition, PAF_PUBLIC);
   genv		= mobject (predef, iitcl, genv);
   predef	= mclass (predef, mlocal_ident (NoPosition, iitk),
		     mnotext (), NoPosition, PAF_PUBLIC);
   genv		= mobject (predef, iitk, genv);
   predef	= mclass (predef, mlocal_ident (NoPosition, iiwidgets),
		     mnotext (), NoPosition, PAF_PUBLIC);
   genv		= mobject (predef, iiwidgets, genv);
   predef	= mprogram (predef);
   Eval (predef);
}

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

PROCEDURE Interpret_itcl (Tree)

program (stmts := stmts: stmts (env := env: env (objects := objects))) :-
   objects := genv;
   genv := env;
   cur_class_ptr := null; cur_proc_ptr := null;
   get_objects (stmts);					/* pass 1 */
{  if (need_pass_2) {
      cur_class_ptr = null; cur_proc_ptr = null;
      pass2 (stmts);
   }
};
   cur_class_ptr := null; cur_proc_ptr := null;
   pass3 (stmts);
   .

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

PROCEDURE get_objects (s: Tree)

proc_c (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident),
      param_names := param_names, block := block, attribute := attribute) :-
   e->env.objects := object (s, ident, e->env.objects);
   dcl (e->env.objects, attribute);
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc_c (next := next, qualification := qualification:
      global_ident (pos := pos, ident := ident),
      param_names := param_names, block := block, attribute := attribute) :-
   genv->env.objects := object (s, ident, genv->env.objects);
   dcl (genv->env.objects, attribute);
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc_c (next := next, qualification := q: local_text (...),
      param_names := param_names, block := block) ;
proc_c (next := next, qualification := q: global_text (...),
      param_names := param_names, block := block) :-
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (q));
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc_c (next := next) :-
   need_pass_2 := rtrue;
   get_objects (next);					/* pass 2 */
   .
namespace (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) :-
   obj: objects; 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 (s, ident, e->env.objects);
      dcl (e->env.objects, attribute);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
namespace (next := next, qualification := qualification:
      global_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) :-
   obj: objects; obj := IdentifyGlobal (ident);
{  if (obj != NoTree && obj->object.object->Kind == knamespace) {
      relocate (blk, obj->object.object->namespace.block->texts.env);
      use (obj, pos, PAF_REF_READ);
   } else {
      genv->env.objects = mobject (s, ident, genv->env.objects);
      dcl (genv->env.objects, attribute);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
namespace (next := next, qualification := q: local_text (...), block := block) ;
namespace (next := next, qualification := q: global_text (...), block := block) :-
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (q));
   get_objects (block);
   cur_class_ptr := prev_class;
   .
namespace (next := next) :-
   need_pass_2 := rtrue;
   get_objects (next);					/* pass 2 */
   .
class (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) ;
itcl_class (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) :-
   obj: objects; obj := IdentifyLocal (ident, e->env.objects);
{  if (obj != NoTree && Tree_IsType (obj->object.object, knamespace_c)) {
      relocate (blk, obj->object.object->class.block->texts.env);
      use (obj, pos, PAF_REF_READ);
   } else {
      e->env.objects = mobject (s, ident, e->env.objects);
      dcl (e->env.objects, attribute);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
class (next := next, env := e, qualification := qualification:
      global_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) ;
itcl_class (next := next, env := e, qualification := qualification:
      global_ident (pos := pos, ident := ident),
      block := blk, attribute := attribute) :-
   obj: objects; obj := IdentifyGlobal (ident);
{  if (obj != NoTree && Tree_IsType (obj->object.object, knamespace_c)) {
      relocate (blk, obj->object.object->class.block->texts.env);
      use (obj, pos, PAF_REF_READ);
   } else {
      e->env.objects = mobject (s, ident, e->env.objects);
      dcl (e->env.objects, attribute);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
class (next := next, env := e, qualification := q:
      local_text (...), block := blk, attribute := attribute) ;
itcl_class (next := next, env := e, qualification := q:
      local_text (...), block := blk, attribute := attribute) ;
class (next := next, env := e, qualification := q:
      global_text (...), block := blk, attribute := attribute) ;
itcl_class (next := next, env := e, qualification := q:
      global_text (...), block := blk, attribute := attribute) :-
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (q));
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
class (next := next) ;
itcl_class (next := next) :-
   need_pass_2 := rtrue;
   get_objects (next);					/* pass 2 */
   .
stmt (env := env, next := next: stmts, words := words:
      one_word (ident := ident, next := w2: word_c (...))) :-
   add_variables (ident, w2, default_attr);
   get_objects (words);
   get_objects (next);
   .
stmt (env := env, next := next: stmts, words := words) :-
   get_objects (words);
   get_objects (next);
   .
block (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   get_objects (stmts);
   get_objects (next);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
block_content (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   get_objects (stmts);
   get_objects (next);
   .
text (env := env, next := next: texts, pos := pos) :-
   get_objects (next);
   .
one_word (env := env, next := next: words, ident := ident, pos := pos) :-
   get_objects (next);
   .
qual_word (env := env, next := next: words, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
qual_words (env := env, next := next: words, qualifications := qualifications) :-
   get_objects (qualifications);
   get_objects (next);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
local_text (pos := pos, env := env, texts := texts) :-
   get_objects (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   get_objects (texts);
   .
qualification (pos := pos, env := env, qualification := qualification: qualification_c, ident := ident) :-
   get_objects (qualification);
   .
complex_qual (pos := pos, env := env, qualification := qualification: qualification_c, texts := texts) :-
   get_objects (qualification);
   get_objects (texts);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c) :-
   get_objects (qualification);
   get_objects (index);
   .

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

PROCEDURE get_param_objects (s: words)