Artifact c565938fe4a730492c73c76bb89274ae7ce7aaebabdf26b5ea78e7945952d34c:

• File psl-1983/3-1/util/inspect.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4662) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/inspect.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4662) [annotate] [blame] [check-ins using]

% INSPECT.RED - Scan files for defined functions
% 
% Author:      Martin Griss
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        31 May 1982
% Copyright (c) 1982 University of Utah
%
% adapted from CREF and BUILD

Imports '(Gsort Dir!-Stuff);

FLUID '(!*UserMode            % To control USER Redef message
        !*ECHO
        !*RedefMsg            % To suppress REDEF messages
         CurrentFile!*        % To keep tack of this file
         FileList!*           % Files seen so far
         ProcedureList!*      % procedures seen so far
         ProcFileList!*       % (PROC . FILE) so far
         !*PrintInspect       % Print each proc
         !*QuietInspect       % Suppress INSPECTOUT messages
);

!*PrintInspect:=T;
!*QuietInspect:=NIL;

Procedure Inspect X;
begin scalar !*UserMode,!*Redefmsg,!*QuietInspect;
    !*QuietInspect:=T;
    INSPECTOut();
    !*ECHO:=NIL;
    If Not FunboundP 'Begin1 then EvIn list X
     else EVAL LIST('Dskin, x);
    INSPECTEnd();
end;

Procedure InspectOut; % Scan Files for Definitions
 Begin
    !*DEFN:=T; !*ECHO:=NIL; SEMIC!*:= '!$ ;
    DFPRINT!* := 'InspectPrint;
    ProcedureList!*:=FileList!* :=ProcFileList!*:=NIL;
    CurrentFile!* := NIL;
    if not !*QuietInspect then
    <<  if not FUnBoundP 'Begin1 then
	<<  Prin2T "INSPECTOUT: IN files; or type in expressions";
	    Prin2T "When all done execute INSPECTEND;" >>
	else
	<<  Prin2T "INSPECTOUT: (DSKIN files) or type in expressions";
	    Prin2T "When all done execute (INSPECTEND)" >> >>;
 End;

Procedure InspectEnd;
 Begin
    If !*PrintInspect then PrintF "%n%% --- Done with INSPECTION ---%n";
    Dfprint!*:=NIL;
    !*Defn:=NIL;
    ProcedureList!* := IdSort ProcedureList!*;
    If !*PrintInspect then <<Prin2T "% --- PROCS: --- "; 
                             Print ProcedureList!*>>;
 End;

Procedure InspectPrint U;
 BEGIN scalar x;
   !*ECHO:=NIL;
   SEMIC!*:='!$;
   x:=IF PairP CLOC!* THEN CAR CLOC!* ELSE "*TTYInput*";
   If x NEQ CurrentFile!* and !*PrintInspect then
     PrintF("%n%% --- Inspecting File : %r --- %n",x);
   CurrentFile!* := x;
   % Find current FILE name, see if new
  IF Not MEMBER(CurrentFile!*,FileList!*) THEN
   FileList!*:=CurrentFile!* . FileList!*;
  InspectForm U;
 END;

FLAG('(INSPECTEND),'IGNORE);
PUT('InspectEnd,'RlispPrefix,'(NIL LAMBDA(X) (ESTAT 'Inspectend)));

procedure InspectForm U;		%. Called by TOP-loop, DFPRINT!*
begin scalar Nam, Ty, Fn;
	if not PairP  U then return NIL;
	Fn := car U;
	IF FN = 'PUTD THEN GOTO DB2;
	IF NOT (FN MEMQ '(DE DF DM DN)) THEN GOTO DB1;
	NAM:=CADR U;
	U:='LAMBDA . CDDR U;
	TY:=CDR ASSOC(FN, '((DE . EXPR)
			    (DF . FEXPR)
			    (DM . MACRO)
			    (DN . NEXPR)));
DB3:	if Ty = 'MACRO then 
         begin scalar !*Comp;
          PutD(Nam, Ty, U);		% Macros get defined now
    	 end;
	if FlagP(Nam, 'Lose) then <<
	ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
			Nam);
	return NIL >>;
        InspectProc(Nam,Ty);
	RETURN NIL;
DB1:	% Simple S-EXPRESSION look for LAP etc.
        IF EQCAR(U,'LAP) Then Return InspectLap U;
        IF EQCAR(U,'Imports) 
	  then Return PrintF("%% --- Imports: %w in %w%n",Cadr U, CurrentFile!*);
	% Maybe indicate IMPORTS etc.
        RETURN NIL;
DB2:	% analyse PUTD
	NAM:=CADR U;
	TY:=CADDR U;
	FN:=CADDDR U;
	IF EQCAR(NAM,'QUOTE) THEN <<  NAM:=CADR NAM;
	IF EQCAR(TY,'QUOTE) THEN << TY:=CADR TY;
	IF PAIRP FN AND CAR FN MEMBER '(FUNCTION QUOTE) THEN <<  FN:=CADR FN;
	IF TY MEMQ '(EXPR FEXPR MACRO NEXPR) THEN
	<<  U:=FN; GOTO DB3 >> >> >> >>;
	GOTO DB1;
   END;

Procedure InspectProc(Nam,Ty);
<<If !*PrintInspect then <<Prin1 NAM; Prin2 " ">>;
  ProcedureList!*:=NAM . ProcedureList!*;
  ProcFileList!*:=(NAM . CurrentFile!*) . ProcFileList!*>>;

Procedure InspectLap U;
  For each x in U do if EQcar(x,'!*ENTRY) then InspectProc(Cadr U,Caddr U);

% -- Handle LISTs of files and dirs ---

Fluid '(!*PrintInspect !*QuietInspect);

Nexpr procedure GetFileList L;
 GetFiles1 L;

Procedure GetFiles1 L;
 If null L then Nil
  else append(Vector2List GetCleandir Car L, GetFiles1 Cdr L);

procedure InspectToFile F;
 Begin scalar f1,c;
     f1:=Bldmsg("%s-%s.ins",GetFileName(f),GetExtension(f));
     Printf(" Inspecting %r to %r%n",F,F1);
     c:=open(f1,'output);
     WRS c;
     !*PrintInspect:=NIL;
     Inspect F$
     Prin2 "(ProcList '"$
     Print ProcedureList!*;
     Prin2T ")";
     WRS NIL;
     close c;
 End;

procedure InspectAllFiles Files;
For each x in files do
 <<PrintF("Doing file: %w%n",x);
   InspectToFile x>>;

Procedure InspectAllPU();
 InspectAllFiles getFileList("pu:*.red","PU:*.sl");


END;