tcl.puma

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

PROCEDURE use_proc_qual (qualification_c)

global_ident (pos := pos, ident := ident) :-
   obj: objects; obj := IdentifyProcGlobal (ident);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
global_ident (pos := pos, ident := ident) :-
   use_proc_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 := IdentifyProcLocal (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 := IdentifyProc (ident, e);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
local_ident (pos := pos, ident := ident) :-
   use_proc_undef (ident, pos);
   .
q: qualification_c (pos := pos) :-
   env: envs; env := get_env (q);
   env != NIL;
   ident: tIdent; ident := get_ident (q);
   obj: objects; obj := IdentifyProcLocal (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_proc_undef (ident, pos);
   .

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

PROCEDURE use_proc ([words, qualifications])

LOCAL { tTree obj; }

one_word (env := env, ident := ident, pos := pos) :-
   obj := IdentifyProc (ident, get_namespace (env));
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
one_word (env := env, ident := ident, pos := pos) :-
   obj := Identify (ident, get_namespace (env));
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   .
one_word (ident := ident, pos := pos) :-
   use_proc_undef (ident, pos);
   .
qual_word (qualification := qualification) :-
   use_proc_qual (qualification);
   .
qual_words (qualifications := qualifications) :-
   use_proc (qualifications);
   .
one_qualification (next := next: noqualification (...), qualification := qualification) :-
   use_proc_qual (qualification);
   .
one_qualification (next := next) :-
   use_proc (next);
   .

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

PROCEDURE use ([objects, stmts, words, qualification_c], p: tPosition, acc: int)

object (object := object, ident := ident), ... :-
   (cross_ref_fp);
   current_ident := GetCStr (ident);
   use (object, p, acc);
   .
one_word (pos := pos, env := env, ident := ident), ... ;
local_ident (pos := pos, env := env, ident := ident), ... ;
global_ident (pos := pos, env := env, ident := ident), ... ;
qualification_c (pos := pos, env := env), ... :-
   use_2 (env, p, acc);
   .
proc (env := env: env (object := namespace (...)), param_names := param_names,
      qualification := q: qualification_c (pos := pos), epos := epos), ... :-
   put_cross_ref (PAF_REF_TO_MBR_FUNC, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, cur_arg_types_ptr,
      current_namespace (env), current_ident, NIL, current_file, (int) p.Line,
      PAF_REF_READ);
   .
proc (env := env, qualification := q: qualification_c (pos := pos),
   param_names := param_names, epos := epos), ... :-
   put_cross_ref (PAF_REF_TO_FUNCTION, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, cur_arg_types_ptr,
      NIL, current_ident, NIL, current_file, (int) p.Line, PAF_REF_READ);
   .
namespace (env := env, qualification := qualification), ... :-
   put_cross_ref (PAF_REF_TO_CLASS, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, cur_arg_types_ptr,
      NIL, current_ident, NIL, current_file, (int) p.Line, PAF_REF_READ);
   .

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

PROCEDURE use_2 (env: env, pos: tPosition, acc: int)

env (object := proc (...)), ... :-
   (report_local_vars);
   put_cross_ref (PAF_REF_TO_LOCAL_VAR, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_LOCAL, cur_class_ptr, cur_proc_ptr, NIL, NIL,
      current_ident, NIL, current_file, (int) pos.Line, acc);
   .
env (object := program (...)), ... :-
   put_cross_ref (PAF_REF_TO_GLOB_VAR, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, NIL, NIL,
      current_ident, NIL, current_file, (int) pos.Line, acc);
   .
env (object := namespace (...)), ... :-
   put_cross_ref (PAF_REF_TO_MBR_VAR, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, NIL, current_namespace (env),
      current_ident, NIL, current_file, (int) pos.Line, acc);
   .

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

PROCEDURE use_undef (ident: tIdent, pos: tPosition)

... :-
   ident > last_keyword;
   c: char; c := * GetCStr (ident);
   'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z' || c == '_';
   put_cross_ref (PAF_REF_UNDEFINED, scope_type (cur_class_ptr),
      PAF_REF_SCOPE_GLOBAL, cur_class_ptr, cur_proc_ptr, NIL, NIL,
      GetCStr (ident), NIL, current_file, (int) pos.Line, PAF_REF_READ);
   .

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

PROCEDURE use_proc_undef (ident: tIdent, pos: tPosition)

... :-
   ! in_string;
   use_undef (ident, pos);
   .

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

PROCEDURE dcl ([objects, stmts, words, qualification_c])

object (object := object, ident := ident) :-
   ident != NoIdent;
   current_ident := GetCStr (ident);
/* c: char; c := * current_ident;
   'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z' || '0' <= c && c <= '9' || c == '_'; */
   * current_ident != '-';
   dcl (object);
   .
one_word (pos := pos, env := env, ident := ident) ;
local_ident (pos := pos, env := env, ident := ident) ;
global_ident (pos := pos, env := env, ident := ident) ;
qualification_c (pos := pos, env := env) :-
   dcl_2 (env, pos);
   .
proc (env := env: env (object := namespace (...)), param_names := param_names,
      qualification := q: qualification_c (pos := pos), epos := epos) :-
   to_names (param_names, args_buffer);
   current_class := current_namespace (env);
   get_begin_pos (q => bpos);
   put_symbol (PAF_MBR_FUNC_DEF, current_class, current_ident, current_file,
      (int) pos.Line, (int) pos.Column - 1, (int) epos.Line, (int) epos.Column,
      PAF_PUBLIC, NIL, NIL, args_buffer, NIL,
      (int) bpos.Line, (int) bpos.Column - 1,
      (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1));
   put_symbol (PAF_MBR_FUNC_DCL, current_class, current_ident, current_file,
      (int) pos.Line, (int) pos.Column - 1, (int) epos.Line, (int) epos.Column,
      PAF_PUBLIC, NIL, NIL, args_buffer, NIL,
      (int) bpos.Line, (int) bpos.Column - 1,
      (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1));
   .
proc (env := env, qualification := q: qualification_c (pos := pos),
      param_names := param_names, epos := epos) :-
   to_names (param_names, args_buffer);
   get_begin_pos (q => bpos);
   put_symbol (PAF_FUNC_DEF, NIL, current_ident, current_file,
      (int) pos.Line, (int) pos.Column - 1, (int) epos.Line, (int) epos.Column,
      PAF_PUBLIC, NIL, NIL, args_buffer, NIL,
      (int) bpos.Line, (int) bpos.Column - 1,
      (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1));
/* put_symbol (PAF_FUNC_DCL, NIL, current_ident, current_file,
      (int) pos.Line, (int) pos.Column - 1, (int) epos.Line, (int) epos.Column,
      PAF_PUBLIC, NIL, NIL, args_buffer, NIL,
      (int) bpos.Line, (int) bpos.Column - 1,
      (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1));
*/
   .
namespace (env := env, qualification := q: qualification_c (pos := pos),
      epos := epos) :-
   get_begin_pos (q => bpos);
   put_symbol (PAF_CLASS_DEF, current_namespace (env), current_ident, current_file,
      (int) pos.Line, (int) pos.Column - 1, (int) epos.Line, (int) epos.Column,
      PAF_PUBLIC, NIL, NIL, NIL, NIL,
      (int) bpos.Line, (int) bpos.Column - 1,
      (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1));
   .

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

PROCEDURE dcl_2 (env: env, pos: tPosition)

env (object := proc (...)), _ :-
   (report_local_vars);
   put_symbol (PAF_LOCAL_VAR_DEF, NIL, current_ident, current_file,
   (int) pos.Line, (int) pos.Column - 1,
   (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1),
   PAF_PUBLIC, NIL, NIL, NIL, NIL, 0, 0, 0, 0);
   .
env (object := program (...)), _ :-
   put_symbol (PAF_GLOB_VAR_DEF, NIL, current_ident, current_file,
   (int) pos.Line, (int) pos.Column - 1,
   (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1),
   PAF_PUBLIC, NIL, NIL, NIL, NIL, 0, 0, 0, 0);
   .
env (object := namespace (...)), _ :-
   put_symbol (PAF_MBR_VAR_DEF, current_namespace (env), current_ident,
   current_file, (int) pos.Line, (int) pos.Column - 1,
   (int) pos.Line, (int) (pos.Column + strlen (current_ident) - 1),
   PAF_PUBLIC, NIL, NIL, NIL, NIL, 0, 0, 0, 0);
   .

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

FUNCTION current_namespace ([envs, qualification_c]) tString

env (object := program (...)) :-
   RETURN NIL;
   .
env (object := namespace (qualification := q)) :-
   RETURN GetCStr (get_ident (q));
   .
env (env := env) :-
   RETURN current_namespace (env);
   .

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

FUNCTION get_class (qualification_c) tString

qualification (qualification := qualification, ident := ident) :-
   RETURN get_class_name (qualification);
   .
complex_qual (qualification := qualification, texts := texts) :-
   RETURN get_class_name (qualification);
   .
_ :-
   RETURN NIL;
   .

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

FUNCTION get_class_name (qualification_c) tString

local_ident (pos := pos, env := env, ident := ident) ;
global_ident (pos := pos, env := env, ident := ident) ;
qualification (qualification := qualification, ident := ident) :-
   RETURN GetCStr (ident);
   .
_ :-
   RETURN NIL;
   .

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

PROCEDURE to_names (words, tString)

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

PROCEDURE get_names (words)

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

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

PROCEDURE get_separator (words)

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

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

PROCEDURE relocate (Tree, new_env: env)

stmt (env := env, next := next: stmts, words := words), _ :-
   env := new_env;
   relocate (words, new_env);
   relocate (next, new_env);
   .
proc (env := env, next := next: stmts, qualification := qualification:
   qualification_c, param_names := param_names: words, parameter := parameter:
   words, block := block: texts (env := env (env := e)), epos := epos), _ :-
   env := new_env;
   e := new_env;
   relocate (qualification, new_env);
   relocate (next, new_env);
   .
namespace (env := env, next := next: stmts, qualification := qualification,
   block := block: texts (env := env (env := e)), epos := epos), _ :-
   env := new_env;
   e := new_env;
   relocate (qualification, new_env);
   relocate (next, new_env);
   .
one_word (env := env, next := next: words, ident := ident, pos := pos), _ :-
   env := new_env;
   relocate (next, new_env);
   .
qual_word (env := env, next := next: words, qualification := qualification: qualification_c), _ :-
   env := new_env;
   relocate (qualification, new_env);
   relocate (next, new_env);
   .
qual_words (env := env, next := next: words, qualifications := qualifications), _ :-
   env := new_env;
   relocate (qualifications, new_env);
   relocate (next, new_env);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c), _ :-
   env := new_env;
   relocate (qualification, new_env);
   relocate (next, new_env);
   .
character (env := env, next := next: texts, pos := pos, text := text), _ :-
   env := new_env;
   relocate (next, new_env);
   .
ident (env := env, next := next: texts, pos := pos, ident := ident), _ :-
   env := new_env;
   relocate (next, new_env);
   .
block (env := env, next := next: texts, pos := pos, epos := epos, stmts := stmts), _ :-
   env := new_env;
   relocate (stmts, new_env);
   relocate (next, new_env);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c), _ :-
   env := new_env;
   relocate (qualification, new_env);
   relocate (next, new_env);
   .
block_content (env := env, next := next: texts, pos := pos, epos := epos, stmts := stmts), _ :-
   env := new_env;
   relocate (stmts, new_env);
   relocate (next, new_env);
   .
local_ident (pos := pos, env := env, ident := ident), _ :-
   env := new_env;
   .
global_ident (pos := pos, env := env, ident := ident), _ :-
   env := new_env;
   .
local_text (pos := pos, env := env, texts := texts), _ :-
   env := new_env;
   relocate (texts, new_env);
   .
global_text (pos := pos, env := env, texts := texts), _ :-
   env := new_env;
   relocate (texts, new_env);
   .
qualification (pos := pos, env := env, qualification := qualification: qualification_c, ident := ident), _ :-
   env := new_env;
   relocate (qualification, new_env);
   .
complex_qual (pos := pos, env := env, qualification := qualification: qualification_c, texts := texts), _ :-
   env := new_env;
   relocate (qualification, new_env);
   relocate (texts, new_env);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c), _ :-
   env := new_env;
   relocate (qualification, new_env);
   relocate (index, new_env);
   .

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