java.puma

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

TRAFO	Trafo

PUBLIC	to_types to_names to_files get_objects Traverse

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

# define null (char *) NULL

static	char *	p;
static	char *	cur_class_ptr	;
static	char *	cur_method_ptr	;
static	char *	cur_arg_types_ptr;
static	char	cur_arg_types [256];
static	char	ref_class [256], ref_sym [256], ref_arg_types [256];
static	int	acc		= PAF_REF_READ;
static	short	no_of_args	= -1;
}

PROCEDURE to_types ([decl_list, type, qualified_symbol], tString)

t, buffer :- p := buffer; get_types (t); * p := '\0'; .

PROCEDURE get_types ([decl_list, type, qualified_symbol])

parameter (next := next, type := type, ident := ident, array := array) :-
   get_types (type);
   get_types (array);
   get_separator (next);
   get_types (next);
   .
simple_type (type := type) :-
   strcpy (p, types [type]); p := p + strlen (types [type]);
   .
named_type (qualified_symbol := qualified_symbol) :-
   get_types (qualified_symbol);
   .
array_type (type := type) :-
   get_types (type);
   strcpy (p, "[]"); p := p + 2;
   .
qualification (qualified_symbol := qualified_symbol, ident := ident) :-
   get_types (qualified_symbol);
   * p ++ := '.';
   GetString (ident, p); p := p + LengthSt (GetStringRef (ident));
   .
ident (ident := ident) :-
   GetString (ident, p); p := p + LengthSt (GetStringRef (ident));
   .

PROCEDURE to_names (decl_list, tString)

t, buffer :- p := buffer; get_names (t); * p := '\0'; .

PROCEDURE get_names (decl_list)

parameter (next := next, ident := ident) :-
   GetString (ident, p); p := p + LengthSt (GetStringRef (ident));
   get_separator (next);
   get_names (next);
   .

PROCEDURE to_files (qualified_symbol, tString)

t, buffer :- p := buffer; get_files (t); * p := '\0'; .

PROCEDURE get_files (qualified_symbol)

qualification (qualified_symbol := qualified_symbol, ident := ident) :-
   get_files (qualified_symbol);
   * p ++ := '/';
   GetString (ident, p); p := p + LengthSt (GetStringRef (ident));
   .
ident (ident := ident) :-
   GetString (ident, p); p := p + LengthSt (GetStringRef (ident));
   .

PROCEDURE get_separator (decl_list)

parameter (...) :- * p ++ := ','; .

/********* add the objects declared in various lists to list o.	*/

FUNCTION get_objects (t: Tree, o: objects) objects

import_asterisk (next := next, qualified_symbol := qualified_symbol), _ :-
   RETURN get_objects (next, o);
   .
import (next := next, qualified_symbol := qualified_symbol), _ :-
   RETURN get_objects (next, get_objects (qualified_symbol, o));
   .
noimport (...), _ :-
   RETURN o;
   .
qualification (qualified_symbol := qualified_symbol, ident := ident), _ :-
   RETURN object (t, ident, o, _);
   .
ident (ident := ident), _ :-
   RETURN object (t, ident, o, _);
   .
type_decl (next := next, ident := ident), _ :-
   RETURN get_objects (next, object (t, ident, o, _));
   .
function (next := next, ident := ident), _ :-
   RETURN get_objects (next, object (t, ident, o, _));
   .
var_decl (next := next, decl_list := decl_list), _ :-
   RETURN get_objects (next, get_objects (decl_list, o));
   .
field (next := next), _ :-
   RETURN get_objects (next, o);
   .
nofield (...), _ :-
   RETURN o;
   .
decl (next := next, ident := ident), _ :-
   RETURN get_objects (next, object (t, ident, o, _));
   .
nodecl (...), _ :-
   RETURN o;
   .
statement (next := next, statement := statement), _ :-
   RETURN get_objects (next, get_objects (statement, o));
   .
nostatement (...), _ :-
   RETURN o;
   .
var_decl_stmt (decl_list := decl_list), _ :-
   RETURN get_objects (decl_list, o);
   .
