! Dictionary package

!Dictionaries are organised as binary trees with parent pointers.
!Balancing is for further study.  Dictionary descriptors contain
!a pointer to the root of the tree, plus a pointer to an alternative
!dictionary, to be searched if the sought entry is not found in the
!current dictionary's tree.  Dictionary cells are normally allocated
!economically, i.e. they do not allow space for a 255 character string
!at the end, but only enough.

%recordformatspec dict cell fm
%recordformat dict fm -
  (%record(dict fm)%name alt,%record(dict cell fm)%name tree)
%recordformat dict cell fm -
  (%record(dict cell fm)%name parent,left,right,
   %integer token,%string(255)s)

%integerfn make entry(%string(255)s,%record(dict fm)%name d)
! Make an entry for name S in dictionary D and return the
! address of the token field for that entry.
%record(dict cell fm)%name c,n,p==nil
  toupper(s)
  n == record(heapget(sizeof(n)-255+length(s)))
  n_parent == nil; n_left == nil; n_right == nil; n_token = 0; n_s = s
  %if d_tree==nil %start
    d_tree == n; %result = addr(n_token)
  %finish
  c == d_tree
  %cycle
    %signal 5,,,"Dictionary corrupt" %unless c_parent==p
    p == c
    %if s<=c_s %start
      %if s=c_s %start
        dispose(n); %result = addr(c_token)
      %finish
      %if c_left==nil %start
        c_left == n; n_parent == c; %result = addr(n_token)
      %finish
      c == c_left
    %elseif c_right==nil
      c_right == n; n_parent == c; %result = addr(n_token)
    %finishelse c == c_right
  %repeat
%end

%integerfn find entry(%string(255)s,%record(dict fm)%name d)
! Find the entry for name S in dictionary D, returning the
! address of its token field (or 0 if not found).
! Looks down ALT tree
%record(dict cell fm)%name c
  toupper(s)
  %cycle
    %result = 0 %if d==nil
    c == d_tree
    %cycle
      %exit %if c==nil
      %result = addr(c_token) %if s=c_s
      %if s<c_s %then c == c_left %else c == c_right
    %repeat
    d == d_alt
  %repeat
%end

%routine delete entry(%integer token,%record(dict fm)%name dict)
%record(dict cell fm)%name c,p,q
%integer offset
  %returnif token=0 %or dict==nil
  offset = addr(c_token)-addr(c)
  c == record(token-offset)
  q == c
  %cycle                    {verify DICT contains C}
    p == q_parent
    %if p==nil %start       {no parent: must be root}
      %exitif dict_tree==q  {OK}
      %return               {not OK}
    %finish
    %returnunless p_left==q %or p_right==q {parenthood acknowledged?}
    q == p
  %repeat
  %if c_left==nil %start       {set Q to be C's replacement}
    q == c_right
  %elseif c_right==nil
    q == c_left
  %else
    q == c_left
    %if q_right==nil %start     {transfer R son to L son's R son}
      q_right == c_right; c_right_parent == q
    %else                   {find biggest in L subtree}
      q == q_right %until q_right==nil
      q_right == c_right; c_right_parent == q
      q_left == c_left; c_left_parent == q
    %finish
  %finish
  p == c_parent                  {original parent}
  q_parent == p %unless q==nil
  %if p==nil %start
    dict_tree == q
  %elseif c==p_left
    p_left == q
  %else
    p_right == q
  %finish
%end

%string(255)%fn translate entry(%integer x)
! Return the name for which an entry was made in some
! dictionary, for which X is the address of the token field.
  %result = string(x+4)
%end

%integerfn first entry(%record(dict fm)%name d)
! Result is address of token field of (alphabetically)
! first entry in D, zero if empty.
%record(dict cell fm)%name c
  c == d_tree; %result = 0 %if c==nil
  c == c_left %while c_left##nil
  %result = addr(c_token)
%end

%integerfn next entry(%integer x)
! Result is address of token field of (alphabetically) next entry
! in the dictionary, assuming X is the result of either a previous
! call to NEXT ENTRY or of a call to FIRST ENTRY.  Zero at end.
%record(dict cell fm)%name c,p
  c == record(x)
  c == record(addr(c)-addr(c_token)+x)
  %if c_right##nil %start
    c == c_right; c == c_left %while c_left##nil
    %result = addr(c_token)
  %finish
  %cycle
    p == c_parent; %result = 0 %if p==nil
    %result = addr(p_token) %if c==p_left
    %signal 5,,,"Dictionary corrupt" %unless c==p_right
    c == p
  %repeat
%end