{	MODULE FOR LIST AND TREE OPERATIONS ARGUMENTS }
{	RANDALL VENHOLA JULY 8, 1987                  }
                                                       

[INHERIT('SCREENHANDLERS','UTILITYOPS'), environment('argops')]

MODULE ARGOPS;

CONST

   maxchars = 31;              {# of chars in arg literal }
   maxargsinarray = 30;      {for conversion to an array of args}
   indexofunknowntexcommand = 0;

TYPE

   pckstr = VARYING [ maxchars ] of char;

   comparisons = (notvalid, lessthan, equal, greaterthan);

   setofcomparisons = set of comparisons;

   argtype = ( dsrverb, int, signedint, stylespecifier,
	    textpckstr, character, quotedpckstr, nulltype);

   setofargtype = set of argtype;

           argument =  record 
	                 source            : pckstr;                       
	                 isgeneralization : boolean;
 	                 texindex         : integer;
                         class             : setofargtype
	               end;        

   argarray = array[1..maxargsinarray] of argument;

                            
            

[GLOBAL] FUNCTION argliteral( arg : argument; smooth : boolean ) : pckstr;

var 
  s : pckstr;         
  i,j, firstchar, lastchar : integer;
  ch : char;

 procedure findfirstchar( s : pckstr; var firstchar : integer);
 begin
    firstchar := 1;
    while (firstchar < s.length) and (s.body[firstchar] <= blank) do
      firstchar := firstchar + 1
 end;  

 procedure findlastchar( s : pckstr; var lastchar : integer );
 begin
   lastchar := s.length;
   while (lastchar > 1) and (s.body[lastchar] <= blank) do
      lastchar := lastchar - 1
 end;
                                                           
begin       
   if smooth then
   begin
     findfirstchar( arg.source, firstchar);
     findlastchar( arg.source, lastchar);
     j := 0;        
     for i := firstchar to lastchar do
     begin  
       ch := arg.source.body[i];
       if ch < blank then ch := blank;
       if ch in ['a'..'z'] then ch := chr(ord(ch) - ord(blank));
       j := j + 1;
       s.body[j] := ch
     end;                                                       
     if (j = 1) and (s.body[1] = blank) then
       s.length := 0
     else
       s.length := j             
   end
   else
     s := arg.source;    
   argliteral := s
end;
          

    


[GLOBAL] FUNCTION pckstrisgeneralization( s : pckstr ) : boolean;
  label
    routineexit;
  var
    flag : boolean;
  begin
     flag := false;
     if s = '[N]' then
     begin
       flag := true;
       goto routineexit
     end;
     if s = '[C]' then
     begin
       flag := true;
       goto routineexit
     end;
     if s = '[Y]' then
     begin
       flag := true;
       goto routineexit
     end;
     if s = '[T]' then
     begin
       flag := true;
       goto routineexit
     end;
     if s = '[Q]' then
     begin
       flag := true;
       goto routineexit                                      
     end;      
     routineexit : pckstrisgeneralization := flag
end;            


    
     
[GLOBAL] FUNCTION argisgeneralization( arg : argument ) : boolean;
begin
   argisgeneralization := arg.isgeneralization
end;
   
          


[GLOBAL] FUNCTION textualmatch( arg1, arg2 : argument) : boolean;                                           
begin
   textualmatch := false;
   if (arg1.source = '[T]') and (textpckstr in arg2.class) then
	textualmatch := true
   else
      if (arg2.source = '[T]') and (textpckstr in arg1.class) then
	textualmatch := true
end;



        
[GLOBAL] FUNCTION compareargs( leftarg, rightarg : argument ) : comparisons;
label
  routineexit;
var
  lefts, rights : pckstr;
  equalpckstrs : boolean;
  comp : comparisons;       

  procedure greaterorlessthancompare;
  begin
     if lefts < rights then
       comp := lessthan
     else              
      comp := greaterthan
  end;
                                                
  procedure checktexindex;
  begin
     if (leftarg.texindex  = indexofunknowntexcommand) or
        (rightarg.texindex = indexofunknowntexcommand) then
         comp := equal
     else
	if leftarg.texindex = rightarg.texindex then
	  comp := equal
	else
           greaterorlessthancompare
  end;

begin                        
   if textualmatch( leftarg, rightarg) then
   begin
     comp := equal;
     goto routineexit
   end;
   if (leftarg.class = [nulltype]) or (rightarg.class = [nulltype]) then
   begin
      comp := equal;
      goto routineexit
   end;
   lefts := argliteral(leftarg, TRUE);
   rights := argliteral(rightarg, TRUE);
   equalpckstrs := (lefts = rights);
   comp := notvalid;
   if leftarg.class * rightarg.class <> [] then
   begin                              
     if equalpckstrs then                            
        comp := equal
     else  
        if (leftarg.isgeneralization) or (rightarg.isgeneralization) then
          checktexindex
        else
          greaterorlessthancompare
   end
   else
     greaterorlessthancompare;
   routineexit : compareargs := comp
end;      




[GLOBAL] FUNCTION argtexindex( arg : argument ) : integer;    
begin
   argtexindex := arg.texindex
end;
                                                              
          


[GLOBAL] FUNCTION argclass( arg : argument ) : setofargtype;
begin
   argclass := arg.class
end;




[GLOBAL] PROCEDURE initarg( var arg : argument; classification : setofargtype;
                   lit : pckstr; index : integer; general : boolean );
begin
   arg.source            := lit;
   arg.class             := classification;
   arg.texindex         := index;
   arg.isgeneralization := general
end;


                         

[GLOBAL] PROCEDURE reassignargclass( var arg : argument; newclass : setofargtype);
begin
   arg.class := newclass
end;                                            
    



[GLOBAL] PROCEDURE reassignargtexindex( var arg : argument; newindex:integer);
begin
  arg.texindex := newindex
end;

                                   

[GLOBAL] PROCEDURE reassignarggeneralization( var arg : argument;general:boolean);
begin
   arg.isgeneralization := general
end;




[GLOBAL] PROCEDURE appendchartoarg( ch : char; var arg : argument );
begin
  if arg.source.length = maxchars then                              
      warningmessage('appendchartoarg','argument too long')   
  else
  begin
    arg.source.length := arg.source.length + 1;
    arg.source.body[arg.source.length] := ch
  end
end;




[GLOBAL] PROCEDURE extractintegerfromargument( arg : argument; var successful : boolean;
	                               var int : integer;
	                               var signed : boolean );
var                                    
  s  : pckstr;
begin
   s := argliteral( arg, TRUE);
   readv( s, int, error := continue );
   if statusv <> 0 then
     successful := false
   else
   begin
      successful := true;
      signed := (s.body[1] = '+') or (s.body[1] = '-')
   end
end;



END.