tcl.puma

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

   .
proc (env := env, next := next, qualification := qualification, parameter := parameter, block := block) :-
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (qualification));
   pass3 (qualification);
   /* pass3 (parameter); */
   pass3 (block);
   cur_proc_ptr := prev_proc;
   pass3 (next);
   .
namespace (env := env, next := next, qualification := qualification, block := block) :-
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (qualification));
   pass3 (qualification);
   pass3 (block);
   cur_class_ptr := prev_class;
   pass3 (next);
   .
one_word (env := env, next := next: words, ident := ident) :-
   pass3 (next);
   .
qual_word (env := env, next := next: words, qualification := qualification) :-
   pass3 (qualification);
   pass3 (next);
   .
qual_words (env := env, next := next: words, qualifications := qualifications) :-
   pass3 (qualifications);
   pass3 (next);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c) :-
   pass3 (qualification);
   pass3 (next);
   .
character (env := env, next := next: texts, pos := pos, text := text) :-
   pass3 (next);
   .
ident (env := env, next := next: texts, pos := pos, ident := ident) :-
   pass3 (next);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c) :-
   use_qual (qualification);
   pass3 (qualification);
   pass3 (next);
   .
block (env := env, next := next, pos := pos, stmts := stmts, type := type) :-
   prev_in_string: rbool; prev_in_string := in_string;
   in_string := type == '"';
   pass3 (stmts);
   in_string := prev_in_string;
   pass3 (next);
   .
block_content (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   pass3 (stmts);
   pass3 (next);
   .
qualification (pos := pos, qualification := qualification: qualification_c, ident := ident) :-
   pass3 (qualification);
   .
local_text (pos := pos, env := env, texts := texts) :-
   pass3 (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   pass3 (texts);
   .
complex_qual (pos := pos, env := env, qualification := qualification, texts := texts) :-
   pass3 (qualification);
   pass3 (texts);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c) :-
   pass3 (qualification);
   pass3 (index);
   .

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

FUNCTION make_one_word ([texts, qualification_c]) tIdent

ident (next := notext (...), ident := ident) :-
   RETURN ident;
   .
t :-
   length := 0;
   make_one_word_2 (t);
   RETURN MakeIdent (buffer, length);
   .

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

PROCEDURE make_one_word_2 ([texts, qualification_c])

character (next := next, text := text) :-
   buffer [length ++] := text;
   make_one_word_2 (next);
   .
ident (next := next, ident := ident) :-
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   make_one_word_2 (next);
   .
content (next := next, qualification := qualification) :-
   buffer [length ++] := '$';
   make_one_word_2 (qualification);
   make_one_word_2 (next);
   .
local_ident (pos := pos, env := env, ident := ident) :-
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
global_ident (pos := pos, env := env, ident := ident) :-
   strcpy (& buffer [length], "::"); length := length + 2;
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
local_text (pos := pos, env := env, texts := texts) :-
   make_one_word_2 (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   strcpy (& buffer [length], "::"); length := length + 2;
   make_one_word_2 (texts);
   .
qualification (pos := pos, qualification := qualification, ident := ident) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "::"); length := length + 2;
   GetString (ident, & buffer [length]);
   length := length + StLength (GetStringRef (ident));
   .
complex_qual (pos := pos, qualification := qualification, texts := texts) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "::"); length := length + 2;
   make_one_word_2 (texts);
   .
subscription (pos := pos, qualification := qualification, index := index) :-
   make_one_word_2 (qualification);
   strcpy (& buffer [length], "("); length := length + 1;
   make_one_word_2 (index);
   strcpy (& buffer [length], ")"); length := length + 1;
   .
block (next := notext (...), stmts := nostmt (...)) :-
   .
notext (...) :-
   .
_ :-
   buffer [length ++] := '?';
   .

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

FUNCTION Mword (words, [word_c, qualification_c, qualifications]) words

w, local_ident (pos := pos, ident := ident) :-
   RETURN one_word (_, w, ident, pos);
   .
w, t: qualification_c (...) :-
   RETURN qual_word (_, w, t);
   .
w, t: one_qualification (...) :-
   RETURN qual_words (_, w, t);
   .
w, t: one_word (next := next) :-
   next := w;
   RETURN t;
   .

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

FUNCTION Mqualification ([word_c, qualification_c, qualifications]) qualifications

one_word (ident := ident, pos := pos) :-
   RETURN one_qualification (next := noqualification (_), qualification :=
      local_ident (pos := pos, ident := ident));
   .
q: qualification_c (...) :-
   RETURN one_qualification (next := noqualification (_), qualification := q);
   .
q: qualifications (...) :-
   RETURN q;
   .

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

FUNCTION Mstmt (stmts, words) stmts

s, w1: one_word (ident := ident, next := w2) :-
   ident == iproc || ident == inamespace;
   stmt: stmts; stmt := Mstmt_2 (s, ident, w2);
   stmt != NIL;
   RETURN stmt;
   .
s, w :-
   RETURN stmt (_, s, w);
   .

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

FUNCTION Mstmt_2 (stmts, tIdent, words) stmts

s, (iproc),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4:>qual_word (qualification := local_text (texts := b: block (epos := epos))))) :-
   p: proc;
   p := proc (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, b, epos, PAF_PUBLIC);
   w4 := noword (_);
   RETURN p;
   .
s, (iproc),
   w2: word_c	(next :=
   w3: word_c	(next :=
   w4: word_c	(...))) :-
   get_end_pos (w4 => epos);
   RETURN proc (_, s, make_qualification (w2),
      ReverseTree (param_names (w3)), w3, notext (_), epos, PAF_PUBLIC);
   .
