PROGRAM Logic

? This program was designed as a simple example of F-Basic's pattern
? matching capabilities. See the documentation in the F-Basic System
? User's Manual in the appendix entitled "Applications Of Pattern
? Matching In F-Basic". The program will accept logical expressions
? of level zero only (meaning that it does not support parenthesis).


INTEGER I,J,K,L,M,N,NFact,NRule
TEXT*120 Fact(100),Expression,Assume(50),Conclude(50),TXT1,TXT2
DATA (Fact," "*100),(Assume," "*50),(Conclude," "*50)
SUBPROGRAM
   INTEGER INFER
   TEXT*120 StandardForm
   
{Again}
INPUT Expression
I=FILLCHAR(TXT1," ")  ;  TXT1=TXT2
IF (Expression ? BLANK * "FACT ") ! J THEN
   IF LENGTH(Expression(J+1:120)) > 0 THEN
      INC(NFact)
      Fact(NFact)=StandardForm(Expression(J+1:120))
      GOSUB UpdateRules
   ENDIF
ELSEIF (Expression ? BLANK * "IF " * ARB.TXT1 * " THEN ") ! J THEN
   IF LENGTH(TXT1) AND LENGTH(Expression(J+1:120)) THEN
      INC(NRule)
      Assume(NRule)=StandardForm(TXT1)
      Conclude(NRule)=StandardForm(Expression(J+1:120))
      GOSUB UpdateRules
   ENDIF
ELSEIF (Expression ? BLANK * "QUERY ") ! J THEN
   IF LENGTH(Expression(J+1:120)) THEN
      TXT1=StandardForm(Expression(J+1:120))
      I=INFER(TXT1,Fact)
      IF I THEN 
         PRINT "True"
      ELSE
         PRINT "False"
      ENDIF
   ENDIF
ELSEIF Expression ? BLANK * "LIST " * BLANK * "RULES" THEN
   FOR I=1 TO NFact
      J=LENGTH(Fact(I))
      PRINT "Fact: ",Fact(I)(1:J)
   NEXT I
   FOR I=1 TO NRule
      J=LENGTH(Assume(I))
      L=LENGTH(Conclude(I))
      PRINT "IF ",Assume(I)(1:J)," THEN ",Conclude(I)(1:L)
   NEXT I
ELSEIF Expression ? BLANK * "QUIT" THEN
   STOP
ELSE
   PRINT "Syntax Error In This Input Line"
ENDIF
GOTO Again

{UpdateRules}
   REPEAT
      K=0
      FOR L=1 TO NRule
         M=INFER(Assume(L),Fact)
         IF M THEN
            IF NOT (Conclude(L) IN Fact) THEN
               INC(NFact)
               Fact(NFact)=Conclude(L)
               K=1
            ENDIF
         ENDIF
      NEXT L
   UNTIL NOT K
   LRETURN
END

FUNCTION INFER
PARAMETER
   TEXT*$ expression,fact(*)
LOCAL
   INTEGER I,J,K,L,N
   TEXT*120 TXT1,TXT2,TXT3 
I=FILLCHAR(TXT1," ") ; TXT2=TXT1 ; TXT3=TXT1 
N=LENGTH(expression)
IF N THEN
   IF (expression ? ARB * " AND ") ! I THEN
      IF I>5 AND I<N THEN
         J=INFER(expression(1:I-5),fact)
         K=INFER(expression(I+1:N),fact)
      ELSE 
         J=K=0
      ENDIF
      INFER=(J>0) AND (K>0)
   ELSEIF (expression ? ARB * " OR ") ! I THEN
      IF I>4 AND I<N THEN
         J=INFER(expression(1:I-4),fact)
         K=INFER(expression(I+1:N),fact)
      ELSE 
         J=K=0
      ENDIF
      INFER=(J>0) OR (K>0)
   ELSEIF (expression ? BLANK * "NOT ") ! I THEN
      IF I<N THEN
         J=INFER(expression(I+1:N),fact)
      ELSE 
         J=1
      ENDIF
      INFER=NOT (J>0)
   ELSE
      TXT1=StandardForm(expression)
      INFER=TXT1 IN fact
   ENDIF
ELSE
   INFER=0
ENDIF
GRETURN
END

FUNCTION StandardForm
PARAMETER
   TEXT*$ STR
LOCAL
   INTEGER I,J,K,L,M,N
   TEXT*120 TXT1
I=FILLCHAR(TXT1," ")
N=LENGTH(STR)
IF (STR ? BLANK) ! I THEN
   TXT1=StandardForm(STR(I+1:N))
ELSEIF (STR ? NAME) ! I THEN
   TXT1=STR(1:I)
   TXT1(I+1)=" "
   IF I<N THEN TXT1(I+2:120)=StandardForm(STR(I+1:N))
ENDIF
StandardForm=TXT1
GRETURN
END