parser tree

{
	ParsTree - parser tree structure
	---------------------------------------------------------------
	This stucture can learn words ( sequence of any characters )
	together with a code. The codeformat may be choosen before
	compilation, see TYPE CodeTyp.
	If a word is already known, the LEARN returns false.
	At any time a word may be SEARCHed, if found it returns true
	and the returned code is valid.
	---------------------------------------------------------------
	PRPtr --> PRec:
		   Term:BOOLEAN;  true if terminal
		   Ch  :CHAR;	  character
		   Sub:PRPtr;      PRPtr --> PRec
		   Code:CodeTyp;  longint
		   Next:PRPtr;     PRPtr --> PRec
		   Alt:PRPtr;      PRPtr --> PRec
	---------------------------------------------------------------
	Important Note : The whole tree is to be hanged on a to be
	supplied pointer( type PRPtr ), which has to be initialized
	to NIL before use.
	---------------------------------------------------------------
	Changes:
	 6/mar/95 :added size function
	  PEntries: number of strings
	  PText: text bytes found in strings
	  PDelta: suppressed number of text bytes
	  PTotal: includes code, excludes PDelta
		  :added readentry function
	  not yet complete
	---------------------------------------------------------------
	TestProg is PTTEST.PAS
	Upper Unit is PARSERTREE.PAS
	---------------------------------------------------------------
	Created		:8.aug.93
	Last Update	:6/mar/95
	---------------------------------------------------------------
	Is updated version of : -
	---------------------------------------------------------------
}
UNIT ParsTree;

INTERFACE

TYPE
 CodeTyp =WORD;	{ can be BYTE WORD LONGINT }
 PPtr=^PRPtr;
 PRPtr=^PRec;
 PRec=RECORD	{ size is 8byte+CodeTyp }
  Term:BOOLEAN; { true if terminal, false if there is more }
  Ch :CHAR;	{ character }
  Sub:PRPtr;
  Code:CodeTyp;
  Next:PRPtr;
  Alt:PRPtr;
 END;

{ TRUE if successful - else known }
FUNCTION Learn(VAR K:PRPtr;S:STRING;Z:CodeTyp):BOOLEAN;

{ TRUE if successful }
FUNCTION Search(VAR K:PRPtr;S:STRING;VAR Z:CodeTyp):BOOLEAN;

PROCEDURE List(VAR K:PRPtr);
PROCEDURE Kill(VAR K:PRPtr);
PROCEDURE Size(VAR K:PRPtr;VAR PEntries,PText,PDelta,PTotal:LONGINT);
FUNCTION ReadEntry(VAR K:PRPtr;E:LONGINT;VAR S:STRING;VAR Z:CodeTyp):BOOLEAN;

IMPLEMENTATION

{ append rest of string at AT with code Z
 Note AT is a POINTER
}
PROCEDURE AppendH(s:STRING;From:BYTE;At:PPtr;Z:CodeTyp);
VAR T:PRPtr;
 V:PPtr;
 i:BYTE;
BEGIN
 V:=At;
 FOR i:=From TO Length(s) DO
  BEGIN
   T:=New(PRPtr);
   V^:=T;
   T^.Term:=FALSE;
   T^.Code:=0;
   T^.Ch:=s[i];
   T^.Sub:=NIL;
   T^.Next:=NIL;
   T^.Alt:=NIL;
   V:=@T^.next;
  END;
 T^.Code:=Z;
 T^.Term:=TRUE;
END;

FUNCTION FindI(S:STRING;pos:BYTE;p:PPtr;Z:CodeTyp):BOOLEAN;
{ p is truely a ptr to ptr }
VAR t:PRPtr;
    v,l:PPtr;
 found :BOOLEAN;
BEGIN
 IF (p^=NIL) THEN { branch empty - insert there }
  BEGIN
   AppendH(s,1,p,Z); { append at entry ptr }
   FindI:=TRUE;
  END
 ELSE  { there is a nextptr }
  BEGIN
   v:=p;l:=v;
   found:=FALSE;
   REPEAT
    IF (ord(v^^.ch)NIL) THEN
       BEGIN
	L:=V;V:=@V^^.Alt;
       END
      ELSE	{ no altptr - insert after }
       BEGIN
	AppendH(s,pos,@v^^.alt,Z);
	Found:=TRUE;
	FindI:=TRUE;
       END;
     END { pos not reached }
    ELSE
     BEGIN
      IF (ord(v^^.ch)=ord(s[pos])) THEN { pos found }
       BEGIN
	IF (posNIL) THEN
       BEGIN
	L:=V;V:=@V^^.Alt;
       END
      ELSE	{ no altptr - inser