s, (inamespace),
   w2: one_word (ident := (ieval), next :=
   w3: word_c	(next :=
   w4: qual_word (qualification := local_text (texts := b: block (epos := epos))))) :-
   RETURN namespace (_, s, make_qualification (w3), b, epos, PAF_PUBLIC);
   .
s, (inamespace),
   w2: one_word (ident := (ieval), next :=
   w3: word_c	(next :=
   w4: word_c	(...))) :-
   get_end_pos (w4 => epos);
   RETURN namespace (_, s, make_qualification (w3), notext (_), epos, PAF_PUBLIC);
   .
... :-
   RETURN NIL;
   .

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

FUNCTION Mblock_content (tPosition, tPosition, stmts) text

b, e, stmt (next := nostmt (...), words :=
      one_word (next := noword (...), ident := ident, pos := pos)) :-
   RETURN content (_, NoTree, b, local_ident (pos := pos, ident := ident));
   .
b, e, stmt (next := nostmt (...), words :=
      qual_word (next := noword (...), qualification := q: qualification_c (...))) :-
   RETURN content (_, NoTree, b, q);
   .
b, e, s :-
   RETURN block_content (_, NoTree, b, e, s);
   .

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

FUNCTION make_qualification ([word_c, qualifications]) qualification_c

one_word (ident := ident, pos := pos) :-
   RETURN local_ident (pos := pos, ident := ident);
   .
qual_word (qualification := qualification) :-
   RETURN qualification;
   .
qual_words (qualifications := qualifications) :-
   RETURN make_qualification (qualifications);
   .
one_qualification (next := next: noqualification (...), qualification := qualification) :-
   RETURN make_qualification (qual_word (qualification := qualification));
   .
one_qualification (next := next) :-
   RETURN make_qualification (next);
   .

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

FUNCTION param_names (word_c) words

one_word (env := env, next := next: words, ident := ident, pos := pos) :-
   RETURN one_word (next := noword (_), ident := ident, pos := pos);
   .
qual_word (qualification := local_text (texts := block (stmts := stmts))) :-
   RETURN param_names_2 (stmts, noword (_));
   .
qual_word (qualification := q: qualification_c (pos := pos)) :-
   RETURN one_word (pos := pos, ident := make_one_word (q), next := noword (_));
   .
qual_words (...) :-				/* crazy: ignore it */
   RETURN noword (_);
   .

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

FUNCTION param_names_2 (stmts, words) words

stmt (env := env, next := next: stmts, words := words), w :-
   RETURN param_names_2 (next, param_names_3 (words, w));
   .
_, w :-
   RETURN w;
   .

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

FUNCTION param_names_3 (words, words) words

one_word (env := env, next := next: words, ident := ident, pos := pos), w :-
   RETURN param_names_3 (next, one_word (next := w, ident := ident, pos := pos));
   .
qual_word (next := next, qualification := local_text (texts := block (stmts :=
      stmt (env := env, words := words)))), w :-
   RETURN param_names_3 (next, param_names_4 (words, w));
   .
qual_word (next := next, qualification := q: qualification_c (pos := pos)), w :-
   RETURN param_names_3 (next, one_word (pos := pos, ident := make_one_word (q), next := w));
   .
_, w :-
   RETURN w;
   .

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

FUNCTION param_names_4 (words, words) words

one_word (env := env, next := next: words, ident := ident, pos := pos), w :-
   RETURN one_word (next := w, ident := ident, pos := pos);
   .
qual_word (qualification := q: qualification_c (pos := pos)), w :-
   RETURN one_word (pos := pos, ident := make_one_word (q), next := w);
   .
_, w :-
   RETURN w;
   .

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

PROCEDURE get_end_pos ([words, texts, qualification_c, qualifications] => tPosition)

one_word (ident := ident, pos := pos) => e :-
   e: tPosition; e := pos;
   e.Column := e.Column + StLength (GetStringRef (ident)) - 1;
   .
qual_word (qualification := qualification) => e :-
   get_end_pos (qualification => e);
   .
qual_words (qualifications := qualifications) => e :-
   get_end_pos (qualifications => e);
   .
one_qualification (next := next: qualifications, qualification := qualification: qualification_c) => e :-
   get_end_pos (qualification => e);
   .
text (next := next: text (...)) => e :-
   get_end_pos (next => e);
   .
character (pos := pos) => e :-
   e: tPosition; e := pos;
   .
ident (pos := pos, ident := ident) => e :-
   e: tPosition; e := pos;
   e.Column := e.Column + StLength (GetStringRef (ident)) - 1;
   .
block (epos := epos) => e :-
   e: tPosition; e := epos;
   .
content (qualification := qualification) => e :-
   get_end_pos (qualification => e);
   .
block_content (epos := epos) => e :-
   e: tPosition; e := epos;
   .
local_ident (pos := pos, ident := ident) => e :-
   e: tPosition; e := pos;
   e.Column := e.Column + StLength (GetStringRef (ident)) - 1;
   .
global_ident (pos := pos, ident := ident) => e :-
   e: tPosition; e := pos;
   e.Column := e.Column + StLength (GetStringRef (ident)) - 1;
   .
local_text (pos := pos, texts := texts) => e :-
   get_end_pos (texts => e);
   .
global_text (pos := pos, texts := texts) => e :-
   get_end_pos (texts => e);
   .
qualification (pos := pos, ident := ident) => e :-
   e: tPosition; e := pos;
   e.Column := e.Column + StLength (GetStringRef (ident)) - 1;
   .
complex_qual (texts := texts) => e :-
   get_end_pos (texts => e);
   .
subscription (qualification := qualification) => e :-
   get_end_pos (qualification => e);
   .

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

PROCEDURE get_begin_pos (qualification_c => tPosition)

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