File psl-1983/3-1/util/pcheck.red artifact 9d7eef5695 part of check-in d9e362f11e

%  <PSL.UTIL>PCHECK.RED.3, 11-Oct-82 18:14:36, Edit by BENSON
%  Changed CATCH to *CATCH

% A little program to check parens in a LISP file

Fluid '(LastSexpr!*);
procedure Pcheck F;
 begin scalar Chan,OldChan;
    LastSexpr!*:=NIL;
    Chan:=Open(F,'Input);
    OldChan:=RDS(Chan);
    !*Catch(NIL,Pcheck1());
    Rds(OldChan);
    Close chan;
%   Printf("last Full S-expression%r%n",LastSexpr!*);
 end;

%/ can we enable Line counter somehow?

procedure Pcheck1();
 Begin Scalar x;
  L:   x:=Read();
       if x eq !$EOF!$ then return NIL;
       LastSexpr!*:=x;
       PrintSome x;
       Goto L;
 End;

procedure printsome x;
 <<Prinsomelevel(x,2,3);terpri()>>;

procedure prinsomelevel(x,l1,l2);
If not pairp x then <<prin1 x; prin2 " ">>
 else if l1 <=0 then prin2 " ... "
 else if l2 <=0 then prin2 " ... "
 else <<prin2 "("; prinsomelevel(car x,l1-1,l2);
        if null cdr x then prin2 ")"
         else if ListP cdr x then <<prinsomelevel(cdr x,l1,l2-1); prin2 ")">>
         else <<prin2 " . "; prinsomelevel(cdr x,l1,l2-1); prin2 ")">>
      >>;

procedure ListP x;
 null x or (Pairp x and ListP cdr x);

end;