type_decl_stmt (type_decl := type_decl), _ :-
   RETURN get_objects (type_decl, o);
   .
if_stmt (then := then), _ :-
   RETURN get_objects (then, o);
   .
if_else_stmt (then := then, Else := Else), _ :-
   RETURN get_objects (Else, get_objects (then, o));
   .
while_stmt (statement := statement), _ :-
   RETURN get_objects (statement, o);
   .
do_stmt (statement := statement), _ :-
   RETURN get_objects (statement, o);
   .
synchronized_stmt (statement := statement), _ :-
   RETURN get_objects (statement, o);
   .
labeled_stmt (ident := ident, statement := statement), _ :-
   RETURN get_objects (statement, object (t, ident, o, _));
   .
try_stmt (statement := statement, finally := finally), _ :-
   RETURN get_objects (finally, get_objects (statement, o));
   .
switch_stmt (switch_list := switch_list), _ :-
   RETURN get_objects (switch_list, o);
   .
statement_c (...), _ :-
   RETURN o;
   .
switch_ (next := next, statement_list := statement_list), _ :-
   RETURN get_objects (next, get_objects (statement_list, o));
   .
noswitch (...), _ :-
   RETURN o;
   .

/********* report a used object: ident or qualification */

PROCEDURE use_object (qualified_symbol)

