COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00011 00003	
C00016 00004	
C00018 00005	
C00031 00006	EXPR SIM1X(L)
C00040 00007		IF LENGTH ANT ≠ LENGTH THANT THEN RETURN'WRONG? NUMBER? OF? ANTECEDENTS
C00044 00008	
C00052 ENDMK
C⊗;
BEGIN
   % This file is the set of miscellaneous routines used by LCFML2
     (the MLISP2 code) and by both it & the simplification package.%


EXPR BETTER(V,L);
% Unprimes (see UNPRIME below) the variable name (V) and then adds just
  enough primes (ones) so that the new name is not in the list (L).   %
BEGIN NEW X,Y;
    X ← UNPRIME(V);
    WHILE (X MEMQ L) DO
	IF (Y←GET(X,'PRIME)) THEN X ← Y
	ELSE X ← PUTPROP(X,READLIST(EXPLODE(X)@<1>),'PRIME);
    RETURN(X);
END;

EXPR UNPRIME(V);
% Removes trailing primes (ones) from a variable name. %
BEGIN NEW X;
    X ← GET(V,'UNPRIME);
    IF ¬NULL(X) THEN RETURN(X);
    X ← REVERSE(EXPLODE V);
    WHILE CAR(X) EQ 1 DO X ← CDR(X);
    X ← READLIST(REVERSE X);
    PUTPROP(V,X,'UNPRIME);
    RETURN(X);
END;


EXPR CORRESP(I1,I2,A1,A2);
% Checks for correspondence between 2 atoms (I1 & I2) according to
  the 2 A-lists (A1 and A2). %
BEGIN NEW X,Y;
    X←ASSOC(I1,A1);  Y←ASSOC(I2,A2);
    RETURN( IF NULL(X)∧NULL(Y) THEN (I1 EQ I2)
	    ELSE IF NULL(X)∨NULL(Y) THEN NIL
		 ELSE CDR(X) EQ CDR(Y) );
END;


EXPR UNION(L1,L2);
% Takes a specially ordered union of 2 ordered lists of integers and
  other atoms. The ordering of the lists is: integers precede other
  things and appear in the order given by GREATERP.%
IF NULL(L1) THEN L2 ELSE
IF NULL(L2) THEN L1 ELSE
IF NUMBERP(CAR L1)∧NUMBERP(CAR L2) THEN
    (IF LESSP(CAR L1,CAR L2) THEN (CAR L1 CONS UNION(CDR L1,L2))
     ELSE IF CAR(L1)≠CAR(L2) THEN (CAR L2 CONS UNION(L1, CDR L2))
     ELSE (CAR L1 CONS UNION(CDR L1,CDR L2)))  ELSE
IF NUMBERP(CAR L1) THEN (CAR L1 CONS UNION(CDR L1,L2)) ELSE
IF NUMBERP(CAR L2) THEN (CAR L2 CONS UNION(CDR L2,L1)) ELSE
IF MEMBER(CAR L1, L2) THEN UNION(CDR L1,L2) ELSE 
CAR L1 CONS UNION(CDR L1,L2);


EXPR SUBSTFREE(X0,V,TERM);
% Substitute X0 for each free occurrence of variable (V) in term (TERM).%
BEGIN NEW X;
    IF ATOM(TERM) THEN
	IF TERM EQ V THEN RETURN(X0)
	ELSE RETURN(TERM)
    ELSE
    IF ATOM(CAR TERM) ∧ (X←ASSOC(CAR(TERM),OPS)) ∧ OPINFO1(CDR X) 
			∧ (CADR(TERM) EQ V) THEN RETURN(TERM)
    ELSE
    RETURN(SUBSTFREE(X0,V,CAR(TERM)) CONS SUBSTFREE(X0,V,CDR(TERM)));
END;

EXPR FREES(TERM);
FREES1(TERM,NIL);

EXPR FREES1(TERM,L);
% This function builds a list of the free variables in unmutated term
  (TERM) that are not in list (L).  %
IF ATOM(TERM) THEN
    IF MEMBER(TERM,L) THEN NIL
    ELSE <TERM>
ELSE
 IF ATOM(CAR TERM) THEN
 BEGIN NEW X;
     X ← CAR TERM;
     IF (X←ASSOC(X,OPS)) THEN
	 IF OPINFO1(CDR X) THEN RETURN(FREES1(CDDR(TERM),CADR(TERM) CONS L))
	 ELSE RETURN(FREES1(CDR(TERM),L))
     ELSE RETURN(FREES1(CAR TERM,L) UNION FREES1(CDR TERM,L));
 END
 ELSE FREES1(CAR TERM,L) UNION FREES1(CDR TERM,L);


EXPR EQUALTERM(T1,T2);EQT(T1,T2,NIL,NIL);
EXPR EQT(S1,S2,L1,L2);
BEGIN NEW X;
    IF ATOM S1 ∧ ATOM S2 THEN RETURN(CORRESP(S1,S2,L1,L2));
    IF ATOM S1 ∨ ATOM S2 THEN RETURN NIL;
    X←GENSYM();
    IF (CAR S1 EQ '?λ) ∨ (CAR S1 EQ '?α) THEN
	IF (CAR S1 EQ CAR S2) THEN
	    RETURN(EQT(CDDR S1,CDDR S2,(CADR(S1) CONS X) CONS L1,
			(CADR S2 CONS X) CONS L2))
	ELSE RETURN NIL;
    RETURN(EQT(CAR S1,CAR S2,L1,L2)∧EQT(CDR S1,CDR S2,L1,L2)  );
END;


EXPR MUTATE(R,L);MUT1(R,L,NIL);
EXPR MUT1(R,L,A); IF NULL R THEN NIL ELSE
	IF ATOM R THEN BEGIN NEW X;RETURN IF X←ASSOC(R,A)
			THEN CDR X ELSE R END ELSE
	IF (CAR R EQ '?λ) ∨ (CAR R EQ '?α) THEN
		BEGIN NEW X,Y;Y←BETTER(X←CADR R,L); RETURN(CAR R CONS
		Y CONS MUT1(CDDR R,Y CONS L,(X CONS Y)CONS A))END ELSE
	MUT1(CAR R,L,A)CONS MUT1(CDR R,L,A);


EXPR MEMP(M,L,P);   % Set membership relative to predicate (P). %
¬NULL L ∧(P(M,CAR L)∨MEMP(M,CDR L,P));

EXPR CONTP(L1,L2,P);	%set containment (L1⊂L2) relative to pred. P  %
NULL(L1) ∨ MEMP(CAR L1,L2,P) ∧ CONTP(CDR L1,L2,P);

EXPR INTERSECTP(L1,L2,P); % Set intersection relative to pred. P. %
BEGIN NEW M,N;
    FOR M IN L1 DO
    IF MEMP(M,L2,P)THEN N←M CONS N;
    RETURN N;
END;

EXPR OUTOFP(M,L,P); % Removal of elements of L related to M by P.%
IF NULL(L) THEN NIL
ELSE IF P(M,CAR L)THEN OUTOFP(M,CDR L,P)
     ELSE CAR L CONS OUTOFP(M,CDR L,P);

EXPR SUBTRACTP(L1,L2,P); %Set subtraction relative to pred P. %
FOR NEW M IN L2 DO L1←OUTOFP(M,L1,P);


EXPR ISASSOF(AWFF,LINENO);
EQUALTERM(AWFF,CAAR LINEOF(LINENO));

EXPR REMASS(S,TV,WFF); %Remove the step numbers of the assumption
			S≡TV from the dependencies of WFF. %
OUTOFP( ('?≡ CONS S CONS TV), CDR WFF, FUNCTION ISASSOF);


EXPR LINEOF(N);
%Get the wff on line numbered N.%
BEGIN NEW L;
    RETURN IF L←ASSOC(N,PROOF)THEN CADR L 
	   ELSE PRINC 'NONEXISTENT? STEP?  
	   ALSO TERPRI PRINC N 
	   ALSO <<'?≡ CONS 'BOOB CONS 'BOOB>> 
END;


EXPR NEWSTEP(Y);  %Add a new step to the proof.%
IF ATOM CAR Y THEN TERPRI T
	      ALSO PRINC CAR Y ALSO PRINC'?;? TRY? AGAIN
ELSE BEGIN 
	PROOF←(THISLINE CONS Y)CONS PROOF;
	FREESPR←FREESPR UNION FREES(CAAR Y);
	PRINC THISLINE;PRINC'? ;TERPRI PRINTSTEP(Y);   
	THISLINE←THISLINE+1 
END;


EXPR SUBSTFREEL(L,R);
IF NULL R THEN NIL 
ELSE 
IF ATOM R THEN 
    BEGIN NEW S; 
	RETURN IF S←ASSOC(R,L) THEN CDR S ELSE R 
    END
ELSE 
IF((CAR R EQ '?λ) ∨ (CAR R EQ '?α)) ∧ ASSOC(CADR R,L) THEN R
ELSE SUBSTFREEL(L,CAR R) CONS SUBSTFREEL(L,CDR R);
     

EXPR INIT();
BEGIN PROOF←NIL;THISLINE←1;FREESPR←NIL;NTACSG←0;
      GOALNO←NIL;NSG←0;GOALLIST←NIL;GOALTREE←NIL;
      AXIOMLIST←NIL;THEOREMLIST←NIL;
      LABELALIST←NIL;
      META←'(A?: B?: C?: D?: E?: F?: G?: H?: I?: J?:);

      THMDEPTH←15;

      IF NULL (GET('INIT, 'INIT)) THEN
      BEGIN
	  ARRAY(BNDGS,T,'(100 . 200));

	  BVMAX←1300;
	  ARRAY(BVMUT,T,'(1000 . 1301));
	  ARRAY(BCV,T,'(300 . 400));
	  NXTBVI←1001;
	  NXTNUMI←401;
	  NUMMUT←NIL;
	  NUMMUT2←NIL;

	  OPS←'( (?α . 1) (?λ . 2) (?! . 3) (?? . 4));

	  ARRAY(OPINFO1,T,5);
	  OPINFO1(1)←T;
	  OPINFO1(2)←T;
	  OPINFO1(3)←NIL;
	  OPINFO1(4)←NIL;

	  ARRAY(OPINFO2,T,5);
	  OPINFO2(1)←1;
	  OPINFO2(2)←1;
	  OPINFO2(3)←2;
	  OPINFO2(4)←3;

	  ARRAY(OPINFO3,T,5);
	  OPINFO3(1)←'?α;
	  OPINFO3(2)←'?λ;
	  OPINFO3(3)←'?!;
	  OPINFO3(4)←'??;
	
      END;

      DEFPROP(INIT,T,INIT);

      LAMSS←<3,2,301,101,102,<0,NIL,NIL,NIL>>;
      % LAMSS is a simpset with just the lambda conversion rule in it.%
      BAS5SS←PUT1IN( '(?≡ (?λ X ?λ Y ?? TT X . Y) . (?λ X ?λ Y . X)),
			NIL, NIL, LAMSS, NIL);
      BAS5SS←PUT1IN( '(?≡ (?λ X ?λ Y ?? FF X . Y) . (?λ X ?λ Y . Y)),
			NIL, NIL, BAS5SS, NIL);
      BAS5SS←PUT1IN( '(?≡ (?λ X ?λ Y ?? UU X . Y) . (?λ X ?λ Y . UU)),
			NIL, NIL, BAS5SS, NIL);
      BAS5SS←PUT1IN( '(?≡ (?λ X ?! UU . X) . (?λ X . UU)),
			NIL, NIL, BAS5SS, NIL);
      % BAS5SS is a simpset with the basic-5 rules in it.%
      DEFPROP(LAMSS,LAMSS,SIMPSET);
      DEFPROP(BAS5SS,BAS5SS,SIMPSET);
      SIMPSET ← BAS5SS;

      THISGOAL←NIL;
      METHOD←NIL;
      IO_LEVEL←0;
      TERPRI T ;
      SIMCNT ←0;
      MATCNT ← 0;
      RESUME();
END;


EXPR RESUME();
BEGIN NEW X;
      IF NULL(GET('INIT,'INIT)) THEN INIT();
      PREVTYP ← NIL;
      DELLIM(13);
      SCANFNSET('SCANPRINT);
      IF SAVING THEN CLOSESAVCHAN();

L;    X←ERRSET(PARSE(),T);
      IF X EQ '?$EOF?$ THEN
      BEGIN
	   IO_LEVEL ← IO_LEVEL - 1;
	   IF IO_LEVEL EQ 1 THEN X←'CH0;
	   IF IO_LEVEL EQ 2 THEN X←'CH1;
	   IF IO_LEVEL EQ 3 THEN X←'CH2;
	   IF ¬(IO_LEVEL EQ 0) THEN INC(X);
      END ALSO GO(L);
      IF ATOM(X) THEN 
      BEGIN
	   TERPRI(NIL);
	   PRINC X;
      END ALSO GO(L);
      IF SAVING THEN CLOSESAVCHAN();
END;

EXPR SCANPRINT(TYPE,VALUE);
BEGIN NEW N, THISTYP;
      IF ¬(IO_LEVEL EQ 0) ∨ ¬SAVING  THEN
	 IF (TYPE EQ 3)∧(VALUE EQ 13) THEN RETURN(SCAN())
	 ELSE RETURN(TYPE);
      N←OUTC('SAVCHAN, NIL);
      THISTYP←¬(TYPE EQ 3);
      IF PREVTYP∧THISTYP THEN PRINC '? ;
      PREVTYP ← THISTYP;
      IF ¬THISTYP THEN PRINC(ASCII VALUE) ELSE PRINC(VALUE);
      IF ¬THISTYP∧(VALUE EQ 13) THEN
	  PRINC(ASCII 10) ALSO SPACES(LENGTH(GOALTREE)*2)
	  ALSO OUTC(N,NIL) ALSO RETURN(SCAN());
      OUTC(N,NIL);
      RETURN(TYPE);
END;

EXPR THMS2BPS();
BEGIN
	FOR NEW X IN THEOREMLIST DO
	PUTPROP(X,LTCONS(GET(X,'THEOREM)),'THEOREM);
	PROOF←LTCONS(PROOF);
	AXIOMLIST←LTCONS(AXIOMLIST);
	SIMPSET←LTCONS(SIMPSET);
END;

EXPR CLOSESAVCHAN();
    IF SAVING THEN OUTC(OUTC('SAVCHAN,NIL),T) ALSO SAVING←NIL;

EXPR SIMP2(MT,S,ML,L);
BEGIN NEW D;
RETURN (
    IF ATOM(MT) THEN
	IF (MT MEMQ META) THEN
	    (IF ¬INTERSECTP(FREES(S),
			(FOR NEW V IN L COLLECT<CDR V>),FUNCTION EQ)
	     THEN
		IF D←ASSOC(MT,ML) THEN
		    (IF EQUALTERM(S,CDR D)THEN T CONS ML)
		ELSE T CONS (MT CONS S) CONS ML)
	ELSE (IF ATOM S ∧ CORRESP(MT,S,L)THEN T CONS ML)
    ELSE IF ¬ATOM S THEN
	    IF(CAR S EQ '?λ) ∨ (CAR S EQ '?α)THEN 
		(IF CAR S EQ CAR MT THEN
		SIMP2(CDDR MT,CDDR S,ML,(CADR MT CONS CADR S)CONS L))
	    ELSE(IF D←SIMP2(CAR MT,CAR S,ML,L)THEN 
		     SIMP2(CDR MT,CDR S,CDR D,L))    )
END;



EXPR SIMP1(M2,M1,S,FLAG,N);
BEGIN NEW D;
RETURN
    IF D←SIMP2(M1,S,NIL,NIL)THEN 
	(IF ¬N THEN RPLACA(FLAG,T)ALSO MUTSUBST(M2,CDR D)
		ELSE RPLACA(FLAG,CAR FLAG+1)ALSO 
		    IF CAR FLAG MEMQ N THEN
			MUTSUBST(M2,CDR D) ELSE S )
    ELSE
    IF ATOM S THEN S 
    ELSE
    IF CAR S MEMQ<'?λ,'?α>THEN 
	  CAR S CONS CADR S CONS SIMP1(M2,M1,CDDR S,FLAG,N)
    ELSE
    (IF CAR S MEMQ<'??,'?!,'?≡,'?⊂ >THEN CAR S
    ELSE SIMP1(M2,M1,CAR S,FLAG,N)) CONS SIMP1(M2,M1,CDR S,FLAG,N)
END;

EXPR MUTSUBST(S,ML);
BEGIN
    FOR NEW B IN ML DO
    S←SUBSTFREE(CDR B,CAR B,
	MUTATE(S,FREES(S)UNION FREES(CDR B)));
    RETURN S
END;


EXPR TRYMN(N,S); %Meaning of TRY.%
IF NSG EQ 0∨¬((N←IF N THEN CAR N ELSE NSG)≤NSG)
    THEN PRINC TERPRI'NO? SUCH? GOAL
ELSE
IF CAR(GOALLIST[N]) THEN PRINT'GOAL ALSO PRINC N
			ALSO PRINC'? ALREADY? PROVED 
ELSE
BEGIN NEW GWFF,GASS,S1,SV;
    THISGOAL←GOALLIST[N];
    GOALTREE←(METHOD CONS GOALLIST)CONS GOALTREE;
    GOALLIST←NIL;METHOD←NIL;GOALNO←N CONS GOALNO;
    RPLACA(THISGOAL,<PROOF,SIMPSET,THISLINE,FREESPR,NSG,NTACSG>);
    NSG←0;NTACSG←1;
    PROOF←<GOALNO,CDR THISGOAL,
		IF S THEN
		    IF((S1←S[1,1])≤2)∨(S1 EQ 7)∨(S1 EQ 8) THEN CDAR(S)
		    ELSE
		    IF (S1 EQ 3) THEN (<'SIMPL> APPEND SIM1X(CADDAR S))
		    ELSE 
		    IF (S1 EQ 9) THEN (<'SPREF> APPEND SIM1X(CADDAR S))
		    ELSE 
		    IF (S1 EQ 10) THEN ('SSUBST CONS STEPREF(CADDAR S)
			CONS CAR CDDDAR S CONS SIM1X(CADDR CDDAR S))
		    ELSE 
		    IF S1 EQ 6 THEN<'USE,CADDAR S> 
		    ELSE CADAR S CONS STEPREF(CADDAR S)CONS CDDDAR S
		ELSE NIL> CONS PROOF;
    FREESPR←FREESPR UNION FREES(CDR THISGOAL);
    IF GASS←CDDR THISGOAL THEN ASSUMPTION(CAR GASS,CDR GASS);
    IF ¬S THEN RETURN NIL;

    SV←CDDAR S; %Every thing after tactic keyword %
    GWFF←CADR THISGOAL;
    IF S1 EQ 1 THEN
    BEGIN
	METHOD←'CASES CONS SV;
	FOR NEW TV IN <'TT,'UU,'FF> DO
	GOAL(GWFF,<<2,'SASSUME>,<'?≡ CONS CAR SV CONS TV>>);
	NTACSG ←3;
    END ELSE
    IF S1 EQ 2 THEN
    BEGIN NEW VAR,NEWGWFF,FREES1,FREESL,L,R,FLAG;
	FREES1←FREES(GWFF)@FREESPR@<'TT,'UU,'FF>;
			 %Free vars. from proof & goal-wff%
	NEWGWFF←FOR NEW A IN GWFF COLLECT
	BEGIN NEW FREES2;
	    FREES2←FREES1;
	    WHILE CAR(L←CADR A) EQ '?λ DO
	    BEGIN
		FLAG←T;
		VAR←BETTER(CADR L,FREES2);
		FREES2←VAR CONS FREES2;
		FREESL←VAR CONS FREESL;
		A←CAR A CONS SUBSTFREE(VAR,CADR L,MUTATE(CDDR L,<VAR>@FREES2))
		    CONS IF CAR(R←CDDR A) EQ '?λ THEN
			    SUBSTFREE(VAR,CADR R,MUTATE(CDDR R,<VAR>@FREES2))
			 ELSE ('?! CONS R CONS VAR)
	    END;
	    RETURN<A>
	END;
	METHOD←<'ABSTR,FREESL>;
	IF FLAG THEN GOAL(NEWGWFF,NIL) ELSE PRINC 'CAN?'T? ABSTR 
			ALSO TERPRI(NIL) ALSO BACKUP(NIL)
    END ELSE
    IF S1 EQ 3 THEN
    BEGIN NEW S,LS,NGWFF;
	SIMPSET←CHGSS(CAR(SV),SIMPSET);
	LS←SIMPLIFY1(<1,<GWFF>>,SIMPSET);
	S←CDR LS;
	LS←IF CAR LS THEN 'BY CONS CAR LS;
	METHOD←'SIMPL CONS CDR S CONS LS;
	FOR NEW A IN CAR(S) DO
	IF ¬TRIVIALAWFF(A) THEN NGWFF←A CONS NGWFF;
	NGWFF←REVERSE(NGWFF);
	IF NULL(NGWFF) THEN
	    NEWSTEP(<GWFF CONS CDR S, 'SIMPL CONS LS>)
		    ALSO BACKUP(T)
	ELSE GOAL(NGWFF,NIL)
    END ELSE
    IF S1 EQ 4 THEN
    BEGIN NEW S,NGWFF;
	S←SUBS1(SV[1],SV[2],<1,<GWFF>>);
	METHOD←<'SUBST,CDR S,'USING,STEPREF(SV[1]),SV[2]>;
	FOR NEW A IN CAR(S) DO
	IF ¬TRIVIALAWFF(A) THEN NGWFF←A CONS NGWFF;
	NGWFF←REVERSE(NGWFF);
	IF NULL(NGWFF) THEN
	    NEWSTEP(<GWFF CONS CDR S, <'SUBST, 'BY, STEPREF(SV[1])>>)
		    ALSO BACKUP(T)
	ELSE GOAL(NGWFF,NIL)
    END ELSE
    IF S1 EQ 5 THEN
    BEGIN NEW FIXAWFF,FIXVAR,TAU,MUVAR,NEWVAR,NEWTAU,BASE,HYP,CONCL,N;
	FIXAWFF←CAAAR SV; FIXVAR←CADR FIXAWFF;
	IF CAR FIXAWFF NEQ'?≡ ∨ CADDR FIXAWFF NEQ'?α THEN
		PRINT'CANT? INDUCT ALSO RETURN BACKUP(NIL);
	MUVAR←CADDDR FIXAWFF;TAU←CDDDDR FIXAWFF;
	N←IF SV[2] THEN SV[2,2] ;
	GWFF←SIMP1('FIXTEMP?:,FIXVAR,GWFF,<IF N THEN 0>,N);
	NEWVAR←BETTER(MUVAR,FREES(GWFF)@FREESPR);
	NEWTAU←SUBSTFREE(NEWVAR,MUVAR,MUTATE(TAU,<NEWVAR>));
	BASE←SUBSTFREE('UU,'FIXTEMP?:,GWFF);
	HYP←SUBSTFREE(NEWVAR,'FIXTEMP?:,MUTATE(GWFF,<NEWVAR>));
	CONCL←SUBSTFREE(NEWTAU,'FIXTEMP?:,MUTATE(GWFF,FREES(NEWTAU)));
	METHOD←<'INDUCT,HYP, CDAR SV ,NEWVAR>;
	GOAL(BASE,NIL);
	GOAL(CONCL,<<1,'ASSUME>,HYP>);
	NTACSG ← 2;
    END ELSE
    IF S1 EQ 6 THEN
    BEGIN NEW THCON,INSTL,THNAME,THM,THANT,FREELIST,METADUMP,M;
	THNAME←CAR SV;
	INSTL←IF SV[3] THEN CAR(SV[3]);
	METHOD←<<'USE,THNAME>,NIL>;
	IF ATOM(THM←LKUPTHM(THNAME)) THEN
	    PRINC TERPRI THM ALSO RETURN BACKUP(NIL);
	THCON←THM[3];THANT←THM[4];
	FREELIST←SUBTRACTP( THM[5] ,<'TT,'UU,'FF> UNION
	    FOR NEW A IN THM[2] ;UNION USEMNGX(A),  FUNCTION EQ);
	IF INSTL ∧ ¬ FOR NEW INST IN INSTL;AND MEMQ(CAR INST,FREELIST)
	    THEN PRINC TERPRI'BAD? INSTANTIATION 
		ALSO RETURN BACKUP(NIL);
	IF LENGTH THCON≠LENGTH GWFF ∨ 
		BEGIN METADUMP←META;META←FREELIST;
		    M←SIMP2(MUTATE(THCON,FREELIST 
			UNION FREES(GWFF)),GWFF,INSTL,NIL);
		    META←METADUMP;RETURN ¬M 
		END
	    THEN PRINC TERPRI'CANT? MATCH? CONSEQUENT 
		ALSO RETURN BACKUP(NIL);
	IF ¬THANT THEN NEWSTEP(<<GWFF>,<THNAME>>) ALSO RETURN BACKUP(T);
	FOR NEW A IN THANT DO 
		GOAL(<SUBSTFREEL(CDR M,MUTATE(A,FREES(CDR M)))>,NIL);
	NTACSG ← LENGTH(THANT)
    END ELSE
    IF S1 EQ 7 THEN
    BEGIN NEW A,B;
	METHOD ← <'CONJ, NIL>;
	FOR A IN GWFF DO
	IF ¬TRIVIALAWFF(A) THEN B←A CONS B;
	IF NULL B THEN RETURN BACKUP(T);
	FOR A IN B DO
	GOAL(<A>,NIL);
	NTACSG ← LENGTH(B);
    END ELSE
    IF S1 EQ 8 THEN
    BEGIN NEW VAR, NEWGWFF, FREES1, FREESL, L, R, FLAG, FLAG1, STEPS;
	IF ¬NULL(CDR GWFF) THEN PRINC 'CAN?'T? PREF?.? DO? CONJ?.
	    ALSO TERPRI(NIL) ALSO RETURN BACKUP(NIL);
	FREES1 ← FREES(GWFF)@<'TT,'UU,'FF>;
	L ← CADAR(GWFF);  R ← CDDAR(GWFF);
	WHILE (FLAG1←(CAR(L) EQ '?λ)) ∨
	     ((CAR(L) EQ '??)∧(CAR(R) EQ '??)∧(CDDDR(L) EQ 'UU)
	     ∧ (CDDDR(R) EQ 'UU)∧EQUALTERM(CADR(L),CADR(R)))  DO
	IF FLAG1 THEN
	BEGIN
	    VAR ← BETTER(CADR(L),FREES1);
	    FREES1 ← VAR CONS FREES1;
	    FREESL ← VAR CONS FREESL;
	    L ← SUBSTFREE(VAR, CADR L, MUTATE(CDDR L,<VAR>@FREES1));
	    IF CAR(R) EQ '?λ THEN
		R ← SUBSTFREE(VAR, CADR R, MUTATE(CDDR R,<VAR>@FREES1))
		ELSE R ← '?! CONS R CONS VAR;
	    FLAG ← T;
	END ELSE
	BEGIN FLAG←T;
	    STEPS ← THISLINE CONS STEPS;
	    ASSUMPTION(<2,'SASSUME>,<'?≡ CONS CADR(L) CONS 'TT>);
	    L ← CADDR(L);  R ← CADDR(R);
	END;
	NEWGWFF ← <CAAR(GWFF) CONS (L CONS R)>;
	METHOD ← <'PREF,FREESL,STEPS>;
	IF FLAG THEN GOAL(NEWGWFF,NIL) ELSE
	    PRINC 'CAN?'T? PREF?.  ALSO TERPRI(NIL) ALSO BACKUP(NIL);
    END ELSE
    IF S1 EQ 9 THEN
    BEGIN NEW VAR, FREES1, FREESL, L, R, FLAG, FLAG1, LS, S, SP, ST, STEPS;
	IF ¬NULL(CDR GWFF) THEN PRINC 'CAN?'T? SPREF?.? DO? CONJ?.
	    ALSO TERPRI(NIL) ALSO RETURN BACKUP(NIL);
	FREES1 ← FREES(GWFF)@<'TT,'UU,'FF>;
	L ← CADAR(GWFF);  R ← CDDAR(GWFF);
	SP ← PROOF;		% SAVE CURRENT PROOF. %
	ST ← THISLINE;		% SAVE LINE COUNTER. %
	WHILE (FLAG1←(CAR(L) EQ '?λ)) ∨
	     ((CAR(Hα⊂Jα⊗E↓;y⎇$⊃D~εI"∩Iα⊗Eα9⎇⎇$"B∞∩∩%⊃"1%∧*E↓≡-)$4(J↓↓↓↓!↓"∞$"∩I"∩Iα⊗Eα:VU$$*FVεe"⊗J5D~ε∩IDa%2∞"I"IJI%↓α$x4(&L1α~29EαRD*84(L∩⊗≡&ph(%↓α↓αZε∩α⎇α
-"R⊗ID~ε∩IDa%2~∀*⊗MEKX4(%α↓↓α~∀*⊗ME¬yαZε∩α∞>:~α~J⊗-→El4PI↓↓↓∧2J⊗⊗≤aα⎇α4
Iα∞|rMα~∀*⊗N1Xh(%↓α↓α1αzαNV
≥"~J⊗*BZεIbα∞ε∩∩α11αm*RεR*B∞∩∩∩α11r4
Izα5∩⊗⊗M
I%l4PI↓↓↓∧J→α∞
⊃"I%∧*E↓≥xAαR",p4($M⊃α⎇α≥*
NR5∩⊗∃"4
I1α≤
∩Iα∩aα6V$
R∃"≤"∩Iα∩arZε∪rα~J,*ME%Hh($&,bN∃α∩α⎇↓≥z	α∞>u→αIα≤z:Mα4
Il4PI↓↓↓∧22ε≥¬yαQlhP&⊗:"α⊗2N(h(&
,:&9α4bε≡}#X4(%α↓↓αN$*BMαzαR"&≤b&:∃∧~>:M¬~R⊗B≠X4(%α↓↓αε≥~V6B$J>9!c⊃1≡N
~NV6+q1q≥yqα∞>u→α∞ε%⊃"1%∧~>:Mα:RQyKX4(%α↓↓α1¬yα∞ε$"I"1KY↓αI¬yα∞ε$"I"IKX4(&,r⊃l4PJ&→,22ε≥¬""⊗9¬αJ&:~↓≡∞εsy≡Q⎇¬~BJ⊗3y84(J↓↓↓αbN=α$*JBJJB:&1Jαε2NzαJ⊗R-∩9α
~.VADr&1%Xh(&NLjBN⊗"α⎇α∞D:NM"≤
I"N2I2N&mαN⊗QKX4(&e→α⎇α≤J6B2L2eE!c	1qr≤
εI"=:~→%∧~>:MαB1α∞|rMαIKqyy2≤J6BN-!%l4PJMα⎇∧~∩Iαe→l4(LbMα⎇∧J→α∞
⊃α2M¬""⊗9α:
eα≤z:Mα≤
Iα2≠X4(&l*R">"α⎇↓q=~BJ⊗2b∞∩I¬→22Md2J⊗⊗≤a2NR-αMylhP&&→¬"J&ZL
2ε↑41"∞ε
⊃αM%¬""⊗9h(%↓α↓αR"M~2&:-zNQ↓∧
2N=ααBJ>|1α⎇α≥↓↓αεe~=↓α≥"}:&`h(%↓α↓αε2≤yα~>∩α:⊗]¬Aα&9∧~∩Iα~α∩=hP$&
,:&9αL1∃"Bα6⊗6
αNR⊗¬→%αRD*9αN%zaα∞|rMαN"α⊗:⊂hP%↓↓ααε2Nzα:⊗↑≥"⊗A!d:↑~→∧~>:M¬∩⊗Z⊗∃~∃"N"I1≡N¬∩⊗→α≤z:Mαe→y$4PI↓↓↓∧
2N=∧∩ε∞.-↓↓"QHh(&⊗e~∃α≡|
1"∞
⊃αM2tJ1%lhQ↓↓↓∧*:⊃α,bN∀4R↓↓↓αL1αME∧*E↓EααR"⊗ph)↓↓αα
⊗≡Lqα:⊗:α2M1¬→1α:=:~→lhP&N}≥*
MEE~ZmFjbNZm∃i1qEcb≡↑~3qy%lhP&N&mαN⊗Q¬yα∞"=~M"N5YNu2≤J6BN-!%l4PJ2MαzαN&6∧b&~e
AqE1d~εI"~Iyy2≤J6BN-!%l4PJ6⊗RDz∩⎇q=~NV
≥!1↓α≤"I"MJαV:&|qα∞∩%⊃α2Mb4($HH%≡V≤J:≥1ααNR⊗¬∩⊗→"≥2mFuJa↓αN5YJuyXh(&Nzα∞∩I∧bMl4PJ2Mαzα&→α≤
Iα2~αR"⊗r↓≡
e∧~>:M∧~εIαe→l4(L2>Iαt*]α¬∧J9α∞
⊃"M%∧"<4(LJ→⊗%∩&Z&bε↑~2B¬%α$B⊗9αt:↑~~|	α∞>u→α:≡<2→l4PJ:≡↑42}J⊗4*JN∃Dr≡↑~2Il4(M→α⎇α≤"IαN5YFuα,r&>9∧~∩I"~Il4(LJ→α:,b1":=:~→%¬""⊗8hP%↓↓αα:⊗↑≥"⊗A!d:↑~→∧~>:M¬→1↓q=~NV
≥!1αN$*BJ⊗2BNZm
i%↓z∧bMy$hP$%↓α↓αε2≤yα
ε≤ZVA""H4(&,bN∃α<zε1"t:↑~→dr&1$hQ↓↓↓∧*:⊃α,bN∀4Ph)↓↓αα⊗JIB∩R"∃∧~>6B-"⊗IαM→α¬α∧Bf:F,)¬	%Xh*⊗:#X4(4PEXPR SIM1X(L);
FOR NEW X IN L COLLECT
((IF CAR(X) EQ 1 THEN <'BY> ELSE <'WO>) APPEND
    FOR NEW Y IN CDR(X) COLLECT <CDR Y>);

EXPR TRIVIALAWFF(AWFF);
%Tests an AWFF for forms  X≡Y, X⊂Y, UU⊂X   %
    EQUALTERM(CADR(AWFF),CDDR(AWFF)) ∨
	((CAR(AWFF) EQ '?⊂)∧(CADR(AWFF) EQ 'UU));



EXPR BACKUP(TV);
BEGIN NEW DUMP;
    DUMP←CAR THISGOAL;SIMPSET←DUMP[2];NSG←DUMP[5];NTACSG←DUMP[6];
    PROOF←IF TV THEN<GOALNO,T,<CAR METHOD>> CONS PROOF ELSE DUMP[1];
    IF ¬TV THEN THISLINE←DUMP[3];
    FREESPR←DUMP[4];
    RPLACA(THISGOAL,IF TV THEN THISLINE-1);PRINT'GOAL;
    PRINTGN(GOALNO);PRINC IF TV THEN'? PROVED ELSE'? ABANDONED;
    PRINC'?.? ? BACK? UP? TO? ; IF(GOALNO←CDR GOALNO)THEN 
	BEGIN PRINC'GOAL? ;PRINTGN(GOALNO)END
	ELSE PRINC'TOP? LEVEL;PRINC'?.?  ;
    GOALLIST←CDAR GOALTREE;
    METHOD←CAAR GOALTREE; GOALTREE←CDR GOALTREE;      
    THISGOAL←IF GOALTREE THEN(CDAR GOALTREE)[CAR GOALNO];
    CHECKGOALS()
END;

EXPR CHECKGOALS();
BEGIN NEW REMGOALS,B,CM;
    CM←CAR METHOD;
    REMGOALS← FOR NEW N ←1 TO NSG COLLECT
	IF CAR(GOALLIST[N]) THEN NIL 
	ELSE (IF N≤NTACSG THEN B←T)ALSO <<N,CDR(GOALLIST[N])>>;  
    IF REMGOALS ∧ (¬METHOD ∨ B) THEN 
    BEGIN PRINT'REMAINING;PRINC'? SUBGOALS? ?:;
	FOR NEW RG IN REMGOALS DO
	BEGIN 
	    PRINT(CAR RG);
	    RG←CADR RG;PRINC'? ? ;PRINTWFF(CAR RG);
	    IF CDR RG THEN 
	    BEGIN PRINC'? ?:? ;PRINC CADADR RG;
		PRINC'? ;PRINTWFF(CDDR(RG));
	    END
	END
    END
    ELSE
    BEGIN
	TERPRI PRINC'? NO? MORE? SUBGOALS?.;
	IF METHOD ∧ ¬B THEN 
	BEGIN NEW LL;
	    LL←FOR NEW N←1 TO NTACSG COLLECT
		<CAR GOALLIST[N]>;
	    IF CM EQ 'CASES THEN
	    BEGIN NEW S;
		S←CADR METHOD;
		NEWSTEP(< CADR THISGOAL  CONS (
		    REMASS(S,'TT,LINEOF(LL[1])) UNION
		    REMASS(S,'UU,LINEOF(LL[2])) UNION
		    REMASS(S,'FF,LINEOF(LL[3])) ) ,<CM,S>@LL>  )
  	    END
	    ELSE
	    IF CM EQ 'ABSTR THEN
	    BEGIN NEW DEPS;
		DEPS←CDR(LINEOF(LL[1]));
		CHECKDEPS(METHOD[2],DEPS);
		CHECKAXS(METHOD[2]);
		NEWSTEP(<CADR THISGOAL CONS DEPS,<CM, LL[1]>>);
	    END
	    ELSE
	    IF CM EQ 'PREF THEN
	    BEGIN NEW DEPS,Y;
		FOR Y IN REVERSE(CDR(LINEOF(LL[1]))) DO
		    IF ¬(Y MEMQ METHOD[3]) THEN DEPS ← Y CONS DEPS;
		CHECKDEPS(METHOD[2],DEPS);
		CHECKAXS(METHOD[2]);
		NEWSTEP(<CADR THISGOAL CONS DEPS,<CM, LL[1]>>);
	    END
	    ELSE
	    IF CM MEMQ'(SIMPL SUBST SSUBST) 
    		THEN NEWSTEP(<CADR THISGOAL CONS 
			UNION(CDR LINEOF(LL[1]),CADR METHOD),
			CM CONS LL[1] CONS CDDR METHOD>)
	    ELSE
	    IF CM EQ 'SPREF THEN
	    BEGIN NEW DEPS,X,Y;
		FOR Y IN REVERSE(CDR(LINEOF(LL[1]))) DO
		    IF ¬(Y MEMQ METHOD[5]) THEN DEPS ← Y CONS DEPS;
		CHECKDEPS(METHOD[4],DEPS);
		CHECKAXS(METHOD[4]);
		FOR Y IN REVERSE(CADR METHOD) DO
		    IF ¬(Y MEMQ METHOD[5]) THEN X ← Y CONS X;
		NEWSTEP(<CADR THISGOAL CONS UNION(DEPS,X),
			CM CONS LL[1] CONS CADDR METHOD>)
	    END
	    ELSE
	    IF CM EQ 'INDUCT THEN
	    BEGIN NEW L,DEPS;
		L←CDR(LINEOF(LL[2]));
		FOR NEW A IN CADR METHOD DO 
		L←OUTOFP(A,L,FUNCTION ISASSOF);
		DEPS←CDR(LINEOF(LL[1])) UNION L UNION METHOD[3];
		CHECKDEPS(<METHOD[4]>,DEPS);
		CHECKAXS(<METHOD[4]>);
		NEWSTEP(< CADR THISGOAL CONS  DEPS,CM CONS LL>)
	    END
	    ELSE
	    IF (CAR(CM) EQ 'USE) ∨ (CM EQ 'CONJ) THEN
		NEWSTEP(<CADR THISGOAL CONS FOR NEW L IN LL;
			UNION CDR LINEOF(L) , CM CONS LL > ) 
	    ELSE ERR("THE CODE IS BAD");
	    BACKUP(T)
	END
    END
END;

EXPR CHECKDEPS(VLIST,DEPS);
FOR NEW X IN DEPS DO
BEGIN NEW Y;
    Y←FREES(LINEOF(X));
    FOR NEW Z IN Y DO
    IF ZεVLIST THEN
    BEGIN
	TERPRI(NIL);
	PRINC 'HOWEVER?,? THIS? GOAL? CANNOT? BE? ESTABLISHED? SINCE? ;
	PRINC 'THE? CREATED? VARIABLE? ; TERPRI(NIL);
	PRINC 'APPEARS? IN? THE? DEPENDENCIES? OF? THE? LAST? STEP?.? ;
	TERPRI(NIL); PRINC 'TRY? AGAIN?.; TERPRI(NIL);
	ERR('? );
    END;
END;

EXPR CHECKAXS(VLIST);
FOR NEW X IN AXIOMLIST DO
BEGIN NEW Y;
    Y←USEMNGX(CAR X);  %FREES IN AXIOM X.%
    FOR NEW Z IN Y DO
    IF ZεVLIST THEN
    BEGIN
	TERPRI(NIL);
	PRINC 'HOWEVER?,? THIS? GOAL? CANNOT? BE? ESTABLISHED? SINCE? ;
	PRINC 'THE? CREATED? VARIABLE? ; TERPRI(NIL);
	PRINC 'APPEARS? IN? AN? AXIOM? WHICH? WAS? RECENTLY? INTRODUCED?.;
	TERPRI(NIL); PRINC 'TRY? AGAIN?.; TERPRI(NIL);
	ERR('? );
    END;
END;

EXPR THEORMNG(TH,AXLIST,THNAME,W);
BEGIN NEW W1,W2,FREELIST;

	AXLIST ← IF W[1] EQ 1 THEN FOR NEW A IN AXIOMLIST COLLECT<CAR A>ELSE
		IF AXLIST THEN AXLIST[2] ;
	IF W[1] EQ 2 THEN  FOR NEW A IN AXLIST DO  IF ¬ASSOC(A,AXIOMLIST)THEN
		PRINT'AXIOM ALSO PRINC A ALSO PRINC'? MISSING?. ;
	IF W[1] EQ 1 THEN W1←CAR W[2] ALSO W2←FOR NEW X IN CDR W[2] COLLECT
					CAR LINEOF(X)
	ELSE W1←W[2] ALSO W2← IF W[3] THEN W[3,2];
	FREELIST ← FREES(W1)UNION FREES(W2);
	THEOREMLIST ← CAR(PRINTTHEOREM1(PUTPROP(THNAME,
	    <THNAME,AXLIST,W1,W2,FREELIST>,'THEOREM))) CONS THEOREMLIST
END;


EXPR USEMNG(THNAME,VLL,INSTL);
< BEGIN NEW THM,THANT,THCON,FREELIST,ANT,ASSLIST,METADUMP,M;
	VLL←IF VLL THEN CAR VLL;  INSTL←IF INSTL THEN CAR INSTL;
	IF ATOM(THM←LKUPTHM(THNAME)) THEN RETURN(THM);
	THCON←THM[3];THANT←THM[4];FREELIST←SUBTRACTP( THM[5] ,<'TT,'UU,'FF>
	UNION FOR NEW A IN THM[2] ;UNION USEMNGX(A),
	FUNCTION EQ);
	ASSLIST ← FOR NEW X IN VLL;UNION CDR X;
	ANT ← FOR NEW X IN VLL COLLECT CAR X;
	IF LENGTH ANT ≠ LENGTH THANT THEN RETURN'WRONG? NUMBER? OF? ANTECEDENTS;
	IF INSTL ∧ ¬ FOR NEW INST IN INSTL;AND MEMQ(CAR INST,FREELIST)
				THEN RETURN'INADMISSIBLE? INSTANTIATION;
	METADUMP←META;META←FREELIST;M←IF ANT THEN 
	SIMP2(MUTATE(THANT,FREELIST UNION FREES(ANT)),ANT,INSTL,NIL)
	ELSE T CONS INSTL; META ← METADUMP;
	RETURN  IF ¬M THEN'CANT? MATCH? ANTECEDENTS  ELSE
		SUBSTFREEL(CDR M,MUTATE(THCON,FREES(CDR M)))
		  CONS ASSLIST
	END , <'USE,THNAME>CONS FOR NEW X IN VLL COLLECT <STEPREF(X)>>;

EXPR LKUPTHM(THN);
BEGIN NEW THM;
	IF ¬MEMQ(THN,THEOREMLIST)
	    ∨ ¬(THM←GET(THN,'THEOREM)) THEN 
		RETURN( 'NO? SUCH? THEOREM);
	IF FOR NEW I IN THM[2];OR ¬ASSOC(I,AXIOMLIST) THEN
		RETURN('SOME? AXIOMS? MISSING);
	RETURN(THM);
END;

EXPR USEMNGX(AXIOM);
BEGIN NEW X;
    IF X←GET(AXIOM,'FREES) THEN RETURN(X);
    X←FREES(CDR(ASSOC(AXIOM,AXIOMLIST)));
    PUTPROP(AXIOM,X,'FREES);
    RETURN X;
END;


EXPR SHOWMNG(TYPE,RL,L,DEST);
BEGIN NEW TP;RL←IF RL THEN CAR RL ELSE <<0,THISLINE+1>>;TP←TYPE[1];
	IF DEST THEN(IF CAAR DEST EQ 2 THEN OUTC(OUTPUT(LPT?:), NIL) ELSE
	OUTC(EVAL(<FUNCTION OUTPUT,'DSK?:,CADAR DEST>),NIL) ) ALSO
	IF DEST[2]THEN LINELENGTH CAR(DEST[2]);
	FOR NEW R IN RL DO
	IF TP EQ 1 THEN 
	(FOR NEW M←1 TO LENGTH GOALTREE DO (  IF R[1] ≤ M-1
	∧ M-1 ≤ R[2] THEN
		BEGIN NEW N;N←0;LINES(1);FOR NEW G IN CDR((REVERSE GOALTREE)[M])
		DO  BEGIN LINES(1);SPACES(M);
			  PRINTGN(CHOP(GOALNO,LENGTH(GOALTREE)-M+1));
			  PRINC'?#;N←N+1;PRINC N;
			  PRINTGOAL(CDR G);PRINTSTATUS(CAR G)
		    END
		END ))
	ELSE IF TP EQ 2 THEN LINES(1) ALSO IF THISGOAL 
		THEN PRINTGOAL(CDR THISGOAL)ELSE PRINC'NONE
	ELSE IF TP EQ 3 THEN FOR NEW N←1 TO NSG DO
		BEGIN NEW G;PRINT N;PRINTGOAL(CDR(G←GOALLIST[N]));
		PRINTSTATUS(CAR G) END
	ELSE IF TP EQ 4 THEN PRINTPROOF(T,T,R[1],R[2])
	ELSE IF TP EQ 5 THEN PRINTPROOF(T,NIL,R[1],R[2])
	ELSE IF TP EQ 6 THEN
	   (FOR NEW THN IN (IF L THEN L[2] ELSE THEOREMLIST) DO
	    IF ATOM(TP←LKUPTHM(THN)) THEN ERR(TP)
	    ELSE IF (TYPE[2,1] EQ 3) THEN PRINTTHEOREM2(TP) 
		 ELSE PRINTTHEOREM1(TP) ALSO PRINC '?; )
	ELSE IF TP EQ 7 THEN 
	    (FOR NEW A IN AXIOMLIST DO 
		IF ¬L∨MEMQ(CAR A,L[2]) THEN PRINT 'AXIOM
 			ALSO PRINC CAR A ALSO PRINC'?:
			ALSO TERPRINTWFF(CDR A)ALSO PRINC'?;)
	ELSE IF TP EQ 8 THEN SHOWSIMPSET(SIMPSET,R[1],R[2])
	ELSE PRINTLABELS(R[1],R[2]);
	OUTC(NIL,T)
END;

% The I/O routines of LCF are all on this page.%

EXPR SPACES(N);FOR NEW I←1 TO N DO PRINC'? ;
EXPR REPPR(A,N);FOR NEW I←1 TO N DO PRINC A;

EXPR LINES(N);FOR NEW I←1 TO N DO TERPRI T;

EXPR BLURB(L);BEGIN FOR NEW X IN L DO BEGIN SPACES(1);PRINTERM(X) END;
	PRINC'?. END;


EXPR PRINTERM(TAU);  IF NULL TAU THEN NIL ELSE
	IF ATOM TAU THEN (IF ¬NUMBERP(TAU) ∧ GET(TAU,'INFIX)
		THEN PRINC'?!) ALSO
	PRINC IF TAU EQ 'NIL?! THEN 'NIL ELSE TAU ELSE
	IF CAR TAU EQ '?? THEN
		BEGIN PRINTERMX(TAU[2]) ;PRINC '?→;
		PRINTERMX(TAU[3]);PRINC '?,;PRINTERMX(CDDDR TAU)         
		END ELSE
	IF CAR TAU EQ '?α THEN
		BEGIN PRINC '?[?α;PRINTERM(CADR TAU);PRINC '?.;
		PRINTERM(CDDR TAU);PRINC '?] END ELSE
	IF CAR TAU EQ '?λ THEN
		BEGIN NEW S;PRINC '?[?λ;S←TAU;
		WHILE ¬ATOM S ∧ CAR S EQ '?λ DO
			BEGIN PRINTERM(CADR S);PRINC'? ;S←CDDR S END;
                 	PRINC'?. ;PRINTERM(S);PRINC '?] END ELSE
	IF CAR TAU EQ '?! THEN
		BEGIN NEW ARGS,FUN,WI;FUN←CADR TAU;ARGS←<CDDR TAU>;
		WHILE ¬ATOM(FUN)∧CAR(FUN) EQ '?! DO
			BEGIN ARGS←CONS(CDDR(FUN),ARGS);FUN←FUN[2]END;
		IF CDR ARGS ∧ ATOM FUN ∧ ¬NUMBERP(FUN) ∧ GET(FUN,'INFIX)
		THEN
		BEGIN
		      IF CDDR(ARGS) THEN PRINC '?(;
		      PRINTERMX(ARGS[1]);
		      IF WI←GET(FUN,'WDINFIX) THEN PRINC'? ;
		      PRINC FUN;IF WI THEN PRINC'? ;
		      PRINTERMX(ARGS[2]);
		      IF ARGS ← CDDR(ARGS) THEN PRINC '?);
		END
		ELSE PRINTERMX(FUN);
		IF ARGS THEN PRINC'?(;
		WHILE ARGS DO 
		BEGIN PRINTERM(ARGS[1]);
		      ARGS←CDR ARGS;PRINC IF ARGS THEN'?, ELSE '?)
		END;
		END
	ELSE
	BEGIN PRINTERM(CAR TAU);IF CDR TAU THEN 
		PRINC'?  ALSO PRINTERM(CDR TAU)END;


EXPR PRINTERMX(TAU);
	IF ATOM(TAU) THEN PRINTERM(TAU) ELSE
	IF EQ(CAR TAU, '??) THEN PRINC'?( ALSO PRINTERM(TAU)
			    ALSO PRINC'?) ELSE
	IF ¬EQ(CAR TAU, '?!) THEN PRINTERM(TAU) ELSE
	IF BEGIN NEW X; X←CADR(TAU);
		RETURN(¬ATOM(X) ∧ EQ(CAR X,'?!) ∧ ATOM(CADR X)
			 ∧ ¬NUMBERP(CADR X) ∧ GET(CADR X,'INFIX));
	   END THEN
	    PRINC '?( ALSO PRINTERM(TAU) ALSO PRINC '?) ELSE
	PRINTERM(TAU);


EXPR PRINTWFF(X);BEGIN NEW SEP;SEP←'? ;FOR NEW A IN X DO
	BEGIN NEW LA,RA,B; LA←CADR A; RA←CDDR A; PRINC SEP;
	WHILE  (IF WHILE ¬ATOM LA ∧ CAR LA EQ '?λ ∧ 
		¬ATOM RA ∧ CAR RA EQ '?λ  ∧ CADR LA=CADR RA DO
		BEGIN IF ¬B THEN PRINC'?∀ ;PRINC CADR LA;PRINC'? ;
		LA←CDDR LA; RA←CDDR RA; RETURN(B←T)  END
		THEN PRINC'?.?  )
	  ∨
		(IF ¬ATOM LA ∧ CAR LA EQ '?? ∧ ¬ATOM RA ∧ CAR RA EQ '?? ∧
		EQUALTERM(CADR LA,CADR RA) ∧ CDDDR LA EQ 'UU ∧ CDDDR RA EQ 'UU 
		THEN PRINTERM(CADR LA)  ALSO LA←CADDR LA ALSO
		RA←CADDR RA ALSO PRINC'? ?:?:?  )
	DO B←NIL;
	PRINTERM(LA);PRINC'? ;PRINC CAR A;PRINC'? ;
	PRINTERM(RA);SEP←'? ?,?  END
		 END;


EXPR TERPRINTWFF(W);
	BEGIN NEW SEP;SEP←'? ;FOR NEW AW IN W DO
	BEGIN TERPRI PRINC SEP;SEP←'?,;PRINTWFF(<AW>)END
	END;


EXPR PRINTSTEP(X);BEGIN X←CAR X;PRINTWFF(CAR X);
PRINC'? ? ;IF CDR X THEN PRINC CDR X END;


EXPR PRINTPROOF(S,G,FIRSTL,LASTL);
BEGIN NEW K,I1,I2,I3,FLAG;
	FLAG←FIRSTL EQ 0;K←0;LINES(2);
	FOR NEW ITEM IN REVERSE PROOF DO
	BEGIN I1←ITEM[1];I2←ITEM[2];I3←ITEM[3];IF ATOM I1 THEN 
	FLAG←(FIRSTL≤I1 ∧ I1≤LASTL);
	IF FLAG ∧ (ATOM I1 ∧ S ∨ ¬ATOM I1 ∧ G)THEN LINES(1)
	 ALSO
	( IF ATOM I1 THEN
		BEGIN REPPR('? ?|,K);PRINC I1;SPACES(2);PRINTSTEP(<I2>);
		IF I3 THEN PRINC'? ?-?-?- ALSO BLURB(I3)
		END
	ELSE IF ATOM I2 THEN
		BEGIN K←K-1;REPPR('? ?|,K);SPACES(1);REPPR('?-,20) END
	ELSE    BEGIN REPPR('? ?|,K);SPACES(1);REPPR('?-,20);K←K+1;
		LINES(1);REPPR('? ?|,K);PRINC 'TRY? ;PRINTGN(I1);SPACES(2);
		PRINTGOAL(I2);
		SPACES(4);BLURB(I3)
		END )
	END
END;

EXPR PRINTGOAL(G);
	BEGIN PRINTWFF(CAR G);IF CDR G THEN PRINC'? ?:?  ALSO
	PRINC CADADR G ALSO PRINC'? ?  ALSO PRINTWFF(CDDR G) END;
EXPR CHOP(L,N);FOR NEW I←1 TO N DO L←CDR L;

EXPR PRINTSTATUS(X);
	BEGIN PRINC'?-?-?-?- ;PRINC IF NULL X THEN'NOT? TRIED ELSE
	IF ATOM X THEN'PROVED?! ELSE 'UNDER? TRIAL END;


EXPR PRINTTHEOREM2(TH);
BEGIN
    IF TH[4] THEN PRINTWFF(TH[4]);
    PRINC '? ? ?|?-? ?  ;
    PRINTWFF(TH[3]);
    TERPRI(NIL);
    RETURN(TH);
END;

EXPR PRINTTHEOREM1(TH);
BEGIN
    PRINT'THEOREM;
    IF TH[2] THEN PRINC'?( ALSO PRINC CAR TH[2]
	ALSO FOR NEW X IN CDR TH[2] DO BEGIN PRINC'?, ;PRINC X END
	ALSO PRINC'?)?  ;
    PRINC TH[1];PRINC'?: ;PRINTWFF(TH[3]); 
    IF TH[4] THEN PRINT'ASSUME 
	ALSO TERPRINTWFF(TH[4]);
    RETURN(TH);
END;

EXPR PRINTLABELS(NF,NL);
BEGIN
	TERPRI(NIL);
	FOR NEW L IN LABELALIST DO
	BEGIN PRINC(CAR L); PRINC('?=);PRINC(CDR L);TERPRI(NIL);END;
END;