ident (pos := pos1, env := env1, ident := ident, object := noobject (...)) :-
   put_cross_ref (no_of_args >= 0 \? PAF_REF_TO_MBR_FUNC \: PAF_REF_TO_MBR_VAR,
      PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      "?", GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := parameter (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_LOCAL_VAR, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_LOCAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      null, GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, ident := ident, object :=
   object (object := variable (env := e, pos := pos2))) :-
   e->Kind == kenv2 && Tree_IsType (e->env2.env1->env.object, ktype_decl);
   put_cross_ref (PAF_REF_TO_MBR_VAR, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      get_class_name (e), GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := variable (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_LOCAL_VAR, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_LOCAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      null, GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := labeled_stmt (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_CONSTANT, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_LOCAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      null, GetCStr (ident), null, current_file, (int) pos1.Line, PAF_REF_READ);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := function (env := env2, decl_list := decl_list))) :-
   to_types  (decl_list, ref_arg_types);
   put_cross_ref (PAF_REF_TO_MBR_FUNC, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      get_class_name (env2), GetCStr (ident), ref_arg_types, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := type_decl (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_CLASS, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      null, GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := ident (env := env2, pos := pos2))) ;
ident (pos := pos1, env := env1, ident := ident, object :=
   object (object := qualification (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_CLASS, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      null, GetCStr (ident), null, current_file, (int) pos1.Line, PAF_REF_READ);
   .
qualification (pos := pos1, env := env1, qualified_symbol :=
   qualified_symbol (object := object (object := type_decl (ident := i))),
   ident := ident, object := noobject (...)) :-
   put_cross_ref (no_of_args >= 0 \? PAF_REF_TO_MBR_FUNC \: PAF_REF_TO_MBR_VAR,
     PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      GetCStr (i), GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
qualification (pos := pos1, env := env1, qualified_symbol :=
   qualified_symbol (object := object (object :=
   decl (type := named_type (qualified_symbol := qualified_symbol)))),
   ident := ident, object := noobject (...)) :-
   to_types (qualified_symbol, ref_class);
   put_cross_ref (no_of_args >= 0 \? PAF_REF_TO_MBR_FUNC \: PAF_REF_TO_MBR_VAR,
     PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      ref_class, GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
qualification (pos := pos1, env := env1, qualified_symbol :=
   qualified_symbol, ident := ident, object := noobject (...)) :-
   to_types (qualified_symbol, ref_class);
   put_cross_ref (no_of_args >= 0 \? PAF_REF_TO_MBR_FUNC \: PAF_REF_TO_MBR_VAR,
   PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      ref_class, GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
qualification (pos := pos1, env := env1, qualified_symbol :=
   qualified_symbol, ident := ident, object :=
   object (object := variable (env := env2, pos := pos2))) :-
   put_cross_ref (PAF_REF_TO_MBR_VAR, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      get_class_name (env2), GetCStr (ident), null, current_file, (int) pos1.Line, acc);
   .
qualification (pos := pos1, env := env1, qualified_symbol :=
   qualified_symbol, ident := ident, object :=
   object (object := function (env := env2, decl_list := decl_list))) :-
   to_types (decl_list, ref_arg_types);
   put_cross_ref (PAF_REF_TO_MBR_FUNC, PAF_MBR_FUNC_DEF, PAF_REF_SCOPE_GLOBAL,
      cur_class_ptr, cur_method_ptr, cur_arg_types_ptr,
      get_class_name (env2), GetCStr (ident), ref_arg_types, current_file, (int) pos1.Line, acc);
   .

FUNCTION get_class_name (envs) tString

NIL :-
   RETURN null;
   .
env (object := type_decl (ident := ident)) :-
   RETURN GetCStr (ident);
   .
env (object := anonymous (...)) :-
   RETURN s_anonymous;
   .
env2 (env1 := env1) :-
   RETURN get_class_name (env1);
   .

FUNCTION get_class_name_2 ([type_decl, anonymous]) tString

type_decl (ident := ident) :-
   RETURN GetCStr (ident);
   .
anonymous (...) :-
   RETURN s_anonymous;
   .

FUNCTION get_current_class (envs) [type_decl, anonymous]

env (object := compilation_unit	(...)) :-
   RETURN NIL;
   .
env (object := o: type_decl	(...)) :-
   RETURN o;
   .
env (object := o: anonymous	(...)) :-
   RETURN o;
   .
env (object := function		(env := env)) ;
env (object := compound_stmt	(env := env)) ;
env (object := for_stmt		(env := env)) ;
env (object := catch		(env := env)) :-
   RETURN get_current_class (env);
   .
env2 (env1 := env1) :-
   RETURN get_current_class (env1);
   .
_ :-
   RETURN NIL;
   .

PROCEDURE Tsuperclass (field_list)

class (next := next, ident := ident, block := blk, extends := named_type (qualified_symbol := qs: qualified_symbol (object := obj))) :-
   cur_class_ptr := GetCStr (ident);
   Tclass (qs);
{
   if (obj != nnoobject && obj->object.object->Kind == kclass)
      blk::env->env2.env1->env.env = obj->object.object->type_decl.block->field_list.env->env2.env1;
};
   Tsuperclass (next);
   .
class (next := next) :-
   Tsuperclass (next);
   .
interface (next := next, ident := ident, block := block, extends := extends) :-
   cur_class_ptr := GetCStr (ident);
   Tclass (extends);
   Tsuperclass (next);
   .

PROCEDURE Traverse (Tree)

compilation_unit (package := package: qualified_symbol, import_list := import_list, field_list := field_list) :-
   cur_class_ptr := null; cur_method_ptr := null; cur_arg_types_ptr := null;
   /* Traverse (package); */
   /* Traverse (import_list); */
   Tsuperclass (field_list);
   cur_class_ptr := null; cur_method_ptr := null; cur_arg_types_ptr := null;
   Traverse (field_list);
   .
import (env := env, next := next: import_list, qualified_symbol := qualified_symbol) :-
   Tclass (qualified_symbol);
   Traverse (next);
   .
class (env := env, next := next: field_list, modifiers := modifiers, ident := ident, pos := pos, block := block, extends := extends, interfaces := interfaces) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   Tclass (interfaces);
   Traverse (block);
   cur_class_ptr := prev_class;
   Traverse (next);
   .
interface (env := env, next := next: field_list, modifiers := modifiers, ident := ident, pos := pos, block := block, extends := extends) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   Traverse (block);
   cur_class_ptr := prev_class;
   Traverse (next);
   .
method (env := env, next := next: field_list, modifiers := modifiers, ident := ident, pos := pos, decl_list := decl_list, type := type, throws := throws, block := block) :-
   cur_method_ptr := GetCStr (ident);